Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/matgen.mac
There are 14 other files named matgen.mac in the archive. Click here to see a list.
; UPD ID= 1292 on 6/27/83 at 11:38 AM by HOFFMAN
TITLE MATGEN FOR COBOL V13
SUBTTL MATHEMATICAL CODE GENERATORS AL BLACKINGTON/CAM
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
IFN TOPS20,<SEARCH MONSYM,MACSYM>
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
RELOC 400000
;EDITS
;NAME DATE COMMENTS
;JEH 09-Jun-83 [1472] Fix DIVIDE literal INTO dn1, dn2, etc.
;DMN 9-Jan-81 [1113] COMP-1 to COMP-2 conversion not done correctly.
;JEH 22-AUG-80 [1047] CORRECT DIVIDE INTO CODE
;DMN 7-FEB-80 [767] CHECK OVERFLOW FLAGS FOR "ON SIZE ERROR".
;DAW 13-SEP-79 [732] FIX "SET" GENERATING BAD CODE SOMETIMES IN COBOL-74
;V12 RELEASED
;CLRH 5-JUN-79 [715] CORRECT EDIT 566
;DAW 29-MAR-79 [672] FIX ILL MEM REF FOR REFERENCES TO TALLY
;MFY 8-NOV-78 [601] CORRECT EDIT 546
;DMN 5-OCT-78 [566] FLOAT OPERANDS WHEN TARGET IS COMP-1
;EHM 16-SEP-78 [546] FIX MULTIPLY -1 BY X GENERATES A SETZM
;EHM 15-SEP-78 [545] FIX STATEMENT AFTER SUBTRACT 1 IS COMPILED WRONG
;EHM 14-APR-78 [534] FIX COMPUTE GETS ANSWER FROM WRONG AC
;V12 RELEASE
; VR 1-JUN-77 [500] FIX "SET X(1) X(2) UP" TO STOP LOOPING
; EHM 11-APR-77 [466] FIX COMPUTE FLOATING DIVIDES WHEN ANSWER ROUNDED.
;V11 RELEASE
; 6-APR-76 [417] MAKE SURE THAT RESTYP IS DEFINED
; 26-JAN-76 [377] FIX MULTIPLE ITEMS IN A GIVING CLAUSE
;ACK 28-MAY-75 COMP-3/EBCDIC CODE.
;VERSION 10 RELEASE
; EDIT 350 TURN OFF ZERO INDICATOR AFTER "SET TO"
; EDIT 325 RECOVER IF GIVING ITEM IN A DIVIDE STATEMENT UNDEFINED
; EDIT 317 FIX GIVING X,Y... FOR ANY X,Y BEING EDITED FIELD
; EDIT 250 ALLOW TALLY TO BE RESULTING OPERAND FOR ARITH AND SET.
; EDIT 112 FIXES SET ITEM<SUBCRIPTED> UP BY N.
ENTRY ADDGEN ;ADD OPERATOR
ENTRY ADDTGN ;ADDTO OPERATOR
ENTRY ADTGGN ;ADD TO GIVING OPERATOR
ENTRY SUBGEN ;SUB OPERATOR
ENTRY SUBFGN ;SUBFRM OPERATOR
ENTRY MULGEN ;MUL OPERATOR
ENTRY MULBGN ;MULBY OPERATOR
ENTRY DIVGEN ;DIV OPERATOR
ENTRY DIVBGN ;DIVBY OPERATOR
ENTRY REMGEN ;REMAIN OPERATOR
ENTRY RESGEN ;RESULT OPERATOR
ENTRY SETTGN ;SETTO OPERATOR
ENTRY SETDGN ;SETDN OPERATOR
ENTRY SETUGN ;SETUP OPERATOR
INTERNAL ADDX. ;ADD SOMETHING TO THE AC'S
INTERNAL SUBX. ;SUBTRACT SOMETHING FROM THE AC'S
INTERNAL MULX. ;MULTIPLY AC'S BY SOMETHING
INTERNAL DIVX. ;DIVIDE AC'S BY SOMETHING
INTERNAL EXPX. ;EXPONENTIATE AC'S BY SOMETHING
INTERNAL SWAPEM ;SWAP OPERANDS AND CURRENT "EAC"
INTERN CNVAF2 ;CONVERT "A" FROM 4-WORD COMP TO COMP-2
EXTERNAL READEM,PUTASY,PUTASN,PUTASA,OPFAT,OPNFAT,NOTNUM,NOTDAT,SWAPAB,ADJSL.
EXTERNAL CC1C2.,MXAC.,MACX.,MNXAC.,FORCX0,ADJDP.,CONVNL,NEGATL
EXTERNAL BMPEOP,BADEOP,GETTAG,ROUND,SIZERA,KILL,XPNRES,XPNEOP,LNKSET,GETEMP
EXTERNAL SUBSCB,SETOPA,SETOPB,SETOPN,MSFP%L,MSF2%L,MXFPA.,MXF2A.,CCXFP.,CCXF2.
EXTERNAL PUT.A,PUT.AA,PUT.B,PUT.BA,PUT.L,PUT.LA,PUT.LB,PUT.P,PUT.PA
EXTERNAL PUT.PC,PUT.LC,PUT.LD,PUT.XA,PUT.XB,PUT.EX,PUT.PJ
EXTERN STASHP,STASHQ,POOLIT,PLITPC,CPOPJ1,CPOPJ
;"ADD" GENERATOR
ADDGEN: PUSHJ PP,GRABOP ;GET FIRST OPERAND INTO AC'S
PUSHJ PP,CDEBA## ;COPY ANY DEBUGGING INFO
PUSHJ PP,INIT9 ;GET INITIAL MAX INTO ADDTMP
SKIPGE TE,RESTYP ;ANY ERRORS?
POPJ PP, ;YES
CAIL TE,3 ;[546] TEST FOR AOS OR SOS
PUSHJ PP,SETA21 ;YES, CHANGE TO MOVEI 0,1
ADDG0: PUSHJ PP,BMPEOP ;NO--BUMP UP TO NEXT OPERAND
POPJ PP, ;NO MORE OPERANDS
ADDG1: MOVE TC,CUREOP ;SET UP "B" OPERAND
HRRM TC,OPERND
SETOM EDEBDB## ;MIGHT WANT TO DEBUG IN RESULT
SOS EDEBDB ;BUT ONLY IF "ARO" ON
PUSHJ PP,SETOPB
PUSHJ PP,OPBCHK ;CK 2ND OPERAND FOR ELEMENTARY NUMERIC
PUSHJ PP,NEXT9 ;SEE IF WE NEED TO GO TO D.P.
PUSHJ PP,ADDX. ;ADD IT TO AC'S
PUSHJ PP,CDEBB## ;COPY ANY DEBUGGING INFO
JRST ADDG0 ;LOOK FOR ANOTHER OPERAND
;"ADD TO GIVING" GENERATOR
;THIS IS REALLY AN "ADD" OPERATOR WITH THE "A" OPERAND ALREADY IN THE ACCS
ADTGGN: SETZM RESTYP ;FORCE RESULT TO "MOVEM"
HRRZ TC,EOPLOC
ADDI TC,1
MOVE EACA,EOPNXT
CAIL TC,(EACA) ;STILL INSIDE EOPTAB?
JRST BADEOP ;NO--TROUBLE
MOVEM TC,CUREOP ;SAVE THAT LOCATION
MOVSM TC,OPERND
JRST ADDG1 ;GO HANDLE "B" OPERAND
;"ADDTO" GENERATOR
ADDTGN: PUSHJ PP,GRABOP ;GET FIRST OPERAND INTO AC'S
PUSHJ PP,CDEBA## ;COPY ANY DEBUGGING INFO
PUSHJ PP,INIT9 ;GET INITIAL MAX INTO ADDTMP
SKIPGE TE,RESTYP ;ANY GOOD OPERANDS FOUND?
POPJ PP, ;NO--FORGET IT
JUMPN TE,ADDG2 ;IF AOS OR SOS, MUST CHECK FOR MORE FIRST
MOVEI TE,1 ;YES--SET RESULT TYPE TO 1
MOVEM TE,RESTYP
JRST ADDG0
ADDG2: PUSHJ PP,BMPEOP ;SEE IF MORE
POPJ PP, ;NO
PUSHJ PP,SETA21 ;YES, SET A TO 1
AOS RESTYP ;[546] RESET TO 1
JRST ADDG1 ;AND ADD NEW OPERAND TO IT
SETA21: SWOFF FALWY0 ;WILL NOT BE ZERO SOON
MOVE CH,RESTYP
MOVEI TC,1
CAIE CH,3
MOVN TC,TC
MOVSI CH,MOV
SETZM RESTYP ;[546] RESET TO MOVEM
JRST PUT.LA
;"SUB" GENERATOR
SUBGEN: SETZM OVFLFL ;CANNOT CAUSE OVERFLOW
SETOM RESTYP
SETZM FLTDIV ;[566] CLEAR INCASE LEFT ON BY PREV. DIVIDE
MOVEM W1,OPLINE
SWOFF FEOFF1 ;TURN OFF MOST FLAGS
HRRZ TC,EOPLOC ;SET "TC" TO FIRST OPERAND
ADDI TC,1
MOVE EACA,EOPNXT
CAIL TC,(EACA) ;IS IT AFTER END?
JRST BADEOP ;YES--OOPS
SETZM ECARRY
MOVEM TC,ESAVAC ;NO--SAVE THE LOCATION
MOVEM TC,CUREOP
PUSHJ PP,BMPEOP ;LOOP FOR NEXT OPERAND
JRST BADEOP ;NOT THERE--ERROR
;SKIP THRU EOPTAB UNTIL LAST OPERAND SEEN
SUBGN1: MOVE TC,CUREOP ;SAVE LOCATION OF LAST ONE SEEN
PUSHJ PP,BMPEOP ;LOOK FOR ANOTHER
SKIPA ;NO MORE
JRST SUBGN1 ;LOOP
MOVEI TE,-1(TC) ;RESET EOPNXT TO POINT TO NEXT TO LAST OPERAND
HRRM TE,EOPNXT
HRLZM TC,OPERND
SETZM EAC ;SET AC'S TO 0 & 1
MOVEI LN,EBASEA ;SET UP THAT LAST OPERAND'S PARAMETERS
SETOM EDEBDA## ;MIGHT NEED TO DEBUG ON DATA-ITEM
SOS EDEBDA ; BUT ONLY IF "ARO" ON
PUSHJ PP,SETOPN
TSWF FERROR ;ANY TROUBLE?
JRST SUBGN4 ;YES
PUSHJ PP,GRBOP2 ;GET OPERAND INTO AC'S
PUSHJ PP,CDEBA## ;COPY ANY DEBUGGING INFO
MOVE TE,RESTYP
CAIE TE,3 ;TEST FOR AOS
CAIN TE,4 ;OR SOS
PUSHJ PP,SETA21 ;NOT ALLOWED HERE
MOVE TC,ESAVAC ;GET BACK TO FIRST OPERAND
MOVEM TC,CUREOP
SETZM RESTYP ;[601]
SUBGN4: HRRM TC,OPERND
PUSHJ PP,SETOPB ;SET UP "B" PARAMETERS
PUSHJ PP,OPBCHK ;CK 2ND OPERAND FOR ELEMENTARY NUMERIC CLASS
PUSHJ PP,SUBX. ;YES--GENERATE THE SUBTRACT
SUBGN5: PUSHJ PP,BMPEOP ;GO TO NEXT OPERAND
POPJ PP, ;NO MORE--QUIT
MOVE TC,CUREOP ;LOOP
JRST SUBGN4
;"SUBFRM" GENERATOR
SUBFGN: SETZM OVFLFL ;CANNOT CAUSE OVERFLOW
SETOM RESTYP
SETZM FLTDIV ;[566] CLEAR INCASE LEFT ON BY PREV. DIVIDE
MOVEM W1,OPLINE
SWOFF FEOFF1 ;CLEAR MOST FLAGS
HRRZ TC,EOPLOC
ADDI TC,1
MOVE EACA,EOPNXT
CAIL TC,(EACA)
JRST BADEOP
SETZM ECARRY
SUBFG2: MOVEM TC,CUREOP
MOVSM TC,OPERND
SETOM EDEBDA## ;MIGHT NEED TO DEBUG ON DATA-ITEM
SOS EDEBDA ; BUT ONLY IF "ARO" ON
PUSHJ PP,SETOPA
SETZM EAC ;SET AC'S TO BE 0&1
TSWT FANUM ;IS "A" NUMERIC?
JRST SUBFG4 ;NO--DROP IT
HRRZ TE,EMODEA ;IS "A" A LITERAL?
CAIN TE,FCMODE
JRST SUBFG7
CAIN TE,LTMODE
JRST SUBFG6 ;YES
PUSHJ PP,MNXAC. ;NO--GET NEGATIVE INTO AC'S
PUSHJ PP,CDEBA## ;COPY ANY DEBUGGING INFO
SUBFG3: MOVEI TE,1 ;SET RESULT TYPE TO 1
MOVEM TE,RESTYP
PUSHJ PP,BMPEOP
POPJ PP,
MOVE TC,CUREOP
JRST SUBGN4
SUBFG4: PUSHJ PP,NOTNUM ;PUT OUT "IMPROPER CLASS" DIAG
SUBFG5: PUSHJ PP,BMPEOP
POPJ PP,
HRRZ TC,CUREOP
JRST SUBFG2
;"SUBFRM" GENERATOR (CONT'D).
;"A" IS A LITERAL
SUBFG6: PUSHJ PP,CONVNL
TSWF FERROR ;ANY ERRORS?
JRST SUBFG5 ;YES
TSWTZ FLNEG ;IS LITERAL NEGATIVE?
PUSHJ PP,NEGATL ;NO--MAKE IT NEGATIVE
PUSHJ PP,GRBOP4
MOVE TE,RESTYP
CAIE TE,3
CAIN TE,4 ;AOS OR SOS?
CAIA ;YES
JRST SUBFG3 ;NO
PUSHJ PP,BMPEOP ;ANY MORE?
POPJ PP, ;NO, ALL IS WELL
PUSHJ PP,SETA21 ;YES, LOAD 1 IN ACCS
AOS RESTYP ;[546]BACK TO ADDM
MOVE TC,CUREOP
JRST SUBGN4 ;GET NEXT OPERAND
;"A" IS A FIGURATIVE CONSTANT
SUBFG7: HRRZ TE,EFLAGA
CAIE TE,2
JRST SUBFG4
SWON FALWY0
JRST SUBFG3
;"MUL" GENERATOR
MULGEN: PUSHJ PP,GRABOP ;GET FIRST OPERAND INTO AC'S
PUSHJ PP,CDEBA## ;COPY ANY DEBUGGING INFO
MOVE TE,RESTYP ;[546] CHECK FOR MULTIPLY BY 1 OR -1
CAIE TE,3 ;[546] +1
CAIN TE,4 ;[546] -1
PUSHJ PP,SETA21 ;[546] YES LOAD AC WITH CORRECT VALUE
SKIPL RESTYP ;ANY ERRORS?
PUSHJ PP,BMPEOP ;NO--GET SECOND OPERAND
POPJ PP, ;SOME KIND OF ERROR
MOVE TC,CUREOP
HRRM TC,OPERND
PUSHJ PP,SETOPB ;SET UP "B" PARAMETERS
PUSHJ PP,OPBCHK ;CK 2ND OPERAND FOR ELEM. NUM. CLASS
JRST MULX. ;YES--GENERATE MULTIPLY
;"MULBY" GENERATOR
MULBGN: PUSHJ PP,GRABOP ;GET OPERAND INTO AC'S
PUSHJ PP,CDEBA## ;COPY ANY DEBUGGING INFO
MOVE TE,RESTYP ;[546] CHECK FOR MULTIPLY BY 1 OR -1
CAIE TE,3 ;[546] +1
CAIN TE,4 ;[546] -1
PUSHJ PP,SETA21 ;[546] YES LOAD AC WITH CORRECT VALUE
MOVEI TE,2
SKIPL RESTYP ;ERRORS FOUND?
MOVEM TE,RESTYP ;NO--SET RESULT TYPE TO 2
POPJ PP,
;"DIVIDE ... GIVING" GENERATOR
DIVGEN: SETOM DIVSRS## ;SIGNAL NOT TO CONSIDER DIVIDE INTO SERIES
PUSHJ PP,SETDIV ;SET UP RESULT
TSWF FERROR ;ANY TROUBLE?
JRST DIVG2C ;YES--DON'T GENERATE CODE
SETZM DIVSRS ;ITS NOT DIVIDE INTO SERIES FOR SURE
DIVG1: TLNE W1,DINTO ;"INTO" OPTION?
JRST DIVG3 ;YES
;"DIVIDE BY"
SETZM DIVSRS ;ITS NOT DIVIDE INTO SERIES FOR SURE
PUSHJ PP,GRBDIV ;GET FIRST OPERAND INTO AC'S
MOVE TE,RESTYP ;[546] CHECK FOR MULTIPLY BY 1 OR -1
CAIE TE,3 ;[546] +1
CAIN TE,4 ;[546] -1
PUSHJ PP,SETA21 ;[546] YES LOAD AC WITH CORRECT VALUE
SKIPL RESTYP ;ANY GOOD OPERANDS FOUND?
PUSHJ PP,BMPEOP ;YES--SKIP UP TO NEXT OPERAND
JRST DIVG2B ;SOME KIND OF ERROR
MOVE TC,CUREOP ;SET UP "B" PARAMETERS
DIVG2: HRRM TC,OPERND
PUSHJ PP,SETOPB
TSWT FBNUM ;IS "B" NUMERIC?
PUSHJ PP,NOTNUM ;NO--ERROR
MOVE TE,EREM4 ;GET NEXT OP
TLNN TE,GNSERA ;[767] SKIP IF SIZE ERROR WANTED
JRST DIVG2N ;[767]
MOVE CH,[XWD SETZM.,OVFLO.]
PUSHJ PP,PUT.EX
PUSHJ PP,PUTASA ;[767] OTHER SET
MOVE CH,[JFCL.##+ASINC+AC17,,AS.MSC] ;[767]
PUSHJ PP,PUTASY ;[767] CLEAR THE OVERFLOW FLAGS
MOVEI CH,AS.DOT+1 ;[767]
PUSHJ PP,PUTASN ;[767]
DIVG2N: SWON FADJDV ;[767] SET "ADJUST DIVISOR" FLAG
PUSHJ PP,DIVX. ;GENERATE THE DIVIDE
SWOFF FADJDV ;CLEAR "ADJUST DIVISOR" FLAG
SETZM EMULSZ
LDB TE,[POINT 8,EREM4,8];IS THERE
CAIE TE,REMOP ; A REMAINDER?
JRST DIVG2B ;NO
HRRZ TE,EMODEA
CAIE TE,FPMODE ;IF COMP-1,
CAIN TE,F2MODE ;OR COMP-2
JRST DIVG2B ; NO NEED FOR REMAINDER
;"DIVIDE ... GIVING" (CONT'D)
MOVE TE,EREM4 ;ANY
TLNN TE,GNSERA ; SIZE ERROR?
JRST DIVG2A ;NO
MOVE CH,[XWD SETZM.,SZERA.];YES
PUSHJ PP,PUT.EX
SETOM EMULSZ
DIVG2A: SETZM ETEMPC ;STASH REMAINDER INTO %TEMP
MOVEI TE,2
MOVE TD,REMPAR
LDB TC,ACMODE
CAIE TC,D2MODE
MOVEI TE,1
PUSHJ PP,GETEMP
HLRZ TE,REMRND ;SPECIAL ROUNDING?
JUMPE TE,DIVG2E ;NO
CAIG TE,^D10 ;2 WORDS
SKIPA TE,[3] ;NO
MOVEI TE,4 ;YES
MOVEM TE,ETEMPC ;SAVE "B" OPERAND IN TEMP
DIVG2E: CAIE TC,D2MODE ;D.P.
JRST .+3 ;NO
PUSHJ PP,PUTASA## ;YES, ENABLE FOR NEW INST.
SKIPA CH,[DMOVM.+AC2+ASINC,,AS.MSC]
MOVE CH,[XWD MOVEM.+AC2+ASINC,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,EACC
PUSHJ PP,PUTASN
;"DIVIDE ... GIVING" (CONT'D)
DIVG2B: MOVE W1,OPLINE ;SET UP FOR "RESGEN"
MOVE EACA,EREM1
MOVEM EACA,EOPNXT
MOVE W1,EREM2
MOVE TC,EREM0
MOVEI TC,1(TC)
PUSHJ PP,STRES0
PUSHJ PP,RESG0D ;GENERATE 'GIVING'
DIVG2C: SKIPN W1,EREM4 ;ANY OPERATOR READY?
POPJ PP, ;NO--WE'RE DONE
HRRZ TE,EREM1 ;YES--THIS IS START OF OPERAND LESS 1
HRRZ TD,EOPLOC ;BUILD
ADDI TD,1 ; XWD FOR
HRLI TD,1(TE) ; BLT TO MOVE OPERAND UP
HRRZ EACA,EREM3 ;THIS IS LAST ADDRESS OF OPERAND
SUBI EACA,(TE) ;SO THIS IS SIZE OF OPERAND
ADDI TE,1(EACA) ;SO THIS IS LAST ADDRESS TO BLT
BLT TD,(TE) ;MOVE OPERAND TO TOP OF EOPTAB
HRLS EACA ;COMPUTE NEW
ADD EACA,EOPLOC ; EOPNXT
MOVEM EACA,EOPNXT ; AND STASH IT
LDB TE,[POINT 8,W1,8];GET OPERATOR CODE
JRST @EOPCOD(TE) ;DISPATCH TO SOME GENERATOR
;"DIVIDE ... GIVING GENERATOR (CONT'D)
;"DIVIDE INTO"
DIVG3: HRRZ TC,EOPLOC ;GET TO SECOND OPERAND
ADDI TC,1
MOVEM TC,CUREOP
PUSHJ PP,BMPEOP
JRST BADEOP ;THERE ISN'T ONE--ERROR
MOVE TC,CUREOP ;GET THAT OPERAND INTO AC'S
PUSHJ PP,GRBOP0
SKIPGE RESTYP ;ERRORS?
JRST DIVG2B ;YES--FORGET IT
HRRZ TC,EOPLOC ;NO--RESET TO TOP OF EOPTAB
ADDI TC,1
MOVEM TC,CUREOP
PUSH PP,TC ;[1047] SAVE AC
MOVE TE,RESTYP ;[1047] CHECK FOR MULTIPLY -1 OR +1
CAIE TE,3 ;[1047] +1
CAIN TE,4 ;[1047] -1
PUSHJ PP,SETA21 ;[1047] LOAD AC WITH CORRECT VALUE
POP PP,TC ;[1047] RESTORE AC
JRST DIVG2 ;NOW PRETEND IT'S "DIVIDE BY"
;"DIVIDE ... BY" GENERATOR
DIVBGN: SETZM DIVSRS## ;ZERO COUNT OF OPERANDS IN SERIES
PUSHJ PP,SETDIV ;SET UP THE RESULT
TSWF FERROR ;ANY TROUBLE?
JRST DIVG2C ;YES--QUIT
;WE HAVE TO CREATE A RESULT EQUAL TO THE SECOND DIVIDE OPERAND.
;BE SURE THERE IS ROOM IN EOPTAB.
DIVBG1: HRRZ TE,EREM0
MOVE EACA,EREM1
SUBI TE,(EACA)
HLRE TD,EREM3
CAMLE TE,TD
JRST DIVBG2
HLRE TE,EOPLOC ;SAVE OLD EOPLOC
PUSH PP,TE
PUSHJ PP,XPNEOP
HLRE TE,EOPLOC ;GET NEW
POP PP,TD ;GET BACK OLD
SUB TE,TD ;COMPARE
HLRE TD,EREM3
ADD TE,TD
HRLM TE,EREM3
JRST DIVBG1
;OK, THERE IS ROOM IN EOPTAB. NOW WE HAVE TO MOVE DOWN THE RESULT
; OPERAND (SECOND DIVIDE OPERAND), PLUS OPERANDS FOR REMAINDER OR
; WHATEVER CAME AFTER DIVIDE.
;NOTE THAT RESULT OPERAND WILL BE DUPLICATED.
DIVBG2: MOVMS TE
HRLS TE
HRRZ TB,EREM0
HRRZ TA,EREM3
ADDM TE,EREM0
ADDM TE,EREM1
ADDB TE,EREM3
DIVBG3: MOVE CH,(TA)
MOVEM CH,(TE)
SUBI TA,1
CAIE TA,(TB)
SOJA TE,DIVBG3
MOVE EACA,EREM0
MOVEM EACA,EOPNXT
JRST DIVG1
;"SETTO" GENERATOR
SETTGN: PUSHJ PP,SETSET ;SET UP LAST OPERAND
SKIPGE RESTYP ;IS IT ALL RIGHT?
POPJ PP, ;NO--FORGET IT
HRRZ TE,EMODEA ;YES--IS IT A LITERAL?
CAIN TE,LTMODE
JRST SETT2 ;YES
CAIN TE,FCMODE ;NO--IS IT ZERO?
JRST SETT3 ;YES
PUSHJ PP,MXAC. ;NO--GET IT INTO THE AC'S
JRST SETT4 ;GO TO "RESULT" GENERATOR
SETT2: PUSH PP,RESTYP ;SAVE WHICH TYPE
PUSHJ PP,GRBOP4 ;GET VALUE OF LITERAL INTO AC'S
MOVE TE,RESTYP ;MUST CHECK INCASE LIT = 1
CAIE TE,3 ;+1
CAIN TE,4 ;-1
PUSHJ PP,SETA21 ;UNDO AOS OR SOS CODE
POP PP,RESTYP ;RESTORE WHAT IT WAS
JRST SETT4 ;GO TO "RESULT" GENERATOR
SETT3: SWON FALWY0;
SETT4: PUSHJ PP,CDEBAB## ;STORE DEBUGGING DATA
MOVE EACA,EOPNXT
PUSHJ PP,RESGEN ;[350] SET RESULT
SWOFF FALWY0 ;[350] TURN OFF ZERO INDICATOR
POPJ PP, ;[350] RETURN
;"SETDN" GENERATOR
SETDGN: PUSHJ PP,SETSET ;SET UP LAST OPERAND
SKIPGE RESTYP ;IS IT ALL RIGHT?
POPJ PP, ;NO--FORGET IT
MOVEI TE,1 ;SET RESULT TYPE TO 1
MOVEM TE,RESTYP
HRRZ TE,EMODEA ;IS IT A LITERAL?
CAIN TE,LTMODE
JRST SETD2 ;YES
CAIN TE,FCMODE
POPJ PP,
PUSHJ PP,MNXAC. ;NO--GET NEGATIVE INTO AC'S
JRST SETT4 ;GO TO "RESULT" GENERATOR
SETD2: JUMPN TD,SETD3 ;IS IT A 2-WORD LITERAL?
TSWT FLNEG ;NO--NEGATIVE?
CAIE TC,1 ;NO--IS IT 1?
JRST SETD3 ;NEGATIVE OR NOT 1
MOVSI CH,SOS. ;IT IS 1--USE "SOS"
JRST SETU3
SETD3: TSWTZ FLNEG ;IS IT NEGATIVE?
PUSHJ PP,NEGATL ;NO--MAKE IT NEGATIVE
JRST SETT2 ;GO TO "RESULT" GENERATOR
;"SETUP" GENERATOR
SETUGN: PUSHJ PP,SETSET ;SET UP LAST OPERAND
SKIPGE RESTYP ;IS IT ALL RIGHT?
POPJ PP, ;NO--FORGET IT
MOVEI TE,1 ;SET RESULT TYPE TO 1
MOVEM TE,RESTYP
HRRZ TE,EMODEA ;IS IT A LITERAL?
CAIN TE,LTMODE
JRST SETU2 ;YES
CAIN TE,FCMODE ;NO--FIG. CONST.?
POPJ PP, ;YES--MUST BE 'ZEROES'
PUSHJ PP,MXAC. ;NO--GET IT INTO AC'S
JRST SETT4 ;GO TO "RESULT" GENERATOR
SETU2: JUMPN TD,SETT2 ;IS IT A 2-WORD LITERAL?
TSWT FLNEG ;NO--IS IT NEGATIVE?
CAIE TC,1 ;NO--IS IT 1?
JRST SETT2 ;NOT 1, OR NEGATIVE--GO TO "RESULT"
MOVSI CH,AOS. ;IT IS 1--USE "AOS"
SETU3: MOVEM CH,RESTYP ;SAVE "AOS" OR "SOS"
HRRZ TC,EOPLOC
ADDI TC,1
MOVEM TC,CUREOP
MOVEM TC,OPERND ;IN CASE OF SUBSCRIPTING
SETZM ERCNT
MOVE TE,RESLOC
MOVEM TE,RESNXT
SETU5: SWOFF FERROR;
MOVE TC,CUREOP ;SET UP PARAMETERS FOR OPERAND
MOVEM TC,OPERND ;[500] IN CASE OF SUBSCRIPTING
SETOM EDEBDB ;IN CASE DEBUGGING
MOVEI LN,EBASEB
PUSHJ PP,SETOPN
TSWF FERROR;
JRST SETU6
HRRZ TE,EMODEB ;IS IT 1-WORD COMP?
CAIE TE,D1MODE
JRST SETU10 ;NO
PUSHJ PP,SUBSCB ;YES--SUBSCRIPT IF NECESSARY
MOVE CH,RESTYP ;GENERATE "AOS" OR "SOS"
CAMN CH,[SOS.,,0] ;GENERATING A "SOS"?
TSWF FBSIGN ;YES--IS IT UNSIGNED?
JRST SETU5A ;NO, GEN IT
;GENERATE
; SOSGE AC,FOO ;SUBTRACT ONE, SKIP IF STILL .GE. 0
; MOVMS AC,FOO ;MAKE IT POSITIVE IN MEMORY
MOVSI CH,SOSGE.
PUSHJ PP,PUT.B ;"SOSGE AC,B"
PUSHJ PP,PUTASA
MOVSI CH,MOVMS.
SETU5A: PUSHJ PP,PUT.B
SETU6: PUSHJ PP,CDEBB ;STORE DEBUGGING DATA
PUSHJ PP,BMPEOP ;GO TO NEXT OPERAND
SKIPA ;NO MORE
JRST SETU5 ;LOOP
PUSHJ PP,GDEBV ;GENERATE DEBUGGING CALLS
;"SETUP" OPERATOR (CONT'D).
;ALL RESULTS HAVE BEEN LOOKED AT ONCE.
SKIPN ERCNT ;ANY NOT DONE?
POPJ PP, ;NO--QUIT
MOVEI TE,D1MODE ;SET MODE OF "A" TO 1-WORD COMP
MOVEM TE,EMODEA
HLRZ CH,RESTYP ;IS THIS "SETUP"?
CAIE CH,AOS.
SKIPA CH,[XWD MOVNI.,1];NO
MOVE CH,[XWD MOVEI.,1];YES
PUSHJ PP,PUT.XA
MOVEI TE,1 ;SET RESULT TYPE TO 1
MOVEM TE,RESTYP
JRST RESGN0
;A RESULT IS NOT 1-WORD COMP--PUT ENTRY INTO RESTAB
SETU10: MOVE TC,CUREOP
PUSHJ PP,STRES8
JRST SETU6
;"RESULT" GENERATOR
RESGEN: SWOFF FEOFF1-FALWY0-FERROR ;CLEAR MOST FLAGS
MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
PUSHJ PP,SETRES ;SET UP RESTAB
TLNN W1,CORR ;IF 'CORRESPONDING', DON'T CLEAR EMULSZ
RESGN0: SETZM EMULSZ ;ASSUME ONLY ONE OPERAND
RESG0D: SETZM ERESDP
TSWT FERROR ;ANY ERRORS?
SKIPN TE,ERCNT ;NO--ANYTHING TO DO?
POPJ PP, ;NO--QUIT
SWON FASIGN ;SET "AC'S ARE SIGNED"
HRRZ TE,EMODEA ;IF 'A' IS
CAIE TE,FPMODE ; COMP-1
TSWF FALWY0 ; OR IF AC'S ARE ZERO,
JRST RESG0C ; SKIP SIZE TEST
CAIN TE,F2MODE ;ALSO COMP-2
JRST RESG0C
MOVE CH,ESIZEA ;IF SIZE OF 'A' IS TOO BIG,
CAILE CH,MAXSIZ+^D20 ; FORGET IT
POPJ PP,
RESG0C: TLNN W1,GNSERA ;ANY SIZE ERROR?
JRST RESGN1 ;NO
PUSHJ PP,GETTAG ;GET A TAG NUMBER
MOVEM CH,ESZERA
SWON FSZERA ;SET 'SIZE ERROR REQUIRED'
LDB TE,[POINT 8,W1,8];IF OPERATOR
CAIN TE,REMOP ; IS 'REMAINDER'
JRST RESGN1 ; GO TO GENERATION
MOVE TE,ERCNT
TLNN W1,CORR ;ANY CORRESPONDING?
SOJE TE,RESGN1 ;NO, JUMP IF ONLY ONE OPERAND
RESG0B: SKIPE EMULSZ ;IS THIS THE FIRST?
JRST RESGN1 ;NO
MOVE CH,[XWD SETZM.,SZERA.]
PUSHJ PP,PUT.EX
SETOM EMULSZ
JRST RESGN1
;"RESULT" GENERATOR (CONT'D).
RESGN1: HRRZ TE,RESLOC
ADDI TE,1
MOVEM TE,CURRES
SKIPN DIVSRS ;IF DIVIDE SERIES WE DON'T NEED A TEMP
PUSHJ PP,SCNRES ;SCAN THRU RESTAB TO SEE IF %TEMP NEEDED
RESGN2: SETOM EDEBDB## ;MIGHT WANT TO DEBUG ON RESULT
PUSHJ PP,RESETB
TSWF FERROR;
JRST RESGN6
RESGN5: PUSHJ PP,RESG10
RESGN6: PUSHJ PP,CDEBB## ;COPY RESULT DEBUGGING CODE
PUSHJ PP,LUKRES
JRST RESGN8 ;ALL DONE
SKIPN DIVSRS ;DIVIDE SERIES IS SPECIAL
JRST RESGN2 ;LOOP THRU ALL RESULTS
PUSHJ PP,RESETB ;SET "B" WITH NEXT RESULT
PUSHJ PP,SWAPEM ;MAKE IT "A"
MOVE TE,DIVTMP ;WE SET UP "A" TO POINT TO %TEMP
MOVEM TE,ESAVDV+1 ;SAVE %TEMP
MOVE TE,[44,,AS.MSC]
MOVEM TE,ESAVDV ;POINT TO IT
MOVE TE,[ESAVDV,,EBASEB]
BLT TE,EBASBX ;RESTORE THE DIVISOR
MOVE TA,1(TC) ;GET
PUSHJ PP,LNKSET ; NUMBER
LDB TE,DA.NDP ; OF DECIMAL PLACES
LDB TD,DA.DPR ;IS DECIMAL POINT
SKIPE TD ; TO RIGHT OF FIELD?
MOVNS TE ;YES--NEGATE
MOVEM TE,ERESDP
MOVE TE,1(TC) ;IS RESULT TO BE
TLNE TE,GNROUN ; ROUNDED?
AOS ERESDP ;YES--GET ANOTHER DECIMAL PLACE
PUSHJ PP,GRBP1A ;GET "A" INTO THE ACCS
SWON FADJDV ;SET "ADJUST DIVISOR" FLAG
PUSHJ PP,DIVX. ;DO THE DIVIDE
SWOFF FADJDV ;CLEAR "ADJUST DIVISOR" FLAG
JRST RESGN2 ;NOW DO THE STORE
RESGN8: SETZM DIVSRS ;CLEAN UP
SETZM DIVTMP
PJRST GDEBV## ;PUT OUT DEBUGGING CODE IF REQUIRED
RESGN7: PUSHJ PP,NOTNUM ;PUT OUT "NOT NUMERIC" DIAG
JRST RESGN6 ;LOOP
;"RESULT" GENERATOR (CONT'D).
;GENERATE CODE TO TAKE SOMETHING OUT OF AC'S, DEPENDING ON RESTYP.
;IF RESTYP IS NEGATIVE, THERE HAVE BEEN ERRORS, SO FORGET IT.
;IF RESTYP IS 0, GENERATE A "MOVEM" TYPE OF INSTRUCTION.
;IF RESTYP IS 1, GENERATE "ADDM"
;IF RESTYP IS 2, GENERATE MULTIPLY AND STORE.
;IF RESTYP IS 3, GENERATE "AOS"
;IF RESTYP IS 4, GENERATE "SOS"
RESG10: SKIPGE TE,RESTYP ;NEGATIVE?
POPJ PP, ;YES--QUIT
MOVE TA,1(TC) ;PICK UP SECOND WORD OF OPERAND
CAIG TE,4 ;IS RESTYP IN BOUNDS?
JRST @RES.T(TE) ;YES--GO TO APPROPRIATE ROUTINE
OUTSTR [ASCIZ /Bad "RESTYP"
/]
JRST KILL
RES.T: EXP RESG11 ;"MOVEM"
EXP RESG14 ;"ADDM"
EXP RESG12 ;MULTIPLY
EXP RESG17 ;"AOS"
EXP RESG17 ;"SOS"
;"MOVEM"
RESG11: TLNE TA,GNROUN ;ANY ROUNDING?
PUSHJ PP,ROUND ;YES--ROUND AC'S
MOVE TE,[XWD EBASEB,ESAVER] ; [377] SAVE RESULT PARAMS
BLT TE,ESAVRX ; [317] WHICH MAY BE CLOBBERED BY MOVGEN
TSWF FSZERA ;ANY SIZE ERROR?
JRST [PUSHJ PP,SIZERA ; [317] YES--GENERATE "SIZE ERROR" CODING
JRST RESG1A] ; [317] FINSISH
PUSHJ PP,MACX. ; [317]GENERATE "MOVEM"
RESG1A: MOVE TE,[XWD ESAVER,EBASEB] ; [377] RESTORE RESULT PARMS
BLT TE,EBASAX ; [317]
POPJ PP, ; [317] RETURN
;MULTIPLY
RESG12: PUSHJ PP,RESCHK ;IS RECEIVING FIELD ELEMENTARY NUMERIC?
JRST NOTNUM ;NO
PUSHJ PP,MULX.
JRST RESG16
;CK RESULT OPERAND FOR ELEMENTARY NUMERIC CLASS
RESCHK: TSWT FBNUM ;NUMERIC?
POPJ PP, ;NO, TAKE ERROR RETURN
PUSH PP,TA
PUSHJ PP,LNKSET ;GET PTR TO OPERAND'S DATAB ENTRY
LDB TA,DA.EDT ;EDITED?
JUMPN TA,.+2 ;NO, ERROR
AOS -1(PP) ;NORMAL RETURN
POP PP,TA
POPJ PP,
;SPECIAL CK ON 2ND OPERAND - MUST BE ELEMENTARY NUMERIC CLASS
OPBCHK: MOVE TB,EMODEB ;LITERAL?
CAIL TB,LTMODE
POPJ PP, ;YES, LET IT PASS
LDB TB,DA.EDT ;EDITED?
JUMPN TB,OPBCH2 ;YES, ERROR
LDB TB,DA.CLA ;NUMERIC?
CAIN TB,%CL.NU
POPJ PP, ;OK, RETURN
OPBCH2: POP PP,TB ;SET FOR RETURN TO CALLER'S CALLER
JRST NOTNUM ;?IMPROPER CLASS
;"RESULT" GENERATOR (CONT'D).
;"ADDM"
RESG14: PUSHJ PP,RESCHK ;IS RECEIVING FIELD ELEMENTARY NUMERIC?
JRST NOTNUM ;NO
TSWT FSZERA ;ANY SIZE ERROR?
TLNE TA,GNROUN ;NO--ANY ROUNDING?
JRST RESG15 ;YES
TSWF FALWY0 ;IF AC'S ARE ZERO,
POPJ PP, ; FORGET IT
RESG13:: ;ADD ACC 0 TO TALLY COUNTER IN INSPECT>
HRRZ TD,EMODEB
HRRZ TE,EMODEA
CAIN TE,FPMODE ;IS "A" COMP-1?
JRST RSG14B ;YES
CAIN TD,FPMODE ;NO--IS "B" COMP-1?
JRST RSG14A ;YES
MOVE TE,EDPLA ;IF A HAS MORE DECIMAL PLACES
CAMLE TE,EDPLB ; THAN B GET B INTO THE AC'S
JRST RESG15 ; SO THAT SUBTRACT 1.9 FROM
; 2 WILL GIVE A RESULT OF 0
; RATHER THAN 1.
PUSHJ PP,ADJDP. ;ADJUST DECIMAL PLACES OF AC'S
MOVE TE,ESIZEA
CAILE TE,MAXSIZ ;ARE AC'S TOO BIG?
POPJ PP, ;YES--QUIT
CAMG TE,ESIZEB ;NO--IS "A" LARGER THAN RESULT?
TSWT FBSIGN ;NO--IS "B" SIGNED?
JRST RESG15 ;CAN'T USE ADDM
HRRZ TD,EMODEB
HRRZ TE,EMODEA
CAIE TE,D1MODE ;ARE AC'S 1-WORD COMP?
JRST RESG15 ;NO
CAIE TD,D1MODE ;YES--ALSO "B"?
JRST RESG15 ;NO
PUSHJ PP,SUBSCB ;YES--SUBSCRIPT IF NECCESSARY
MOVSI CH,ADDM. ;GENERATE <ADDM AC,B> AND
JRST PUT.BA ; RETURN
RSG14A: PUSHJ PP,CCXFP.## ;CONVERT "A" TO COMP-1
MOVE TD,EMODEB
RSG14B: CAIE TD,FPMODE ;"A" IS COMP-1, IS "B"?
JRST RESG15 ;NO
PUSHJ PP,SUBSCB ;YES--SUBSCRIPT IF NECESSARY
MOVSI CH,FADM. ;GENERATE <FADM AC,B> AND
JRST PUT.BA ; RETURN
RESG15: PUSHJ PP,ADDX. ;CAN'T USE "ADDM"--GENERATE ADD TO AC'S
RESG16: PUSHJ PP,RESETB
MOVE TA,1(TC)
JRST RESG11 ;GO GENERATE STASH
;"AOS" OR "SOS"
RESG17: PUSHJ PP,RESCHK ;IS RECEIVING FIELD ELEMENTARY NUMERIC?
JRST NOTNUM ;NO
TSWT FSZERA ;ANY SIZE ERROR?
TLNE TA,GNROUN ;NO--ANY ROUNDING?
JRST RSG15A ;YES
HRRZ TD,EMODEB ;GET MODE
CAIN TD,D1MODE ;1-WORD COMP
SKIPE EDPLB ;AND NO DECIMAL PLACES
JRST RSG15A ;NO
PUSHJ PP,SUBSCB ;OK, SUBSCRIPT IF REQUIRED
TSWF FBSIGN ;IS IT UNSIGNED
JRST RSG17A ;NO, WHAT LUCK!
PUSHJ PP,PUTASA
MOVSI CH,MOVMS. ;MUST MAKE SURE ITS NOT NEGATIVE
PUSHJ PP,PUT.B
RSG17A: MOVE CH,RESTYP
CAIE CH,3 ;AOS?
JRST RSG17B ;GENERATE SOS, MOVSS IF NECESSARY
MOVSI CH,AOS. ;GENERATE <AOS B>
JRST PUT.B
RSG17B: MOVSI CH,SOS. ;ASSUME IT IS SIGNED
TSWF FBSIGN ;IS IT?
JRST PUT.B ;YES-- JUST GENERATE "SOS"
MOVSI CH,SOSGE.
PUSHJ PP,PUT.B ;GEN "SOSGE DATANAME"
PUSHJ PP,PUTASA ; GENERATE "MOVMS DATANAME"
MOVSI CH,MOVMS. ;TO BE EXECUTED IF DATANAME BECAME NEGATIVE
JRST PUT.B ;BY THE "SOS"
RSG15A: MOVE CH,RESTYP
CAIE CH,3
SKIPA CH,[MOVNI.,,1]
MOVE CH,[MOVEI.,,1]
PUSHJ PP,PUT.XA ;GET 1 INTO ACCS
SWOFF FALWY0 ;ACCS NOT ZERO NOW
MOVEI TE,D1MODE ;
MOVEM TE,EMODEA ;SET MODE OF A
MOVEI TE,1
MOVEM TE,ESIZEA ;AND SIZE
JRST RESG14 ;DO AS ADDM
;"REMAINDER" GENERATOR
REMGEN: SWOFF FEOFF1-FALWY0-FERROR
MOVEM W1,OPLINE ;SAVE OPERATOR
SETZM EAC ;SET AC'S TO BE 0&1
MOVE TD,REMPAR ;PICK UP REMAINDER PARAMETERS
LDB TC,ACMODE ;GET MODE
CAIE TC,FPMODE ;IS IT COMP-1?
CAIN TC,F2MODE ;OR COMP-2?
JRST REMGN4 ;YES
LDB TE,ACSIZE ;NO--GET SIZE
MOVEM TE,ESIZEA
MOVEM TC,EMODEA ;SET MODE
HRREM TD,EDPLA ;SET DECIMAL PLACES
CAIN TC,D2MODE ;2-WORDS?
PUSHJ PP,PUTASA## ;YES
CAIN TC,D2MODE
SKIPA CH,[DMOVE.##+ASINC,,AS.MSC]
MOVE CH,[XWD MOV+ASINC,AS.MSC]
PUSHJ PP,PUTASY
MOVEI CH,AS.TMP
ADD CH,TEMBAS
PUSHJ PP,PUTASN
JRST REMGN5
REMGN4: MOVEM TC,EMODEA ;SET MODE TO COMP-1 OR COMP-2
MOVE CH,[XWD SETZB.,1] ;GENERATE <SETZB 0,1>
PUSHJ PP,PUTASY
SWON FALWY0;
REMGN5: PUSHJ PP,SETRES
JRST RESG0D
;GENERATE CODE TO ADD SOMETHING TO THE AC'S
ADDX.: TSWF FALWY0 ;ARE AC'S ZERO?
JRST ADDX.7 ;YES
HRRZ TE,EMODEA
CAIN TE,D4MODE ;IF "A" IS 4-WORDS
PUSHJ PP,CNVAF2 ;CONVERT TO COMP-2
PUSHJ PP,SETB ;NO--SET UP "B"
JRST ADDX.4 ;IT IS A LITERAL, OR ERRORS FOUND
ADDX.1: PUSHJ PP,SETDP
TSWF FERROR;
POPJ PP,
SWOFF FALWY0 ;TURN OFF "AC'S ARE ZERO"
ADDX.2: HRRZ TE,EMODEA
HRRZ TD,EMODEB ;DON'T ALLOW ADD IF EITHER "A" OR "B"
CAIE TD,D4MODE## ; IS A LARGE INTERMEDIATE RESULT
CAIN TE,D4MODE## ;(ARE THEY?)
PJRST TOOBIG ;YES, COMPLAIN
JRST @ADDT.1(TE)
;"B" IS A HALF-WORD LITERAL, OR ERRORS FOUND
ADDX.4: MOVSI CH,AD##
TSWFZ FLNEG ;IF NEGATIVE LITERAL,
MOVSI CH,SUB. ; USE SUBTRACT
ADDX.5: TSWT FERROR ;IF ANY ERRORS DETECTED
SKIPN TC ; OR IF LITERAL IS ZERO,
POPJ PP, ; FORGET IT
PUSH PP,CH ;SAVE OP-CODE
MOVE TE,EDPLA ;IF
SUB TE,EDPLB ; NECESSARY,
JUMPLE TE,ADDX.6 ; ADJUST
PUSHJ PP,ADJSL. ; DECIMAL PLACES OF LITERAL
PUSHJ PP,SETB2A ;SEE IF STILL HALF-WORD
JFCL ;[534] SETB2A SOMETIMES GIVES SKIP RET
TSWF FERROR ;[534] EVEN IF NO ERROR SO TEST FOR
POPJ PP, ;[534] ERROR AND GET OUT IF BAD
HRRZ TE,EMODEB ;IS IT
CAIE TE,LTMODE ; STILL A LITERAL?
JRST ADDX.8 ;NO
ADDX.6: PUSH PP,TC ;SAVE LITERAL VALUE
PUSHJ PP,SETDP ;ADJUST AC'S
POP PP,TC ;RESTORE LITERAL VALUE
HRRZ CH,EMODEA## ;IF SETDP CHANGED THE A OPERAND
CAIE CH,D1MODE## ; INTO A 2 WORD COMP ITEM, GO
JRST ADDX.9 ; STASH THE LITERA.
POP PP,CH ;RESTORE OP-CODE
PUSHJ PP,PUT.LA ;GENERATE ADD OR SUBTRACT
JRST CHKSIZ ;CHECK SIZE OF RESULT AND RETURN
;AC'S ARE ZERO
ADDX.7: PUSHJ PP,SWAPAB ;SWAP OPERANDS
SWOFF FALWY0 ;TURN OFF "AC'S ARE ZERO"
JRST MXAC. ;GET OLD 'B' INTO AC'S
;IT IS NO LONGER LITERAL
ADDX.8: POP PP,CH ;GET OP-CODE
CAME CH,[XWD AD,0] ;IF NOT ADD,
JRST SUBX.1 ; DO SUBTRACT,
JRST ADDX.1 ; ELSE DO ADD
;COME HERE IF WE HAD A HALF WORD LITERAL AND SETDP CHANGED THE A
; OPERAND FROM A 1 WORD COMP ITEM TO A 2 WORD COMP ITEM.
; (TC) = THE VALUE OF THE LITERAL.
ADDX.9: PUSHJ PP,SETB5 ;GO STASH THE LITERAL.
JFCL ;CAN'T GET AN ERROR NOW.
POP PP,CH ;RESTORE THE OP CODE.
CAME CH,[XWD AD,0] ;IF NOT ADD DO
JRST SUBX.4 ; SUBTRACT ELSE
JRST ADDX.2 ; DO ADD.
;ADD NON-LITERAL TO 1-WORD COMP IN AC'S
ADD1D: HRRZ TE,EMODEB
CAIE TE,D1MODE
JRST ADD1DD
MOVSI CH,AD
PUSHJ PP,PUT.BA
JRST CHKSIZ
;"B" IS MORE THAN 10 DIGITS LONG
ADD1DD: PUSHJ PP,FORCX0
;ADD 2-WD TO 1-WD
PUSHJ PP,PUTASA##
MOVE CH,[ASHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY## ;"ASHC 0,-^D35"
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
PUSHJ PP,PUTASA##
MOVSI CH,DADD.
PUSHJ PP,PUT.B## ;"DADD 0,B"
ADD1DF: MOVEI TE,D2MODE
MOVEM TE,EMODEA
JRST CHKSIZ
;ADD NON-LITERAL TO 2-WORD COMP IN AC'S
ADD2D: PUSHJ PP,FORCX0
HRRZ TE,EMODEB
CAIE TE,D1MODE
JRST ADD22D ;ADD 2-WD TO 2-WD
;ADD 1-WD TO 2-WD
ADD21D: HRRZ TE,EBASEB ;IF "B" IS IN AN AC, SKIP THE REDUNDANT MOVE
CAILE TE,15 ;MAKE SURE ASHC WON'T MANGLE AC0
JRST ADD2DA ;TOO BAD
LSH TE,^D18+5 ;SHIFT TO AC POSITION
PUSHJ PP,PUTASA
MOVE CH,[ASHC.+ASINC,,AS.CNB]
IOR CH,TE
PUSHJ PP,PUTASY## ;"ASHC AC,-^D35"
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
PUSHJ PP,PUTASA ;READY FOR "DADD"
HRLI CH,DADD.
HRR CH,EBASEB ;"DADD 0,B"
PUSHJ PP,PUTASY
JRST CHKSIZ
ADD2DA: MOVSI CH,MOV+AC2
PUSHJ PP,PUT.B## ;"MOVE AC2,B"
ADD2DB: PUSHJ PP,PUTASA##
MOVE CH,[ASHC.+AC2+ASINC,,AS.CNB]
PUSHJ PP,PUTASY## ;"ASHC AC2,-^D35"
MOVEI CH,-^D35
PUSHJ PP,PUTASN## ; TO EXTEND THE SIGN
;GENERATE "DADD 0,2"
PUSHJ PP,PUTASA##
MOVE CH,[DADD.,,2]
PUSHJ PP,PUTASY##
JRST CHKSIZ
;ADD 2-WD TO 2-WD
ADD22D: PUSHJ PP,PUTASA## ;"DADD 0,B"
MOVSI CH,DADD.
PUSHJ PP,PUT.B##
JRST CHKSIZ
;ADD NON-LITERAL TO FLOATING-POINT
;"ADSUB2" CONVERTED "B" TO COMP-1, IF NECESSARY
ADDFP: MOVSI CH,FAD.
JRST PUT.BA
;ADD NON-LITERAL TO D.P. FLOATING-POINT
;"ADSUB2" CONVERTED "B" TO COMP-2, IF NECESSARY
ADDF2: PUSHJ PP,PUTASA
MOVSI CH,DFAD.
JRST PUT.BA
;GENERATE CODE TO SUBTRACT FROM AC'S
SUBX.: TSWF FALWY0 ;IF AC'S ARE ZERO,
JRST SUBX.6 ; TAKE SPECIAL ROUTE
HRRZ TE,EMODEA
CAIN TE,D4MODE ;IF "A" IS 4-WORDS
PUSHJ PP,CNVAF2 ;CONVERT TO COMP-2
PUSHJ PP,SETB ;SET UP "B"
JRST SUBX.5 ;IT IS A LITERAL, OR ERRORS FOUND
SUBX.1: PUSHJ PP,SETDP
TSWF FERROR;
POPJ PP,
SWOFF FALWY0 ;TURN OFF "AC'S CONTAIN ZERO"
SUBX.4: HRRZ TE,EMODEA
HRRZ TD,EMODEB ;IF EITHER "B" OR "A"
CAIE TD,D4MODE## ;IS A 4-WORD INTERMEDIATE RESULT,
CAIN TE,D4MODE## ; GIVE UP
PJRST TOOBIG
JRST @SUBT.1(TE)
;"B" IS A HALF-WORD LITERAL, OR ERRORS FOUND
SUBX.5: MOVSI CH,SUB. ;GENERATE SUBTRACT UNLESS
TSWFZ FLNEG ; LITERAL IS NEGATIVE,
MOVSI CH,AD ; IN WHICH CASE GENERATE AN ADD
JRST ADDX.5
;AC'S ARE ZERO
SUBX.6: PUSHJ PP,SWAPAB ;SWAP OPERANDS
SWOFF FALWY0 ; RESET "AC'S ARE ZERO"
JRST MNXAC. ;GET NEGATIVE OF OLD 'B' INTO AC'S
;SUBTRACT NON-LITERAL FROM 1-WORD COMP IN AC'S
SUB1D: HRRZ TE,EMODEB
CAIE TE,D1MODE
JRST SUB1DD
MOVSI CH,SUB.
PUSHJ PP,PUT.BA
JRST CHKSIZ
SUB1DD: PUSHJ PP,FORCX0
;SUBTRACT 2-WD FROM 1-WD
PUSHJ PP,PUTASA##
MOVE CH,[ASHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY## ;"ASHC 0,-^D35"
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
PUSHJ PP,PUTASA##
MOVSI CH,DSUB.
PUSHJ PP,PUT.B## ;"DSUB 0,B"
JRST ADD1DF
;SUBTRACT NON-LITERAL FROM 2-WORD COMP IN AC'S
SUB2D: PUSHJ PP,FORCX0
HRRZ TE,EMODEB
CAIE TE,D1MODE
JRST SUB22D ;2-WD MINUS 2-WD
;SUBTRACT 1-WD FROM 2-WD
SUB21D: MOVSI CH,MOV+AC2
PUSHJ PP,PUT.B## ;"MOVE AC2,B"
PUSHJ PP,PUTASA##
MOVE CH,[ASHC.+AC2+ASINC,,AS.CNB]
PUSHJ PP,PUTASY## ;"ASHC AC2,-^D35"
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
;GENERATE "DSUB 0,2"
PUSHJ PP,PUTASA##
MOVE CH,[DSUB.,,2]
PUSHJ PP,PUTASY##
JRST CHKSIZ
;SUBTRACT 2-WD FROM 2-WD
SUB22D: PUSHJ PP,PUTASA## ;"DSUB 0,B"
MOVSI CH,DSUB.
PUSHJ PP,PUT.B##
JRST CHKSIZ
;SUBTRACT NON-LITERAL FROM COMP-1.
;"ADSUB2" CONVERTED "B" TO COMP-1, IF NECESSARY.
SUBFP: MOVSI CH,FSB.
JRST PUT.BA
;SUBTRACT NON-LITERAL FROM COMP-2.
;"ADSUB2" CONVERTED "B" TO COMP-2, IF NECESSARY.
SUBF2: PUSHJ PP,PUTASA
MOVSI CH,DFSB.
JRST PUT.BA
;MULTIPLY AC'S BY SOMETHING
MULX.: TSWF FALWY0 ;IF AC'S ARE ZERO,
POPJ PP, ; NO CODE NECESSARY
HRRZ TE,EMODEA
CAIN TE,D4MODE ;IF "A" IS 4-WORDS
PUSHJ PP,CNVAF2 ;CONVERT TO COMP-2
PUSHJ PP,SETB ;SET UP "B"
JRST MULX20 ;"B" IS LITERAL, OR ERRORS
;"B" IS NOT A LITERAL
HRRZ TE,EMODEA
CAIE TE,FPMODE
CAIN TE,F2MODE
JRST MUL10B
MOVE TA,ESIZEA
CAILE TA,MAXSIZ ;IS IT TOO BIG ALREADY?
POPJ PP, ;YES--FORGET IT
HRRZ TE,EMODEB
CAIE TE,FPMODE
CAIN TE,F2MODE
JRST MUL10B
ADD TA,ESIZEB
TSWT FBIGCV ;ARE WE ALLOWED TO GO TO FLOATING?
JRST MUL100 ;NO
CAILE TA,MAXSIZ ;YES, DON'T ALLOW RESULT TO GO TO 4 WORDS
JRST MULX32
MUL100: CAILE TA,MAXSIZ+^D24
JRST MULX32
MUL10B: PUSHJ PP,SUBSCB
PUSHJ PP,NEGIF
HRRZ TE,EMODEA
HRRZ TD,EMODEB
;DON'T ALLOW MULTIPLY OF 4-WORD INTERMEDIATE RESULTS
CAIE TD,D4MODE## ;IS "B" COMP-4?
CAIN TE,D4MODE## ;4-WORD INTERMEDIATE ALREADY?
PJRST TOOBIG ;YES, COMPLAIN
HRRZ TD,EMODEB
JRST @MULT.1(TE)
;MULTIPLY A 1-WORD COMP BY SOMETHING
ML1CX:
JRST @MULT.2(TD)
;MULTIPLY A 2-WORD COMP BY SOMETHING
ML2CX: JRST @MULT.3(TD)
;"B" IS A HALF-WORD LITERAL, OR ERRORS FOUND
MULX20: TSWF FERROR ;ANY ERRORS?
POPJ PP, ;YES--FORGET IT
SKIPN TC ;IS LITERAL ZERO?
SWON FALWY0 ;YES--SET 'AC'S ARE ZERO'
TSWF FALWY0 ;ARE AC'S ZERO?
POPJ PP, ;YES--FORGET IT
TSWFZ FLNEG ;IS LITERAL NEGATIVE?
MOVNS TC ;YES
MOVE TA,ESIZEB
ADDB TA,ESIZEA
CAILE TA,^D10
JRST MULX23
;RESULT WILL BE ONE WORD
MOVSI CH,IMUL.
MULX22: PUSHJ PP,PUT.LA
MOVE TE,EDPLB
ADDM TE,EDPLA
POPJ PP,
;RESULT WILL BE TWO WORDS
MULX23: MOVEI TE,D2MODE
MOVEM TE,EMODEA
MOVSI CH,MUL.
JRST MULX22
;MULTIPLY A 1-WORD COMP BY A 1-WORD COMP
ML1C1C: MOVE TE,ESIZEA
ADD TE,ESIZEB
CAILE TE,^D10
JRST MULX12
MOVSI CH,IMUL.
PUSHJ PP,PUT.BA
MULEND: MOVE TE,ESIZEB
ADDM TE,ESIZEA
MOVE TE,EDPLB
ADDM TE,EDPLA
POPJ PP,
MULX12: MOVSI CH,MUL.
PUSHJ PP,PUT.BA
JRST MULX14
;MULTIPLY A 1-WORD COMP BY A 2-WORD COMP
ML1C2C: MOVE TA,ESIZEA
ADD TA,ESIZEB
CAILE TA,MAXSIZ
JRST ML1C4C
PUSHJ PP,GMUL12
JRST MULX14
MULX14: MOVEI TE,D2MODE
MOVEM TE,EMODEA
JRST MULEND
;MULTIPLY A 2-WORD COMP BY A 1-WORD COMP
ML2C1C: MOVE TA,ESIZEA
ADD TA,ESIZEB
CAILE TA,MAXSIZ
JRST ML4C1C
PUSHJ PP,GMUL21
JRST MULX14
;MULTIPLY A 2-WORD COMP BY A 2-WORD COMP
ML2C2C: MOVE TA,ESIZEA
ADD TA,ESIZEB
CAILE TA,MAXSIZ
JRST ML4C2C
PUSHJ PP,GMUL22
JRST MULX14
;MULTIPLY COMP-1 BY COMP-1
MLFPFP: MOVSI CH,FMP.
JRST PUT.BA
;MULTIPLY COMP-2 BY COMP-2
MLF2F2: PUSHJ PP,PUTASA
MOVSI CH,DFMP.
JRST PUT.BA
;MULTIPLY A 1-WORD COMP BY A 2-WORD COMP GIVING 4-WORD COMP
ML1C4C: PUSHJ PP,MLASHC ;CONVERT TO 2-WORDS
JRST ML4C2C
;MULTIPLY A 2-WORD COMP BY A 1-WORD COMP GIVING 4-WORD COMP
ML4C1C: MOVEI CH,2
ADDB CH,EAC ;USE NEXT PAIR OF ACCS
CAMN CH,EBASEB ;IF THERE ALREADY
JRST ML4C1D ;SKIP THE LOAD
MOVSI CH,MOV
PUSHJ PP,PUT.BA
ML4C1D: PUSHJ PP,MLASHC
MOVE CH,EAC
MOVEM CH,EBASEB
SUBI CH,2
MOVEM CH,EAC
JRST ML4C2C
;MULTIPLY A 2-WORD COMP BY A 2-WORD COMP GIVING 4-WORD COMP
ML4C2C: PUSHJ PP,PUTASA## ;ALTERNATE CODE SET
MOVSI CH,DMUL.##
PUSHJ PP,PUT.BA
MOVEI TE,D4MODE##
MOVEM TE,EMODEA
JRST MULEND
MLASHC: PUSHJ PP,PUTASA
HRLZ CH,EAC
LSH CH,5
ADD CH,[ASHC.##+ASINC,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,-^D35
JRST PUTASN
;GENERATE INLINE CODE FOR MUL.12
GMUL12: PUSHJ PP,PUTASA##
MOVE CH,[ASHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY##
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
PUSHJ PP,PUTASA##
MOVSI CH,DMUL.
PUSHJ PP,PUT.BA##
PJRST GMULP0 ;GET LOW ORDER RESULT & RETURN
;GENERATE INLINE CODE FOR MUL.21
GMUL21: PUSHJ PP,GMULB1 ;GET "B" AS 2 WDS, DO DMUL
PJRST GMULP0 ;GET LOW ORDER RESULT & RETURN
;GENERATE INLINE CODE FOR MUL.22
GMUL22: PUSHJ PP,PUTASA##
MOVSI CH,DMUL.
PUSHJ PP,PUT.BA## ;"DMUL AC,B"
; PJRST GMULP0 ;GET LOW ORDER RESULT
;ROUTINE TO GENERATE CODE TO PUT LOW ORDER DMUL RESULT INTO 1ST 2 AC'S
;GEN: DMOVE AC,AC+2
GMULP0: PUSHJ PP,PUTASA##
MOVSI CH,DMOVE.
HRR CH,EAC
ADDI CH,2
PJRST PUT.XA##
;ROUTINE TO GET "B" INTO AC+4 & AC+5 AS 2-WDS
;GENERATE:
; MOVE AC+4,B
; ASHC AC+4,-^D35
; DMUL AC,AC+4
;UNLESS B = A +2
;IN WHICH CASE GENERATE
; ASHC AC+2,-^D35
; DMUL AC,AC+2
GMULB1: HRRZ CH,EBASEB ;GET "B"
ADD CH,EINCRA ;ANY INCREMENT
SUBI CH,2 ;"B" -2
CAMN CH,EAC ;= "A"
JRST GMULB2 ;YES
HRRZ CH,EAC
ADDI CH,4 ;AC+4
LSH CH,5
IORI CH,MOV
HRLZ CH,CH ;"MOVE AC+4,"
PUSHJ PP,PUT.B##
PUSHJ PP,PUTASA##
HRRZ CH,EAC
ADDI CH,4
LSH CH,5 ;AC+4
HRLZ CH,CH
IOR CH,[ASHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY##
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
PUSHJ PP,PUTASA##
MOVSI CH,DMUL.
HRR CH,EAC
ADDI CH,4 ;"DMUL Z, AC+4"
PJRST PUT.XA## ;PUT IN AC
GMULB2: PUSHJ PP,PUTASA##
HRRZ CH,EAC
ADDI CH,2
LSH CH,5 ;AC+2
HRLZ CH,CH
IOR CH,[ASHC.+ASINC,,AS.CNB]
PUSHJ PP,PUTASY##
MOVEI CH,-^D35
PUSHJ PP,PUTASN##
PUSHJ PP,PUTASA##
MOVSI CH,DMUL.
HRR CH,EAC
ADDI CH,2 ;"DMUL Z, AC+2"
PJRST PUT.XA## ;PUT IN AC
;NEW SIZE IS > 19 DIGITS
;"B" IS NOT A LITERAL
MULX32: TSWT FBIGCV;
JRST MULX33
PUSHJ PP,CCXF2.
PUSHJ PP,SWAPEM
PUSHJ PP,MXF2A.
PUSHJ PP,SWAPEM
JRST MLF2F2
MULX33: MOVEI DW,E.88
JRST OPNFAT
;GENERATE CODE TO DIVIDE AC'S BY SOMETHING
DIVX.: TSWF FALWY0 ;IF AC'S ARE ZERO,
POPJ PP, ; NO CODE NEEDED
HRRZ TE,EMODEA
CAIN TE,D4MODE ;IF "A" IS 4-WORDS
PUSHJ PP,CNVAF2 ;CONVERT TO COMP-2
PUSHJ PP,FORCX0 ;INSURE THAT AC'S ARE 0&1
PUSHJ PP,SETB ;SET UP "B"
JRST DIVX50 ;"B" IS LITERAL OR ERROR
;GENERATE CODE TO DIVIDE AC'S BY SOMETHING.
;"B" IS NOT A LITERAL.
HRRZ TE,EMODEB ;DON'T ALLOW DIVIDE BY 4-WORD COMP
CAIN TE,D4MODE##
PJRST TOOBIG
PUSHJ PP,SUBSCB
SKIPE DIVSRS ;IS IT A DIVIDE SERIES
SKIPE DIVTMP ;AND "B" NOT YET SAVED IN %TEMP?
JRST DIVX5C ;NO
DIVX5S: MOVE TE,[EBASEB,,ESAVDV##]
BLT TE,ESVDVX## ;SAVE DIVISOR
MOVEI TE,1 ;ASSUME 1 WORD
MOVE TD,ESIZEB
CAILE TD,^D10
MOVEI TE,2 ;NEEDS 2 WORDS
PUSHJ PP,GETEMP
MOVEM EACC,DIVTMP## ;SAVE LOCATION
PUSHJ PP,SWAPEM ;PUT DIVISOR IN "A"
HRRZ TE,EBASEA ;IS IT ALREADY IN THE ACCS?
CAILE TE,17
JRST [MOVEI TE,2 ;NOT YET
MOVEM TE,EAC ;USE 2 & 3
PUSHJ PP,MXAC. ;GET INTO ACCS
MOVE TE,EAC
MOVEM TE,EBASEA ;SET UP BASE
JRST .+1]
MOVE TC,EMODEA
CAIE TC,D2MODE ;D.P.
CAIN TC,F2MODE
TRNA ;YES
JRST .+3 ;NO
PUSHJ PP,PUTASA## ;YES, ENABLE FOR NEW INST.
SKIPA CH,[DMOVM.+ASINC,,AS.MSC]
MOVE CH,[XWD MOVEM.+ASINC,AS.MSC]
HRRZ TE,EBASEA ;PUT AC FIELD IN INSTRUCTION
DPB TE,CHAC
PUSHJ PP,PUTASY
HRRZI CH,AS.MSC
HRRZ CH,DIVTMP
PUSHJ PP,PUTASN
PUSHJ PP,SWAPEM ;PUT DIVISOR BACK IN "B"
DIVX5C: PUSHJ PP,NEGIF ;NEGATE AC'S IF 'B' HAS UNARY MINUS
HRRZ TE,EMODEB
CAIN TE,FPMODE
JRST DIVX40
CAIN TE,F2MODE
JRST DIVXF2
DIVX5B: MOVE TE,EDPLA ;WILL THERE BE ENOUGH DECIMAL PLACES?
SUB TE,EDPLB
MOVE TD,ERESDP
CAML TE,TD
JRST DIVX5A ;YES
MOVE TE,[XWD EBASEB,ESAVEB];NO--ADJUST DP OF "A"
BLT TE,ESAVBX
ADDM TD,EDPLB
PUSHJ PP,ADJDPA## ;[466] SAVE ADJUSTMENT AMNT MIGHT NEED
MOVE TE,[XWD ESAVEB,EBASEB]
BLT TE,EBASBX
JRST DIVX5D
DIVX5A: TSWF FADJDV ;SHOULD WE TRY TO ADJUST DIVISOR?
CAMG TE,TD ;YES--SHOULD WE ADJUST IT?
JRST DIVX5D ;NO
PUSHJ PP,SWAPEM ;YES--SWAP OPERANDS
HRRZ TE,EBASEA ;IS NEW "A" IN AC'S?
CAILE TE,17
PUSHJ PP,MXAC. ;NO--PUT IT THERE
MOVE TE,[XWD EBASEB,ESAVEB] ;SAVE "B" PARAMETERS
BLT TE,ESAVBX
MOVN TD,ERESDP
ADDM TD,EDPLB
PUSHJ PP,ADJDPA## ;[466]ADJUST DECIMAL PLACES BUT SAVE AMT
MOVE TE,[XWD ESAVEB,EBASEB] ;RESTORE "B"
BLT TE,EBASBX
PUSHJ PP,SWAPEM ;RE-SWAP OPERANDS
DIVX5D: TSWF FERROR;
POPJ PP,
SKIPL REMRND ;SPECIAL ROUNDING REQUIRED?
JRST DIVX5E ;NO
; STORE THE DIVISOR IN %TEMP IF IT'S NOW IN AC'S. THIS WILL ALLOW THE
; ROUNDING CODE IN CMNGEN TO WORK. STORE LOCATION OF DIVISOR IN RH(REMRND)
; AND REMRN1. NOTE: IF DIVISOR IS A ONE-WORD COMP, NO %TEMP IS NEEDED.
MOVE TD,ESIZEB
HRLM TD,REMRND ;RH (REMRND) = SIZE OF DIVISOR
SETZM SGNREM## ;CLEAR FLAGS
SETZM SGNDIV##
TSWF FASIGN ;IS DIVIDEND SIGNED?
SETOM SGNREM## ;YES--REMAINDER MAY BE NEGATIVE
TSWT FBSIGN ;IS DIVISOR SIGNED?
JRST .+3 ;NO
SETOM SGNREM## ;YES-- BOTH REMAINDER AND
SETOM SGNDIV## ; DIVISOR MAY BE NEGATIVE
HRRZ TE,EBASEB ;WHERE IS THE DIVISOR?
CAILE TE,17 ; DID WE MOVE IT TO AC'S?
JRST [HRRM TE,REMRND ;NO--REMEMBER WHERE IT IS
MOVE TE,EINCRB
MOVEM TE,REMRN1##
JRST DIVX5E]
MOVEI TE,2 ;NEED TO ALLOCATE SPACE FOR REMAINDER
MOVEM TE,ETEMPC ; SINCE REST OF COMPILER KNOWS
; REMAINDER IS AT %TEMP+0
; AND POSSIBLY %TEMP+1
MOVE TC,EMODEB ;GET MODE
CAIE TC,D2MODE
CAIN TC,F2MODE
SKIPA TE,[2] ;NEED 2 WORDS
MOVEI TE,1 ;ONLY 1 WORD
PUSHJ PP,GETEMP ;THIS FOR "B"
CAIE TC,D2MODE ;D.P.
CAIN TC,F2MODE
TRNA ;YES
JRST .+3 ;NO
PUSHJ PP,PUTASA## ;YES, ENABLE FOR NEW INST.
SKIPA CH,[DMOVM.+ASINC,,AS.MSC]
MOVE CH,[XWD MOVEM.+ASINC,AS.MSC]
HRRZ TE,EBASEB ;PUT AC FIELD IN INSTRUCTION
DPB TE,CHAC
PUSHJ PP,PUTASY
HRRZI CH,AS.MSC ;BASE IN RH (REMRND)
HRRM CH,REMRND
HRRZ CH,EACC
HRRZM CH,REMRN1 ;INCREMENT IN REMRN1
PUSHJ PP,PUTASN
DIVX5E: HRRZ TE,EMODEA
JRST @DIVT.1(TE)
;"A" IS A 1-WORD COMP OR INDEX
DIVX.6: HRRZ TC,EMODEB
CAIE TC,D1MODE
JRST DIVX.7
MOVSI CH,DIV.11
MOVE TE,EBASEB
CAIE TE,AS.MSC ;WAS IT RESET TO MISC?
JRST DIVX.8 ;NO
LDB TE,[POINT 3,EINCRB,20]
CAIE TE,AC.LIT## ;I.E. A LITERAL
JUMPN TE,DIVX.8 ;OR ABS VALUE
MOVE TE,EREM4
TLNE TE,GNSERA ;DO WE NEED SIZE ERROR CODE?
SKIPL OVFLFL ;OR NO CHANCE OF OVERFLOW?
JRST DIVX60 ;NO, SO NO NEED FOR OVERFLOW CHECK
PUSHJ PP,PUTASA
MOVE CH,[JOV.##+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
MOVEI CH,AS.DOT##+1
PUSHJ PP,PUTASN ;JOV .+1
DIVX60: MOVE TE,EINCRB ;GET VALUE
TRNN TE,AS.LIT ;LITERAL?
JRST [MOVE CH,[IDIVI.##+ASINC,,AS.CNB]
PUSHJ PP,PUT.XA
MOVE CH,EINCRB
PUSHJ PP,PUTASN
JRST DIVX61]
MOVSI CH,IDIV.##
PUSHJ PP,PUT.BA ;IDIV EAC,[LITERAL]
DIVX61: LDB TE,[POINT 8,EREM4,8]
CAIE TE,REMOP ;REMAINDER?
JRST DIVX62 ;NO, SO NO NEED FOR REMAINDER STORE
MOVE CH,EAC
DPB CH,CHAC## ;PUT IN AC FIELD
ADD CH,[MOVEM.+AC1,,2]
PUSHJ PP,PUTASY ;MOVEM EAC+1,EAC+2 - STORE REMAINDER
DIVX62: MOVE TE,EREM4
TLNE TE,GNSERA ;SIZE ERROR CHECK WANTED?
SKIPL OVFLFL ;OR NO CHANCE OF OVERFLOW?
JRST DIVX63 ;NO SIZE ERROR CODE
PUSHJ PP,PUTASA
MOVE CH,[JOV.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
MOVEI CH,AS.DOT+2
PUSHJ PP,PUTASN ;JOV .+2
PUSHJ PP,PUTASA
MOVE CH,[XJRST.##+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
MOVEI CH,AS.DOT+2
PUSHJ PP,PUTASN ;JRST .+2
MOVE CH,[SETOM.##,,OVFLO.##]
PUSHJ PP,PUT.EX ;SETOM. OVFLO.
DIVX63: HRRES OVFLFL ;RESET FLAG
JRST DIVX.9 ;CONTINUE
DIVX.7: MOVEM TC,EMODEA
MOVSI CH,DIV.12
DIVX.8: PUSHJ PP,PUT.BA ;WRITE OUT THE INSTRUCTION
DIVX.9: MOVN TE,EDPLB ;ADJUST DECIMAL PLACES IN "A"
MOVE TD,EDPLA
ADDM TE,EDPLA
MOVE TE,ESIZEB
DPB TE,ACSIZE
DPB TC,ACMODE
MOVEM TD,REMPAR
POPJ PP,
;"A" IS A 2-WORD COMP.
DIVX10: HRRZ TC,EMODEB
MOVSI CH,DIV.21
CAIE TC,D1MODE
MOVSI CH,DIV.22
JRST DIVX.8
;"A" IS COMP-1
DIVX40: HRRZ TE,EMODEB
CAIE TE,FPMODE
PUSHJ PP,GTBFP
MOVSI CH,FDV.
PUSHJ PP,PUT.BA
MOVEI TD,0 ;SET UP REMAINDER PARAMETER
MOVEI TE,FPMODE
DPB TE,ACMODE
MOVEM TD,REMPAR
POPJ PP,
;"A" IS COMP-2
DIVXF2: HRRZ TE,EMODEB
CAIE TE,F2MODE
PUSHJ PP,GTBF2
PUSHJ PP,PUTASA
MOVSI CH,DFDV.
PUSHJ PP,PUT.BA
MOVEI TD,0 ;SET UP REMAINDER PARAMETER
MOVEI TE,F2MODE
DPB TE,ACMODE
MOVEM TD,REMPAR
POPJ PP,
DIVX11: HRRZ TC,EMODEB
MOVEI CH,DIV%41##
CAIE TC,D1MODE
MOVEI CH,DIV%42##
PUSHJ PP,PMOPB.##
MOVEI TC,D2MODE
MOVEM TC,EMODEA ;WILL BE 2-WORDS SOON
MOVEI TC,MAXSIZ ;MOST THAT WILL FIT IN 2 WORDS
MOVEM TC,ESIZEA
PUSHJ PP,CREATL##
MOVE EACC,EPWR10##(TC) ;GET 10*MAXSIZ
MOVEI CH,DIV%42 ;SO ADJUST TO FIT
PUSHJ PP,PMOPV.##
PUSHJ PP,PUTASA##
MOVE CH,[DMOVE.##,,4]
PUSHJ PP,PUTASY ;PUT LOW ORDER WORDS IN 0 & 1
HRRZ TC,EMODEB
JRST DIVX.9
;DIVIDE ONE-WORD COMP BY HALF-WORD LITERAL
DIVX50: TSWF FERROR ;ANY ERRORS?
POPJ PP, ;YES--QUIT
JUMPE TC,CANT0 ;CANNOT DIVIDE BY ZERO
TSWF FALWY0 ;AC'S ALREADY ZERO?
POPJ PP, ;YES--NO CODE
CAIE TC,1 ;IS DIVISIOR +1
CAMN TC,[-1] ; OR -1
CAIA ;YES, THIS IS THE ONLY CASE THAT CAN CAUSE OVERFLOW
HRRZS OVFLFL ;NO, SO SET FLAG TO SKIP OVERFLOW GENERATION
MOVE TE,OPERND ;UNARY MINUS?
MOVE TE,1(TE)
TLNE TE,NEGEOP
TSWC FLNEG ;YES--NEGATE LITERAL
REPEAT 0,< ;NOT YET WORKING, COMPUTE FAILS
TSWT FLNEG ;NEGATIVE?
SKIPA TA,TC ;NO
MOVN TA,TC ;YES
TLNN TA,-1 ;18 BITS ONLY?
JRST DIVX51 ;YES, USE IDIVI
>
MOVE TA,[XWD D1LIT,1];CREATE LITERAL
PUSHJ PP,STASHP
TSWT FLNEG ;NEGATIVE?
SKIPA TA,TC ;NO
MOVN TA,TC ;YES
PUSHJ PP,POOLIT
MOVEI TE,D1MODE
MOVEM TE,EMODEB
SKIPN TE,PLITPC
MOVE TE,ELITPC
IORI TE,AS.LIT
MOVEM TE,EINCRB
MOVEI TE,AS.MSC
MOVEM TE,EBASEB
SKIPN PLITPC
AOS ELITPC
SWON FBSIGN
SKIPE DIVSRS ;[1472] Is it a DIVIDE series?
SKIPE DIVTMP ;[1472] and "B" not saved yet?
SKIPA ;[1472] No
JRST DIVX5S ;[1472] Yes
JRST DIVX5B
DIVX51: MOVEM TA,EINCRB ;STORE NUMBER
MOVEI TE,D1MODE
MOVEM TE,EMODEB ;SET NEW MODE
MOVEI TE,AS.MSC
MOVEM TE,EBASEB
SWON FBSIGN
JRST DIVX5B
;GENERATE CODE FOR EXPONENTIATION
EXPX.: HRRZ TE,EMODEA
CAIN TE,D4MODE ;IF "A" IS 4-WORDS
PUSHJ PP,CNVAF2 ;CONVERT TO COMP-2
HRRZ TE,EMODEA ;IS "A" FLOATING-POINT?
CAIE TE,F2MODE ;COMP-2?
PUSHJ PP,CCXF2. ;NO--CONVERT IT TO FLOATING-POINT
PUSHJ PP,FORCX0 ;BE SURE IT IS IN AC 1
HRRZ TE,EMODEB ;GET MODE OF "B"
CAIN TE,D4MODE## ;IS "B" A LARGE INTERMEDIATE VALUE?
PUSHJ PP,CNVBF2 ;YES, CONVERT TO COMP-2
HRRZ TE,EMODEB
CAIN TE,FCMODE ;IS "B" A FIG. CONST.?
JRST EXPX15 ;YES
CAIE TE,LTMODE ;IS "B" A LITERAL?
JRST EXPX4 ;NO
;"B" IS A LITERAL
MOVE TE,EBYTEB ;SAVE
MOVEM TE,ESAVER ; BYTE POINTER TO LITERAL
MOVE TE,ESIZEB ; AND
MOVEM TE,ESAVER+1 ; IT'S SIZE
MOVEI LN,EBASEB ;GET IT'S VALUE
PUSHJ PP,CONVNL
TSWF FERROR;
POPJ PP,
JUMPN TD,EXPX2
JUMPE TC,EXPX16
SKIPN EDPLB
JRST EXPX3
;GENERATE CODE FOR EXPONENTIATION (CONT'D).
;LITERAL HAS TO BE FLOATING POINT
EXPX2: MOVE TE,ESAVER
MOVEM TE,EBYTEB
MOVE TE,ESAVER+1
MOVEM TE,ESIZEB
SETZM EDPLB
PUSHJ PP,MSFP%L ;CREATE A FLOATING-POINT LITERAL
HRRZ TE,EMODEA
CAIN TE,F2MODE ;COMP-2?
JRST EXPX22 ;YES
MOVE CH,[XWD E.C3C3,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,TC
JRST PUTASN
EXPX22: MOVE CH,[MOVEI.+AC16,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,TC
PUSHJ PP,PUTASN
MOVEI CH,E.F2FP
JRST PUT.PJ
EXPX3: MOVSI CH,E.C3C1
MOVE TE,OPERND ;IS LITERAL TO BE NEGATED?
MOVE TE,1(TE)
TLNE TE,NEGEOP
TSWC FLNEG ;YES--COMPLEMENT SIGN INDICATOR
TSWFZ FLNEG;
MOVNS TC
JRST PUT.L
;GENERATE EXPONENTIATION (CONT'D)
;"B" IS NOT A LITERAL
EXPX4: SETOM NOFLOT## ;DON'T FLOAT IF INTEGER
PUSHJ PP,SETBX ;SET UP "B"
POPJ PP, ;ERROR--QUIT
MOVE TE,OPERND ;IS "B" TO BE NEGATED?
MOVE TE,1(TE)
TLNN TE,NEGEOP
JRST EXPX5 ;NO
PUSHJ PP,SWAPEM ;YES--SWAP OPERANDS
PUSHJ PP,MNXAC. ;GET NEGATIVE OF "B" INTO AC'S
PUSHJ PP,SWAPEM ;SWAP OPERANDS BACK
EXPX5: HRRZ TE,EMODEA
CAIN TE,F2MODE ;IS "A" COMP-2?
JRST EXPX25 ;YES
HRRZ TE,EMODEB
CAIN TE,FPMODE
JRST EXPX8
CAIN TE,F2MODE ;IS "B" COMP-2?
JRST EXPX20 ;YES, MAKE "A" COMP-2 ALSO
;GENERATE EXPONENTIATION (CONT'D)
;"B" IS COMP
SKIPN EDPLB
CAIE TE,D1MODE
JRST EXPX7
PUSHJ PP,SUBSCB
MOVSI CH,E.C3C1
JRST PUT.B
EXPX7: PUSHJ PP,GTBFP
JRST EXPX9
;"B" IS COMP-1
EXPX8: PUSHJ PP,SUBSCB
EXPX9: MOVSI CH,E.C3C3
JRST PUT.B
;"B" IS A FIG. CONST.
EXPX15: MOVE TE,OPERND
MOVE TE,(TE)
TLNN TE,GNFCZ
JRST BADFIG
EXPX16: MOVE CH,[XWD HRLZI.+AC1,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,(1.0)
SETZM EAC
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA
MOVSI CH,SETZ.+AC1 ;JUST INCASE 2 WORDS
JRST PUTASY
;"A" IS COMP-2
EXPX25: HRRZ TE,EMODEB
CAIE TE,FPMODE
CAIN TE,F2MODE
JRST EXPX28
;GENERATE EXPONENTIATION (CONT'D)
;"B" IS COMP
SKIPE EDPLB
JRST EXPX27 ;CONVERT TO COMP-2
PUSHJ PP,SUBSCB
MOVSI CH,MOVEI.+AC16
PUSHJ PP,PUT.B
HRRZ TE,EMODEB
MOVEI CH,E.F2D1
CAIE TE,D1MODE
MOVEI CH,E.F2D2
JRST PUT.PJ
EXPX27: PUSHJ PP,GTBF2
JRST EXPX29
;"B" IS COMP-1 OR COMP-2
EXPX28: PUSHJ PP,SUBSCB
EXPX29: MOVSI CH,MOVEI.+AC16
PUSHJ PP,PUT.B
HRRZ TE,EMODEB
MOVEI CH,E.F2FP
CAIE TE,FPMODE
MOVEI CH,E.F2F2
JRST PUT.PJ
EXPX20: PUSHJ PP,PUTASA
MOVSI CH,SETZ.+AC1
PUSHJ PP,PUTASY ;CONVERT TO "A" TO COMP-2
MOVEI TE,F2MODE
MOVEM TE,EMODEA
JRST EXPX25 ;AND CONTINUE
;CONVERT 4-WORD COMP ITEM TO COMP-2
;CONVERT 4-WORD COMP "A" OPERAND TO COMP-2
CNVAF2: PUSHJ PP,CCXF2. ;CONVERT "A" TO COMP-2
CNVAFL: SKIPN TD,EDPLA ;ANY DECIMAL PLACES?
POPJ PP, ;NO
CAILE TD,MAXSIZ ;GENF2L CAN ONLY HANDLE 10**<MAXSIZ> FOR NOW
SKIPA TD,[-MAXSIZ]
MOVN TD,TD
ADDM TD,EDPLA ;ADJUST SIZE
PUSHJ PP,GENF2L## ;YES, ADJUST VALUE
JRST CNVAFL ;TRY AGAIN
;CONVERT 4-WORD COMP "B" OPERAND TO COMP-2
CNVBF2: PUSHJ PP,SWAPAB
PUSHJ PP,CNVAF2 ;CONVERT TO COMP-2
PUSHJ PP,SWAPAB
POPJ PP,
;SET UP B-OPERAND FOR ARITHMETIC VERBS
;IF "B" IS A LITERAL, AND "A" IS COMP-1, CREATE A COMP-1 LITERAL AND
; RETURN TO CALL+2.
;IF "B" IS A LITERAL, AND "A" IS COMP-2, CREATE A COMP-2 LITERAL AND
; RETURN TO CALL+2.
;IF "B" IS A LITERAL, AND "A" IS NOT COMP-1 OR COMP-2, CREATE A LITERAL AND
; RETURN TO CALL+2 UNLESS VALUE OF LITERAL FITS A HALF-WORD,
; IN WHICH CASE RETURN TO CALL+1 WITH VALUE OF LITERAL
; IN ACCUMULATOR TC.
;IF "A" IS COMP-1, CONVERT "B" TO COMP-1 (IF NECESSARY) AND RETURN
; TO CALL+2.
;IF "B" IS COMP-1, CONVERT "A" TO COMP-1 (IF NECESSARY) AND RETURN
; TO CALL+2.
;IF "A" IS COMP-2, CONVERT "B" TO COMP-2 (IF NECESSARY) AND RETURN
; TO CALL+2.
;IF "B" IS COMP-2 CONVERT "A" TO COMP-2 (IF NECESSARY) AND RETURN
; TO CALL+2.
;IF "B" IS DISPLAY, CONVERT IT TO COMP.
;ON ANY OF THE ABOVE, IF ERRORS FOUND RETURN TO CALL+1.
SETB: SETZM NOFLOT ;CLEAR FLAG SINCE IT MIGHT HAVE BEEN LEFT ON
SETBX: HRRZ TE,EMODEA ;IF MODE IS
CAIE TE,FPMODE ; FLOATING-POINT,
CAIN TE,FCMODE ; OR FIG. CONST.,
JRST SETB0 ; DON'T DO SIZE TEST
CAIN TE,F2MODE ;SAME FOR COMP-2
JRST SETB0
MOVE TE,ESIZEA ;IF SIZE IS
CAIG TE,MAXSIZ+^D20 ; REASONABLE,
JRST SETB0 ; WE'RE HAPPY
SWON FERROR ;FORCE NO CODE
POPJ PP,
SETB0: HRRZ TE,EMODEB ;GET TYPE OF B-OPERAND
CAIE TE,LTMODE ;IS IT A LITERAL?
JRST SETB8 ;NO
TSWT FBNUM ;YES--NUMERIC?
JRST NOTNUM ;NO
SWON FBSIGN ;YES--MUST BE SIGNED
MOVEI LN,EBASEB ;GET READY TO GET LITERAL VALUE
HRRZ TE,EMODEA
CAIN TE,F2MODE ;IS "A" COMP-2?
JRST SETB1F ;YES
CAIE TE,FPMODE ;IS "A" COMP-1?
JRST SETB2 ;NO
PUSHJ PP,MSFP%L ;YES--CREATE A COMP-1 LITERAL
MOVEI TE,FPMODE ;FORCE MODE TO BE COMP-1
SETB1: MOVEM TE,EMODEB
MOVEI TE,AS.MSC ;GET ADDRESS
MOVEM TE,EBASEB
MOVEM TC,EINCRB
SETB1A: TSWT FERROR ;ANY ERRORS?
AOS (PP) ;NO--RETURN TO CALL+2
POPJ PP,
SETB1F: PUSHJ PP,MSF2%L ;YES--CREATE A COMP-2 LITERAL
MOVEI TE,F2MODE ;FORCE MODE TO BE COMP-2
JRST SETB1
;SET UP 'B' OPERAND (CONT'D)
;"B" IS NON-FLOATING-POINT LITERAL
SETB2: PUSHJ PP,CONVNL ;GET VALUE
MOVE TE,OPERND
MOVE CH,1(TE)
TLZE CH,NEGEOP
TSWC FLNEG;
MOVEM CH,1(TE)
SETB2A: JUMPE TD,SETB4 ;TWO-WORD LITERAL?
;"B" IS TWO-WORD LITERAL
TSWFZ FLNEG ;NEGATIVE?
PUSHJ PP,NEGATL ;YES--NEGATE VALUE
MOVE TA,[XWD D2LIT,2];CREATE LITERAL
PUSHJ PP,STASHP
MOVE TA,TD
PUSHJ PP,STASHQ
MOVE TA,TC
PUSHJ PP,POOLIT
MOVEI TE,D2MODE
MOVEI TC,2
SETB3: SKIPE PLITPC
JRST [MOVE TC,PLITPC
JRST SETB3A]
EXCH TC,ELITPC
ADDM TC,ELITPC
SETB3A: IORI TC,AS.LIT
JRST SETB1
;"B" IS ONE-WORD LITERAL
SETB4: JUMPE TC,CPOPJ ;RETURN IF ZERO VALUE
HRRZ TE,EMODEA ;IS MODE
CAIN TE,D1MODE ; ONE-WORD COMP?
TLNE TC,-1 ;YES--IS VALUE ONLY HALF-WORD?
JRST SETB5 ;NO--NEED LITERAL
POPJ PP, ;YES--RETURN WITH VALUE
SETB5: MOVE TA,[XWD D1LIT,1];CREATE LITERAL
PUSHJ PP,STASHP
TSWTZ FLNEG ;IS IT NEGATIVE?
SKIPA TA,TC ;NO
MOVN TA,TC ;YES
PUSHJ PP,POOLIT
MOVEI TE,D1MODE
MOVEI TC,1
JRST SETB3
;SET UP "B" OPERAND (CONT'D).
;"B" IS NOT A LITERAL
SETB8: CAIE TE,FCMODE ;IS "B" FIG. CONST.?
JRST SETB10 ;NO
SETZB TC,TD ;YES--
MOVE TE,OPERND ; IT
MOVE TD,(TE) ; MUST BE
TLNE TD,GNFCZ ; "ZERO"
JRST SETB4 ;IT IS -- OK
HRRZM TE,CUREOP ;IT ISN'T --
JRST BADFIG ;ERROR
;"B" IS A DATA-ITEM
SETB10: HRRZ TD,EMODEA
CAIE TE,F2MODE ;IS "B" COMP-2?
JRST SETB16 ;NO
CAIE TD,F2MODE ;YES--IS "A" ALSO COMP-2?
PUSHJ PP,CCXF2. ;NO--CONVERT "A" TO COMP-2
JRST SETB1A ;RETURN
SETB16: CAIE TE,FPMODE ;IS "B" COMP-1?
JRST SETB11 ;NO
CAIN TD,F2MODE ;[1113] IS "A" COMP-2?
JRST SETB20 ;[1113] YES, CONVERT "B" TO COMP-2
CAIE TD,FPMODE ;YES--IS "A" ALSO COMP-1?
PUSHJ PP,CCXFP. ;NO--CONVERT "A" TO COMP-1
JRST SETB1A ;RETURN
;"B" IS COMP-1, GET IT INTO THE ACCS AS COMP-2
SETB20: HRRZ TE,EBASEB ;[1113] IS "B" IN
SKIPN TE ;[1113] AC'S 0&1?
PUSHJ PP,EXCHAC ;[1113] YES--EXCHANGE AC'S
PUSHJ PP,SWAPEM ;[1113] EXCHANGE OPERANDS
PUSHJ PP,MXF2A. ;[1113] GET "B" INTO AC'S AS COMP-2
PUSHJ PP,SWAPEM ;[1113] RE-EXCHANGE OPERANDS
JRST SETB1A ;[1113] RETURN
;"B" IS NOT COMP-1 OR COMP-2
SETB11: CAIE TD,F2MODE ;IS "A" COMP-2?
JRST SETB17 ;NO
SKIPE NOFLOT ;DO WE HAVE TO CHECK FIRST?
SKIPE EDPLB ;YES, ANY DECIMAL PLACES?
JRST SETB18 ;FLOAT IT
CAIN TE,D1MODE ;IS "B" 1 WORD COMP?
JRST SETB1A ;YES, LEAVE AS IS
MOVE TD,ESIZEB ;GET SIZE
CAIG TE,DSMODE ;DISPLAY MODE?
CAILE TE,^D10 ;CONVERT TO 1-WORD COMP?
JRST SETB18 ;NO, JUST FLOAT IT
JRST SETB19 ;YES, GET INTO ACCS AS 1-WORD COMP
SETB18: HRRZ TE,EBASEB ;YES--IS "B" IN
SKIPN TE ; AC'S 0&1?
PUSHJ PP,EXCHAC ;YES--EXCHANGE AC'S
PUSHJ PP,SWAPEM ;EXCHANGE OPERANDS
PUSHJ PP,MXF2A. ;GET "B" INTO AC'S AS COMP-2
PUSHJ PP,SWAPEM ;RE-EXCHANGE OPERANDS
JRST SETB1A ;RETURN
SETB17: CAIE TD,FPMODE ;IS "A" COMP-1?
JRST SETB12 ;NO
SKIPE NOFLOT ;DO WE HAVE TO CHECK FIRST?
SKIPE EDPLB ;YES, ANY DECIMAL PLACES?
JRST SETB15 ;FLOAT IT
CAIN TE,D1MODE ;IS "B" 1 WORD COMP?
JRST SETB1A ;YES, LEAVE AS IS
MOVE TD,ESIZEB ;GET SIZE
CAIG TE,DSMODE ;DISPLAY MODE?
CAILE TE,^D10 ;CONVERT TO 1-WORD COMP?
JRST SETB15 ;NO, JUST FLOAT IT
SETB19: HRRZ TE,EBASEB ;YES--IS "B" IN
SKIPN TE ; AC'S 0&1?
PUSHJ PP,EXCHAC ;YES--EXCHANGE AC'S
PUSHJ PP,SWAPEM ;EXCHANGE OPERANDS
PUSHJ PP,MXAC. ;GET "B" INTO AC'S AS 1-WORD COMP
PUSHJ PP,SWAPEM ;RE-EXCHANGE OPERANDS
JRST SETB1A ;RETURN
SETB15: HRRZ TE,EBASEB ;YES--IS "B" IN
SKIPN TE ; AC'S 0&1?
PUSHJ PP,EXCHAC ;YES--EXCHANGE AC'S
PUSHJ PP,SWAPEM ;EXCHANGE OPERANDS
PUSHJ PP,MXFPA. ;GET "B" INTO AC'S AS COMP-1
PUSHJ PP,SWAPEM ;RE-EXCHANGE OPERANDS
JRST SETB1A ;RETURN
;SET UP "B" OPERAND (CONT'D)
;"B" IS DATA-ITEM, AND NEITHER "A" NOR "B" IS COMP-1 OR COMP-2
SETB12: CAILE TE,DSMODE ;IS "B" DISPLAY?
JRST SETB14 ;NO
SETB13: PUSHJ PP,SWAPEM ;EXCHANGE OPERANDS
PUSHJ PP,MXAC. ;GET "B" INTO AC'S
PUSHJ PP,SWAPEM ;RE-EXCHANGE AC'S
JRST SETB1A ;RETURN
SETB14: TSWF FBSIGN ;IF "B" IS NOT SIGNED OR
CAIN TE,C3MODE## ; IS COMP-3
JRST SETB13 ;MOVE IT TO THE AC'S.
JRST SETB1A ;OTHERWISE, LEAVE IT IN MEMORY.
;SET UP DECIMAL PLACES FOR ADD OR SUBTRACT
;IF "A" IS COMP-1, SIMPLY RETURN ("SETB" HAS INSURED THAT "B" IS ALSO COMP-1).
;IF "A" IS COMP-2, SIMPLY RETURN ("SETB" HAS INSURED THAT "B" IS ALSO COMP-2).
;IF "A" HAS FEWER DECIMAL PLACES, ADJUST "A".
;IF "B" HAS FEWER DECIMAL PLACES, ADJUST "B".
SETDP: HRRZ TE,EMODEA
CAIE TE,FPMODE
CAIN TE,F2MODE
JRST SUBSCB
MOVE TE,EDPLA
CAMN TE,EDPLB
JRST SUBSCB
CAML TE,EDPLB
JRST SETDP1
;"A" HAS FEWER PLACES
PUSHJ PP,ADJDP.
HRRZ TE,EMODEA ;HAS "A" BECOME
CAIE TE,FPMODE ; COMP-1?
JRST SETDP0 ;NO
PUSHJ PP,SWAPEM ;YES--
PUSHJ PP,MXFPA. ; CONVERT "B" TO
JRST SWAPEM ; COMP-1
SETDP0: CAIE TE,F2MODE ; COMP-2?
JRST SUBSCB ;NO
PUSHJ PP,SWAPEM ;YES--
PUSHJ PP,MXF2A. ; CONVERT "B" TO
JRST SWAPEM ; COMP-2
;"B" HAS FEWER PLACES
SETDP1: PUSHJ PP,SWAPEM ;EXCHANGE OPERANDS
PUSHJ PP,MXAC. ;GET "B" INTO AC'S
PUSHJ PP,ADJDP. ;ADJUST DECIMAL PLACES
PUSHJ PP,SWAPEM ;RE-EXCHANGE OPERANDS
HRRZ TE,EMODEB ;HAS "B" BECOME
CAIN TE,FPMODE ; COMP-1?
JRST CCXFP. ;YES--CONVERT "A"
CAIN TE,F2MODE ;OR COMP-2?
JRST CCXF2. ;CONVERT "A" TO COMP-2
POPJ PP, ;NO--RETURN
;LOOK AT NEXT ENTRY IN RESTAB.
;IF NO MORE ENTRIES, EXIT TO CALL+1; OTHERWISE EXIT WILL BE TO CALL+2.
;IF IT HAS MORE INTEGRAL PLACES, OR MORE DECIMAL PLACES, THAN AC'S,
;OR NEXT ENTRY IS S.P. AND PREVIOUS WAS D.P.
;AND CONTENTS OF AC'S WERE PREVIOUSLY STASHED IN A TEMPORARY, GENERATE
;CODE TO PICK UP THAT TEMPORARY.
LUKRES: SOSG ERCNT ;ANY MORE?
POPJ PP, ;NO--EXIT TO CALL+1
AOS (PP) ;EXIT WILL BE TO CALL+2
MOVEI TA,2 ;BUMP UP TO NEXT ENTRY
ADDB TA,CURRES
HRRZ TC,0(TA) ;SET POINTER TO RESULT'S EOPTAB ENTRY
SKIPN ETEMPR ;ANY TEMP STASHED?
POPJ PP, ;NO
SKIPN RESTYP ;DOING ANYTHING BUT "MOVEM"?
SKIPGE TD,-2(TA) ;WAS LAST RESULT ROUNDED?
JRST LUKR5 ;YES--TEMP REQUIRED
TLNE TD,(1B1) ;WAS LAST RESULT EDITED?
JRST LUKR5 ;YES, TEMP REQUIRED.
HRRZ TD,EMODEA ;ARE AC'S FLOATING POINT?
CAIN TD,FPMODE
JRST LUKR7 ;YES
HLRZ TD,1(TA) ;COMPARE INTEGRAL SIZES
MOVE TE,ESIZEA
SUB TE,EDPLA
CAMLE TD,TE
JRST LUKR4 ;RESULT > AC'S--GET TEMP
HRRE TD,1(TA) ;COMPARE DECIMAL PLACES
CAMLE TD,EDPLA
JRST LUKR4 ;GET TEMP
HLRZ TE,1(TA)
ADD TD,TE ;GET INTERNAL SIZE
CAILE TD,^D10 ;POSSIBLE PROBLEM IF S.P.
POPJ PP, ;NO NEED FOR TEMP
HLRZ TE,-1(TA) ;GET PREVIOUS
HRRE TD,-1(TA)
ADD TD,TE
CAIG TD,^D10 ;WAS THIS D.P.?
POPJ PP, ;NO TEMP NECESSARY
LUKR4: MOVE TD,ETEMPR+1 ;PICK UP DATA ON TEMP
LDB TE,ACMODE
CAIN TE,FPMODE
JRST LUKR5
LDB TE,ACSIZE
HRRE TB,TD
SUB TE,TB
MOVE TD,ESIZEA
SUB TD,EDPLA
CAMLE TE,TD
JRST LUKR5
CAMG TB,EDPLA
POPJ PP,
;LOOK AT NEXT ENTRY IN RESTAB (CONT'D).
;%TEMP MUST BE PICKED UP
LUKR5: SETZM EAC
MOVE TD,ETEMPR+1
LDB TE,ACSIZE
MOVEM TE,ESIZEA
HRRE TE,TD
MOVEM TE,EDPLA
LDB TE,ACMODE
MOVEM TE,EMODEA
CAIE TE,D2MODE
CAIN TE,D4MODE
JRST [PUSHJ PP,PUTASA##
MOVE CH,[DMOVE.##+ASINC,,AS.MSC]
JRST .+2]
MOVE CH,[XWD MOV+ASINC,AS.MSC]
PUSHJ PP,PUT.XA
HRRZ CH,ETEMPR
HRRZ TE,EMODEA
CAIE TE,D4MODE ;NEED TO RESTORE 4 ACCS?
JRST PUTASN
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA
MOVE CH,[DMOVE.+ASINC,,AS.MSC]
PUSHJ PP,PUT.XC ;RESTORE ACC+2 AND ACC+3
MOVE CH,ETEMPR
ADDI CH,2
JRST PUTASN
LUKR7: HLRZ TE,0(TA)
ANDCMI TE,1B18
CAIE TE,FPMODE
JRST LUKR4
POPJ PP,
;SET UP RESTAB
SETRES: MOVE TC,EOPLOC
ADDI TC,1
STRES0: MOVEM TC,CUREOP
SETZM ERCNT
MOVE EACA,EOPNXT
CAMN EACA,EOPLOC
POPJ PP,
MOVE TB,RESLOC
MOVEM TB,RESNXT
STRES1: PUSHJ PP,STRES8
PUSHJ PP,BMPEOP
POPJ PP,
HRRZ TC,CUREOP
JRST STRES1
;SET UP RESTAB (CONT'D)
STRES8: HLRE TE,RESNXT
CAMLE TE,[-2]
PUSHJ PP,XPNRES
MOVE TB,RESNXT
MOVE TD,TC
SUB TD,EOPLOC ;GET A RELATIVE ADDRESS
HRRZM TD,1(TB)
MOVE TA,1(TC)
LDB TD,LNKCOD
CAIE TD,TB.DAT
JRST NOTDAT
PUSHJ PP,LNKSET
LDB TE,DA.CLA
CAIE TE,%CL.NU
JRST NOTNUM
LDB TE,DA.NDP
LDB TD,DA.DPR
SKIPE TD
MOVNS TE
MOVEM TE,2(TB)
LDB TE,DA.INS
SUB TE,2(TB)
HRLM TE,2(TB)
LDB TE,DA.USG
SUBI TE,1
CAIN TE,IXMODE
STRESB: ; [250]
MOVEI TE,D1MODE
MOVE TD,1(TC)
TLNN TD,GNROUN
JRST STRES9
IORI TE,1B18
AOS 2(TB)
STRES9: LDB TD,DA.EDT##
TRNE TD,-1
TRO TE,(1B1)
STRESC: HRLM TE,1(TB) ;[672] ADD LABEL
AOS ERCNT
ADD TB,[XWD 2,2]
MOVEM TB,RESNXT
POPJ PP,
;SCAN THRU RESTAB.
;IF ANY ENTRY HAS MORE INTEGRAL PLACES, OR MORE DECIMAL PLACES, THAN
;PRECEDING ONES, OR IF ANY NON-FLOATING POINT FOLLOWS A FLOATING POINT,
;OR NEXT ENTRY IS S.P. AND PREVIOUS WAS D.P.
;GET A TEMP LOCATION AND GENERATE CODE TO STASH AC'S THERE.
SCNRES: TSWF FALWY0 ;IF AC'S ARE ZERO,
JRST SCNR3A ; NO TEMP NEEDED
MOVE TE,ERCNT
SOJLE TE,CPOPJ
SKIPN RESTYP ;RESULT OTHER THAN "MOVEM"?
TSWF FSZERA ;ANY SIZE ERROR CLAUSE?
JRST SCNRS4 ;YES--TEMP NEEDED
MOVE TA,RESLOC
ADDI TA,1
SCNRS1: HLRZ TB,0(TA) ;IS OPERAND ROUNDED?
TRZN TB,(1B1) ;OR EDITED?
TRNE TB,1B18
JRST SCNRS4 ;YES--TEMP NEEDED
CAIE TB,FPMODE
JRST SCNRS2
HLRZ TB,2(TA)
ANDCMI TB,1B18+1B19
CAIE TB,FPMODE
JRST SCNRS4
JRST SCNRS3
SCNRS2: HLRZ TB,1(TA)
HLRZ TC,3(TA)
CAMGE TB,TC
JRST SCNRS4
CAILE TB,^D10 ;IS THIS D.P.?
CAILE TC,^D10 ;AND NEXT S.P.?
CAIA ;NO
JRST SCNRS4 ;YES, NEED TEMP
HRRE TB,1(TA)
HRRE TC,3(TA)
CAMGE TB,TC
JRST SCNRS4
SCNRS3: ADDI TA,2
SOJG TE,SCNRS1
SCNR3A: SETZM ETEMPR
POPJ PP,
SCNRS4: MOVEI TE,1
HRRZ TA,EMODEA
CAIN TA,D2MODE
MOVEI TE,2
CAIN TA,D4MODE
MOVEI TE,4
PUSHJ PP,GETEMP
HRRZM EACC,ETEMPR
HRRZ TD,EDPLA
MOVE TE,ESIZEA
DPB TE,ACSIZE
DPB TA,ACMODE
MOVEM TD,ETEMPR+1
CAIE TA,D2MODE
CAIN TA,D4MODE
JRST [PUSHJ PP,PUTASA##
MOVE CH,[DMOVM.##+ASINC,,AS.MSC]
JRST .+2]
MOVE CH,[XWD MOVEM.+ASINC,AS.MSC]
PUSHJ PP,PUT.XA
HRRZ CH,ETEMPR
CAIE TA,D4MODE ;NEED TO SAVE 4 ACCS?
JRST PUTASN
PUSHJ PP,PUTASN
PUSHJ PP,PUTASA
MOVE CH,[DMOVM.+ASINC,,AS.MSC]
PUSHJ PP,PUT.XC## ;SAVE ACC+2 AND ACC+3
MOVE CH,ETEMPR
ADDI CH,2
JRST PUTASN
;SET UP "B" OPERAND AS A RESULT
RESETB:
;IF HERE FROM INSPECT, LOCATION "TEMADP"
; WILL HAVE THE RELATIVE ADDRESS IN TEMTAB
; WHERE WE HAVE THE OPERAND SAVED... ELSE
;"TEMADP" WILL BE ZERO
SKIPN TC,TEMADP## ;SKIP IF OPERAND IS IN TEMTAB
JRST RSETB0 ;NO--TAKE NORMAL ROUTE
;[732] REMOVE CLEARING OF TEMADP - IT WILL BE HANDLED BY THE CALLER
;[732] SETZM TEMADP## ;CLEAR FLAG
ADD TC,TEMLOC## ;GET ACTUAL LOCATION
JRST RSTB0A ; SKIP "HRRZ TC,@CURRES" AND ADD TC,EOPLOC
RSETB0: HRRZ TC,@CURRES
ADD TC,EOPLOC ;CHANGE RELATIVE ADDRESS TO OPERAND ADDRESS
RSTB0A: TLZ TC,-1 ;CLEAR LH
MOVEM TC,OPERND
MOVEM TC,CUREOP
PUSHJ PP,SETOPB ;GET PARAMETERS
MOVE TC,OPERND ;GET LINK TO
MOVE TA,1(TC) ; OPERAND
PUSHJ PP,LNKSET ;CONVERT TO ADDRESS
LDB TE,DA.CLA ;IF CLASS IS
CAIE TE,%CL.NU ; NOT NUMERIC,
JRST RSETB2 ; ERROR
SWON FBNUM ;IT IS NUMERIC
LDB TE,DA.EDT ;IF IT IS
JUMPE TE,RSETB1 ; NOT EDITED, USE EXTERNAL SIZE
LDB TE,DA.INS ;IT IS EDITED--GET INTERNAL SIZE
MOVEM TE,ESIZEB
MOVEI TE,EDMODE ;SET MODE TO NUMERIC-EDITED
MOVEM TE,EMODEB
RSETB1: POPJ PP,
RSETB2: SWON FERROR;
JRST NOTNUM
;GET IN RESULT FIELD FOR DIVIDE
SETDIV: SETOM OVFLFL## ;SIGNAL DIVIDE DONE, WE NEED OVFLO. TEST
SETZM FLTDIV## ;[566] CLEAR COMP-1 RESULT FLAG
SWOFF FEOFF1;
MOVE EACA,EOPNXT
MOVEM EACA,EREM1 ; [325] KEEP EOPTAB LOCATION IN CASE OF ERROR
MOVEM W1,OPLINE
CAMN EACA,EOPLOC
JRST STDIV9
MOVEM EACA,EREM0
PUSHJ PP,READEM
HRRZ TE,W2
CAIE TE,RESLT.
JRST STDIV9
MOVEM EACA,EREM1
MOVEM W1,EREM2
HRRZ TC,EREM0
PUSHJ PP,STDIV7
TSWF FERROR ;IF TROUBLE,
JRST STDIV4 ; DON'T CHECK ROUNDING
MOVE TA,2(TC) ;GET
PUSHJ PP,LNKSET ; NUMBER
LDB TE,DA.NDP ; OF DECIMAL PLACES
LDB TD,DA.DPR ;IS DECIMAL POINT
SKIPE TD ; TO RIGHT OF FIELD?
MOVNS TE ;YES--NEGATE
MOVEM TE,ERESDP
LDB TE,DA.USG ;[566] GET USAGE OF TARGET
CAIN TE,%US.C1 ;[566] IF IT IS COMP-1
SETOM FLTDIV ;[566] SET FLAG
SETDVA: ; [250]
MOVE TE,2(TC) ;IS RESULT TO BE
TLNN TE,GNROUN ; ROUNDED?
JRST STDIV1 ;NO
AOS ERESDP ;YES--GET ANOTHER DECIMAL PLACE
SETOM REMRND## ;IN CASE REMAINDER ALSO
STDIV1: MOVEI TC,1(TC)
MOVEM TC,CUREOP ;SET FOR SERIES TEST
PUSHJ PP,BMPEOP ;SEE IF IT IS
JRST STDIV4 ;ALL DONE
SETZM REMRND ;CAN'T HAVE REM IF SERIES
SKIPL DIVSRS ;IS IT DIVIDE INTO SERIES?
JRST STDIV5 ;YES, COUNT OPERANDS, BUT DON'T FIND MAX.
MOVE TC,CUREOP
SUBI TC,1 ;RESET TC
MOVE TA,2(TC)
PUSHJ PP,LNKSET
LDB TE,DA.NDP ;GET DECIMAL PLACES
CAMGE TE,ERESDP ;IS IT SMALLER?
JRST STDIV1 ;YES, TRY NEXT
MOVEM TE,ERESDP ;NO, SET MAX.
MOVE TE,2(TC)
TLNE TE,GNROUN ;IS THIS ONE ROUNDED?
AOS ERESDP ;YES
JRST STDIV1 ;TRY AGAIN
STDIV5: AOS DIVSRS ;COUNT NO. OF OPERANDS
MOVE TC,CUREOP
SOJA TC,STDIV1 ;RESET TC AND TRY AGAIN
STDIV4: PUSHJ PP,READEM ;GET OPERANDS&OPERATOR AFTER 'RESULT'
MOVEM W1,EREM4
MOVEM EACA,EREM3
HRRZ TE,W2
CAIE TE,REMOP
JRST STDIV6
HRRZ TC,EREM1
PUSHJ PP,STDIV7
MOVSI TE,GNSERA
TLNE W1,GNSERA
IORM TE,EREM2
SKIPGE REMRND ;ROUNDED ALSO
SOSA ERESDP ;YES, REMOVE EXTRA DECIMAL PLACE
STDIV6: SETZM REMRND ;NOT BOTH REMAINDER & ROUNDED
MOVE W1,OPLINE
MOVE TC,EOPLOC
MOVEI TC,1(TC)
MOVEM TC,CUREOP
MOVE EACA,EREM0
MOVEM EACA,EOPNXT
POPJ PP,
;GET DIVIDE RESULT FIELDS (CONT'D)
;CHECK OPERAND FOR VALIDITY
STDIV7: CAIN TC,(EACA) ;WAS AN OPERAND READ?
JRST STDIV9 ;NO--ERROR
MOVE TA,2(TC) ;IS IT
LDB TE,LNKCOD ; A
CAIN TE,TB.DAT ; DATA-NAME?
POPJ PP, ;YES--OK
MOVEI TC,1(TC) ;NO, SET UP FOR OPNFAT
MOVEM TC,CUREOP
JRST NOTDAT ;PUT OUT DIAG
STDIV9: CAIN TE,REMOP
TDCA TE,TE
MOVEM W1,EREM4 ; [325] SAVE W1, FIRST OPERATOR WORD.
MOVEM EACA,EREM3
SWON FERROR
POPJ PP,
;EXCHANGE CONTENTS OF AC'S SUCH THAT "A" IS NOW IN AC'S 0&1.
;CURRENTLY "B" IS THERE.
EXCHAC: MOVE TE,EBASEB
CAILE TE,1
POPJ PP,
MOVE TE,EAC
MOVEM TE,EBASEB
MOVSI CH,EXCH.
HRR CH,EAC
PUSHJ PP,PUTASY
HRRZ TE,EMODEB
CAIN TE,D2MODE
JRST EXCAC1
HRRZ TE,EMODEA
CAIE TE,D2MODE
JRST EXCAC3
MOVSI CH,MOV+AC1
JRST EXCAC2
EXCAC1: MOVSI CH,MOVEM.+AC1
HRRZ TE,EMODEA
CAIN TE,D2MODE
MOVSI CH,EXCH.
EXCAC2: HRR CH,EAC
ADDI CH,1
PUSHJ PP,PUTASY
EXCAC3: SETZM EAC
POPJ PP,
;GET "B" INTO AC'S AS COMP-1 NUMBER
GTBFP: HRRZ TE,EBASEB ;IS "B" NOW IN AC'S 0&1?
SKIPN TE
PUSHJ PP,EXCHAC ;YES--EXCHANGE AC'S
PUSHJ PP,FORCX0 ;BE SURE "A" IS NOW IN 0&1
PUSHJ PP,SWAPEM ;SWAP OPERANDS
PUSHJ PP,MXFPA. ;GET "B" INTO AC'S AS COMP-1
JRST SWAPEM ;RE-SWAP OPERANDS AND LEAVE
;GET "B" INTO AC'S AS COMP-2 NUMBER
GTBF2: HRRZ TE,EBASEB ;IS "B" NOW IN AC'S 0&1?
SKIPN TE
PUSHJ PP,EXCHAC ;YES--EXCHANGE AC'S
PUSHJ PP,FORCX0 ;BE SURE "A" IS NOW IN 0&1
PUSHJ PP,SWAPEM ;SWAP OPERANDS
PUSHJ PP,MXF2A. ;GET "B" INTO AC'S AS COMP-2
JRST SWAPEM ;RE-SWAP OPERANDS AND LEAVE
;RESET NEW SIZE OF AC'S
CHKSIZ: MOVE TE,ESIZEB
CAMLE TE,ESIZEA
JRST CHKSZ2
CHKSZ1: AOS TE,ECARRY
CAIG TE,^D9
POPJ PP,
SETZM ECARRY
AOS ESIZEA
POPJ PP,
CHKSZ2: MOVEM TE,ESIZEA
MOVEI TE,1
MOVEM TE,ECARRY
POPJ PP,
;IF "A" IS 1-WORD COMP, "B" IS 10 DIGITS OR LESS,
; AND SIZEA OF "A" IS 10, AND ECARRY IS 3, CONVERT "A" TO A 2-WORD COMP.
CHKS10: HRRZ TE,EMODEA
CAIE TE,D1MODE
POPJ PP,
MOVE TE,ESIZEB
CAIL TE,^D11
POPJ PP,
MOVE TE,ESIZEA
CAIE TE,^D10
POPJ PP,
MOVE TE,ECARRY
CAIGE TE,3
POPJ PP,
JRST CC1C2.
;SWAP "A" AND "B" PARAMETERS
SWAPEM: PUSHJ PP,SWAPAB
MOVE TE,EAC
MOVEM TE,EBASEB
SETZM EINCRB
SKIPE EAC
JRST [SETZB TE,EAC ;USE 0 & 1
POPJ PP,]
MOVE TE,EMODEB ;GET MODE OF OLD "A"
CAIN TE,D4MODE ;QUADRUPLE PRECISSION?
SKIPA TE,[4] ;YES, NEED 0 - 3
MOVEI TE,2
MOVEM TE,EAC
POPJ PP,
;NEGATE AC'S IF "B" HAS UNARY MINUS
NEGIF: MOVE TE,OPERND
MOVE TE,1(TE)
TLNN TE,NEGEOP
POPJ PP,
MOVSI CH,MOVN.
HRRZ TE,EMODEA
CAIE TE,D2MODE
JRST NEGIF2
PUSHJ PP,PUTASA
MOVSI CH,DMOVN.##
NEGIF2: HRR CH,EAC
DPB CH,CHAC
JRST PUTASY
;PUT FIRST OPERAND INTO AC'S
;USED BY ADD,ADDTO,MUL,MULBY,DIV,DIVBY
GRABOP: SETZM OVFLFL ;THESE OPERATIONS CANNOT CAUSE OVERFLOW
SETZM RESTYP ; [417] SET DEFAULT RESTYP
SETZM FLTDIV ;[715] IN CASE LEFT ON BY A DIVIDE
MOVEM W1,OPLINE
GRBDIV: HRRZ TC,EOPLOC
ADDI TC,1
GRBOP0: MOVE EACA,EOPNXT
CAIL TC,(EACA) ;STILL INSIDE EOPTAB?
JRST BADEOP ;NO--TROUBLE
SWOFF FEOFF1 ;TURN OFF MOST FLAGS
MOVEM TC,CUREOP ;SAVE THAT LOCATION
MOVSM TC,OPERND
GRBOP1: SETOM EDEBDA## ;MIGHT NEED TO DEBUG ON DATA-ITEM
SOS EDEBDA ; BUT ONLY IF "ARO" ON
PUSHJ PP,SETOPA ;SET UP "A" PARAMETERS
GRBP1A: SETZM EAC ;USE AC'S 0 & 1
SETZM ECARRY
GRBOP2: HRRZ TE,EMODEA
CAIN TE,FCMODE
JRST GRBOP9
TSWF FANUM ;NUMERIC FIELD?
JRST GRBOP5 ;YES
MOVEM TC,CUREOP ;NO, RESET PTR TO THAT OPERAND
SETOM RESTYP ;SET ERROR FLAG
JRST NOTNUM ;GIVE "?IMPROPER CLASS" MSG
GRBOP5: CAIN TE,LTMODE
JRST GRBOP3
SETZM RESTYP ;SET RESULT TYPE TO ZERO
SKIPL FLTDIV ;[566] DO WE NEED TO FLOAT IT?
JRST MXAC. ;GET DATA INTO AC'S AND RETURN
JRST MXFPA. ;[566] YES
;PUT FIRST OPERAND INTO AC'S (CONT'D).
;IT IS A LITERAL.
GRBOP3: PUSHJ PP,CONVNL ;GET VALUE INTO TC&TD
TSWF FERROR ;ANY ERRORS?
JRST GRBOP8 ;YES
SETZM RESTYP ;NO--CLEAR RESULT TYPE
GRBOP4: SKIPN TD ;TREAT ZERO LITERAL IN
JUMPE TC,GRBO10 ; SPECIAL WAY
MOVE TE,ESIZEA ;ONE WORD LITERAL?
CAILE TE,^D10
JRST GRBOP6 ;NO
MOVEI TE,D1MODE ;YES--SET MODE
MOVEM TE,EMODEA
CAIN TC,1 ;1 IS SPECIAL
JRST GRBO1A ;AS WE CAN USE AOS OR SOS
CAMN TC,[-1] ;OR -1
JRST GRBO1B ;SINCE THIS IS SOS OR AOS
TSWF FLNEG ;NEGATIVE LITERAL?
MOVNS TC ;YES--NEGATE VALUE
MOVSI CH,MOV## ;GENERATE <MOVE AC,[LITERAL]>
JRST PUT.LA ; AND RETURN
GRBOP6: MOVEI TE,D2MODE
MOVEM TE,EMODEA
TSWF FLNEG;
PUSHJ PP,NEGATL
MOVE TA,[XWD D2LIT,2]
PUSHJ PP,STASHP
MOVE TA,TD
PUSHJ PP,STASHQ
MOVE TA,TC
PUSHJ PP,POOLIT
MOVEI TE,AS.MSC
MOVEM TE,EBASEA
SKIPN TE,PLITPC
MOVE TE,ELITPC
IORI TE,AS.LIT
HRRZM TE,EINCRA
MOVEI TE,2
SKIPN PLITPC
ADDM TE,ELITPC
JRST MXAC.
GRBOP7: PUSHJ PP,NOTNUM ;PUT OUT "IMPROPER CLASS" DIAG
GRBOP8: PUSHJ PP,BMPEOP ;ANY MORE OPERANDS?
POPJ PP, ;NO
HRRZ TC,CUREOP ;YES--TRY NEXT ONE
JRST GRBOP1
;PUT FIRST OPERAND INTO AC'S (CONT'D)
;IT IS A FIGURATIVE CONSTANT
GRBOP9: HRRZ TE,EFLAGA
CAIE TE,2
JRST GRBOP7
SETZM RESTYP ;FIG. CONST ZERO - SET RESTYP TO 0
;LITERAL IS ZERO
GRBO10: SWON FALWY0 ;SET "AC'S ARE ZERO"
POPJ PP,
;LITERAL IS 1
GRBO1A: MOVEI TE,3 ;AOS
TSWF FLNEG ;-1
MOVEI TE,4 ;SET TO SOS
MOVEM TE,RESTYP
POPJ PP, ;[545] RETURN
;LITERAL IS -1
GRBO1B: MOVEI TE,4 ;SAOS
TSWF FLNEG ;+1
MOVEI TE,3 ;SET TO AOS
MOVEM TE,RESTYP
POPJ PP, ;[545] RETURN
;CHECK OPERANDS FOR LEGALITY FOR "SET" VERB.
;SET UP LAST OPERAND.
SETSET: SWOFF FEOFF1 ;TURN OFF MOST FLAGS
SETZM FLTDIV ;[566] CLEAR INCASE LEFT ON BY PREV. DIVIDE
MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
SETZM ERCNT
SETZM RESTYP
SETZM EAC
HRRZ TC,EOPLOC
ADDI TC,1
MOVE EACA,EOPNXT
CAIL TC,(EACA) ;ANY OPERANDS AT ALL?
JRST SETST4 ;NO--ERROR
SETST1: MOVEM TC,CUREOP
MOVE TA,1(TC)
LDB TE,LNKCOD
CAIE TE,TB.DAT
JRST SETST5 ;NO--ERROR
MOVE TE,0(TC) ;YES--IS IT NUMERIC?
TLNN TE,GNOPNM
JRST SETST3 ;NO--ERROR
MOVE TA,1(TC) ;YES--GET POINTER TO DATAB
PUSHJ PP,LNKSET
LDB TE,DA.NDP ;ANY DECIMAL PLACES?
JUMPN TE,SETST3
SETSTA: AOS ERCNT ;[250] NO
SETST2: PUSHJ PP,BMPEOP ;STEP UP TO NEXT ONE
JRST SETST4 ;NO MORE--ERROR
MOVE TC,CUREOP ;SAVE LOCATION OF THIS ONE
PUSHJ PP,BMPEOP ;WAS THAT THE LAST?
JRST SETST7 ;YES
JRST SETST1 ;NO--GO PROCESS IT
SETST3: SETOM RESTYP ;SET ERROR INDICATION
MOVEI DW,E.264 ;WRITE OUT DIAG
PUSHJ PP,OPNFAT
JRST SETST2
SETST4: SETOM RESTYP ;SET ERROR INDICATION
JRST BADEOP ;PUT OUT DIAG
SETST5: PUSHJ PP,NOTDAT
SETOM RESTYP
JRST SETST2
;SET UP LAST OPERAND FOR "SET" VERB (CONT'D).
;LAST OPERAND IS IN HAND.
SETST7: MOVEM TC,CUREOP
HRLM TC,OPERND
MOVEI TE,-1(TC) ;RESET RESNXT TO DROP THIS ONE
HRRM TE,EOPNXT
SETOM EDEBDA ;INCASE DEBUGGING
SOS EDEBDA ;ONLY FOR "ARO"
MOVEI LN,EBASEA ;SET UP PARAMETERS
PUSHJ PP,SETOPN
TSWF FERROR;
JRST STST10
HRRZ TE,EMODEA
CAIN TE,FCMODE
JRST STST12
TSWT FANUM ;NUMERIC?
JRST SETST8 ;NO
CAIE TE,LTMODE ;YES--IS IT A LITERAL?
JRST STST11 ;NO
SETST9: PUSHJ PP,CONVNL ;GET VALUE OF LITERAL INTO AC'S
TSWF FERROR ;ANY ERRORS?
JRST STST10 ;YES--QUIT
STST11: SKIPN EDPLA ;NO--ANY DECIMAL PLACES?
POPJ PP, ;NO--ALL OK
SETST8: MOVEI DW,E.264 ;WRITE OUT DIAG
PUSHJ PP,OPNFAT
STST10: SETOM RESTYP ;SET ERROR INDICATION
POPJ PP,
STST12: MOVE TD,EOPNXT
MOVE TD,1(TD)
TLNN TD,GNFCZ
JRST SETST8
POPJ PP,
;ERROR ROUTINES
TOOBIG: MOVEI DW,E.88
JRST OPERA
BADFIG: MOVEI DW,E.211
OPERA: SWON FERROR;
JRST OPNFAT
CANT0: MOVE W1,OPLINE
MOVEI DW,E.239
JRST OPFAT
ADDT.1=.-3
EXP ADD1D ;"A" + 1C
EXP ADD2D ;"A" + 2C
EXP ADDFP ;"A" + FP
BLOCK 4
EXP TOOBIG ;"A" + 4C
EXP ADDF2 ;"A" + F2
SUBT.1=.-3
EXP SUB1D ;"A" - 1C
EXP SUB2D ;"A" - 2C
EXP SUBFP ;"A" - FP
BLOCK 4
EXP TOOBIG ;"A" - 4C
EXP SUBF2 ;"A" - F2
MULT.1=.-3
EXP ML1CX ;"A" * 1C
EXP ML2CX ;"A" * 2C
EXP MLFPFP ;"A" * FP
BLOCK 4
EXP TOOBIG ;"A" * 4C
EXP MLF2F2 ;"A" * F2
MULT.2=.-3
EXP ML1C1C ;1C * 1C
EXP ML1C2C ;1C * 2C
MULT.3=.-3
EXP ML2C1C ;2C * 1C
EXP ML2C2C ;2C * 2C
DIVT.1=.-3
EXP DIVX.6
EXP DIVX10
EXP DIVX40
BLOCK 4
EXP DIVX11 ;"A" / 4C
EXP DIVXF2 ;"A" / F2
;CODE TO KEEP TRACK OF MAX. POSSIBLE SIZE OF INTERMEDIATE TEMP IN ADD AND SUBTRACT SERIES.
INIT9: MOVE TE,ESIZEA ;GET SIZE
CAILE TE,^D12 ;IF ITS ALREADY D.P.
POPJ PP, ;DON'T CARE
MOVE TE,TABLE9(TE) ;GET NO. OF 9'S
MOVEM TE,ADDTMP## ;INTO COUNTER
POPJ PP,
;ADD NEXT MAX. SIZE TO SEE IF WE NEED D.P. BEFORE CODE IS GENERATED
NEXT9: TSWF FERROR ;GIVE UP IF ALREADY SEEN ERROR
POPJ PP,
HRRZ TE,EMODEA ;IF MODE IS NOT
CAIE TE,D1MODE ; 1-WORD COMP
POPJ PP, ; DON'T WORRY
HRRZ TE,EMODEB ;SAME FOR "B" OPERAND
CAIE TE,FPMODE ; IF FLOATING-POINT,
CAIN TE,F2MODE ; OR COMP-2,
POPJ PP, ; DON'T WORRY SETB WILL TAKE CARE OF IT
MOVE TE,ESIZEB ;IF SIZE IS
CAILE TE,^D12 ; GREATER THAN 10 DIGITS
POPJ PP, ; ITS ALREADY D.P.
MOVE TE,EDPLA ;WORRY ABOUT DECIMAL PLACES
SUB TE,EDPLB ; IF THEY ARE DIFFERENT
JUMPE TE,NEXT9B ;DON'T BOTHER IF ZERO
JUMPL TE,NEXT9A ;"B" HAS MORE PLACES SHIFT "A"
ADD TE,ESIZEB ;MUST SHIFT "B"
CAILE TE,^D12 ;SEE IF WE GOT TOO BIG
POPJ PP, ;YES, WE WILL USE D.P. ANYWAY
JRST NEXT9C ;NUMBER IS SLIGHTLY TOO BIG
NEXT9A: MOVM TE,TE ; WE MUST SHIFT CURRENT MAX.
MOVE TE,POWR10##(TE) ;GET POWER OF TEN
JFCL 17,.+1 ;CLEAR FLAGS
IMUL TE,ADDTMP ;SEE IF IT OVERFLOWS
JOV MAKDP ;MAKE "A" D.P. IF IT OVERFLOWS
MOVEM TE,ADDTMP ;STORE NEW RESULT BACK
NEXT9B: MOVE TE,ESIZEB ;GET SIZE AGAIN
NEXT9C: MOVE TE,TABLE9(TE) ;GET 9'S
JFCL 17,.+1 ;CLEAR FLAGS
ADDM TE,ADDTMP ;GET NEW TOTAL
JOV MAKDP ;MAKE "A" D.P. IF THIS OVERFLOWED
POPJ PP,
MAKDP: JRST CC1C2. ;CONVERT "A" TO 2-WORD COMP
;TABLE OF 9'S, USED TO COMPUTE MAX. POSSIBLE SIZE OF INTERMEDIATE TEMP
;IN ADD AND SUBTRACT SERIES.
RADIX 10
TABLE9: 0
9
99
999
9999
99999
999999
9999999
99999999
999999999
9999999999
RADIX 8
DINTO==1B<^D18+^D9> ;"INTO" FLAG IN DIVIDE OPERATOR
RESLT.==11 ;"RESULT" OPERATOR CODE
YECCH.==105 ;"YECCH" OPERATOR CODE
NEGEOP==1B<^D18+6> ;"UNARY MINUS" FLAG IN OPERAND
REMOP==12 ;'REMAINDER' OPERATOR CODE
EXTERNAL CORR
EXTERNAL EOPLOC,EOPNXT,CUREOP,RESLOC,RESNXT,CURRES,EWORDB,EREMAN,TEMBAS,ETEMPC
EXTERNAL EBASEA,EINCRA,ERESA,EDPLA,EMODEA,ESIZEA,EFLAGA,EBYTEA
EXTERNAL EBASEB,EINCRB,ERESB,EDPLB,EMODEB,ESIZEB,EFLAGB,EBYTEB
EXTERNAL EBASEX,EINCRX,ERESX,EDPLX,EMODEX,ESIZEX,EFLAGX,EBYTEX
EXTERNAL ESAVEA,ESAVEB,EBASAX,EBASBX,ESAVAX,ESAVBX,ESAVER,ESAVRX
EXTERNAL D1MODE,D2MODE,DSMODE,D6MODE,D7MODE,FPMODE,F2MODE,EDMODE,FCMODE,LTMODE,IXMODE,ZERO
EXTERNAL AS.MSC,AS.CNB,AS.TMP,AS.LIT,D1LIT,D2LIT
EXTERNAL LNKCOD,TB.DAT
EXTERNAL DA.CLA,DA.NDP,DA.DPR,DA.INS,DA.EXS,DA.USG,DA.EDT
EXTERNAL AOS.,FAD.,ADDM.,FADM.,DADD.,DSUB.,DMUL.,DDIV.
EXTERNAL SOS.,SUB.,FSB.,MUL.,FMP.,IMUL.,DFAD.,DFSB.,DFMP.,DFDV.
EXTERNAL DIV.,FDV.,DIV.11,DIV.12,DIV.21,DIV.22
EXTERNAL MOVM.,MOVN.,MOVEM.,MOVEI.,MOVNI.,MOVSI.,HRLZI.
EXTERNAL BLT.,EXCH.,SETZB.,HRRZI.,SETZM.,SETZ.,SZERA.,OVFLO.
EXTERNAL E.C3C1,E.C3C3,E.F2D1,E.F2D2,E.F2FP,E.F2F2,EPJPP
EXTERNAL MOVMS.,SOSGE.
EXTERNAL EAC,ELITPC,CUREOP,OPERND,CHAC,ESAVAC,OPLINE
EXTERNAL ECARRY,MAXSIZ,ESZERA,ERESDP,EMULSZ,EOPCOD
EXTERNAL ERCNT,ETEMPR,RESTYP,ACSIZE,ACMODE,REMPAR
EXTERNAL EREM0,EREM1,EREM2,EREM3,EREM4
END