ASMB,R,B,L
      NAM FF.C
      END 
ASMB,R,B,L,X
      HED REAL TIME FORTRAN FORMATTER 
      NAM FRMTR,7,0,0,0,0,0,0,0 
*        N O V E M B E R  6 ,  1 9 6 8
      ENT .DIO.,.BIO.,.IOI.,.IOR. 
      ENT .IAR.,.RAR.,.DTA. 
      ENT OLDIO 
      EXT  EXEC,.FLUN,.PACK,FLOAT,IFIX
      EXT .OPSY 
* * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                   * 
*                F  O  R  T  R  A  N                * 
*                                                   * 
*                      I  /  O                      * 
*                                                   * 
*                P  R  O  G  R  A  M                * 
*                                                   * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
* THE FORTRAN I/O PROGRAM PROVIDES FOR ALL INPUT AND
* OUTPUT SERVICES SPECIFIED BY THE -HP-2116 FORTRAN 
* COMPILER.  THIS INCLUDES THE FOLLOWING TYPES OF 
* FORTRAN STATEMENTS: 
* 
*      I  WRITE (<UNIT>,<FORMAT>) <LIST>
*     II  READ  (<UNIT>,<FORMAT>) <LIST>
*    III  WRITE (<UNIT>) <LIST> 
*     IV  READ  (<UNIT>) <LIST> 
* 
* THE FIRST TWO STATEMENTS PROVIDE FOR FORMATTED
* INPUT/OUTPUT, THE LAST TWO FOR BINARY INPUT/
* OUTPUT.  A SPECIAL FORM OF THE TYPE II STATEMENT
* IS FREE-FIELD INPUT.  THIS IS SPECIFIED BY A STAR 
* IN THE FORMAT FIELD.
* 
* IN ADDITION TO THE USUAL BASIC FORTRAN FORMAT SPE-
* CIFICATIONS, THE FOLLOWING SPECIFICATIONS ARE RE- 
* COGNIZED: 
* 
* 1) Q-FORMAT: THIS CAN BE USED TO OUTPUT A CHARACTER 
*    STRING WITHOUT EXPLICITLY SPECIFYING THE NUMBER
*    OF CHARACTERS. ITS FORM IS:
*              " <CHARACTER STRING> " 
* 
* 2) FREE-FIELD INPUT: THIS ALLOWS FOR INPUT DATA 
*    WITHOUT ANY PARTICULAR FORMAT BEING SPECIFIED. 
* 
* 
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
* 
*    THE PROGRAM ITSELF CONSISTS OF THREE SETS OF 
*    ROUTINES.  THESE CAN BE CLASSIFIED AS: 
* 
* 1) THE FORMAT ANALYZER.  THESE ROUTINES ARE RESPON- 
*    SIBLE FOR SCANNING THE FORMAT STRING AND PASSING 
*    CONTROL TO THE CORRECT CONVERSION ROUTINE. 
* 
* 2) THE CONVERSION ROUTINES.  THESE ROUTINES ARE THE 
*    ONES THAT PERFORM THE ACTUAL CONVERSION BETWEEN
*    INTERNAL AND EXTERNAL REPRESENTATIONS. 
* 
* 3) THE COMMUNICATION ROUTINES.  THESE ARE THE ROU-
*    TINES THAT ARE ACTUALLY CALLED BY THE FORTRAN
*    PROGRAM.  THEY ESSENTIALLY DRIVE THE ROUTINES
*    OF CLASSES 1 AND 2.
* 
*     THE CALLING SEQUENCES ARE AS FOLLOWS: 
* 
*     INITIALIZATION CALL:
* 
*       BINARY INPUT/OUTPUT 
* 
*           JSB .BIO.  (A=UNIT, B=0 FOR OUTPUT, 1 FOR INPUT)
* 
*       DECIMAL INPUT/OUTPUT
* 
*           JSB .DIO.  (A=UNIT, B=0 FOR OUTPUT, 1 FOR INPUT)
*           DEF BUFFER (ONLY IF UNIT=0) 
*           DEF FORMAT (=0 FOR FREE-FIELD INPUT)
*           DEF ENDLIST 
* 
*       WHEN UNIT=0, THE FORMATTER WILL CONVERT DIRECTLY TO OR FROM 
*       THE USER'S BUFFER. NO ACTUAL I/O WILL TAKE PLACE. 
* 
*     CONTINUATION CALLS: 
*       JSB .IOR. WILL CONVERT A FLOATING POINT NUMBER. 
*       JSB .IOI. WILL CONVERT A FIXED POINT NUMBER.
*       JSB .RAR. OR .IAR. WILL CONVERT AN ENTIRE ARRAY, IN FLOATING
*         POINT OR FIXED POINT. (A=#OF ELEMENTS, B=ADDRESS OF FIRST 
*         ELEMENT 
* 
*     TERMINATION CALL: (USED ONLY FOR OUTPUT)
* 
*       JSB .DTA. 
* 
* 
*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *
*************************** 
*                         * 
* CONSTANTS AND VARIABLES * 
*                         * 
*************************** 
A     EQU 0 
B     EQU 1 
.177  OCT 177       USED TO MASK CHARACTERS 
BLANK OCT 40        ALPHABETIC
COMMA OCT 54
E     OCT 105         CONSTANTS 
ASCIA OCT 101     ASCII "A" 
F     OCT 106 
H     OCT 110 
I     OCT 111 
OCTAL OCT 100      @B PRECEDING A NUMBER IN FREE- 
*                                       FIELD INPUT INDICATES OCTAL.
.36   OCT 36
QUOTE OCT 42        " 
SLASH OCT 57
..7   OCT 7 
..67  OCT 67
....6 OCT 6 
X     OCT 130 
K     OCT 113        ASCII K
LPREN OCT 50
.4000 OCT 4000
RPREN OCT 51
PLUS  OCT 53
MINUS OCT 55
POINT OCT 56
MONEY OCT 44        DOLLAR SIGN ($) 
CNTRL BSS 1 
D13   DEC 13
D15   DEC -15 
MIN2  DEC -2
MIN72 OCT -72 
.12   OCT 12
BCR   BSS 1 
PAPER OCT 34000     TEST FOR PAPER TAPE.
PBIT  OCT 200       SET BIT FOR IOC.
TENTH OCT 63146     FIRST 15 BITS OF THE NUMBER 0.1 
...60 OCT 60        SAME AS ASC ZERO
MIN16 DEC -16 
MIN1 DEC -1 
BASIC OCT 400 
ASC2B OCT 500 
MIN5  DEC -5
NINE  DEC 9 
...61 OCT 61
HIMSK OCT 174000
MIN4  OCT 177774
MIN3  OCT -3
TEMP1 BSS 1         TEMPORARY 
TEMP2 BSS 1              STORAGE
FCR   BSS 1         POINTS TO CHARACTER IN FORMAT 
DBLNK BSS 1         FLAG FOR SKIPPING BLANKS IN FMT 
DCOMA BSS 1         FLAG FOR SKIPPING COMMAS IN FMT 
BCRS  BSS 1         USED FOR REMEMBERING BCR
CCNT  BSS 1         COUNTS WORDS/CHARS IN BUFFER
RF    BSS 1         FORMAT REPEAT FIELD COUNTER 
IO    BSS 1         FLAG...=0 FOR OUTPUT, 1 FOR IN
NEST  BSS 1         COUNTS PAREN. LEVEL IN FORMATS. 
*                                   INITIALLY -3, =-2 WITHIN FMT, 
*                                   -1 IN INNER PARENS. 
RF1   BSS 1         REPEAT COUNTER FOR INNER PARENS 
RF2   BSS 1         USED TO RECALL REPEAT COUNT 
SKIPL BSS 1         FLAG SET TO AVOID A SPURIOUS RE-
*                                   TURN TO THE LIST
OVTOG BSS 1        FLAG TO SAY WHETHER OUTBUFFER IS BOMBED
PREN1 BSS 1         USED AS POINTERS TO PARENS IN 
PREN2 BSS 1              FORMATS. 
SIGN  BSS 1         USUALLY INDICATES SIGN OF NUMBER
W     BSS 1         COUNTER OF W-FIELD
WSAVE BSS 1         HOLDS INITIAL W FOR REPEATS 
D     BSS 1         COUNTER OF D-FIELD
DSAVE BSS 1         HOLDS INITIAL D FOR REPEATS 
BCNT  BSS 1         COUNTS LEADING BLANKS FOR OUTPUT
DT    BSS 1         TEMP D FOR OUTPUT OVERFLOW
MANTS BSS 2 
EXPS  BSS 1 
EXPON BSS 1         EXPONENT PART OF NUMBER 
UNIT  OCT 1         INPUT/OUTPUT UNIT 
BCTEM EQU TEMP2     TEMPORARY FOR OUTPUT
MULT1 BSS 1         TEMPORARIES FOR 
MULT2 EQU TEMP2          MULTO
ESIGN BSS 1         HOLDS EXPONENT SIGN 
SKIP  BSS 1         FLAG FOR INPUT SKIPPING 
POST  BSS 1         INPUT CONTROL INDICATOR 
CFLAG EQU MULT1     COMMA CHECK FOR FREE-FIELD INPUT
ENDLS BSS 1         POINTS TO ENDOF CALLING SEQUENCE
ARRAY BSS 1         USED BY .RAR. 
ALNTH BSS 1              AND .IAR.
BFLAG BSS 1         =1 FOR BINARY I/O, 0 FOR DECIMAL
STATT BSS 1 
MANT  BSS 2 
MIN10 DEC -10 
...72 OCT 72
STXXX NOP 
BUFBN EQU 60
BUFLN EQU 67
BUFI  BSS BUFLN 
BUFO  EQU BUFI
BINRY ABS -BUFBN-BUFBN   BINRY RECORD LINGTH
ASCRY ABS -BUFLN-BUFLN   ASCII RECORD LENGTH
********************* 
*  UTILITY ROUTINES * 
********************* 
* 
* THE ROUTINES THAT HANDLE CHARACTER MANIPULATION USE 
* THE FOLLOWING ADDRESSING SCHEME:
* THE ADDRESS OF THE WORD IS CONTAINED IN BITS [15:1] 
* AND BIT 0 IS EITHER 0 FOR THE CHARACTER CONTAINED 
* IN BITS [14:8], OR 1 FOR THE CHARACTER CONTAINED IN 
* BITS [6:0]. THUS, A STRING OF CHARACTERS HAVE AD- 
* DRESSES WHICH ARE SEQUENTIAL. FOR EXAMPLE, IF LOCA- 
* TION 1000 CONTAINS THE TWO CHARACTERS A AND B, THE
* CHARACTER ADDRESS OF THE A IS 2000, AND THAT OF THE 
* B IS 2001. THE SINGLE BIT IS REFERRED TO BELOW AS 
* THE C-BIT.
******************************* 
BUF2A NOP     *     THE CHAR WHOSE LOCN IS IN B IS
*******************************         PUT INTO A
      CLE,ERB       POSITION ADDRESS AND SET E=C-BIT
      LDA B,I       WORD CONTAINING CHARACTER TO A. 
      SEZ,RSS       IF E=0, ROTATE TO GET THE CHAR- 
      ALF,ALF         ACTER IN A[6:0].
      AND .177      MASK OUT EXTRANEOUS BITS. 
      JMP BUF2A,I   RETURN WITH CHAR IN A.
******************************* 
A2BUF NOP     *     THE CHAR IN A IS PUT IN THE 
*******************************         LOCATION GIVEN BY B.
      STA TEMP1     SAVE THE CHARACTER
      SLB,INB       COMPLEMENT THE LOW ORDER BIT
      ADB MIN2           OF B.
      JSB BUF2A     GET THE OTHER CHARACTER IN THE
      ALF,ALF       MEMORY WORD AND ROTATE TO HI END
      IOR TEMP1     MERGE THE OTHER CHARACTER.
      SEZ           ROTATE IF 
      ALF,ALF       NECESSARY.
      STA B,I       STORE THE NEW WORD. 
      JMP A2BUF,I   RETURN
******************************* 
FCHAR NOP     *     THE NEXT CHAR IN THE FORMAT IS
*******************************         MOVED TO A
NCHAR ISZ FCR       ADVANCE FORMAT STRING POINTER.
      LDB FCR       LOAD CHARACTER INTO A AND TEST
      JSB BUF2A     FOR BLANK OR COMMA
      LDB DBLNK     SKIP BLANKS IF DBLNK=1
      SZB,RSS 
      JMP *+3       DON'T SKIP BLANKS.
      CPA BLANK     IF DBLNK=1 AND A=BLANK, GO GET
      JMP NCHAR     ANOTHER CHARACTER.
      LDB DCOMA     SKIP COMMAS IF DCOMA=1
      SZB,RSS 
      JMP FCHAR,I   RETURN
      CPA COMMA     IF DCOMA=1 AND A=COMMA, GO GET
      JMP NCHAR     ANOTHER CHARACTER 
      JMP FCHAR,I   RETURN
******************************* 
OUTCR NOP     *     THE CHAR IN A IS PLACED IN THE
*******************************         OUTPUT STRING.
      ISZ CCNT        END OF THE BUFFER ? 
      JMP OUTC1 
      CCA           YES-- RESET CCNT AND RETURN 
      STA CCNT
      JMP OUTC2    SET OVTOG TO SAY BUFFER IS BOMBED
OUTC1 ISZ BCR      ADVANCE BUFFER POINTER 
      LDB BCR 
      JSB A2BUF     STORE CHARACTER IN BUFFER.
      CLA          CLEAR OVTOG AND WERE OKAY
OUTC2 STA OVTOG 
      JMP OUTCR,I   RETURN. 
******************************* 
INCHR NOP           GETS NEXT CHAR FROM BUFFER
      LDA CCNT      IF CCNT=0 THEN
      SZA,RSS         GET THE NEXT
      JSB DTA            LINE.
      ISZ CCNT      IF CCNT=-1 THEN SKIP
      JMP GETC
      CCA           RESET CCNT TO -1. 
      STA CCNT
      LDA POST      IF BEGINNING OF NUMBER SCAN 
      IOR FCR         IN FREE FIELD INPUT,
      SZA,RSS           RETURN TO END OF
      JMP ENDLS,I         LIST. 
      LDA BLANK     OTHERWISE RETURN A BLANK. 
      JMP INCHR,I 
GETC  ISZ BCR       IF CCNT<-1 THEN 
      LDB BCR         JUST
      JSB BUF2A         GET THE NEXT
      JMP INCHR,I          CHARACTER
DIGIT NOP     *     TESTS CHARACTER IN A FOR A DIGIT
*                             *         IF IT IS RETURN THE TRUE
*                             *         DIGIT IN A AND SKIP. ELSE 
*                             *         RETURN THE CHARACTER AND
*******************************         DON'T SKIP. 
      LDB A         PLACE THE CHARACTER IN B. 
      ADB MIN72     CHARACTERS > '9' REMAIN POSITIVE
      SSB,RSS       SKIP IF B NEGATIVE
      JMP DIGIT,I   RETURN...NOT A DIGIT
      ADB .12       CHARACTERS < '0' REMAIN NEGATIVE
      SSB 
      JMP DIGIT,I   RETURN...NOT A DIGIT
      ISZ DIGIT     BUMP RETURN ADDRESS 
      LDA B         PLACE THE DIGIT IN A
      JMP DIGIT,I 
******************************* 
FINTG NOP     *     COMPUTES THE INTEGER IN THE FOR-
*                             *         MAT STRING. THE FIRST DIGIT 
*******************************         IS ALREADY IN A.
      CLB 
      STB DCOMA     DON'T SKIP COMMAS NOW 
FINT1 STA TEMP1     SAVE RESULT SO FAR
      JSB FCHAR     GET NEXT CHARACTER
      JSB DIGIT     CHECK FOR DIGIT 
      JMP GOTIT     END OF INTEGER
      LDB TEMP1     MULTIPLY RESULT SO
      BLS,BLS         FAR BY TEN. 
      ADB TEMP1 
      BLS 
      ADA B         ADD TO NEW DIGIT
      JMP FINT1     LOOP
GOTIT CCB           BACK UP FORMAT POINTER
      ADB FCR 
      STB FCR 
      LDA TEMP1     RETURN WITH 
      JMP FINTG,I   RESULT IN A 
******************************* 
INT   NOP     *     COMPUTES THE NEXT NUMBER IN THE 
*******************************         FORMAT STRING, FROM SCRATCH.
      JSB FCHAR     GET ONE CHARACTER 
      JSB DIGIT     TEST FOR DIGIT
      JMP ERR1      NO DIGIT
      JSB FINTG     GET THE REST OF THE INTEGER 
      JMP INT,I     RETURN
********************************************************************
 HED FORMAT ANALYZER
*                                                                  *
*         THE FOLLOWING SECTION IS THE FORMAT ANALYZER. CONTROL IN *
*         HERE IS GOVERNED BY THE CONTROL LOOP, WHICH EXAMINES THE *
*         FORMAT AND PASSES CONTROL TO THE VARIOUS CONVERSION ROU- *
*         TINES. SINCE TERMINATION OF THE I/O STATEMENT IS DETER-  *
*         MINED BY THE CALLING SEQUENCE, EACH CONVERSION ROUTINE   *
*         MUST CHECK THE LIST BEFORE PERFORMING A CONVERSION. THIS *
*         IS DONE BY CALLING A ROUTINE CALLED F2LST. THE SOLE FUNC-*
*         TION OF THIS ROUTINE IS TO HOLD THE ADDRESS FROM WHICH   *
*         IT WAS CALLED, AND THEN TO GET BACK TO THE CALLING       *
*         SEQUENCE. THE CALLING SEQUENCE WILL THEN PASS CONTROL    *
*         BACK THROUGH THE COMMUNICATION ROUTINES (SEE ABOVE).     *
*         EACH OF THESE CALLS A ROUTINE CALLED LST2F, WHICH GETS   *
*         BACK TO THE FORMATTER BY USING THE ADDRESS LEFT AT       *
*         F2LST.                                                   *
*                                                                  *
********************************************************************
RFCHK NOP           CHECKS REPEAT FIELD FOR EXHAUS- 
      ISZ RF         TION. IF RF GOES TO ZERO, CON- 
      JMP RFCHK,I     TROL FALLS THROUGH TO FORMT.
FORMT CLA,INA       SET DBLNK AND DCOMA FOR SKIPPING. 
      STA DBLNK 
      STA DCOMA 
      CCA 
FORM1 STA RF       SET REPEAT FIELD AT ONE. 
      JSB FCHAR     GET THE CHARACTER AND TEST IT 
      CPA E         FOR TYPES 
      JMP ETYPE 
      CPA F 
      JMP FTYPE 
      CPA OCTAL     TEST FOR OCTAL TYPE 
      JMP OTYPE 
      CPA K     ALTERNATIVE OCTAL TYPE
      JMP OTYPE 
      CPA ASCIA     TEST FOR A TYPE 
      JMP ATYPE 
      CPA H 
      JMP HTYPE 
      CPA I 
      JMP ITYPE 
      CPA QUOTE 
      JMP QTYPE 
      CPA SLASH 
      JMP INOUT 
      CPA X 
      JMP XTYPE 
      CPA LPREN 
      JMP LPTYP 
      CPA RPREN 
      JMP RPTYP 
      JSB DIGIT     LAST CHANCE 
      JMP ERR3      UNKNOWN CHARACTER 
      JSB FINTG     GET THE REST OF THE NUMBER. 
      CMA,INA,SZA,RSS 
      JMP ERR3
      JMP FORM1 
***************************************** 
*                                       * 
* FOLLOWING ARE THE CONVERSION ROUTINES * 
*                                       * 
***************************************** 
IOCHK NOP           A SWITCH ON THE VALUE OF IO. RE-
      LDB IO        TURN TO P+1 FOR OUTPUT, P+2 FOR 
      SZB           INPUT.
      ISZ IOCHK 
      JMP IOCHK,I 
 HED X AND H SPECIFICATIONS 
**********************************
*     XTYPE HANDLES X-CONVERSION *
**********************************
XTYPE LDA BLANK     IN CASE OF OUTPUT 
      JSB IOCHK     WHICH WAY?
      JMP XOUT      OUT 
      JSB INCHR     IN
      RSS           SKIP
XOUT  JSB OUTCR     OUT 
      JSB RFCHK     TEST RF 
      JMP XTYPE     LOOP
**********************************
*     HTYPE HANDLES H-CONVERSION *
**********************************
HTYPE CLA           SET FOR NO
      STA DBLNK      SKIPPING 
      STA DCOMA 
HLOOP JSB IOCHK     WHICH WAY?
      JMP HOUT      OUT 
      JSB INCHR     IN
      ISZ FCR       ADVANCE FORMAT POINTER
      LDB FCR 
      JSB A2BUF     PLACE INTO FORMAT 
HCHEK JSB RFCHK     TEST RF 
      JMP HLOOP 
HOUT  JSB FCHAR     GET A CHAR FROM STRING
      JSB OUTCR     OUTPUT IT 
      JMP HCHEK 
 HED A SPECIFICATIONS 
* ATYPE HANDLES A-SPECIFICATIONS
ATYPE CLA         GET 
      STA SIGN           THE
      JSB WGET             W-FIELD
ALOOP JSB AOSET 
      JSB IOCHK     IN/OUT SWITCH 
      JMP AOUT
* A-INPUT 
AIN   CLA     INITIALIZE MANT TO ZERO 
      STA MANT
AIN1  JSB INCHR     READ A CHARACTER
      LDB W         FIGURE OUT WHAT TO DO WITH IT 
      INB,SZB      IF W NOT -1, 
      ALF,ALF      ROTATE IT
      IOR MANT        PUT IN PREVIOUS RESULT
      INB    STORE ONLY IF
      SSB,RSS    W IS -2 OR -1
      STA MANT
      ISZ W       TEST FOR FINISHED 
      JMP AIN1      NOT YET 
ATYP1 JSB $ASET 
      JMP ALOOP 
* 
AOUT  LDA MANT     GET SYMBOL TO GO OUT 
      LDB W     GET W 
      INB,SZB     IF NOT -1  WE WANT THE
      ALF,ALF            HIGH PART
      AND .177       ONE CHARACTER ONLY 
      INB 
      SSB     IF NOT -1 OF -2 WE WANT 
      LDA BLANK            BLANK
      JSB OUTCR         THERE IT GOES 
      ISZ W         ALL DONE YET
      JMP AOUT         NOPE 
      JMP ATYP1      END OF ASPECIFICATIONS 
* 
 HED K SPECIFICATION
*OTYPE HANDLES @ SPECIFICATIONS * 
OTYPE CLA       GET 
      STA SIGN        THE 
      JSB WGET           W-   FIELD 
OLOOP JSB AOSET 
      JSB IOCHK     IN/OUT SWITCH 
      JMP OCOUT 
* OCTAL INPUT * 
      CLA        INITIALIZE TO
      STA MANT       ZERO 
OCT1  JSB INCHR      GET A CHARACTER
      STA B        SAVE IN B
      IOR ..7     TEST FOR OCTAL DIGIT
      CPA ..67
      JMP OCT2       IT IS ONE
OCT3  ISZ W         END OF THIS INPUT       ??? 
      JMP OCT1       NOPE 
OCT6  JSB $ASET    YES--TEST FOR END OF SPEC
      JMP OLOOP 
* ADD NEW DIGIT IN *
OCT2  LDA 1       GET OCTAL DIGIT BACK IN A 
      AND ..7     REMOVE ASCII BITS 
      LDB MANT     REPOSITION PREVIOUS RESULT 
      BLF,RBR 
      ADA 1      ADD TO NEW DIGIT 
      STA MANT    PUT IT BACK 
      JMP OCT3
* OCTAL OUTPUT *
OCOUT LDA BLANK 
      LDB W     IS W GEQ -6?
      ADB ....6 
      SSB 
      JMP OCT4     NO---OUTPUT A BLANK
      LDA MANT     GET NUMBER 
      CMB 
      RAR,RAR     POSITION OVER 2 FOR 16TH BIT
      CPB MIN1
      ALR,RAR 
      ALF,RAR     ROTATE 3
      INB,SZB     DONE ROTATING???? 
      JMP *-2     NOT YET, SON
      AND ..7      MASK OFF 
      IOR ...60     ASCII BITS
OCT4  JSB OUTCR      THERE IT GOES
      ISZ W      END OF VALUE?
      JMP OCOUT 
      JMP OCT6
*     END OF OCTAL SPECIFICATIONS 
AOSET NOP 
      JSB WDSET 
      JSB F2LST 
      JSB IOCHK 
      RSS 
      JMP AOSET,I 
      LDA MANT     FOR OUTPUT WE HAVE 
      LDB EXP       TO REUNNORMALIZE
      ADB MIN16      THE INTEGER
AOST1 STA MANT
      INB,SZB,RSS 
      JMP AOSET,I 
      ARS 
      JMP AOST1 
$ASET NOP 
      LDA .36     FOR INPUT, FOOL .IOR. 
      STA MANT+1        BY SETTING EXPONENT TO 15 
      JSB RFCHK 
      JMP $ASET,I