ASMB,Q,C
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*   NAME: PART OF MATH LIBRARY
*   SOURCE:  24998-18XXX  SEE NAM FOR LAST THREE DIGITS 
*   RELOC: PART OF 24998-12001
*   PGMR: BG & JTS
* 
      HED "FRMTR" REAL TIME FORTRAN FORMATTER.
      NAM FRMTR,6 24998-1X231 REV.2001 790503 
      ENT .FRMN,.LS2F,.INPN,.DTAN 
      EXT .FLUN,.CFER,.XPAK,$SETP 
      EXT .ZRNT 
      EXT IFIX,FLOAT,.LBT,.SBT
A     EQU 0 
B     EQU 1 
      SPC 1 
* * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                   * 
*                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. 
* 
* FOR THE REAL TIME SYSTEM, FRMTR IS USED FOR DATA CONVERSION 
* AND FMTIO IS USED FOR I/O. IN THIS WAY FRMTR CAN BE MADE
* RE-ENTRANT. FRMTR ACCEPTS AS INPUT A FORMAT STRING AND,FOR
* INPUT, A CHARACTER STRING OR, FOR OUTPUT, A SINGLE VARIABLE.
* THE NECESSARY DATA CONVERSION IS PERFORMED,AND FRMTR RETURNS
* TO FMTIO. ITEMS THAT MUST BE SAVED ARE STORED IN FMTIO AND
* REFERENCED INDIRECTLY BY FRMTR. 
      SKP 
* 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: 
* 
*       Single element I/O: 
* 
*         JSB .zIO.  z=I,J,R,X,T            <output: X in A or A&B> 
*         DEF <arg>                         JSB .IOz.  z=I,J,R
*                                           <input: X in A or A&B>
*       Array I/O:
* 
*         JSB .zAY.  z=I,J,R,X,T            LDA length
*         DEF <address>                     LDB address 
*         DEC <length>                      JSB .zAR.  z = I,J,R,X,T
* 
*       Where the letters I,J,R,X,T are for 1 & 2-word integer and
*       2, 3 & 4-word floating, in that order.
*********************************************************************** 
*     TERMINATION CALL: (USED ONLY FOR OUTPUT)
* 
*       JSB .DTA. 
      SKP 
*                   SUBROUTINE ENTRY POINTS.
* 
TDB   NOP 
      ABS TDBND-*   THIS MANY WORDS MUST BE STACKED TO
      NOP                         SUPPORT REENTRANTCY.
TRNAD NOP 
      JMP TRNAX 
F2LST NOP 
      JMP F2LSX 
DTA   NOP 
      JMP DTX 
FCHAR NOP 
      JMP FCHAX 
OUTCR NOP 
      JMP OUTCX 
INCHR NOP 
      JMP INCHX 
DIGIT NOP 
      JMP DIGIX 
FINTG NOP 
      JMP FINTX 
RFCHK NOP 
      JMP RFCHX 
WGET  NOP 
      JMP WGEX
WSET  NOP 
      JMP WSEX
WDFIX NOP 
      JMP WDFIZ 
WDGET NOP 
      JMP WDGEX 
OUTPT NOP 
      JMP OUTPX 
OUTP1 NOP 
      JMP OUTPZ 
MTPLO NOP 
      JMP MTPLX 
GETDG NOP 
      JMP GETDX 
NORML NOP 
      JMP NORMX 
INPUT NOP 
      JMP INPUX 
.XCOM NOP 
      JMP XCOMX 
PTEN  NOP 
      JMP PTENX 
MULT  NOP 
      JMP MULTX 
DIVD  NOP 
      JMP DIVDX 
RSN   NOP 
      JMP RSNX
LSONE NOP 
      JMP LSONX 
INDIG NOP 
      JMP INDIX 
ABLKS NOP 
      JMP ABLKX 
BCKUP NOP 
      JMP BCKUX 
* 
*                   INDIRECTS FROM FMTIO. 
* 
AADX  DEF 0         ADDR VARIABLE.
TYPE  BSS 1         TYPE. 
LENTH BSS 1         LENGTH. 
SKIP  BSS 1         FREE FIELD SKIP 
FCR   BSS 1         FORMAT POINTER
CCNT  BSS 1         BUFFER COUNT
CMAX  BSS 1         MAX VALUE OF CCNT AFTER TAB LEFT. 
BCR   BSS 1         BUFFER POINTER
IO    BSS 1         FLAG FOR I/O
SKIPL BSS 1         FOR UNLIMITED GROUPS
TSCAL BSS 1         SCALE FACTOR
SCALE BSS 1         USED FOR F AND I FIELDS 
NEST  BSS 1         NEST LEVEL FOR GROUPS.
CFLAG BSS 1         COMMA CHECK FOR FREE F. 
BCRS  BSS 1         SAVE BCR
F2LSI BSS 1         ENTRANCE INTO FRMTR 
SWITH BSS 1         TYPE OF EXIT FOR FMTIO. 
*                                     1-5:ERR1-5. 
*                                     6:F2LST 
*                                     7:ENDLS 
*                                     8:DTA (NEW RECORD)
RNEST BSS 1         NEST FOR UNLIMITED GROUPS 
ADRFD BSS 1         INDEX FOR RFLD
RF    BSS 1         REPEAT FIELD. 
WSAVE BSS 1 
DSAVE BSS 1 
GFLAG BSS 1 
.OBUF BSS 1 
EORD  BSS 1 
OFLAG BSS 1         OLD-NEW DEFINITIONS FLAG
ATMP  EQU EORD      FLAG FOR A VS. R FORMAT.
DTAI  EQU EORD      ENTRANCE AFTER I/O. 
      SPC 3 
*                   MANTISSA AND "XEQ", A ROUTINE FOR VARIABLE SHIFTING.
* 
MANT  BSS 5         MANTISSA OF NUMBER BEING CONVERTED. 
XEQ   NOP 
      NOP 
TDBND JMP XEQ,I     (NEED NOT BE SAVED) 
      SKP 
*                   TEMPS LOCAL TO NAMED ROUTINES.
* 
MULTA EQU FCHAR 
MULTB EQU OUTCR 
MULTC EQU INCHR 
MULTD EQU DIGIT 
DIVDA EQU FCHAR 
DIVDB EQU OUTCR 
DIVDC EQU INCHR 
DIVDD EQU DIGIT 
DIVDE EQU WGET
DIVDF EQU WSET
PTENA EQU OUTP1 
PTENB EQU MTPLO 
MTPL1 EQU XEQ 
MTPL2 EQU XEQ+1 
FINTA EQU XEQ 
QTYPA EQU XEQ 
QTYPB EQU XEQ+1 
ATYPA EQU WGET
ATYPB EQU WSET
TTYPA EQU XEQ+1 
INDIA EQU OUTP1 
INPUA EQU XEQ 
INPUB EQU XEQ+1 
INPUC EQU WGET
INPUD EQU WSET
OUTA  EQU OUTP1 
GETDB EQU XEQ+1 
NORMA EQU GETDG 
NORMB EQU DIVD
* 
*                   GLOBAL TEMPS. 
* 
GETDA EQU XEQ 
GETDC EQU WGET
ADX   EQU F2LST     DIRECT ADDR VARIABLE. 
EXP   EQU WDFIX     EXPONENT
W     EQU NORML     -W
D     EQU .XCOM     -D-1
EFLAG EQU WDGET     THE E FORMAT FLAG 
DBLNK EQU OUTPT     FLAG FOR SKIPPING BLANKS IN FMT 
BCNT  EQU MTPLO     COUNTS LEADING BLANKS FOR OUTPOT
EXPON EQU DTA       EXPONENT PART OF NUMBER 
EXPNS EQU INDIG     COPY OF EXPON FOR G-FORMAT. 
SGDIG EQU OUTPT     FOR NEG SCALE FACTORS, E-FORMAT.
OCONT EQU PTEN      # ZEROES FOR E SCALE FACTOR.
POST  EQU WDGET     INPUT CONTROL INDICATOR 
SIGN  EQU ABLKS     SIGN OF NUMBER. 
MANTP EQU TRNAD     FWA WORKING AREA IN MANTISSA
MANTL EQU FINTG     LWA DITTO 
OVTOG EQU RFCHK     FLAG INDICATING OUTPUT BUFFER OVERRUN.
      SKP 
*                   ADDRESS CONSTANTS & SHIFT INSTRUCTIONS. 
* 
MULTZ DEF MULT
DIVDZ DEF DIVD
AAADX DEF AADX      TO SEE IF ADDRESSES NEED BE RESET.
AMANT DEF MANT      FWA MANTISSA
AMNT3 DEF MANT+3    LWA USED BY .XCOM 
MANTE DEF MANT+5    LWA+1 MANTISSA
RRR16 RRR 16
RRL16 RRL 16
* 
*                   NUMERIC AND CHARACTER CONSTANTS.
* 
NUMAD ABS OFLAG-AADX+1   NUMBER OF ADDRESSES FROM FMTIO 
NEG1  OCT 100000    LOGICAL TRUE. 
MIN72 OCT -72       -"9"-1
MIN5  DEC -5
MIN4  DEC -4
MIN3  DEC -3
MIN2  DEC -2
MIN1  DEC -1
....2 DEC 2 
....3 DEC 3 
....6 DEC 6 
....8 DEC 8 
....9 DEC 9 
.177  OCT 177 
BLANK OCT 40        CHARACTER CONSTANTS.
QUOTE OCT 42        " 
"$"   OCT 44
"&"   OCT 46
PLUS  OCT 53
COMMA OCT 54
MINUS OCT 55
"."   OCT 56
"/"   OCT 57
"0"   OCT 60
"1"   OCT 61
"7"   OCT 67
"@"   OCT 100 
"D"   OCT 104 
"E"   OCT 105 
"F"   OCT 106 
"L"   OCT 114 
"P"   OCT 120 
"R"   OCT 122 
"T"   OCT 124 
_"Y"  OCT -131      -"Y"
"Y_@" ABS 131B-100B "Y"-"@" 
"@_&" ABS 100B-046B "@"-"&" 
"0_." EQU ....2     "0"-"." 
      HED ENTRY POINTS. 
*                   GENERAL ENTRY ROUTINE.
* 
TRNAX LDA MIN4      FIND ORIGIONAL CALLER 
      ADA TRNAD     NOP ADDRESS 
      LDB A,I       GET NOP'S CONTENTS
      INA           NOW GET THE POSSIBLE
      LDA A,I       JSB $LIBR?? 
      STA .LS2F+1   FIX UP P+1 OF OTHER CALLS 
      STA .DTAN+1 
      SSA,RSS       IS IT A JSB $LIBR?
      STB TDB+2     NO, SET THE TDB RETURN
      LDB AAADX 
      LDA TDB+2,I 
      CPA B,I       CHECK IF ADDRESSES NEED SETTING 
      JMP SAME      NO, SKIP IT 
      JSB $SETP     SET UP INDIRECTS FROM FMTIO.
      DEF NUMAD 
SAME  LDA AADX,I    COPY ADDR VARIABLE. 
      STA ADX 
      ISZ TDB+2     SKIP PARAM
      JMP TRNAD,I 
* 
*                   FORMATTED I/O ENTRY POINT.
* 
.FRMN NOP           ENTRANCE TO FORMAT SCANNER
      JSB .ZRNT 
      DEF LIBX
      JSB TRNAD 
      CCA           SET FLAG THAT NO LIST ITEM PROCESSED YET. 
      STA ADX 
      JMP FORMT 
* 
*                   FREE-FIELD INPUT ENTRY. 
* 
.INPN NOP           ENTRANCE FOR FREE FIELD INPUT 
      JSB .ZRNT     1ST ENTRY IF FREE FIELD INPUT 
      DEF LIBX1     DEF ANOTHER LIBX
      JSB TRNAD 
      JSB INPUT 
LIBX1 JMP TDB+2,I   RETURN
      DEF TDB 
      DEC 0 
      SKP 
*                   ROUTINE TO REQUEST LIST ELEMENT FROM FMTIO. 
* 
F2LSX LDA F2LST 
      STA F2LSI,I 
      LDA ....6 
      STA SWITH,I 
      JMP LIBX
.LS2F NOP           ENTRANCE FROM ELEMENT LIST
      JMP *         STALL IF CALLED BEFORE .FRMN
      DEF TDB 
      JSB TRNAD          TRANSFER ADDRESSES 
      LDA F2LSI,I 
      JMP A,I       ENTER FORMATTER 
* 
*                   ROUTINE TO REQUEST I/O FROM FMTIO.
* 
DTX   LDA DTA 
      STA DTAI,I
      LDA ....8 
      STA SWITH,I 
LIBX  JMP TDB+2,I 
      DEF TDB 
      DEC 0 
.DTAN NOP           ENTRANCE AFTER AN I/O REQUEST 
      JMP *         STALL IF CALLED BEFORE .FRMN
      DEF TDB 
      JSB TRNAD 
      LDA DTAI,I
      JMP A,I       RETURN TO THE DTA CALL
* 
*                   ERROR EXITS.
* 
ERR1  LDA ....1 
      JMP STERR 
ERR2  LDA ....2 
      JMP STERR 
ERR3  LDA ....3 
      JMP STERR 
ERR4  LDA ....4 
      JMP STERR 
ERR5  LDA ....5 
STERR STA SWITH,I 
      JMP LIBX
      HED SOME UTILITY ROUTINES 
********************* 
*  UTILITY ROUTINES * 
********************* 
* 
* THE ROUTINES THAT HANDLE CHARACTER MANIPULATION USE 
* STANDARD BYTE ADDRESSES.
      SPC 5 
* CALL: JSB FCHAR 
* RETURNS: A = THE NEXT VALID FORMAT STRING CHARACTER 
*          B = MEANINGLESS
* 
* BLANKS ARE IGNORED DEPENDING ON THE FLAG DBLNK. 
      SPC 2 
FCHAX ISZ FCR,I     A _ NEXT FORMAT CHAR. 
      LDB FCR,I     LOAD CHARACTER INTO A AND TEST
      JSB .LBT      FOR BLANK OR COMMA
      LDB DBLNK     SKIP BLANKS IF DBLNK=1
      CPA BLANK     CHAR=BLANK ?
      SZB,RSS       AND DBLNK.NE.0 ?
      JMP FCHAR,I   NO, DONE. 
      JMP FCHAX     YES, SKIP THE BLANK.
      SPC 4 
* CALL: LDA CHAR
*       JSB OUTCR 
* RETURN: A = OVTOG 
*         B = NEXT BYTE ADDRESS IN THE OUTPUT BUFFER
      SPC 2 
OUTCX ISZ CCNT,I    A<7:0> PLACED IN OUTPUT.  END OF BUFFER ? 
      JMP OUTC1 
      CCA           YES-- RESET CCNT AND RETURN 
      STA CCNT,I
      JMP OUTC2    SET OVTOG TO SAY BUFFER IS BOMBED
OUTC1 ISZ BCR,I     ADVANCE BUFFER POINTER
      LDB BCR,I 
      JSB .SBT      STORE CHARACTER IN BUFFER.
      CLA          CLEAR OVTOG AND WERE OKAY
OUTC2 STA OVTOG 
      JMP OUTCR,I   RETURN. 
      SKP 
* CALL: JSB INCHR 
* RETURN: A = THE NEXT CHARACTER IN THE INPUT STRING OR A BLANK 
*         B MEANINGLESS 
      SPC 3 
INCHX LDA CCNT,I    A_NEXT INPUT CHAR.  IF CCNT=0 THEN
      SZA,RSS       RETURN A
      JMP RTBNK     BLANK 
      ISZ CCNT,I    IF CCNT=-1 THEN SKIP
      JMP GETC
      CCA           RESET CCNT TO -1. 
      STA CCNT,I
      LDA POST      IF BEGINNING OF NUMBER SCAN 
      IOR FCR,I        IN FREE FIELD INPUT
      SZA 
      JMP RTBNK 
      LDA ....7 
      STA SWITH,I 
      JMP LIBX      GO TO END OF LIST 
RTBNK LDA BLANK     OTHERWISE RETURN A BLANK
      JMP INCHR,I 
GETC  ISZ BCR,I     IF CCNT <-1 THEN
      LDB BCR,I       JUST
      JSB .LBT          GET THE NEXT
      JMP INCHR,I          CHARACTER
      SKP 
* CALL: LDA CHAR
*       JSB DIGIT 
* RETURN: P+1 CHAR IN A NOT A DIGIT 
*          A =  CHAR
*         P+2 CHAR IN A A DIGIT 
*         A = B = VALUE.
      SPC 2 
DIGIX LDB A         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. 
      ADB MIN72     CHARACTERS > '9' REMAIN POSITIVE
      SSB,RSS       SKIP IF B NEGATIVE
      JMP DIGIT,I   RETURN...NOT A DIGIT
      ADB ...10     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 
      SPC 3 
******************************* 
FINTX JSB DIGIT     COMPUTES THE INTEGER IN THE FOR-
*                             *         MAT STRING. THE FIRST DIGIT 
*******************************         IS ALREADY IN A.  MAX VALUE 511.
      JMP FINTG,I   IF NOT A DIGIT
      ISZ FINTG     ELSE GOOD RETURN (IF ANY) 
FINT1 STA FINTA     SAVE RESULT SO FAR
      JSB FCHAR     GET NEXT CHARACTER
      JSB DIGIT     CHECK FOR DIGIT 
      JMP GOTIT     END OF INTEGER
      CLO           MULTIPLY RESULT SO FAR BY 10. 
      LDB FINTA     *1
      ADB B         *2
      ADB B         *4
      ADB FINTA     *5
      ADB B         *10 
      ADA B         ADD THAT TO CURRENT DIGIT.
      LDB A         LIMIT VALUE TO 16383. 
      ADB B         BY DOUBLING THE FINAL VALUE IN (B). 
      SOS           DID IT FIT ?
      JMP FINT1     YES. LOOP.
      JMP ERR1      NO. ERROR.
* 
GOTIT CCB           BACK UP FORMAT POINTER
      ADB FCR,I 
      STB FCR,I 
      LDA FINTA     RETURN WITH 
      JMP FINTG,I   RESULT IN A 
 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.                                                   *
*                                                                  *
********************************************************************
RFCHX ISZ RF,I      CHECK REPEAT.  IF RF GOES TO ZERO,
      JMP RFCHK,I     CONTROL FALLS THROUGH TO FORMT. 
FORMT CLA,INA       SET DBLNK FOR SKIPPING. 
      STA DBLNK 
      STA GFLAG,I 
      LDA "E" 
      STA EORD,I
      LDB TSCAL,I   SCALE FACTOR
      CMB,INB 
      STB SCALE,I 
      CCA 
FORM1 STA RF,I      SET REPEAT FIELD AT ONE.
* 
*                   GET FORMAT CHARACTER AND GO TO APPROPRIATE ROUTINE. 
* 
FORM2 JSB FCHAR     GET THE CHARACTER AND TEST IT 
      ADA _"Y"      -"Y"
      SSA,RSS       >X ?
      JMP FORM3     YES.
      ADA "Y_@"     +"Y"-"@"
      SSA           <@ ?
      JMP FORM3     YES.
      ADA FMTBL     IN [@,X], USE JUMP TABLE. 
      LDA A,I       A = ADDR ROUTINE TO HANDLE CHAR.
      JMP A,I 
      SKP 
FORM3 ADA "@_&"     +"@"-"&"
      CPA MIN4      " 
      JMP QTYPE 
      CPA ....1     ' 
      JMP QTYPE 
      CPA ....2     ( 
      JMP LPTYP 
      CPA ....3     ) 
      JMP RPTYP 
      CPA ....6     , 
      JMP FORM2 
      CPA ....7     - 
      JMP MTYPE 
      CPA ....9     / 
      JMP INOUT 
      ADA "&"       RESTORE ORIGINAL CHAR.
      JSB FINTG     LAST CHANCE: NUMBER 
      JMP ERR3
      CMA,INA,SZA,RSS 
      JMP STRNP 
      JMP FORM1 
* 
*                   JUMP TABLE FOR FORMAT CHARACTERS "@" THRU "X".
* 
FMTBL DEF *+1 
      DEF OTYPE     @ 
      DEF ATYPE     A 
      DEF ERR3      B 
      DEF ERR3      C 
      DEF DTYPE     D 
      DEF ETYPE     E 
      DEF FTYPE     F 
      DEF GTYPE     G 
      DEF HTYPE     H 
      DEF ITYPE     I 
      DEF ERR3      J 
      DEF OTYPE     K 
      DEF LTYPE     L 
      DEF ERR3      M 
      DEF ERR3      N 
      DEF OTYPE     O 
      DEF PTYPE     P 
      DEF ERR3      Q 
      DEF RTYPE     R 
      DEF ERR3      S 
      DEF TTYPE     T 
      DEF ERR3      U 
      DEF ERR3      V 
      DEF ERR3      W 
      DEF XTYPE     X 
      HED P, X & H SPECIFICATIONS.
***************************************** 
*                                       * 
* FOLLOWING ARE THE CONVERSION ROUTINES * 
*                                       * 
***************************************** 
      SPC 3 
MTYPE JSB FCHAR    GET NEGATIVE SCALE FACTOR. 
      JSB FINTG     TEST FOR NUMBER 
      JMP ERR1      NOT A DIGIT 
STRNP STA TSCAL,I 
      JSB FCHAR    MAKE SURE NEXT 
      CPA "P"       CHARACTER IS P. 
      JMP FORMT 
      JMP ERR3     TOO BAD. 
* 
PTYPE LDA RF,I
      STA TSCAL,I 
      JMP FORMT 
      SPC 3 
**********************************
*     HTYPE HANDLES H-CONVERSION *
**********************************
HTYPE CLA           SET FOR NO
      STA DBLNK      SKIPPING 
HLOOP LDB IO,I      WHICH WAY?
      SZB,RSS 
      JMP HOUT      OUT 
      JSB INCHR     IN
      ISZ FCR,I          ADVANCE FORMAT COUNTER 
      LDB FCR,I 
      JSB .SBT      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 T SPECIFICATION.
TTYPE JSB FCHAR     GET DIGIT, L OR R.
      CPA "R"       R ? 
      JMP TR1       YES.
      LDB BCR,I     NO. B = (ADDR CURRENT COLUMN)-1 
      CMB           -(ADDR CUR COL) 
      ADB .OBUF,I   -(ADDR CUR COL)+(ADDR COL 1)/2
      ADB .OBUF,I   -(ADDR CUR COL)+(ADDR COL 1)
      ADB MIN1      -(CURRENT COL #)
      STB TTYPA 
      CPA "L"       L ? 
      JMP TL1       YES.
* 
*                   T-FORMAT.  CONVERT TO RELATIVE TAB. 
* 
      JSB FINTG     NUMBER ?
      JMP ERR3      NO, ERROR.
      ADA TTYPA     M = REL TAB = N-(CUR COL #) 
      SSA,RSS       WHICH WAY ? 
      JMP TR2       RIGHT.  M >= 0. 
      CMA,INA       LEFT.  TL GETS -M > 0.
      JMP TL2 
* 
*                   TL-FORMAT.  IF NEW COL < 1, SET TO 1. 
* 
TL1   JSB FCHAR     GET AMOUNT TO GO LEFT. (-M) 
      JSB FINTG 
      JMP ERR3      IF NO NUMBER. 
TL2   STA B         CHECK IF COL < 1 (INCLUDES T0)
      ADB TTYPA     -(NEW COL)
      CMA,INA       M 
      SSB,INB,RSS   NEW COL > 0 ? 
      ADA B         NO, M = 1 - (CURRENT COL) 
      LDB CCNT,I    SEE IF OLD POSITION WAS MAX REACHED.
      CMB,CLE,INB   -CCNT 
      ADB CMAX,I    CMAX-CCNT  (E=0 IFF B<0)
      LDB CCNT,I    TO SET NEW MAX. 
      SEZ,RSS       IS CCNT > CMAX ?
      STB CMAX,I    YES, SET NEW MAX COLUMN.
TL3   STA B         UPDATE BCR & CCNT.
      ADB CCNT,I
      ADA BCR,I 
      STA BCR,I 
      STB CCNT,I
      JMP FORMT     DONE. 
      SKP 
*                   TR-FORMAT.  IF NEW COL > LAST COL, SET TO LAST+1. 
* 
XTYPE LDA RF,I      X FORMAT: CHANGE NX TO TRN. 
      CMA,INA 
      JMP TR2 
TR1   JSB FCHAR     GET AMOUNT TO GO RIGHT. 
      JSB FINTG 
      JMP ERR3      IF NOT A NUMBER.
TR2   STA B         M 
      ADB CCNT,I    CCNT+M. 
      SSB           SHOULD BE < 0.
      JMP TR3       IS, O.K.
      LDA CCNT,I
      CMA           M = -CCNT-1 
TR3   LDB IO,I      IN OR OUT ? 
      SZB 
      JMP TL3       IN. 
      STA B         OUT.  B=M.  SEE IF OLD POS > OLD MAX. 
      LDA CCNT,I
      CMA,INA       -OLD POS. 
      ADA CMAX,I    CMAX-CCNT 
      SSA           CCNT > CMAX ? (NOW AT MAX ?)
      JMP TR4       YES.  JUST OUTPUT SPACES. 
      LDA B         A=B=M.  IS NEW POS > OLD MAX ?
      ADB CCNT,I    NEW CCNT. 
      CMB,INB       -CCNT.
      ADB CMAX,I    CMAX-CCNT 
      SSB,RSS       CCNT > CMAX ? 
      JMP TL3       NO, JUST POSITION TO NEW POSITION.
      ADA B         YES.  A = AMNT TO ADVANCE TO GET TO CMAX. 
      ADA BCR,I     ADVANCE TO CMAX.
      STA BCR,I 
      LDA CMAX,I
      STA CCNT,I
      CMB,INB       OUTPUT EXCESS SPACES. 
TR4   LDA BLANK 
      JSB MTPLO 
      JMP FORMT 
      HED SLASH & L SPECIFICATIONS. 
*                   INOUT HANDLES THE SLASH IN A FORMAT.
* 
INOUT JSB DTA 
      JSB RFCHK 
      JMP INOUT 
      SPC 4 
LTYPE CLA 
      JSB WGET
LLOOP JSB F2LST     GET LIST ITEM.
      JSB WSET      SET UP W. 
      LDB IO,I      WHICH WAY?
      SZB,RSS 
      JMP LOUT
LIN   JSB INCHR     SKIP BLANKS UNTIL 
      CPA BLANK      FIND A T OR F. 
      JMP NEXTC       IF RUN OUT OF FIELD, ERROR 4. 
      CLB,INB       B<0> = NOT FOUND FLAG.
      CPA "T" 
      LDB NEG1      IF TRUE, MANT = 100000B 
      CPA "F" 
      CLB 
      SLB           FOUND ONE ? 
      JMP ERR5      NO, ERROR.
      STB ADX,I     YES, STORE RESULT.
      JMP *+2       SKIP REST OF FIELD. 
      JSB INCHR 
      ISZ W 
      JMP *-2 
LTYP1 JSB RFCHK     CHECK FOR REPEATS 
      JMP LLOOP 
* 
NEXTC ISZ W 
      JMP LIN 
      JMP ERR5
      SPC 2 
LOUT  LDA BLANK     OUTPUT W-1 LEADING BLANKS.
      LDB W 
      CMB 
      JSB MTPLO 
      LDB ADX,I     OUTPUT "T" OR "F" 
      LDA "T"       "T" IF SIGN BIT SET.
      SSB,RSS 
      LDA "F"       "F" IF NOT. 
      JSB OUTCR 
      JMP LTYP1 
      HED A & R SPECIFICATIONS. 
ATYPE CCB           A: ATMP=-1. 
      LDA OFLAG,I   OLD ? 
      SSA           SKIP IF NOT.
RTYPE CLB           R, OLD A: ATMP=0. 
      STB ATMP,I
      CLA           GET W 
      JSB WGET
ALOOP JSB F2LST     GET LIST ITEM.
      JSB WSET      SET W.
      LDA ADX       FORM BYTE ADDR OF VARIABLE. 
      RAL 
      STA ATYPA 
      LDB LENTH,I   # WDS DATA. 
      BLS           # CHARS DATA. 
      ADB W         # CHARS - W 
      STB ATYPB 
      LDA IO,I      IN OR OUT ? 
      SZA,RSS 
      JMP AOUT      OUT.
* 
*                   A&R INPUT.
* 
AIN   SSB           W > # CHARS DATA.  (EXCESS DATA) ?
      JMP AIN1      YES.
      LDA ATMP,I    NO. EXACT OR TOO LITTLE DATA.  (B=DIFF) 
      SZA,RSS       R-FORMAT ?   (IF SO, A=0 FOR ABLKS) 
      JSB ABLKS     YES, SUPPLY LEADING BINARY ZEROES.
      JMP AIN3      (ATYPB=0 NOW FOR R-FORMAT)
AIN1  STB ATYPB     - # CHARS EXCESS. 
AIN2  JSB INCHR     SKIP THEM.
      ISZ W         (CAN'T GO TO ZERO)
      ISZ ATYPB 
      JMP AIN2      (ATYPB=0 WHEN DONE) 
AIN3  JSB INCHR     COPY W CHARS. 
      LDB ATYPA 
      JSB .SBT
      STB ATYPA 
      ISZ W 
      JMP AIN3      LOOP. 
      LDA BLANK     SUPPLY TRAILING BLANKS, IF ANY. 
      LDB ATYPB 
      JSB ABLKS 
ATYP1 JSB RFCHK     REPEAT ?
      JMP ALOOP     YES.
      SKP 
*                   A&R OUTPUT. 
* 
AOUT  SSB           W VS # CHARS DATA.
      JMP AOUT1     W > # CHARS.
      ADB ATYPA     W <= # CHARS.  SKIP CHARS IN DATA.
      LDA ATMP,I    BUT ONLY IF R FORMAT. 
      SSA,RSS 
      STB ATYPA 
      JMP AOUT2 
AOUT1 CMB,INB       B = AMOUNT W EXCEEDS DATA.
      LDA BLANK     OUTPUT THAT MANY BLANKS.
      JSB MTPLO 
AOUT2 LDB ATYPA     COPY W CHARS TO OUTPUT. 
      JSB .LBT
      STB ATYPA 
      JSB OUTCR 
      ISZ W 
      JMP AOUT2     LOOP. 
      JMP ATYP1     GO CHECK REPEATS. 
      SPC 3 
*                   ROUTINE TO PUT -B- COPIES OF A<7:0> 
*                   INTO A/R VARIABLE, B >= 0.
* 
ABLKX CMB,INB,SZB,RSS -COUNT.  ZERO ? 
      JMP ABLKS,I   YES, DONE.
      STB ATYPB     (WILL BE ZERO NEXT TIME)
      LDB ATYPA 
ABLK1 JSB .SBT
      ISZ ATYPB 
      JMP ABLK1 
      STB ATYPA 
      JMP ABLKS,I 
      HED @, K & O SPECIFICATIONS.
*                   OTYPE HANDLES @ SPECIFICATIONS *
* 
OTYPE CLA       GET 
      JSB WGET      THE  W-FIELD
OLOOP JSB F2LST     GET A LIST ITEM.
      JSB WSET      SET W.
      LDB IO,I      IN/OUT SWITCH 
      SZB,RSS 
      JMP OCOUT 
* 
*                   INPUT.
* 
      CLA        INITIALIZE TO
      STA ADX,I      ZERO 
OCT1  JSB INCHR      GET A CHARACTER
      STA B        SAVE IN B
      IOR ....7   TEST FOR OCTAL DIGIT
      CPA "7" 
      JMP OCT2       IT IS ONE
OCT3  ISZ W         END OF THIS INPUT ? 
      JMP OCT1       NOPE 
OCT6  JSB RFCHK     CHECK FOR REPEATS 
      JMP OLOOP 
* ADD NEW DIGIT IN *
OCT2  LDA B       GET OCTAL DIGIT BACK IN A 
      AND ....7   REMOVE ASCII BITS 
      LDB ADX,I      REPOSITION PREVIOUS RESULT.
      BLF,RBR 
      ADA B      ADD TO NEW DIGIT 
      STA ADX,I     PUT IT BACK.
      JMP OCT3
* 
*                   OUTPUT. 
* 
OCOUT LDA BLANK 
      LDB W         IS W GEQ -6 ? 
      ADB ....6 
      SSB 
      JMP OCT4     NO---OUTPUT A BLANK
      LDA ADX,I     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 "0"       ASCII BITS
OCT4  JSB OUTCR      THERE IT GOES
      ISZ W         END OF VALUE ?
      JMP OCOUT 
      JMP OCT6
      HED " AND ' SPECIFICATIONS. 
**********************************
*     QTYPE HANDLES "-CONVERSION *
**********************************
QTYPE ADA "&"       RESTORE " OR '
      STA QTYPA     REMEMBER WHICH. 
      CLA           SET FOR NO
      STA DBLNK      SKIPPING 
      LDA FCR,I     SAVE FCR FOR
      STA QTYPB     REPEATS 
QLOOP JSB FCHAR     GET FORMAT CHARACTER
      CPA QTYPA     CHECK FOR SAME KIND OF QUOTE. 
      JMP QUOT1     JMP FOR SPECIAL HANDLIG 
      LDB IO,I      WHICH WAY?
      SZB,RSS 
      JMP *+3 
      JSB INCHR 
      JMP QLOOP 
      JSB OUTCR 
      JMP QLOOP 
QUOT1 JSB RFCHK     CHECK THE REPEAT COUNT
      LDA QTYPB     RESTORE FCR 
      STA FCR,I         AND 
      JMP QLOOP         LOOP
      SPC 4 
********************************************************************
* LPTYP AND RPTYP HANDLE THE PARENTHESIS MANIPULATION              *
*     LPRN CONTAINS ADDRESS OF LEFT PARENTHESIS.                   *
*     RFSV CONTAINS INITIAL VALUE OF REPEAT FIELD FOR THE GROUP.   *
*     RFLD CONTAINS CURRENT VALUE OF REPEAT FIELD.                 *
*     THESE 5-WORD ARRAYS ARE INDEXED BY THE CURRENT VALUE OF NEST.*
*     THE ORDER OF THE ARRAYS IS : RFLD,RFSV,LPRN.                 *
********************************************************************
* 
LPTYP ISZ NEST,I    ADVANCE DEPTH COUNTER 
      JMP *+2 
      JMP ERR2      TOO DEEP, GAS IT. 
      LDA NEST,I
      LDB A 
      ADA ....3     IF NEST = -5 OR -4, 
      SSA 
      STB RNEST,I    STORE FOR UNLIMITED GROUPS 
      ADB ADRFD,I   CONTAINS INDEXED ADDRESS
      ADB ...10 
      LDA FCR,I      OF LPRN. 
      STA B,I       STORE FORMAT LOC. OF LEFT PAREN.
      ADB MIN5      NOW IN RFSV.
      LDA RF,I
      STA B,I       STORE REPEAT FIELD IN RFSV
STRF  ADB  MIN5 
      STA B,I         AND IN RFLD.
      JMP FORMT 
      HED PARENTHESIS MANIPULATION. 
RPTYP LDA NEST,I
      ADA ....5     OUTER PAREN? (NEST=-5)
      SZA,RSS 
      JMP LASTP       YES.
      SSA             NO.  NEST <-5 ? 
      JMP ERR2          YES. GAS IT.
      LDB NEST,I         NO.
      ADB ADRFD,I   B CONTAINS INDEXED ADD. IN RFLD.
      ISZ B,I       CHECK CURRENT VALUE OF REPEAT FD
      JMP STFCR       STILL MORE REPEATS. 
      LDA NEST,I     REPEAT FIELD EXHAUSTED 
      ADA MIN1
      STA NEST,I    DECREMENT NEST BY 1.
      ADB ....5     NOW B IN RFSV.
      LDA B,I       RESTORE REPEAT
      JMP STRF        FIELD AND EXIT. 
STFCR ADB ...10     MORE REPEATS. B IN LPRN.
      LDA B,I       RESET FCR TO
      STA FCR,I      LEFT PAREN LOC.
      JMP FORMT 
LASTP LDA ADX       REMEMBER IF WE USED ANY LIST ITEMS. 
      STA DTA 
      JSB F2LST     RETURN TO CALLING SEQ.
      LDA DTA       LIST ITEMS BUT NO CONVERSION SPECS ?
      SSA 
      JMP ERR3
      JSB DTA       IF WE GET BACK, UNLIMITED GROUP.
      CCA             I/O THE RECORD AND AVOID
      STA SKIPL,I    A SPURIOUS RETURN TO CALLER
      STA ADX       NOTE NO CONVERSIONS SO FAR. 
      LDB RNEST,I 
      STB NEST,I    RESET NEST
      ADB ADRFD,I 
      JMP STFCR     SET FCR, EXIT.
      HED MANIPULATION OF W & D.
********************************************************************
*                                                                  *
* FOLLOWING ARE SOME UTILITY ROUTINES FOR OBTAINING THE W AND D    *
* FIELDS, AND DOING A FEW OTHER LITTLE THINGS.                     *
*                                                                  *
********************************************************************
WGEX  STA SIGN      SAVE LENGTH OF EXPONENT FIELD.
      JSB FCHAR     GET NUMBER IN FORMAT. 
      JSB FINTG 
      JMP ERR1      NOT A DIGIT!! 
      CMA,INA       NEGATE. 
      ADA SIGN      =4 FOR E AND G TYPE, 0 OTHERWISE
      SSA,RSS       IF NOT NEGATIVE THEN
      JMP ERR1      TAKE GAS. 
      STA WSAVE,I 
      JMP WGET,I
      SPC 3 
WSEX  LDA WSAVE,I   RESTORES W. 
      STA W 
      JMP WSET,I
      SPC 3 
WDFIZ LDA DSAVE,I   INIT W AND D. A=POS D.
      CMA           A=-D-1. 
WDFX1 STA D         SET D TO INCLUDE POINT
      LDB SIGN      SIGN. 
      CMB,INB       -SIGN.
      ADB WSAVE,I   -W-SIGN.
      STB W         SET UP W. 
      CMB,INB       W+SIGN. 
      ADA B         W-D-1+SIGN. 
      STA BCNT      NUMBER OF LEADING BLANKS. 
      SSA,RSS       <0 ?
      JMP WDFIX,I   NO, DONE. 
      LDA W         YES, SET D=W. 
      JMP WDFX1 
      SPC 3 
WDGEX JSB WGET      GETS W AND W. FIRST W.
      JSB FCHAR     MAKE SURE NEXT CHARACTER
      CPA "."       IS A DECIMAL POINT. 
      JMP *+2       IT IS...OK
      JMP ERR1      IT'S NOT...TOO BAD
      JSB FCHAR     COMPUTE NEXT NUMBER IN FORMAT 
      JSB FINTG     TEST FOR DIGIT
      JMP ERR1      NOT A DIGIT!! 
      STA DSAVE,I   SET D.
      JMP WDGET,I 
      HED SCALING AND CONVERSION ROUTINES.
*     NORML - MANTISSA NORMALIZATION. 
*        THE MANTISSA AND EXPONENT ARE ADJUSTED SO THAT THEY
*        CONTAIN A NORMALIZED VALUE.  IT IS ASSUMED THAT THE
*        INITIAL STATE IS NOT UNNORMLIZED BY MORE THAN 31 BITS. 
* 
NORMX LDB MANT      SEE IF NORMALIZED.
      LDA MANT+1
      ASL 1 
      SOC 
      JMP NORML,I   YES, DONE.
      ASL 15        NO, SEE IF WORD SHIFT.
      SOC 
      JMP NORM1     NO. 
      SZB,RSS       YES, IS SECOND WORD ZERO TOO ?
      JMP NORM3     YES, IS ZERO. 
      STB MANT      NO, DO WORD SHIFT.
      LDB MANT+2
      STB MANT+1
      LDB MANT+3
      STB MANT+2
      LDB MANT+4
      STB MANT+3
      STA MANT+4
      LDA EXP       ADJUST EXPONENT 
      ADA =D-16 
      STA EXP 
NORM1 LDA MANT      DETERMINE BIT SHIFT.
      JSB FLOAT     B = 30 - 2*SHIFT
      BRS           B = 15-SHIFT
      ADB =D-15     B = -SHIFT
      LDA B         SAVE SHIFT COUNT
      CMA,INA,SZA,RSS A = SHIFT.  IS IT ZERO ?
      JMP NORML,I   YES, DONE.
      ADB EXP       ADJUST EXPONENT.
      STB EXP 
      IOR RRL16     SET UP SHIFT. 
      STA XEQ+1 
      LDA AMANT     SET UP BIT NORMALIZE LOOP.
      STA NORMA 
      LDA MIN4
      STA NORMB 
NORM2 DLD NORMA,I   WORD PAIR.
      JSB XEQ       LEFT SHIFT. 
      STA NORMA,I   NEW FIRST WORD OF PAIR. 
      ISZ NORMA     BUMP ADDR.
      ISZ NORMB     BUMP COUNT. 
      JMP NORM2     IF MORE.
      JMP NORML,I   EXIT. 
NORM3 STB EXP       ZERO, SET EXPONENT ZERO TOO.
      JMP NORML,I 
      SKP 
*     PTEN - SCALE NUMBER BY A POWER OF TEN.
* 
*     PTEN MULTIPLIES THE VALUE IN (MANT...MANT2) AND (EXP) 
*     BY 10**(A).  NO CHECK IS MADE FOR OVERFLOW/UNDERFLOW. 
* 
*     CALLING SEQUENCE: 
*                   LDA POWER 
*                   JSB PTEN
      SPC 2 
PTENX LDB AMANT     SET UP MANTISSA POINTERS. 
      STB MANTP 
      LDB TYPE,I
      SZB 
      CPB ....1 
      ADB ....2     IF TYPE<2, USE EXTRA WORD.
      ADB MIN1      # WORDS PRECISION TO USE - 1
      ADB MANTP     LWA USED MANTISSA 
      STB MANTL 
      SZA,RSS       IF N=0, LEAVE ALONE.
      JMP PTEN,I
      SSA,RSS       N>0 ? 
      JMP PTEN1     YES.
      CMA,INA       NO, TAKE IABS(N)
      STA PTENA 
      LDA ....2     RIGHT SHIFT MANTISSA TWO BITS.
      JSB RSN 
      LDB DIVDZ     SET "DIVIDE"
      JMP PTEN2 
PTEN1 LDB MULTZ     SET "MULTIPLY"
      STA PTENA     PTENA = IABS(N) 
PTEN2 STB PTENB     PTENB = ADDR MULT OR DIVD 
PTEN3 LDA PTENA     A=N 
      ADA MIN6      N-6 
      CLE,SSA       N<6 ?   (E=0 FOR MULT)
      JMP PTEN4     YES, GO DO LAST ONE.
      STA PTENA     NO, MULT/DIV BY 10**6 
      LDA PWR1A+10
      LDB PWR1A+11
      JSB PTENB,I 
      JMP PTEN3     TRY AGAIN.
PTEN4 ADA ....5     A = N-1 
      RAL,CLE,SLA   N=0 ? 
      JMP PTEN5     YES, GO NORMALIZE.
      ADA PWR10     GET POWER OF TEN. (E=0 FOR MULT.) 
      DLD A,I 
      JSB PTENB,I   GO MPY DIV USING IT.
PTEN5 LDB MANT      NORMALIZE.
      ASL 1 
      SOC           THERE ? 
      JMP PTEN,I    YES.
      JSB LSONE     NO, LEFT SHIFT. 
      JMP PTEN5     AND TRY AGAIN.
      SKP 
*     POWER OF TEN TABLE.  FIRST PART IS (10**I)/2, I=1,2,3.  SECOND
*     PART IS IDENTICAL TO 2-WORD FLOATING EXCEPT THE SECOND WORD HAS 
*     BEEN RIGHT SHIFTED ONE BIT.  VALUES ARE 1O**I FOR I=1,6.
      SPC 1 
.5000 DEC 5000
PWR10 DEF PWR1A     BASE ADDRESS. 
....5 DEC 5 
      DEC 50
      DEC 500 
PWR1A DEC 20480     10**1 
....4 DEC 4 
      DEC 25600     10**2 
....7 DEC 7 
      DEC 32000,10  10**3 
      DEC 20000,14  10**4 
      DEC 25000,17  10**5 
      DEC 31250,20  10**6 
      SPC 3 
*     INDIG - ADD INPUT DIGIT TO NUMBER.
* 
*     INDIG TAKES AN INPUT DIGIT AND COMBINES IT WITH THE 
*     RUNNING MANTISSA.  THE RUNNING MANTISSA IS NOT IN A 
*     USABLE FORM UNIL A TERMINAION CALL IS MADE.  THE
*     MANTISSA IS THEN USABLE BUT MAY NOT BE NORMALIZED.
* 
*     CALLING SEQUENCE: 
* 
*                   LDA <DIGIT> 
*                   JSB INDIG 
* 
*     A TERMINATION CALL IS SIGNALLED BY <DIGIT> NEGATIVE.
*     ANY TRAILING ZEROES OR DIGITS AFTER THE LIMIT (20)
*     AFFECT ONLY THE TRAILING ZERO COUNT IN "INPUD". 
      SPC 1 
*                   CHECK FOR ZERO, EXTRA DIGIT OR TERMINATION. 
* 
INDIX STA INDIA     SAVE DIGIT. 
      SSA           TERMINATION CALL ?
      JMP INDI7     YES.
INDI1 LDB MANTL     NO. AT LIMIT ?
      SZA           OR ZERO DIGIT ? 
      CPB MANTE 
      JMP INDI6     YES, JUST COUNT IT. 
* 
*                   GOOD DIGIT.  ADD IT OR A SKIPPED ZERO.
* 
      LDA INPUA     NO. GOOD DIGIT. MULTIPLY OTHERS BY 10.
      ALS,ALS 
      ADA INPUA 
      ALS 
      LDB INPUD     ANY UNUSED ZEROES ? 
      SZB,RSS       IF SO, ADD THEM FIRST.
      ADA INDIA     IF NOT, ADD THIS DIGIT. 
      STA INPUA 
      ISZ INPUB     COUNT DIGITS.  FULL GROUP OF 4 ?
      JMP INDI5     NO. 
      LDA .5000     YES, ADD THEM.
INDI2 LDB =D-16     MAKE ROOM.
      CMB,CCE,INB   B=16, E=1.
      JSB MULT
      LDB MANTL     ADD DIGIT(S)
      ISZ MANTL 
      LDA B,I 
      CLE 
      ADA INPUA 
      STA B,I 
      CCA,SEZ,RSS   CARRY ? 
      JMP INDI4     NO. 
INDI3 ADB A         PROPOGATE IT. 
      ISZ B,I 
      JMP INDI4 
      JMP INDI3 
INDI4 LDA MIN4      RESET COUNT.
      STA INPUB 
      CLA           RESET DIGITS. 
      STA INPUA 
      LDB INPUD     RELOAD TRAILING ZERO COUNT. 
* 
*                   IF JUST PROCESSED A SKIPPED ZERO, DO ANOTHER DIGIT. 
* 
INDI5 LDA INDIA     WAS IT A TERMINATION CALL ? 
      SSA,RSS 
      SZB,RSS       OR NO TRAILING ZEROES ? 
      JMP INDIG,I   YES, DONE WITH THIS DIGIT.
      ADB MIN1      IT WAS A SKIPPED ZERO.  DECREMENT COUNT.
      STB INPUD 
      JMP INDI1     TRY AGAIN.
* 
*                   ZERO, EXTRA DIGIT & TERMINATION PROCESSING. 
* 
INDI6 LDA INPUA     ZERO OR EXTRA DIGIT.  LEADING ZERO ?
      ADA EXP       (IF SO, EXP=-1 AND INPUA=0) 
      SSA,RSS 
      ISZ INPUD     NO, TRAILING DIGIT, COUNT IT. 
      JMP INDIG,I   DONE WITH THIS ONE. 
INDI7 LDA INPUB     ANY UNUSED DIGITS ? 
      CPA MIN4
      JMP INDIG,I   NO, DONE. 
      ADA PWR10     YES. ADD THEM.
      LDA A,I 
      JMP INDI2 
      SKP 
*     GETDG - EXTRACT DIGITS FOR OUTPUT.
* 
*     GETDG EXTRACTS DIGITS FROM THE MANTISSA AND RETURNS THEM
*     FOR OUTPUT PURPOSES.  ONLY (SGCNT) DIGITS WILL BE RETURNED, 
*     ANY AFTER THAT ARE 0 OR 9 AS REQUIRED TO PRODUCE THE CORRECT
*     ROUNDING.  LESS PRECISION IS USED AS DIGITS ARE GENERATED.
      SPC 2 
GETDX LDA GETDA     TOO MANY DIGITS ? 
      CLE,SSA,RSS 
      JMP NOSIG     YES, SEND ROUNDING DIGIT. 
      ISZ GETDC     ANY DIGITS LEFT ? 
      JMP GETD1     YES, GET ONE. 
      LDA .5000     NO, GENERATE 4 MORE.
      JSB MULT
      ISZ MANTP     THEY'RE IN THE NEXT WORD. 
      LDA MIN4
      STA GETDC 
GETD1 LDA GETDC     A = - # DIGITS IN WORD. 
      ADA GETDZ     GET POWER OF TEN FOR EXTRACTING DIGIT.
      STA GETDB 
      LDA MANTP,I   DIGITS. 
      CLB 
      DIV GETDB,I   A = NEW DIGIT, B = REST.
      STB MANTP,I 
      ISZ GETDA     IS THIS FIRST AFTER LAST VALID DIGIT ?
      JMP GETDG,I   NO. 
      LDB ....9     YES. IF .GE. 5, RETURN NINES NOW. 
      ADA MIN5
      SSA 
      CLB           ELSE RETURN ZEROES. 
      STB GETDC 
NOSIG LDA GETDC     RETURN ROUNDING DIGIT (0 OR 9)
      JMP GETDG,I 
      SPC 2 
.1000 DEC 1000
      DEC 100 
...10 DEC 10
....1 DEC 1 
GETDZ DEF * 
      SKP 
*     RSN - LOGICAL RIGHT SHIFT MANTISSA BY N BITS, N IN [1,15].
* 
RSNX  LDB A         ADJUST EXPONENT.
      ADB EXP 
      STB EXP 
      IOR RRR16     SET UP SHIFT INSTRUCTION. 
      STA XEQ+1 
      LDA MANT+2    SHIFT.
      LDB MANT+3
      JSB XEQ 
      STB MANT+3
      LDA MANT+1
      LDB MANT+2
      JSB XEQ 
      STB MANT+2
      LDA MANT
      LDB MANT+1
      JSB XEQ 
      STB MANT+1
      CLA 
      LDB MANT
      JSB XEQ 
      STB MANT
      JMP RSN,I     EXIT
      SPC 4 
*     LSONE - LOGICAL LEFT SHIFT MANTISSA ONE BIT.
* 
LSONX LDA MANT+3    SHIFT.
      CLE,ELA 
      STA MANT+3
      LDA MANT+2
      ELA 
      STA MANT+2
      LDA MANT+1
      ELA 
      STA MANT+1
      LDA MANT
      ELA 
      STA MANT
      CCA           ADJUST EXP
      ADA EXP 
      STA EXP 
      JMP LSONE,I 
      SKP 
*     .XCOM - NEGATE MANTISSA / ROUND RESULT. 
* 
*     IF B=-1 THE MANTISSA IS NEGATED ELSE IT IS ROUNDED USING
*     B+1 AS THE ROUND CONSTANT.  WHEN ROUNDING, THE LOCATION 
*     INPUA IS SET TO THE ADDRESS OF THE LAST WORD. 
      SPC 2 
XCOMX INB,SZB       NEGATE OR ROUND ? 
      JMP XCOM1     ROUND, DON'T COMPLEMENT.
      LDA MANT      COMPLEMENT MANTISSA.
      CMA 
      STA MANT
      LDA MANT+1
      CMA 
      STA MANT+1
      LDA MANT+2
      CMA 
      STA MANT+2
      LDA MANT+3
      CMA 
      STA MANT+3
      LDA AMNT3     ADDR WORD TO START INCR.
      JMP XCOM2 
XCOM1 CCA           FORM ADDR LAST WORD.
      ADA LENTH,I 
      ADA AMANT 
      STA INPUA     SPECIAL: SET UP FOR INPUT.
XCOM2 CLE,INB 
      ADB A,I       ADD ROUND CONSTANT. 
XCOM3 STB A,I 
      SEZ,RSS       CARRY ? 
      JMP .XCOM,I   NO, DONE. 
      ADA MIN1      YES, PROPOGATE IT.
      LDB A,I 
      CLE,INB 
      CPA AMANT     AT FIRST WORD ? 
      JMP *+2 
      JMP XCOM3     NO, KEEP GOING. 
      STB MANT      STORE FIRST WORD. 
      CLA,INA       A=1.
      CPB NEG1      OVERFLOW ?
      JMP XCOM4     YES.
      ASL 1         NEG UNNORM ?
      SOC 
      JMP .XCOM,I   NO, DONE. 
      CCA,RSS       YES. B = NEW FIRST WD.  DECR EXP. 
XCOM4 RBR           OFL.  R.S. & INCR EXP. (A=1)
      STB MANT
      ADA EXP 
      STA EXP 
      JMP .XCOM,I 
      SKP 
*     MULT - MULTIPLY THE MANTISSA BY A SCALAR. 
* 
*     MULT MULTIPLIES THE MANTISSA BY A 15-BIT SCALAR AND ADJUSTS THE 
*     EXPONENT.  THE RESULT IS AS IF AN INTEGER MULTIPLY OF THE MANTISSA
*     AND SCALAR WERE DONE FOLLOWED BY A RIGHT SHIFT 15.  THE RESULT
*     WILL NOT OVERFLOW BUT IT MAY BECOME UNNORMALIZED. 
* 
*     CALLING SEQUENCE: 
* 
*                   CLE/CCE      LAST WORD FLAG.
*                   LDA SCALAR   MULTIPLIER.
*                   LDB N        EXPONENT ADJUSTMENT. 
*                   JSB MULT
* 
*     WHERE E=1 INDICATES THAT THE LAST WORD OF THE CURRENT 
*     MANTISSA IS ZERO.  (INPUT CONVERSION).  FOR THIS
*     CASE, THE EXPONENT ADJUSTMENT MUST NOT CARRY OUT. 
      SPC 2 
MULTX STA MULTA     SAVE MULTIPLIER.
      RAL           AND 2*MULTIPLIER. 
      STA MULTD 
      CME           E=0 IFF INPUT 
      ADB EXP       ADJUST EXPONENT 
      STB EXP 
      LDB MANTL     CURRENT WORD ADDR 
      SEZ,RSS       INPUT ? 
      JMP MULT3     YES, SKIP FIRST MPY 
      STB MULTB 
      RAR           RESTORE MULTIPLIER. 
      MPY B,I 
      ASL 1 
      JMP MULT2 
MULT1 LDA MULTA     MULTIPLIER. 
      MPY B,I       * CURRENT WORD. 
      CLE,ELA       ALIGN.
      ELB,CLE 
      ADA MULTC,I   ADD LOWER TO CURRENT + 1
      STA MULTC,I 
      SEZ           PROPOGATE CARRY.
      INB 
MULT2 LDA MULTB,I   CORRECT FOR BIT 15. 
      SSA 
      ADB MULTD 
      STB MULTB,I 
      LDB MULTB     SEE IF DONE.
MULT3 CPB MANTP     I.E., IS CURRENT WORD THE START ? 
      JMP MULT,I    YES, DONE.
      STB MULTC     NO, UPDATE POINTERS.
      ADB MIN1
      STB MULTB 
      JMP MULT1     AND LOOP. 
      SKP 
*     DIVD - DIVIDE MANTISSA BY A SCALAR. 
* 
*     DIVD DIVIDES THE MANTISSA BY A SCALAR AND ADJUSTS THE 
*     EXPONENT ACCORDINGLY.  THE EFFECT IS AS IF THE TWO WERE 
*     INTEGERS AND THE DIVIDE WERE DONE, KEEPING 15 FRACTION
*     BITS, FOLLOWED BY A LEFT SHIFT 15.
*     OVERFLOW CAN OCCUR ONLY IF THE MANTISSA IS NORMALIZED 
*     OR THE DIVISOR IS LESS THAN 2**14.
* 
*     CALLING SEQUENCE: 
* 
*                   LDA SCALAR      15-BIT DIVISOR. 
*                   LDB N           EXPONENT ADJUSTMENT.
*                   JSB DIVD
      SPC 4 
DIVDX STA DIVDA     SAVE DIVISOR. 
      ARS           SAVE DIVISOR/2. 
      STA DIVDD 
      CMB,INB       CORRECT EXPONENT. 
      ADB EXP 
      STB EXP 
      LDA MANTP     SET UP POINTERS.
      STA DIVDB 
      STA DIVDC 
      LDB A,I       B = FIRST WORD. 
      CMA,INA       -MANTP
      ADA MANTL     MANTL-MANTP = # WDS - 1 
      CMA           - # WDS 
      STA DIVDE 
      CLA           BITS 15,14 FIRST WORD = 0 
      JMP DIVD2 
DIVD1 ISZ DIVDB 
      CLA           SAVE BIT 15 (IN E). 
      ELA,ELA 
      CMB           FORM REM - DIVISOR/2
      ADB DIVDD 
      CMB,CLE,SSB   POS ? 
      ADB DIVDD     NO, RESTORE REM & SET E.
      CME           SAVE BIT 14 (IN E). 
      ERA,RAR 
DIVD2 STA DIVDF     SAVE BITS 15,14.
      ISZ DIVDC 
      LDA DIVDC,I   A = NEXT WORD (LOW) 
      DIV DIVDA     DIVIDE. 
      CLE,ERA       SHIFT RIGHT, SAVE BIT 0 AS BIT 15.
      IOR DIVDF     ADD PREV BITS 15,14.
      STA DIVDB,I 
      ISZ DIVDE     DONE ?
      JMP DIVD1     NO, LOOP. 
      JMP DIVD,I    YES, EXIT.
      SKP 
*     OUTPT - SCALE NUMBER FOR OUTPUT.
* 
*     OUTPT COPIES A VARIABLE TO BE NUMERICALLY OUTPUT, PUTTING 
*     IT IN A STANDARD FORMAT (4 WORD MANTISSA, SEPARATE EXPONENT). 
*     THEN IT MULTIPLIES OR DIVIDES THE NUMBER BY A POWER OF TEN
*     TO THAT IT IS IN [1000,10000).  THE BINARY POINT IS PLACED
*     AFTER THE FIRST WORD SO THE FIRST 4 DIGITS ARE IN THAT WORD.
*     THE VALUE OF N S.T. (ORIGINAL #) * (10**(-N)) IS IN [.1,1)
*     IS STORED IN EXPON, I.E. NUMBER * 10**EXPON = ORIG NUMBER.
*     THE FOLLOWING APPROXIMATION IS USED:
* 
*  LOG10(X*(2**N)) = [((N*19729)/128)+((X*(2**15))*617)/(2**16)-290]/512
* 
*     WHERE X IS IN [0.5,1).  THE ERROR IS ALWAYS POSITIVE. 
      SPC 2 
*                   COPY NUMBER AND CONVERT IT. 
* 
OUTPX LDA AMANT     COPY THE DATA.
      STA OUTA      (MUST COPY ONLY EXACT AMOUNT TO AVOID DM) 
      LDA LENTH,I   # WORDS.
      CMA,INA 
OUTPE LDB ADX,I     COPY A WORD.
      STB OUTA,I
      ISZ ADX       BUMP SOURCE.
      ISZ OUTA      BUMP DEST.
      INA,SZA       COUNT & LOOP. 
      JMP OUTPE 
* 
      LDA TYPE,I    WHAT TYPE IS IT ? 
      ADA MIN2
      SSA,INA,RSS 
      JMP OUTPB     FLOATING. 
* 
*                   INTEGER.
* 
      SZA,RSS       INTEGER.  1 OR 2-WORD.
      JMP OUTPC     2-WORD. 
      LDA MANT      1-WORD.  FLOAT IT.
      JSB FLOAT 
      STA MANT      SET UP AS IF 2-WORD FLOATING. 
      STB MANT+1
      CLA,INA 
      JMP OUTPB 
OUTPC STA MANT+2    2-WORD.  FLOAT TO 3-WD FLOATING.
      LDA =D31
      JSB .XPAK 
      DEF MANT
      LDA ....2     SET UP AS IF 3-WORD FLOATING. 
      SKP 
*                   FLOATING. 
* 
OUTPB ADA AMANT     FORM ADDR LAST WORD 
      STA OUTA
      LDB A,I       UNPACK THAT WORD. 
      JSB .FLUN 
      STB OUTA,I
      STA EXP 
      ISZ OUTA      ZERO OUT NEXT WORD. 
      CLA 
      STA OUTA,I
* 
*                   REMEMBER SIGN, TAKE ABS VALUE, CHECK FOR ZERO.
* 
      JSB NORML     NORMALIZE.
      LDB MANT      SET SIGN. 
      ASR 16
      STB SIGN
      STB EXPON     IN CASE ZERO. 
      SZA,RSS       ZERO ?
      JMP OUTPD     YES, DON'T SCALE. 
      SSA           NEGATIVE ?
      JSB .XCOM     YES, TAKE ABS VALUE.  (B=-1)
* 
*                   SCALE TO [1000,10000).
*                   FIRST, ESTIMATE LOG BASE 10.
* 
      LDA EXP       FORM N*19729
      MPY =D19729 
      ASR 7         (N*19729)/128 
      STA OUTA
      LDA MANT      X*(2**15) 
      MPY =D617     B = ((X*(2**15))*617)/(2**16) 
      ADB OUTA      + (N*19729)/128 
      ADB =D222     -290+512
      ASR 9         B = FLOOR(LOG10(NUMBER))+1
      STB EXPON     = N.
* 
*                   NOW PERFORM THE SCALING.
* 
      CMB,INB       DIVIDE NUMBER BY 10**(N-4)
      ADB ....4 
      LDA B 
      JSB PTEN
      SKP 
*                   IF < 1000, MULTIPLY BY 10.
*                   (CAN HAPPEN DUE TO ERROR IN COMPUTING LOG.) 
* 
      LDA MANT      GET INTEGER PART. 
      LDB EXP 
      RBL 
      JSB IFIX
      ADA =D-1000   IS IT < 1000 ?
      CLE,SSA,RSS 
      JMP OUTPA     NO, O.K.
      LDA PWR1A     YES, MULTIPLY BY TEN. 
      LDB PWR1A+1 
      JSB MULT      (E=0: NON-INPUT MODE) 
      CCA           DECREMENT EXPONENT. 
      ADA EXPON 
      STA EXPON 
* 
*                   MOVE BINARY POINT TO AFTER FIRST WORD.
* 
OUTPA LDA EXP       ADJUST EXP TO +15 
      ADA =D-15 
      CMA,INA 
      JSB RSN 
* 
*                   SET UP MANTP, MANTL, W AND D.  EXIT.
* 
OUTPD LDA AMANT     RESET TO HIGHER ACCURACY. 
      STA MANTP     (FOR ZERO CASE) 
      ADA LENTH,I   FOR DIGIT PRODUCTION. 
      STA MANTL 
      JSB WDFIX     SET W AND ADJUST AND SET D. 
      JMP OUTPT,I   EXIT. 
      HED D, E, F, G & I SPECIFICATIONS.
GTYPE LDB IO,I      I/O SWITCH
      SZB               OUTPUT
      JMP FTYPE     INPUT SAME AS F-TYPE
      LDA ....4 
      JSB WDGET     PICK OFF W AND D FIELDS 
      CLA 
      STA SCALE,I    NO SCALE FACTOR IF F-TYPE USED 
GCONV JSB F2LST 
      JSB OUTPT     SCALE, SET W & D. 
      CCA           SET FLAG SO FTYPE & ETYPE WILL RETURN.
      STA GFLAG,I 
      LDA EXPON     CHECK RANGE. A = SCALE FROM [.1,1)
      STA EXPNS     SAVE FOR RECHECKING LATER.
      SSA           < 0.1 ? 
      JMP GTOE      YES, USE -E-. 
      ADA D         FLOOR(LOG10(X))+1-D-1 
      LDB D         CHECK D TOO.
      CMB,SZB,RSS   IF D=-1 AND EXPON=0, FORCE -E-. 
      INA 
      SSA,RSS       FLOOR(LOG10(X))<D, I.E. X<10**D ? 
      JMP GTOE      NO, USE -E-.
      JMP GTOF
* 
*                   RTN FROM F. IF STILL < 10**D, WRITE 4 BLANKS & EXIT.
* 
BACKF JSB WDFIX     RESET W & D.
      LDA EXPNS     CHECK EXPONENT AGAIN. 
      STA EXPON     JUST IN CASE. 
      ADA D 
      SSA,RSS       NOW 10**D ? 
      JMP BCKF1     YES, GO CHANGE TO E-FORMAT. 
      LDA BLANK     NO, NOW FOUR BLANKS.
      LDB ....4 
      JSB MTPLO 
      JMP BCKE1     GO LOOP.
* 
*                   RTN FROM E-FORMAT.  IF STILL < 0.1, DONE. 
* 
BACKE LDA EXPNS     CHECK EXPONENT. 
      STA EXPON     JUST IN CASE. 
      SZA,RSS       ROUNDED TO 0.1 ?
      JMP BCKE2     YES, CHANGE TO E. 
BCKE1 JSB RFCHK     NO, CHECK FOR REPEAT. 
      JMP GCONV     YES.
      SKP 
*                   FORMAT CHANGED DUE TO ROUNDING. RESET & REDO. 
* 
BCKF1 JSB BCKUP     RESET.
      JMP GTOE      CHANGE TO E.
BCKE2 JSB WDFIX     RESET.
      LDA D         IF D=-1, LEAVE E-FORMAT.
      INA,SZA,RSS 
      JMP BCKE1 
      JSB BCKUP     RESET POSITION AND VALUE. 
      ADA MIN4      BACK UP OVER EXPONENT TOO.
      STA CCNT,I
      JMP GTOF      CHANGE TO F.
* 
*                   BACKUP ROUTINE. 
* 
BCKUX LDA .1000     SET UP ROUNDED MANTISSA.
      STA MANT
      CLA 
      STA MANT+1
      STA MANT+2
      STA MANT+3
      LDA AMANT     RESET MANTISSA POINTERS.
      STA MANTP 
      ADA LENTH,I 
      STA MANTL 
      LDA BCRS,I    RESET TO START OF FIELD.
      STA BCR,I 
      LDA CCNT,I
      ADA WSAVE,I 
      STA CCNT,I
      JMP BCKUP,I   THAT'S ALL. 
      SPC 4 
*                   COMMON FORMATTED INPUT. 
* 
IFEIN JSB F2LST     GET LIST ITEM.
      JSB WSET      SET W.
      LDA DSAVE,I   SET D.
      STA D 
      JSB INPUT     READ AN ITEM. 
      JSB RFCHK     AGAIN ? 
      JMP IFEIN     YES.
      SKP 
ITYPE CLA           NO EXPONENT.
      STA SCALE,I   NO SCALE FACTOR FOR INPUT 
      LDB IO,I      SET UP D. (A=0) 
      SZB,RSS       OUTPUT ?
      CCA           YES, D=-1.
      STA DSAVE,I 
      CLA 
      JSB WGET      READ W. 
      JSB WDFIX 
      JMP FCONV 
FTYPE CLA           NO EXPONENT.
      JSB WDGET 
FCONV LDB IO,I      IN OR OUT ? 
      SZB 
      JMP IFEIN     IN. 
FOUT  JSB F2LST     OUT, GET LIST ELEMENT.
      JSB OUTPT     SCALE, SET W & D. 
GTOF  CLB           CLEAR E-FORMAT FLAG.
      STB EFLAG 
      LDB SCALE,I 
      ADB EXPON     APPLY SCALE FACTOR. 
      LDA MANT      NUMBER ZERO ? 
      SZA,RSS 
      CLB,INB       YES, WANT ONE LEADING DIGIT.
      ADB MIN1
      SSB,INB,RSS   X < 1.0 ? 
      JMP FOUT1     NO. 
      LDA D         (- # DEC PL - 1)
      ADB A         YES, FORCE LEADING ZEROES.
      STB D 
      CLB,INB       B=+1. 
      SSA,INA,SZA   WAS D >= -1 ? 
      JMP FOUT2     NO, AT LEAST ONE DIGIT AFTER POINT. 
      STB EFLAG     YES, FORCE A LEADING ZERO.
FOUT1 CMB,INB       NO, REMOVE LEADING BLANKS.
      LDA GFLAG,I   IF G-FORMAT, TREAT BCNT AS ZERO.
      SSA 
      JMP FOUT3 
      ADB BCNT      ADJUST BCNT.
      STB BCNT
FOUT3 CMB,SSB       -BCNT-1.  BCNT<0 ?
      JMP FOUT2     NO, O.K.
      ADB D         YES. D-BCNT-1.
      SSB,INB,RSS   SKIP IF BCNT>=D.  D-BCNT. 
      STB W         DOESN'T FIT.  OUTPUT DOLLARS. 
      STB D         FITS. ADJUST D ACCORDINGLY. 
      CLB           AND BCNT=0. 
      SSA,RSS       IF G-FORMAT, LEAVE BCNT ALONE.
      STB BCNT
FOUT2 JSB OUTP1     PRINT NUMBER. 
      LDA GFLAG,I   GFIELD ?
      SSA 
      JMP BACKF     YES. GO BACK TO GTYPE.
      JSB RFCHK     AGAIN ? 
      JMP FOUT      YES.
      SKP 
DTYPE LDA "D" 
      STA EORD,I    PUT ASCII D FOR EXPONENT FIELD. 
ETYPE LDB IO,I      I/O SWITCH
      SZB 
      JMP FTYPE     INPUT IS THE SAME AS F-TYPE.
      LDA ....4     4 CHARS EXPONENT. 
      JSB WDGET 
ELOOP JSB F2LST     CHECK THE LIST
      JSB OUTPT     SCALE, SET W & D. 
GTOE  CCA           SET EFLAG:=TRUE.
      STA EFLAG 
      LDA EXPON     SUBTRACT SCALE FACTOR FROM EXPONENT.
      ADA TSCAL,I 
      STA EXPON 
      LDA TSCAL,I   ADD IT TO D.
      CMA,INA       + SCALE FACTOR. 
      STA SGDIG     (IF + SCALE, NO SPECIAL ROUNDING) 
      ADA D 
      STA D         A = D.
      LDB TSCAL,I   - SCALE FACTOR. 
      SSB,RSS       SCALE FACTOR <= 0 ? 
      JMP ETYP2     YES.
* 
*                   SCALE FACTOR > 0. DECREMENT D.  IF BCNT > 0, DECR 
*                   BCNT.  THEN IF TOO FEW PLACES, ADJUST D & EXPON.
* 
      CCB           TRY TO DECREMENT BCNT.
      ADB BCNT
      SSB           STILL + ? 
      JMP ETYP1     NO, LEAVE BCNT & D. 
      STB BCNT      YES. DO IT. 
      ADA MIN1      D TOO.
      STA D 
ETYP1 LDB MANT      NUMBER ZERO ? 
      SZB,RSS 
      JMP ETYP5     YES, DELETE EXTRA LEADING ZEROES. 
      SSA           NO.  DIGITS BEFORE POINT LOST ? 
      JMP ETYP4     NO. 
      LDB D         YES, ADJUST EXPON TO REFLECT THIS.
      JMP ETYP3 
ETYP5 CMA,SSA,INA   -D. WAS D >= 0 ?
      CLA           YES, USE D=0. 
      ADA W         W-D 
      CMA           D-W-1 = # OF EXTRA ZEROES + BCNT. 
      STA BCNT      JUST DELETE THEM. 
      JMP ETYP4 
      SKP 
*                   SCALE FACTOR <= 0, MAKE SURE AT LEAST ONE DIGIT.
* 
ETYP2 ADA B         RESTORE ORIGINAL D. 
      ADA B         ACCOUNT FOR LEADING ZEROES. 
      STA SGDIG     REMEMBER FOR ROUNDING.
      INA           (OLD D)+(# LDNG ZEROES)+1 = - # SIG DIG.
      CMA,SSA,RSS   # SIG DIG - 1.  AT LEAST ONE ?
      JMP ETYP4     YES, IS O.K.
      STA B         NO. FIX D & EXPON.
      CMA,INA       1 - # SIG DIG 
      ADA D         START DIGITS THAT MUCH SOONER.
      STA D 
      LDA MIN2      LIMIT ROUNDING. 
      STA SGDIG 
ETYP3 ADB EXPON     CORRECT EXPONENT. 
      STB EXPON 
* 
*                   OUTPUT NUMBER AND EXPONENT. 
* 
ETYP4 LDA MANT
      SZA,RSS       IF NUMBER ZERO, SET EXPONENT = 0
      STA EXPON 
      JSB OUTP1 
      LDA EORD,I    OUTPUT EXPONENT. FIRST, 
      JSB OUTCR      DESCRIPTIVE E (OR D) 
      LDA MINUS 
      LDB EXPON 
      SSB           SKIP IF POSITIVE
      CMB,INB,RSS   IF NEGATIVE, 2'S COMPLEMENT&SKIP
      LDA PLUS      IF POSITIVE,CHANGE A TO '+' 
      STB EXPON 
      JSB OUTCR     OUTPUT THE SIGN 
      LDA EXPON     NOW THE MAGNITUDE.
      CLB 
      DIV ...10     A=FIRST, B=SECOND.
      ADA "0" 
      ADB "0" 
      STB EXPON 
      JSB OUTCR 
      LDA EXPON 
      JSB OUTCR     SECOND DIGIT
      LDA GFLAG,I 
      SSA 
      JMP BACKE 
      JSB RFCHK     CHECK FOR REPEATS 
      JMP ELOOP 
      HED GENERAL DIGIT OUTPUT. 
**********************************************************************
*  OUTP1 IS THE ROUTINE WHICH PERFORMS THE ACTUAL OUTPUT CONVERSION. *
*  IT ASSUMES THAT WSAVE, DSAVE, AND BCNT HAVE BEEN PROPERLY INI-    *
*  TIALIZED, AND THAT THE NUMBER HAS BEEN PROPERLY SCALED BY OUTPT.  *
*  IT USES GETDG TO PRODUCE SIGNIFICANT DIGITS FROM LEFT TO RIGHT    *
*  AND PRODUCES LEADING BLANKS, LEADING ZEROES AND THE DECIMAL POINT *
*  ACCORDING TO WSAVE, DSAVE AND BCNT.  SPECIAL CARE IS TAKEN TO     *
*  OUTPUT THE SIGN AND THE DECIMAL POINT PROPERLY, AND TO ROUND THE  *
*  RESULT CORRECTLY.                                                 *
**********************************************************************
* 
* 
* THIS ROUTINE HAS BEEN MODIFIED TO OUTPUT 0'S AFTER THE NUMBER OF
* SIGNIFICANT DIGITS GIVEN BY THE TABLE "SDTBL".
* THIS WAS DONE TO SUPPRESS THE RETURN OF INSIGNIFICANT DIGITS IN 
* LARGE FORMAT FIELDS.
      SPC 3 
*                   INITIALIZE, OUTPUT LEADING BLANKS & SIGN. 
* 
OUTPZ LDA W         MAY ALREADY BE TOO LATE.
      SSA,RSS 
      JMP BCKS3     YUP. DOLLARS. 
      LDB BCNT      OUTPUT LEADING BLANKS 
      LDA BLANK 
      JSB MTPLO 
      LDB SIGN      OUTPUT A MINUS ?
      LDA MINUS 
      SZB           IF NOT. 
      JSB OUTCR     YES.
      LDA "0"       SPECIAL CASE FROM F-FORMAT. 
      LDB EFLAG     IF EFLAG=+1, OUTPUT "0" 
      CPB ....1 
      JSB MTPLO     (UPDATE W TOO)
      LDA SDTBL 
      ADA TYPE,I
      LDA A,I 
      STA GETDA     SET COUNTER FOR # OF SIGNIFICANT DIGITS 
      LDA MIN5      SET UP CONVERSION FOR GETDG.
      STA GETDC 
      SKP 
*                   OUTPUT DIGITS.
* 
      LDA D         D 
      CMA,INA       -D
      ADA W         W-D 
      STA OCONT 
      LDB W         IF W=0, DONE. 
      SSB,RSS 
      JMP ALDON 
      SSA           ANY DIGITS BEFORE POINT (W<D) ? 
      JMP OUT15     YES.
      JMP OUT5      NO. OUTPUT POINT. 
OUT6  STB OCONT     STORE COUNT AND OUTPUT A LEADING ZERO.
      CLA,RSS 
OUT15 JSB GETDG     GET NEXT DIGIT. 
      ADA "0" 
OUT8  JSB OUTCR     OUTPUT IT.
      ISZ W         DONE ?
      JMP *+2       NO. 
      JMP ALDON     YES.
      LDB OCONT     COUNTING LEADING ZEROES OR DIGITS ? 
      CMB,INB,SZB,RSS  (NEGATE COUNT) 
      JMP OUT15     NO, JUST GO ON. 
      CMB,SSB,RSS   LEADING ZEROES ? (COUNT IS DECREMENTED) 
      JMP OUT6      YES, GO DO IT.
      ISZ OCONT     NO, COUNT A LEADING DIGIT.
      JMP OUT15     IF NOT TIME FOR POINT.
OUT5  LDA "."       OUTPUT POINT. 
      JMP OUT8
* 
*                   DECIDE WHETHER TO ROUND UP. 
* 
ALDON LDA OCONT     ANY LEADING ZEROES LEFT ? 
      CMA,INA 
      SSA,RSS       IF SO, FORCE NO ROUNDING. 
      JSB GETDG     NEXT DIGIT AFTER LAST PRINTED.
      ADA MIN5
      ISZ OVTOG    IF BUFFER IS BOMBED, FORGET IT!
      SSA           SKIP IF DIGIT WAS 5 OR MORE 
      JMP OUTP1,I   ELSE EXIT.
* 
*                   ROUNDING SECTION.  INITIALIZE.
* 
      JSB WSET      RESET W SO WE DON'T BACK TOO FAR
      LDA SGDIG     IF E-FORMAT AND SCALE FACTOR <= 0,
      AND EFLAG     LIMIT ROUNDING. 
      STA OCONT     -(MAX SIG DIG)-1
      LDB BCR,I     POINTS TO LAST DIGIT. 
      SKP 
*                   EXAMINE CURRENT CHARACTER.
* 
OUT11 ISZ OCONT     AT LAST REQ'D LEADING ZERO ?
      JMP *+2       NO. 
      JMP OUT19     YES, CHANGE NEXT TO 1.
      JSB .LBT      CHARACTER OUTPUT. 
      JSB DIGIT     WAS IT A DIGIT? 
      JMP OUT18     NO. 
* 
*                   DIGIT.  IF < 9, JUST INCREMENT, ELSE
*                   CHANGE TO ZERO AND BACK UP. 
* 
      LDB BCR,I 
      CPA ....9     YES. WAS IT A NINE. 
      JMP OUT10     YES.
      ADA "1" 
      JMP OUT14 
OUT10 LDA "0"       CHANGE THE NINE TO A ZERO 
      JSB .SBT
OUT12 CCB           BACK UP BUFFER POINTER
      ADB BCR,I 
      STB BCR,I 
      ISZ W         TEST FOR BEGINNING OF FIELD 
      JMP OUT11 
      CLA           START OF FIELD. PREVENT MATCHES.
* 
*                   CHECK FOR ".", E-FORMAT, AND BLANK. 
* 
OUT18 CPA "."       WAS THE CHARACTER A DECIMAL PT.?
      JMP OUT12     YES. PASS IT BY FOR NOW.
      LDB EFLAG     E-FORMAT ?
      SSB 
      JMP OUT19     YES.
      ISZ EXPNS     NOTE A ROUND TO POWER OF TEN. 
      NOP           COULD SKIP !
      LDB GFLAG,I   AT FIRST DIGIT. IS IT G-FORMAT ?
      SSB 
      JMP BUCKS     YES, MOVE DECIMAL POINT RIGHT.
      CPA BLANK     WAS IT A BLANK? 
      JMP OUT16     YES. ROUNDING OVERFLOW. 
* 
*                   MINUS OR START OF FIELD. (IF SOF, W=0)
* 
      LDB W         CHECK W 
      INB 
      SSB,RSS       IS IT < -1 ?
      JMP BUCKS     NO, NO ROOM LEFT. 
      CCB           YES, MOVE MINUS SIGN BACK.
      ADB BCR,I 
      STB BCR,I 
      JSB .SBT
      SKP 
*                   STORE "1", MOVE TO END OF FIELD & EXIT. 
* 
OUT17 ISZ BCR,I     NOW PUT IN A '1'
OUT16 LDB BCR,I 
      LDA "1" 
OUT14 JSB .SBT
OUT9  LDB WSAVE,I   PUT BCR BACK AT THE END OF THE
      CMB,INB       FIELD.
      ADB BCRS,I
      STB BCR,I 
      JMP OUTP1,I 
* 
*                   E-FORMAT.  CHANGE FIRST DIGIT TO "1", INC EXPONENT. 
* 
OUT19 ISZ EXPON     ELSE EXP := EXP+1 
      JMP *+1 
      ISZ EXPNS     NOTE CHANGE FOR G-FORMAT. 
      JMP OUT17     (NEXT CHAR CANNOT BE ".": SEE OCONT)
      JMP OUT17 
* 
*                   FIELD OVERFLOW.  IF A DECIMAL POINT, ELIMINATE ONE
*                   DECIMAL PLACE (THE POINT, IF NONE).  ELSE FILL WITH "$".
* 
BUCKS LDA D         SEE IF DECIMAL POINT. 
      SSA,RSS 
      JMP BCKS2     NO, GO BACK UP & OUTPUT DOLLARS.
      LDB BCR,I     FIXABLE. FIRST STORE A "1". 
      INB 
      JSB .LBT      SEE IF ROUNDING TO 1.0
      ADB MIN1
      INA           CHANGE "0" TO "1" OR "." TO "/" 
      CPA "/"       WAS IT "." ?
      JMP BCKS4     YES, CHANGE ".0" TO "1."
      JSB .SBT      NO, CHANGE "0XX0.0XX" TO "1XX00.XX" 
BCKS1 JSB .LBT      SCAN FOR "." (FIRST NON-ZERO) 
      CPA "0" 
      JMP BCKS1 
      ADB MIN1      BACK UP.
BCKS4 ADA "0_."     CHANGE "." TO "0" OR "/" TO "1" 
      JSB .SBT
      LDA "."       NEW POINT.
      ISZ D         WERE THERE ANY PLACES AFTER POINT ? 
      JMP OUT14     YES, PLACE NEW POINT. 
      JMP OUT9      NO, JUST DELETE POINT.
BCKS2 JSB BCKUP     BACK UP TO START OF FIELD.
      JSB WSET      TO RESET W
BCKS3 LDA "$"       OUTPUT DOLLARS. 
      LDB WSAVE,I 
      CMB,INB 
      JSB MTPLO 
      JMP OUTP1,I   EXIT. 
      SKP 
*                   SDTBL - TABLE OF MAX # SIGNIFICANT DIGITS BY TYPE.
* 
*                   ENTRIES ARE -(MAX # DIG) - 1
* 
*                   CRITERION: MINIMUM # DIGITS TO GUARANTEE THAT A 
*                   NUMBER MAY BE WRITTEN & READ WITH THE SAME
*                   (SUFFICIENTLY LARGE) FORMAT & REPRODUCE THE 
*                   ORIGINAL BIT PATTERN. 
* 
SDTBL DEF *+1       ADDR TYPE 0 
MIN6  DEC -6        1-WORD INTEGER:   5 
      DEC -11       2-WORD INTEGER:  10 
      DEC -9        2-WORD FLOATING:  8 
      DEC -14       3-WORD FLOATING: 13 
      DEC -19       4-WORD FLOATING: 18 
      SPC 6 
******************************* 
MTPLX CMB,INB       OUTPTS THE CHARACTER IN A THE 
*                             *         NUMBER OF TIMEGIVEN BY B
******************************* 
      SSB,RSS       SKIP IF B WAS POSITIVE
      JMP MTPLO,I   RETURN IF B WAS 0 OR LESS 
      STB MTPL2     STORE THE COUNT 
      STA MTPL1     SAVE THE CHARACTER
MTPLL LDA MTPL1 
      JSB OUTCR 
      ISZ W 
      NOP           JUST IN CASE. 
      ISZ MTPL2 
      JMP MTPLL 
      JMP MTPLO,I 
 HED NUMERICAL INPUT CONVERSION 
******************************************************************* 
* INPUT IS THE ROUTINE THAT DOES ALL OF THE INPUT CONVERSION. IT
* INCLUDES BOTH A FREE-FIELD SCANNER AND A FORMATTED SCANNER. 
* FREE-FIELD IS INDICATED BY FCR=0. ALL CONVERSION IS DONE IN 
* THE SAME WAY, REGARDLESS OF THE FORMAT TYPE. THIS ALLOWS REAL 
* VARIABLES TO APPEAR AS INTEGERS, AND VICE VERSA. THE FORM OF A
* NUMBER IS AS FOLLOWS: 
* 
* <SIGN><INTEGER PART><DEC.PT><FRACTION><E><EXP.SIGN><EXPONENT> 
* 
* ALL OF THESE ARE OPTIONAL, AND THE APPEARANCE OF THE FIRST
* SIGN, DIGIT, OR DECIMAL PT. DEFINES A NUMBER. ANY COMBINATION 
* OF THE ABOVE IS LEGAL, WITH THE FOLLOWING EXEPTIONS:            * 
* 
*    (1) AN INITIAL E IS IGNORED IN FREE-FIELD, AND IS ILLEGAL IN 
*        FIXED FIELD; 
*    (2) IF NO INTEGER PART OR FRACTION APPEARS (AND A SIGN OR
*        DEC.PT. DOES), THE RESULT IS ZERO
* 
* IN FIXED-FIELD INPUT, IF NO DECIMAL PT.  APPEARS, THE RESULT IS * 
* MULTIPLIED BY 10**(-D). 
* 
* THE FOLLOWING SPECIAL FEATURES ARE INCLUDED FOR FREE-FIELD INPUT: 
* 
*    (1) WHEN 2 CONSECUTIVE COMMAS APPEAR WITH NO DATA BETWEEN, 
*        THAT LIST ELEMENT IS SKIPPED.
* 
*    (2) WHEN A SLASH OCCURS IN AN INPUT RECORD, THE REMAINDER
*        OF THE RECORD IS TREATED AS COMMENTS.
* 
*    (3) IF A LINE TERMINATES WITHOUT A SLASH, THE INPUT OPERATION
*        TERMINATES AND THE REMAINDER OF THE LIST REMAINS 
*        UNCHANGED. 
* 
*    (4) WHEN A QUOTE APPEARS, THE FOLLOWING                      * 
*        CHARACTERS IN THAT LINE ARE TREATED AS COMMENTS          * 
*        UNTIL ANOTHER QUOTE APPEARS.                             * 
* 
*    (5) ALL UNRECOGNIZED CHARACTERS ARE TREATED AS BLANKS
* 
*    (6) WHEN AN INTEGER IS PRECEDED BY THE CHARACTER "@", THE IN-
*        TEGER IS INTERPRETED AS OCTAL. 
* 
* CONTROL WITHIN INPUT IS GOVERNED BY THE VARIABLE POST,
* WHOSE VALUE INDICATES HOW FAR THE NUMBER HAS BEEN 
* SCANNED, AS FOLLOWS:
* 
* POST = 0 : NUMBER NOT STARTED YET 
*        1 : NUMBER STARTED, BUT NO DECIMAL PT. REACHED YET 
*        3 : LAST CHARACTER WAS THE 'E' 
*        4 : EXPONENT BEING PROCESSED 
* 
******************************************************************* 
* 
*                   INITIALIZATION. 
      SKP 
INPUX LDA AMANT     SET UP MANTISSA ADDRESSES.
      STA MANTP 
      STA MANTL 
      LDA MIN4      FOR INDIG.
      STA INPUB     # DIGITS THIS GROUP - 4.
      CCA 
      STA EXP 
      CLA 
      STA INPUA     ACCUMULATED DIGITS THIS GROUP. (UP TO 4)
      STA INPUC     SIGN OF EXPONENT. 
      STA INPUD     # TRAILING ZEROES.
      STA SIGN      SIGN OF MANTISSA. 
      STA MANT
      STA MANT+1
      STA MANT+2
      STA MANT+3
      STA MANT+4
      STA EXPON 
      STA SKIP,I
      STA POST
      CPA FCR,I     FREE FIELD ?
      JMP *+2 
      JMP INLUP 
      STA W 
      STA D 
      STA DSAVE,I 
* 
*                   MAIN LOOP.  READ A CHAR AND DECIDE WHAT TO DO.
* 
FLIP  ISZ W         CHECK FOR END OF FIELD
      JMP INLUP     NO, KEEP GOING. 
      JMP FINAL     YES, GO PACK IT UP. 
INLUP JSB INCHR 
      LDB POST
      CPA "/" 
      JMP INSLS 
      CPA COMMA 
      JMP INCOM 
      CPA PLUS
      JMP INPLS 
      CPA MINUS 
      JMP INMIN 
      CPA "." 
      JMP INPNT 
      CPA "E" 
      JMP INE 
      CPA "D" 
      JMP INE 
      CPA QUOTE 
      JMP INQUO 
      CPA "@" 
      JMP INOCT 
      JSB DIGIT 
      JMP INBLN 
      SKP 
***** THE CHARACTER IS A DIGIT. WE FIRST SET POST AS FOLLOWS:  **** 
*     POST=0      : POST_1
*     POST=2      : DF_DF+1 
*     POST=3      : POST_6                                        * 
******************************************************************* 
BNKNM LDB POST
      SZB,RSS 
      ISZ POST      IF POST=0, SET IT TO 1
      CPB ....3 
      JMP INEX3     PROCESSING EXPONENT 
      CPB ....4 
      JMP INEX4     PROCESSING EXPONENT 
* 
*                   ADD THIS DIGIT TO MANTISSA. 
* 
      LDB POST      IF PAST DEC POINT, COUNT DIGITS.
      CPB ....2 
      ISZ D 
      NOP           COULD SKIP !
      JSB INDIG     ADD DIGIT.
      JMP FLIP
* 
*                   EXPONENT PROCESSING.
* 
INEX3 ISZ POST
INEX4 LDB EXPON     MULTIPLY EXPON BY 10
      BLS,BLS 
      ADB EXPON 
      BLS 
      ADB A 
      ASL 4         GUARANTEE LARGE EXPONENTS STAY LARGE. 
      SOC           IF TOO BIG, 
      LDB =B77777   SET TO MAX POS. (BECOMES 3777)
      ASR 4 
      STB EXPON 
      JMP FLIP
* 
*                   COMMA.
* 
INCOM LDA FCR,I     TREAT A COMMA ON INPUT
      SZA           TEST FOR FREE FIELD INPUT 
      JMP ERR4
      CCA 
      SZB           IS POST=0?
      JMP FINL1 
      CPA CFLAG,I 
      JMP *+3       DOUBLE COMMA
      STA CFLAG,I 
      JMP FLIP
      STA SKIP,I
      STA SWITH,I 
      JMP INPUT,I 
      SKP 
*                   "+" AND "-": SET THE APPROPRIATE SIGN.
* 
INMIN CCA           FOR MINUS 
      SZB           WHICH ? 
      JMP INPL2     DEC EXPONENT. 
      STA SIGN      MANTISSA. 
      JMP FLIP
INPL2 STA INPUC 
INPLS CPB ....4     IF POST=4 THIS IS ILLEGAL 
      JMP ERR5
      LDA ....4 
      SZB           IF POST>0 THEN SET IT TO 4
STORP STA POST
      JMP FLIP
* 
*                   "." : DECIMAL POINT.
* 
INPNT BRS           HANDLES DECIMAL POINT 
      SZB 
      JMP ERR5      MEANS POST WAS 2 OR MORE
      LDA DSAVE,I   SUBTRACT DSAVE FROM D.
      CMA,INA 
      ADA D 
      STA D 
      LDA ....2 
      JMP STORP 
* 
*                   "E" : NOTE END OF MANTISSA. 
* 
INE   ADB MIN3
      SSB,RSS 
      JMP ERR5      POST WAS 3 OR 4 
      LDA ....3     SET IT TO 3 
      JMP STORP 
* 
*                   "/" : FORMATTED, ERROR.  FREE-FIELD, IS END-OF-LINE.
* 
INSLS LDA FCR,I 
      SZA 
      JMP ERR4
      STA CCNT,I    SET CCNT=0 TO READ NEXT LINE
      JMP FINAL     BEAT IT 
* 
*                   FREE-FIELD COMMENT PROCESSING.
* 
INQUO LDA FCR,I     ERROR IF NOT FREE-FIELD.
      SZA 
      JMP ERR4      FIXED, ERROR 4. 
INQU1 JSB INCHR     READ CHARACTERS UNTIL ANOTHER 
      CPA QUOTE      QUOTE IS READ. 
      JMP INBLN          INBLN
      CCA           *** CHECK IF END OF BUFFER? 
      CPA CCNT,I    *** THIS CODE ADDED TO FIX '123"' 
      JMP INSLS     *** YES  FREE FIELD INPUT BUG 
      JMP INQU1 
      SKP 
*                   BLANK.
* 
INBLN LDB FCR,I     SEE IF FREE-FIELD.
      SZB,RSS 
      JMP INBL1     YES.
      CPA BLANK     NO.  MUST BE A TRUE BLANK.
      RSS 
      JMP ERR4      NO, UNRECOGNIZED CHAR.
      LDA OFLAG,I   YES. IGNORE OR TREAT AS A ZERO ?
      LDB POST
      SZB           IF POST=0, ALWAYS IGNORE. 
      SZA 
      JMP FLIP      OLDIO. IGNORE.
      JMP BNKNM     NEWIO. TREAT AS ZERO.  (A=0)
INBL1 LDB POST      FREE-FIELD. POST=0 ?
      SZB,RSS 
      JMP FLIP      YES. IGNORE IT. (ELSE FALL INTO "FINAL")
* 
*                   END OF NUMBER.  PUT IT ALL TOGETHER.
* 
FINAL CLA 
FINL1 STA CFLAG,I 
      CCA           ADD ANY REMAINING DIGITS. 
      JSB INDIG 
      JSB NORML     NORMALIZE.
      LDA MANT      IF ZERO, DONE.
      SZA,RSS 
      JMP FNL11 
      LDA EXPON   FINAL COMPUTATION OF NUMBER 
      ISZ INPUC     COMPUTE EXTERNAL
      CMA,INA          EXPONENT AS NEGATIVE 
      LDB POST     IF NO E-FIELD
      ADB MIN3      ADD 
      SSB            SCALE FACTOR 
      ADA SCALE,I 
      ADA D         ADJUST FOR DECIMAL POINT OR EXCESS DIGITS.
      CMA,INA 
      ADA INPUD     ACCOUNT FOR TRAILING ZEROES, EXTRA DIGITS.
      LDB A         CHECK FOR LARGE VALUE.
      ASL 9         OFL IF OUTSIDE [-64,+64)
      SOC           SHOULD NEVER BE OUTSIDE [-60,+39] 
      JMP FNL13     (MANTISSA IN [1,10**20],
      RRR 9            RESULT IN [10**-39,10**39] ) 
      JSB PTEN      MULTIPLY BY POWER OF TEN. 
      LDB SIGN      TEST THE SIGN 
      SSB           NEGATIVE ?
      JSB .XCOM     YES, COMPLEMENT MANTISSA. (B=-1)
      SKP 
*                   ALL SET EXCEPT COMBINING MANTISSA & EXPONENT. 
* 
INPCK LDA TYPE,I    WHAT TYPE ? 
      ADA MIN2
      CLE,SSA,INA,RSS 
      JMP FINL6     FLOATING. 
      LDA EXP       INTEGER.  CHECK EXPONENT. 
      CMA,SSA,INA,RSS IN [-.5,+.5) ?
      JMP FNL14     YES, RESULT = 0 
      ADA =D15      NO.  A = SHIFT-16 TO INTEGERIZE.
      SSA           SHIFT<16 ?
      JMP FINL3     YES.  MIGHT BE <0 (OFL) 
      STA EXP       NO.  REMEMBER REST OF SHIFT.
      LDA MANT+2    DO WORD SHIFT.
      IOR MANT+1
      STA MANT+2
      LDB MANT
      STB MANT+1
ASR16 ASR 16
      STB MANT
      LDA EXP       REST OF SHIFT 
      JMP FINL4     GO DO IT. 
FINL3 ADA =D16      SHIFT.
      CLE,SSA       <0 ? (OVERFLOW) 
      JMP FNL15     YES.
FINL4 SZA,RSS       NO. SHIFT>0 ? 
      JMP FNL4A     NO, DONE SHIFTING.
      IOR ASR16     FORM ASR SHIFT
      STA XEQ+1 
      LDB MANT+1    CATCH BITS SHIFTED PAST POINT.
      CLA 
      JSB XEQ 
      IOR MANT+2    JUST OR THEM IN 
      STA MANT+2
      LDB MANT      NOW DO THE SHIFT. 
      LDA MANT+1
      JSB XEQ 
      STB MANT
      STA MANT+1
FNL4A LDB MANT      NUMBER<0 ?
      SSB,RSS 
      JMP FINL5     NO. 
      LDA MANT+2    YES. CHECK FOR BITS PAST POINT. 
      IOR MANT+3
      SZA,RSS 
      JMP FINL5     IF NONE.
      ISZ MANT+1    SOME.  INCREMENT RESULT.
      JMP *+2       NO CARRY. 
      INB           PROPOGATE CARRY.
FINL5 LDA TYPE,I    SINGLE OR DOUBLE INTEGER ?
      CLE,SZA 
      JMP FNL5A     DOUBLE, DONE. 
      LDA MANT+1    SINGLE, SHORTEN IT. 
      ASL 16
      SOC           OVERFLOW ?
      JMP FNL15     YES. (E=0)
FNL5A STB MANT      NO. UPDATE FIRST WORD.
      JMP FNL11 
* 
*                   ROUND FLOATING.  CHECK FOR OFL UFL, PACK EXPONENT.
* 
FINL6 LDB .177      ADD 200B TO ROUND.
      JSB .XCOM     ROUND.  ALSO SET INPUA TO LWA.
      LDB EXP       CHECK EXP 
      CLA           FOR USE IN FORMATTING EXP 
      ASL 8         MUST FIT IN 8 BITS WITH SIGN. 
      SOC 
      JMP FNL13     NO, OFL/UFL.
      CLE,ELB       E=EXP SIGN, B<15:9>=EXP MANT. 
      BLF,BLF       B<7:1>=EXP MANT.
      RBR,ELB       B<7:0>=FORMATTED EXPONENT.
      LDA INPUA,I   LAST WORD MANTISSA. 
      AND =B177400  MAKE ROOM FOR EXP.
      IOR B         PUT TOGETHER. 
      STA INPUA,I 
FNL11 LDA AMANT     COPY RESULT.
      LDB ADX 
      STB INPUB 
      LDB LENTH,I   SET UP COUNT. 
      CMB,INB 
      STB INPUA 
FNL12 LDB A,I       CAN'T USE .MVW: IS TYPE 7.
      STB INPUB,I 
      INA           INCR ADDRESSES & LOOP.
      ISZ INPUB 
      ISZ INPUA     DO "LENTH" TIMES. 
      JMP FNL12 
      STA SWITH,I   INDICATE PRESENCE OF NUMBER.
      JMP INPUT,I   EXIT. 
* 
*                   OVERFLOW & UNDERFLOW HANDLING.
* 
FNL13 CCE,SSB       OFL OR UFL ? (IF OFL, E=1)
FNL14 CLA,CLE,RSS   UFL. (E=0)
FNL15 LDA =B77777   OFL.  E=1 IF FLOATING.
      STA MANT
      RAL,ARS       UFL:0  OFL:-1 
      STA MANT+1
      STA MANT+2
      STA MANT+3
      CCB,SEZ,RSS   INTEGER OR UFL ?  (B=-1)
      JMP FNL11     YES, DONE.
      ADB LENTH,I   NO, COMPUTE ADDR LAST WORD. 
      ADB AMANT 
      LDA B,I       FLOATING & OFL, CLEAR LAST BIT. 
      ALS 
      STA B,I 
      JMP FNL11     GO COPY IT. 
      SKP 
*                   FREE-FIELD OCTAL PROCESSING.
* 
INOCT STA POST
      SZB           IF POST WAS NON ZERO, TREAT AS A
      JMP INBLN      BLANK. 
      STB CFLAG,I   RESET CFLAG TO SAY NO COMMA 
      LDA FCR,I 
      SZA           TEST FOR FREE FIELD INPUT 
      JMP ERR4
INOC2 JSB INCHR     GET NEXT CHARACTER. 
      JSB DIGIT     CHECK FOR DIGIT.
      JMP INOC1     NO. 
      LDB MANT      GET PREVIOUS OCTAL RESULT 
      BLF,RBR       SHIFT LEFT 3. 
      IOR B         MERGE WITH NEW DIGIT. 
      STA MANT
      JMP INOC2 
INOC1 LDA MANT      FLOAT IT. 
      JSB FLOAT 
      STA MANT
      BRS 
      STB EXP 
      STA SWITH,I   INDICATES NUMBER PROCESSED (A.NE.7) 
      CPA BLANK     IF TERMINATING CHARACTER IS 
      JMP INPCK      OTHER THAN A BLANK,
      CCB           UNREAD IT.
      ADB BCR,I 
      STB BCR,I 
      CCB 
      ADB CCNT,I
      STB CCNT,I
      JMP INPCK 
      END