ASMB,R,B,T,L <STRING ARITHMETIC - 8/27/70>
      HED ** STRING ARITHMETIC ROUTINES - <IADD> **
      NAM STLIB,7
      ENT IADD,ISUB,IMULT 
      ENT GETCR,OUTCR,%NULL,%OVFL,%MOVF 
      EXT .ENTR,.ERRR 
      COM X(4),Y(4),SIGN(1),LGTH(1),DISPL(1),PAD(2)
      COM LCOR(2),Z(65) 
      SPC 1 
* <IADD> PERFORMS STRING ADDITION OR SUBTRACTION ON ASCII
* STRINGS.  THE RESULT STRING MUST BE LESS THAN 64 CHARACTERS.
* <IADD> PERFORMS X=X+Y, AND <ISUB> PERFORMS X=X-Y.
* X AND Y MAY BE SIGNED OR UNSIGNED, FIXED POINT OR REAL
* NUMBERS.  A LEADING "+" OR SPACE, OR A DIGIT IMPLIES A
* POSITIVE STRING NUMBER;  A LEADING "-" IMPLIES NEGATIVE.
* THE RESULT REPLACES X-STRING, AND Y-STRING IS UNCHANGED.
      SPC 1
* LEADING, TRAILING, AND INTERSPERSED NON-NUMERIC CHARACTERS
* ARE IGNORED.  IF MORE THAN ONE DECIMAL POINT APPEARS IN A
* STRING, ONLY THE LEFTMOST IS PROCESSED, AND THE REMAINDER
* ARE IGNORED.  THIS IMPLIES THAT NUMBERS SUCH AS:
      SPC 1
* $1,247.50   1,567,801    ..1 (=.1)   AND  1 2 . 5 (=12.5)
      SPC 1
* CAN BE PROCESSED WITHOUT ERRORS.
      SPC 1 
* CALLING SEQUENCES FOR <IADD> AND <ISUB>:
      SPC 1 
*     JSB IADD[ISUB]    IADD=ADDITION, ISUB=SUBTRACTION 
*     DEF *+7           RETURN ADDRESS
*     DEF X             ADDRESS OF X=STRING 
*     DEF XOF           ADDRESS OF X=STRING OFFSET
*     DEF XLEN          ADDRESS OF X-STRING LENGTH(CHARS) 
*     DEF Y             ADDRESS OF Y-STRING 
*     DEF YOF           ADDRESS OF Y-STRING OFFSET(CHARS) 
*     DEF YLEN          ADDRESS OF Y=STRING LENGTH(CHARS) 
*     STA ILRES         POST RESULT STRING LENGTH(CHARS)
      SPC 1 
* FORTRAN CALLING SEQUENCE (ILRES=LENGTH OF RESULT STRING): 
      SPC 1 
*     ILRES=IADD(IX,IXOF,IXLEN,IY,IYOF,IYLEN)  OR,
*     ILRES=ISUB(IX, ETC.                   ) 
      SPC 1 
* <IADD> FLOATING POINT STRING ADDITION ROUTINE:
      SPC 1 
XAA   BSS 6         PARAMETER ADDRESS SAVE AREA 
      SPC 1 
IADD  NOP           ENTRY/EXIT POINT
      JSB .ENTR     PASS PARAMETER ADDRESSES
      DEF XAA 
      LDB *-1       PASS POINTER TO PARAMETER 
      JSB INIT       ADDRESS SAVE AREA AND GO 
      BSS 0           COMPUTE PSEUDO ADDRESSES.
      JSB POINT     EXTRACT THE SIGNS AND DECIMAL 
      BSS 0          POINT DISPLACEMENTS FOR
      BSS 0           X- AND Y-STRINGS. 
      JSB ALIGN     ALIGN THE DECIMAL POINTS
      LDA X+.SGN. 
      CPA Y+.SGN.   DO ARGUMENTS HAVE LIKE SIGNS? 
      JMP ADD2      YES - NORMAL ADD OPERATION
      STA Y+.SGN.   NO - SET SIGN OF Y EQUAL TO SIGN
      LDA IADD       OF X AND GO SUBTRACT.  RESET 
      STA ISUB        RETURN ADDRESS TO SUBTRACT. 
      JMP SUB1      USE SUBTRACT ROUTINE
      SPC 1 
ADD2  STA SIGN      POST SIGN OF RESULT (SGN(X))
      JSB GEN1      SET UP POINTERS AND COUNTS
      SPC 1 
* FORM THE SUM OF CORRESPONDING X- AND Y-STRING CHARACTERS IN 
* AN INTERMEDIATE DECIMAL ARRAY 'Z'.  PAD X- AND Y-STRING 
* WITH ZEROS SO AS TO ALIGN THE DECIMAL POINTS. 
      SPC 1 
      LDA CLAI      SET PRE-PADDING SWITCHES 'ON' 
      STA ADD3
      STA ADD6
      DLD JSBI1     SET POST-PADDING SWITCHES 'OFF'
      STA ADD4+1
      STB ADD7+1
      SPC 1 
ADD3  JMP ADD4      PRE-PAD X-STRING AS REQUIRED TO 
      BSS 0          ALIGN IT WITH Y-STRING.  THIS
      BSS 0           IS INITIALLY A 'CLA' INSTR. 
      ISZ XPAD      ANY MORE NEEDED ? 
      JMP ADD5      YES - SKIP X-CHARACTER FETCH
      LDA JMPI1     NO - SET A SWITCH TO SKIP PADDING 
      STA ADD3       FROM NOW ON.  OVERLAY 'CLA'. 
      SPC 1 
ADD4  LDA XLOC      FETCH X-STRING CHARACTER
      JSB GETCR     IF AT END OF STRING, PAD ON 
      JSB GEN3       RIGHT UNTIL Y-STRING EXHAUSTED.
      JSB NUMCK     GO VERIFY THE DIGIT 
      JMP ADD4      IF POINT OR SIGN, FETCH AGAIN 
ADD5  STA TEMP      SAVE GOOD AUGEND DIGIT
      SPC 1 
ADD6  JMP ADD7      PRE-PAD Y-STRING ('CLA' INITIALLY)
      ISZ YPAD      ANY MODE NEEDED ? 
      JMP ADD8      YES - SKIP DIGIT FETCH
      LDA JMPI2     NO - SET SWITCH TO SKIP ANY 
      STA ADD6       FURTHER PADDING.
      SPC 1 
ADD7  LDA YLOC      FETCH ADDEND DIGIT
      JSB GETCR 
      JSB GEN3      IF END OF STRING, PAD RIGHT 
      JSB NUMCK     VERIFY THE DIGIT
      JMP ADD7      IF SIGN OR POINT, FETCH AGAIN 
      SPC 1 
ADD8  ADA TEMP      FORM THE SUM DIGIT IN (A) 
      STA SUM,I      AND POST IT IN INTERMEDIATE
      ISZ SUM         DECIMAL ARRAY.  BUMP PNTR.
      ISZ LOOP      FINISHED ?
      JMP ADD3      NO - GET NEXT PAIR AND ADD
      SPC 1 
* PERFORM CARRY PROPAGATION IN THE INTERMEDIATE DECIMAL 
* ARRAY.  IF Z(I)>10, THEN Z(I)=Z(I)-10 AND Z(I+1)= 
* Z(I+1)+1  FOR  I=1 TO LGTH. 
      SPC 1 
      JSB GEN2      SET UP POINTERS AND COUNTS
ADD9  LDA SUM,I     GET PREVIOUS SUM(I) 
      ADA CARRY     ADD CARRY(I-1)
      LDB =D-10 
      ADB A         (B)=SUM(I)+CARRY(I-1)-10
      SSB,RSS        RESULT <0 ?
      JMP ADD11     NO - WE MUST PROPAGATE A CARRY
      STA SUM,I     YES - SUM DOES NOT EXCEED 10
      CLA 
      SPC 1 
ADD10 STA CARRY     SET CARRY(I)=0
      CCA 
      ADA SUM       ADJUST DECIMAL ARRAY POINTER
      STA SUM        TO NEXT DIGIT POSITION.
      ISZ LOOP      FINISHED ?
      JMP ADD9      NO - CONTINUE 
      LDA CARRY     YES - POST CARRY(L+1) 
      STA Z 
      JMP ADD12 
      SPC 1 
ADD11 STB SUM,I     SUM(I)=SUM(I)+CARRY(I-1)-10 
      CLA,INA 
      JMP ADD10     CARRY(I)=1
      SPC 1 
* CONVERT INTERMEDIATE DECIMAL ARRAY 'Z' TO ASCII AND GO
* PLACE THE DECIMAL POINT:
      SPC 1 
ADD12 LDA SIGN      GO POST SIGN OF RESULT IN X 
      JSB OUTSN
      LDA ZARA      RESET DECIMAL ARRAY POINTERS
      STA ADD13 
      LDA LGTH      GET LGTH IN A 
      LDB Z 
      SZB           DID A FINAL CARRY OCCUR ? 
      INA,RSS       YES: L=L+1
      ISZ ADD13      NO:  Z=Z+1 
      LDB DISPL 
      JSB PLACE 
ADD13 DEF Z 
      JMP IADD,I    RETURN
      HED ** STRING ARITHMETIC ROUTINES - <ISUB> ** 
XAS   BSS 6         PARAMETER ADDRESS SAVE AREA 
      SPC 1 
ISUB  NOP           ENTRY/EXIT POINT
      JSB .ENTR     PASS PARAMETER ADDRESSS 
      DEF XAS 
      LDB *-1       PASS POINTER TO PARAMETER SAVE
      JSB INIT       AREA AND COMPUTE PSEUDO ADDR.
      JSB POINT     EXTRACT SIGNS AND DECIMAL PNTS. 
      JSB ALIGN     GO ALIGN THE POINTS 
      DLD PAD 
      DST XPAD      MOVE POINTERS TO LOCAL
      LDA X+.PNT. 
      LDB Y+.PNT. 
      JSB IMAX      DISPL=(PX MAX PY) 
      STA DISPL 
      LDA X+.SGN. 
      CPA Y+.SGN.   DO ARGUMENTS HAVE LIKE SIGNS ?
      JMP SUB1      YES - NORMAL SUBTRACT 
      STA Y+.SGN.   NO - SET SGN(Y)=SGN(X) AND GO 
      LDB ISUB       DO ADD INSTEAD.  RESET 
      STB IADD        RETURN ADDRESS. 
      JMP ADD2
      SPC 1 
* SUBTRACT X-STRING AND Y-STRING CHARACTERS, FORMING A DIFFER-
* ENCE IN THE INTERMEDIATE ARRAY 'Z'.  PRE-PAD AND POST-PAD 
* BOTH X AND Y SO AS TO ALIGN THEIR DECIMAL POINTS. 
      SPC 1 
SUB1  STA SIGN      POST SIGN OF RESULT STRING
      JSB GEN1      SET UP POINTERS AND COUNTS
      DLD JSBI3     SET POST-PADDING SWITCHES 'OFF' 
      STA SUB3+1
      STB SUB6+1
      LDA CLAI      SET PRE-PADDING SWITCHES 'ON' 
      STA SUB2
      STA SUB5
      SPC 1 
* PERFORM THE SUBTRACT OPERATION: 
      SPC 1 
SUB2  JMP SUB3      PRE-PAD X-STRING AS REQUIRED FOR
      BSS 0          ALIGNMENT (INITIALLY 'CLA')
      ISZ XPAD      ANY MORE PADDING NEEDED ? 
      JMP SUB4      YES - BYPASS CHARACTER FETCH
      LDA JMPI3     NO - SET SWITCH TO DISCONTINUE
      STA SUB2       PADDING FROM NOW ON. 
      SPC 1 
SUB3  LDA XLOC      FETCH X-STRING CHARACTER
      JSB GETCR 
      JSB GEN3      IF NULL, PAD WITH ZEROS 
      JSB NUMCK     VERIFY THE DIGIT
      JMP SUB3      IF POINT OR SIGN, FETCH AGAIN 
SUB4  STA TEMP      SAVE THE CHARACTER
      SPC 1 
SUB5  JMP SUB6      PAD Y-STRING ('CLA' INITIALLY)
      ISZ YPAD      ANY MORE NEEDED ? 
      JMP SUB7      YES - SKIP CHARACTER FETCH
      LDA JMPI4      NO - SET A SWITCH TO 
      STA SUB5        SKIP PADDING NEXT TIME.
      SPC 1 
SUB6  LDA YLOC      GO FETCH Y-STRING DIGIT 
      JSB GETCR 
      JSB GEN3      IF NULL, POST-PAD WITH ZERO 
      JSB NUMCK     VERIFY DIGIT
      JMP SUB6      IF POINT OR SIGN, FETCH AGAIN 
      CMA,INA       FORM -Y(I)
      SPC 1 
SUB7  ADA TEMP      FORM X(I)-Y(I)
      STA DIFF,I    POST DIFFERENCE 
      ISZ DIFF      BUMP POINTER
      ISZ LOOP      FINISHED ?
      JMP SUB2      NO - CONTINUE 
      SPC 1 
* PERFORM BORROW PROPAGATION IN DECIMAL ARRAY 'Z':  IF Z(I)<0 
* THEN Z(I)=Z(I)+10, AND Z(I+1)=Z(I+1)-1. 
      SPC 1 
      JSB GEN2      SET UP POINTERS AND COUNTS
      SPC 1 
SUB8  LDA DIFF,I    GET Z(I)
      ADA BORRO      FORM Z(I)-BORROW(I-1)
      SSA           RESULT<0? 
      JMP SUB10     YES - PROPAGATE THE BORROW
      STA DIFF,I    NO - NO BORROW
      CLA 
      SPC 1 
SUB9  STA BORRO     POST NEXT BORROW
      CCA 
      ADA DIFF      ADJUST Z-POINTER TO NEXT
      STA DIFF       DIGIT IN STRING. 
      ISZ LOOP      FINISHED ?
      JMP SUB8      NO - CONTINUE 
      JMP SUB11 
      SPC 1 
SUB10 ADA =D10      ADD 10 TO DIFFERENCE
      STA DIFF,I     AND POST D(I). 
      CCA           BORROW(I)=-1
      JMP SUB9
      SPC 1 
SUB11 LDA X+.SGN.   GET SIGN OF X 
      LDB BORRO     DID A FINAL BORROW OCCUR ?
      SZB 
      JMP SUB12     YES - WE MUST COMPLEMENT
      JSB OUTSN     NO - SGN(RESULT)=SGN(X) 
      SPC 1 
SUBEX LDA LGTH      GO CONVERT TO ASCII AND
      LDB DISPL      PLACE DECIMAL POINT. 
      JSB PLACE 
      DEF Z+1 
      JMP ISUB,I    RETURN
      SPC 1 
* A BORROW OCCURRED OUT OF Z(1) - WE MUST TAKE THE TENS 
* COMPLEMENT OF THE RESULT AND COMPLEMENT THE SIGN OF X 
* AS THE SIGN OF THE RESULT STRING. 
      SPC 1 
SUB12 CMA           COMPLEMENT SGN(X) 
      STA TEMP
      JSB GEN2      GO RESET POINTERS 
      DLD X         RESET LOCAL STRING POINTERS 
      DST XLOC,I     FROM COMMON COPY.
      DLD Y 
      DST YLOC,I
      LDA TEMP      GET SIGN OF RESULT
      JSB OUTSN      AND POST IT. 
      SPC 1 
SUB13 LDA DIFF,I    GET DIFFERENCE DIGIT
      CMA,INA       SUBTRACT FROM 10
      ADA BORRO     ADD IN BORROW(I-1)
      SSA           RESULT<0 ?
      JMP SUB15     YES - PROPAGATE 
      STA DIFF,I    NO - POST DIFFERENCE
      CLA           SET NEXT BORROW TO 0
      SPC 1 
SUB14 STA BORRO     POST NEXT BORROW
      CCA 
      ADA DIFF      ADJUST POINTER TO NEXT DIFIT
      STA DIFF
      ISZ LOOP      FINISHED ?
      JMP SUB13     NO - CONTINUE 
      JMP SUBEX     YES - EXIT NORMALLY 
      SPC 1 
SUB15 ADA =D10      ADD 10 TO DIFFERENCE
      STA DIFF,I
      CCA            AND SET NEXT BORROW =-1
      JMP SUB14 
      SPC 1 
      SKP 
* GENERAL PURPOSE SUBROUTINES USED IN <IADD> AND <ISUB> : 
      SPC 1 
GEN1  NOP           GENERAL SUBR. #1
      LDA ZARA
      INA
      STA SUM       SET UP SUM/DIFF POINTER IN Z
      LDA LGTH
      CMA,INA 
      STA LOOP      SET UP LOOP COUNTER 
      DLD X 
      DST XLOC,I    RESET LOCAL POINTER - X 
      DLD Y 
      DST YLOC,I     AND Y. 
      JMP GEN1,I    RETURN
      SPC 1 
GEN2  NOP           GENERAL SUBR. #2
      LDA ZARA
      ADA LGTH
      STA SUM       POINT TO Z(1) 
      LDA LGTH
      CMA,INA 
      STA LOOP      SET UP LOOP COUNTER 
      CLA 
      STA CARRY     SET CARRY/BORROW = 0
      JMP GEN2,I     RETURN 
      SPC 1 
GEN3  NOP           GENERAL SUBROUTINE #3 
      LDA GEN3      GET ADDRESS OF 'JSB OUTCR'
      ADA DM2        INSTRUCTION PRECEEDING.
      LDB PADON     GET POST-PAD 'ON' SWITCH
      STB A,I       TURN ON POST-PADDING
PADON CLA,RSS       EXECUTE THE SWITCH
DM2   DEC -2
      ADA =B60      RETURN ASCII "0"
      JMP GEN3,I    RETURN
      HED ** STRING ARITHMETIC ROUTINES - <IMULT> **
* <MULT> FORMS THE PRODUCT OF X-STRING AND Y=STRING, X=X*Y, 
* WHERE X AND Y MAY BE SIGNED OR UNSIGNED, FIXED POINT OR 
* FLOATING POINT STRINGS.  IF THE LENGTH OF THE RESULT STRING 
* (X) EXCEEDS 64 CHARACTERS, THE MESSAGE "12 OV" IS PRINTED 
* ON THE TTY, AND THE COMPUTER HALTS (102002).  THIS HALT IS
* IRRECOVERABLE.
      SPC 1 
* CALLING SEQUENCE - FORTRAN: 
      SPC 1 
*     ILRES=IMULT(IX,IXOF,IXLNE,IY,IYOF,IYLEN)
      SPC 1 
* IX/IY = X-STRING/Y-STRING ADDRESSES 
* IXOF/IYOF = X-STRING/Y-STRING OFFSETS, IN CHARACTERS. 
* IXLEN/IYLEN = X-STRING/Y-STRING LENGTHS, IN CHARACTERS. 
      SPC 1
* CALLING SEQUENCE - ASSEMBLER: 
      SPC 1 
*     EXT IMULT 
*     JSB IMULT       
*     DEF *+7       RETURN ADDRESS
*     DEF IX        X-STRING ADDRESS
*     DEF IXOF      X-STRING OFFSET (CHARS) 
*     DEF IXLEN     X-STRING LENGTH (CHARS) 
*     DEF IY        Y-STRING ADDRESS
*     DEF IYOF      Y-STRING OFFSET (CHARS) 
*     DEF IYLEN     Y-STRING LENGTH (CHARS) 
*     STA ILRES     POST LENGTH OF RESULT STRING(CHARS) 
      SPC 1 
PARAM BSS 6         PARAMETER ADDRESS SAVE AREA 
      SPC 1 
IMULT NOP           ENTRY/EXIT POINT
      JSB .ENTR     PASS PARAMETER ADDRESSES
      DEF PARAM 
      LDB *-1       GO COMPUTE PSEUDO ADDRESSES AND 
      JSB INIT       STORE THEM IN COMMON STORAGE.
      JSB POINT     GO EXTRACT SIGNS AND DECIMAL
      BSS 0          POINTS FOR X AND Y STRINGS.
      LDA X+?PNT
      ADA Y+?PNT
      STA DISPL     POINT DISPL=P(X)+P(Y) 
      LDA X+?LEN
      ADA Y+?LEN
      CMA,INA       FORM LGTH(X)+LGTH(Y)+2
      ADA DM2 
      LDB LCOR+?X 
      ADB LCOR+?Y   FORM LCOR(X)+LCOR(Y) IN (B) 
      CMB,INB 
      ADB A         FORM CORRECTED RESULT STRING
      STB LGTH       AND POST IN COMMON AREA. 
      ADB MSIZE     CHECK FOR RESULT STRING O'FLOW
      SSB,RSS       LGTH >64 CHARACTERS ? 
      JMP ERROR     YES - GO PRINT ERROR MSG. 
      CCA           ASSUME SIGN IS "-"
      LDB X+?SGN    GET SIGN OF X-STRING
      CPB Y+?SGN    SAME AS SIGN OF Y=STRING ?
      CLA           YES - LIKE SIGNS - "+"
      STA SIGN      NO - UNLIKE SIGNS - "-" 
      DLD X+?LEN    MOVE X-STRING AND Y-STRING
      DST XLOC,I     PSUEDO ADDRESS/LGTH TO 
      DLD Y+?LEN      LOCAL STORAGE AREA. 
      DST YLOC,I
      LDA LGTH
      CMA           ZERO THE INTERMEDIATE DECIMAL 
      LDB ZARA       ARRAY TO HOLD PARTIAL
      STA LOOP        PRODUCTS DURING MULTIPLY. 
      CLA 
      SPC 1 
MULT1 STA B,I       ZERO ONE WORD IN "Z"
      INB 
      ISZ LOOP      FINISHED ?
      JMP MULT1     NO - CONTINUE 
      STA XLOOP     SET XLOOP COUNT TO 0
      SPC 1 
* PERFORM MULTIPLICATION BY ACCUMULATING PARTIAL PRODUCTS 
* IN THE INTERMEDIATE DECIMAL ARRAY "Z".
      SPC 1 
MULT2 LDA XLOC      FETCH X-STRING CHARACTER
      JSB GETCR 
      JMP MULT5     END OF STRING 
      JSB NUMCK     VERIFY THE DIGIT
      JMP MULT2     IF POINT OR SIGN, FETCH AGAIN 
      STA XVAL      SAVE MULTIPLIER DIGIT 
      CLA 
      STA YLOOP     SET MULTIPLICAND INDEX TO 0
      SPC 1 
MULT3 LDA YLOC      INNER LOOP - FETCH Y-STRING 
      JSB GETCR      CHARACTER (MULTIPLICAND).
      JMP MULT4     END OF Y-STRING 
      JSB NUMCK     IF SIGN OR DECIMAL POINT, 
      JMP MULT3      RE-FETCH, OTHERWISE CONVERT
      MPY XVAL      FORM A PARTIAL PRODUCT IN (A) 
      LDB ZARA      COMPUTE A POINTER TO PREVIOUS 
      ADB XLOOP 
      ADB YLOOP     PARTIAL PRODUCT.
      INB 
      ADA B,I       ADD THIS ONE TO PREVIOUS
      STA B,I       PARTIAL PRODUCT AND STORE BACK. 
      ISZ YLOOP     BUMP Y-STRING INDEX 
      JMP MULT3     CONTINUE UNTIL END OF STRING
      SPC 1 
MULT4 DLD Y+?LEN    RESET Y-STRING POINTS 
      DST YLOC,I
      ISZ XLOOP     BUMP X-STRING INDEX 
      JMP MULT2     DO OUTER LOOP AGAIN 
      SPC 1 
* THE PRODUCT NOW EXISTS IN THE INTERMEDIATE ARRAY "Z". 
* PERFORM CARRAY PROPAGATION IN ARRAY "Z".
      SPC 1 
MULT5 LDA ZARA      POINT TO LEAST SIGNIFICANT
      ADA LGTH       DIGIT IN ARRAY "Z".
      STA SUM 
      LDA LGTH
      CMA,INA 
      STA LOOP      LOOP COUNTER - LGTH OF "Z"
      CLA 
      STA CARRY     INITIAL CARRY = 0 
      SPC 1 
MULTC LDB SUM,I     GET PREVIOUS SUM
      ADB CARRY     ADD IN NEXT CARRY 
      STB TEMP      SAVE
      ADB =D-10 
      SSB           GREATER THAN 10 ? 
      JMP MULT7     NO - NO CARRY GENERATED 
      LDA TEMP      YES - WE MUST PROPAGATE 
      CLB           A CARRY.
      DIV =D10
      SPC 1 
MULT6 STB SUM,I     PREVIOUS SUM = REMAINDER
      STA CARRY     QUOTIENT = NEXT CARRY 
      CCA
      ADA SUM       ADJUST "Z" POINTER
      STA SUM 
      ISZ LOOP      FINISHED ?
      JMP MULTC     NO - CONTINUE 
      JMP MULT8     YES 
      SPC 1 
MULT7 LDB TEMP      SUM=SUM+CARRY (<10) 
      CLA 
      JMP MULT6 
      SPC 1 
* CONVERT INTERMEDIATE ARRAY "Z" TO ASCII AND PLACE THE 
* DECIMAL POINT:
      SPC 1 
MULT8 LDA CARRY     POST LAST CARRY IN Z
      STA Z 
      CCA 
      ADA LGTH      ADJUST THE LENGTH 
      STA LGTH
      LDA IMULT     PICK UP CALLING PROGRAM ADDRESS AND 
      STA IADD      RETURN VIA ADD ROUTINE
      JMP ADD12     GO CONVERT TO ASCII 
      SPC 1 
ERROR JSB .ERRR     GO WRITE ERROR MESSAGE
      ASC 1,12
      ASC 1,OV
      HLT 2
%MOVF JMP *-1       FORCE IRRECOVERABLE HALT.