Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
ifgen.mac
There are 22 other files named ifgen.mac in the archive. Click here to see a list.
; UPD ID= 2015 on 8/22/79 at 5:01 PM by N:<NIXON>
TITLE IFGEN FOR COBOL V12
SUBTTL CODE GENERATORS FOR ALL "IF" OPERATORS 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, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
DBMS==:DBMS
;EDITS
;V12A****************
;NAME DATE COMMENTS
;[720] FIX COBOL-74 COMPARE TO SPACES WITH PROGRAM COLLATING SEQUENCE
;[717] FIX IF A NOT = SPACES FOR A ALPHANUMERIC AND LONGER THAN 2040 CHARACTERS
;[630] FIX EDIT 562 FOR NON-BIS CASE
;[611] FIX IF DBMS-STATEMENT TO GENERATE CORRECT CODE (THIS WAS IN BWR FILE)
;[605] STORE DEPENDING ITEM AFTER READ OF VARIABLE LENGTH RECORD
;V12*****************
;NAME DATE COMMENTS
;[600] ADJUST D.P. OF "A" IN ACCS IF LESS THAN D.P. OF "B"
;[562] FIX SIXBIT 6 CHAR FIG-CON COMPARE WHEN SIGN GETS IN THE WAY
;[550] FIX IF SUBSCRIPTED ITEM IS ALPHABETIC
;[547] FIX EXAMINE REPLACING HIGH-VALUES BY
;[544] FIX HIGH-VALUES COMPARES FOR SIXBIT VARIABLES
;[542] FIX NUMERIC COMPARE OF FIELD WITH DECIMAL PLACES WITH EXPRESSION
; WITH NO DECIMAL PLACES
;V10*****************
;NAME DATE COMMENTS
;[473] FIX COMPARE OF NON-NUMERICS OF UNEQUAL LENGTH
;[445] TEST FOR ERRORS AFTER RETURN FROM SETED
;[444] GIVE WARNING WHEN MAXIMUM COMPARE LENGTH FOR IF STATEMENT IS EXCEEDED
;[441] FOR NONNUMERIC TEST OF ZEROES OF FORM 'IF A OP ZERO' USE CHAR COMPARE
;[437] FIX DBMS IF STATEMENTS INCASE OF LITTAB TABLE OVERFLOWS
;********************
;[436] FIX DBMS IF STATEMENTS IN SEGMENTED SECTIONS
;[426] FIX ZERO TESTING.
;[413] HANDLE NEGATIVE EXPRESSIONS IN IF STATEMENTS
;[374] /JEC FLAG ERROR WHEN SIXBIT LITERAL HAS A NON-SIXBIT CHAR IN IT
;[372] /JEC MAKE SURE %PARAM IS PUT INTO AS1 FILE FOR DBMS IF STATEMENTS
;[217] /ACK FIX FATAL DIAG PRODUCED IN A VALID PROGRAM.
; EDIT 322 FIX "IF CONDITION" SO THAT AN ERROR IN PREVIOUS STATMENT DOES NOT CAUSE A COMPILER ERROR MESSAGE
;**; EDIT 170-A FIXES PATCH EDIT 170
;**; EDIT 174 FIXES D.P. COMPARES WITH ZERO FOR >, AND NOT <
;**; EDIT 170 FIXES COMPARES OF NON-NUMERIC ITEMS OF FORM
; IF A(I) = B(J) OR IF A(I) = C; WHERE AN ITEM
; OF A IS SMALLER THAN B (OR C).
;*; EDIT 154 FIXES DOUBLE PRECISION COMPARES
; AND ALSO SIGN PROBLEMS.
TWOSEG
RELOC 400000
SALL
ENTRY ENDIFG ;"ENDIF" OPERATOR
ENTRY SPIFGN ;"SPIF" OPERATOR
ENTRY IFCGEN ;"IFC" OPERATOR
ENTRY IFTGEN ;"IFT" OPERATOR
ENTRY IFGEN ;"IF" OPERATOR
ENTRY ELSEGN ;"ELSE" OPERATOR
ENTRY IFGNZC ;ENTRY POINT FOR RPWGEN & SEARCH
ENTRY IFPOS ;ENTRY POINT FOR SEARCH
IFN DBMS,<ENTRY IFDBGN> ;"IFDB" OPERATOR
EXTERNAL COMEBK,MOVGN.,PUTASN,PUTASY,SETOPN,B1PAR,B2PAR,SUBSCA
EXTERN STASHI,STASHL,STASHP,STASHQ,POOL,POOLIT,PLITPC
EXTERN MBYTPA,MBYTPB,CPOPJ1,CPOPJ
EXTERNAL LNKSET,GETTAG,KILLF,WARN,FATAL,PUTEMP,CCXFP.,CCXF2.,MSFP%L,MSF2%L,PUSEOP
EXTERNAL BMPEOP,PUTTAG,CONVNL,NEGATL,MAKEL,MAKEL2,GETEMP
EXTERNAL FORCX0,MBYTEA,BADEOP,OPNFAT,JOUT,NOTNUM,NOTDAT
EXTERNAL PUT.A,PUT.AA,PUT.B,PUT.BA,PUT.L,PUT.LA,PUT.LB,PUT.LC,PUT.LD
EXTERNAL PUT.P,PUT.PA,PUT.PC,PUT.XA,PUT.XB
EXTERNAL M1CAC.,M2CAC.,MDAC.,CC1C2.,CCXFP.,ADJDP.,ADJSL.,SWAPAB
EXTERNAL M.IA,M.IB,MXAC.,MXFPA.,LITD.,LITN.,LITN.A,SCANL
EXTERNAL FPLOV.
EXTERNAL SUBSCR,SUBSCA,SUBSCB,SUBSCC,SUBSCD
;"IF" GENERATOR
IFGEN: CAMN EACA,EOPLOC ;ANYTHING IN EOPTAB?
POPJ PP, ;NO--WE MUST HAVE HAD A YECCH
MOVEM W1,OPLINE
PUSHJ PP,IFGENZ
IFDONE: HRRZ TC,EOPLOC ;RESET EACA SUCH THAT THERE IS ONE OPERAND
ADDI TC,1
MOVEM TC,CUREOP
PUSHJ PP,BMPEOP
JFCL
MOVE EACA,CUREOP
SUB EACA,EOPLOC
HRLS EACA
ADD EACA,EOPLOC
MOVEM EACA,EOPNXT
JRST COMEBK
;"IFT" GENERATOR
IFTGEN: SETZM TAGTRU
CAMN EACA,EOPLOC ;ANY OPERANDS?
POPJ PP, ;NO--MUST HAVE HAD A YECCH
MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
PUSHJ PP,IFTGNZ ;GENERATE CODE
JRST IFDONE ;GO HOME
IFTGNZ: SWOFF FEOFF1 ;TURN OFF MOST FLAGS
PUSHJ PP,MAK1OP ;INSURE THAT THERE IS ONLY ONE OPERAND
TSWF FERROR;
JRST BADEOP
MOVE TC,CUREOP
MOVSM TC,OPERND
MOVE TE,1(TC) ;IS OPERAND %TEMP OR AC'S?
TLNN TE,GNNOTD
JRST IFTGNY
HRRZ TE,0(TC) ;YES--IS IT AC'S?
CAIG TE,17
SWON FAINAC ;YES--SET FLAG
JRST IFTGNX
IFTGNY: LDB TE,[POINT 3,1(TC),20]
IFN ANS68,<
CAIN TE,TB.DAT
JRST IFTGNX
LDB TE,[POINT 1,(TC),9] ;CHECK FOR TALLY.
JUMPE TE,NOTDAT ;NEITHER DATAB NOR TALLY - ERROR.
>
IFN ANS74,<
CAIE TE,TB.DAT
JRST NOTDAT ;NOT DATAB - ERROR
>
IFTGNX: MOVEI LN,EBASEA
PUSHJ PP,SETED
MOVEI TA,BADIFT
TLNE W1,1B27
MOVEI TA,IFNUM
TLNE W1,1B28
MOVEI TA,IFALF
TLNE W1,1B29
MOVEI TA,IFPOS
TLNE W1,1B30
MOVEI TA,IFNEG
TLNE W1,1B31
MOVEI TA,IFZERO
TLZ W1,CONCMP
TLO W1,EQUALF
TLON W1,GOFALS
TLC W1,NOTF
JRST @TA
;"IFC" GENERATOR
IFCGEN: MOVEM W1,OPLINE
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST IFCSW7 ;NO--MUST BE "IF SWITCH"
SWOFF FEOFF1 ; [322] TURN OFF ALL ERROR INDICATORS
MOVEM EACA,EOPNXT ;SAVE EACA
MOVE CH,[XWD 2,2] ;MAKE THIS LOOK LIKE EXPRESSION
PUSHJ PP,PUSEOP
SETZM TAGTRU
PUSHJ PP,MAK1OP
TSWF FERROR;
JRST BADEOP
LDB TE,[POINT 3,-1(EACA),20]
CAIN TE,TB.MNE
JRST IFCSW
TLON W1,GOFALS ;GO IF FALSE?
TLC W1,NOTF ;NO--COMPLEMENT "NOT"
TLNN W1,NOTF ;"NOT"?
JRST IFCGNF ;NO
HLRZM W2,ECTRUE ;YES--SET "TRUE" TAG
SETZM ECFALS ;CLEAR "FALSE" TAG
JRST IFCGNA
IFCGNF: HLRZM W2,ECFALS ;SET UP TAG FOR "FALSE"
SETZM ECTRUE
IFCGNA: SETZM ECXTRA ;TURN OFF "EXTRA TAG NEEDED"
TLZ W1,CONCMP ;CLEAR CONDITION FLAGS
MOVEM W1,OPLINE
MOVEI TC,ECNAME
MOVEM TC,OPERND
SWOFF FEOFF1 ;CLEAR MOST FLAGS
MOVE TC,EOPLOC ;CONVERT COND. NAME LINK TO TABLE ADDRESS
ADDI TC,1
MOVE TA,TC ;SET UP DUMMY "B"
TLZ TA,-4
TLO TA,1B18
MOVEM TA,ECNAME
MOVE TA,1(TC)
PUSHJ PP,LNKSET
MOVE TE,1(TA) ;GET LITERAL COUNT
HRRZM TE,CONCTR
SKIPN CONCTR ;ANY THERE?
POPJ PP, ;NO--MUST HAVE HAD TROUBLE--QUIT
HLRM TE,1(TC) ;RESET "A" TO BE DATA-NAME
MOVEM TC,CUREOP
ROT TE,3
ANDI TE,7
CAIE TE,TB.DAT
JRST NOTDAT
MOVEI TE,2(TA) ;CREATE A BYTE POINTER TO CONTAB ENTRIES
HRLI TE,442200
MOVEM TE,ECNBP
HRRZ CH,CUREOP ;GET PTR TO DATA OPERAND
HRRZ TA,1(CH)
PUSHJ PP,LNKSET
LDB TB,DA.LKS## ;IS IT IN LINKAGE SECTION?
SKIPE TB ;NO
MOVSI TB,(LKSFLG) ;YES, SET GENFIL FLAG
IORM TB,(CH)
;"IFC" GENERATOR (CONT'D).
;THIS IS THE START OF THE MAIN LOOP
IFCGN1: SWOFF FAINAC ;CLEAR "A IN AC'S" FLAG
HRRZ TC,EOPLOC
ADDI TC,1
MOVEM TC,CUREOP
HRLM TC,OPERND
MOVEI LN,EBASEA ;SET UP "A" PARAMETERS
PUSHJ PP,SETED
ILDB TA,ECNBP ;IS IT A RANGE?
TRNE TA,CRANGE
JRST IFCG10 ;YES
;"IFC" GENERATOR (CONT'D)
;NOT A RANGE
PUSHJ PP,SETUPB
MOVE W1,OPLINE
IBP ECNBP ;BUMP BYTE POINTER
SOSG CONCTR ;IS THIS THE LAST VALUE?
JRST IFCGN4 ;YES
TLZ W1,NOTF ;YES--SHUT OFF "NOT"
TLO W1,LESSF!GREATF ;SET "NOT EQUAL"
PUSHJ PP,GETTRU ;TRUE IF EQUAL
JRST IFCGN6
IFCGN4: TLZE W1,NOTF ;"NOT"?
JRST IFCGN5 ;YES
TLO W1,EQUALF ;SET "EQUAL"
PUSHJ PP,GETFLS ;FALSE IF NOT EQUAL
JRST IFCGN6
IFCGN5: TLO W1,LESSF!GREATF ;SET "NOT EQUAL"
PUSHJ PP,GETTRU ;TRUE IF EQUAL
IFCGN6: PUSHJ PP,GOTOIF
SKIPE CONCTR
JRST IFCGN1
SKIPE CH,ECXTRA
PUSHJ PP,PUTTAG
POPJ PP,
;"IFC" GENERATOR (CONT'D).
;A RANGE
IFCG10: PUSHJ PP,SETUPB
MOVE W1,OPLINE
TLZ W1,NOTF ;TURN OFF "NOT" FOR NOW
SOSLE CONCTR##
JRST IFCG20
;THE LAST RANGE IN THE VALUE CLAUSE
;FIRST COMPARISON
; < FALSE
; > FALL THRU
; = FALL THRU
PUSHJ PP,GETFLS
TLO W1,GREATF!EQUALF
PUSHJ PP,GOTOIF
;SECOND COMPARISON
; NOTF OFF NOTF ON
; < FALL THRU TRUE
; > FALSE FALL THRU
; = FALL THRU TRUE
SWOFF FAINAC ;CLEAR "A IN AC'S" FLAG
HRRZ TC,EOPLOC
ADDI TC,1
MOVEI LN,EBASEA
PUSHJ PP,SETED
ILDB TA,ECNBP
PUSHJ PP,SETUPB
MOVE TC,CUREOP ;SET LEFT HALF OF OPERAND PTR
HRLM TC,OPERND ; FOR SUBSCR SO LINKAGE FLAG HANDLED RIGHT
MOVE W1,OPLINE
TLZN W1,NOTF
JRST IFCG13
PUSHJ PP,GETTRU
TLO W1,GREATF
JRST IFCGN6
IFCG13: TLO W1,LESSF!EQUALF
PUSHJ PP,GETFLS
JRST IFCGN6
;"IFC" GENERATOR (CONT'D).
;A RANGE (CONT'D)
;ALL RANGE COMPARISONS EXCEPT THE LAST IN VALUE CLAUSE
;FIRST COMPARISON
; < NEXT COND'N
; > FALL THRU
; = FALL THRU
IFCG20: TLO W1,GREATF!EQUALF
PUSHJ PP,GETTAG
MOVEM CH,ECSTEP
PUSHJ PP,GOTOIF
;SECOND COMPARISON
; < TRUE
; > FALL THRU
; = TRUE
SWOFF FAINAC ;CLEAR "A IN AC'S" FLAG
PUSHJ PP,GETTRU
HRRZ TC,EOPLOC
ADDI TC,1
MOVEI LN,EBASEA
PUSHJ PP,SETED
ILDB TA,ECNBP
PUSHJ PP,SETUPB
MOVE TC,CUREOP ;[217]
HRLM TC,OPERND ;[217]
MOVE W1,OPLINE
PUSHJ PP,GETTRU
TLZ W1,NOTF
TLO W1,GREATF
PUSHJ PP,GOTOIF
MOVE CH,ECSTEP
PUSHJ PP,PUTTAG
JRST IFCGN1
;"IFC" GENERATOR (CONT'D).
;CALL THE "IF" ROUTINE FROM "IFC"
GOTOIF: HRRZ TA,EBASEA ; IF ONE OF THE OPERANDS IS A TAG, UPDATE REF
;COUNT SINCE A COMPARISON WILL REFERENCE THE TAG
TRC TA,AS.TAG##
TRNN TA,700000 ;SKIP IF NOT AS.TAG+N
PUSHJ PP,REFTAG##
HRRZ TA,EBASEB
TRC TA,AS.TAG
TRNN TA,700000 ;SAME FOR "B"
PUSHJ PP,REFTAG##
MOVS W2,CH ;SET UP FALSE PATH
TSWT FAINAC ;IS "A" IN THE AC'S?
JRST IFGNZC ;NO
JRST IFGN0 ;YES
;GET A TAG FOR THE TRUE PATH
GETTRU: SKIPN CH,ECTRUE
PUSHJ PP,IFCTAG
MOVEM CH,ECTRUE
POPJ PP,
;GET A TAG FOR THE FALSE PATH
GETFLS: SKIPN CH,ECFALS
PUSHJ PP,IFCTAG
MOVEM CH,ECFALS
POPJ PP,
;GET A TAG FOR EITHER THE TRUE OR THE FALSE PATH
IFCTAG: SKIPN CH,ECXTRA
PUSHJ PP,GETTAG
MOVEM CH,ECXTRA
POPJ PP,
;"IFC" GENERATOR (CONT'D).
;SET UP "B" OPERAND
SETUPB: TRNN TA,CNFIGC ;FIG. CONST.?
JRST SETUB1 ;NO
LDB TE,[POINT 5,TA,25] ;PICK UP FLAGS FOR FIG. CONST.
DPB TE,[POINT 5,ECNAME,14] ;STASH THEM AWAY
MOVSI TE,GNLIT!GNFIGC!1B18
IORM TE,ECNAME
SETZM ECNAME+1
MOVEI TC,ECNAME
MOVEI LN,EBASEB
JRST SETOPN
SETUB1: MOVE TE,[XWD EBASEA,EBASEB]
BLT TE,EBASBX
TSWF FASIGN;
SWONS FBSIGN;
SWOFF FBSIGN;
TSWF FANUM;
SWONS FBNUM;
SWOFF FBNUM;
SWOFF FBSUB;
ANDI TA,77777
IORI TA,AS.TAG
HRLI TA,^D36
MOVEM TA,EBASEB
SETZM EINCRB
POPJ PP,
;"IFC" GENERATOR (CONT'D).
;GENERATE A CONDITIONAL FOR HARDWARE SWITCHES
IFCSW: HRRZ TA,-1(EACA) ;GET "ON" OR "OFF"
PUSHJ PP,LNKSET
MOVE TE,1(TA)
JUMPL TE,IFCSW0
LDB TE,MNESF
DPB TE,W1SF
TLNN W1,SWITCH
JRST NOTSWC
IFCSW0: LDB TC,SWNUM ;PICK UP SWITCH NUMBER FROM MNETAB
IFCSWA: TLNN W1,SWCHON ;"ON" TEST?
TLC W1,NOTF ;NO--COMPLEMENT "NOT"
TLNN W1,GOFALS ;"GO IF FALSE"?
TLC W1,NOTF ;NO--COMPLEMENT "NOT"
MOVE CH,CALLSW ;GENERATE <CALLI 0,20>
PUSHJ PP,PUTASY
MOVNS TC ;SET
MOVSI TD,1B18 ; APPROPRIATE
LSH TD,0(TC) ; BIT
TLNN TD,-1 ;LEFT-HALF?
JRST IFCSW1
HLRZS TD ;YES--PUT IT IN RIGHT HALF
TDCA TC,TC ;USE "TLNX"
IFCSW1: MOVEI TC,1 ;USE "TRNX"
TLNN W1,NOTF ;IS IT "NOT"
SKIPA CH,IFCSWT(TC) ;NO--USE TXNN"
MOVS CH,IFCSWT(TC) ;YES--USE "TXNE"
HRRI CH,AS.CNB
PUSHJ PP,PUTASY
MOVE CH,TD
PUSHJ PP,PUTASN
JRST JFALSE ;PUT OUT <JRST FALSE> AND RETURN
IFCSWT: XWD TLNN.+ASINC,TLNE.+ASINC
XWD TRNN.+ASINC,TRNE.+ASINC
NOTSWC: MOVEI DW,E.290
JRST OPNFAT
;GENERATE CODE FOR "IF SWITCH (N)"
IFCSW7: TLNN W1,SWITCH ;IS EITHER SWITCH FLAG ON?
JRST BADEOP ;NO-TROUBLE
LDB TC,[POINT 6,W1,35] ;GET SWITCH NUMBER
JRST IFCSWA
;GENERATE CODE FOR "IF".
IFGENZ: SETZM TAGTRU
LDB TE,CONDIT ;INSURE VALIDITY OF FLAGS
JUMPE TE,BADIF
CAIN TE,7
JRST BADIF
SWOFF FEOFF1 ;TURN OFF MOST FLAGS
PUSHJ PP,MAK2OP ;INSURE RIGHT NUMBER OF OPERANDS
TSWF FERROR ;ANY ERROR?
JRST BADEOP ;YES
TLZE W1,NOTF ;"NOT"?
TLC W1,CONCMP ;YES--COMPLEMENT CONDITION
TLNN W1,GOFALS ;IS TAG FOR "FALSE"?
TLC W1,CONCMP ;NO--COMPLEMENT CONDITION
MOVE TC,CUREOP ;SET UP FIRST OPERAND
MOVSM TC,OPERND
MOVEI LN,EBASEA
PUSHJ PP,SETED
TSWF FERROR ;ANY ERRORS YET?
POPJ PP, ;YES--QUIT
PUSHJ PP,BMPEOP ;SET UP SECOND OPERAND
JRST BADEOP ;NO MORE-- WE LOSE
AOS TC,CUREOP
HRRM TC,OPERND
MOVEI LN,EBASEB
PUSHJ PP,SETED
TSWF FERROR ;[445] ERRORS?
POPJ PP, ;[445] YES--QUIT
HRRZ TE,OPERND ;IS "B" THE AC'S?
MOVE TD,1(TE)
HRRZ TE,0(TE)
TLNE TD,GNNOTD
CAILE TE,17
JRST IFGNZA ;NO
PUSHJ PP,SWAPIT ;YES--SWAP OPERANDS
JRST IFGNZB
IFGNZA: HLRZ TE,OPERND ;IS "A" THE AC'S?
MOVE TD,1(TE)
HRRZ TE,0(TE)
TLNE TD,GNNOTD
CAILE TE,17
JRST IFGNZC ;NO
IFGNZB: SWON FAINAC!FASIGN ;YES--SET "'A' IS AC'S"
SWOFF FASUB;
HRROM TE,IFEAC## ;SAVE "A" ACC TO UNDO "B" DAMAGE
JRST IFGNZD
;"IF" GENERATOR (CONT'D).
IFGNZC: SETZM EAC ;SET AC'S TO BE 0&1
HRRZ TA,EMODEA ;IS "A" A LITERAL?
CAIN TA,LTMODE
JRST IFGN1 ;YES
CAIN TA,FCMODE ;FIG. CONST.?
JRST IFGN3 ;YES
IFGNZD: HRRZ TB,EMODEB ;IS "B" A LITERAL?
CAIN TB,LTMODE
JRST IFGN2 ;YES
CAIN TB,FCMODE ;FIG. CONST.?
JRST IFGN3E ;YES
;NEITHER OPERAND IS A LITERAL NOR A FIG. CONST.
TSWT FAINAC ;IS "A" IN THE AC'S?
JRST IFGN0A ;NO
;"A" IS IN THE AC'S
IFGN0: HRRZ TA,EMODEA
HRRZ TB,EMODEB
TSWT FBNUM ;IS "B" NUMERIC?
JRST NOTNMB ;NO--TROUBLE
CAIE TA,FPMODE ;IS EITHER "A" OR "B" COMP-1?
CAIN TB,FPMODE
JRST IFGN0N ;YES
CAIE TA,F2MODE ;NO, IS EITHER "A" OR "B" COMP-2?
CAIN TB,F2MODE
JRST IFGN0N ;YES
MOVE TE,EDPLA ;[600] DOES "A" HAVE SAME DECIMAL PLACES AS "B"?
SUB TE,EDPLB ;[600]
JUMPE TE,IFGN0N ;[600] YES
JUMPL TE,IFGN0L ;[600] "A" LESS THAN "B"
PUSHJ PP,SETBCX
JRST IFGN0E
;"IF" GENERATOR (CONT'D)
;"A" IS NOT THE AC'S
IFGN0A: TSWF FANUM ;IS "A" NUMERIC?
JRST IFGN0B ;YES
CAILE TB,DSMODE ;NO--IS "B" DISPLAY?
JRST NOTNMA ;NO--ERROR
JRST IFDD ;YES
;"A" ISN'T IN THE AC'S, BUT IS NUMERIC
IFGN0B: CAIE TB,FPMODE ;IS "B" COMP-1?
CAIN TB,F2MODE ;OR COMP-2?
JRST IFGN0E ;YES
CAIE TA,FPMODE ;NO--IS "A" COMP-1?
CAIN TA,F2MODE ;OR COMP-2?
JRST IFGN0G ;YES
TSWF FBNUM ;IS "B" NUMERIC?
JRST IFGN0C ;YES
IFN ANS68,<
CAILE TA,DSMODE ;NO--IS "A" DISPLAY?
JRST NOTNMB ;NO--ERROR
>
IFN ANS74,<
CAIG TA,DSMODE ;IS "A" DISPLAY
TSWF FASIGN ;YES, BUT NOT SIGNED?
JRST IFKAD ;NO, CONVERT "A" TO DISPLAY
>
JRST IFDD ;YES
;BOTH "A" AND "B" ARE NUMERIC
IFGN0C: MOVE TE,EDPLA ;COMPARE DECIMAL PLACES
CAMN TE,EDPLB ;THE SAME?
JRST IFGN0F ;YES
CAML TE,EDPLB ;NO--"A" HAVE MORE THAN "B"?
JRST IFGN0G ;YES--SWAP OPERANDS
JRST IFGN0E ;NO--NO POINT IN SWAPPING
;"A" AND "B" HAVE THE SAME NUMBER OF DECIMAL PLACES
IFGN0F: CAIG TA,DSMODE ;IS "A" DISPLAY?
JRST IFGN0E ;YES--NO POINT IN SWAPPING
TSWT FBSIGN ;NO--IS "B" SIGNED?
IFGN0G: PUSHJ PP,SWAPIT ;SWAP OPERANDS
IFGN0E: PUSHJ PP,MOVXAC ; [413] GET "A" INTO THE AC'S
SWON FAINAC;
IFGN0L: PUSHJ PP,ADJDP. ;[600] ADJUST THE DECIMAL PLACES OF "A"
;"A" IS NOW IN THE AC'S -- DISPATCH TO CORRECT ROUTINE
IFGN0N: HRRZ TE,EMODEA ;IS MODE OF "A" LEGAL?
IFN BIS,<
CAIN TE,D4MODE ;IS "A" A 4-WORD COMP?
JRST IF4WD ;YES, MAKE IT 2-WD
>;END IFN BIS
CAIL TE,D1MODE
CAILE TE,F2MODE
JRST IFCONA ;NO--SOMEBODY IS CONFUZED
CAIG TE,FPMODE ;IN FIRST SET?
JRST IFGN0P ;YES
CAIGE TE,D4MODE ;IN SECOND SET?
JRST IFCONA ;NO, ERROR
SUBI TE,D4MODE-FPMODE-1 ;REMOVE MODES NOT IN TABLE
IFGN0P: SUBI TE,D1MODE ;YES--REDUCE IT
HRRZ TD,EMODEB ;IS MODE OF "B" LEGAL?
IFN BIS,<
CAIN TD,D4MODE ;4-WORD COMP?
JRST IF4WD ;YES--MAKE IT TWO WORDS
>;END IFN BIS
CAILE TD,F2MODE
JRST IFCONB ;NO
IMULI TE,<F2MODE+1>/2 ;YES--DISPATCH THRU TABLE
ROT TD,-1
ADDI TE,(TD)
TLNE TD,1B18
SKIPA TE,IFACT(TE)
MOVS TE,IFACT(TE)
JRST (TE)
;DISPATCH TABLE
IFACT: XWD IFC1D,IFC1D ;1C-S,1C-A
XWD IFC1D,IFC1C1 ;1C-E,1C-1C
XWD IFC1C2,IFCXFP ;1C-2C,1C-FP
XWD IFC1D,IFCONB ;1C-C3,1C-ED
XWD IFCONB,IFCONB ;1C-LT,1C-FG
XWD IFCONB,IFCXF2 ;1C-4C,1C-F2
XWD IFC2D,IFC2D ;2C-S,2C-A
XWD IFC2D,IFC2C1 ;2C-E,2C-1C
XWD IFC2C2,IFCXFP ;2C-2C,2C-FP
XWD IFC2D,IFCONB ;2C-C3,2C-ED
XWD IFCONB,IFCONB ;2C-LT,2C-FG
XWD IFCONB,IFCXF2 ;2C-4C,2C-F2
XWD IFPAC.,IFPAC. ;FP-S,FP-A
XWD IFPAC.,IFPAC. ;FP-E,FP-1C
XWD IFPAC.,IC1C1A ;FP-2C,FP-FP
XWD IFPAC.,IFCONB ;FP-C3,FP-ED
XWD IFCONB,IFCONB ;FP-LT,FP-FG
XWD IFCONB,IFC2C2 ;FP-4C,FP-F2
XWD IFCONA,IFCONA ;4C-S,4C-A
XWD IFCONA,IFCONA ;4C-E,4C-1C
XWD IFCONA,IC1C1A ;4C-2C,4C-FP
XWD IFCONA,IFCONA ;4C-C3,4C-ED
XWD IFCONA,IFCONA ;4C-LT,4C-FG
XWD IFCONA,IFCONA ;4C-4C,4C-F2
XWD IF2AC.,IF2AC. ;F2-S,F2-A
XWD IF2AC.,IF2AC. ;F2-E,F2-1C
XWD IF2AC.,IC1C1A ;F2-2C,F2-FP
XWD IF2AC.,IFCONB ;F2-C3,F2-ED
XWD IFCONB,IFCONB ;F2-LT,F2-FG
XWD IFCONB,IFC2C2 ;F2-4C,F2-F2
;HERE IFCONA AND/OR "B" IS 4-WORD COMP
IFN BIS,<
IF4WD: MOVE TE,ESIZEA ;GET SIZE OF A
CAIG TE,MAXSIZ ;4-WORD COMP?
JRST IF4WDB ;NO
;CUT DOWN "A"
SUBI TE,MAXSIZ ;POWER OF 10 TO DIVIDE BY
PUSH PP,TE
MOVSI CH,MOVEI.+AC15
HRR CH,EBASEA ;"MOVEI 15,A"
PUSHJ PP,PUTASY##
POP PP,TC ;GET POWER OF 10
MOVEI CH,DVI41.## ;GET A LIBOL ROUTINE
CAILE TC,^D10
MOVEI CH,DVI42.## ;SORRY--WRONG ONE
PUSHJ PP,PMOPC.## ;"MOVEI 16,[^D1000..]"
;"PUSHJ PP,ROUTINE"
MOVEI TE,D2MODE ;NEW "A" PARAMETERS
MOVEM TE,EMODEA
MOVEI TE,^D18
MOVEM TE,ESIZEA
IF4WDB: MOVE TE,ESIZEB
CAIG TE,MAXSIZ
JRST IFGN0N ;START AGAIN
;CUT DOWN "B"
SUBI TE,MAXSIZ
PUSH PP,TE ;SAVE POWER OF 10
MOVSI CH,MOVEI.+AC15
PUSHJ PP,PUT.B## ;"MOVEI AC15,B"
POP PP,TC
MOVEI CH,DVI41.## ;A LIBOL ROUTINE
CAILE TC,^D10
MOVEI CH,DVI42.##
PUSHJ PP,PMOPC.##
MOVEI TE,D2MODE ;NEW "B" PARAMETERS
MOVEM TE,EMODEB
MOVEI TE,^D18
MOVEM TE,ESIZEB
JRST IFGN0N ;NOW CAN DO THE IF GENERATION
>;END IFN BIS
;CONVERT NUMERIC TO DISPLAY UNSIGNED
IFN ANS74,<
IFKAD: MOVE TE,[EBASEB,,ESAVEA]
BLT TE,ESAVBX ;SAVE "B"
MOVE TE,[EBASEA,,EBASEB]
BLT TE,EBASBX ;COPY "A" TO "B"
MOVEI TE,D6MODE
MOVEM TE,EMODEB ;MAKE DISPLAY
MOVE TE,ESIZEB ;GET SIZE
ADDI TE,5
IDIVI TE,6 ;NO. OF WORDS
PUSHJ PP,GETEMP
MOVEM EACC,EINCRB
MOVE TE,[^D36,,AS.MSC]
MOVEM TE,EBASEB
SWOFF FBSIGN!FBNUM!FASUB ;TURN OFF NUMERIC FLAGS
PUSHJ PP,MXX.## ;MOVE "A" TO TEMP
MOVE TE,[EBASEB,,EBASEA]
BLT TE,EBASAX ;COPY "B" TO "A"
MOVE TE,[ESAVEA,,EBASEB]
BLT TE,EBASBX ;RESTORE "B"
SWOFF FASIGN!FBNUM!FASUB
JRST IFDD
>
;"A" IS A LITERAL
IFGN1: HRRZ TE,EMODEB
CAIE TE,LTMODE
CAIN TE,FCMODE
JRST TWOLIT
;"A" IS A LITERAL, "B" ISN'T
TSWT FBNUM ;IS "B" NUMERIC?
JRST IFGN2C ;NO
PUSHJ PP,SWAPIT ;YES--SWAP OPERANDS
PUSHJ PP,MOVXAC ; [413] PUT INTO ACS
SWON FAINAC;
JRST IFGN9
;"B" IS A LITERAL, "A" ISN'T
IFGN2: TSWT FANUM!FAINAC ;IS "A" NUMERIC?
JRST IFGN2A ;NO
IFN ANS74,<
;*** FIX IT LATER ***
;
TSWT FBNUM ;BUT IS "B" NUMERIC ALSO?
JRST [SKIPN EDPLB ;NO, IS IT INTEGER?
JRST IFGN2A ;YES, NON-NUMERIC COMPARE
JRST .+1] ;NO, ERROR
>;END IFN ASN74
TSWTS FAINAC ;GET IT INTO AC'S UNLESS
PUSHJ PP,MOVXAC ; [413] IT'S THERE ALREADY
JRST IFGN9
IFGN2A: PUSHJ PP,SWAPIT ;"A" ISN'T NUMERIC--SWAP OPERANDS
;"A" IS A LITERAL, "B" IS NON-NUMERIC DISPLAY
IFGN2C: TSWT FANUM ;IS IT A NUMERIC LITERAL?
JRST IFDD2 ;NO
;"A" IS A NUMERIC LITERAL,"B" IS NON-NUMERIC DISPLAY
MOVE TA,ETABLB ;IS
PUSHJ PP,LNKSET ; 'B'
LDB TE,DA.EDT ; EDITED?
JUMPN TE,NOTNMA ;IF SO, ERROR
PUSH PP,EBYTEA ;NO--SEE IF ANY DECIMAL PLACES IN LITERAL
PUSHJ PP,SCANL
POP PP,EBYTEA
TSWF FERROR ;ANY ERRORS OF ANY KIND?
POPJ PP, ;YES--FORGET IT
PUSHJ PP,LITN.A ;NO--CREATE A NUMERIC DISPLAY LITERAL
JRST IFDD2 ;DO COMPARISON
;"A" IS A FIGURATIVE CONSTANT
IFGN3: HRRZ TE,EMODEB
CAIE TE,LTMODE
CAIN TE,FCMODE
JRST TWOLIT
;"A" IS A FIG. CONST., "B" ISN'T
PUSHJ PP,SWAPIT ;SWAP OPERANDS
;NOW "B" IS THE FIG. CONST.
IFGN3A: HRRZ TE,EMODEA ;IS 'A' DISPLAY?
CAIG TE,DSMODE
JRST IFGN3C ;YES
CAIN TE, C3MODE ;IS A COMP-3?
JRST IFGN4 ;YES, SPECIAL CASE FOR HIGH AND
; LOW VALUES.
CAIE TE,D1MODE ;IS IT COMP
CAIN TE,FPMODE ;OR COMP-1
CAIA ;YES
JRST IFG3AM ;NO
HRRZ TE,EFLAGB ;GET WHICH FIGCON
CAIN TE,2 ;ZERO IS SPECIAL
JRST IFGN3B ;YES, DON'T LOAD ACCS
IFG3AM: PUSHJ PP,MXAC. ;NO--GET IT INTO AC'S
SWON FAINAC;
IFGN3B: HRRZ TE,EFLAGB ;DISPATCH
CAILE TE,5 ; TO APPROPRIATE ROUTINE
MOVEI TE,1
JRST @IFFCTA(TE)
IFGN3C: HRRZ TE,EFLAGB
CAILE TE,5
MOVEI TE,1
JRST @IFFCT(TE)
;"B" IS A FIG. CONST., "A" ISN'T
IFGN3E: TSWF FAINAC ;IS "A" IN THE AC'S?
JRST IFGN3B ;YES
JRST IFGN3A ;NO
IFGN4: HRRZ TE, EFLAGB ;SEE WHICH FIGURATIVE CONSTANT IT IS.
CAIN TE, 4 ;IF IT'S HIGH-VALUES, SPECIAL CASE.
JRST IFGN4F
CAIE TE, 5 ;IF IT'S NOT LOW-VALUES, USE
JRST IFG3AM ; THE STANDARD ROUTINE.
TSWF FASIGN; ;IT'S LOW VALUES, IF IT'S SIGNED
JRST IFGN4F ; SPECIAL CASE.
HRRZI TE, 2 ;OTHERWISE, MAKE IT A COMPARISON
HRRM TE, EFLAGB ; TO ZERO.
JRST IFG3AM
;COMPARE A COMP-3 ITEM TO HIGH OR LOW VALUES.
IFGN4F: PUSHJ PP, MOVXAC ; [413] GET THE COMP-3 ITEM INTO THE AC'S.
SWON FAINAC;
MOVE TA, ESIZEA ;SEE HOW MANY DIGITS THE ITEM HAS.
CAILE TA, ^D10
JRST IFGN4L
; GET 10**N-1.
SETZI TD, ;ONE WORD COMP.
MOVE TC, POWR10##(TA)
JRST IFGN4R
IFGN4L: LSH TA, 1 ;TWO WORD COMP.
MOVE TD, DPWR10##-^D22(TA)
MOVE TC, DPWR10##-^D21(TA)
IFGN4R: SOS TC ;DON'T WORRY ABOUT UNDERFLOW, IT
; CAN'T HAPPEN (FAMOUS LAST WORDS!)
;NOW WE HAVE THE THING TO COMPARE THE ITEM TO, MAKE IT LOOK LIKE A LITERAL.
MOVEM TC, ELITLO
MOVEM TD, ELITHI
HRRZ TA, EFLAGB ;IF IT'S LOW VALUES, MAKE THE
CAIN TA, 5 ; LITERAL NEGATIVE.
SWON FLNEG;
MOVE TA, [XWD EBASEA,EBASEB] ;GIVE THE LITERAL ALL OF
BLT TA, EBASBX ; THE ITEM'S CHARACTERISTICS
SWON FBNUM!FBSIGN; ; (EXCEPT SUBSCRIPTING
SWOFF FBSUB; ; AND MODE OF COURSE.)
HRRZI TA, LTMODE
MOVEM TA, EMODEB
JRST IFGN9B ;GO GENERATE THE COMPARE.
;THE "A" OPERAND IS IN THE AC'S, "B" IS A LITERAL
IFGN9: MOVEI LN,EBASEB
HRRZ TE,EMODEA
CAIE TE,FPMODE
JRST IFGN9A
PUSHJ PP,MSFP%L
MOVEI TA,FPMODE
MOVEM TA,EMODEB
MOVEM TC,EINCRB
MOVEI TE,AS.MSC
MOVEM TE,EBASEB
JRST IC1C1B
IFGN9A: CAIN TE,F2MODE
JRST IFGN9C
PUSHJ PP,CONVNL
TSWF FERROR ;ANY ERRORS?
POPJ PP, ;YES--FORGET THE WHOLE THING
MOVE TE,EDPLA
SUB TE,EDPLB
PUSHJ PP,ADJSL.
MOVEM TC,ELITLO
MOVEM TD,ELITHI
PUSHJ PP,ADJDP.
MOVE TC,ELITLO
MOVE TD,ELITHI
IFGN9B: HRRZ TE,EMODEA
CAIE TE,D2MODE ;IF "A" IS NOT A 2-WORD COMP, AND
JUMPE TD,IC1C1E ; LITERAL ONLY 1-WORD, JUMP
PUSHJ PP,MAKEL2
HLRZ TE,OPERND ; [413] GET "A" OPERAND
LDB TE,EOPSGN ; [413] SEE IF NEGATED
JUMPN TE,IC2C2Z ; [413] IF NEGATED GO SEE TO IT.
JRST IC2C2E
IFGN9C: PUSHJ PP,MSF2%L
MOVEI TA,F2MODE
MOVEM TA,EMODEB
MOVEM TC,EINCRB
MOVEI TE,AS.MSC
MOVEM TE,EBASEB
JRST IC2C2E
;GENERATE CODE TO COMPARE 1-WORD COMP VERSUS 1-WORD COMP
IFC1C1: HRRZ TE,OPERND ; [413] IF NEGATED
LDB TE,EOPSGN ; [413] THEN MOVE NEGATIVE
JUMPN TE,IC1C1Z ; [413] TO ACS
TSWF FBSIGN ;IS "B" SIGNED?
JRST IC1C1A ;YES
IC1C1Z: PUSHJ PP,SETBCX ;SAVE LOCATION OF "A" & MAKE IT "B"
PUSHJ PP,MOVC1 ; [413] GET NEW "A" INTO AC'S
JRST IC1C1B
IC1C1A: PUSHJ PP,SUBSCB
IC1C1B: MOVSI CH,CAM. ;GENERATE THE COMPARE
LDB TE,CONDIT
ROT TE,-^D8
ADD CH,TE
PUSHJ PP,PUT.BA
JRST JFALSE
;"B" IS A LITERAL.
IC1C1E: SKIPN ELITLO ;IS LITERAL 0?
JRST IC1C1G ;YES
MOVSI CH,CAM.
LDB TE,CONDIT
ROT TE,-^D8
ADD CH,TE
HRRZ TE,OPERND ; [413] SEE IF "B" OPERAND
LDB TE,EOPSGN ; [413] IS NEGATED
JUMPN TE,IC1C1F ; [413] IF SO NEGATE IT
TSWT FLNEG ;IS LITERAL NEGATIVE?
SKIPA TC,ELITLO ;NO
IC1C1F: MOVN TC,ELITLO ;[413] YES
PUSHJ PP,PUT.LA ;GENERATE <CAMX AC,[LITERAL]>
JRST JFALSE ;GENERATE JRST TO FALSE, AND RETURN
;"B" IS A LITERAL OF ZERO
IC1C1G: MOVSI CH,JUMP.
LDB TE,CONDIT
TRC TE,CONCMP/100 ;COMPLEMENT CONDITION
ROT TE,-9
ADD CH,TE ;GENERATE JUMPX
MOVE TE,EAC
DPB TE,CHAC ;LOAD AC FIELD
JRST JFLSEA ;GENERATE JUMPX AC,FALSE
;GENERATE CODE TO COMPARE A 1-WORD COMP OR INDEX VS. A 2-WORD COMP
IFC1C2: MOVE TC,EDPLB ;COMPUTE DIFFERENCE IN DECIMAL PLACES
SUB TC,EDPLA
ADDM TC,EDPLA ;ADJUST DECIMAL PLACES OF "A"
ADDM TC,ESIZEA ;ALSO SIZE
MOVSI CH,MUL. ;GENERATE <MUL. AC,[POWER OF 10]>
PUSHJ PP,PUT.PA
MOVEI TE,D2MODE ;"A" IS NOW A 2-WORD COMP
MOVEM TE,EMODEA
JRST IFC2C2 ;DO DOUBLE-PRECISION COMPARE
;GENERATE CODE TO COMPARE A 2-WORD COMP VS. A 1-WORD COMP OR INDEX
IFC2C1: PUSHJ PP,SETBCX ;SWAP OPERANDS
HRRZ TE,EBASEA ;IF NEW 'A' IS
CAILE TE,17 ; NOT YET IN AC'S
PUSHJ PP,MOVC1 ; [413] GET IT THERE
JRST IFC1C2
;GENERATE CODE TO COMPARE 2-WORD COMPS.
IFC2C2: HRRZ TE,OPERND ; [413] GET "B" OPERAND
LDB TE,EOPSGN ; [413] SEE IF NEGATED
JUMPN TE,IC2C2Z ; [413] IF SO NEGATE IT
TSWF FBSIGN ;IS "B" SIGNED?
JRST IC2C2D ;YES
PUSHJ PP,SETBCX ;SWAP OPERANDS
IC2C2Z: HLRZ TE,OPERND ; [413] GET "A" OPERAND
LDB TE,EOPSGN ; [413] SEE IF NEGATED
JUMPE TE,IC2C2Y ; [413]
PUSHJ PP,MNXAC.## ; [413] MOVE ITS NEGATIVE
JRST IC2C2E ; [413] DO COMPARISON.
IC2C2Y: PUSHJ PP,M2CAC. ;GET NEW "A" INTO AC'S
JRST IC2C2E
IC2C2D: PUSHJ PP,SUBSCB
IC2C2E: SKIPE EAC ; MAKE SURE SETBCX DONE EVEN NO. OF TIMES [154]
PUSHJ PP,SETBCX ; TO FORCE CORRECT COMPARE UUO OF COMP. 2 [154]
MOVSI CH,CAMN.
PUSHJ PP,PUT.BA
AOS EAC
HRRZ TE,EBASEB
CAIG TE,17 ;IN ACCS?
AOSA EBASEB ;YES
AOS EINCRB
LDB TE,CONDIT
CAIE TE,EQ
CAIN TE,NOTEQ
JRST IC2C2F ;EITHER EQUAL OR NOT EQUAL
;HERE FOR LESS, LESS EQUAL, GREATER, GREATER EQUAL
MOVSI CH,CAM.
LDB TE,CONDIT
TRC TE,7 ;INVERSE CONDITION
ROT TE,-8
ADD CH,TE ;CREATE CAMX
PUSHJ PP,PUT.BA
SOS EAC
HRRZ TE,EBASEB
CAIG TE,17 ;IN ACCS?
SOSA EBASEB ;YES
SOS EINCRB
MOVSI CH,CAM.
LDB TE,CONDIT
TRO TE,EQ ;TURN ON EQ
ROT TE,-8
ADD CH,TE ;CREATE CAMX
PUSHJ PP,PUT.BA
JRST JFALSE
;HERE FOR EQUAL OR NOTEQUAL
IC2C2F: MOVSI CH,CAME.
PUSHJ PP,PUT.BA
MOVEI TC,AS.DOT+2
TLNN W1,EQUALF
PUSHJ PP,JOUT ;NOT EQUAL
SOS EAC
HRRZ TE,EBASEB
CAIG TE,17 ;IN ACCS?
SOSA EBASEB ;YES
SOS EINCRB
JRST JFALSE
;AC'S ARE FLOATING POINT, "B" IS NOT
IFPAC.: PUSHJ PP,PUTEMP
SETZM EAC
PUSHJ PP,SWAPIT
HLRZ TE,OPERND ; [413] GET "A" OPERAND
LDB TE,EOPSGN ; [413] SEE IF NEGATED
JUMPE TE,IFFPCY ; [413]
PUSHJ PP,MNXAC.## ; [413] MOVE NEGATIVE INTO ACS
JRST IC1C1B ; [413] DO COMPARISON
IFFPCY: PUSHJ PP,MXFPA.
JRST IC1C1B
;AC'S CONTAIN 1- OR 2-WORD COMP, "B" IS FLOATING POINT
IFCXFP: PUSHJ PP,CCXFP.
HLRZ TE,OPERND ; [413] GET "A" OPERAND
LDB TE,EOPSGN ; [413] SEE IF NEGATED
JUMPN TE,IC1C1Z ; [413] GO NEGATE "A"
JRST IC1C1A
;AC'S ARE COMP-2, "B" IS NOT
IF2AC.: PUSHJ PP,PUTEMP
SETZM EAC
PUSHJ PP,SWAPIT
HLRZ TE,OPERND ;GET "A" OPERAND
LDB TE,EOPSGN ;SEE IF NEGATED
JUMPE TE,IFF2CY
PUSHJ PP,MNXAC.## ;MOVE NEGATIVE INTO ACS
JRST IC2C2E ;DO COMPARISON
IFF2CY: PUSHJ PP,MXFPA.
JRST IC2C2E
;AC'S CONTAIN 1- OR 2-WORD COMP, "B" IS COMP-2
IFCXF2: PUSHJ PP,CCXF2.
HLRZ TE,OPERND ;GET "A" OPERAND
LDB TE,EOPSGN ;SEE IF NEGATED
JUMPN TE,IFC2C2 ;GO NEGATE "A"
JRST IC2C2D
;"A" IS A 1-WORD COMP IN AC'S, "B" IS DISPLAY
IFC1D: MOVE TE,ESIZEB
CAIG TE,^D10
JRST IFC1DA
;"B" WILL BE 2 WORDS
MOVE TC,EDPLB ;[542] COMPUTE DIFF IN DECIMAL PLACES
SUB TC,EDPLA ;[542]
ADDM TC,EDPLA ;[542] ADJUST DECIMAL PLACES OF "A"
ADDM TC,ESIZEA ;[542] ALSO ADJUST SIZE
MOVSI CH,MUL. ;[542] GENERATE <MUL. AC,[POWER OF 10]>
PUSHJ PP,PUT.PA ;[542]
MOVEI TE,D2MODE ;[542] "A" IS NOW A 2-WORD COMP
MOVEM TE,EMODEA ;[542]
PUSHJ PP,SETBCX
PUSHJ PP,MOVXAC ; [413] MOVE INTO ACS
PUSHJ PP,SETBCX
JRST IC2C2E
;"B" WILL BE 1 WORD
IFC1DA: PUSHJ PP,SETBCX
PUSHJ PP,MOVXAC ; [413] MOVE INTO ACS
JRST IC1C1B
;"A" IS A 2-WORD COMP IN AC'S, "B" IS DISPLAY
IFC2D: PUSHJ PP,SETBCX
PUSHJ PP,MOVXAC ; [413] MOVE INTO ACS
HRRZ TE,EMODEA
CAIN TE,D1MODE
PUSHJ PP,CC1C2.
PUSHJ PP,SETBCX
HLRZ TE,OPERND ; [413] GET "A" OPERAND
LDB TE,EOPSGN ; [413] SEE IF NEGATED
JUMPN TE,IC2C2Z ; [413] IF NEGATED GO SEE TO IT.
JRST IC2C2E
;GENERATE CODE FOR NON-NUMERIC DISPLAY COMPARISON
IFDD: HRRZ TE, EMODEA ;IF A IS DISPLAY-6 AND B IS
CAMGE TE, EMODEB ; DISPLAY-7 OR DISPLAY-9, OR
PUSHJ PP, SWAPIT ; A IS DISPLAY-7 AND B IS
; DISPLAY-9, SWAP THE OPERANDS.
IFDD2: MOVE TE,ESIZEA ;COMPARE SIZES
MOVEM TE,ESIZEZ
CAME TE,ESIZEB
JRST IFDD4
;'A' IS SAME SIZE AS 'B'
IFDD3: HRRZ TE,EMODEA ;IS 'A' A
CAIN TE,LTMODE ; LITERAL?
JRST IFDD30 ;YES
HRRZ TD,EMODEB ;NO--IS MODE OF 'A'
CAME TD,TE ; SAME AS MODE OF 'B'?
JRST IFDD3A ;NO
MOVEI LN,EBASEB ;YES--IS 'B'
TSWT FBSUB ; NON-SUBSCRIPTED AND
PUSHJ PP,IFDD50 ; WORD-CONTAINED?
JRST IFDD3A ;IT IS SUBSCRIPTED OR NOT WORD-CONTAINED
MOVEI LN,EBASEA ;YES--IS 'A'
TSWT FASUB ; NON-SUBSCRIPTED AND
PUSHJ PP,IFDD50 ; WORD-CONTAINED?
JRST IFDD3A ;IT IS SUBSCRIPTED OR NOT WORD-CONTAINED
IFN ANS74,<
SKIPN COLSEQ ;TEST FOR SPECIAL COLLATING SEQUENCE
>
JRST IFDD40 ;NO--SPECIAL CODE
IFDD3A: HRRZ TE,ESIZEZ
CAIG TE,MXPSZ.## ;TOO BIG
JRST IFDD3B ;NO
SUBI TE,3770 ;GET REMAINDER
PUSH PP,EINCRA
PUSH PP,EINCRB
PUSH PP,TE
MOVEI TE,3770 ;DIVISIBLE BY 6, 5 AND 4
MOVEM TE,ESIZEZ ;SET SIZE
PUSHJ PP,IFDD3B ;AND DO FIRST PART
IFDD3C: POP PP,ESIZEZ
MOVE TE,EMODEA ;GET MODE
MOVE TE,[EXP 3770/6,3770/5,3770/4](TE)
ADDM TE,EINCRA ;MOVE DOWN STRING
MOVE TE,EMODEB ;GET MODE
MOVE TE,[EXP 3770/6,3770/5,3770/4](TE)
ADDM TE,EINCRB
MOVE TE,ESIZEZ
CAIG TE,MXPSZ. ;STILL TOO BIG?
JRST IFDD3D ;NO, DO LAST COMPARE
SUBI TE,3770 ;YES, CUT DOWN AGAIN
PUSH PP,TE
MOVEI TE,3770
MOVEM TE,ESIZEZ
PUSHJ PP,IFDD3B
JRST IFDD3C
IFDD3D: PUSHJ PP,IFDD20
POP PP,EINCRB
POP PP,EINCRA
CAIA
IFDD3B: PUSHJ PP,IFDD20
HRRZ TE,EMODEB ;IF SAME
CAMN TE,EMODEA ; MODE,
JRST JFALSE ; ONLY ONE JRST REQUIRED
JRST ADDRS3 ;PUT OUT 3 JRSTS
;PRETEND 'A' AND 'B' ARE THE SAME SIZE
IFDD3E: MOVE TE,ESIZEA
CAMLE TE,ESIZEB
MOVE TE,ESIZEB
MOVEM TE,ESIZEA
MOVEM TE,ESIZEB
JRST IFDD3
;BOTH 'A' AND 'B' ARE NON-NUMERIC (CONT'D)
;'A' HAS DIFFERENT SIZE THAN 'B'
IFDD4: CAML TE,ESIZEB
JRST IFDD16 ;"A" LARGER THAN "B"
;"A" SMALLER THAN "B"
HRRZ TE,EMODEA
CAIN TE,LTMODE
JRST IFDD30
IFN BIS,<
CAMN TE,EMODEB ;IS "A" SAME MODE AS "B"?
JRST GENEXD ;YES-- DIFF SIZE COMPARE USING EXTEND
>;END IFN BIS
LDB TE,CONDIT ;IS IT ">" OR "NOT >"?
CAIE TE,NOTGR
CAIN TE,GR
JRST IFDD3E ;YES
MOVE TD,ESIZEB ; GET SIZE OF B [170-A]
PUSH PP,TD ; SAVE SIZE OF B [170-A]
MOVE TD,ESIZEA ; GET A SIZE (SMALLER THAN B) [170]
MOVEM TD,ESIZEB ; SET B SIZE = TO A SIZE [170]
CAIG TD,MXPSZ. ;TOO BIG
JRST IFDD4A ;NO
SUBI TD,3770 ;GET REMAINDER
PUSH PP,EINCRA ;SO WE CAN GET END CONDITION RIGHT
PUSH PP,EINCRB
PUSH PP,TD
MOVEI TE,3770 ;DIVISIBLE BY 6, 5 AND 4
MOVEM TE,ESIZEZ ;SET SIZE
PUSHJ PP,IFDD17 ;AND DO FIRST PART
IFDD4B: POP PP,ESIZEZ
MOVE TE,EMODEA ;GET MODE
MOVE TE,[EXP 3770/6,3770/5,3770/4](TE)
ADDM TE,EINCRA ;MOVE DOWN STRING
MOVE TE,EMODEB ;GET MODE
MOVE TE,[EXP 3770/6,3770/5,3770/4](TE)
ADDM TE,EINCRB
MOVE TE,ESIZEZ
CAIG TE,MXPSZ. ;THIS THE LAST TIME WE HAVE TO LOOP?
JRST IFDD4C ;YES, DO LAST COMPARE
SUBI TE,3770
PUSH PP,TE
MOVEI TE,3770
MOVEM TE,ESIZEZ
PUSHJ PP,IFD17A
JRST IFDD4B
IFDD4C: PUSHJ PP,IFD17A ;TAG IS ALREADY SET UP
POP PP,EINCRB
POP PP,EINCRA
CAIA
IFDD4A: PUSHJ PP,IFDD17 ; GO GENERATE COMP CODE FOR 'A' SIZE [170]
PUSHJ PP,SWAPIT ;[473] MAKE 'B' OPERAND 'A' FOR SPACE COMPARE [170-A]
POP PP,TD ; GET BACK ORIGINAL B SIZE [170-A]
MOVE TE,ESIZEA ; GET A SIZE FOR ARGUMENT TO M.IA [170]
SUB TD,TE ; GET DIFFERENCE OF A AND B [170]
MOVEM TD,ESIZEA ; DIFFERENCE IS LEFT OVER CHARS OF ORIG B FOR SPACE COMP [170-A]
JRST IFD16A
;"A" LARGER THAN "B"
IFDD16: HRRZ TE,EMODEA
CAIN TE,LTMODE
PUSHJ PP,IFDD51
IFN BIS,<
HRRZ TE,EMODEA ;GET "A" MODE NOW
CAME TE,EMODEB ;SKIP IF "A" AND "B" SAME MODE
JRST IFD6AA ; NO -- GO NORMAL ROUTE
PUSHJ PP,SWAPIT ;MAKE "A" THE SMALLER OPERAND
JRST GENEXD ; AND GENERATE THE EXTEND
IFD6AA:
>;END IFN BIS
MOVE TE,ESIZEB
MOVEM TE,ESIZEZ
LDB TE,CONDIT ;IS IT "<" OR "NOT <"?
CAIE TE,LS
CAIN TE,NOTLS
JRST IFDD3E ;YES
MOVE TE,ESIZEB
MOVEM TE,ESIZEZ
CAIG TE,MXPSZ. ;TOO BIG
JRST IFD16B ;NO
SUBI TE,3770 ;GET REMAINDER
PUSH PP,EINCRA ;SO WE CAN GET END CONDITION RIGHT
PUSH PP,EINCRB
PUSH PP,TE
MOVEI TE,3770 ;DIVISIBLE BY 6, 5 AND 4
MOVEM TE,ESIZEZ ;SET SIZE
PUSHJ PP,IFDD17 ;AND DO FIRST PART
IFD16C: POP PP,ESIZEZ
MOVE TE,EMODEA ;GET MODE
MOVE TE,[EXP 3770/6,3770/5,3770/4](TE)
ADDM TE,EINCRA ;MOVE DOWN STRING
MOVE TE,EMODEB ;GET MODE
MOVE TE,[EXP 3770/6,3770/5,3770/4](TE)
ADDM TE,EINCRB
MOVE TE,ESIZEZ ;CAN WE FINISH NOW?
CAIG TE,MXPSZ.
JRST IFD16D ;YES, DO LAST COMPARE
SUBI TE,3770 ;NO, DO A 3770 COMPARE AGAIN
PUSH PP,TE
MOVEI TE,3770
MOVEM TE,ESIZEZ
PUSHJ PP,IFD17A
JRST IFD16C ;LOOP
IFD16D: PUSHJ PP,IFD17A ;TAG IS ALREADY SET UP
POP PP,EINCRB
POP PP,EINCRA
CAIA
IFD16B: PUSHJ PP,IFDD17
MOVE TE,ESIZEB
MOVN TD,ESIZEB
ADDM TD,ESIZEA
IFD16A: PUSHJ PP,M.IA
PUSHJ PP,IFSPAC
HRRZ CH,TAGTRU
SETZM TAGTRU
JRST PUTTAG
;GENERATE CODE FOR NON-NUMERIC DISPLAY COMPARISON (CONT'D).
;ONE FIELD IS SMALLER THAN THE OTHER. GENERATE COMPARISON FOR SMALLER SIZE.
IFDD17: PUSHJ PP,GETTAG ;GET A TAG FOR TRUE PATH
HRLI CH,JRST.
MOVEM CH,TAGTRU
IFD17A: PUSHJ PP,B2PAR
PUSHJ PP,IFDD24
MOVEI TC,5
TLNE W1,LESSF
PUSHJ PP,JTRUES
PUSHJ PP,JFALSE
MOVEI TC,4
TLNE W1,GREATF
JRST JTRUE
JRST JFALSE
;GENERATE THE ACTUAL COMPARISON INSTRUCTION
IFDD20: PUSH PP,EREMAN ;SAVE UNTIL PARAMETERS BUILT
IFN BIS,<
IFN ANS74,<
SKIPE COLSEQ ;SPECIAL COLLATING SEQUENCE?
JRST OLDF20 ;YES, CAN'T USE EXTEND
>;END IFN ANS74
HRRZ TE,EMODEB
CAMN TE,EMODEA ;MODES EQUAL?
JRST NEWF20 ;YES, USE NEW METHOD
OLDF20:
>;END IFN BIS
IFN ANS74,<
SKIPE COLSEQ ;SPECIAL COLLATING SEQUENCE
HRROS COLSEQ ;YES, SIGNAL SUBSCRIPTER TO USE IT
>;END IFN ANS74
PUSHJ PP,B2PAR ;BUILD PARAMETERS
IFN ANS74,<
HRRZS COLSEQ
>
POP PP,EREMAN
HRRZ TE,EMODEB ;SAME MODE?
CAME TE,EMODEA
JRST IFDD24
MOVE CH,[XWD CMP.+ASINC,AS.MSC] ;YES--USE "COMP."
LDB TE,CONDIT
ROT TE,-^D13
ADD CH,TE
PUSHJ PP,PUTASY
HRRZ CH,EACC
JRST PUTASN
IFN BIS,<
NEWF20: PUSHJ PP,EXTNGN ;GENERATE THE EXTEND
POP PP,EREMAN## ;RESTORE THIS
POPJ PP, ;AND RETURN
EXTNGN: PUSHJ PP,DEPCKK## ;SKIP IF ANY DEPENDING ITEMS
JRST EXTNG1 ;NO
;WE ASSUME 'ESIZEA' IS THE MAX SIZE OF 'A' AND 'ESIZEB' IS MAX SIZE FOR 'B'.
; ESIZEZ IS IGNORED. AC4 WILL BE SETUP TO HAVE COUNT OF 'A' AND AC7 FOR 'B'.
PUSHJ PP,EXMAB## ;PUT SUBSCRIPTS IN %TEMP NOW
; SO WE DON'T SMASH ACS 4 & 7 AT NB2PAR
PUSHJ PP,DEPTSA## ;DOES 'A' HAVE A DEPENDING ITEM?
JRST NODPIA ;NO, DO 'MOVEI' LATER ON
MOVEI TE,4 ;USE RUNTIME AC 4
PUSHJ PP,SZDPVA## ; SET IT UP
POPJ PP, ; ?ERROR, GIVE UP NOW
MOVEI TE,4
MOVEM TE,CONVSV## ;HAVE TO PRESERVE THIS AC
NODPIA: PUSHJ PP,DEPTSB## ;DOES 'B' HAVE A DEPENDING ITEM?
JRST NODPIB ;NO
MOVEI TE,7 ;SETUP AC 7 WITH SIZE OF 'B'
PUSHJ PP,SZDPVB## ; SET IT UP
NODPIB: SETZM CONVSV## ;CLEAR 'AC TO SAVE'
EXTNG1: MOVE TA,ESIZEZ ;# CHARS TO MOVE
MOVEM TA,NCHARS## ;STORE FOR GETNB
PUSHJ PP,GETNB## ;CAN WE USE LARGER BYTES?
MOVE TE,NBYTES## ;CAN WE USE LARGER BYTES?
CAIE TE,1
SETOM USENBT## ;IF NOT 1, ANSWER IS YES!
MOVE TE,ESIZEZ ;NOW FIND OUT # BYTES
IDIV TE,NBYTES##
SOJE TE,[HRRZ TE,EMODEA ;[544] COMPARING ONE BYTE?
CAIE TE,D6MODE ;[544] YES, SIXBIT CAN BE PROBLEM
JRST ONEBYT ;[544] OK, DON'T USE EXTEND
MOVE TE,NBYTES ;[544] GET NUMBER OF BYTES
CAIE TE,6 ;[544] A FULL WORD?
JRST ONEBYT ;[544] NO
JRST .+1] ;[544] YES, USE EXTEND INST
PUSHJ PP,NB2PAR## ;SETUP ACS 5-10
;IF 36-BIT BYTES ARE BEING USED, THE BYTE POINTER MUST BE SETUP.
MOVE TE,NBYTES## ;HOW MANY BYTES/BYTE?
CAIE TE,4
CAIN TE,6 ;4 OR 6 MEANS OPTIMIZATION WAS APPLIED
CAIA
JRST GOTBPS ;B.P.'S OK
TSWT FASUB ;IS RH OF AC5 SETUP?
JRST XXSET5 ;NO
MOVE CH,[TLO.+ASINC+AC5,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,(POINT 36,) ;"TLO 5,(POINT 36,)"
PUSHJ PP,PUTASN
JRST XXSET7
XXSET5: MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP
PUSHJ PP,MBYTPA
PUSHJ PP,POOL
MOVSI CH,MOV+AC5
PUSHJ PP,PUT.LD
SKIPN PLITPC
AOS ELITPC
XXSET7: TSWT FBSUB ;IS RH OF AC10 SETUP?
JRST XXSET8 ;NO
MOVE CH,[TLO.+ASINC+AC10,,AS.CNB]
PUSHJ PP,PUTASY
MOVEI CH,(POINT 36,) ;"TLO 10,(POINT 36,)"
PUSHJ PP,PUTASN
JRST GOTBPS ;OK, GOT BYTE PTRS NOW
XXSET8: MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP
PUSHJ PP,MBYTPB
PUSHJ PP,POOL
MOVSI CH,MOV+AC10
PUSHJ PP,PUT.LD
SKIPN PLITPC
AOS ELITPC
;GENERATE "MOVEI 4,<NUMBER OF BYTES>"
GOTBPS: PUSHJ PP,DEPTSA## ;'A' SIZE SETUP?
SKIPA CH,[MOVEI.+AC4+ASINC,,AS.CNB]
JRST GOTBPA ;YES
PUSHJ PP,PUTASY
MOVE TE,ESIZEZ ;NUMBER OF SMALL BYTES TO COMPARE
IDIV TE,NBYTES## ; # OF "BIG" BYTES TO COMPARE
MOVE CH,TE
PUSHJ PP,PUTASN
;GENERATE "MOVEI 7,<NUMBER OF BYTES>"
GOTBPA: PUSHJ PP,DEPTSB## ;'B' SIZE SETUP?
SKIPA CH,[MOVEI.+ASINC+AC7,,AS.CNB]
JRST GOTBPB ;YES
PUSHJ PP,PUTASY##
MOVE TE,ESIZEZ ;NUMBER OF SMALL BYTES TO COMPARE
IDIV TE,NBYTES## ; # OF 'BIG' BYTES TO COMPARE
MOVE CH,TE
PUSHJ PP,PUTASN##
;ACS HAVE BEEN SETUP. NOW GENERATE THE EXTEND
GOTBPB: PUSHJ PP,DEPCKK ;IF ANY DEPENDING ITEMS,
SKIPA TA,[XTNLIT,,1] ;NO, OCTAL LITERAL
PJRST USE3EX ;YES, USE THE EXTEND WITH THE FILLER CHAR
PUSHJ PP,STASHP ; (FOR CMPXX EXTEND CODE)
LDB TE,CONDIT ;WHICH CONDITION TO TEST?
HLLZ TA,CMXTB(TE)
PUSHJ PP,POOLIT
PUSHJ PP,PUTASA## ;EXTEND IS IN 2ND SET OF OPCODES
MOVSI CH,XTND.+AC4
PUSHJ PP,PUT.LD## ;OUTPUT "EXTEND AC4,<CURRENT LITERAL>"
SKIPN PLITPC
AOS ELITPC
SETZM USENBT## ;CLEAR FLAG
POPJ PP,
CMXTB: 0
CMPSE ;EQ
CMPSG ;GREATER
CMPSGE ;GREATER OR EQUAL
CMPSL ;LESS
CMPSLE ;LESS OR EQUAL
CMPSN ;NOT EQUAL
;HERE FOR COMPARE WHEN "A" IS SMALLER THAN "B"
; GENERATE THE EXTEND USING SMALL BYTES & FILLER CHARS
GENEXD: PUSHJ PP,NB2PAR## ;SETUP BYTE PTRS TO "A" AND "B"
;GENERATE "MOVEI 4,<# BYTES IN A>
MOVE CH,[MOVEI.+AC4+ASINC,,AS.CNB]
PUSHJ PP,PUTASY##
MOVE CH,ESIZEA ;NUMBER OF BYTES IN A
PUSHJ PP,PUTASN##
;GENERATE "MOVEI 7,<# BYTES IN B>
MOVE CH,[MOVEI.+AC7+ASINC,,AS.CNB]
PUSHJ PP,PUTASY##
MOVE CH,ESIZEB
PUSHJ PP,PUTASN##
PUSHJ PP,USE2EX ; USE THE EXTEND WITH FILLER CHARS
JRST JFALSE ;GEN "JRST FALSE" THEN RETURN
;GENERATE THE LITERAL STUFF, WITH FILLER CHARACTER IN E0+1
USE2EX: MOVE TA,[XTNLIT,,1]
PUSHJ PP,STASHP ;FIRST IS TYPE OF EXTEND
LDB TE,CONDIT
HLLZ TA,CMXTB(TE)
PUSHJ PP,STASHQ
AOS ELITPC ;GET LITERAL PC RIGHT FOR POOL
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
HRRZ TE,EMODEA
HRRZ TA,IFSPCS(TE) ;GET A SPACE
PUSHJ PP,POOLIT ;FINISH LITERAL BLOCK FOR EXTEND
SOS ELITPC
PUSHJ PP,PUTASA## ;READY FOR EXTEND
MOVSI CH,XTND.+AC4
PUSHJ PP,PUT.LD##
SKIPE PLITPC
POPJ PP, ;RETURN
MOVEI TE,2 ;UPDATE ELITPC IF WE DIDN'T POOL
ADDM TE,ELITPC
POPJ PP, ;RETURN
;GENERATE THE LITERAL STUFF, WITH FILLER CHARACTER IN E0+1 AND E0+2
;SINCE WE DON'T KNOW WHICH STRING WILL BE THE SHORTER
USE3EX: MOVE TA,[XTNLIT,,1]
PUSHJ PP,STASHP ;FIRST IS TYPE OF EXTEND
LDB TE,CONDIT
HLLZ TA,CMXTB(TE)
PUSHJ PP,STASHQ
AOS ELITPC ;GET LITERAL PC RIGHT FOR POOL
MOVE TA,[OCTLIT,,2]
PUSHJ PP,STASHP
HRRZ TE,EMODEA
HRRZ TA,IFSPCS(TE) ;GET A SPACE
PUSHJ PP,STASHQ ;E0+1
HRRZ TE,EMODEB
HRRZ TA,IFSPCS(TE) ;GET A SPACE
PUSHJ PP,POOLIT ;FINISH LITERAL BLOCK FOR EXTEND
SOS ELITPC
PUSHJ PP,PUTASA## ;READY FOR EXTEND
MOVSI CH,XTND.+AC4
PUSHJ PP,PUT.LD##
SKIPE PLITPC
POPJ PP, ;RETURN
MOVEI TE,3 ;UPDATE ELITPC IF WE DIDN'T POOL
ADDM TE,ELITPC
POPJ PP, ;RETURN
;HERE TO COMPARE ONE BYTE
ONEBYT: PUSHJ PP,PCXBP2## ;GEN PROPER BYTE PTRS
MOVE TE,EMODEA
CAIN TE,D7MODE
JRST ONEBY1 ;USE ILDB, CAMX
MOVE TE,ESIZEZ
CAIGE TE,4 ;FULL WORD BYTE?
JRST ONEBY1 ;NO
;COMPARE FULL WORDS
TSWT FASUB ;WAS "A" SUBSCRIPTED?
JRST FULWW1 ;NO
HLRZ CH,PCXPTR## ;GET INDEX AC
IORI CH,MOV
HRLZ CH,CH
PUSHJ PP,PUT.XA## ;"MOVE AC, (SUBSC.AC)"
JRST FULWD2
FULWW1: MOVSI CH,MOV
PUSHJ PP,PUT.AA## ;"MOVE AC,A"
FULWD2: TSWT FBSUB ;SKIP IF "B" SUBSCRIPTED
JRST FULWD4 ;NO
; "B" WAS SUBSCRIPTED. ADDRESS OF IT IS IN AN AC.
FULWD3: MOVSI CH,CAM.
LDB TE,CONDIT
ROT TE,-8
ADD CH,TE
HRLZ TE,PCXPTR## ;GET AC "B" IS IN
OR CH,TE ;INDEX BY IT
SETZM USENBT## ;CLEAR FLAG
PJRST PUT.XA## ;"CAMX AC,0(SUBSC.AC)"
FULWD4: MOVSI CH,CAM.
LDB TE,CONDIT
ROT TE,-8
ADD CH,TE
SETZM USENBT## ;CLEAR FLAG
PJRST PUT.BA## ;"CAMX AC,B"
;HERE TO GENERATE ILDB, ILDB, CAMX
ONEBY1: HLRZ TA,PCXPTR## ;WHERE IS "A" GOING TO END UP?
CAIGE TA,AS.LIT ;SKIP IF LITTAB
JRST ONEBYA ;NO, IN AC
MOVE CH,[LDB.+ASINC,,AS.MSC]
PUSHJ PP,PUT.XA## ;"LDB AC,LIT00+N"
HLRZ CH,PCXPTR##
PUSHJ PP,PUTASN## ;. .
JRST ONEBYB
ONEBYA: MOVSI CH,ILDB. ;"ILDB AC,<SUBSC. AC>"
HLR CH,PCXPTR##
PUSHJ PP,PUT.XA##
ONEBYB: HRRZ TA,PCXPTR## ;WHERE IS "B" GOING TO END UP?
CAIGE TA,AS.LIT ;SKIP IF LITTAB
JRST ONEBYC ;NO, IT WAS SUBSCRIPTED
MOVE CH,[LDB.+ASINC,,AS.MSC]
PUSHJ PP,PUT.XB##
HRRZ CH,PCXPTR##
PUSHJ PP,PUTASN##
JRST ONEBYD
ONEBYC: MOVSI CH,ILDB.
HRR CH,PCXPTR##
PUSHJ PP,PUT.XB##
;GENERATE "CAMX AC,AC+1"
ONEBYD: SETZM USENBT## ;CLEAR FLAG
MOVSI CH,CAM.
LDB TE,CONDIT
ROT TE,-8
ADD CH,TE
HRR CH,EAC
AOJA CH,PUT.XA##
>;END IFN BIS
;GENERATE "HRRZI 16, <PARAMETER ADDRESS>".
IFDD24: MOVE CH, [XWD HRRZI.+AC16+ASINC,AS.MSC]
PUSHJ PP, PUTASY
HRRZI CH, (EACC)
PUSHJ PP, PUTASN
;GENERATE "PUSHJ 17, <ROUTINE>".
HRRZ TE, EMODEA ;FIGURE OUT WHICH ROUTINE TO USE.
HRRZI CH, COMP%## ;ASSUME A AND B ARE OF THE SAME MODE.
CAMN TE, EMODEB
PJRST GNPSX.## ;THEY ARE, GO GENERATE THE INSTRUCTION.
ADD TE, EMODEB ;THEY AREN'T, FORM THE INDEX.
JUMPL TE, GNPSX.## ;IF AN ERROR OCCURED IN PHASE D
CAIG TE, 3 ; THE MODES MAY BE MESSED UP, SO
; USE COMP.
MOVE CH, CDDS-1(TE) ;GET THE ROUTINE.
PJRST GNPSX.## ;GO GENERATE THE INSTRUCTION.
CDDS: XWD 0,CMP%76## ;COMPARE DISPLAY-7 TO DISPLAY-6.
XWD 0,CMP%96## ;COMPARE DISPLAY-9 TO DISPLAY-6.
XWD 0,CMP%97## ;COMPARE DISPLAY-9 TO DISPLAY-7.
;'A' IS A LITERAL WITH SIZE NOT GREATER THAN 'B', AND 'B' IS NON-NUMERIC
IFDD30: MOVE TE,ESIZEB ;IS 'B'
CAIN TE,1 ; A SINGLE CHARACTER?
TSWF FBSUB ;YES--SUBSCRIPTED?
JRST IFDD36 ;SUBSCRIPTED, OR NOT SINGLE CHARACTER
PUSHJ PP,IFDD42 ;YES--GENERATE <LDB 0,B>
PUSHJ PP,SWAPIT ;SWAP OPERANDS AND CONDITION
ILDB CH,EBYTEB ;GET LITERAL VALUE INTO 'CH'
HRRZ TE,EMODEA ;IS 'A'
CAIE TE,D6MODE ; SIXBIT?
JRST IFDD31 ;NO
CAIG CH,137 ;YES-- IS LITERAL
CAIGE CH,40 ; REASONABLE?
JRST IFDD39 ;NO
SUBI CH,40 ;YES--CONVERT TO SIXBIT
JRST IFDD32
IFDD31: CAIE TE, D9MODE## ;IS 'A' DISPLAY-9?
JRST IFDD32 ;NO, MUST BE DISPLAY-7 THEN.
MOVEI TE, (CH) ;SET UP FOR VLIT8. CALL.
PUSHJ PP, VLIT8.## ;GO CONVERT THE CHAR.
LDB CH, [POINT 9,TE,35] ;GET IT IN CH (THERE MAY BE 2 CHARS.)
IFDD32:
IFN ANS74,<
SKIPN COLSEQ ;PROGRAM COL SEQ SPECIAL?
JRST IFDD33 ;NO
HRRZ TE,EMODEA ;GET MODE AGAIN
EXCH TD,CH ;PUT CHAR IN RIGHT PLACE
XCT CSCHAR(TE) ;CONVERT
EXCH TD,CH ;RESTORE
>
IFDD33: HRLI CH,CAI. ;GET DUMMY CAI OPERATOR
LDB TE,CONDIT ;CONVERT
ROT TE,-^D8 ; OPERATOR TO
ADD CH,TE ; SOMETHING VALID
PUSHJ PP,PUTASY ;GENERATE <CAIX 0,LITERAL>
JRST JFALSE ;PUT OUT FALSE JUMP AND LEAVE
;CANNOT USE SPECIAL CODE
IFDD36: PUSHJ PP,IFDD51 ;PUT LITERAL IN LITAB
JRST IFDD2 ;TRY AGAIN
;LITERAL HAS NON-SIXBIT VALUE
IFDD39: HRRZ TE,OPERND
MOVEM TE,CUREOP
MOVEI DW,E.329 ; [374] NON-SIXBIT CHAR ERROR
PUSHJ PP,OPNFAT
MOVEI CH,0
JRST IFDD33
;BOTH 'A' AND 'B' ARE WORD-CONTAINED, AND HAVE SAME MODE
IFDD40: CAIN TE,^D36 ;ARE THEY FULL WORDS?
JRST IFDD44 ;YES, SPECIAL TREATMENT
PUSHJ PP,IFDD42 ;GENERATE <LDB 0,B>
PUSHJ PP,IFDD41 ;GENERATE <LDB 1,A>
MOVSI CH,CAM.+AC1 ;GET DUMMY CAM OPERATOR
LDB TE,CONDIT ;CONVERT
ROT TE,-^D8 ; OPERATOR TO
ADD CH,TE ; SOMETHING REASONABLE
PUSHJ PP,PUTASY ;GENERATE <CAMX 1,0>
JRST JFALSE ;PUT OUT FALSE PATH AND QUIT
;GENERATE <LDB 1,A>
IFDD41: MOVSI CH,LDB.+AC1
MOVEI LN,EBASEA
IFN ANS74,<
SKIPN COLSEQ ;SPECIAL COLLATING SEQUENCE?
>
JRST IFDD43
IFN ANS74,<
PUSHJ PP,IFDD43 ;YES, LOAD AC1
MOVE CH,[MOV+AC1+ASINC+1,,AS.MSC]
PUSHJ PP,PUTASY
MOVE CH,EMODEA
MOVE CH,COLSQS(CH)
PJRST PUTASN
>
;GENERATE <LDB 0,B>
IFDD42: MOVSI CH,LDB.
MOVEI LN,EBASEB
IFN ANS74,<
SKIPN COLSEQ ;SPECIAL COLLATING SEQUENCE?
JRST IFDD43
MOVSI CH,LDB.+AC1
PUSHJ PP,IFDD43 ;YES, LOAD AC1
MOVE CH,[MOV+ASINC+1,,AS.MSC]
PUSHJ PP,PUTASY
MOVE CH,EMODEB
MOVE CH,COLSQS(CH)
PJRST PUTASN
>
IFDD43: PUSH PP,CH ;SAVE INST
MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP
HRRZ TA,EBASEX(LN)
PUSHJ PP,STASHQ
MOVE TA,ESIZEX(LN)
HRRZ TD,EMODEX(LN)
IMUL TA,BYTE.S(TD)
HLR TD,ERESX(LN)
SUB TD,TA
ROT TA,-6
HRRI TA,(TD)
ROT TA,-6
HRR TA,EINCRX(LN)
PUSHJ PP,POOLIT
POP PP,CH
PUSHJ PP,PUT.LD ;GENERATE <LDB [CURRENT LITERAL]>
SKIPN PLITPC
AOS ELITPC
POPJ PP,
;BOTH 'A' AND 'B' ARE WORD-CONTAINED, HAVE SAME MODE, AND ARE 36 BITS
IFDD44: LDB TE,CONDIT ;IF CONDITION IS
CAIE TE,EQ ; EQUAL OR
CAIN TE,NOTEQ ; NOT EQUAL, GENERATE
JRST .+2 ; SPECIAL CODE, ELSE
JRST IFDD3A ; RETURN TO NORMAL
MOVSI CH,MOV+AC1 ;WE CAN USE MOVE RATHER THAN LDB
PUSHJ PP,PUT.A ;GENERATE <MOVE 1,A>
MOVSI CH,CAM.+AC1 ;NO NEED TO LOAD B
LDB TE,CONDIT ;CONVERT
ROT TE,-^D8 ; CONDITION TO
ADD CH,TE ; CAMX
PUSHJ PP,PUT.B ;GENERATE <CAMX 1,B>
JRST JFALSE ;PUT OUT FALSE AND QUIT
;CHECK TO SEE IF FIELD IS WORD-CONTAINED.
;IF SO, RETURN TO CALL+2; IF NOT RETURN TO CALL+1.
IFDD50: MOVE TE,ESIZEX(LN)
HRRZ TD,EMODEX(LN)
IMUL TE,BYTE.S(TD)
HLRZ TD,ERESX(LN)
CAML TD,TE
AOS (PP)
POPJ PP,
;PUT VALUE OF THE LITERAL 'A' INTO LITAB
IFDD51: PUSH PP,ESIZEB
HLRZ TE,OPERND
MOVE TE,0(TE)
TLNE TE,GNALL
JRST IFDD52
MOVE TE,ESIZEA
CAMLE TE,ESIZEB
MOVEM TE,ESIZEB
IFDD52: SETZM LITERR## ; [374] CLEAR LITERAL ERROR SW
PUSHJ PP,LITD.0## ; [374] SET UP LITERAL
POP PP,ESIZEB
SKIPN LITERR ; [374] ERRORS IN CONVERSION?
POPJ PP, ;NO
MOVEI DW,E.329 ; [374] SET UP FOR POSSIBLE ERROR
HLRZ TE,OPERND ; [374] GET LITERAL OPERAND
MOVEM TE, CUREOP ; [374] SET UP FOR ERROR
PUSHJ PP,OPNFAT ; [374] YES GIVE ERROR
SETZM LITERR ; [374] CLEAR ERROR SW
POPJ PP,
;TABLE OF FIG. CONST. ENTRY POINTS, WHEN "A" IS NOT AC'S
IFFCT:
IFN ANS68,<
EXP IFTODY ;TODAY
>
IFN ANS74,<
EXP 0
>
EXP IFSPAC ;SPACE
EXP IFZERO ;ZERO
EXP IFQUOT ;QUOTE
EXP IFHIV ;HIGH-VALUES
EXP IFLOV ;LOW-VALUES
;TABLE OF FIG. CONST. ENTRY POINTS, WHEN "A" IS AC'S
IFFCTA:
IFN ANS68,<
EXP IFATDY ;TODAY
>
IFN ANS74,<
EXP 0
>
EXP BADCLS ;SPACE
EXP IFZERO ;ZERO
EXP BADCLS ;QUOTE
EXP IFHIV ;HIGH-VALUES
EXP IFLOV ;LOW-VALUES
;ERROR ROUTINES
;TWO LITERALS BEING COMPARED
TWOLIT: MOVEI DW,E.331
JRST OPNFAT
;AC'S BEING COMPARED WITH SOMETHING NOT NUMERIC
BADCLS: MOVEI DW,E.211
JRST OPNFAT
;CONFUSION -- "B" AT FAULT
IFCONB: SKIPA TC,OPERND
;CONFUSION -- "A" AT FAULT
IFCONA: MOVS TC,OPERND
HRRZM TC,CUREOP
MOVEI DW,E.276
JRST OPNFAT
;"B" MUST BE NUMERIC
NOTNMB: SKIPA TC,OPERND
;"A" MUST BE NUMERIC
NOTNMA: MOVS TC,OPERND
HRRZM TC,CUREOP
MOVEI DW,E.211
JRST OPNFAT
;GENERATE CODE FOR "ENDIF"
ENDIFG:ENDIFG: TLNN W1,GNENDS ;[605] IS THIS AN "END SPIF"?
POPJ PP, ;[605] NO
IFN ANS74,<ENDIFR::>
SKIPN EDEPFT## ;[605] READ OF VARIABLE LENGTH RECORD?
JRST ENDIF2 ;[605] NO, TRY "INTO"
HRRZ TA,EDEPFT ;[605] GET FILE TABLE
HRLZM TA,CURFIL## ;[605] MAKE SURE IT POINTS TO FILE WE WANT
PUSHJ PP,LNKSET ;[605] CONVERT TO ADDRESS
HRRM TA,CURFIL ;[605] SAVE IT
SETZM EDEPFT ;[605]
PUSHJ PP,VLTST## ;[605] CALL AGAIN TO SETUP POINTER TO RECORD
ENDIF1: MOVEM CH,EDEPFT ;[605] SOMEWHERE SAFE TO STORE POINTERS
HLRZ CH,CURFIL ;[605] GET FILE TABLE
IOR CH,[MOV+ASINC,,AS.FIL##] ;[605] GET RECORD COUNT
PUSHJ PP,PUTASY ;[605] PUT OUT FIRST PART
MOVSI CH,FI.CLR## ;[605] NEG OFFSET IN LHS.
PUSHJ PP,PUTASN ;[605] PUT OUT NEG. OFFSET
SETZM EAC ;[605] RESULT IS IN AC0
HRRZ TA,EDEPFT ;[605] GET OFFSET OF 01 RECORD
PUSHJ PP,LNKSET ;[605] ITS ADDRESS
LDB TB,DA.EXS ;[605] GET MAX. SIZE
PUSH PP,TB ;[605] SAVE
HLRZ TA,EDEPFT ;[605] GET OFFSET OF OCCURS ITEM
PUSHJ PP,LNKSET ;[605] ITS ADDRESS
LDB TB,DA.EXS ;[605] GET SIZE
LDB TC,DA.NOC## ;[605] NO. OF OCCURS
IMULI TC,(TB) ;[605] SIZE OF VARIABLE PART
POP PP,CH ;[605] REGET SIZE OF RECORD
SUB CH,TC ;[605] GET FIXED PART
JUMPE CH,ENDIF3 ;[605] NO FIXED PART
HRLI CH,SUBI.## ;[605] GENERATE CODE TO SUBTRACT IT FROM CHAR COUNT
PUSHJ PP,PUTASY ;[605] SO OCCURS DEP. VARIABLE IS WHAT COBOL EXPECTS
ENDIF3: CAIN TB,1 ;[605] IF SIZE IS 1
JRST ENDIF4 ;[605] DON'T GENERATE DIVIDE INST
MOVSI CH,ADDI.## ;[605] FASTEST WAY TO ROUND UP
HRRI CH,-1(TB) ;[605] BY ADDING SIZE -1
PUSHJ PP,PUTASY ;[605] TO VALUE IN AC0
MOVSI CH,IDIVI.## ;[605] GENERATE DIVIDE
HRRI CH,(TB) ;[605] BY INDIVIDUAL ITEM
PUSHJ PP,PUTASY ;[605]
ENDIF4: SETZM EBASEA ;[605] SET UP A FAKE "A"
MOVE TA,[EBASEA,,EBASEA+1] ;[605]
BLT TA,EFLAGA ;[605] START WITH IT ALL ZERO
MOVEI TA,D1MODE ;[605] 1 WORD COMP
MOVEM TA,EMODEA ;[605]
SWOFF FEOFF1 ;[605] GET THE FLAGS RIGHT
SWON FAINAC!FANUM!FASIGN ;[605]
;[605] NOW TO FAKE "B"
PUSH PP,W1 ;[605] SAVE W1
PUSH PP,W2 ;[605] AND W2.
PUSH PP,OPERND## ;[605] SAVE OPERND TOO. (IN CASE IT'S
;[605] IN THE LINKAGE SECTION.)
HLRZ TA,EDEPFT ;[605] GET OCCURS ITEM
PUSHJ PP,LNKSET ;[605] POINT TO IT
LDB W2,DA.DEP## ;[605] GET THE DEPENDING ITEM.
MOVEI TA,(W2) ;[605] AND POINT AT IT.
PUSHJ PP,LNKSET## ;[605]
MOVSI W1,(1B0) ;[605] SET THE OPERAND FLAG.
LDB TD,DA.SYL## ;[605] SET THE SYNC FLAGS.
DPB TD,[POINT 1,W1,5] ;[605]
LDB TD,DA.SYR## ;[605]
DPB TD,[POINT 1,W1,6] ;[605]
LDB TD,DA.CLA## ;[605] SET THE NUMERIC FLAG.
CAIN TD,%CL.NU ;[605]
TLO W1,(1B7) ;[605]
LDB TD,DA.JST## ;[605] SET THE JUSTIFIED FLAG.
DPB TD,[POINT 1,W1,8] ;[605]
LDB TD,DA.LKS## ;[605] SET THE LINKAGE SECTION FLAG.
DPB TD,[POINT 1,W1,9] ;[605]
LDB TD,DA.USG## ;[605] SET THE USAGE.
DPB TD,[POINT 4,W1,13] ;[605]
PUSHJ PP,PUSH12## ;[605] STASH THE INFO IN EOPTAB.
HRRZI TC,-1(EACA) ;[605] POINT AT THE EOPTAB ENTRY.
MOVEM TC,CUREOP ;[605] MAKE IT THE CURRENT ENTRY.
HRRZM TC,OPERND## ;[605] MAKE IT THE CURRENT OPERAND TOO.
MOVEI LN,EBASEB ;[605] POINT TO "B"
PUSHJ PP,SETOPN ;[605] SET UP "B" OPERAND
TSWT FERROR ;[605] DON'T TRY TO STORE IF ERROR FOUND
PUSHJ PP,MACX.## ;[605] STORE DEPENDING ITEM
POP PP,OPERND## ;[605] RESTORE OPERND.
POP PP,W2 ;[605] RESTORE W2
POP PP,W1 ;[605] AND W1.
MOVE EACA,EOPNXT## ;[605] RESET EOPTAB.
POP EACA,(EACA) ;[605]
POP EACA,(EACA) ;[605]
HRRZ TA,EDEPFT ;[605] GET CURRENT 01
SETZM EDEPFT ;[605] SO WE KNOW IF ANOTHER IS FOUND
PUSHJ PP,VLTSTN## ;[605] LOOK FOR ONE
SKIPE EDEPFT ;[605] DID WE FIND SOMETHING?
JRST ENDIF1 ;[605] YES, GENERATE CODE FOR THIS DEP. VAR. ALSO
ENDIF2: SKIPN TB,EINTO ;[605] ANY "INTO" FOR A READ?
POPJ PP, ;NO--QUIT
HRRZI TA,EINTO
HRRZI TC,EINTO+2
MOVEM TC,CUREOP
PUSHJ PP,MOVGN. ;GENERATE THE MOVE
SETZM EINTO
POPJ PP,
;GENERATE CODE FOR "SPIF" OPERATOR
SPIFGN:
IFN ANS68,<
TLNN W1,ATINVK
>
IFN ANS74,<
TLNN W1,ATPINV## ;ALSO TEST FOR ATEOP
>
JRST SPIF5
SPIF3: HLRZ CH,W2
ANDI CH,LMASKS
IORI CH,AS.TAG
HRLI CH,XJRST.## ;SO OPTIMIZER WON'T REMOVE
HRRZ TA,CH
PUSH PP,CH
PUSHJ PP,REFTAG## ;REFERENCE THE TAG
PUSHJ PP,PUTASA ;OTHER CODE SET
POP PP,CH
JRST PUTASY
;NEITHER INVALID KEY NOR AT END--MUST BE SIZE ERROR
SPIF5: MOVE CH,[XWD SKIPN.,SZERA.]
SKIPE EMULSZ
PUSHJ PP,PUT.EX##
SETZM EMULSZ
PUSHJ PP,SPIF3 ;PUT OUT THE JRST
SKIPN CH,ESZERA ;ANY TAG TO GO?
POPJ PP, ;NO--QUIT
SETZM ESZERA ;YES--CLEAR INDICATOR
JRST PUTTAG ;PUT OUT THE TAG--THEN QUIT
;GENERATE CODE TO COMPARE A FIELD TO ZEROES.
IFZERO: TSWF FAINAC ;IS 'A' IN AC'S?
JRST IFZ20 ;YES
MOVE TE,ESIZEA
MOVEM TE,ESIZEZ
HRRZ TE,EMODEA
CAILE TE,DSMODE
JRST IFZ2
TSWF FANUM ;IS 'A' NUMERIC?
JRST IFZ19 ;YES
HRRZ TD,W2 ; [441] GET IF OPERATOR
CAIN TD,22 ; [441] IFT ( IF A ZERO ) TYPE?
JRST IFZZ0 ; [441] YES USE ALGEBRAIC COMPARES
; IF A OP ZERO FOR A NON-NUMERIC USE CHAR COMPARE
HRRZ TD,IFZROC(TE) ; [441] GET SOME KIND OF ZERO.
IFN ANS74,<
SKIPE COLSEQ ;SPECIAL COLLATING SEQUENCE?
XCT CSCHAR(TE) ;YES, GET CONVERTED ZERO
>
HLRZ CH,IFZROC(TE) ; [441] GET A ROUTINE'S EXTAB ADR.
MOVEM TD,ESAVAC
PUSHJ PP,SPECIL
POPJ PP, ;"CAM" GENERATED--EXIT
IFZ1D: ;[441]
LDB TE,CONDIT ;IF CONDITION IS
CAIE TE,EQ ; EQUAL OR
CAIN TE,NOTEQ ; NOT EQUAL,
JRST IFNM2 ; SPECIAL PROCESSING
JRST IFQHV2 ; ELSE NORMAL
;NOT DISPLAY
IFZ2: CAIN TE,C3MODE ;IF THE OPERAND IS COMP-3,
JRST IFZ19 ; GO GET IT INTO THE AC'S.
TLZE W1,NOTF
TLC W1,CONCMP
PUSHJ PP,SUBSCD
HRRZ TE,EMODEA
CAIN TE,D2MODE
JRST IFZ5
IFZ3: MOVSI CH,SKIP.
LDB TE,CONDIT
ROT TE,-^D9
ADD CH,TE
PUSHJ PP,PUT.A
JRST JFALSE
IFZZ0: HRRZ TD,IFZROS(TE) ;GET SOME KIND OF ZERO
MOVEM TD,ESAVAC ;SAVE ZERO CHAR
IFE BIS,< HLRZ CH,IFZROS(TE) > ;GET A ROUTINE'S EXTAB ADDRESS
IFN BIS,< SETO CH, > ;
JRST IFZ1D
IFZROS: XWD ZERO%6##,20 ;DISPLAY-6 ZERO.
XWD ZERO%7##,60 ;DISPLAY-7 ZERO.
XWD ZERO%9##,360 ;DISPLAY-9 ZERO.
IFZROC::XWD ZERC%6##,20 ; [441] DISPLAY-6 ZERO
XWD ZERC%7##,60 ; [441] DISPLAY-7 ZERO
XWD ZERC%9##,360 ; [441] DISPLAY-9 ZERO
IFZ5: LDB TE,CONDIT
JRST @.(TE)
EXP IFZ6 ;=
EXP IFZ12 ;> [177]
EXP IFZ9 ;NOT <
EXP IFZ3 ;<
EXP IFZ10 ;NOT >
EXP IFZ8 ;NOT =
IFZ6: MOVSI CH,SKIPN.
PUSHJ PP,PUT.A
MOVSI CH,SKIPE.
IFZ6A: AOS EINCRA ; SKIPX AC+1 [177]
PUSHJ PP,PUT.A
IFZ7: SOS EINCRA
JRST JFALSE
IFZ8: MOVSI CH,SKIPN.
PUSHJ PP,PUT.A
AOS EINCRA
MOVSI CH,SKIPE.
PUSHJ PP,PUT.A
MOVSI CH,SKIPA.
PUSHJ PP,PUTASY
JRST IFZ7
IFZ9: MOVSI CH,SKPGE. ; SKIPGE AC [177]
PUSHJ PP,PUT.A ; PUT IN ASSEMBLY FILE [177]
JRST JFALSE ; ENTER JRST FALSE [177]
; NO NEED TO CHECK 2ND WORD SINCE G.E. 0 [177]
IFZ10: MOVSI CH,SKPGE. ; SKIPGE AC [177]
PUSHJ PP,PUT.A
MOVE CH,[XWD JRST.+ASINC,AS.MSC]
PUSHJ PP,PUTASY
HRRZI CH,AS.DOT+4
PUSHJ PP,PUTASN
JRST IFZ6
IFZ12: MOVSI CH,SKPLE. ; SKIPLE AC, [177]
PUSHJ PP,PUT.A ; PUT IN ASSY FILE [177]
MOVE CH,[XWD JRST.+ASINC,AS.MSC] ; PUT IN JRST .+4 [177]
PUSHJ PP,PUTASY ; PUT IN ASSY FILE [177]
HRRZI CH,AS.DOT+4 ; .+4 [177]
PUSHJ PP,PUTASN ; [177]
MOVSI CH,SKIPN. ; SKIPN AC [177]
PUSHJ PP,PUT.A ; PUT IN ASSY FILE [177]
MOVSI CH,SKIPN. ; SKIPN AC+1 [177]
JRST IFZ6A ; FINISH UP [177]
;COMPARE A FIELD AGAINST ZEROES (CONT'D).
;"A" IS NUMERIC DISPLAY OR COMP-3.
IFZ19: PUSHJ PP,MOVXAC ; [413] GET IT INTO AC'S
SWON FAINAC;
;"A" IS IN THE AC'S.
IFZ20: HRRZ TE,EMODEA
CAIN TE,D2MODE
JRST IFZ22
IFZ21: ;ENTER HERE FROM CAMX AC,0
MOVSI CH,JUMP.
LDB TE,CONDIT
TLNN W1,NOTF
TRC TE,CONCMP/100
ROT TE,-^D9
ADD CH,TE
MOVE TE,EAC
DPB TE,CHAC
JRST JFLSEA
IFZ22: LDB TE,CONDIT
TLNE W1,NOTF
TRC TE,CONCMP/100
JRST @.(TE)
EXP IFZ26 ;=
EXP IFZ23 ;>
EXP IFZ24 ;NOT <
EXP IFZ23A
EXP IFZ25 ;NOT >
EXP IFZ27 ;NOT =
IFZ23: MOVE CH,[XWD JUMPG.+ASINC,AS.MSC] ; JUMPG AC, [177]
PUSHJ PP,PUT.XA ; ASSEMBLE IT [177]
HRRZI CH,AS.DOT+3 ; RH OF JUMPG .+3 [177]
PUSHJ PP,PUTASN ; ASSEMBLE IT [177]
MOVSI CH,JUMPN. ; JUMPN AC, [177]
MOVE TE,EAC ; GET AC [177]
DPB TE,CHAC ; PUT IN AC FIELD [177]
PUSHJ PP,JFLSEA ; JUMPN AC, FALSE [177]
MOVSI CH,JUMPE. ; JUMPE AC+1, [177]
AOSA EAC ; BUMP AC [177]
IFZ23A: MOVSI CH,JMPGE. ; FOR <, JUMPGE AC, [177]
IFZ23B: MOVE TE,EAC
DPB TE,CHAC
JRST JFLSEA
IFZ24: MOVE CH,[XWD JUMPG.+ASINC,AS.MSC] ; JUMPG AC. [177]
PUSHJ PP,PUT.XA ; ASSEMBLE IT [177]
HRRZI CH,AS.DOT+2 ; JUMPG AC,.+2 [177]
PUSHJ PP,PUTASN ; ASSEMBLE [177]
MOVSI CH,JUMPN. ; JUMPN AC+1, [177]
JRST IFZ23B ; FINISH UP [177]
IFZ25: MOVE CH,[XWD JUMPL.+ASINC,AS.MSC]
MOVE TE,EAC
DPB TE,CHAC
PUSHJ PP,PUTASY
HRRZI CH,AS.DOT+3
PUSHJ PP,PUTASN
IFZ26: MOVSI CH,JUMPN.
MOVE TE,EAC
DPB TE,CHAC
PUSHJ PP,JFLSEA
IFZ261: MOVE TE,EAC
ADDI TE,1
DPB TE,CHAC
JRST JFLSEA
IFZ27: MOVE CH,[XWD JUMPN.+ASINC,AS.MSC]
PUSHJ PP,PUT.XA
HRRZI CH,AS.DOT+2 ; .+2
PUSHJ PP,PUTASN
MOVSI CH,JUMPE.
JRST IFZ261
;GENERATE CODE TO COMPARE AN ALPHANUMERIC FIELD TO SPACES.
IFSPAC: MOVE TE,ESIZEA
MOVEM TE,ESIZEZ
SWOFF FASIGN;
MOVE TE,EMODEA
CAILE TE,DSMODE ;IF IT'S NOT SOME KIND OF
JRST BADFIG ; DISPLAY, IT'S AN ERROR.
HRRZ TD,IFSPCS(TE) ;GET SOME KIND OF SPACE.
IFN ANS74,<
SKIPE COLSEQ ;SPECIAL COLLATING SEQUENCE?
IFN BIS,<
JRST [XCT CSCHAR(TE) ;[720] YES, GET CONVERTED SPACE
HLRZ CH,IFSPCS(TE) ;[720] GET A ROUTINE'S EXTAB ADDRESS.
JRST .+2] ;[720] CAN NOT USE BIS INSTRUCTION
SETO CH, ;[720] BIS WILL USE EXTEND, NO ROUTINE
>
IFE BIS,<XCT CSCHAR(TE) ;[720] YES, GET CONVERTED SPACE
HLRZ CH,IFSPCS(TE) ;[720] GET A ROUTINE'S EXTAB ADDRESS.
>>
IFN ANS68,<
IFE BIS, HLRZ CH,IFSPCS(TE) ;[720] GET A ROUTINE'S EXTAB ADDRESS.
IFN BIS, SETO CH, ;[720] BIS WILL USE EXTEND, NO ROUTINE
>
MOVEM TD,ESAVAC
PUSHJ PP,SPECIL
POPJ PP, ;"CAM" GENERATED--EXIT
LDB TE,CONDIT
CAIE TE,EQ
CAIN TE,NOTEQ
JRST IFSP3
JRST IFQHV2
IFSP3:
IFN BIS,<
JUMPL CH,IFSP3A ;[717] IF GENERATING EXTEND SIZE DOES'NT MATTER
>
HRRZ TE,ESIZEA ;[717] GET LENGTH OF ITEM
SUBI TE,10 ;[717] TO GET REMAINDER OF 3777
IDIVI TE,3770 ;[717] FIND NUMBER OF PIECES TO BREAK IT INTO
ADDI TD,10 ;[717] AVOIDS REMAINDER OF 0
PUSH PP,TD ;[717] SAVE REMAINDER
MOVEM TE,ECNTA ;[717] SAVE COUNT OF LEADING PIECES
JUMPE TE,IFSP3C ;[717] ONLY ONE PIECE
IFSP3B: MOVEI TE,3770 ;[717] LENGTH OF FIRST PIECES IS CONSTANT
MOVEM TE,ESIZEA ;[717] ...
MOVEM TE,ESIZEZ ;[717] ...
PUSH PP,CH ;SAVE CONVERSION ROUTINE
PUSHJ PP,IFSP3A ;AND DO FIRST PART
POP PP,CH
MOVE TE,EMODEA ;GET MODE
MOVE TE,[EXP 3770/6,3770/5,3770/4](TE)
ADDM TE,EINCRA ;MOVE DOWN STRING
SOSLE ECNTA ;[717] DECREMENT PIECE COUNT
JRST IFSP3B ;[717] LOOP UNTIL STRING IS SMALL ENOUGH
IFSP3C: POP PP,TE ;[717] GET SIZE OF LAST PIECE
MOVEM TE,ESIZEA ;[717] RESTORE IT
MOVEM TE,ESIZEZ ;[717] ...
IFSP3A: TLZE W1,NOTF
TLC W1,CONCMP
PUSH PP,CH ;COULDN'T USE "CAM"
IFN BIS,<
;IF WE HAVE PUT -1 IN CH, USE EXTEND.
; ELSE, CH WILL CONTAIN AN EXTAB ADDRESS - USE OLD METHOD
JUMPGE CH,[PUSHJ PP,B1PAR ;NOT EXTEND, SETUP OPERAND OLD WAY
POP PP,CH ;RESTORE ROUTINE ADDR
JRST IFSP5] ;GO GEN PUSHJ
PUSHJ PP,NB1PAR##
>;END IFN BIS
IFE BIS, PUSHJ PP,B1PAR
POP PP,CH
IFN BIS, JRST BFIGCM ;GENERATE BIS COMPARISON, THEN "JRST FALSE"
IFSP5: TSWF FASUB; ;IS THE OPERAND SUBSCRIPTED?
SETZI EACC, ;YES, NOTE IT FOR PMOPV.
PUSHJ PP, PMOPV.## ;GO GENERATE
; HRRZI 16, PARM
; PUSHJ 17, RTN
IFSP6: SKIPLE ECNTA ;[717] ON LAST PIECE?
JRST JMPOUT ;[717] NO
MOVSI CH,SKIPA.
TLNN W1,EQUALF
PUSHJ PP,PUTASY
JRST JFALSE
BADFIG: MOVEI DW,E.211
MOVE TC,OPERND
MOVE TC,0(TC)
LDB LN,TCLN
LDB CP,TCCP
JRST FATAL
IFSPCS:: XWD SPAC%6##,0 ;DISPLAY-6 SPACE.
XWD SPAC%7##,40 ;DISPLAY-7 SPACE.
XWD SPAC%9##,100 ;DISPLAY-9 SPACE.
IFN ANS74,<
CSCHAR: HLRZ TD,PRGCOL##+240(TD) ;SIXBIT
HLRZ TD,PRGCOL(TD) ;ASCII
HRRZ TD,PRGCOL(TD) ;EBCDIC
>
IFN BIS,<
;HERE TO GENERATE BIS CODE TO
;COMPARE A STRING AGAINST A FIG. CONSTANT
; (ZEROES OR SPACES)
;CALL:
; <GEN CODE TO PUT BYTE PTR IN AC5>
; ESAVAC/ A CHARACTER OF FIG. CONSTANT IN THE CORRECT MODE
; GENERATES:
; EXTEND OR EQUIVALENT CODE
; JRST FALSE ;CONDITION (EQ,NOTEQ) NOT MET
BFIGCM: MOVE TE,ESIZEA ;IF SIZE IS 1
CAIN TE,1
JRST BFIGC1 ;DON'T USE EXTEND
MOVE CH,[MOVEI.+AC4+ASINC,,AS.CNB]
PUSHJ PP,PUTASY##
MOVE CH,ESIZEA
PUSHJ PP,PUTASN##
MOVE CH,[SETZB.+AC7,,10]
PUSHJ PP,PUTASY##
MOVE TA,[XTNLIT,,1]
PUSHJ PP,STASHP
MOVSI TA,(CMPSE)
TLNN W1,EQUALF
MOVSI TA,(CMPSN)
PUSHJ PP,STASHQ
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHP
SETZ TA,
PUSHJ PP,STASHQ
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHP
SETZ TA,
PUSHJ PP,STASHQ
MOVE TA,ESAVAC ;GET CHARACTER VALUE
PUSHJ PP,POOLIT ;THAT'S ALL!
PUSHJ PP,PUTASA## ;EXTEND, IN 2ND SET OF OPCODES
MOVSI CH,XTND.+AC4
PUSHJ PP,PUT.LD## ;GENERATE THE EXTEND
SKIPE PLITPC
JRST JFALSE ;"JRST FALSE"
MOVEI TE,3
ADDM TE,ELITPC## ;UPDATE ELITPC IF NOT POOLED
JRST JFALSE ;PUT OUT JUMP TO FALSE PATH
BFIGC1: MOVE CH,[ILDB.,,5]
PUSHJ PP,PUT.XA## ;GEN ILDB AC,5
;CAIE AC,"CHAR"
MOVSI CH,CAIE.
TLNN W1,EQUALF
MOVSI CH,CAIN.
HRR CH,ESAVAC##
PUSHJ PP,PUT.XA##
JRST JFALSE
>;END IFN BIS
;GENERATE CODE TO COMPARE A FIELD AGAINST QUOTES
IFQUOT:
IFN ANS68,<
TSWF FANUM ;IS "A" NUMERIC?
JRST BADFIG ;YES--ERROR
>
HRRZ TE, EMODEA ;SEE WHAT A'S
HRRZ TD, HIVQOT(TE) ;GET SOME KIND OF QUOTE.
IFN ANS74,<
SKIPE COLSEQ ;SPECIAL COLLATING SEQUENCE?
XCT CSCHAR(TE) ;YES, GET CONVERTED QUOTE
>
JRST IFQHV0 ;GO GENERATE SOME CODE.
;GENERATE CODE TO COMPARE A FIELD AGAINST HIGH-VALUES
IFHIV: HRRZ TE,EMODEA
CAILE TE, DSMODE ;IS A SOME KIND OF DISPLAY?
JRST IFHV1 ;NO, GO WORRY OVER NUMBERS.
HLRZ TD, HIVQOT(TE) ;GET SOME KIND OF HIGH VALUES.
JRST IFQHV0 ;GO GENERATE SOME CODE.
IFHV1: PUSHJ PP,HIVAL##
MOVE EACC,EHIVAL
IFHIV2: TSWT FAINAC ;IS "A" IN THE AC'S?
PUSHJ PP,MXAC. ;NO--GET IT THERE
HRRZ TE,EMODEA
CAIN TE,D2MODE
JRST IFHIV3
MOVE CH,[XWD CAM.+ASINC,AS.MSC]
LDB TE,CONDIT
ROT TE,-^D8
ADD CH,TE
PUSHJ PP,PUT.XA
HRRZ CH,EACC
PUSHJ PP,PUTASN
JRST JFALSE
INTERN HIVQOT ;[547] MAKE INTERN FOR MSCGEN
HIVQOT: XWD 77,2 ;DISPLAY-6 HIGH-VALUES, QUOTE.
XWD 177,42 ;DISPLAY-7 HIGH-VALUES, QUOTE.
XWD 377,177 ;DISPLAY-9 HIGH-VALUES, QUOTE.
;GENERATE CODE FOR 2-WORD COMPARE
IFHIV3: LDB TE,CONDIT
JRST @[EXP IFHV21,IFHV22,IFHV23,IFHV24,IFHV25,IFHV26]-1(TE)
;HERE FOR EQUAL OR NOTEQUAL
IFHV21: IFHV26:
MOVE CH,[CAMN.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,EACC
PUSHJ PP,PUTASN
MOVE CH,[CAME.+ASINC+AC1,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,EACC
ADDI CH,1
PUSHJ PP,PUTASN
MOVEI TC,AS.DOT+2
TLNN W1,EQUALF
PUSHJ PP,JOUT ;NOT EQUAL
JRST JFALSE
;HERE FOR LESS THAN OR LESS THAN OR EQUAL
IFHV24: IFHV25:
MOVE CH,[CAMGE.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,EACC
PUSHJ PP,PUTASN
MOVEI TC,AS.DOT+4
PUSHJ PP,JOUT
MOVE CH,[CAMG.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,EACC
PUSHJ PP,PUTASN
MOVE CH,[CAML.+ASINC+AC1,,AS.MSC]
TLNE W1,EQUALF
HRLI CH,CAMLE.+ASINC+AC1
IFHV20: PUSHJ PP,PUTASY
HRRZ CH,EACC
ADDI CH,1
PUSHJ PP,PUTASN
JRST JFALSE
;HERE FOR GREATER THAN OR GREATER THAN OR EQUAL
IFHV22: IFHV23:
MOVE CH,[CAMLE.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,EACC
PUSHJ PP,PUTASN
MOVEI TC,AS.DOT+4
PUSHJ PP,JOUT
MOVE CH,[CAML.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ CH,EACC
PUSHJ PP,PUTASN
MOVE CH,[CAMG.+ASINC+AC1,,AS.MSC]
TLNE W1,EQUALF
HRLI CH,CAMGE.+ASINC+AC1
JRST IFHV20
;GENERATE CODE TO COMPARE A FIELD AGAINST LOW-VALUES
IFLOV: HRRZ TE,EMODEA
SETZM ESAVAC
CAIG TE, DSMODE
JRST IFQHV1
CAIE TE,FPMODE
CAIN TE,F2MODE
JRST IFLOV2
PUSHJ PP,LOVAL##
MOVE EACC,ELOVAL
JRST IFHIV2
IFLOV2: PUSHJ PP,FPLOV.
MOVE EACC,EFPLOV
JRST IFHIV2
;GENERATE CODE TO COMPARE A DISPLAY FIELD AGAINST QUOTES OR HIGH-VALUES.
;EITHER A QUOTE OR A HI-VALUE IS IN TD.
IFQHV0: MOVEM TD,ESAVAC
;GENERATE CODE TO COMPARE A DISPLAY FIELD AGAINST QUOTES, HIGH-VALUES, OR
;LOW-VALUES.
;CHARACTER TO COMPARE AGAINST IS IN ESAVAC.
IFQHV1: PUSHJ PP,SPECIL
POPJ PP, ;"CAM" GENERATED--EXIT
IFQHV2: PUSHJ PP,SUBSCA
TSWF FASUB;
JRST IFQHV3
MOVE TA,[XWD BYTLIT,2]
PUSHJ PP,STASHP
PUSHJ PP,MBYTPA
PUSHJ PP,POOL
MOVE CH,[XWD MOV+ASINC+SAC,AS.MSC]
PUSHJ PP,PUTASY
SKIPN CH,PLITPC
HRRZ CH,ELITPC
IORI CH,AS.LIT
PUSHJ PP,PUTASN
SKIPN PLITPC
AOS ELITPC
IFQHV3: SETZM EAC
MOVSI CH,MOV## ;GENERATE <MOVEI 0,SIZE>
HRRZ TC,ESIZEA
PUSHJ PP,PUT.LA
PUSHJ PP,GETTAG
MOVEM CH,ESAVAC+1
PUSHJ PP,PUTTAG
MOVE CH,[XWD ILDB.+AC2,SXR]
PUSHJ PP,PUTASY
IFN ANS74,<
SKIPN COLSEQ ;SPECIAL?
JRST IFQHV4 ;NO
MOVE CH,[MOV+AC2+ASINC+2,,AS.MSC]
PUSHJ PP,PUTASY
HRRZ TC,EMODEA
MOVE CH,COLSQS(TC) ;GET LITERAL BASE
PUSHJ PP,PUTASN
IFQHV4:>
LDB TE,CONDIT
CAIE TE,EQ
JRST IFQHV5
SKIPN CH,ESAVAC ;GET COMPARE VALUE
JRST [MOVSI CH,JUMPN.+AC2 ;SIXBIT LOW-VALUES
PUSHJ PP,JFLSEA ;GENERATE JUMPN 2,FALSE
JRST IFQHV7]
HRLI CH,CAIE.+AC2
PUSHJ PP,PUTASY
PUSHJ PP,JFALSE
IFQHV7: HRRZ TA,ESAVAC+1 ;THIS IS A TAG WE ARE ABOUT TO REFERENCE
PUSHJ PP,REFTAG## ;SO REMEMBER THAT
MOVSI CH,SOJG.
HRR CH,ESAVAC+1
JRST PUTASY
;GENERATE CODE TO COMPARE A DISPLAY FIELD AGAINST QUOTES, ETC. (CONT'D)
;A "CAM" WOULDN'T DO, AND IT IS NOT "EQUALS".
IFQHV5: MOVSI CH,CAIN.+AC2 ;GENERATE: CAIN 2,<VALUE>
HRR CH,ESAVAC
PUSHJ PP,PUTASY
HRRZ TA,ESAVAC+1 ;GET TAG TO REFERENCE
PUSHJ PP,REFTAG## ; SO OPTIMIZER KNOWS
MOVSI CH,SOJG. ; SOJG 0,%X
HRR CH,ESAVAC+1
PUSHJ PP,PUTASY
LDB TE,CONDIT ;IS IT
CAIE TE,NOTEQ ; 'NOT EQUAL'?
JRST IFQHV6 ;NO
MOVSI CH,JMPLE. ; JUMPLE 0,<FALSE>
JRST JFLSEA
;A "CAM" WOULDN'T DO, AND IT NEITHER "EQUALS" NOR "NOT EQUALS".
IFQHV6: MOVSI CH,CAI.+AC2
ROT TE,-^D8
ADD CH,TE
HRR CH,ESAVAC
PUSHJ PP,PUTASY
JRST JFALSE
;COMPARE AC'S AGAINST "TODAY"
IFN ANS68,<
IFATDY: PUSHJ PP,PUTEMP
;COMPARE A FIELD AGAINST "TODAY"
IFTODY: MOVE CH,[XWD EPJPP,TODAY.##]
PUSHJ PP,PUTASY
MOVSI TE,^D36
MOVEM TE,EBASEB
SETZM TE,EINCRB
MOVEI TE,^D12
MOVEM TE,ESIZEB
SETZM EDPLB
MOVEI TE,D6MODE
MOVEM TE,EMODEB
SWON FBNUM;
TSWT FANUM;
JRST IFDD
PUSHJ PP,SWAPIT
PUSHJ PP,MXAC.T## ;SKIP CHECKING TO SEE IF A IS ALREADY IN
; THE AC'S WHEN WE GO TO MOVE IT THERE
; SINCE IT IS. THE ONLY PROBLEM IS IT
; IS DISPLAY-6 AND WE WANT IT TO BE COMP.
SWON FAINAC;
JRST IFGN0
>
;GENERATE CODE TO SEE IF A FIELD IS ALPHABETIC
IFALF: MOVE TE, EMODEA
CAILE TE, DSMODE ;IF IT'S NOT DISPLAY,
JRST IFNM3 ; IT'S AN ERROR.
HLRZ CH, ALFNUM(TE) ;GET THE ROUTINE'S EXTAB LINK.
TSWF FANUM ;IS IT NUMERIC?
JRST IFNM3 ;YES--ERROR
IFE BIS,< JRST IFNM2 ;NO>
IFN BIS,<
;GENERATE CODE TO DO EXTEND IN-LINE
PUSHJ PP, NB1PAR ;[550] GET BP TO PARAM IN AC5
MOVE TA, [OCTLIT,,1] ;GENERATE OCTAL LITERAL
PUSHJ PP, STASHP ; POOLED, TO HOLD AC4 CONTENTS
HRRZ TA, ESIZEA ;RH OF AC4 HAS SIZE
TLO TA, 400000 ;LH HAS SIGNIFICANCE BIT
PUSHJ PP, POOLIT ;GENERATE AND POOL LITERAL
HRLZI CH, MOV+AC4 ;NOW GENERATE MOVE AC4,LITERAL
PUSHJ PP, PUT.LD ;
SKIPN PLITPC ;BUMP LITERAL COUNT IF NOT POOLED
AOS ELITPC ;
;[550] PUSHJ PP, NB1PAR ;GET BP TO PARAM IN AC5
MOVE CH, [MOVEI.+AC7+ASINC,,AS.CNB] ;GENERATE MOVE OF
PUSHJ PP, PUTASY ;SIZE TO AC7 ALSO
HRRZ CH, ESIZEA ;HALF WORD SIZE ALLOWED
PUSHJ PP, PUTASN ;DONT INCR PC COUNT
MOVSI CH, MOVEI.+AC10 ;NOW GENERATE SETZ AC10,0
PUSHJ PP, PUTASY ;SO NOT TO GET DESTINATION STRING
MOVE TA, [XTNLIT,,1] ;GENERATE THE EXTEND INSTR
PUSHJ PP, STASHP ;POOLED IF POSSIBLE.
MOVE TA, EMODEA ;GET TABLE FOR EXTEND
MOVE TA, ALPS.T(TA) ;BY LOOKUP IN TABLE
IFE TOPS20,<
TSWF FREENT ;NO INDIRECT IF /R
>
IFN TOPS20,<
SKIPE RENSW## ;NO INDIRECT IF /R
>
TLZ TA, (@) ;SO TURN IT OFF
PUSHJ PP, POOLIT ;GENERATE LITERAL POOLED
PUSHJ PP, PUTASA ;EXTEND INSTR IS IN SECOND SET
MOVSI CH, XTND.##+AC4 ;
PUSHJ PP, PUT.LD ;OUTPUT USING LAST LITERAL (THE MOVST)
SKIPN PLITPC ;BUMP LITERAL COUNT IF NECESSARY
AOS ELITPC ;
PUSHJ PP, PUTASA
MOVE CH, [ERROR.##+AC17,,XTND.E##] ;ERROR IF EXTEND NOT SKIP
PUSHJ PP, PUT.EX ;
MOVE CH, [TLNE.+AC4+ASINC,,AS.CNB] ;GENERATE TEST BIT
TLNE W1, NOTF ;SKIP FOR "IF X IS ALPHABETIC"
MOVE CH, [TLNN.+AC4+ASINC,,AS.CNB] ;AS OPPOSED TO "IF X NOT ALPHABETIC"
PUSHJ PP, PUTASY ; INSTR TO SKIP IF TRUE
MOVEI CH, 100000 ;WE ARE TESTING THE M BIT
PUSHJ PP, PUTASN ;
JRST JFALSE ;GO TO FALSE BRANCH
ALPS.T: MOVST @ALPS.6## ;SIXBIT
MOVST @ALPS.7## ;SEVEN BIT
MOVST @ALPS.9## ;EBCDIC
> ;END IFN BIS
;GENERATE CODE TO SEE IF A FIELD IS NUMERIC
IFNUM: MOVE TE,EMODEA
CAIN TE,C3MODE ;COMP-3?
SETO TE, ;YES, MAKE INDEX VALID
CAILE TE,DSMODE ;IF IT'S NOT DISPLAY,
JRST IFNM4 ; IT'S ALWAYS NUMERIC, COMPLAIN.
HRRZ CH,ALFNUM(TE) ;GET THE ROUTINE'S EXTAB LINK.
MOVE TA,ETABLA
PUSHJ PP,LNKSET
LDB TE,DA.CLA
CAIN TE,ALPHAB
JRST IFNM3
IFNM2: MOVE TE,ESIZEA
MOVEM TE,ESIZEZ
JRST IFSP3
IFNM3: MOVEI DW,E.211
LDB LN,W1LN
LDB CP,W1CP
JRST FATAL
IFNM4: MOVEI DW,E.212
TLNE W1,NOTF
MOVEI DW,E.213
LDB LN,W1LN
LDB CP,W1CP
PUSHJ PP,WARN
TLNE W1,NOTF
JRST JFALSE
POPJ PP,
;EXTAB LINKS FOR ALPHABETIC AND NUMERIC ROUTINES.
EXP NUM%3## ;COMP-3
ALFNUM: XWD ALF%6##,NUM%6## ;DISPLAY-6.
XWD ALF%7##,NUM%7## ;DISPLAY-7.
XWD ALF%9##,NUM%9## ;DISPLAY-9.
;GENERATE CODE TO SEE IF A FIELD IS POSITIVE
IFPOS: MOVE TE,EMODEA
CAILE TE, DSMODE ;IF IT'S NOT DISPLAY, GO
JRST IFPOS3 ; DO A NUMERIC COMPARISON.
HLRZ CH, POSNEG(TE) ;SELECT THE ROUTINE'S EXTAB LINK.
IFPOS2: MOVE TA,ETABLA
PUSHJ PP,LNKSET
LDB TE,DA.CLA
CAIE TE,NUMERC
JRST IFNM3
JRST IFNM2
IFPOS3: TSWT FAINAC; ;IF THE OPERAND IS IN THE AC'S
CAIN TE, C3MODE ; OR IS COMP-3, GO USE A JUMP.
JRST IFPOS4
HRRZ TE,EMODEA
CAIN TE,D2MODE ;TWO-WORD?
JRST IFPO31 ;YES
PUSHJ PP,SUBSCA
MOVSI CH,SKIPG.
TLNE W1,NOTF
MOVSI CH,SKPLE.
PUSHJ PP,PUT.A
JRST JFALSE
; TWO-WORD COMP, TEST FOR POSITIVE OR NOT POSITIVE
; GENERATE SKIPL <DATA-NAME>
; SKIPG <DATA-NAME>+1
; FOR POSITIVE
; GENERATE SKIPG <DATA-NAME>
; SKIPLE <DATA-NAME>+1
; FOR NOT POSITIVE
IFPO31: PUSHJ PP,SUBSCD
MOVSI CH,SKIPL.
TLNE W1,NOTF
MOVSI CH,SKIPG.
PUSHJ PP,PUT.A
MOVSI CH,SKIPG.
TLNE W1,NOTF
MOVSI CH,SKPLE.
AOS EINCRA
PUSHJ PP,PUT.A
SOS EINCRA
JRST JFALSE
IFPOS4: TSWTS FAINAC; ;IF THE OPERAND ISN'T IN THE
PUSHJ PP, MOVXAC ; [413] AC'S, GO GET IT THERE.
HRRZ TE,EMODEA
CAIE TE,D2MODE
JRST IFPO41 ;ONE-WORD
MOVE CH,[XWD JUMPG.+ASINC,AS.MSC]
TLNE W1,NOTF
MOVE CH,[XWD JUMPL.+ASINC,AS.MSC]
PUSHJ PP,PUT.XB
HRRZI CH,AS.DOT+2
PUSHJ PP,PUTASN
TLNN W1,NOTF
JRST IFPO41
MOVSI CH,JUMPG.
MOVE TE,EAC
ADDI TE,1
DPB TE,CHAC
PUSHJ PP,JFLSEA
IFPO41: MOVSI CH,JMPLE.
TLNE W1,NOTF
MOVSI CH,JUMPG.
IFPOS5: MOVE TE,EAC
DPB TE,CHAC
JRST JFLSEA
;GENERATE CODE TO SEE IT A FIELD IS NEGATIVE
IFNEG: MOVE TE,EMODEA
CAILE TE, DSMODE ;IF IT'S NOT DISPLAY, GO
JRST IFNEG2 ; DO A NUMERIC COMPARISON.
HRRZ CH, POSNEG(TE) ;SELECT THE APPROPRIATE ROUTINE.
JRST IFPOS2
IFNEG2: TSWT FAINAC; ;IF THE OPERAND IS IN THE AC'S
CAIN TE, C3MODE ; OR IS COMP-3, GO USE A JUMP.
JRST IFNEG4
PUSHJ PP,SUBSCA
MOVSI CH,SKIPL.
TLNE W1,NOTF
MOVSI CH,SKPGE.
PUSHJ PP,PUT.A
JRST JFALSE
IFNEG4: TSWTS FAINAC; ;IF THE OPERAND ISN'T IN THE
PUSHJ PP, MOVXAC ; [413] AC'S, GO GET IT THERE.
MOVSI CH,JMPGE.
TLNE W1,NOTF
MOVSI CH,JUMPL.
JRST IFPOS5
;EXTAB LINKS FOR THE POSITIVE AND NEGATIVE ROUTINES.
POSNEG: XWD POS%6##,NEG%6## ;DISPLAY-6.
XWD POS%7##,NEG%7## ;DISPLAY-7.
XWD POS%9##,NEG%9## ;DISPLAY-9.
IFN DBMS,<
;GENERATE CODE FOR "IFDB" OPERATOR
IFDBGN: CAMN EACA,EOPLOC ;ANY OPERANDS?
POPJ PP, ;NO, MUST BE A "YECCH"
;PUT "SET-NAME" IN LITERAL POOL
HRRZ CH,ELITPC ;GET LIT LOC
IORI CH,AS.LIT
HRRZM CH,LITNN## ; [437] STORE FOR USE IN BYTE STRING DESCRIPTOR
HRRZ TA,EOPLOC ;GET OPERAND
HRRZ TA,2(TA)
PUSHJ PP,LNKSET ;GET ITS VALTAB ADDR
HRRZI TD,(TA) ;MAKE BYTE PTR FOR ILDB LOOP
MOVE TB,[POINT 7,(TD)]
ILDB TC,TB ;GET BYTE COUNT FROM 1ST VALTAB BYTE
HRLM TC,LITNN ; [437] SAVE FOR USE IN BYTE STRING DESCRIPTOR
MOVEI TE,5(TC) ;CONVERT BYTE COUNT TO WORD COUNT
MOVEI TA,6 ;[273]SIX SIXBIT BYTES PER WORD
IDIVM TE,TA
PUSH PP,TA ;SAVE LITERAL INCREMENT
HRLI TA,SIXLIT## ;PUT OUT "SIXLIT,,WORD-COUNT" HEADER
PUSHJ PP,STASHI
POP PP,TA
ADDM TA,ELITPC ;BUMP LITERAL POOL PC
IFDB0: SETZ TA, ;INIT FOR ACCUMULATION OF A SIXBIT WORD
MOVE TE,[POINT 6,TA]
IFDB1: SOJL TC,IFDB2 ;CHECK BYTE COUNT
ILDB CH,TB ;GET VALTAB BYTE
SUBI CH,40 ;CONVERT TO SIXBIT
IDPB CH,TE
TRNN TA,77 ;TA FULL?
JRST IFDB1 ;NO
IFDB2: JUMPE TA,IFDB3 ;ANY REMAINDER?
PUSHJ PP,STASHL ;YES, OUTPUT IT
JRST IFDB0
;PUT BYTE STRING DESCRIPTOR IN LITERAL POOL
IFDB3: MOVE TA,[BYTLIT,,2] ;PUT OUT BYTE PTR TO "SET-NAME"
PUSHJ PP,STASHI
HRRZI TA,AS.MSC
PUSHJ PP,STASHL
HRRZ TA,LITNN ; [437] GET BACK BYTE STRING'S ADDR
HRLI TA,(POINT 6,)
PUSHJ PP,STASHL
AOS ELITPC
MOVE TA,[XWDLIT,,2] ;PUT OUT BYTE COUNT
PUSHJ PP,STASHI
MOVEI TA,AS.CNB ;LEFT HF = 0
PUSHJ PP,STASHL
HLLZ TA,LITNN ; [437] RIGHT = BYTE COUNT
HRRI TA,AS.CNB
PUSHJ PP,STASHL
HRRZ CH,ELITPC ;REMEMBER ADDR OF BYTE STRING DESC.
SUBI CH,1 ;BACK UP TO IT
HRRZM CH,LITNN ; [437] SAVE BYTE STRING LITERAL LOCATION
AOS ELITPC ;BUMP LIT POOL PC
;PUT ARG LIST IN LITERAL POOL
MOVE TA,[OCTLIT,,1] ;PUT OUT ARG COUNT WORD
PUSHJ PP,STASHI
MOVSI TA,-2
PUSHJ PP,STASHL
AOS CH,ELITPC ;BUMP PC OVER ARG COUNT
IORI CH,AS.LIT
HRLM CH,LITNN ; [437] REMEMBER ARG LIST ADDR
MOVE TA,[XWDLIT,,2] ;1ST ARG = BYTE STRING DESCRIPTOR ADDR
PUSHJ PP,STASHI
HRLZI TA,(ARGBSD) ;LEFT HF = ARG TYPE
HRRI TA,AS.CNB
PUSHJ PP,STASHL
HRLZ TA,LITNN ; [437] GET ADDR OF BYTE STRING DESC.
TLO TA,AS.LIT
HRRI TA,AS.MSC
PUSHJ PP,STASHL
AOS ELITPC ;BUMP LIT PC
;GET A WORD IN %PARAMS FOR DBCS ROUTINE RETURN VALUE
HRRZ TB,EAS1PC## ;GET DATA PC
AOS EAS1PC
HRRM TB,LITNN ; [437] REMEMBER RET-VALUE ADDR
PUSHJ PP,PUTOC0## ;[372] SET %PARAM TO ZERO
;PUT PTR TO RETURN VALUE LOC IN ARG LIST
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHI
HRLZI TA,(ARG1WB) ;LEFT HF = ARG TYPE
HRRI TA,AS.CNB
PUSHJ PP,STASHL
HRLZI TA,(TB) ;RT HF = ADDR OF RET-VALUE
TLO TA,AS.PAR##
HRRI TA,AS.MSC
PUSHJ PP,STASHL
AOS ELITPC
;PUT OUT DBCS SUBROUTINE CALL
; IF SET EMPTY = PUSHJ 17,SETCON
; IF REC MEMBER = PUSHJ 17,RECMEM
; IF REC OWNER = PUSHJ 17,RECOWN
; IF REC MEM/OWN = PUSHJ 17,RECMO
MOVE CH,[ASINC+AC16+MOVEI.,,AS.MSC]
PUSHJ PP,PUTASY ;"MOVEI 16,ARG-LIST"
HLRZ CH,LITNN ; [437] GET ARG LIST ADDR
PUSHJ PP,PUTASN
SETZ TB, ;FIND OUT WHICH DBCS ROUTINE TO CALL
TLNE W1,(GWFL10)
MOVEI TB,1
TLNE W1,(GWFL11)
MOVEI TB,2
TLNE W1,(GWFL12)
MOVEI TB,3
HRRZ CH,IFDBCS(TB) ;GET SELECTED NAME
ANDI CH,77777 ;SET ASSEMBLY EXTAB FLAG
IORI CH,AS.EXT##
PUSHJ PP,GNPSX.## ; [436] "PUSHJ 17,DBCS-ROUTINE"
;NOW TEST RESULT OF SUBROUTINE CALL
MOVE CH,[ASINC+SKIPN.,,AS.MSC] ;ASSUME NOT NOT
TLNE W1,(GWFL15) ;'NOT' FLAG ON?
HRLI CH,ASINC+SKIPE. ;YES
PUSHJ PP,PUTASY
HRRZ CH,LITNN ; [437] GET BACK ADDR OF RET-VALUE LOC
HRLI CH,AS.MSC ;[160]MAKE IT INTO ASY FORMAT
TRO CH,AS.PAR ;[160]PUT IT INTO %PARAMS AREA
PUSHJ PP,PUTASN ;"SKIPN(E) RET-VALUE"
JRST JFALSE ;"JRST FALSE-PATH"
;THEN RETURN TO COBOLE
;EXTAB ADDRESSES OF DBCS ROUTINES
IFDBCS: EXP SETCON##
EXP RECMEM##
EXP RECOWN##
EXP RECMO##
>;END IFN DBMS
;CHECK TO SEE IF A DISPLAY COMPARISON COULD BE A "CAM" COMPARE.
;TRUE IF FIELD IS WORD-CONTAINED.
;ENTER WITH COMPARISON CONSTANT IN "ESAVAC"
;IF FALSE - EXIT TO CALL+2.
;IF TRUE - GENERATE A "CAM" TYPE COMPARISON AND EXIT TO CALL+1.
SPECIL: TSWF FASUB;
JRST CPOPJ1
HLRZ TC,ERESA ;GET RESIDUE OF "A"
MOVE TB,ESIZEA ;AND IT'S SIZE
HRRZ TD,EMODEA ;AND IT'S USAGE
IFN ANS74,<
SKIPN COLSEQ## ;SPECIAL COLLATING SEQUENCE
JRST SPECL0 ;NO
CAIE TB,1 ;YES, 1 CHAR. IS OK
JRST CPOPJ1 ;FAILED
PUSH PP,EAC ;SAVE AC INCASE 0
SKIPN EAC ;IF SO
AOS EAC ;USE 1
SPECL0:
>
IMUL TB,BYTE.S(TD) ;COMPUTE SIZE IN BITS
SUB TC,TB ;SUBTRACT THAT FROM RESIDUE
JUMPL TC,CPOPJ1 ;IS "A" WORD-CONTAINED?
CAIN TB,^D36 ;YES--IS IT A FULL WORD?
JRST SPECL1 ;YES
LSH TC,6 ;NO--NEW RESIDUE IS IN "TC"
ADD TB,TC ;NOW RESIDUE AND FIELD SIZE ARE IN "TB"
MOVE TA,[XWD BYTLIT,2];CREATE BYTE POINTER IN LITAB
PUSHJ PP,STASHP
HRRZ TA,EBASEA
PUSHJ PP,STASHQ
LSHC TB,-14
HRR TA,EINCRA
PUSHJ PP,POOLIT
MOVSI CH,LDB.
PUSHJ PP,PUT.LC
SKIPN PLITPC
AOS ELITPC
IFN ANS74,<
SKIPN COLSEQ ;SPECIAL?
JRST SPECL2 ;NO
HRLZ CH,EAC ;INDEX BY NEW ACC
IOR CH,[MOV+ASINC,,AS.MSC]
POP PP,EAC ;ORIGINAL ACC
PUSHJ PP,PUT.XA ;WRITE IT OUT
MOVE TC,EMODEA ;GET USAGE
MOVE CH,COLSQS##(TC) ;GET LITERAL BASE
PUSHJ PP,PUTASN
>
JRST SPECL2
SPECL1: PUSHJ PP,SUBSCA
MOVSI CH,MOV
PUSHJ PP,PUT.AA
;[562] NOW WE MUST TEST FOR 6-CHAR SIXBIT ITEM SINCE SIGN GETS IN THE WAY
MOVE TA,ESIZEA ;[562] GET SIZE
HRRZ TC,EMODEA ;[562] GET MODE
CAIN TA,6 ;[562] 6 CHAR?
CAIE TC,D6MODE ;[562] AND SIXBIT?
JRST SPECL2 ;[562] NO
LDB TE,CONDIT ;[562] GET CONDITION
CAIE TE,EQ ;[562] EQUAL
CAIN TE,NOTEQ ;[562] AND NOT EQUAL
JRST SPECL2 ;[562] ARE OK
PUSHJ PP,PUTASA## ;[630] [562] NEED OTHER OPCODE SET
MOVE CH,[TLC.##+ASINC,,AS.CNB] ;[562]
PUSHJ PP,PUT.XA ;[562] COMPLIMENT
MOVEI CH,400000 ;[562] THE HIGH ORDER BIT
PUSHJ PP,PUTASN ;[562]
;[562] COPY THE CODE AT SPECL2 THRU SPECL4
MOVE TA,ESIZEA ;[562] CREATE NEW CONSTANT
MOVE TB,ESAVAC ;[562]
HRRZ TC,EMODEA ;[562]
MOVE TC,BYTE.S(TC) ;[562]
SPECL7: LSH TB,0(TC) ;[562]
IORM TB,ESAVAC ;[562]
SOJG TA,SPECL7 ;[562]
MOVSI TA,(1B0) ;[562] COMPLIMEMT THE CONSTANT
XORM TA,ESAVAC ;[562]
JRST SPECL4 ;[562]
;TRY FOR "CAM" COMPARISON FOR DISPLAY FIELD (CONT'D).
;ITEM IS IN AC'S NOW.
SPECL2: MOVE TA,ESIZEA ;CREATE NEW CONSTANT
MOVE TB,ESAVAC
HRRZ TC,EMODEA
MOVE TC,BYTE.S(TC)
SOJLE TA,SPECL4
SPECL3: LSH TB,0(TC)
IORM TB,ESAVAC
SOJG TA,SPECL3
SPECL4: SKIPN TC,ESAVAC
JRST IFZ21 ;USE JUMPX INSTEAD
TLNE TC,-1
JRST SPECL5
MOVSI CH,CAM.
LDB TE,CONDIT
TLNE W1,NOTF
TRC TE,CONCMP/100
ROT TE,-^D8
ADD CH,TE
PUSHJ PP,PUT.LA
JRST JFALSE
SPECL5: MOVE TA,[XWD OCTLIT,1]
PUSHJ PP,STASHP
MOVE TA,TC
PUSHJ PP,POOLIT
MOVSI CH,CAM.
LDB TE,CONDIT
TLNE W1,NOTF
TRC TE,CONCMP/100
ROT TE,-^D8
ADD CH,TE
PUSHJ PP,PUT.LC
SKIPN PLITPC
AOS ELITPC
; JRST JFALSE ;FALL THRU
;PUT OUT <JRST %NNNNN> ;WHERE %NNNNN IS "ELSE" PATH.
JFALSE: MOVSI CH,JRST.
JFLSEA: HLR CH,W2
ANDCMI CH,7B20
IORI CH,AS.TAG
SKIPN IFEAC ;NEED TO RESET EAC?
JRST JFLSEC ;NO
EXCH CH,IFEAC ;GET VALUE, SAVE ACC
HRRZM CH,EAC ;RESET INCASE "B" LOADED ACCS
MOVE CH,IFEAC ;RESTORE
SETZM IFEAC ;DONE
JFLSEC: HRRZ TA,CH
PUSHJ PP,REFTAG##
JRST PUTASY ;"JRST %NN"
;PUT OUT <JRST .+N> IF "EQUAL" FLAG OFF, <JRST .+N-1> IF "EQUAL"
;FLAG IS ON. ENTER WITH "N" IN ACCUMULATOR "TC".
;SKIP ONE INSTRUCTION UPON RETURN FROM JTRUES, BUT NOT FROM JTRUE.
JTRUES: AOS (PP)
JTRUE: SKIPN CH,IFEAC ;NEED TO RESET EAC?
JRST JTRUE1 ;NO
HRRZM CH,EAC ;YES
SETZM IFEAC
JTRUE1: SKIPE CH,TAGTRU ;ANY TAG FOR TRUE PATH?
JRST JFLSEC ;YES--PUT OUT <JRST %TAG>
HRRZI TC,AS.DOT(TC)
TLNN W1,EQUALF ;TRUE IF EQUAL?
JRST JOUT ;NO
SOJA TC,JOUT ;YES
;[717] PUT OUT "JRST FALSE" OR "JRST TRUE" DEPENDING ON ECNTA
JMPOUT: SKIPG TC,ECNTA ;[717] GET COUNT OF PIECES LEFT
JRST JFALSE ;[717] LAST PIECE
IMULI TC,4 ;[717] MULT. BY 4
AOJA TC,JTRUE ;[717] ADD ONE, AND GENERATE JRST TO TRUE PATH
;PUT OUT THE THREE INSTRUCTION FOR LESS,GREATER,EQUAL
ADDRS3: MOVEI TC,3
TLNE W1,LESSF
PUSHJ PP,JTRUES
PUSHJ PP,JFALSE
MOVEI TC,2
TLNE W1,GREATF
PUSHJ PP,JTRUES
PUSHJ PP,JFALSE
TLNN W1,EQUALF
JRST JFALSE
POPJ PP,
;COUNT THE NUMBER OF OPERANDS FOR "IF".
;IF < 2 OR > 3, ERROR.
;IF 2, RETURN.
;IF 3, THROW AWAY ALL BUT SECOND AND THIRD AND THEN RETURN.
MAK2OP: MOVEM EACA,EOPNXT
HRRZ TA,EOPLOC
ADDI TA,1
MOVEM TA,CUREOP
PUSHJ PP,BMPEOP ;IS THERE AT LEAST 2?
JRST OPCHK1 ;NO--ERROR
AOS TB,CUREOP ;YES--TB_LOCATION OF SECOND ONE
PUSHJ PP,BMPEOP ;MORE THAN 2?
JRST OPCHK3 ;NO--GO HOME
AOS CUREOP
OPCHK2: PUSHJ PP,BMPEOP
AOSA TC,CUREOP
JRST OPCHK1
OPCHK4: SUBI TC,0(TB)
ADDI TC,-1(TA)
MOVSS TB
HRRI TB,0(TA)
BLT TB,0(TC)
SUB TC,EOPLOC
HRLS TC
ADD TC,EOPLOC
MOVE EACA,TC
OPCHK3: MOVEM EACA,EOPNXT
MOVEM TA,CUREOP
POPJ PP,
OPCHK1: SWON FERROR;
POPJ PP,
;COUNT NUMBER OF OPERANDS FOR "IFT".
;IF 1, RETURN.
;IF >1, THROW AWAY ALL BUT LAST ONE.
MAK1OP: MOVEM EACA,EOPNXT
HRRZ TA,EOPLOC
ADDI TA,1
MOVEM TA,CUREOP
CAIL TA,(EACA) ;IF NO OPERANDS,
SWONS FERROR ; TROUBLE
PUSHJ PP,BMPEOP ;ONLY 1?
JRST OPCHK3 ;YES--WE'RE DONE
MAK1A: AOS TB,CUREOP
PUSHJ PP,BMPEOP ;ANY MORE?
AOSA TC,CUREOP ;NO
JRST MAK1A ;LOOP
JRST OPCHK4
;SET "A" PARAMETERS TO SHOW THAT IT IS IN AC'S
SETBCX: MOVE TE,EAC
MOVEM TE,EBASEA
SETZM EINCRA
PUSHJ PP,SWAPIT
SWOFF FBSUB;
SWON FBSIGN;
SKIPE EAC
TDCA TE,TE
MOVEI TE,2
MOVEM TE,EAC
POPJ PP,
;SWAP OPERANDS
SWAPIT: PUSHJ PP,SWAPAB
LDB TE,CONDIT ;IS CONDITION "EQUAL"?
CAIE TE,EQ
CAIN TE,NOTEQ ;NO--"UNEQUAL"?
CAIA
TLC W1,GLCMP ;NO--COMPLEMENT THE CONDITION
POPJ PP,
;CHECK TO SEE IF AN ITEM IS EDITED.
;IF SO, USE EXTERNAL SIZE.
SETED: PUSHJ PP,SETOPN ;SET UP PARAMETERS
HRRZ TE,EMODEX(LN) ;IS IT DISPLAY?
CAILE TE,DSMODE
POPJ PP, ;NO--RETURN
MOVE TC,CUREOP ;YES--GET DATAB FLAG WORD
HRRZ TA,1(TC)
PUSHJ PP,LNKSET
LDB TC,DA.EDT ;IS IT EDITED?
JUMPE TC,CPOPJ ;NO
LDB TE,DA.EXS ;YES--GET EXTERNAL SIZE
MOVEM TE,ESIZEX(LN)
POPJ PP,
; CALL TO MOVGEN TO MOVE "A" INTO ACS
; IF THE OPERAND IS NEGATED THEN MOVE ITS NEGATED VALUE INTO ACS
; MOVE 1-COMP INTO ACS
MOVC1: HLRZ TE,OPERND ; [413] GET "A" OPERAND
LDB TE,EOPSGN ; [413] SEE IF NEGATED
JUMPN TE,MNXAC.## ; [413] NEGATE IT
JRST M1CAC.## ; [413] NOT NEGATED
; MOVE ANY TYPE INTO ACS
MOVXAC: HLRZ TE,OPERND ; [413] GET "A" OPERAND
LDB TE,EOPSGN ; [413] SEE IF NEGATED
JUMPN TE,MNXAC.## ; [413] NEGATE IT
JRST MXAC.## ; [413] NOT NEGATED
;IMPROPER CONDITIONS
BADIF: TTCALL 3,[ASCIZ /BAD "IF" FLAGS
/]
JRST KILLF
BADCOD: TTCALL 3,[ASCIZ /BAD "IF" USAGE
/]
POPJ PP,
BADIFT: TTCALL 3,[ASCIZ /BAD "IFT" FLAGS
/]
JRST KILLF
;GENERATE CODE FOR "ELSE"
ELSEGN: JRST KILLF ;SHOULD NEVER GET HERE
NUMERC==2 ;NUMERIC USAGE
ALPHAB==1 ;ALPHABETIC USAGE
GNENDS==1B27 ;"END SPIF" FLAG IN OPERATOR
LESSF==1B27 ;"LESS" FLAG IN CONDITIONAL OPERATOR
GREATF==1B28 ;"GREATER" FLAG IN CONDITIONAL OPERATOR
EQUALF==1B29 ;"EQUAL" FLAG IN CONDITIONAL OPERATOR
CONCMP==EQUALF!LESSF!GREATF
GLCMP==LESSF!GREATF
GOFALS==1B32 ;"FALSE" OR "TRUE" FLAG IN "IF" OPERATOR
NOTF==1B33 ;"NOT" FLAG IN CONDITIONAL
SWITCH==3B<^D18+^D10> ;"THIS IS FOR HARDWARE-SWITCH" FLAGS IN W1
SWCHON==1B<^D18+^D9> ;"TEST FOR HARDWARE SWITCH ON" FLAG IN W1
CRANGE==1B18 ;"RANGE" FLAG IN CONTAB ENTRY
CNFIGC==1B19 ;"FIG. CONST." FLAG IN CONTAB
EQ==EQUALF/1B29
NOTEQ==<LESSF!GREATF>/1B29
GR==GREATF/1B29
NOTGR==<LESSF!EQUALF>/1B29
LS==LESSF/1B29
NOTLS==<EQUALF!GREATF>/1B29
CONDIT: POINT 3,W1,11 ;CONDITIONAL FLAGS
CALLSW: XWD CALLI.,20 ;INSTRUCTION WHICH READ HARDWARE SWITCHES
SWNUM: POINT 6,1(TA),35 ;LOCATION OF SWITCH NUMBER IN MNETAB ENTRY
MNESF: POINT 2,1(TA),2 ;LOCATION OF "ON" & "OFF" FLAGS IN MNETAB
W1SF: POINT 2,W1,10 ;LIKEWISE FOR OPERATOR
EOPSGN: POINT 1,1(TE),6 ; [413] NEGATED OPERAND BY NEGEOP SW IN EXPGEN
EXTERNAL LMASKS,TB.DAT,TB.MNE,ATINVK
EXTERNAL XWDLIT,BYTLIT,D1LIT,D2LIT,OCTLIT,XTNLIT
EXTERNAL EINTO,ENDIFT,W1LN,W1CP,TCLN,TCCP
EXTERNAL ECTRUE,ECFALS,ECNAME,ECNBP,ECXTRA,ECSTEP,EREMAN,TAGTRU,ECNTA
EXTERNAL EOPLOC,EOPNXT,CUREOP,OPLINE,EHIVAL,ELOVAL,EFPLOV,EMULSZ
EXTERNAL AS.MSC,AS.TAG,AS.CNB,AS.DOT,AS.LIT,SZERA.,EPJPP
EXTERNAL EBASEA,EINCRA,ESIZEA,EDPLA,EMODEA,ERESA,EBYTEA,EFLAGA,ETABLA
EXTERNAL EBASEB,EINCRB,ESIZEB,EDPLB,EMODEB,ERESB,EBYTEB,EFLAGB,ETABLB
EXTERNAL EBASEX,EINCRX,ESIZEX,EDPLX,EMODEX,ERESX,EBYTEX,EFLAGX,ETABLX
EXTERNAL ESAVEA,ESAVEB,ESAVAX,ESAVBX,EBASAX,EBASBX
EXTERNAL ESIZEZ,EAC,BYTE.W,ELITPC,OPERND,BYTE.S,ESAVAC,ESZERA,MAXSIZ
EXTERNAL ELITLO,ELITHI,POWR10,DPWR10,EWORDB,CHAC
EXTERNAL D1MODE,D2MODE,D6MODE,D7MODE,DSMODE,FPMODE,F2MODE,C3MODE,FCMODE,LTMODE,D4MODE
EXTERNAL SKIP.,SKIPE.,SKIPN.,SKIPA.,SKIPG.,SKIPL.,SKPGE.,SKPLE.,JRST.
EXTERNAL JUMP.,JUMPE.,JUMPL.,JUMPN.,JUMPG.,JMPLE.,JMPGE.
EXTERNAL CAME.,CAMN.,CAML.,CAMLE.,CAMG.,CAMGE.,XTND.,HRRZ.
EXTERNAL MOVM.,MOVEM.,MUL.,MULI.,IMUL.,HRRZI.,SETZB.
EXTERNAL CMP.
EXTERNAL HRLOI.,LDB.,ILDB.,CAI.,CAM.,MOVEI.,CAIE.,CAIN.,SOJG.
EXTERNAL TLNN.,TRNN.,TLNE.,TRNE.,TLO.,CALLI.,MOV
EXTERNAL DA.CLA,DA.EDT,DA.EXS
END