Trailing-Edge
-
PDP-10 Archives
-
BB-H580C-SB_1981
-
expgen.mac
There are 21 other files named expgen.mac in the archive. Click here to see a list.
; UPD ID= 3322 on 1/9/81 at 10:51 AM by NIXON
TITLE EXPGEN FOR COBOL V12B
SUBTTL CODE GENERATORS FOR ARITHMETIC EXPRESSIONS AL BLACKINGTON/CAM
;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, 1981 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
;EDITS
;NAME DATE COMMENTS
;DMN 26-SEP-80 [1056] FIX COMP-2 TO COMP-1 CONVERSION IN COMPUTE STATEMENT.
;DMN 8-MAY-80 ;[1017] FIX EDIT 443, MAKE COMPUTE A = - (SOMETHING) WORK.
;DAW 27-MAR-80 ;[777] FIX ?ASSEMBLY ERROR WHEN LITERALS USED IN
; ;COMPUTE AND EDIT 637 IS INSTALLED
;DMN 7-FEB-80 ;[767] CHECK OVERFLOW FLAGS FOR "ON SIZE ERROR".
;DMN 30-JAN-80 ;[762] ADD SMALL CONSTANT TO COMP-2 COMPUTE CALCULATIONS.
;V12A RELEASED
;DMN 27-FEB-79 ;[641] FIX INCORRECT TEST FOR OPERAND IS ACC AT LASTOP
;DAW 23-FEB-79 ;[637] FIX COMPUTE WITH COMP-1 RESULT
;EHM 14-APR-78 ;[534] FIX COMPUTE GETS ANSWER FROM WRONG AC
;V12 RELEASE
;EHM 28-DEC-76 ;[456] WARN IF ROUNDING IN WRONG PLACE
;V11 RELEASE
;JC 16-SEP-76 ;[443] FIX 'COMPUTE A = - (25)'
;ACK 28-MAY-75 COMP-3/EBCDIC CODE.
;V10 RELEASE
; EDIT 370 FIX RETURN FATAL ERROR IN EXPRESSION
; EDIT 360 FIX EDIT 320 FOR SIMPLE COMPUTE X = -A OR (-A)
; EDIT 350 TURN OFF ZERO BIT AFTER COMPUTE
; EDIT 321 FIX RECOVERY IN A COMPUTE STATEMENT IF DATA IS NOT QUALIFIED.
; EIDT 320 FIX COMPUTE X = - (EXP) (MINUS SIGN)
;EDIT 314 FIX RECOVERY IF COMPUTE STATEMENT HAS UNDEFINED VARIBLE
TWOSEG
SALL
RELOC 400000
EXPGEN: INTERNAL EXPGEN
ENTRY EXPRGN ;START OF AN EXPRESSION
ENTRY COMPGN ;"COMPUTE" GENERATOR
ENTRY CENDGN ;"CEND" GENERATOR
EXTERNAL PUTASY,PUTASN,FATAL,WARN,GETEMP,GETGEN,SETOPN,LNKSET
EXTERNAL BMPEOP,GETTAG,PUTTAG,ADJDP.,COMEBK,PUSEOP,PUSH12
EXTERNAL ADDX.,SUBX.,MULX.,DIVX.,EXPX.,MACX.,MXAC.,MNXAC.,SWAPAB
EXTERNAL PUT.XA,PUT.XB,PUT.EX
EXTERNAL ROUND,SIZERA,NOTNUM,BADEOP
EXTERNAL NEGCMP ; [360]
EXTERNAL OPNWRN ;[456]
DEFINE SUBGEN (X),<
XLIST
IRP X,<
ENTRY X'GN
X'GN=NOTOPR
>
LIST>
NOTOPR: MOVEM PP,SAVEPP
MOVEI DW,E.215
W1ERA: LDB LN,W1LN
LDB CP,W1CP
;PUT OUT A DIAGNOSTIC, THEN SCAN GENFIL FOR ENDEXP OR ENDIT OPERATOR.
GOBACK: PUSHJ PP,FATAL
JRST GOBAK3
GOBAK1: MOVE PP,SAVEPP
GOBAK2: PUSHJ PP,GETGEN
GOBAK3: JUMPL W1,GOBAK2
HRRZ TE,W2
CAIL TE,OPCADD ; [321] GO PAST PARTS OF COMPUTE
CAILE TE,OPCEXP ; [321] STMNT ADD,SUB,MULPY,DIV,EXPEN
SKIPA ; [321] OKAY SO FAR
JRST GOBAK2 ; [321] ONE OF THE ABOVE- GO ON
CAIL TE,OPLPAR ; [321] ALSO GO PAST LEFT AND RIGHT
CAILE TE,OPEXP ; [321] PARENS AND EXPRESSIONS
CAIN TE,OPYECC ; [V10] SKIP OVER THE YECCH ALSO.
JRST GOBAK2 ; [321] ONE OF THE ABOVE- GO ON
SETZM NEGCMP ; [V10]
POPJ PP, ; [V10]
;THE FOLLOWING ROUTINES SHOULD NEVER BE ENTERED FROM THE OUTSIDE
SUBGEN <CADD,CSUB,CMUL,CDIV,CEXP,LPAR,RPAR,ENDX>
;"COMPUTE" GENERATOR
COMPGN: SETZM NEGCMP ; [360] TURN OFF NEGATE SWITCH
SETZM ECARRY## ;[534] RESET ECARRY
SETZM FLTDIV## ;[637] CLEAR "RESULT IS FLOATING POINT"
SWOFF FEOFF1 ;TURN OFF MOST FLAGS
MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
SWON FBIGCV ;TURN ON "CONVERT TO FL.PT. IF TOO BIG"
HRRZ TC,EOPLOC ;GET FIRST OPERAND
IFN ANS68,<
ADDI TC,1
>
IFN ANS74,<
MOVE CH,CMPLVL
IMULI CH,4 ;4 WORDS EACH
ADDI TC,1(CH)
>
MOVE EACA,EOPNXT
CAIL TC,(EACA)
JRST BADEOP ;THERE ISN'T ONE--ERROR
MOVE W2,1(TC) ;GET OPERAND'S SECOND WORD
LDB CH,W2SUBC ;GET SUBSCRIPT COUNT
ADDI CH,1
LSH CH,1
HRLS CH
PUSHJ PP,PUSEOP ;STASH IT IN EOPTAB
MOVEI CH,0 ; FOLLOWED BY
PUSHJ PP,PUSEOP ; ZERO
MOVE TA,W2 ;IF ITEM IS
LDB TE,LNKCOD ; NOT
CAIN TE,TB.DAT ; DATA-NAME,
JRST COMPG1 ; USE
MOVEI TA,0 ; ZERO
JRST COMPG2 ; DECIMAL PLACES
COMPG1: PUSHJ PP,LNKSET ;IT'S DATA-NAME--GET DATAB ENTRY ADDRESS
LDB TE,DA.NDP ;GET DECIMAL PLACES
LDB TD,DA.DPR ;IF DECIMAL POINT IS TO
SKIPE TD ; THE RIGHT OF THE WORD BOUNDARY,
MOVNS TE ; NEGATE
LDB TD,DA.USG## ;[637] GET USAGE OF TARGET
CAIN TD,%US.C1 ;[637] IF IT IS COMP-1
SETOM FLTDIV ;[637] SET FLAG
COMPG2: TLNE W2,GNROUN ;IS RESULT TO BE ROUNDED?
ADDI TE,1 ;YES--ADD 1 TO DECIMAL PLACES
IFN ANS74,<
SKIPN CMPLVL## ;NOT FIRST?
JRST .+3 ;IT IS
CAMGE TE,ERESDP ;FIND LARGEST IN SERIES
MOVE TE,ERESDP ;USE PREVIOUS
>
MOVEM TE,ERESDP
MOVE EACA,EOPNXT
IFN ANS74,<
AOS CH,CMPLVL ;BUMP COUNT
SOJN CH,COMEBK ;ONLY OUTPUT FIRST TIME
>
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]
SETOM OVFLFL## ;SIGNAL WE MIGHT NEED OVERFLOW CHECKING
JRST COMEBK
;"CEND" GENERATOR
CENDGN: SETZM ERESDP
SETZM FLTDIV## ;[637] CLEAR "FLOATING POINT RESULT"
SWOFF <FBIGCV!FEOFF1>-FALWY0; TURN OFF SOME FLAGS
MOVE EACA,EOPNXT
HRRZ TC,EOPLOC
ADDI TC,1
CAIL TC,(EACA) ;ANY OPERANDS?
POPJ PP, ;NO--MUST HAVE HAD A YECCH
MOVEM TC,OPERND
MOVEM TC,CUREOP
IFN ANS74,<
SETZM CMPTMP## ;
SOSG CMPLVL ;MORE THAN 1 IN SERIES?
JRST CEND00 ;NO
MOVE TC,CMPLVL ;GET COUNT
PUSHJ PP,BMPEOP ;BYPASS OPERAND
POPJ PP, ;ERROR
PUSHJ PP,BMPEOP ;BYPASS "PSEUDO = OP"
POPJ PP,
SOJGE TC,.-4 ;LOOP
MOVE TC,CUREOP ;POINT TO VALUE OF COMP
HRRZM TC,CMPEOP## ;STORE FOR LATER
HRRZ TC,EOPLOC
ADDI TC,1
MOVEM TC,OPERND ;RESET
MOVEM TC,CUREOP
HRROS CMPLVL ;SIGNAL FIRST TIME
CEND0L: PUSHJ PP,CEND00 ;YES, LOOP BACK
SKIPN CMPTMP ;NEED TO RESTORE VALUE?
JRST CEND0N ;NO
IFN BIS,<
HLRZ CH,CMPTMP
SOJE CH,.+3 ;1 WORD ONLY
PUSHJ PP,PUTASA
SKIPA CH,[DMOVE.##+ASINC,,AS.MSC]
>
MOVE CH,[MOV##+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,CMPTMP
PUSHJ PP,PUTASN
IFE BIS,<
HLRZ CH,CMPTMP
SOJE CH,CEND0N
MOVE CH,[MOV+AC1+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,CMPTMP
ADDI CH,1
PUSHJ PP,PUTASN
>
CEND0N: HRRZ TC,EOPLOC
MOVEI TC,1(TC)
MOVEM TC,OPERND
MOVEM TC,CUREOP
PUSHJ PP,BMPEOP ;BYPASS THIS
POPJ PP, ;CAN'T HAPPEN
AOS TC,CUREOP ;BYPASS "PSEUDO = OP"
HRRM TC,EOPLOC ;SET TO TOP OF NEW OPERAND
MOVEI TC,1(TC)
MOVEM TC,OPERND
MOVEM TC,CUREOP
SOSE CMPLVL ;COUNT DOWN
JRST CEND0L ;NOT DONE YET
CEND00:
>;END OF IFN ANS74
MOVEI LN,EBASEB
PUSHJ PP,SETOPN
TSWT FBNUM;
JRST CEND2
CEND0: PUSHJ PP,BMPEOP
POPJ PP, ;ONLY 1 OP--MUST HAVE BEEN A YECCH.
HRRZ TC,EOPLOC ;GET
ADDI TC,1 ; CUREOP, AND RESET IT TO
EXCH TC,CUREOP ; TOP OF EOPTAB
ADDI TC,2 ;SKIP PAST COUNT WORD AND "PSEUDO =" OPERATOR
IFN ANS74,<
SKIPE CMPLVL ;LAST ONE (OR ONLY ONE)?
MOVE TC,CMPEOP ;YES, POINT TO IT
>
HRLM TC,OPERND
MOVE TA,1(TC) ; [314] GET DATA NAME ADDRESS
CAIN TA,100001 ; [314] IF DUMMY VARIABLE
POPJ PP, ; [314] WHICH REPLACED UNDEFINED ONE-QUIT
MOVEI LN,EBASEA
PUSHJ PP,SETOPN
IFN ANS74,<
SKIPE CMPTMP ;VALUE IN TEMP?
SETZM EBASEA ;ACTUALLY IN ACC 0 & 1
SKIPL CMPLVL ;FIRST TIME?
JRST CEND0B ;NO
HRRZS CMPLVL ;ONLY ONCE
HRRZ TE,EBASEA ;IS IT IN THE ACCS
CAILE TE,17
JRST CEND0B ;NO?
MOVEI TE,2
MOVE TD,EMODEA
CAIE TD,D2MODE
MOVEI TE,1 ;1 WORD ONLY
HRLZM TE,CMPTMP ;LHS = NO. OF WORDS
PUSHJ PP,GETEMP
IFN BIS,<
CAIN TD,D2MODE
PUSHJ PP,PUTASA ;NEED DMOVE
>
MOVE CH,EBASEA ;GET ACC
LSH CH,^D18+5
IFE BIS,<
ADD CH,[MOVEM.+ASINC,,AS.MSC]
>
IFN BIS,<
ADD CH,[ASINC,,AS.MSC]
CAIN TD,D2MODE ;NEED DMOVEM
TLOA CH,DMOVM.##
TLO CH,MOVEM.
>
PUSHJ PP,PUTASY
HRRZ CH,EACC
HRRM CH,CMPTMP ;RHS = TEMP ADDRESS
PUSHJ PP,PUTASN
IFE BIS,<
CAIE TD,D2MODE
JRST CEND0B
MOVE CH,EBASEA
LSH CH,^D18+5
ADD CH,[MOVEM.+AC1+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
MOVEI CH,1(EACC)
PUSHJ PP,PUTASN
>
CEND0B:>
TSWT FANUM ;IS "A" NUMERIC?
PUSHJ PP,CEND3
HRRZ TE,EMODEA ;IS "A" A LITERAL?
CAIN TE,LTMODE
JRST CEND0A
HRRZ TE,EBASEA ;NO--IS IT THE AC'S?
CAIG TE,17
JRST CEND1 ;YES
CEND0A: SETZM EAC ;NO--GET IT INTO AC'S 0&1
PUSHJ PP,INTOAC ;GET "A" INTO THE AC'S
MOVS TC,OPERND ;[1017] GET "A" OPERANDS ADDRESS
MOVSI TE,NEGEOP ;[1017] CLEAR NEGATE OPERAND FLAG
ANDCAM TE,1(TC) ;[1017] SINCE INTOAC HAS ALREADY GOT NEGATIVE
CEND1: HLRZ TC,OPERND ; [320] GET AC OPERND ADDRESS
MOVE TC,1(TC) ; [320] GET 2ND WORD OF OPERND
TLNE TC,NEGEOP ; [320] NEGATE THE RESULT IN THE AC?
PUSHJ PP,CENDN ; [320] YES
SETZM NEGCMP ; [360] TURN OFF NEGATE SWITCH
MOVE TC,OPERND
MOVE TC,1(TC)
TLNE TC,GNROUN
IFE BIS,<
PUSHJ PP,ROUND
>
IFN BIS,<
JRST [PUSHJ PP,ROUND ;[762] ROUNDING REQUIRED
JRST CEND1C] ;[762]
HRRZ TE,EMODEA ;[762] GET MODE OF "A"
HRRZ TC,EMODEB ;[762] AND "B"
CAIN TE,F2MODE## ;[762] IS "A" COMP-2
CAIN TC,F2MODE ;[762] AND "B" SOMETHING ELSE?
JRST CEND1C ;[762] NO, LEAVE AS IS
CAIN TC,FPMODE## ;[1056] IF COMP-1
JRST [PUSHJ PP,CF2FP.## ;[1056] JUST ROUND AND TRUNCATE
JRST CEND1C] ;[1056]
PUSHJ PP,EPSLON## ;[762] YES, ADD EPSILON TO "A"
CEND1C:>
SETZM EMULSZ ;SET "SINGLE RESULT" INDICATOR
TLNE W1,GNSERA ;[350] ON SIZE SPECIFIED?
JRST CEND1A ;[350] YES
PUSHJ PP,MACX. ;[350] GENERATE MOVE
JRST CEND1B ;[350] FINISH UP AND RETURN.
CEND1A: PUSHJ PP,GETTAG ;[350] GET A TAG NUMBER.
MOVEM CH,ESZERA ;[350] SAVE IT FOR "SPIF"
PUSHJ PP,SIZERA ;[350] GENERATE "SIZE ERROR" CODE
CEND1B: SWOFF FALWY0 ;[350] TURN OFF ZERO INDICATOR
POPJ PP, ;[350] RETURN
; NEGATE THE RESULT IN THE AC'S
; ONLY NEGATE FINAL RESULT IF COMPUTE STATEMENT HAS
; LEADING MINUS SIGN AND LEFT PAREN
CENDN: MOVE TC,NEGCMP ; [360] SEE IF WE SHOULD NEGATE THE FINAL OUTPUT.
CAIGE TC,2 ; [360] YES IF CORRECT COUNT
POPJ PP, ; [360] DO DON'T DO IT.
HRRZ TC,EMODEA ; [320] GET MODE OF AC
MOVSI CH,MOVN. ; [320] ASSUME 1-WORD RESULT
CAIE TC,D2MODE ; [320] IS IT 2-WORD RESULT?
JRST PUTASY ; [320] NO, PUT IN CODE AND RETURN
IFE BIS,<
MOVSI CH,NEG.## ; [320] FOR 2-WORD RESULT USE NEG UUO
>
IFN BIS,<
PUSHJ PP,PUTASA##
MOVSI CH,DMOVN.##
>
JRST PUTASY ; [320] PUT IN CODE AND RETURN
;"B" ISN'T NUMERIC. SEE IF IT IS NUMERIC EDITED.
CEND2: TLNN TB,GNOPNM
JRST NOTNUM ;IT ISN'T--TOUGH
MOVE TA,ETABLB ;IT IS--
PUSHJ PP,LNKSET ; GET
LDB TE,DA.INS ; INTERNAL SIZE
MOVEM TE,ESIZEB
MOVEI TE,EDMODE ;RESET MODE
MOVEM TE,EMODEB
SWON FBNUM;
JRST CEND0
;"A" ISN'T NUMERIC. SEE IF IT IS "ZERO".
CEND3: HRRZ TE,EMODEA
MOVE TD,EFLAGA
CAIN TE,FCMODE
CAIE TD,ZERO
JRST NOTNUM
JRST INTOAC ;IT IS "ZERO"--SET AC'S TO ZERO
;GENERATE CODE FOR EXPRESSION
EXPRGN: MOVEM W1,OPLINE
MOVEM PP,SAVEPP ;SAVE PP IN CASE OF ERROR
MOVE EACA,EOPNXT
MOVE TE,EACA
SUB TE,EOPLOC
MOVEM TE,EXPBEG
IFN ANS74,<
AOS CURXSQ## ;INCREMENT THE NUMBER SEEN FOR FIPS FLAGGER
>
PUSHJ PP,EXPRGA ; [360] CHECK SEQUENCE OF TERMS AND EVALUATE EXPRESSION.
EXPRA: MOVEI TA,COMEBK
PUSH PP,TA
MOVE TA,EOPLOC
ADD TA,EXPBEG
CAMN TA,EOPNXT
JRST EXPR0
HRRZ TD,W2
CAIE TD,OPYECC
POPJ PP,
PUSHJ PP,GOBAK2
;TROUBLE--PUT DUMMY DATAB OPERAND ON EOPTAB
EXPR0: MOVE EACA,TA
MOVEM EACA,EOPNXT
MOVE CH,OPLINE
TLZ CH,777774
TLO CH,(1B0)
PUSHJ PP,PUSEOP
HRRZI CH,100001
PUSHJ PP,PUSEOP
MOVE CH,[XWD 2,2]
JRST PUSEOP
; [360] CHECK TERM SEQUENCE IN AN EXPRESSION.
EXPRGA: PUSHJ PP,GETGEN ; [360] GET NEXT GENFIL INPUT
SETZM NEGCMP ; [360] RESET NEGATE SWITCH
JUMPL W1,EXPR1A ; [360] IT IS AN OPERAND, NO NEGATION
CAIN W2,OPCSUB ; [360] LEADING MINUS SIGN
AOS NEGCMP ; [360] YES, FINAL NEGATION POSSIBLE
JRST EXPR11 ; [360] GO ON TO EVALUATE EXPRESSION
EXPR1: PUSHJ PP,GETGEN
JUMPL W1,EXPR1A
EXPR11: HRRZ TE,W2 ; [360] GET OPERATOR CODE
CAIN TE,OPENDE
POPJ PP,
PUSHJ PP,NXTOPR
JRST EXPR1B
EXPR1A: PUSHJ PP,GTOPN1
EXPR1B: PUSHJ PP,GETOPR
EXPR2: SWOFF FEOFF1-FBIGCV-FALWY0;
HRRZ TE,W2
CAIG TE,OPCEXP ;IS IT ONE OF THE ALGEBRAIC OPERATORS?
CAIGE TE,OPCADD
JRST EXPR3 ;NO
PUSHJ PP,@EXPR5-OPCADD(TE) ;YES--DISPATCH TO A ROUTINE
JRST EXPR2 ;LOOP
EXPR3: CAIN TE,OPRPAR
POPJ PP,
CAIN TE,OPENDE
JRST EXPR4
CAIE TE,OPYECC
JRST CONFUZ
EXPR4: SETZM ERESDP
POPJ PP,
EXPR5: EXP CADD
EXP CSUB
EXP CMUL
EXP CDIV
EXP CEXP
;GENERATE CODE FOR A+B
CADD: PUSHJ PP,ADDSUB ;INSURE THAT WE CAN ADD NOW
PUSHJ PP,BOPRND ;GET "B" OPERAND
JRST CADD4 ;IT IS IN AC'S
PUSHJ PP,AOPRND ;GET "A" OPERAND
JRST CADD3 ;IT IS IN AC'S
HRRZ TE,EMODEA ;IS "A" A LITERAL?
CAIE TE,LTMODE
JRST CADD2 ;NO
HRRZ TE,EMODEB ;IS "B" A LITERAL?
CAIN TE,LTMODE
JRST CADD2 ;YES--NO SENSE IN SWAPPING
PUSHJ PP,SWAPAB ;NO--SWAP SO LITERAL IS "B"
CADD2: PUSHJ PP,INTOAC ;GET "A" INTO THE AC'S
CADD3: MOVE TE,OPERND
MOVE TE,1(TE)
TLNE TE,NEGEOP
JRST CSUB3A
CADD3A: PUSHJ PP,ADDX. ;GENERATE THE ADD
JRST SETAC ;SET OPERAND TO BE AC'S, AND RETURN
CADD4: PUSHJ PP,SWAPAB
CADD5: PUSHJ PP,BOPRN1 ;GET OTHER OPERAND
JRST CONFUZ ;IT CAN'T BE IN AC'S
JRST CADD3
;GENERATE CODE FOR A-B
CSUB: PUSHJ PP,ADDSUB ;INSURE THAT WE CAN SUBTRACT NOW
PUSHJ PP,BOPRND ;GET "B" OPERAND
JRST CSUB4 ;IT IS IN AC'S
PUSHJ PP,AOPRND ;GET "A" OPERAND
JRST CSUB3 ;IT IS IN AC'S
PUSHJ PP,INTOAC ;GET "A" INTO AC'S
CSUB3: MOVE TE,OPERND
MOVE TE,1(TE)
TLNE TE,NEGEOP
JRST CADD3A
CSUB3A: PUSHJ PP,SUBX.
JRST SETAC
CSUB4: PUSHJ PP,SWAPAB
HRRZ TE,EMODEA ;NEGATE THE AC'S
CAIN TE,D2MODE
JRST CSUB5
MOVSI CH,MOVN. ;GENERATE <MOVN AC,AC>
JRST CSUB6
CSUB5:
IFE BIS,<
MOVSI CH,NEG. ;GENERATE <NEG. AC,AC>
>
IFN BIS,<
PUSHJ PP,PUTASA
MOVSI CH,DMOVN.
>
CSUB6: HRR CH,EAC
DPB CH,CHAC
PUSHJ PP,PUTASY
JRST CADD5
;GENERATE CODE FOR A*B
CMUL: PUSHJ PP,MULDIV ;INSURE THAT WE CAN MULTIPLY NOW
PUSHJ PP,BOPRND ;GET "B" OPERAND
JRST CMUL5 ;IT IS AC'S
PUSHJ PP,AOPRND ;GET "A" OPERAND
JRST CMUL3 ;IT IS AC'S
HRRZ TE,EMODEA
CAIE TE,FCMODE
CAIN TE,LTMODE
PUSHJ PP,SWAPAB
CMUL2: PUSHJ PP,INTOAC ;GET OPERAND INTO AC'S
CMUL3: PUSHJ PP,MULX. ;GENERATE THE MULTIPLY
CMUL4: PUSHJ PP,SETAC ;SET OPERAND TO BE AC'S
HRRZ TE,W2 ;IS NEXT OPERATOR ANOTHER "*"?
CAIN TE,OPCMUL
JRST CMUL ;YES--LOOP
CAIN TE,OPCDIV ;NO--IS IT "/"?
JRST CDIV ;YES
POPJ PP, ;NO--RETURN
CMUL5: MOVE TE,[XWD EBASEB,EBASEA] ;MOVE "B" TO "A"
BLT TE,EBASAX
MOVSS OPERND
PUSHJ PP,BOPRN1 ;GET OTHER OPERAND
JRST CONFUZ ;IT CAN'T BE IN AC'S
JRST CMUL3
;GENERATE CODE FOR A/B
CDIV: PUSHJ PP,MULDIV
PUSHJ PP,BOPRND ;GET "B" OPERAND
JRST CDIV5 ;IT'S IN AC'S
PUSHJ PP,AOPRND ;GET "A" OPERAND
JRST CDIV3
CDIV2:
IFN BIS,<
SETOM FLTDIV ;FORCE FLOATING POINT ON DIVIDE
>
PUSHJ PP,INTOAC ;GET "A" INTO AC'S
IFN ANS74&0,<
MOVE TE,ESIZEA
CAIL TE,^D18 ;MAX. SIZE
JRST CDIV3 ;YES, CAN NOT DO ANY BETTER
MOVE TE,[EBASEB,,ESAVEB##]
BLT TE,ESAVBX## ;SAVE CURRENT "B"
MOVE TE,[EBASEA,,EBASEB]
BLT TE,EBASBX ;COPY "A" TO "B"
MOVEI TE,D2MODE
MOVEM TE,EMODEB ;SET MODE TO 2-WORDS
MOVEI TE,^D18
MOVEM TE,ESIZEB ;MAKE "B" MAX. SIZE
SUB TE,ESIZEA
ADDM TE,EDPLB ;ADD EXTRA AS DECIMAL PLACES
PUSHJ PP,ADJDP.## ;ADJUST ACCS
MOVE TE,[EBASEB,,EBASEA]
BLT TE,EBASAX ;NEW "A"
MOVE TE,[ESAVEB,,EBASEB]
BLT TE,EBASBX ;RESTORE "B"
>
CDIV3: PUSHJ PP,DIVX.
JRST CMUL4
CDIV5: HRRZ TE,EMODEB ;ARE AC'S 2-WORD COMP
CAIN TE,D2MODE
JRST CDIV7 ;YES
MOVEI TE,1 ;NO--GET A 1-WORD TEMP
PUSHJ PP,GETEMP
CDIV6: MOVE CH,[XWD MOVEM.+ASINC,AS.MSC]
CDIV8: PUSHJ PP,PUT.XA
IORI EACC,AS.TMP
HRRZ CH,EACC
PUSHJ PP,PUTASN
MOVEM EACC,EINCRB
MOVEI TE,AS.MSC
MOVEM TE,EBASEB
PUSHJ PP,AOPRND
JRST CONFUZ
MOVEI TE,1(EACA)
HRLM TE,OPERND
JRST CDIV2
CDIV7: MOVEI TE,2
PUSHJ PP,GETEMP
IFE BIS,<
IORI EACC,AS.TMP
MOVE CH,[XWD MOVEM.+ASINC,AS.MSC]
PUSHJ PP,PUT.XB
MOVEI CH,1(EACC)
PUSHJ PP,PUTASN
JRST CDIV6
>
IFN BIS,<
PUSHJ PP,PUTASA
MOVE CH,[DMOVM.##+ASINC,,AS.MSC]
JRST CDIV8
>
;EXPONENTIATE.
CEXP: MOVE CH,W1 ;SAVE
PUSHJ PP,PUSEOP ; OPERATOR
PUSHJ PP,GETOPN ;GET NEXT OPERAND
PUSHJ PP,BOPRND ;GET "B" OPERAND
JRST CEXP5
CEXP1A: PUSHJ PP,AOPRND ;GET "A" OPERAND
JRST CEXP2
PUSHJ PP,INTOAC ;PUT IT INTO AC'S
CEXP2: PUSHJ PP,EXPX.
PUSHJ PP,SETAC
PUSHJ PP,GETOPR
HRRZ TE,W2
CAIN TE,OPCEXP
JRST CEXP
POPJ PP,
CEXP5: MOVEI TE,1
HRRZ TD,EMODEA
CAIN TD,D2MODE
MOVEI TE,2
PUSHJ PP,GETEMP
HRRZM EACC,EINCRA
MOVEI TD,AS.MSC
MOVEM TD,EBASEA
MOVE TE,[XWD EBASEA,EBASEB]
BLT TE,EBASBX
PUSHJ PP,MACX.
MOVE TE,[XWD EBASEA,EBASEB]
BLT TE,EBASBX
JRST CEXP1A
;LOOK AHEAD TO SEE IF WE CAN ADD OR SUBTRACT.
;IF WE CANNOT, FIX IT SUCH THAT WE CAN.
ADDSUB: PUSHJ PP,ADSB6 ;GET OPERAND & OPERATOR
CAIN TE,OPCEXP ;EXPONENTIATION?
JRST ADSB3 ;YES
ADSB2: CAIN TE,OPCMUL ;MULTIPLICATION?
JRST ADSB4 ;YES
CAIN TE,OPCDIV ;DIVISION?
JRST ADSB5 ;YES
POPJ PP, ;NO--RETURN
;NEXT OPERATOR IS "**"
ADSB3: PUSHJ PP,STASH ;STASH CURRENT AC'S
PUSHJ PP,CEXP ;GENERATE EXPONENTIATION CALLS
HRRZ TE,W2 ;GO BACK TO CHECK FOR
JRST ADSB2 ; MULTIPLY AND DIVIDE
;NEXT OPERATOR IS "*"
ADSB4: PUSHJ PP,STASH ;STASH CURRENT AC'S
JRST CMUL ;GENERATE MULTIPLY AND RETURN
;NEXT OPERATOR IS "/"
ADSB5: PUSHJ PP,STASH ;STASH CURRENT AC'S
JRST CDIV ;GENERATE DIVIDE AND RETURN
;GET NEXT OPERAND AND OPERATOR
ADSB6: MOVE CH,W1 ;SAVE
PUSHJ PP,PUSEOP ; THIS OPERATOR
PUSHJ PP,GETOPN ;GET OPERAND
PUSHJ PP,GETOPR ;GET OPERATOR
HRRZ TE,W2 ;EXTRACT OPERATOR CODE
POPJ PP,
;LOOK AHEAD TO SEE IF WE CAN MULTIPLY OR DIVIDE NOW.
;IF WE CANNOT, FIX IT SO THAT WE CAN.
MULDIV: PUSHJ PP,ADSB6 ;GET OPERAND AND OPERATOR
CAIE TE,OPCEXP ;IS IT EXPONENTIATION?
POPJ PP, ;NO--RETURN
PUSHJ PP,STASH ;YES--SAVE CURRENT AC'S
JRST CEXP ;EXPONENTIATE, THEN RETURN
;GENERATE CODE TO GET "A" INTO THE AC'S
INTOAC: CAMN EACA,EOPLOC ;ANYTHING IN EOPTAB?
JRST INTOA0 ;NO
MOVE TD,[XWD EBASEB,ESAVER] ;YES--IF AC'S, STASH
BLT TD,ESAVRX
MOVEI TD,-2(EACA)
PUSHJ PP,STASHA
MOVE TD,[XWD ESAVER,EBASEB]
BLT TD,EBASBX
;"A" IS GOING INTO THE ACS. "B" OPERAND IS SETUP IN EBASEB, ETC.
; PROTECT "B" AGAINST EXPANDING TABLES BY ADJUSTING "EBYTEB" TO
; BE A RELATIVE ITEM.
INTOA0: HRRZ TA,EBYTEB
HRRZ TB,VALLOC## ;GET RELATIVE VALTAB OFFSET
SUB TA,TB
HRRM TA,EBYTEB ;INCASE TABLES EXPAND
PUSH PP,[INTOA4] ;RETURN HERE WHEN MOVGEN POPJ'S
SETZM EAC ;CLEAR RESULT AC
HRRZ TE,EMODEA
CAIN TE,FCMODE
JRST INTOA2
INTOA1: MOVS TA,OPERND
MOVE TA,1(TA)
SKIPE FLTDIV## ;[637] IS RESULT FLOATING?
JRST INTOF1 ;[637] YES, FLOAT "A"
TLNE TA,NEGEOP
JRST MNXAC.
JRST MXAC.
;[637] "FLTDIV" HAS BEEN SET TO -1 BY "COMPGN". THIS HAPPENS WHEN
;[637] THE COBOL STATEMENT IS "COMPUTE COMP-1 = EXPRESSION"
;[637] OR A DIVIDE OPARAND HAS BEEN SEEN IN EXPRESSION.
;[637] THE FIRST OPERAND IS BROUGHT INTO THE ACS AS COMP-1 OR COMP-2,
;[637] THUS FORCING COBOL TO EVALUATE THE EXPRESSION
;[637] ENTIRELY WITH FLOATING-POINT OPERATIONS
INTOF1: HRRZ TE,EMODEA ;[777] IS "A" A LITERAL?
CAIN TE,LTMODE ;[777]
JRST INTOF2 ;[777] YES, THESE MOVGEN ROUTINES
;[777] ARE NOT SMART ENOUGH TO HANDLE
;[777] LITERALS CORRECTLY -- (FIXED IN V13)
IFE BIS,<
TLNN TA,NEGEOP ;[637] NEGATE "A" ALSO?
JRST MXFPA.## ;[637] NO, JUST FLOAT IT
PUSHJ PP,MNXAC. ;[637] YES, GET -A IN ACS
JRST CCXFP.## ;[637] AND FLOAT IT
>
IFN BIS,<
TLNN TA,NEGEOP ;[637] NEGATE "A" ALSO?
JRST MXF2A.## ;[637] NO, JUST FLOAT IT
PUSHJ PP,MNXAC. ;[637] YES, GET -A IN ACS
JRST CCXF2.## ;[637] AND FLOAT IT
>
;[777] LITERAL SPECIAL CASE
;[777] THIS STUFF IS NECESSARY BECAUSE THE MOVGEN ROUTINES
;[777] DO NOT ALWAYS KEEP TRACK OF WHERE THE DATA ITEM IS!
INTOF2: PUSH PP,EMODEB ;[777] SAVE CURRENT MODE OF B
IFN BIS,<
MOVEI TE,F2MODE## ;[777] WANT 2 WORD F.P. ANSWER IN AC
> ;[777]
IFE BIS,<
MOVEI TE,FPMODE## ;[777]
>
MOVEM TE,EMODEB ;[777] FAKE OUT MOVGEN
TLNE TA,NEGEOP ;[777] SKIP IF NOT A NEGATIVE OPERAND
JRST INTOF4 ;[777] TELL MOVGEN TO NEGATE IT
PUSHJ PP,MXAC. ;[777] MOVE LITERAL TO AC, CONVERTING TO FP
INTOF3: POP PP,EMODEB ;[777] PUT BACK ORIGINAL "EMODEB"
POPJ PP, ;[777] RETURN
INTOF4: PUSHJ PP,MNXAC. ;[777] MOVE NEG. LITERAL TO AC, CONVERTING TO FP
JRST INTOF3 ;[777]
INTOA2: HRRZ TD,EMODEB
CAIE TD,FCMODE
CAIN TD,LTMODE
MOVEI TD,D1MODE
CAILE TE,DSMODE ;IS IT DISPLAY OR
CAIN TD,C3MODE## ; OR COMP-3.
SKIPA TE,ESIZEB ;YES, CHANGE THE MODE.
JRST INTOA3
MOVEI TD,D1MODE
CAILE TE,^D10
MOVEI TD,D2MODE
INTOA3: SWON FALWY0 ;SET "AC'S CONTAIN ZERO"
POPJ PP,
;RETURN HERE TO FIX EBYTEB
INTOA4: HRRZ TA,VALLOC
ADDM TA,EBYTEB ;NOW IT'S AN ABSOLUTE BP AGAIN
POPJ PP, ;RETURN FROM "INTOAC"
;GET "B" OPERAND FROM EOPTAB
BOPRND: MOVEI LN,EBASEB
PUSHJ PP,LASTOP
AOS (PP)
POP EACA,EOPHLD
MOVEM EACA,EOPNXT
MOVEI TE,EOPHLD
MOVEM TE,CUREOP
BOPA: HRRM TC,OPERND
TSWF FBNUM ;IS "B" NUMERIC?
POPJ PP, ;YES
HRRZ TE,EMODEB ;NO--IT BEST BE "ZERO"
MOVE TD,EFLAGB
BOPB: CAIN TE,FCMODE ;IS IT A FIG. CONST.?
CAIE TD,ZERO ;YES--ZERO?
JRST NOTNMA ;NO--YOU LOSE
POPJ PP,
;GET "B" OPERAND AS SECOND OPERAND
BOPRN1: MOVEI LN,EBASEB
PUSHJ PP,LASTOP
AOS (PP)
JRST BOPA
;GET "A" OPERAND FROM EOPTAB
AOPRND: MOVEI LN,EBASEA
AOPRN1: PUSHJ PP,LASTOP
AOS (PP)
HRLM TC,OPERND
TSWF FANUM ;IS "A" NUMERIC?
POPJ PP,
HRRZ TE,EMODEA
MOVE TD,EFLAGA
JRST BOPB
;GET THE LAST OPERAND FROM EOPTAB
LASTOP: MOVE EACA,EOPNXT
POP EACA,TC ;GET DECREMENT COUNT
SUB EACA,TC ;BACK UP EOPTAB POINTER
MOVS TE,1(EACA) ;[641] IS IT THE AC'S?
CAIN TE,GNOPNM ;[641] TEST FOR OPERAND SET AT SETAC
AOS (PP) ;YES--RETURN TO CALL+2
MOVEI TC,1(EACA)
MOVEM EACA,EOPNXT
PUSHJ PP,SETOPN
MOVE EACA,EOPNXT
MOVE TB,EBASEX(LN) ; [321] GETOPERAND LOCATION
CAIE TB,<CD.DAT>B20+1 ; [321] IF DUMMY QUIT NOW
POPJ PP, ; [321] OKAY- RETURN
JRST GOHOME ; [321] ABANDON EXPRESSION CODE GENERATION
;SET "LAST OPERAND IS AC".
SETAC: MOVSI CH,GNOPNM ;STASH FIRST PART OF
PUSHJ PP,PUSEOP ; OPERAND
MOVSI TD,GNOPNM
MOVE TE,EMODEA
DPB TE,ACMODE
MOVE TE,ESIZEA
DPB TE,ACSIZE
HRR TD,EDPLA
TLO TD,GNNOTD
MOVE CH,TD ;STASH SECOND PART OF
PUSHJ PP,PUSEOP ; OPERAND
MOVE CH,[XWD 2,2] ;STASH
JRST PUSEOP ; COUNT WORD AND RETURN
;IF ANYTHING IN AC'S--SAVE IT IN A TEMP
;LAST THING IN EOPTAB IS AN OPERAND.
STASH: MOVE TD,EOPNXT
SUB TD,(TD)
MOVEI TD,-4(TD)
STASHA: MOVE TE,1(TD)
HRRZ TC,0(TD)
TLNE TE,GNNOTD
CAILE TC,17
POPJ PP,
MOVE TE,[XWD EBASEA,ESAVEA] ;SAVE CURRENT "A"
BLT TE,ESAVAX
MOVE TC,TD
MOVE TD,1(TD)
HRRE TE,TD
MOVEM TE,EDPLA
LDB TE,ACMODE
MOVEM TE,EMODEA
LDB TE,ACSIZE
MOVEM TE,ESIZEA
PUSH PP,SW ;SAVE CURRENT SWITCHES
SWON FASIGN!FANUM!FBSIGN!FBNUM;
SWOFF FASUB!FBSUB;
MOVEI TE,1
HRRZ TD,EMODEA
CAIN TD,D2MODE
MOVEI TE,2
CAIN TD,D4MODE
MOVEI TE,4
PUSHJ PP,GETEMP
HRRM EACC,0(TC)
MOVE TE,[XWD EBASEA+1,EBASEB+1]
BLT TE,EBASBX
HRRZM EACC,EINCRB
HRRZI TE,AS.MSC
MOVEM TE,EBASEB
PUSHJ PP,MACX.
MOVE TE,[XWD ESAVEA,EBASEA] ;RESTORE "A"
BLT TE,EBASAX
POP PP,SW ;RESTORE SWITCHES
SETZM EAC
POPJ PP,
;SAVE ANYTHING IN AC'S (CONT'D).
;LAST THING IN EOPTAB IS OPERATOR, COUNT WORD, OR NOTHING
STASHB: MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANYTHING IN EOPTAB?
POPJ PP, ;NO--NOTHING TO STASH
MOVE TD,(EACA) ;IS LAST THING AN OPERATOR?
TLNN TD,777000
POPJ PP, ;NO--FORGET IT
MOVEI TD,-1(EACA)
SUB TD,0(TD)
JRST STASHA
;GET NEXT OPERAND.
GETOPN: PUSHJ PP,GETGEN
JUMPGE W1,NXTOPR ;IT IS AN OPERATOR
GTOPN1: PUSHJ PP,PUSH12 ;STASH W1&W2 IN EOPTAB
MOVEI TE,-1(EACA) ;SAVE
MOVEM TE,CUREOP ; THAT ENTRY LOCATION
TLNE W2,GNROUN ;[456] IS IT ROUNDED?
PUSHJ PP,ROUNER ;[456] YES, ERROR
TLNE W1,GNLIT
TDCA TE,TE
LDB TE,W2SUBC
MOVE TD,TE
JUMPE TE,GTOPN3
GTOPN2: PUSHJ PP,GETGEN
PUSHJ PP,PUSH12 ;STASH W1&W2
SOJG TE,GTOPN2
GTOPN3: LSH TD,1
ADDI TD,2
HRLS TD
MOVE CH,TD ;STASH COUNT WORD
JRST PUSEOP ; AND RETURN
;GET NEXT OPERATOR
GETOPR: PUSHJ PP,GETGEN
JUMPL W1,CONFUZ
HRRZ TE,W2
CAIE TE,OPYECC
POPJ PP,
;NEXT OPERATOR WAS YECCH--GO AWAY
GOHOME: MOVE PP,SAVEPP
PUSHJ PP,GOBAK3 ; [370] GET READY TO RETURN
MOVE TA,EXPBEG
ADD TA,EOPLOC
MOVEM TA,EOPNXT
JRST EXPRA
;WE WENT LOOKING FOR AN OPERAND, BUT FOUND AN OPERATOR.
NXTOPR: HRRZ TE,W2 ;LEFT PAREN?
CAIE TE,OPLPAR
JRST NXTOP1 ;NO
PUSHJ PP,STASHB ;YES--STASH AC'S
SKIPLE NEGCMP ; [360] IF > 0 MEANS WE HAD A LEADING SIGN.
AOS NEGCMP ; [360] LEADING MINUS SIGN - COUNT LEFT PAREN
JRST EXPR1 ;EVALUATE EXPRESSION AND RETURN
NXTOP1: CAIE TE,OPCSUB ;WAS IT A UNARY MINUS?
JRST NXTOP3 ;NO--WE'RE CONFUSED
PUSH PP,EACA
PUSHJ PP,GETOPN ;YES--GET NEXT OPERAND
POP PP,TD
MOVSI TE,NEGEOP ;SET "NEGATE OPERAND"
XORM TE,2(TD)
POPJ PP,
NXTOP3: CAIE TE,OPYECC
JRST CONFUZ
JRST GOHOME
;ERROR ROUTINES
;OPERAND WAS NOT NUMERIC (INSIDE EXPRESSION)
NOTNMA: MOVEI DW,E.211
SWON FERROR;
MOVE TC,(TC)
LDB CP,TCCP
LDB LN,TCLN
JRST FATAL
;WRONG NUMBER OF OPERANDS (INSIDE EXPRESSION)
BADOPA: MOVEI DW,E.214
JRST W1ERA
CONFUZ: MOVE TC,CUREOP
MOVE TC,(TC)
LDB LN,TCLN
LDB CP,TCCP
MOVEI DW,E.216
JRST GOBACK
;[456] USER HAS TRIED TO ROUND IN WRONG PLACE, WARN HIM
ROUNER: MOVEI DW,E.591 ;[456] GET DIAGNOSTIC
PUSH PP,TE ;[456] SAVE
PUSH PP,LN ;[456] SOME
PUSH PP,TC ;[456] REGISTERS
PUSHJ PP,OPNWRN ;[456] GIVE WARNING
POP PP,TC ;[456] GET
POP PP,LN ;[456] REGISTERS
POP PP,TE ;[456] BACK
POPJ PP, ;[456] AND CONTINUE
NEGEOP==1B<^D18+6>
EXTERNAL TCLN,TCCP,W1LN,W1CP,W2SUBC,EAC,SAVEPP
EXTERNAL EBASEA,EINCRA,ERESA,EDPLA,ESIZEA,EMODEA,EFLAGA,EBYTEA
EXTERNAL EBASEB,EINCRB,ERESB,EDPLB,ESIZEB,EMODEB,EFLAGB,EBYTEB,ETABLB
EXTERNAL EBASEX,EINCRX,ERESX,EDPLX,ESIZEX,EMODEX,EFLAGX,EBYTEX
EXTERNAL ESAVEA,ESAVEB,EBASAX,EBASBX,ESAVAX,ESAVBX
EXTERNAL ESAVER,ESAVRX
EXTERNAL EOPLOC,EOPNXT,CUREOP,OPLINE,OPERND,EXPBEG
EXTERNAL DA.NDP,DA.DPR,DA.INS
EXTERNAL LNKCOD,TB.DAT
EXTERNAL D1MODE,D2MODE,D4MODE,D6MODE,D7MODE,EDMODE,LTMODE,FCMODE,DSMODE,ZERO
EXTERNAL ACMODE,ACSIZE,TESUBC
EXTERNAL OVFLO.
EXTERNAL MOVN.,MOVEM.,JRST.,CAML.,COMP.D
EXTERNAL SKIPL.,SKIPA.,SETZM.,SETZB.,HRRZI.
EXTERNAL CHAC,ESAVAC,ESZERA,POWR10,ELITPC,EOPHLD,ERESDP
EXTERNAL AS.MSC,AS.TMP,D1LIT,D2LIT,AS.DOT,AS.%X,EMULSZ
EXTERNAL EBASEX ; [321]
EXTERNAL OPCADD,OPCSUB,OPCMUL,OPCDIV,OPCEXP,OPLPAR,OPRPAR,OPEXP,OPENDE,OPYECC,OPENDI
END