ASMB,L,C
*&FPPSW 
* 
* S/W ARITHMETIC ROUTINES 
* 
* THESE ROUTINES DO ALL THE SOFTWARE CALCULATIONS FOR TST00-TST09,TST15.
* 
*CREATED  780705
* EDITED 781218  1705  TO MAKE ER4,... FASTER-- ADB POS1=>INB 
*                      TO MAKE MPYOP FASTER...
*                      TO USE NEW MPYOP, AR16,MPYAD 
* EDITED 781219  1015  TO SHORTEN MPYOP..MPYAD,.. 
*                      TO CLEAN MPYOP 
* EDITED 781220  1455  TO ADD AR4N,ER4N,AR4M,ER4M 
*                      TO CHANGE EQLZ5 FOR NEW SHIFTS 
*                      TO CLE IN ADDOP B4 SUMOP 
*                      TO FIX AR16-- NEG #
* EDITED 781221  1020  TO ADD LL4M
*                      TO MOD DIVSH...
* EDITED 790102  2050  TO REMOVE LL4,ERM4, SPEED UP AR4M,AR4N 
*                2110  TO SPEED UP RND5,FIXOP,
*                2140  TO FIX RND5 BUG(WDCLR) SLB OVER SAX
* EDITED 790502  1000  TO ADD &NAME 
* 
* LAST CODE CHANGE  790102  2140  CC
* 
      NAM FPPSW     790121  2355  REV 1913  CC
* 
      ENT MPYOP,COM5,AR4,ER4,EL4,NORM5,SUMOP,ADDOP,EQLZ5
      ENT MOVFW,DIVOP,SUBOP,RND5,PAK5,UNPK5,EXPCK,FIXOP,FLTOP,TRNC5 
      ENT AR4M,AR4N 
      ENT LL4M
* 
* 
A     EQU 0 
B     EQU 1 
* 
* 
* 
      SUP 
* 
      SKP 
* 
      IFZ           IF ABS, PUT ON BP 
      ORB 
      XIF 
* 
* GLOBAL CONSTANTS
* 
POS0  DEC 0 
POS1  DEC 1 
POS2  DEC 2 
POS3  DEC 3 
POS4  DEC 4 
POS5  DEC 5 
POS64 DEC 64
PS127 DEC 127 
POSMX DEC 32767 
* 
NEG1  DEC -1
NEG3  DEC -3
NEG4  DEC -4
NEG5  DEC -5
NEG15 DEC -15 
NEG16 DEC -16 
* 
UPBYT OCT 177400
LWBYT OCT 377 
* 
      SKP 
* 
* GLOBAL VARIABLES
* 
RSLT  BSS 1 
RSLTL BSS 1 
SIGN  BSS 1 
CNT   BSS 1 
TMP   BSS 1 
STICK BSS 1 
WRDS  BSS 1 
* 
ACC   DEF *+1 
ACC3  BSS 1 
ACC2  BSS 1 
ACC1  BSS 1 
ACC0  BSS 1 
ACCE  BSS 1 
* 
AC2   DEF *+1 
AC23  BSS 1 
AC22  BSS 1 
AC21  BSS 1 
AC20  BSS 1 
AC2E  BSS 1 
* 
      IFZ           RETURN TO CUR PAGE
      ORR 
      XIF 
* 
* 
* 
* 
      SKP 
* 
* SUBR TO MPY TWO 5 WORD OPNDS B=XR+YR
* B,XR YR ARE DEFS TO BUFS
* A IS LOST 
* 
*SMPYOP 
MPYOP NOP 
      STB RSLT      RESULT =ADDR OF RSLT BUFFR
      STX MPX       SAVE X ADDR 
      STY MPY 
      CLA,CLE       CLEAR SIGN COUNTER
      STA SIGN
      LDB MPX,I     A=X3
      SSB,RSS       IF X3<0, X3=-X3,B=1 
      JMP TSTY1     TEST Y
      LDB MPX       A=X ADDR
      JSB COM5        * 
      ISZ SIGN
TSTY1 LBY 0         B=Y3
      CLE,SSB,RSS   IF Y3<0  Y3=-Y3,A=A+1 
      JMP CLRA      ELSE CONTINUE 
      CYB           B=ADDR OF Y 
      JSB COM5        * 
      ISZ SIGN
* 
CLRA  CLA,CLE       CLEAR ACCS
      STA ACC3
      STA ACC2
      STA ACC1
      STA ACC0
      STA AC23
      STA AC22
      STA AC21
      STA AC20
* 
      LDX ACC       X=ADDR OF ACC 
      LDY AC2       Y=ACC2
* 
      JSB MPYAD     MPY & ADD IN SUM
      BYT 3,3       LOW OPNDS 
      JSB AR16      SHIFT RIGHT 16 BITS (B=ACC) 
* 
      JSB MPYAD     MPY & ADD IN SUM
      BYT 202,3     SIGN BIT FOR MORE 
      BYT   3,2 
      JSB AR16      SHIFT RIGHT 16 BITS 
* 
      JSB MPYAD     MPY & ADD IN SUM
      BYT 203,1 
      BYT 201,3 
      BYT   2,2 
      JSB AR16      SHIFT RIGHT 16 BITS 
* 
      JSB MPYAD 
      BYT 203,0 
      BYT 200,3 
      BYT 202,1 
      BYT   1,2 
      JSB AR16      SHIFT RIGHT 16 BITS 
* 
      JSB MPYAD 
      BYT 202,0 
      BYT 200,2 
      BYT   1,1 
      JSB AR16      SHIFT RIGHT 16 BITS 
* 
      JSB MPYAD 
      BYT 201,0 
      BYT   0,1 
* 
      LDA MPX,I     LAST ONE
      MPY MPY,I     ITS POS.
      STB AC23      GOES IN UPPER WORDS 
      STA AC22
      CLA,CLE       CLEAR 2ND ACC. WORD, CIN
      STA AC21
      LDB ACC 
      JSB SUMOP     ADD LAST TERM 
* 
* 
      LDA MPX       GET X TO EXP
      ADA POS4
      LDA A,I 
      LDB MPY       B=BEXP
      ADB POS4
      ADA B,I       A=AEXP+YEXP 
      ADA POS1      CORRECTION
      LDB RSLT
      ADB POS4      B=REXP
      STA B,I       REXP=XEXP+YEXP+1
      LDA ACC 
      LDB RSLT
      MVW POS4
      LDB RSLT      NORM RESULT 
      LDA SIGN      IF SIGN ODD, RSLT=-RSLT 
      CLE,SLA 
      JSB COM5        * 
      JSB NORM5       * 
      JMP MPYOP,I   DRIVE HER HOME, BOYS
* 
* 
* 
MPYAD NOP           ROUTINE TO MPY 2 16BIT#S, ADD IN RUN. SUM 
MPYAL LDA MPYAD,I   GET 2ND OPND OFFSET 
      AND POS3      LOW BYTE
      ADA MPY       GET 2ND#
      LDB A,I 
      SZB,RSS       IF=0, NO OP 
      JMP MPYCK 
      LDA MPYAD,I   GET 1ST OPND OFFSET 
      ALF,ALF       UPPER BYTE
      AND POS3
      ADA MPX       GET 1ST#
      LDA A,I 
      SZA,RSS       IF=0, NO OP 
      JMP MPYCK 
      STA MPTA      SAVE A
      STB MPTB      AND B 
      MPY MPTB      16 BIT SIGNED MPY 
      STA MPTR      SAVE LOW
      LDA MPTA      GET ORIG... ADJ FOR SIGNED OPN
      SSA 
      ADB MPTB
      LDA MPTB
      SSA 
      ADB MPTA      B OK NOW
      LDA MPTR      A OK NOW
      STB AC22      PUT IN MID 2 WORDS OF ACC 
      STA AC21
      LDB ACC       ADD IN
      CLE           NO CARRY IN 
      JSB SUMOP 
MPYCK LDA MPYAD,I   TEST FOR MORE MPYS
      ISZ MPYAD     INC POINTER 
      SSA           IF SIGN BIT CLEAR, DONE 
      JMP MPYAL     LOOP FOR MORE 
      LDB ACC       SET B FOR CALLER
      JMP MPYAD,I   DONE
* 
* 
*LMPYOP 
* 
NEG63 DEC -63 
MPCNT BSS 1 
MPTMP BSS 1 
MPX   BSS 1 
MPY   BSS 1 
MPTA  BSS 1 
MPTB  BSS 1 
MPTR  BSS 1 
*EMPYOP 
* 
* 
      SKP 
* 
* THIS HERE IS A SUBROUTINE TO COMPLEMENT (NOT COMPLIMENT) A
* 5 WORD OPERAND, WHOSE ADDRESS IS IN B 
* YOU WILL LOSE A!
* POSSIBLE PROBLEM-- RETURNS 1.1000.... FOR COMPL. OF 0.1000....
* 
*SCOM5
COM5  NOP 
      STB TMP       SAVE RSLT ADDR
      ADB POS3      X0=-X0
      LDA B,I 
      CMA,CLE,INA 
      STA B,I 
      LDB TMP       X1=X1'+COUT(X0) 
      ADB POS2
      LDA B,I 
      CMA,SEZ,CLE 
      INA 
      STA B,I 
      LDB TMP       X2=X2'+COUT(X0) 
      ADB POS1
      LDA B,I 
      CMA,SEZ,CLE 
      INA 
      STA B,I 
      LDB TMP 
      LDA B,I      X3=X3'+COUT(X2)
      CMA,SEZ,CLE,RSS IF NO CIN, DONE 
      JMP STX3
      SSA,INA       ELSE INC, & CHECK FOR OVFLW 
      JMP TNRM      IF XIN WAS +, CHECK FOR NORM. OUTPUT
      CCE,SSA,RSS   CHECK FOR SIGN CHANGE, SET E
      CLE,RSS       IF SO, OK-- CLEAR E & STORE X3
      RAR           X3 WAS -1, SHIFT RIGHT & BUMP EXP 
STX3  STA TMP,I 
      ADB POS4      B=EXP ADDR
      SEZ,CLE       BUMP EXP IF OVFLW 
      ISZ B,I 
      JMP *+1       IN CASE THE TUKEY TRIES TO SKIP 
      LDB TMP       RESTORE TMP  ADDR 
      JMP COM5,I    I'LL TAKE A COLD BEER AFTER ALL THAT WORK 
TNRM  STA TMP,I     SAVE X0 
      CLE,ELA       CHECK FOR BIT 14=1
      SSA,RSS       IF NOT, THATS ALL FOR NOW 
      JMP COM5,I    RETURN
      STA TMP,I     ELSE NORMALIZE NUMBER 
      ADB POS4      DECREMENT EXPONENT
      LDA B,I 
      ADA NEG1
      STA B,I 
      LDB TMP       RESTORE B REG.
      JMP COM5,I
* 
*LCOM5
* 
*ECOM5
* 
      SKP 
* 
* SUBR TO SHIFT A 4 WRD OPND RIGHT 1 BIT, MSB=E,E=LSB 
* OPND ADDR IN B, A LOST
* 
*E
* 
* 
*S
AR4   NOP 
      STB TMP 
      LDA AR4       SET UP RETURN POINT FROM ER4
      STA ER4 
      LDA B,I       DO FIRST WORD, THEN JOIN ER4
      ERA,RAL 
      ARS 
      JMP EAR4      USE THE OTHER CODE
* 
* 
* 
*S
ER4   NOP 
      STB TMP 
      LDA B,I       A=X3,I
      ERA           X3=E,X3/2 
EAR4  STA B,I 
      INB 
      LDA B,I       X2=X2/2 
      ERA 
      STA B,I 
      INB 
      LDA B,I       X1=X1/2 
      ERA 
      STA B,I 
      INB 
      LDA B,I       X0=X0,2  E=LSB
      ERA 
      STA B,I 
      LDB TMP 
      JMP ER4,I 
* 
* 
      SKP 
* 
* SUBR TO A 4 WORD OPND LEFT 1 BIT, LSB=E, E=MSB
* MODIFIES A
* 
* 
*E
* 
* 
*S
EL4   NOP 
      STB TMP 
      ADB POS3      LOW MANT
      LDA B,I 
      ELA 
      STA B,I 
      LDB TMP       GET 2ND MANT ADDR 
      ADB POS2
      LDA B,I 
      ELA 
      STA B,I 
      LDB TMP 
      INB 
      LDA B,I 
      ELA 
      STA B,I 
      LDB TMP 
      LDA B,I 
      ELA 
      STA B,I 
      JMP EL4,I 
* 
* 
* 
* 
* 
* 
* 
      SKP 
*S
* ROUTINE TO SHIFT 4 WORD OPND RIGHT 16 BITS (1 WORD) 
* B=ADDR OF OPND,    ...A DESTROYED 
* 
AR16  NOP 
      STB TMP       SAVE ADDR 
      CLB 
      LDA TMP,I     1ST WORD
      SSA           IF NEG, MAKE TOP WORD=-1
      CCB 
      STB TMP,I     STORE HI WORD 
      ISZ TMP       NEXT WORD 
      LDB TMP,I 
      STA TMP,I 
      ISZ TMP       NEXT
      LDA TMP,I 
      STB TMP,I 
      ISZ TMP       LAST
      LDB TMP,I     SAVE LAST WORD FOR RTN
      STA TMP,I 
      LDA B         IN A
      LDB TMP       RESTORE B REG 
      ADB NEG3
      JMP AR16,I    DONE
* 
* 
* 
* 
* 
      SKP 
*S
* ROUTINE TO SHIFT A 4 WD OPND RIGHT ARITH N BITS 
* 
* ENTRY: A=#BITS, B=ADDR
* RETN:  E=SET IF LOST BIT
* 
AR4N  NOP 
      CPA POS1      IF 1 BIT SHIFT, SPECIAL 
      JMP AR4N4 
* 
      STA AR4NC     SAVE CNT
      CLA           CLEAR STICK BIT 
      STA AR4NS 
AR4N1 LDA AR4NC 
      CLE,SZA,RSS   IF CNT=0, DONE (CLEAR E FOR EXIT) 
      JMP AR4N3 
      ADA NEG16     TEST FOR >16 SHIFT
      SSA 
      JMP AR4N2     <16, SLOW TYPE
      STA AR4NC     SAVE CNT
      JSB AR16      FAST SHIFT
      SZA           TEST FOR LOST BITS
      ISZ AR4NS     IF SO, INC STICKY BIT 
      JMP AR4N1 
* 
AR4N2 ADA POS16     REFORM CNT
      JSB AR4M      SHIFT OPND SLOW 
      CLE,SZA       TEST FOR LOST BITS
      ISZ AR4NS 
AR4N3 LDA AR4NS     IF LOST BITS, SET E 
      SZA 
      CCE 
      JMP AR4N,I    DONE
* 
AR4N4 JSB AR4       1 BIT SHIFT 
      JMP AR4N,I    DONE
* 
* 
AR4NC BSS 1 
AR4NS BSS 1 
* 
* 
* 
* 
* 
      SKP 
*S
* ROUTINE TO SHIFT 4WD# M BITS (<=16) RIGHT, ARITH
* ENTRY:  B=OPND ADDR, A= #BITS 
*         JSB AR4M
* 
* ON RTN, A=SHIFTED OUT BITS
* 
* 
AR4M  NOP 
      STB AR4MB     SAVE ADDR 
      INB           ALSO SET NEXT WD PTR
      STB AR4MA 
      AND POS15     ONLY 4 BIT SHIFT FIELD
      ADA ASR       FORM OPCODE 
      STA ASR2
      STA ASR3
      STA ASR4
      STA ASR5
* 
      LDB AR4MB,I   GET ORIG HI WORD
      LDA AR4MA,I   NXT WORD
ASR2  NOP           2 WORD SHIFT
      STB AR4MB,I   SAVE HI WORD
      LDB AR4MA,I   GET ORIG NEXT WORD
      STA AR4MA,I   REPLACE WITH SHIFTED VERSION
      ISZ AR4MA     POINTER TO NEXT WORD
* 
      LDA AR4MA,I   NXT WORD
ASR3  NOP           2 WORD SHIFT
      LDB AR4MA,I   GET ORIG NXT WORD 
      STA AR4MA,I   REPLACE W/ SHIFTED VERSION
      ISZ AR4MA     POINT TO NXT WORD 
* 
      LDA AR4MA,I   NXT WORD
ASR4  NOP           2 WORD SHIFT
      LDB AR4MA,I   GET ORIG NEXT WORD
      STA AR4MA,I   REPLACE WITH SHIFTED VERSION
* 
      CLA           WILL GET SHIFTED OUT BITS 
ASR5  NOP           2 WORD SHIFT
* 
      LDB AR4MB     RESTORE  OPND ADDR
      JMP AR4M,I    DONE
* 
* 
* 
ASR   ASR 16        INSTR. BASE 
AR4MA BSS 1 
AR4MB BSS 1 
* 
* 
* 
* 
* 
      SKP 
*S
* ROUTINE TO SHIFT 4WD# M BITS (<=16) LEFT, LOGICAL 
* ENTRY:  B=OPND ADDR, A= #BITS 
*         E= BIT TO SHIFT IN LEFT 0 OR 1
*         JSB LL4M
* 
* 
* 
LL4M  NOP 
      CPA POS1      IF SHIFT=1, SPECIAL 
      JMP LL4M1 
      STB LL4MB     SAVE ADDR 
      INB           SET UP OTHER ADDRS
      STB LL4A1 
      INB 
      STB LL4A2 
      INB 
      STB LL4A3 
      AND POS15     ONLY 4 BIT SHIFT FIELD
      ADA LSL       FORM OPCODE 
      STA LSL1
      STA LSL2
      STA LSL3
      STA LSL4
      CLA,SEZ       IF E SET, A=-1
      CCA 
* 
      LDB LL4A3,I   GET ORIG LO WORD
LSL1  NOP           2 WORD SHIFT
      LDA LL4A3,I   GET ORIG LO WORD
      STB LL4A3,I   REPLACE WITH SHIFTED VERSION
* 
      LDB LL4A2,I   NXT WORD
LSL2  NOP           2 WORD SHIFT
      LDA LL4A2,I   GET ORIG NEXT WORD
      STB LL4A2,I   REPLACE WITH SHIFTED VERSION
* 
      LDB LL4A1,I   NXT WORD
LSL3  NOP           2 WORD SHIFT
      LDA LL4A1,I   GET ORIG NXT WORD 
      STB LL4A1,I   REPLACE W/ SHIFTED VERSION
* 
      LDB LL4MB,I   NXT WORD
LSL4  NOP           2 WORD SHIFT
      STB LL4MB,I   GET ORIG NEXT WORD
* 
      LDB LL4MB     RESTORE  OPND ADDR
      JMP LL4M,I    DONE
* 
LL4M1 JSB EL4       1 BIT SHIFT 
      JMP LL4M,I    DONE
* 
* 
* 
LSL   LSL 16        INSTR. BASE 
LL4MX BSS 1 
LL4MB BSS 1 
LL4A1 BSS 1 
LL4A2 BSS 1 
LL4A3 BSS 1 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* 
      SKP 
* SUBR TO NORMALIZE A 5 WRD OPERAND 
* ADDR OF OPND IN B,  A LOST
* 
*SNORM5 
NORM5 NOP 
      LDA NEG64     INITIALIZE COUNTER
      STA NMCNT 
* 
NMLP  LDA B,I 
      ELA           CHECK MOST SIG. BITS FOR NORMALIZATION
      CMA,SEZ,SSA,RSS 
      JMP NMZD      IF BITS=01, NORMALIZED
      SEZ,CLE,SSA 
      JMP NMZD      OR IF BITS=10 
      JSB EL4         IF NOT NORM.  SHIFT LEFT & TEST AGAIN 
      ISZ NMCNT     CHECK FOR MANT=0
      JMP NMLP      IF NOT CONTINUE 
      STO           IF SO, SET OVFLW,E  EXP=0 
      CLA 
      ADB POS4
      STA B,I 
      ADB NEG4
      CCE 
      JMP NORM5,I 
NMZD  ADB POS4      RSLT EXP= OPND EXP-#SHIFTS
      LDA NMCNT 
      ADA POS64     A=#SHIFTS 
      CMA,INA 
      ADA B,I 
      STA B,I 
      ADB NEG4
      JMP NORM5,I 
* 
*LNORM5 
* 
NEG64 DEC -64 
NMCNT BSS 1 
*ENORM5 
* 
      SKP 
* 
* SUBR TO ADD TWO 4 WORD OPNDS  B=XR+YR+E 
* RETURNS COUT,OVFLW,  A LOST 
* 
* 
*SSUMOP 
SUMOP NOP 
      STB TMP       SAVE X,Y,TMP
      STX SMX 
      STY SMY 
* 
      LDA SMX       LOW MANT
      ADA POS3
      LDA A,I 
      LDB SMY 
      ADB POS3
      SEZ,CLE       IF CIN, INC WORD
      INA 
      ADA B,I       ADD IN 2ND OPND 
      LDB TMP       PUT IN RSLT 
      ADB POS3
      STA B,I 
* 
      LDA SMX 
      ADA POS2
      LDA A,I 
      LDB SMY 
      ADB POS2
      SEZ,CLE 
      INA 
      ADA B,I 
      LDB TMP 
      ADB POS2
      STA B,I 
      LDA SMX       3RD MANT
      ADA POS1
      LDA A,I 
      LDB SMY 
      ADB POS1
      SEZ,CLE 
      INA 
      ADA B,I 
      LDB TMP 
      ADB POS1
      STA  B,I
* 
      CLO 
      LDA SMX,I     A=X3
      LDB SMY,I     B=Y3
      SEZ,CLE       IF CIN INC RSLT(3)
      INA 
      SOC           IF OVFLW, MUST DO SPECIAL ADD 
      JMP SPAD
      ADA B         A=X3+Y3+COUT(2) 
      STA TMP,I     RSLT(3)=A 
      LDB TMP       B=ADDR OF TMP 
      JMP SUMOP,I   THATS ALL FOLKS 
* 
SPAD  ADA B         A=X3+Y3+COUT(2) 
      STA TMP,I     RSLT(3)=A 
      SSA,RSS       IF A>0, THEN Y3<0-- CLEAR OVFLW 
      CLO 
      LDB TMP       RESTORE TMP  ADDR 
      JMP SUMOP,I   GO HOME 
* 
*LSUMOP 
* 
SMX   BSS 1 
SMY   BSS 1 
*ESUMOP 
* 
      SKP 
* 
* SUBR TO ADD 2 5 WORD OPNDS BR=XR+YR 
*  MODIFIES A,E,OVFLW 
* 
* 
*S
ADDOP NOP 
      STB RSLT      SAVE RESULT ADDR
      CXA           GET MOST SIG. WORD OF 1ST OPND
      LDA A,I 
      CLE,SZA,RSS   IF NOT=0, CHECK 2ND OPND
      JMP AZERO     IF=0, RSLT EXP=YEXP 
      CYA           A=MOST SIG. WORD OF 2ND OPND
      LDA A,I 
      SZA,RSS       IF NOT=0, EQUALIZE OPNDS
      JMP *+2       ELSE RSLT EXP=XEXP
      JSB EQLZ5       EQUALIZE OPNDS
      LAX 4         RSLT EXP = XEXP 
      LDB RSLT
STEXP ADB POS4
      STA B,I 
      LDB RSLT
      CLE           NO CIN
      JSB SUMOP        ADD OPNDS
      SOC           IF OVFLW, ADJUST RSLT 
      JSB MOVFW 
      JSB NORM5 
      JMP ADDOP,I 
AZERO LAY 4         A=YEXP
      JMP STEXP 
* 
      SKP 
* 
* SUBR TO EQUALIZE 2 5 WORD OPERANDS, XR&YR, WHICH ARE DEFS TO BUFS 
* MODIFIES A,B,E
* 
* 
*SEQLZ5 
EQLZ5 NOP 
      LBX 4         A=XEXP
      LAY 4         B=-YEXP 
      CMA,INA 
      ADA B         A=XEXP-YEXP 
      SSA,RSS       IF +, COMPL & TEST
      JMP XGTY
      ADA POS64     A=XEXP-YEXP+64
      LBY 4         XEXP=YEXP 
      SBX 4 
      CXB           B=XR
      SSA           IF<0,SWAMP-- X=0
      JMP SET0
      JMP SHIFT     ELSE SHIFT Y RIGHT
* 
XGTY  CMA,INA       A=YEXP-XEXP+64
      ADA POS64 
      LBX 4         YEXP=XEXP 
      SBY 4 
      CYB           B=YR
      SSA           IF <0, SWAMP-- Y=0
      JMP SET0
SHIFT ADA NEG65     B= =#SHIFTS-1 
* 
* 
* 
      CMA           COMPL CNT 
      JSB AR4N      SHIFT IT
      SEZ,RSS       CHECK FOR STICKY BIT
* 
      JMP EQLZ5,I 
      ADB POS3      OPND(0)=IOR(OPND(0),1)
      LDA B,I 
      IOR POS1
      STA B,I 
      JMP EQLZ5,I 
* 
SET0  CLA           CLEAR OPND
      STA B,I 
      INB 
      STA B,I 
      INB 
      STA B,I 
      CLE,INB       E=0 FOR SUMOP CALL FROM ADDOP 
      STA B,I 
      JMP EQLZ5,I 
* 
*LEQLZ5 
* 
NEG65 DEC -65 
*EEQLZ5 
* 
* 
* 
      SKP 
* 
* SUBR TO ADJUST OPND AFTER MANT OVERFLOW, OPND ADDR IN B 
* MODIFIES A,E
* 
*E
*S
MOVFW NOP 
      STB RSLT      SAVE OPND ADDR
      JSB ER4         SHIFT OPND BACK ONE BIT 
      LDA B,I       A=OPND(3) 
      ADB POS3      B=OPND(0) ADDR
      SEZ,CLE,RSS   IF LSB=1, CHECK FOR SIGN OF OPND
      JMP EXPUP 
      SSA,RSS       IF A<0, SET LSB OF OPND=1 
      JMP EXPUP 
      LDA B,I 
      IOR POS1
      STA B,I 
EXPUP INB           B=EXP ADDR
      ISZ B,I       EXP =EXP + 1
      JMP *+1       IT COULD SKIP 
      LDB RSLT      RESTORE OPND ADDR (BE KIND TO YOUR PARENTS) 
      JMP MOVFW,I   NOW GET OUT OF THIS HOLE
* 
      SKP 
* 
* SUBR TO DIVIDE TWO 5 WORD OPERANDS, BR=XR/YR
* 
* 
*SDIVOP 
DIVOP NOP 
      STB RSLT      SAVE REGS 
      STX DVX 
      STY DVY 
      CLA,CLE 
      STA SIGN      CLEAR SIGN COUNTER
      STA ACC0      CLEAR Q 
      STA ACC0-1
      STA ACC0-2
      STA ACC0-3
      STA ACC0+1
      LDB P4096     B=EXP OVERFLOW, IE TOO LARGE -- 4096
      LDA DVY,I     A=MOST SIG. WORD OF 2ND OPND
      SZA,RSS       IF NOT=0, CHECK 2ND OPND
      JMP EXIT0     IF 2ND OPND=0, RSLT EXP=TOO LARGE --OVFLW 
      LDA DVX,I     A=MOST SIG. WORD OF 1ST OPND
      SZA,RSS       IF=0, RETURN ZERO 
      JMP RTN0      IF=0, CLEAR RESULT
      LDA DVY       YCOM=YR 
      LDB YCOM
      MVW POS5
      LDA DVX,I 
      SSA,RSS       IF XR<0, XR=-XR, INC SIGN COUNT 
      JMP TSTY      ELSE TEST YR
      LDB DVX 
      JSB COM5        * 
      ISZ SIGN
TSTY  LDA DVY,I     A=Y3
      LDB DVY 
      SSA           IF Y<0, INC SIGN
      ISZ SIGN
      CLE,SSA,RSS   IF Y3<0, YR=-YR 
      LDB YCOM      ELSE YCOM=-YR 
      JSB COM5        * 
      LAX 4         A=XEXP
      LBY 4         B=-YEXP 
      CMB,INB 
      ADA B         RSLT EXP=XEXP-YEXP+1
      INA 
      LDX RSLT
      SAX 4 
      LDA YCOME     A=YCOM EXP-YEXP 
      ADA B 
      CLE,SZA,RSS   IF=, OK-- GO TO DIVIDE
      JMP DIVST 
      LDA DVX       IF NOT=, Y=-1, RSLT=-X
      LDB RSLT
      MVW POS4
      JMP TSTR      TEST FOR SIGN OF X
* 
DIVST LDA NEG62     SET LOOP COUNT
      STA DVCNT 
      LDX DVX 
DIVLP LDA DVX,I     A='SIGN' OF X 
      LDB DVY 
      CLE,SSA,RSS   IF X>0, Q0=1, X=X-Y 
      LDB YCOM      IF X<0, X=X+Y,Q0=0
      CBY           PUT Y OR Y' IN YR 
      LDB DVX 
      JSB SUMOP        X=X+-Y 
      CLE           NO SHIFT IN 
      JSB EL4         X=X*2 
      CME           Q0=-SIGN OF X 
      LDB ACC 
      JSB EL4         Q=Q*2 
DIVSH LDA DVX,I     IF 2 HIGH BITS =00 OR 11, CONTINUE SHIFT
* 
* 
* 
      LDB NEG15     SET UP TMP CNT
      CLE,SSA       IF NEG, MAKE POS
      CMA,CCE       ALSO SET E
DIVS1 RAL           TEST NEXT BIT 
      SSA           TEST FOR BIT SET
      JMP DIVS2     IF SET SHIFT
      ISZ DVCNT     TEST COUNT
      JMP *+2       IF NOT=0, CONTINUE
      JMP DIVS3     IF DONE, FORCE SHIFT
      ISZ B         TEST FOR SHORT COUNT<15 
      JMP DIVS1     LOOP
      JMP DIVS2 
DIVS3 ISZ B 
      NOP 
* 
DIVS2 LDA B         ADJ COUNT 
      AND POS15     DONT SET E,O
      ADA POS15 
      AND POS15 
      STA DVCN2     SAVE CNT
      SZA,RSS       IF=0, DONE
      JMP DVASB 
      LDB ACC       ACC ADDR
      JSB LL4M      SHIFT N PLACES
      CLE           NO LOW BITS 
      LDA DVCN2     GET COUNT AGAIN 
      LDB DVX       SHIFT OPND
      JSB LL4M
      LDA DVCNT     IF COUNT=0, DONE
      SZA 
      JMP DIVSH     ELSE DO AGAIN 
* 
* 
TRSLT LDA ACC       RSLT=ACC
      LDB RSLT
      MVW POS4
TSTR  LDB RSLT
      JSB NORM5       NORMALIZE RESULT
      ADB POS3      INDUCE ROUND FOR ANY LOW BITS IF NEG
      LDA B,I       IE,SET LSB OF LAST WORD 
      IOR POS1
      STA B,I 
      LDB RSLT
      LDA SIGN      IF SIGN ODD, RSLT=-RSLT 
      CLE,SLA 
      JSB COM5
      LDX DVX       SET EM UP JOE 
      LDY DVY 
      JMP DIVOP,I   IS IT SOUP YET? 
* 
DVASB ISZ DVCNT     X WAS NORMALIZED, CHECK IF DONE 
      JMP DIVLP     NO -- PLAY IT AGAIN SAM 
      LDB ACC       YES -- BUT Q NEEDS ONE MORE SHIFT 
      JSB EL4         DONT CARE ABOUT LSB-- WE HAVE ENOUGH EXTRA
      JMP TRSLT 
EXIT0 LDA RSLT      STORE ILLEGAL EXP IN RESULT EXP 
      ADA POS4      A=EXP ADDR
      STB A,I 
      LDB RSLT
      JMP DIVOP,I   THAT SHOULD DO IT FOR NOW!
* 
RTN0  LDA ACC       ZERO OUT RESULT 
      LDB RSLT
      MVW POS5
      LDB RSLT
      JMP DIVOP,I 
* 
*LDIVOP 
* 
P4096 DEC 4096
NEG62 DEC -62 
DVCNT BSS 1 
DVCN2 BSS 1 
DVX   BSS 1 
DVY   BSS 1 
YCOM  DEF *+1 
      BSS 4 
YCOME BSS 1 
*EDIVOP 
* 
* 
      SKP 
* 
* SUBR TO SUBTRACT TWO 5 WORD OPERANDS BR=XR-YR 
* 
* 
*E
*S
SUBOP NOP 
      STB RSLT      SAVE RESULT ADDR
      CYB 
      JSB COM5         X-Y=X+(-Y), Y=-Y 
      LDB RSLT
      JSB ADDOP       * 
      JMP SUBOP,I 
* 
      SKP 
* 
*ROUTINE TO ROUND 2,3, AND 4 WORD FLOATING POINT NUMBERS
* 
*SRND5
RND5  NOP 
      STB RSLT
      STX RNX 
      STY RNY 
      CPA POS5      IF WRDS=5, SET TO 4 
      LDA POS4
      STA WRDAJ 
* 
* 
      CMA           GET INDEX TO RNDING WORD
      ADA RNDBF 
      CAY           PUT IN Y
* 
      LDA RSLT,I    A='SIGN' OF OPND
      ELA           E=CIN=1 IF OPND >=0  IE ADD 200B
      CME 
      LDB RSLT
      LDX RSLT
      JSB SUMOP        RSLT=RSLT+ROUND WORD 
      SOC 
      JSB MOVFW       * 
      CLA,CLE 
      LDB WRDAJ 
      RBR,SLB,RBL   IF 4 WORDOP, NO WORDS TO CLEAR
      JMP WDCLR 
WDMSK ADB NEG1      MASK OFF LOWER 8 BITS OF LOW WORD 
      ADB RSLT
      LDA B,I 
      AND UPBYT 
      STA B,I 
      LDA RSLT,I    CHECK FOR UNNORMALIZED NUMBER 
      LDB RSLT
      ELA 
      SEZ,SSA       ONLY PROBLEM IF NEG, IE 1011111...+1
      JSB NORM5       * 
      LDX RNX 
      LDY RNY 
      JMP RND5,I
* 
WDCLR SLB           IF 2WD CLEAR 2 WORDS
      JMP WDCL2 
      SAX 2         CLEAR OPND1 IF 2WDS 
WDCL2 SAX 3         CLEAR OPND0 IF NOT 4 WDS
      JMP WDMSK 
* 
*LRND5
* 
NEG2  DEC -2
WRDAJ BSS 1 
RNX   BSS 1 
RNY   BSS 1 
* 
RNDBF DEF RNDBE 
      OCT 0 
      OCT 0 
      OCT 0 
      OCT 177 
      OCT 177777
RNDBE OCT 177777    POINTS TO LAST WORD OF BUFFER 
*ERND5
* 
* 
* 
      SKP 
* SUBR TO PACK 5 WORD FP#S INTO 2,3, AND 4 WORD #S
* OPERAND ADDR IN B, #WORDS IN A
* 
* 
*E
*S
PAK5  NOP 
      STB RSLTL 
      STA WRDS
      ADB POS4      A=OPND EXP
      LDA B,I 
      RAL           PUT SIGN IN LSB 
      STA B,I       PUT ROTATED EXPONENT BACK 
      AND LWBYT     ONLY WANT LOW 8 BITS OF EXP 
      STA TMP       SAVE THE EXP HALF 
      ADB NEG5      GET THE LOWER MANTISSA WORD 
      ADB WRDS
      LDA B,I 
      AND UPBYT     THROW AWAY LOWER HALF 
      IOR TMP       OR IN  THE EXP
      STA B,I       REPLACE LOW WORD
      LDB RSLTL 
      JMP PAK5,I    THATS ALL THERE IS TO IT! 
* 
* 
* 
      SKP 
* SUBR TO UNPAK 2,3, AND 4 WORD OPERANDS INTO 5 WORDS 
* B=ADDR OF OPERAND, A=# WORDS
* 
*SUNPK5 
UNPK5 NOP 
      STB TMP 
      STA WRDS
      STX UPX 
      ADB NEG1      B=LOW MANT ADDR 
      ADB WRDS
      CPA POS5      IF 5 WORDS, SPECIAL 
      JMP UP5WD 
      STB RSLTL 
      LDA B,I       A=LOW OPND WORD 
      AND LWBYT     FORM EXPONENT HALF
      SLA,RAR       MOVE SIGN TO BIT 15, EXTEND IF NECESSARY
      IOR NEGXP 
      LDB TMP       STORE EXP IN 5TH WORD 
      ADB POS4
      STA B,I 
      ADB NEG5      TRUNCATE LOW MANT TO UPPER BYTE 
      ADB WRDS
TRMNT LDA B,I 
      AND UPBYT 
      STA B,I 
      CLB 
      LDX TMP       CLEAR OUT EXTRA WORDS 
      LDA WRDS
      ERA,SLA,RAR   IF 2 OR 3WDS, CLEAR OPND3 
      SBX 3 
      SEZ,SLA,RSS   IF 2WDS, CLEAR OPND2
      SBX 2 
      LDX UPX 
      LDB TMP 
      JMP UNPK5,I   SET THE CHUTE AND LET IT FLY
UP5WD LDA B,I       ADJUST EXPONENT-- ROTATE RIGHT 1 BIT
      RAR 
      STA B,I 
      ADB NEG1      NOW TRUNCATE MANTISSA JUST IN CASE
      JMP TRMNT 
* 
*LUNPK5 
* 
NEGXP OCT 177600
UPX   BSS 1 
*EUNPK5 
* 
* 
      SKP 
* SUBR TO CHECK FOR OVERFLOW & UNDERFLOW & SET O IF SO
* BR=ADDR OF OPND, E=0 FOR NORMAL, 1 FOR EXPANDED EXPONENT
* 
*E
* 
*SEXPCK 
EXPCK NOP 
      LDA PS128     A=STANDARD MAX. EXPONENT (127)
      SEZ           IF NORMAL, STORE IT, ELSE USE EXPANDED EXPONENT 
      LDA PS512     EXPANDED EXPONENT MAX. (512 ) 
      STA EXPMX 
      STB TMP 
      STX XPX 
      ADB POS4
      LDA B,I       A=OPND EXP
CLE   SSA,RSS       IF EXP>0,A=-EXP 
      CMA 
      ADA EXPMX 
      CLO 
      SSA,RSS       IF EXP IN RANGE GO HOME 
      JMP RSTRB 
      STO           OVERFLOW FLAG 
      LDA B,I       CHECK SIGN OF EXP 
      SSA           IF <0, UNDERFLOW
      JMP UNFLW 
      LDA PS127     ELSE SET TO MAX + 
      STA B,I 
      LDB TMP       SET 1ST WORD TO 32767 
      LDA POSMX 
      STA B,I 
      INB 
      CCA,CLE       SET NEXT 2 WORDS TO -1
      STA B,I 
      INB 
      STA B,I 
      INB 
      LDA UPBYT     4TH WORD= UPPER 8 BITS ONLY 
      STA B,I 
      LDX XPX 
RSTRB LDB TMP 
      JMP EXPCK,I 
* 
UNFLW CLA 
      LDB TMP 
      XBX           X=RSLT ADDR 
      SAX 0         CLEAR OPND
      SAX 1 
      SAX 2 
      SAX 3 
      SAX 4 
      XBX           RESTORE X,B 
      JMP EXPCK,I   SET SAILS FOR THE INDIES
* 
*LEXPCK 
* 
EXPMX BSS 1 
XPX   BSS 1 
PS128 DEC 128 
PS512 DEC 512 
*EEXPCK 
* 
* 
      SKP 
* 
* ROUTINE TO CONVERT 5 WORD FP#S INTO 1 AND 2 WORD INTEGERS 
*    ON ENTRY B=OPERAND ADDR, A=0 FOR SINGLE, 1 FOR DOUBLE INTEGER
* 
* 
*E
*S
FIXOP NOP 
      STA INTWD     SAVE SINGLE-DOUBLE FLAG 
      STB RSLT      SAVE OPERAND ADDR 
      SZA           IF DOUBLE, A=16-- #SHIFTS=15+16*INTWD-EXP 
      LDA NEG16     A<=-#SHIFTS 
      ADA NEG15 
      ADB POS4      ADD EXP 
      ADA B,I 
      STA CNT       CNT=-#SHIFTS
      CLO           CLEAR OVERFLOW FOR RETURN (SET LATER) 
      CLA           CLEAR OUT STICKY BIT & EXPONENT 
      STA STICK 
      STA B,I 
      LDB RSLT
      LDA CNT       TEST IF CNT NEG 
      SZA,RSS       IF CNT=0,CHECK FOR ROUND
      JMP FXTRD 
      SSA,RSS       IF CNT>0, OVERFLOW
      JMP FIXOV     GO TEST 
* 
      CMA,INA       NEGATE COUNT
      JSB AR4N      SHIFT CNT TIMES 
      ELA           LSB OF A=STICK BIT
      STA STICK 
* 
FXTRD ADB INTWD     B POINTS TO LSW OF INTEGER, CHECK FOR ROUND 
      LDA RSLT,I    IF #>=0, CLEAR & RETURN 
      SSA,RSS       ELSE CHECK FOR ROUND
      JMP FXCLR 
      INB           B=ADDR OF 1ST ROUND WORD
      CLA           CLEAR A FOR COMPARES
      CPA B,I       IF WORD NOT=0, ROUND
      JMP *+2 
      JMP FIXRD 
      INB           AND AGAIN 
      CPA B,I 
      JMP *+2 
      JMP FIXRD 
      INB           ONE MORE TIME (COULD BE EXP, BUT=0) 
      CPA B,I 
      JMP *+2 
      JMP FIXRD 
      LDB RSLT
      CPA STICK     NOW TEST FOR LOST BITS
      JMP FIXOP,I   IF=0, RETURN
* 
FIXRD LDB RSLT
      ADB INTWD     GET LSW OF RESULT 
      ISZ B,I       IF NOT=0, DONE-- CLEAR REST & RETURN
      JMP FXCLR 
      CPB RSLT      IF SINGLE INTEGER, CLEAR & RETURN 
      JMP FXCLR 
      ISZ RSLT,I    ELSE ROUND UPPER WORD 
      JMP *+1       IT COULD SKIP!
FXCLR INB           NOW CLEAR LOWER WORDS 
      CLA           CLEAR A 
      STA B,I 
      INB 
      STA B,I 
      INB 
      STA B,I       COULD BE EXP-- OK 
      LDB RSLT
      JMP FIXOP,I 
* 
* 
* 
FIXOV LDA POSMX     A=32767=OVERFLOW #
      LDB INTWD     B=0 FOR SINGLE, -1 FOR DOUBLE INTEGER 
      CMB,INB       B= -INTWD 
      DST RSLT,I    PUT IN RESULT 
      STO           OVERFLOW RETURN 
      LDB RSLT      SET UP FPR FXCLR
FXCLS ADB INTWD     B=ADDR OF LOWER RESULT WORD 
      JMP FXCLR 
* 
* 
INTWD BSS 1 
* 
* 
      SKP 
* 
* ROUTINE TO CONVERT SINGLE & DOUBLE INTEGERS TO 5 WORD FP #S 
* A=0 FOR SINGLE, 1 FOR DOUBLE,  B=OPND ADDR
* A,E LOST
* 
* NOTE: CALLER MUST TRUNCATE RESULT IF DOUBLE FLOAT TO 32 BITS! 
* 
*E
* 
*S
FLTOP NOP 
      STB RSLT      SAVE RSLT ADDR
      ADB POS4      EXP=15+INTWD*16 
      SZA 
      LDA POS16 
      ADA POS15 
      STA B,I 
      LDB RSLT      NORMALIZE EXP, GET FP # 
      JSB NORM5       * 
      JMP FLTOP,I 
* 
POS15 DEC 15
POS16 DEC 16
* 
* 
      SKP 
* 
* ROUTINE TO TRUNCATE A 5 WORD OPERAND TO 2,3,4, OR 5 WORDS (FP)
* ON ENTRY A=#OUTPUT WORDS, B=OPERAND ADDRESS 
* A,E LOST
* 
*E
*S
TRNC5 NOP 
      STB TMP       SAVE OPND ADDR
      STA WRDS      SAVE #WORDS 
      ADA NEG4      IF 4 OR 5 WORDS, SPECIAL
      SSA,RSS 
      JMP TRC45 
      ADA POS3      MASK OFF LOWER 8 BITS OF LSW OF MANT
      ADB A 
      LDA B,I 
      AND UPBYT 
      STA B,I 
      INB           CLEAR NEXT WORD 
      CLA 
      STA B,I 
      LDB TMP 
      JMP *+2       NOW CLEAR 4TH WORD
TRC45 LDA UPBYT     MASK LOW 8 BITS OF MANT WORD 4
      ADB POS3
      AND B,I 
      STA B,I 
      LDB TMP 
      JMP TRNC5,I 
* 
FWAA  EQU *         FIRST WORD OF AVAIL. MEM
      END 
                                                                                                                                                                                  