Trailing-Edge
-
PDP-10 Archives
-
cobol12c
-
ifgen.mac
There are 22 other files named ifgen.mac in the archive. Click here to see a list.
; UPD ID= 3515 on 5/5/81 at 4:06 PM by NIXON
TITLE IFGEN FOR COBOL V12C
SUBTTL CODE GENERATORS FOR ALL "IF" OPERATORS AL BLACKINGTON/CAM
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH P
%%P==:%%P
DBMS==:DBMS
IFN TOPS20,< SEARCH MONSYM,MACSYM>
IFE TOPS20,< SEARCH MACTEN,UUOSYM>
;EDITS
;NAME DATE COMMENTS
;[1457] IF SET-NAME SET GENERATED LITERAL CONTAINS GARBAGE
;[1416] 68274 Generate warning if size of literal and data item not the same.
;[1404] If LITTAB is expanded, update byte pointer to literal.
;[1374] Check coll. seq. when generating high-values
;[1353] If literal generated by call to LITD. too large, FERROR set to force
; exit
;[1351] STORE READ .. INTO OPERANDS IN A FIXED LOCATION - AVOID LINK FAILURES
;[1317] FIX COBOL-74 COMPARE NUMERIC TO NON-NUMERIC ITEMS
;V12B****************
;[1067] FIX COBOL-74 COMPARE NUMERIC TO NON-NUMERIC ITEMS
;[1060] FIX IF DATA-ITEM = ZEROES FOR FIELD GREATER THAN 2040 CHARACTERS
;[1057] GIVE ERROR ON ILLEGAL USE OF ALL IN NUMERIC COMPARISONS.
;[1040] FIX NON-BIS CASE OF EDIT 1034; "IF ..NOT SPACES" DIDN'T WORK
;[1037] FIX ?ASSEMBLY ERRORS WHEN DEP. VAR. ON "READ..INTO" AND COMP ITEM
;[1034] MAKE IF = ZERO TEST GENERATE INLINE CODE, FIXES LARGE RECORD PROBLEM.
;[1027] BUILD RECORD NAME TABLE IF NESTED READS
;[1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;V12A****************
;[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*****************
;[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*****************
;[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
;[322] FIX "IF CONDITION" SO THAT AN ERROR IN PREVIOUS STATMENT DOES NOT CAUSE A COMPILER ERROR MESSAGE
;[217] /ACK FIX FATAL DIAG PRODUCED IN A VALID PROGRAM.
;[174] FIXES D.P. COMPARES WITH ZERO FOR >, AND NOT <
;[170-A] FIXES EDIT 170
;[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).
;[154] FIXES DOUBLE PRECISION COMPARES AND ALSO SIGN PROBLEMS.
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
ENTRY ENDIFG ;"ENDIF" OPERATOR
ENTRY SPIFGN ;"SPIF" OPERATOR
ENTRY IFCGEN ;"IFC" OPERATOR
ENTRY IFTGEN ;"IFT" OPERATOR
ENTRY IFGEN ;"IF" OPERATOR
ENTRY IFUGEN ;"IF" OPERATOR IN PERFORM VARYING UNTIL CASE
ENTRY ELSEGN ;"ELSE" OPERATOR
ENTRY IFGNZC ;ENTRY POINT FOR RPWGEN & SEARCH
ENTRY IFPOS ;ENTRY POINT FOR SEARCH
IFN DBMS,<ENTRY IFDBGN> ;"IFDB" OPERATOR
INTERN IFZROS ;VALUES OF ZERO CHARACTER IN SIXBIT, ASCII, AND EBCDIC
INTERN IFSPCS ;VALUE OF SPACE CHARACTER IN SIXBIT, ASCII, AND EBCDIC
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
IFUGEN:
IFN ANS74,<
SETOM INPERF## ;SIGNAL WE ARE IN PERFORM CONTROL
>
IFGEN: MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANYTHING IN EOPTAB?
POPJ PP, ;NO--WE MUST HAVE HAD A YECCH
IFN ANS74,<
MOVE TC,OPLINE ;SAVE W1 (LN & CP) OF PREVIOUS OPERATOR
MOVEM TC,EXPLNC## ;FOR FIPS FLAGGER
>
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
IFN ANS74,<
MOVE TC,CURXSQ ;COPY CURRENT SEQ #
MOVEM TC,LSTXSQ ;TO LAST FOR FIPS FLAGGER
>
JRST COMEBK
;"IFT" GENERATOR
IFTGEN: SETZM TAGTRU
MOVE EACA,EOPNXT
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
MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST IFCSW7 ;NO--MUST BE "IF SWITCH"
SWOFF FEOFF1 ; [322] TURN OFF ALL ERROR INDICATORS
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"
IFN ANS68,<
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
>
IFN ANS74,<
MOVSI CH,MOVEI.+AC16
HRR CH,TC ;GENERATE <MOVEI 16,SWITCH>
PUSHJ PP,PUTASY
MOVEI CH,SWT.ON##
TLNE W1,NOTF ;SEE IF SWITCH SHOULD BE OFF OR ON
MOVEI CH,SWT.OF##
PUSHJ PP,PUT.PJ ;GENERATE <PUSHJ 17,SWT.ON/SWT.OF>
>
JRST JFALSE ;PUT OUT <JRST FALSE> AND RETURN
IFN ANS68,<
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
IFN ANS74,<
PUSHJ PP,CDEBAB## ;STORE "A" AND "B" OPERANDS
PUSHJ PP,GDEBV## ;OUTPUT THEM PLUS ALL PREVIOUS EXPRESSIONS
SETZM INPERF ;CLEAR CONTROL FLAG NOW
>
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
IFN ANS68,<
CAILE TB,DSMODE ;NO--IS "B" DISPLAY?
JRST NOTNMA ;NO--ERROR
JRST IFDD ;YES
>
IFN ANS74,<
CAIG TB,DSMODE ;IS "B" DISPLAY?
TSWF FBSIGN ;YES, BUT NOT SIGNED?
CAIA
JRST IFDD ;YES
PUSHJ PP,SWAPIT ;SWAP OPERANDS (and the CONDITION).
JRST IFKAD ;MOVE IT TO UNSIGNED DISPLAY, THEN COMPARE.
>;END IFN ANS74
;"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,<
;COME HERE WHEN "B" IS NON-NUMERIC DISPLAY, AND "A" IS NUMERIC.
;"A" IS MOVED TO A TEMP NON-NUMERIC, SAME MODE AS "B".
IFKAD: MOVE TD,EMODEB ;[1067] GET MODE TO CONVERT TO
PUSHJ PP,IFKADM ;[1067] CALL ROUTINE TO CONVERT "A" TO TEMP
JRST IFDD ;[1067] GO DO NON-NUMERIC COMPARISON
;[1067] ROUTINE TO MOVE "A" (A NUMERIC ITEM) TO A NON-NUMERIC TEMP
;[1067] FOR COMPARISON PURPOSES.
;[1067] CALL: TD/ MODE TO CONVERT TO (MUST BE DISPLAY)
;[1067] PUSHJ PP,IFKADM
;[1067] <RETURN HERE>, "A" CHANGED TO BE THE TEMP, "B" NOT AFFECTED
IFKADM: MOVE TE,[EBASEB,,ESAVBI] ;[1067]
BLT TE,ESVIBX ;[1067] SAVE "B"
MOVE TE,[EBASEA,,EBASEB] ;[1067]
BLT TE,EBASBX ;[1067] COPY "A" TO "B"
MOVEM TD,EMODEB ;[1067] SET MODE OF RESULT
MOVE TE,ESIZEB ;[1067] GET SIZE
ADD TE,[EXP 6-1,7-1,^D9-1](TD) ;[1067]Round up
IDIV TE,[EXP 6,5,4](TD) ;[1067][1542] GET # OF WORDS
PUSHJ PP,GETEMP ;[1067]
MOVEM EACC,EINCRB ;[1067]
MOVE TE,[^D36,,AS.MSC] ;[1067]
MOVEM TE,EBASEB ;[1067]
PUSH PP,SW ;[1067] SAVE FLAGS
SWOFF FBSIGN!FBNUM!FBSUB ;[1067] MAKE DESTINATION ITEM
;[1067] A SIMPLE NON-NUMERIC TEMP
PUSH PP,EACC ;[1067] SAVE %TEMP OFFSET
PUSHJ PP,MXX.## ;[1067] MOVE "A" TO TEMP
POP PP,EACC ;[1067] RESTORE %TEMP OFFSET
MOVE TE,[EBASEB,,EBASEA] ;[1067]
BLT TE,EBASAX ;[1067] COPY "B" TO "A"
MOVEM EACC,EINCRA ;[1067] RESET OFFSET,
MOVE TE,[^D36,,AS.MSC] ;[1067] AND BASE,
MOVEM TE,EBASEA ;[1067] INCASE MXX. CHANGED THEM
MOVE TE,[ESAVBI,,EBASEB] ;[1067]
BLT TE,EBASBX ;[1067] RESTORE "B"
POP PP,SW ;[1067] RESTORE ORIGINAL "B" FLAGS
SWOFF FASIGN!FANUM!FASUB ;[1067] THE NEW "A" IS THE TEMP
POPJ PP, ;[1067] RETURN
>;END IFN ANS74
;"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
;[1067] "A" IS A NUMERIC ITEM, "B" IS A LITERAL
IFN ANS74,< ;[1067]
TSWT FBNUM ;[1067] IS "B" A NUMERIC LITERAL?
JRST IFGN2D ;[1067] NO
>;END IFN ANS74 ;[1067]
PUSHJ PP,MOVXAC ; [413] PUT INTO ACS
SWON FAINAC;
;COME HERE WHEN "A" HAS BEEN MOVED TO ACS. SINCE THIS MAY HAVE
; EXPANDED THE TABLES, WE CAN NO LONGER BELIEVE THAT EBYTEB POINTS
; TO THE LITERAL. WE HAVE TO SET IT UP AGAIN, THEN GO TO IFGN9.
IFGN1A: HRRZ TA,EBASEB ;SET UP ETABLB AGAIN,
PUSHJ PP,LNKSET ; INCASE THE TABLES EXPANDED
HRRM TA,EBYTEB
JRST IFGN9
;"B" IS A LITERAL, "A" ISN'T
IFGN2: TSWT FANUM!FAINAC ;IS "A" NUMERIC?
JRST IFGN2A ;NO
IFN ANS74,<
TSWF FBNUM ;[1067] SKIP IF "B" IS NOT NUMERIC
JRST IFGN2E ;[1067] COMPARE NUMERICALLY
;[1067] "A" IS A NUMERIC ITEM, "B" IS A NON-NUMERIC LITERAL
IFGN2D: MOVEI TD,D7MODE ;[1067] MOVE "A" TO ASCII TEMP
PUSHJ PP,IFKADM ;[1067]
PUSHJ PP,SWAPIT ;[1067] SWAP SO "A" IS LITERAL,
;[1067] "B" IS NON-NUMERIC TEMP
JRST IFDD2 ;[1067] GO DO NON-NUMERIC COMPARISON
;[1067] "A" IS A NUMERIC ITEM, "B" IS A NUMERIC LITERAL
IFGN2E: ;[1067]
>;END IFN ASN74
TSWTS FAINAC ;GET IT INTO AC'S UNLESS
PUSHJ PP,MOVXAC ; [413] IT'S THERE ALREADY
JRST IFGN1A
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.
SETZ 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: ;[1416]
IFN FT68274,< ;[1416]
MOVEI DW,E.765 ;[1416] SET UP WARNING MESSAGE
MOVE TA,ESIZEA ;[1416] GET SIZE OF OPERATOR
TSWT FBNUM ;[1416] NUMERIC LITERAL ?
CAMN TA,ESIZEB ;[1416] OR SIZE EQUAL ?
SKIPA ;[1416] YES
PUSHJ PP,OPNWRN## ;[1416] NO, GENERATE WARNING
> ;[1416]
MOVEI LN,EBASEB ;[1416]
HRRZ TE,OPERND ;[1057] IS "ALL" SPECIFIED?
MOVE TE,0(TE) ;[1057]
TLNE TE,GNALL ;[1057]
JRST BADALL## ;[1057] YES
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 ;[154] MAKE SURE SETBCX DONE EVEN NO. OF TIMES
PUSHJ PP,SETBCX ;[154] TO FORCE CORRECT COMPARE UUO OF COMP. 2
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.
IFN ANS74,<
PUSHJ PP,TSTCOL ;[1004] NEED TO WORRY ABOUT ASCII/EBCDIC COLL. SEQ.?
PUSHJ PP,SWAPIT ;[1004] YES, SIGNAL BY EMODEA .LT. EMODEB
>
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
IFN ANS74,<
PUSHJ PP,TSTCOL ;[1004] SEE IF WE HAVE TO USE THE OTHER COL. SEQ.
JRST IFDD3A ;[1004] YES
>
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,<
SKIPG COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
>
JRST IFDD40 ;NO--SPECIAL CODE
IFDD3A: HRRZ TE,ESIZEZ
IFN BIS,< ;[1317]
MOVE TD,EMODEA ;[1317] NO NEED TO BREAK DOWN THE SIZE
CAME TD,EMODEB ;[1317] IF THE MODES ARE THE SAME
JRST IFDD3F ;[1317]
IFN ANS74,< ;[1317]
SKIPN COLSEQ ;[1317] AND NO SPECIAL COLLATING
> ;END IFN ANS74 ;[1317]
JRST IFDD3B ;[1317] SO USE THE WHOLE SIZE
IFDD3F: ;[1317]
> ;END IFN BIS ;[1317]
CAIG TE,MXPSZ.## ;TOO BIG
JRST IFDD3B ;NO
SUBI TE,3770 ;GET REMAINDER
PUSH PP,EINCRA
PUSH PP,EINCRB
PUSH PP,TE
PUSH PP,TD ;[1317] SAVE TD FOR A SECOND
IDIVI TE,3770 ;[1317] FIND OUT HOW MANY
SKIPE TD ;[1317] PARTS LEFT
ADDI TE,1 ;[1317]
MOVEM TE,ECNTA ;[1317] SAVE PART COUNT
POP PP,TD ;[1317] RESTORE TD
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
HRROI TE,-1 ;[1317] DECREMENT NUMBER
ADDM TE,ECNTA ;[1317] OF PARTS LEFT
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
CAME TE,EMODEA ;[1004] IF NOT THE SAME MODE
JRST ADDRS3 ;PUT OUT 3 JRSTS
IFN ANS74,<
PUSHJ PP,TSTCOL ;[1004] SAME MODE, BUT SEE IF OTHER COL. SEQ.
JRST ADDRS3 ;[1004] YES, SO NEED 3 JRSTS ALSO
>
JRST JFALSE ; ONLY ONE JRST REQUIRED
;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:
IFN ANS74,<
SKIPN FLGSW## ;ARE WE CHECKING FIPS LEVEL?
JRST IFDD4E ;NO
PUSHJ PP,TST.N2## ;TEST AT HIGH-INTERMEDIATE LEVEL
MOVE TE,ESIZEA ;RELOAD SIZE OF "A"
IFDD4E:>
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"?
IFN ANS74,<
PUSHJ PP,TSTCOL ;[1004] SEE IF OTHER COL. SEQ.
CAIA ;[1004] YES, CANNOT USE EXTEND INST.
>
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 ;[170-A] GET SIZE OF B
PUSH PP,TD ;[170-A] SAVE SIZE OF B
MOVE TD,ESIZEA ;[170] GET A SIZE (SMALLER THAN B)
MOVEM TD,ESIZEB ;[170] SET B SIZE = TO A SIZE
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 ;[170] GO GENERATE COMP CODE FOR 'A' SIZE
PUSHJ PP,SWAPIT ;[473] [170-A] MAKE 'B' OPERAND 'A' FOR SPACE COMPARE
POP PP,TD ;[170-A] GET BACK ORIGINAL B SIZE
MOVE TE,ESIZEA ;[170] GET A SIZE FOR ARGUMENT TO M.IA
SUB TD,TE ;[170] GET DIFFERENCE OF A AND B
MOVEM TD,ESIZEA ;[170-A] DIFFERENCE IS LEFT OVER CHARS OF ORIG B FOR SPACE COMP
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
IFN ANS68,<
CAME TE,EMODEB ;SKIP IF "A" AND "B" SAME MODE
JRST IFD6AA ; NO -- GO NORMAL ROUTE
>
IFN ANS74,<
CAMN TE,EMODEB ;SKIP IF "A" AND "B" NOT THE SAME MODE
PUSHJ PP,TSTCOL ;[1004] SEE IF OTHER COL. SEQ.
JRST IFD6AA ;[1004] YES, CANNOT USE EXTEND
>
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,<
SKIPG COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
PUSHJ PP,TSTCOL ;[1004] SEE IF WE HAVE TO USE OTHER COL. SEQ.
JRST OLDF20 ;[1004] 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,<
SKIPLE COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
SETOM COLSCP## ;[1004] YES, SIGNAL SUBSCRIPTER TO USE IT
>;END IFN ANS74
PUSHJ PP,B2PAR ;BUILD PARAMETERS
IFN ANS74,<
SETZM COLSCP ;[1004] BACK TO NORMAL
>
POP PP,EREMAN
HRRZ TE,EMODEB ;SAME MODE?
CAME TE,EMODEA
JRST IFDD24
IFN ANS74,<
PUSHJ PP,TSTCOL ;[1004] SEE IF WE NEED OTHER COL. SEQ.
JRST IFDD24 ;[1004] YES
>
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
IFN ANS68,<
PJRST GNPSX.## ;THEY ARE, GO GENERATE THE INSTRUCTION.
>
IFN ANS74,<
JRST IFDD25 ;[1004] SEE IF SPECIAL COLLATING SEQ. SPECIFIED
IMULI TE,D9MODE+1 ;[1004] INDEX IS EMODEA*3+EMODEB
>
ADD TE, EMODEB ;THEY AREN'T, FORM THE INDEX.
JUMPL TE, GNPSX.## ;IF AN ERROR OCCURED IN PHASE D
CAIG TE, CDDSLN ;[1004] THE MODES MAY BE MESSED UP, SO
; USE COMP.
MOVE CH, CDDS-1(TE) ;GET THE ROUTINE.
PJRST GNPSX.## ;GO GENERATE THE INSTRUCTION.
CDDS:
IFN ANS74,<
; XWD 0,COMP% ;[1004] CANNOT HAPPEN
XWD 0,CMP.67## ;[1004] COMPARE DISPLAY-6 TO DISPLAY-7 IN EBCDIC.
XWD 0,CMP.69## ;[1004] COMPARE DISPLAY-6 TO DISPLAY-9 IN EBCDIC.
>
XWD 0,CMP%76## ;COMPARE DISPLAY-7 TO DISPLAY-6 IN ASCII.
IFN ANS74,<
XWD 0,COMP% ;[1004] COMPARE DISPLAY-7 TO DISPLAY-7.
XWD 0,CMP.79## ;[1004] COMPARE DISPLAY-7 TO DISPLAY-9 IN ASCII.
>
XWD 0,CMP%96## ;COMPARE DISPLAY-9 TO DISPLAY-6.
XWD 0,CMP%97## ;COMPARE DISPLAY-9 TO DISPLAY-7.
; XWD 0,COMP% ;[1004] COMPARE DISPLAY-9 TO DISPLAY-9.
CDDSLN==.-CDDS ;[1004] LENGTH OF DISPATCH TABLE
IFN ANS74,<
IFDD25: PUSHJ PP,TSTCOL ;[1004] ASCII OR EBCDIC SPECIFIED?
SKIPA TE,EMODEA ;[1004] YES, USE SPECIAL ROUTINE
JRST GNPSX. ;[1004] NO, ITS IN THE RIGHT MODE
MOVE CH,CDDSAE(TE) ;[1004] GET THE ROUTINE
JRST GNPSX. ;[1004] GENERATE THE INSTRUCTION
CDDSAE: EXP COMP.6## ;[1004] SIXBIT IN EBCDIC MODE
EXP COMP.7## ;[1004] ASCII IN EBCDIC MODE
EXP COMP.9## ;[1004] EBCDIC IN ASCII MODE
>
;'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
HRRZ TE,VALLOC## ;MAKE EBYTEA RELATIVE TO VALTAB
MOVNS TE ; IN CASE LITTAB EXPANDS
ADDM TE,EBYTEA ; AND CAUSES VALTAB TO MOVE
PUSHJ PP,IFDD42 ;YES--GENERATE <LDB 0,B>
HRRZ TE,VALLOC ;PUT BACK THE VALTAB BASE
ADDM TE,EBYTEA ; SO EBYTEA POINTS TO CURRENT VALUE
PUSHJ PP,SWAPIT ;SWAP OPERANDS AND CONDITION
HRRZ TA,EBASEB ;[1404] SET UP ETABLB AGAIN
PUSHJ PP,LNKSET ;[1404] INCASE THE TABLES EXPANDED
HRRM TA,EBYTEB ;[1404]
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,<
SKIPG COLSEQ ;[1004] PROGRAM COL SEQ = ALPHABET-NAME?
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
TSWF FERROR ;[1353] LITERAL TOO LARGE
POPJ PP, ;[1353]
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
PUSHJ PP,IFDD45 ;SEE IF WE CAN USE HALF-WORD INST
IFN ANS74,<
SKIPG COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
>
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
PUSHJ PP,IFDD45 ;SEE IF WE CAN USE HALF-WORD INST
IFN ANS74,<
SKIPG COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
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: JUMPE CH,CPOPJ ;ALREADY DONE VIA HALF-WORD INST
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
;SEE IF WE CAN USE HALF-WORD INST
IFDD45: HLRZ TA,ERESX(LN) ;GET BYTE OFFSET
CAIE TA,44 ;MUST START ON HALF WORD BOUNDARY
CAIN TA,22
CAIA ;SO FAR SO GOOD
POPJ PP, ;FAILED FIRST TEST
MOVE TA,ESIZEX(LN)
HRRZ TD,EMODEX(LN)
IMUL TA,BYTE.S(TD)
CAIE TA,^D18 ;MUST BE EXACTLY 18 BITS
POPJ PP, ;FAILED
PUSHJ PP,PUTASA ;SIGNAL SECOND INST SET
HLRZ TA,ERESX(LN) ;GET BYTE OFFSET AGAIN
CAIE LN,EBASEA ;SEE IF "A" OR "B"
JRST IFDD46 ;"B"
;GENERATE <HXRZ 1,A>
CAIE TA,22
SKIPA CH,[HLRZ.##+AC1,,0]
MOVSI CH,HRRZ.##+AC1
PUSHJ PP,PUT.A
SETZ CH, ;SIGNAL DONE
POPJ PP,
;GENERATE <HXRZ 0,B>
IFDD46: CAIE TA,22
SKIPA CH,[HLRZ.##,,0]
MOVSI CH,HRRZ.##
PUSHJ PP,PUT.B
SETZ CH, ;SIGNAL DONE
POPJ PP,
;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: TLNN W1,GNENDS ;[605] IS THIS AN "END SPIF"?
POPJ PP, ;[605] NO
TLNE W1,(1B10) ;END SPIF, BUT NO I-O?
POPJ PP, ;YES, NOTHING TO GENERATE
IFN ANS74,<ENDIFR::>
;[12B] Sometimes there is information passed to this routine from
; the various I-O generators, such as the "READ INTO" item, or
; the file-table pointer and flag saying that this is a READ INTO
; a variable length item.
; This information is stored in a HLDTAB entry. EVERY special IF
;creates a HLDTAB entry, and they are stored as a LIFO "stack" as follows:
;PTRHLD contains information about the last entry made, (entry flags
;and pointer into HLDTAB).
; Each HLDTAB entry contains a header word which describes the
;NEXT entry in the chain (not the entry the header word is contained in!!!),
;and information that allows ENDIFG to generate the appropriate code.
; If there is only one entry in HLDTAB, the header word of that entry
;is zero.
; Every type of special IF must generate a HLDTAB entry. This includes
;all "INVALID KEY/AT END/AT END OF PAGE" etc.-type things.
; This type of arrangement is necessary to preserve the "pushdown"
;stack data structure, so nested "SPECIAL IF's" will work.
; Guard against errors
SKIPN PTRHLD## ;A MISMATCH INDICATES SYNTAX ERRORS
POPJ PP, ;SO JUST FORGET IT.
; Check for the various options
ENDIF0: MOVE TB,PTRHLD## ;GET PTRHLD WITH ITS FLAGS
TXNE TB,HE%VLR ; VARIABLE-LENGTH READ?
PUSHJ PP,ENDF0B ;YES
IFN ANS74,<
TXNE TB,HE%DEB ; DEBUGGING CODE?
PUSHJ PP,ENDF0C ;YES
>;END IFN ANS74
TXNE TB,HE%RIN ;READ..INTO OR RETURN..INTO?
PUSHJ PP,ENDF0A ;YES
HRRZ TA,PTRHLD ;FIND HLDTAB ENTRY
ADD TA,HLDLOC##
MOVE TB,(TA) ;"POP" THE STACK
MOVEM TB,PTRHLD
;Return space to HLDTAB
MOVE TB,[.HESIZ,,.HESIZ] ; # WORDS IN ENTRY USED
MOVE TD,HLDNXT##
SUB TD,TB ;ADJUST HLDNXT
MOVEM TD,HLDNXT ;AS IF WE HAD NEVER USED THE SPACE
POPJ PP, ;RETURN FROM ENDIFG
;ENDIFG - SUBROUTINES
;READ--INTO or RETURN...INTO
ENDF0A: MOVEI TA,.HERIN ;START OF ENTRY
ADD TA,PTRHLD ;POINT INTO THIS ENTRY
ADD TA,HLDLOC ;START OF THE READ..INTO OPERANDS
HRLI TB,0(TA) ;[1351] MOVE HLDTAB ENTRY
HRRI TB,EINTO## ;[1351] TO A FIXED LOCATION
MOVEI TC,EINTO ;[1351] BECAUSE TABLE EXPANSION
ADDI TC,OPNSIZ+OPNMAX;[1351] IS CLOBBERING CUREOP'S PTR
BLT TB,-1(TC) ;[1351]
MOVEI TA,EINTO ;[1351] TA POINTS TO RECORD ITEM
MOVEI TC,2(TA) ;[1351] TC POINTS TO INTO ITEM
MOVEM TC,CUREOP ;[1351] SETUP CUREOP THE WAY MOVGN. LIKES IT
;[1351] HRRZI TC,2(TA) ;TC POINTS TO INTO ITEM
;[1351] HRRZI TA,0(TA) ;TA POINTS TO RECORD ITEM
;[1351] MOVEM TC,CUREOP ;SETUP CUREOP THE WAY MOVGN. LIKES
PUSHJ PP,MOVGN. ;GENERATE THE MOVE CODE
SETZM EINTO ;[1351] RESET EINTO
MOVE TB,PTRHLD ;REGET PTRHLD
POPJ PP, ;RETURN
;READ--VARIABLE-LENGTH FLAG WAS ON
ENDF0B: MOVEI TA,.HEVLR ;GET OFFSET INTO ENTRY
ADD TA,PTRHLD ;POINT INTO THIS ENTRY
ADD TA,HLDLOC
MOVE TB,(TA) ;FETCH FILE-TABLE PTR
MOVEM TB,EDEPFT## ;STORE INFORMATION
PUSHJ PP,ENDFVL ;DO VARIABLE-LENGTH CODE
MOVE TB,PTRHLD ;RE-GET PTRHLD
POPJ PP, ;RETURN
;ENDIFG - SUBROUTINES
;CALLED BY ENDF0B TO DO THE VARIABLE LENGTH CODE
;INPUT: EDEPFT = FILE-TABLE POINTER
ENDFVL: 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
LDB TB,DA.USG ;[1037] GET USAGE OF 01 ITEM
SUBI TB,1 ;[1037] CONVERT TO MODE
MOVEM TB,ESAVMD## ;[1037] SAVE FOR SUBSIZ
HLRZ TA,EDEPFT ;[605] GET OFFSET OF OCCURS ITEM
PUSHJ PP,LNKSET ;[605] ITS ADDRESS
LDB TC,DA.USG ;[1037] GET USAGE
XCT SUBSIZ##(TC) ;[1037] CALL ROUTINE TO GET SIZE IN BYTES
MOVE TB,TE ;[1037] PUT SIZE IN TB
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
POPJ PP, ;DONE, RETURN
;ENDIFG - SUBROUTINES
IFN ANS74,<
;GENERATE DEBUGGING CODE
ENDF0C: MOVEI TA,.HEDEB ;GET PTR TO HLDTAB ENTRY
ADD TA,PTRHLD ;POINT INTO THIS ENTRY
ADD TA,HLDLOC
MOVE TC,(TA) ;GET THE DEBUGGING WORD
MOVEM TC,DBSPIF## ;REMEMBER IT WHILE WE GENERATE CODE.
TXNE TB,HE%RIN ;IF THIS IS READ..INTO
JRST ENDIF5 ; NO TAG NEEDED
;HAVE TO CREATE A TAG FOR DEBUGGING CODE
TSWF FAS3 ;IN NON-RESIDENT SECTION?
JRST [LDB CH,AS3BHO##+1 ;YES
JRST .+2]
LDB CH,AS2BHO##+1
HLRZ TE,CH ;GET OP-CODE
CAIE TE,720000 ;IS IT TAGGEN?
JRST ENDIF5 ;NO, LEAVE IT ALONE, GENERATE WRONG CODE!
LDB TE,[POINT 3,CH,20] ;GET TABLE #
CAIE TE,AC.TAG## ;MAKE SURE ITS A TAG
JRST ENDIF5 ;NO
PUSH PP,CH ;SAVE CURRENT INST
MOVE CH,[JRST.+ASINC,,AS.MSC]
TSWF FAS3
JRST [DPB CH,AS3BHO+1 ;CHANGE TO JRST .+3
JRST .+2]
DPB CH,AS2BHO+1
IFN MCS!TCS,<
HRRZ CH,DBSPIF
CAIN CH,DBCD. ;DBCD. NEEDS JRST .+4
SKIPA CH,[AS.DOT+4]
>
MOVEI CH,AS.DOT+3
PUSHJ PP,PUTASY ;FINISH OFF INST.
POP PP,CH
HRRZ TE,CH
ANDI TE,077777 ;GET TAG NUMBER
ADD TE,TAGLOC##
AOS (TE) ;INCREMENT PC OF TAG
PUSHJ PP,PUTASN ;OUTPUT TAG AGAIN
ENDIF5: HRRZ CH,DBSPIF
PUSHJ PP,PUT.PJ## ;PUSHJ 17,DBXX.
MOVE CH,[AS.XWD##,,1]
PUSHJ PP,PUTASN
LDB CH,[POINT 13,DBSPIF+1,28] ;GET LINE NUMBER
PUSHJ PP,PUTASN
IFN MCS!TCS,<
HRRZ CH,DBSPIF ;GET ROUTINE
CAIN CH,DBCD.## ;CHECK FOR DEBUG ON CD-NAME
JRST [HLRZ TA,DBSPIF ;YES, GET CD-NAME
ADD TA,CDLOC## ;ADD IN BASE
PUSHJ PP,DBGEN1## ;USE CODE IN MESGEN
JRST ENDIF6]
>
HLRZ CH,DBSPIF
IORI CH,AS.FIL ;CONVERT INTO FILTAB ADDRESS
PUSHJ PP,PUTASY ;XWD LINE #,FILTAB
ENDIF6: SETZM DBSPIF
MOVE TB,PTRHLD ;REGET PTRHLD
POPJ PP, ;RETURN
>;END IFN ANS74
;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,IFZROS(TE) ;[1034] [441] GET SOME KIND OF ZERO.
SETO CH, ;[1034] ALWAYS USE IN-LINE CODE
IFN ANS74,<
SKIPLE COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
XCT CSCHAR(TE) ;YES, GET CONVERTED ZERO
PUSHJ PP,TSTCOL ;[1004] NEED OTHER COL. SEQ.?
JRST [MOVE TE,EMODEA ;[1004] YES
HRRZ TD,OTHZRO(TE) ;[1004] GET OTHER MODE'S ZERO
JRST .+1] ;[1004]
>
JRST IFSP1 ;[1034]
;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.
IFN ANS74,<
OTHZRO: XWD 0,360 ;[1004] DISPLAY-9 ZERO
XWD 0,360 ;[1004] DISPLAY-9 ZERO
XWD 0,60 ;[1004] DISPLAY-7 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. ;[177] SKIPGE AC
PUSHJ PP,PUT.A ;[177] PUT IN ASSEMBLY FILE
JRST JFALSE ;[177] ENTER JRST FALSE
;[177] NO NEED TO CHECK 2ND WORD SINCE G.E. 0
IFZ10: MOVSI CH,SKPGE. ;[177] SKIPGE AC
PUSHJ PP,IFZ13
JRST IFZ6
IFZ12: MOVSI CH,SKPLE. ;[177] SKIPLE AC,
PUSHJ PP,IFZ13
MOVSI CH,SKIPN. ;[177] SKIPN AC
PUSHJ PP,PUT.A ;[177] PUT IN ASSY FILE
MOVSI CH,SKIPN. ;[177] SKIPN AC+1
JRST IFZ6A ;[177] FINISH UP
IFZ13: PUSHJ PP,PUT.A ;[177] PUT IN ASSY FILE
MOVE CH,[XWD JRST.+ASINC,AS.MSC] ;[177] PUT IN JRST .+4
PUSHJ PP,PUTASY ;[177] PUT IN ASSY FILE
HRRZI CH,AS.DOT+4 ;[177] .+4
JRST PUTASN ;[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] ;[177] JUMPG AC,
PUSHJ PP,PUT.XA ;[177] ASSEMBLE IT
HRRZI CH,AS.DOT+3 ;[177] RH OF JUMPG .+3
PUSHJ PP,PUTASN ;[177] ASSEMBLE IT
MOVSI CH,JUMPN. ;[177] JUMPN AC,
MOVE TE,EAC ;[177] GET AC
DPB TE,CHAC ;[177] PUT IN AC FIELD
PUSHJ PP,JFLSEA ;[177] JUMPN AC, FALSE
MOVSI CH,JUMPE. ;[177] JUMPE AC+1,
AOSA EAC ;[177] BUMP AC
IFZ23A: MOVSI CH,JMPGE. ;[177] FOR <, JUMPGE AC,
IFZ23B: MOVE TE,EAC
DPB TE,CHAC
JRST JFLSEA
IFZ24: MOVE CH,[XWD JUMPG.+ASINC,AS.MSC] ;[177] JUMPG AC.
PUSHJ PP,PUT.XA ;[177] ASSEMBLE IT
HRRZI CH,AS.DOT+2 ;[177] JUMPG AC,.+2
PUSHJ PP,PUTASN ;[177] ASSEMBLE
MOVSI CH,JUMPN. ;[177] JUMPN AC+1,
JRST IFZ23B ;[177] FINISH UP
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.
SETO CH, ;[1034] ALWAYS GENERATE INLINE CODE IF POSSIBLE
IFN ANS74,<
SKIPLE COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
XCT CSCHAR(TE) ;[1034] [720] YES, GET CONVERTED SPACE
PUSHJ PP,TSTCOL ;[1004] SEE IF OTHER COL. SEQ.
JRST [MOVE TE,EMODEA ;[1004]
HRRZ TD,OTHSPC(TE) ;[1004] GET THE OTHER COL. SEQ. SPACE
JRST .+1] ;[1004]
>;END IFN ANS74
IFSP1: MOVEM TD,ESAVAC ;[1034]
PUSHJ PP,SPECIL ;[1034]
POPJ PP, ;[1034] "CAM" GENERATED--EXIT
IFN ANS74,<
SKIPLE COLSEQ ;[1034] IF PROGRAM COLL. SEQ. = ALPHABET-NAME
JRST IFQHV2 ;[1034] WE MUST WORRY ABOUT EQUIVALENT CHARS.
>
IFZ1D: LDB TE,CONDIT ;[1034] IF CONDITION IS
CAIE TE,EQ ;[1034] EQUAL OR
CAIN TE,NOTEQ ;[1034] NOT EQUAL,
JRST IFSP3 ;[1034] SPECIAL PROCESSING
JRST IFQHV2 ;[1034] ELSE NORMAL
IFSP3: JUMPL CH,IFSP3A ;[1034] [717] IF GENERATING INLINE CODE 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"
;IF WE HAVE PUT -1 IN CH, USE INLINE CODE (EXTEND IF BIS).
; ELSE, CH WILL CONTAIN AN EXTAB ADDRESS - USE OLD METHOD
JUMPGE CH,IFSP4 ;[1034] NOT INLINE CODE, SETUP OPERAND OLD WAY
PUSHJ PP,NB1PAR##
POP PP,CH
JRST BFIGCM ;GENERATE INLINE COMPARISON, THEN "JRST FALSE"
IFSP4: PUSHJ PP,B1PAR ;[1034]
POP PP,CH
IFSP5: TSWF FASUB; ;IS THE OPERAND SUBSCRIPTED?
SETZ 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: EXP 0 ;DISPLAY-6 SPACE.
EXP 40 ;DISPLAY-7 SPACE.
EXP 100 ;DISPLAY-9 SPACE.
IFN ANS74,<
CSCHAR: HLRZ TD,PRGCOL##+240(TD) ;SIXBIT
HLRZ TD,PRGCOL(TD) ;ASCII
HRRZ TD,PRGCOL(TD) ;EBCDIC
OTHSPC: XWD 177,100 ;[1004] DISPLAY-9 QUOTE ,, SPACE
XWD 177,100 ;[1004] DISPLAY-9 QUOTE ,, SPACE
XWD 42, 40 ;[1004] DISPLAY-7 QUOTE ,, SPACE
>
;HERE TO GENERATE INLINE 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:
IFN BIS,<
MOVE TE,ESIZEA ;IF SIZE IS 1
SOJE TE,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
>;END IFN BIS
IFE BIS,<
TLNN W1,EQUALF ;[1040] IS CONDITION =?
JRST BFIGC3 ;[1040] NOT =, USE DIFFERENT CODE
MOVE CH,ESIZEA ;[1034]
CAIG CH,2 ;[1034] IF SIZE IS 2 OR LESS
JRST BFIGC2 ;[1034] USE STRAIGHT LINE CODE
HRLI CH,MOVEI.+AC7 ;[1034] WE NEED A LOOP
PUSHJ PP,PUTASY ;[1034] GENERATE MOVEI 7,SIZE
BFIGC2: PUSHJ PP,BFIGC1 ;[1034] GENERATE COMPARE CODE
MOVE CH,ESIZEA ;[1034] SEE IF WE NEED LOOP
SOJE CH,JFALSE ;[1034] NOT IF SIZE = 1
PUSHJ PP,JFALSE ;[1034] YES, PUT OUT FALSE JUMP
MOVE CH,ESIZEA ;[1034]
CAIN CH,2 ;[1034] IS IT THE OTHER SPECIAL CASE?
JRST [PUSHJ PP,BFIGC1 ;[1034] YES, GENERATE SECOND TEST
JRST JFALSE] ;[1034] AND EXIT
MOVE CH,[SOJG.+AC7+ASINC,,AS.MS2##] ;[1034] NO
PUSHJ PP,PUTASY ;[1034]
MOVEI CH,AS.DOT+3 ;[1034]
JRST PUTASN ;[1034] GENERATE SOJG 7,.-3
>
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##
IFN BIS,<
PUSHJ PP,PUT.XA##
JRST JFALSE
>
IFE BIS,<
JRST PUT.XA## ;[1034]
>
IFE BIS,< ;[1040] NOT = CODE
BFIGC3: MOVE CH,ESIZEA ;[1040] IF SIZE IS 1,
CAIN CH,1 ;[1040]
JRST [PUSHJ PP,BFIGC1 ;[1040] GENERATE THE "CAIN"
JRST JFALSE] ;[1040] GEN "JRST FALSE"
HRLI CH,MOVEI.+AC7 ;[1040] MAKE A LOOP
PUSHJ PP,PUTASY ;[1040]
MOVE CH,[ILDB.,,5] ;[1040] GEN "ILDB AC,5"
PUSHJ PP,PUT.XA## ;[1040]
MOVSI CH,CAIE. ;[1040] GEN "CAIE AC,CHAR"
HRR CH,ESAVAC## ;[1040]
PUSHJ PP,PUT.XA## ;[1040]
MOVE CH,[JRST.+ASINC,,AS.MSC##] ;[1040] GEN "JRST TRUE"
PUSHJ PP,PUTASY ;[1040]
MOVEI CH,AS.DOT+3 ;[1040] ...WHICH IS .+3
PUSHJ PP,PUTASN ;[1040]
MOVE CH,[SOJG.+AC7+ASINC,,AS.MS2##] ;[1040] CHECK ALL CHARS
PUSHJ PP,PUTASY ;[1040] "SOJG AC7,.-3"
MOVEI CH,AS.DOT+3 ;[1040]
PUSHJ PP,PUTASN ;[1040]
JRST JFALSE ;[1040] GEN "JRST FALSE"
>;[1040] END IFE 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,<
SKIPLE COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
XCT CSCHAR(TE) ;YES, GET CONVERTED QUOTE
PUSHJ PP,TSTCOL ;[1004] NEED OTHER COL. SEQ.?
JRST [MOVE TE,EMODEA ;[1004] YES
HLRZ TD,OTHSPC(TE) ;[1004] GET OTHER MODE'S QUOTE
JRST .+1] ;[1004]
>
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.
IFN ANS74,<
SKIPL TD,COLSEQ ;[1374] WAS ASCII OR EBCDIC COLL SEQ DECLARED?
JRST IFHIVA ;[1374] NO, CONT
TRNE TD,%AN.EB ;[1374] YES, WAS IT EBCDIC?
MOVEI TE,D9MODE ;[1374] YES, CHANGE MODE OF HIGH-VAL TO EBCDIC
IFHIVA: ;[1374]
>
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,<
PUSHJ PP,TSTCOL ;[1004] SEE IF WE NEED OTHER COL. SEQ.
JRST [MOVE TC,EMODEA ;[1004] YES
MOVSI CH,LDB.+AC2 ;[1004] NEED TO CONVERT FROM ONE
HRR CH,SUTBL(TC) ;[1004] CHARACTER SET TO THE OTHER
IFE TOPS20,<
TSWT FREENT ;[1004] NO INDIRECT IF /R
>
IFN TOPS20,<
SKIPN RENSW## ;[1004] NO INDIRECT IF /R
>
TLO CH,(@) ;[1004] TURN ON INDIRECT BIT IF NOT /R
PUSHJ PP,PUT.EX ;[1004]
JRST IFQHV4] ;[1004]
SKIPG COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
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
IFN ANS74,<
SUTBL: EXP SU.S69## ;[1004] SIXBIT TO EBCDIC
EXP SU.S79## ;[1004] ASCII TO EBCDIC
EXP SU.S97## ;[1004] EBCDIC TO ASCII
>
;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'S NEITHER "EQUALS" NOR "NOT EQUALS".
IFQHV6: SKIPN ESAVAC ;IS THE CONSTANT = 0?
JRST IFQHV8 ;YES, USE JUMPX INSTEAD
MOVSI CH,CAI.+AC2
ROT TE,-^D8
ADD CH,TE
HRR CH,ESAVAC
PUSHJ PP,PUTASY
JRST JFALSE
IFQHV8: MOVSI CH,JUMP.+AC2
LDB TE,CONDIT
TLNN W1,NOTF
TRC TE,CONCMP/100
ROT TE,-^D9
ADD CH,TE
JRST JFLSEA
;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: MOVE EACA,EOPNXT
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?
MOVEM TD,CURVAL## ;[1457] MOVE VALTAB PTR IN CASE VALTAB MOVED
PUSHJ PP,STASHL ;YES, OUTPUT IT
MOVE TD,CURVAL## ;[1457] GET VALTAB PTR BACK, ASSUME IT MOVED
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,<
PUSHJ PP,TSTCOL ;[1004] SEE IF WE WANT OTHER COL. SEQ.
JRST .+3 ;[1004] YES, ONLY SPECIAL IF 1 CHAR.
SKIPG COLSEQ## ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
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
MOVEI TE,2 ;[1004] IF OTHER COL. SEQ.
SKIPGE COLSEQ ;[1004] WE NEED AC2
MOVEM TE,EAC ;[1004] TO BE ABLE TO DO INDEXING
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,<
PUSHJ PP,TSTCOL ;[1004] SEE IF WE NEED OTHER COL. SEQ.
JRST [MOVE TC,EMODEA ;[1004] YES
POP PP,EAC ;[1004] RESTORE ORIGINAL ACC
MOVSI CH,LDB. ;[1004] NEED TO CONVERT FROM ONE
HRR CH,EAC ;[1004]
DPB CH,CHAC ;[1004] LOAD AC FIELD
HRR CH,SUTBL(TC) ;[1004] CHARACTER SET TO THE OTHER
IFE TOPS20,<
TSWT FREENT ;[1004] NO INDIRECT IF /R
>
IFN TOPS20,<
SKIPN RENSW## ;[1004] NO INDIRECT IF /R
>
TLO CH,(@) ;[1004] TURN ON INDIRECT BIT IF NOT /R
PUSHJ PP,PUT.EX ;[1004]
JRST SPECL2] ;[1004]
SKIPG COLSEQ ;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
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)
HRRZ TE,EFLAGB ;[1060] IF ZERO TESTING,
CAIE TE,2 ;[1060] TC HAS CORRECT VALUE
JRST JTRUE2 ;[1060] FOR = OR NOT =
TLNN W1,GLCMP ;[1060] IF > OR < , SKIP
JRST JOUT ;[1060]
JTRUE2: 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
HRRZ TE,EFLAGB ;[1060] MOVE B FLAGS TO TE
CAIN TE,2 ;[1060] TEST FOR IFZERO FLAG
JRST JMP2 ;[1060]
TLNE W1,GLCMP ;[1060] IF > OR <, SKIP
JRST JMP2 ;[1060]
IMULI TC,3 ;[1060]
JRST JTRUE ;[1060]
JMP2: IMULI TC,4 ;[1060] [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,4 ;[1317] OFFSET BASE FOR JRSTS EQUALS
IMUL TC,ECNTA ;[1317] NUMBER OF PIECES LEFT TIMES 4
TLNE W1,NOTF ;[1317] UNLESS THIS IS A "NOT"
SETZ TC, ;[1317] THEN THE OFFSET BASE = 0
PUSH PP,TC ;[1317] SAVE THE OFFSET BASE
ADDI TC,3 ;[1317] FIRST OFFSET
TLNE W1,LESSF
PUSHJ PP,JTRUES
PUSHJ PP,JFALSE
POP PP,TC ;[1317] RESTORE OFFSET BASE
ADDI TC,2 ;[1317] SECOND OFFSET BASE
TLNE W1,GREATF
PUSHJ PP,JTRUES
PUSHJ PP,JFALSE
SKIPE ECNTA ;[1317] IF THIS ISN'T THE LAST PART
POPJ PP, ;[1317] DON'T WANT THIRD JRST
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
IFN ANS74,<
JRST OPCHK5
>
OPCHK3:
IFN ANS74,<
SKIPN FLGSW## ;NEED FIPS FLAGGER?
JRST OPCHK5 ;NO
MOVE TC,CURXSQ## ;GET NUMBER OF EXPRESSION SEEN
SUB TC,LSTXSQ## ;MINUS NUMBER AT LAST IF
SOJN TC,OPCHK5 ;PROBLEM IF ONLY 1
LDB LN,[POINT 13,EXPLNC,28]
JUMPE LN,OPCHK5 ;*** NOT THE REAL FIX, BUT IT WORKS ***
; OTHERWISE SINGLE VARIABLES WILL FAIL
LDB CP,[POINT 8,EXPLNC,35]
PUSH PP,TA
MOVEI TA,%LV.HI
PUSHJ PP,FLG.ES## ;FLAG POSSIBLE VIOLATION (ABREV CONDITIONA)
POP PP,TA
OPCHK5:>
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:
IFN ANS74,<
CAIE LN,EBASEA ;SEE IF "A" OR "B"
JRST [SETOM EDEBDB##
SKIPL INPERF ;ALWAYS IF IN PERFORM LOOP CONTROL
SOS EDEBDB ;OTHERWISE ONLY IF DB.ARO IS ON
JRST SETEDA]
SETOM EDEBDA## ;POSSIBLE DEBUG CODE WANTED
SKIPL INPERF ;ALWAYS IF IN PERFORM LOOP CONTROL
SOS EDEBDA ;OTHERWISE ONLY IF DB.ARO IS ON
SETEDA:>
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
IFN ANS74,<
;HERE TO SEE IF OPERAND "A" IS IN THE SAME MODE AS PROGRAM COL. SEQ.
;AND CONDITION IS NEITHER "EQUAL" NOR "NOT EQUAL"
;RETURNS +1 IF NOT
; +2 IF YES
TSTCOL: SKIPL TE,COLSEQ ;[1004] ASCII OR EBCDIC SPECIFIED?
JRST CPOPJ1 ;[1004] NO, GIVE SKIP RETURN
TRNN TE,%AN.EB ;[1004] DID USER SAY EBCDIC?
TDZA TE,TE ;[1004] NO, ASSUME ASCII
MOVEI TE,D9MODE+1 ;[1004] YES
ADD TE,EMODEA ;[1004] FORM INDEX
JRST @[EXP CPOPJ1 ;[1004] SIXBIT IN ASCII MODE
EXP CPOPJ1 ;[1004] ASCII IN ASCII MODE
EXP .+1 ;[1004] EBCDIC IN ASCII MODE
EXP .+1 ;[1004] SIXBIT IN EBCDIC MODE
EXP .+1 ;[1004] ASCII IN EBCDIC MODE
EXP CPOPJ1](TE) ;[1004] EBCDIC IN EBCDIC MODE
LDB TE,CONDIT ;[1004] YES, BUT
CAIE TE,EQ ;[1004] EQUAL AND NOT EQUAL
CAIN TE,NOTEQ ;[1004] ARE INVARIANT UNDER
AOS (PP) ;[1004] THIS TRANSFORMATION
POPJ PP, ;[1004]
>
;IMPROPER CONDITIONS
BADIF: OUTSTR [ASCIZ /Bad "IF" flags
/]
JRST KILLF
BADCOD: OUTSTR [ASCIZ /Bad "IF" usage
/]
POPJ PP,
BADIFT: OUTSTR [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
IFN ANS68,<
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 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 ESAVBI,ESVIBX ;[1067]
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.,MOV
EXTERNAL DA.CLA,DA.EDT,DA.EXS
END