Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/cobole.mac
There are 14 other files named cobole.mac in the archive. Click here to see a list.
; UPD ID= 1374 on 9/23/83 at 8:29 AM by KILGORE
TITLE COBOLE FOR COBOL V13
SUBTTL PHASE E - GENERATOR CONTROL SERG POLEVITSKY/ALB/CAM
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P,COMUNI
%%P==:%%P
%%COMU==:%%COMU
DBMS==:DBMS
MCS==:MCS
IFN TOPS20,<SEARCH MONSYM,MACSYM>
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
RELOC 400000
;EDITS
;V12A RELEASED *****
;NAME DATE COMMENTS
;DMN 21-Jun-82 [1363] Fix errors in handling alphabet-name in SPECIAL-NAMES.
;V12B RELEASED *****
;DMN 1-APR-80 [1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;DAW 8-MAR-79 [656] FIX PROBLEMS WITH DBMS USE PROCEDURES
;DAW 6-MAR-79 [650] FOR DBMS PROGRAMS WITH USE PROCEDURES,
; FIX ILL MEM REF WHEN TABLES EXPAND.
;DAW 23-FEB-79 [637] FIX COMPUTE WITH COMP-1 RESULT
;V12 RELEASED *****
;V10*****************
; 10-AUG-76 [435] ADD OPERATORS FOR BEGIN AND END DECLARITIVES
;GPS 12/23/74 ADD OPERATORS FOR SIMULTANEOUS UPDATE
;DBT 1/14/75 REFERENCE COMUNI.UNV FOR FIXNUM DEFINITION
;DBT 6/24/75 REMOVE REMNENTS OF UUOS
;********************
;DPL 4/11/75 [332] FIX DBARG2 TO OUTPUT CORRECT ARGS IN DBMS USE STATEMENT
;
;PREAMBLE
;
;**************************************
;* NOTE WELL *
;* EOPCOD HOLDS SUBROUTINE ADDRESSES *
;* EOPTAB HOLDS CURRENT OPERANDS ONLY *
;**************************************
;
;
;THE PHASE E STRATEGY IS AS FOLLOWS:
;READ INPUT FROM THE PREVIOUS PHASES STASHING OPERANDS (DISTINGUISHABLE FROM
;OPERATORS BY A 1 IN BIT 0 OF THEIR 1ST WORD) IN EOPTAB (A DYNAMICALLY ALLOCATED
;PUSH-DOWN LIST, WHOSE PRESENT STARTING ADDRESS CAN BE FOUND IN THE RIGHT HALF OF
;EOPLOC) UNTIL AN OPERATOR (BIT 0 OF WORD 1 =0) IS FOUND.
;UPON "SEEING" AN OPERATOR, THE SCANNER ROUTINE WILL CHECK THE OP CODE IN THE
;2ND WORD OF THE ITEM HELD "IN HAND" [W1 & W2 ACCUMULATORS] AGAINST THE HIGHEST
;LEGAL OP CODE KNOWN (ELAST). IF THE OP CODE IS > ELAST, IT CAN BE EITHER
;(A) AN ILLEGAL OP CODE OR (B) THE ENDIT OPERATOR, DENOTING
;END OF INPUT FROM THE PREVIOUS PHASES.
;IF THE OP CODE IS = TO ENDIT, WRAPUP THE CURRENT PHASE, HOUSE CLEANING FILES, ETC.
;AND JUMP TO NEXT PHASE. IF THE OP-CODE FAILS TO BE ENDIT
;AND IS GREATER THAN ELAST, IT IS A BOGUS OP CODE AND AN ERROR MESSAGE IS GIVEN.
;NOTE THAT IN ALL PROBABILITY, A BOGUS OP CODE OF THIS TYPE (> ELAST AND NOT = ENDIT)
;PROBABLY MEANS A COMPILER ERROR.
;IF THE OP CODE IS < OR = ELAST, JUMP THROUGH EOPCOD ENTRY AS SPECIFIED BY
;THE OFFSET WHICH IS THE OP CODE ITSELF TO THE APPROPRIATE SUBROUTINE.
;TO EMEND THE CURRENT SCHEME, ADDITIONS TO THE OP CODE REPERTOIRE SHOULD BE IN THE
;FORM:
; VECTOR <SUBROUTINE ADDRESS>,<FLAGS>
DEFINE VECTOR (PARAM,FLAGS),<
XWD FLAGS,PARAM
EXTERNAL PARAM
>
;COMMONLY USED PARAMETERS ARE ALREADY DEFINED
;IN THE FILE "P.MAC"
;ALSO SEE MEMO 100-350-007 (CODE GENERATION)
;AND MEMO 100-350-010 (FILE DESCRIPTIONS)
;AS TO BIT ASSIGNMENTS AND FILE ORGANIZATION
INTERN EOPCOD
INTERN EBADOP
INTERN ENTERS ;COME BACK FROM A GENERATOR
;RESETTING EOPTAB.
INTERN COMEBK ;COME BACK FROM GENERATOR BUT DO NOT
;RESET EOPTAB.
INTERN GO2NXT ;DISPATCH TO NEXT OPCODE THRU EOPCOD
INTERN READEM ;FETCH ALL OPERANDS UP TO
;AN OPERATOR. POPJ PP, BACK
;TO CALLING ROUTINE WITH OPERATOR IN W1 & W2.
;FLAGS IN VECTOR DEFINITIONS
DB==(1B0) ;STORE W1 FOR DEBUG CODE
;****** EXTERNAL ENTRY POINTS ******
EXTERN XPNEOP ;EXPAND EOPTAB
EXTERN CMNGEN,XFRGEN,MOVGEN
EXTERN AS3BUF
EXTERN LITNXT,LITLOC,EAS1PC,EAS2PC,EAS3PC,EOPLOC,EOPNXT
EXTERN ETEMPC
EXTERN EALTPC ;DEFINE SOME PHANTOM PROGRAM COUNTERS
;FOR RELATIVE LOCATION WITHIN TEMPS,
;ALTERS > 50, AND ...
EXTERN PUSH12
EXTERN PUTASN
EXTERN SEGCLN
EXTERN SETGEN
EXTERN GETGEN
EXTERN KILL
EXTERN PUTAS1,PUTAS2,PUTAS3,PUTERA
EXTERN EINITL,EZEROH
EXTERN USEBAS
EXTERN EALTMX ;MAXIMUM SIZE NEEDED FOR ALTERS (SEE TEMPS [ETEMAX]).
EXTERN TEMBAS
EXTERN ETEMAX
EXTERN DATBAS
EXTERN ALTBAS
EXTERN RESDNT
EXTERN IMPPAR
EXTERN FILTBL
EXTERN NONRES
EXTERN A50BAS
EXTERN HILOC ;SIZE OF LARGEST NON-RESIDENT SEGMENT
IFE TOPS20,<EXTERN CPYBHO ;3-WORD BUFFER INFO FOR OUTPUT CPYFIL>
IFN TOPS20,<EXTERN CPYBH>
EXTERN STASHI,STASHL,AS.LIT,AS.MSC
EXTERN ACEPT.,DSPLY.,EDIT.U,EDIT.S,FLOT.2,C.D6D7,C.D7D6,C.DD
EXTERN PD6.,PD7.,MUL.21,DIV.21
EXTERN PRODSW
;ELAST = SEE LAST ENTRY IN TABLE, EOPCOD.
;ELAST IS THE LAST VALID OP CODE ENTERED IN
;THE OP CODE TABLE,EOPCOD,WHICH CONTAINS
;THE ADDRESSES OF THE SUBROUTINE GENERATOR WITH
;WHICH THIS OP CODE IS ASSOCIATED.
;THE OP CODE ITSELF WILL GIVE THE OFFSET IN THE TABLE, EOPCOD,
;AND THUS POINT TO THE PARTICULAR SUBROUTINE TO
;BE USED. THE OP CODE WILL BE PASSED, RIGHT-JUSTIFIED, IN W2.
ENDIT=377
;ENDIT IS THE END OF INPUT OPERATOR. UPON SEEING
;ENDIT, THE CODE GENERATION PHASE WILL CLOSE THE ERROR LISTING
;FILE AND ALL
;OPEN AS-TYPE FILES AND JRST TO THE ENTRY POINT OF THE NEXT PHASE
;
;
;
;
;PHASE E WILL SCAN INPUT FROM THE PREVIOUS PHASES AND
;PUSH DOWN OPERANDS FOUND INTO THE LIST, EOPCOD,
;UNTIL THE OPERATOR ASSOCIATED WITH THESE OPERANDS IS FOUND.
;"OPERAND" WILL BE UNDERSTOOD TO REFER TO ANY ONE OF THE
;FOLLOWING THREE ITEMS:
;A) TW0-WORD OPERANDS
;B) LITERALS
;C) FIGURATIVE CONSTANTS
;ON SEEING AN OPERATOR, JUMP THROUGH THE EOPCOD TABLE
;TO THE APPROPRIATE SUBROUTINE GENERATOR.
;EACA WILL HOLD THE PUSH-DOWN XWD FOR THE
;DYNAMICALLY ALLOCATED PUSH-DOWN LIST, EOPCOD
;EACB WILL HOLD W2,(FLOLOC)
; ^^ INDEX FIELD
; ^ ^ ADDRESS FIELD
COBOLE: SETFAZ E; ;GENERATE "INTERNAL **COBOLE**"
;INFORM THE REST OF THE COMPILER THAT
;PHASE E HAS BEGUN.
IFE TOPS20,<
SETOM @CPYBHO+1 ;JAM LAST LINE NUMBER WITH 1'S
CLOSE CPY, ;CLOSE OUTPUT CPYFIL
RELEASE LIB, ;THROW AWAY ANY LIBRARY FILE
>
IFN TOPS20,<
SETOM @CPYBH+1 ;JAM LAST LINE NUMBER WITH 1'S
PUSHJ PP,RITCPY## ;Write out last partial buffer
PUSHJ PP,CLSCPY## ;CLOSE OUTPUT CPYFIL
PUSHJ PP,CLZLIB## ;THROW AWAY ANY LIBRARY FILE
>
PUSHJ PP,SETGEN ;SET UP READS FROM THE FILE, GENFIL,
;& RETURN IF DEVICE O. K.
;IF DEVICE BAD, ETC., DON'T RETURN.
IFE TOPS20,<
MOVE TA,AS3BUF ;SET UP AS3 BUFFER
MOVEM TA,.JBFF##
OUTBUF AS3,2
>
SETZM EINITL ;CLEAR PHANTOM PROGRAM COUNTERS
MOVE TE,[XWD EINITL,EINITL+1]
BLT TE,EZEROH
HRRI SW,0 ;CLEAR RIGHT HALF! OF SWITCH REGISTER.
SETZM HILOC ;PRESET SIZE OF NON-RESIDENT
SETZM SEGFLG## ;CLEAR "THERE ARE NON-RESIDENT SEGMENTS"
SETZM EVALSN## ;CLEAR "EVALUATE SEEN" FLAG
MOVE TA,LITLOC ;INSURE LITNXT IS RESET
MOVEM TA,LITNXT
MOVEI TA,2*FIXNUM ;%TEMP GOES ABOVE %FILES, ETC
MOVEM TA,TEMBAS
PUSHJ PP,POOLINI## ;INITIALIZE LITERAL POOLER
;ALLOCATE %PARAM WORDS WE NEED. NOTE: THIS MUST BE DONE BEFORE
; CALL TO SETRPW, WHICH ALLOCATES SOME MORE.
SKIPN RELKEY## ;KEY CONVERSION REQUIRED?
JRST .+3 ;NO
AOS EAS1PC ;RESERVE %PARAM+0
PUSHJ PP,PUTOC0## ;PUT 0 IN ASY FILE
HRRZ TA,DEBLOC## ;SEE IF WE HAVE ANY DEBUGGING
HRRZ TB,DEBNXT## ;ON DATA-NAMES WHICH NEED EXTRA PARAMS
SUB TB,TA
CAIGE TB,SZ.DEB
JRST CBLE11 ;NO, WE ARE OK
MOVE TE,EAS1PC
IORI TE,AS.PAR##
IFE SZ.DEB-2,<
LSH TB,-1 ;SAVES WORRYING ABOUT TB+1
>
IFN SZ.DEB-2,<
PUSH PP,TB+1
IDIVI TB,SZ.DEB
POP PP,TB+1
>
MOVN TB,TB
HRL TA,TB ;AOBJN POINTER
ADDI TA,1 ;BYPASS FIRST WORD IN TABLE
DBLUP1: LDB TD,DB.DAT## ;GET DATAB LINK
EXCH TA,TD
ANDI TA,077777
ADD TA,DATLOC## ;DON'T USE LNKSET
LDB TA,DA.SUB## ;IF IT SUBSCRIPTED WE NEED 4 PARAMS
EXCH TA,TD
SKIPN TD ;SUBSCRIPTED?
AOJA TB,DBLUP2 ;NO, SO 1 LESS SET OF PARAMS
DPB TE,DB.PRM## ;SAVE PARAMETER
ADDI TE,4
DBLUP2: ADDI TA,SZ.DEB-1 ;AOBJN WILL GET US TO NEXT ITEM
AOBJN TA,DBLUP1 ;LOOP
IMUL TB,[-4] ;GET NUMBER OF WORDS TO ADD
ADDM TB,EAS1PC ; AT 4 PER DEBUG ITEM
PUSHJ PP,PUTOC0 ;ALLOCATE THE %PARAMS
SOJG TB,.-1
CBLE11: PUSHJ PP,SETRPW## ;WRITE OUT RPWTAB, ALLOC PARAMS IF NECESSARY
;PUT IN LITERAL TABLE A LIST OF ALL PROGRAMS CALLED BY "CALL"
;SO LIBOL CAN CHAIN THE FILE TABLES
CALLS: HRRZ TA,ELITPC## ;SAVE LITERAL ADDR OF LIST FOR ENTRIES
MOVEM TA,SUBLST##
HRRZI TA,<CD.EXT>B20+1 ;REL ADDR OF 1ST ENTRY IN EXTAB
HRLZM TA,CUREXT##
PUSHJ PP,LNKSET## ;MAKE ABS PTR
HRRM TA,CUREXT
CALLS1: LDB TE,EX.CAL## ;THIS ENTRY REFERENCED BY A CALL
JUMPE TE,CALLS2 ;NO
LDB TE,EX.ENT## ;THIS AN ENTRY IN CURRENT PROGRAM?
JUMPN TE,CALLS2 ;YES, ERROR FLAGGED LATER BY IPCGEN
MOVE TA,[XWDLIT##,,2] ;MAKE ENTRY IN LITTAB
PUSHJ PP,STASHI
MOVEI TA,0 ;LEFT HALF = 0
PUSHJ PP,STASHL
HLRZ TA,CUREXT ;RT HALF = EXT ADDR
ANDI TA,77777
IORI TA,AS.EXT
PUSHJ PP,STASHL
AOS ELITPC
CALLS2: MOVE TA,CUREXT ;GET BACK EXTAB PTR
LDB TA,EX.CNT## ;GET COUNT OF EXTRA WORDS IN ENTRY
ADDI TA,2 ;BUMP UP TO NEXT ENTRY
HRLI TA,(TA)
ADDB TA,CUREXT
HRRZ TE,EXTNXT## ;END OF EXTAB YET?
CAILE TE,(TA)
JRST CALLS1 ;NO
MOVE TA,[OCTLIT##,,1] ;PUT 0 AT END OF LIST
PUSHJ PP,STASHI
MOVEI TA,0
PUSHJ PP,STASHL
AOS ELITPC
IFN DBMS,<
;SET UP ARGUMENTS FOR INITDB CALL (GENERATED IN START-UP CODE)
DBARGS: SKIPN SCHSEC## ; if not a DBMS program
JRST NODBMS ; don't generate INITDB arg list
HRRZ CH,ELITPC ;SAVE ADDR OF ERROR-STAT PROC TABLE
MOVEM CH,DBLITP## ;[656] STORE IN RH (DBLITP)
HRRZ TA,USELOC## ;[650] GET START ADDRESS NOW
HRRZ TB,USENXT## ;[650] GET END ADDRESS NOW
SUBI TB,1(TA) ;[650] TB = LEN OF USE TABLE - 1
SETZM CTR## ;INIT ENTRY COUNTER
JUMPLE TB,DBARG6 ;[650] IF TABLE IS EMPTY, SKIP THIS
MOVEI TA,1 ;[650] INITIAL RELATIVE ADDRESS
DBARG1: CAILE TA,(TB) ;END OF TABLE?
JRST DBARG6 ;YES
PUSH PP,TB ;[650] SAVE RELATIVE NUMBERS
PUSH PP,TA ;[650] CURRENT OFFSET
HRRZ TB,USELOC## ;[650] GET CURRENT ABSOLUTE START OF TABLE
ADD TA,TB ;[650] CURRENT ABSOLUTE ADDRESS
LDB TC,US.TYP## ;ERROR-STATUS ENTRY?
CAIE TC,%UT.ES
JRST DBARG3 ;NO
LDB TC,US.XTR## ;EXTRA WORDS ALLOCATED?
JUMPE TC,DBARG5 ;NO, BAD ENTRY
LDB TC,US.CNT## ;GET COUNT OF BYTES IN ENTRY
MOVE TD,[POINT 18,1(TA),17] ;SETUP PTR TO CODES
DBARG2: SOJL TC,DBARG4 ;CK CODE COUNTER
MOVE TA,[XWDLIT,,2] ;OUTPUT "XWD ERROR-CODE,%TAG-OF-PROC-PERF"
PUSHJ PP,STASHI
HRRZ TA,USELOC## ;[650] COMPUTE ABSOLUTE ADDRESS
ADD TA,(PP) ;[650]
ILDB TA,TD ;GET NEXT ERROR-CODE
CAIN TA,-1 ;[332] -1 MEANS USE FOR ALL E-S CODES
MOVEI TA,0
AOS CTR
HRLZI TA,(TA)
HRRI TA,AS.CNB
PUSHJ PP,STASHL
HRRZ TA,USELOC## ;[650] COMPUTE ABSOLUTE ADDRESS
ADD TA,(PP) ;[650]
LDB TA,US.PRO## ;GET TAG ADDR
IORI TA,AS.TAG##
PUSHJ PP,STASHL
AOS ELITPC ;BUMP PC
JRST DBARG2
DBARG3: LDB TC,US.XTR ;ANY EXTRA WORDS?
JUMPE TC,DBARG5 ;NO
DBARG4: HRRZ TA,USELOC## ;[650] COMPUTE ABSOLUTE ADDRESS AGAIN
ADD TA,(PP) ;[650]
LDB TC,US.CNT ;BUMP USETAB PTR OVER EXTRA WORDS
;[656] @ DBARG4 + 3 DELETED 4 INSTRUCTIONS
;[656] ADDI TC,5
;[656] MOVEI CH,5
;[656] IDIVM TC,CH
;[656] ADDM CH,(PP) ;[650] BUMP REL ADDRESS
LSH TC,-1 ;[656] TWO BYTES PER WORD
ADDI TC,1 ;[656] ACCOUNT FOR HEADER WORD
ADDM TC,(PP) ;[656] BUMP REL ADDRESS
DBARG5: POP PP,TA ;[650] POP ACS AND LOOP
POP PP,TB ;[650]
AOJA TA,DBARG1 ;[650] GO ON TO NEXT ENTRY
>
IFN DBMS,<
DBARG6: HRRZ TC,ELITPC ;SAVE ADDR OF ARRAY PTR
HRLM TC,DBLITP ;[656] IN LH (DBLITP)
MOVE TA,[XWDLIT,,2] ;PUT OUT HALF-WORD ARRAY DESCRIPTOR
PUSHJ PP,STASHI
HRLZ TA,CTR ;LEFT HF = # WORDS IN ARRAY
LSH TA,1 ;WORD COUNT * 2
HRRI TA,AS.CNB##
PUSHJ PP,STASHL
HRLZ TA,DBLITP ;[656] RT HF = ADDR OF ARRAY
TLO TA,AS.LIT
HRRI TA,AS.MSC
SKIPN CTR ;IF CTR = 0, RT HF = 0 ALSO
MOVEI TA,AS.CNB
PUSHJ PP,STASHL
AOS ELITPC ;BUMP PC
MOVE TA,[XTNLIT##,,1] ; entry contains external DBMLOK address
PUSHJ PP,STASHI
MOVEI TA,DBMLOK##
PUSHJ PP,STASHL
AOS TC,ELITPC
MOVE TA,[OCTLIT,,1] ;PUT OUT ARG-COUNT FOR ARG-LIST
PUSHJ PP,STASHI
MOVSI TA,-2
PUSHJ PP,STASHL
AOS TC,ELITPC ;SAVE ADDR OF ARG LIST
HRRZM TC,DBUSES##
MOVE TA,[XWDLIT,,2] ;PUT OUT ARG LIST ENTRY
PUSHJ PP,STASHI
HRLZI TA,(ARGHWA) ;LEFT = ARG TYPE
HRRI TA,AS.CNB
PUSHJ PP,STASHL
HLLZ TA,DBLITP ;[656] RIGHT = ADDR OF ARRAY DESCRIPTOR
TLO TA,AS.LIT
HRRI TA,AS.MSC
PUSHJ PP,STASHL
AOS ELITPC
MOVE TA,[XWDLIT,,2] ; 2nd arg points to adrs of DBMLOK
PUSHJ PP,STASHI
HLRZI TA,(ARG1WB) ; call it an integer, for want of better desc.
HRRI TA,AS.CNB
PUSHJ PP,STASHL
HRRZ TA,DBUSES ; DBMLOK adrs stored just before arg-cnt
SUBI TA,2 ; or 2 before start of INITDB arg-list
MOVSS TA
TLO TA,AS.LIT
HRRI TA,AS.MSC
PUSHJ PP,STASHL
AOS ELITPC
NODBMS: ; skip to here if no INITDB arg-list
>
IFN MCS,<
;SET UP CALL TO INITIALIZE "INTITIAL" CD ENTRY--
SKIPN FINITL## ;IS THERE ONE?
JRST MCSEND ;NO
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHI
MOVSI TA,-1
PUSHJ PP,STASHL
AOS TA,ELITPC ;XWD -1,0
HRRZM TA,M.IARG## ;SAVE ARG PTR
MOVE TA,[XWDLIT,,2]
PUSHJ PP,STASHI
MOVEI TA,640
PUSHJ PP,STASHL
MOVE TA,ELITPC
HRLZI TA,1(TA) ;GET ADDRESS OF .+1
TLO TA,AS.LIT
HRRI TA,AS.MSC
PUSHJ PP,STASHL
AOS ELITPC ;XWD 640,,.+1
MOVE TA,[BYTLIT##,,2]
PUSHJ PP,STASHI
HLRZ TB,FINITL##
ADD TB,CDLOC## ;GET ADDRESS OF CD ENTRY
HLRZ TA,2(TB) ;GET CD-REC ADDR
TLO TA,1B18 ;BITS 0-2 = 4
TRO TA,1B20 ;SET BIT 20
PUSHJ PP,STASHL
MOVSI TA,440700 ;SET BYTE POINTER
PUSHJ PP,STASHL
AOS ELITPC ;POINT 7,CD-REC
MOVE TA,[OCTLIT,,1]
PUSHJ PP,STASHI
MOVEI TA,^D87 ;SIZE OF INPUT RECORD
PUSHJ PP,STASHL
AOS ELITPC ;XWD 0,,SIZE
MCSEND:
>
;SET UP COLLATING SEQUENCE LITERALS FOR ALPHABET-NAMES
HRRZ TA,MNELOC##
ADDI TA,1 ;BYPASS ZERO
CSMNEL: MOVEM TA,CURMNE## ;SAVE IT
MOVE TB,1(TA) ;GET 2'ND WORD
TLNE TB,MTSYMB ;SYMBOLIC CHAR?
JRST CSMNEE ;YES, ACCOUNT FOR LN & CP
TLNN TB,MTALPA ;ALPHABET-NAME?
SOJA TA,CSMNEE ;[1363] NO, AND NO <LN,,CP> WORD EITHER
ANDI TB,777 ;YES, BUT IS IT A LITERAL?
JUMPE TB,CSMNEE ;NO
MOVE TC,[COLTMP##,,COLTMP+1]
SETOM COLTMP
BLT TC,COLZRL## ;INITIALIZE ALL OF TABLE
MOVN TB,TB
HRL TA,TB ;SETUP AOBJN POINTER
SETO TC, ;STORE POINTER (INCREMENTED BEFORE STORE)
SETZB TD,ILCSIX## ;ALSO COUNT AND SIXBIT OFFSET
SETZM EXCEBC## ;CLEAR EBCDIC ONLY COUNT
CSMNEN: MOVE TB,3(TA) ;GET LITERAL
TRZE TB,MTTHRU ;THRU?
JRST CSMNET ;YES
TRZE TB,MTALSO ;ALSO?
JRST CSMNEA ;YES
ADDI TC,1(TD) ;IN CASE ALSO
SETZ TD,
PUSHJ PP,CSMTST ;STORE IF FIRST TIME
JRST CSMNEJ ;GET NEXT
CSMNEA: PUSHJ PP,CSMTST ;STORE IF FIRST TIME
AOJA TD,CSMNEJ ;GET NEXT
CSMNET: ADDI TC,0(TD) ;INCASE ANY ALSO
MOVE TD,TB ;SAVE THRU LIT
MOVE TB,2(TA) ;GET PREVIOUS LITERAL
SUBM TB,TD ;GET -NO. TO DO
JUMPG TD,CSMNER ;ORDER IS REVERSED
ADDI TB,1 ;GET NEXT
HRL TB,TD ;AOBJN POINTER
SETZ TD,
CSMNEU: ADDI TC,1 ;POINT TO CURRENT
PUSHJ PP,CSMTST ;STORE IF FIRST TIME
AOBJN TB,CSMNEU ;LOOP
JRST CSMNEJ
CSMNER: SUBI TB,(TD) ;GET OTHER END
MOVN TD,TD ;GET - LENGTH
HRL TB,TD ;AOBJN LOOP PTR
MOVN TD,TD ;+ SIZE
ADDI TC,1(TD) ;GET LAST FIRST
SUBI TD,1 ;WHAT TO ADD ON WHEN FINISHED
CSMNEV: SUBI TC,1 ;POINT TO CURRENT
PUSHJ PP,CSMTST ;STORE IF FIRST TIME
AOBJN TB,CSMNEV ;LOOP
CSMNEJ: AOBJN TA,CSMNEN ;NOT YET
;NOW LOOP THROUGH TABLE FILLING IN MISSING VALUES
ADDI TC,1(TD) ;IN CASE ANY ALSO'S LEFT
MOVSI TA,-40 ;SCAN FIRST PART OF TABLE
PUSH PP,TC ;SAVE NUMBER KNOWN
CSMNEH: SKIPL COLTMP(TA)
JRST CSMNEI
HRLM TC,COLTMP(TA) ;STORE ASCII ONLY
AOS ILCSIX ;ACCOUNT FOR NON-SIXBIT CHARACTER
ADDI TC,1
CSMNEI: AOBJN TA,CSMNEH
HRLI TA,-100 ;SCAN REST OF SIXBIT TABLE
CSMNEF: SKIPL COLTMP(TA) ;ALREADY SET
JRST CSMNEG ;YES
HRLM TC,COLTMP(TA) ;STORE NEW VALUE
SUB TC,ILCSIX ;REMOVE EFFECT OF NO SIXBIT
HRLM TC,COLTMP+200(TA)
ADD TC,ILCSIX
ADDI TC,1
CSMNEG: AOBJN TA,CSMNEF ;TRY NEXT
HRLI TA,-40 ;SCAN LAST PART OF TABLE
CSMNEK: SKIPL COLTMP(TA)
JRST CSMNEM
HRLM TC,COLTMP(TA) ;NO SIXBIT
ADDI TC,1
CSMNEM: AOBJN TA,CSMNEK
POP PP,TC ;RESTORE COUNT
MOVSI TA,-400 ;SCAN EBCDIC TABLE
CSMNEO: HRRE TB,COLTMP(TA) ;GET EBCDIC PART
JUMPGE TB,CSMNEP ;ALREADY SET UP
HRRM TC,COLTMP(TA)
ADDI TC,1
CSMNEP: AOBJN TA,CSMNEO
;IF THIS IS THE PROGRAM COLLATING SEQUENCE SETUP VARIOUS POINTER
MOVE TA,CURMNE
HLRZ TB,(TA) ;GET NAMTAB ENTRY
ANDI TB,77777
CAME TB,COLSEQ## ;PROGRAM COLLATING SEQUENCE?
JRST CSMNEQ ;NO
MOVE TB,ELITPC ;WHERE IT WILL START
IORI TB,AS.LIT ;SET TYPE BIT
MOVEM TB,COLSQA## ;ASCII
ADDI TB,200
MOVEM TB,COLSQS## ;SIXBIT
ADDI TB,100
MOVEM TB,COLSQE## ;EBCDIC
CSMNEQ:
HRRZ TB,1(TA) ;GET SIZE
ADDM TB,CURMNE ;ACCOUNT FOR ALL BUT FIRST 2 WORDS
MOVE TB,ELITPC ;WHERE WE WILL STORE SEQUENCE
HRRM TB,1(TA) ;CHANGE TO BE LITTAB NOW
HRRZ TA,MNELOC
MOVN TA,TA
ADDM TA,CURMNE ;IN CASE EXPANSION
PUSH PP,W1 ;NEED A SAFE AC
;NOW TO OUTPUT THE ASCII COLLATING SEQUENCE
MOVE TA,[OCTLIT,,200]
PUSHJ PP,STASHI
MOVSI W1,-200
HLRZ TA,COLTMP(W1)
PUSHJ PP,STASHL
AOS ELITPC
AOBJN W1,.-3
;NOW TO OUTPUT THE SIXBIT COLLATING SEQUENCE
MOVE TA,[OCTLIT,,100]
PUSHJ PP,STASHI
MOVSI W1,-100
HLRZ TA,COLTMP+240(W1)
PUSHJ PP,STASHL
AOS ELITPC
AOBJN W1,.-3
;NOW TO OUTPUT THE EBCDIC COLLATING SEQUENCE
MOVE TA,[OCTLIT,,400]
PUSHJ PP,STASHI
MOVSI W1,-400
HRRZ TA,COLTMP(W1)
PUSHJ PP,STASHL
AOS ELITPC
AOBJN W1,.-3
POP PP,W1
HRRZ TA,MNELOC
ADDB TA,CURMNE ;PUT BASE BACK
; JRST CSMNEE ;ADD IN FIRST 2 WORDS
CSMNEE: ADDI TA,SZ.MNE+1 ;ADD IN NORMAL SIZE + <LN,,CP> IF ALPHABET-NAME
HRRZ TB,MNENXT##
CAIGE TA,(TB) ;FINISHED?
JRST CSMNEL ;NO
;NOW SEE WHAT PROGRAM COLLATING SEQUENCE IS
HRRZ TA,COLSEQ
CAIE TA,%AN.AS ;[1004] ASCII
CAIN TA,%AN.EB ;[1004] AND EBCDIC
HRROS COLSEQ ;[1004] ARE SPECIAL, SET LHS = -1 AS FLAG
JRST CSMEND ;ALL DONE
CSMNEZ: HRRZI DW,E.719 ;ERROR #
MOVE CP,CURMNE ;GET BASE
HLRZ LN,2(CP) ;RESTORE LN
HRRZ CP,2(CP) ;AND CP
PJRST WARN##
CSMTST: SKIPGE DEFDSP## ;IS THE DEFAULT DISPLAY-9
JRST CSMSTX ;YES
SKIPL COLTMP(TB) ;ALREADY SETUP?
JRST CSMNEZ ;YES, ERROR
PUSH PP,TB ;SAVE TB
CSMSTR: CAIL TB,200 ;IN ASCII RANGE?
SOJA TC,CSMSNA ;NO
HRLM TC,COLTMP(TB) ;STORE NEW ASCII VALUE
HRRZ TB,TB ;INCASE AOBJN PTR
CAIL TB,40 ;IS IT IN SIXBIT RANGE?
CAIL TB,140 ;...
JRST CSMSNS ;NO
SUB TC,ILCSIX ;REMOVE NON-SIXBIT COUNT
HRLM TC,COLTMP+200(TB) ;STORE SIXBIT
ADD TC,ILCSIX ;RESTORE COUNT
CSMSTE: SKIPGE DEFDSP ;IS THE DEFAULT DISPLAY-9
JRST CSMSTZ ;YES, WE'RE ALL DONE
;ROUTINE TO CONVERT AN ASCII CHAR TO EBCDIC.
CAIL TB,200 ;IS IT OUTSIDE ASCII RANGE?
JRST CSMSTG ;YES, USE AS IS
ROT TB,-2 ;FORM THE INDEX INTO THE TABLE.
JUMPL TB,CSMSTF ;LEFT OR RIGHT HALF?
HLR TB,ASEBC.##(TB) ;LEFT.
CAIA
CSMSTF: HRR TB,ASEBC.##(TB) ;RIGHT.
TLNN TB,(1B1) ;IS THE CHAR RIGHT JUSTIFIED?
LSH TB,-^D9 ;IT IS NOW.
ANDI TB,377 ;CLEAR JUNK
CSMSTG: ADD TC,EXCEBC ;ADD IN EXCESS COUNT
HRRM TC,COLTMP(TB) ;STORE EBCDIC
SUB TC,EXCEBC
CSMSTZ: POP PP,TB ;RESTORE
POPJ PP,
CSMSNA: AOSA EXCEBC ;ONE MORE THAT IS ONLY EBCDIC
CSMSNS: AOS ILCSIX ;ONE MORE THAT ISN'T SIXBIT
JRST CSMSTE ;TRY EBCDIC
CSMSTX: HRL TC,COLTMP(TB) ;GET CURRENT CHAR.
JUMPGE TC,CSMNEZ ;ALREADY EXISTS
HRRZ TC,TC ;CLEAR LHS.
ADD TC,EXCEBC ;ADD EXCESS
HRRM TC,COLTMP(TB) ;SAVE EBCDIC CHAR
SUB TC,EXCEBC
PUSH PP,TB ;SAVE CHAR
HRRZ TB,TB ;INCASE AOBJN PTR
;ROUTINE TO CONVERT AN EBCDIC CHAR TO ASCII.
ROT TB,-2 ;FORM THE INDEX INTO THE TABLE.
JUMPL TB,CSMSTY ;LEFT OR RIGHT HALF?
HLR TB,EBASC.##(TB) ;LEFT.
CAIA
CSMSTY: HRR TB,EBASC.##(TB) ;RIGHT.
TLNN TB,(1B1) ;IS THE CHAR RIGHT JUSTIFIED?
LSH TB,-^D9 ;IT IS NOW.
ANDI TB,177 ;CLEAR JUNK
CAIE TB,134 ;\ IS SPECIAL
JRST CSMSTR ;NOW STORE ASCII
HRRZ TB,0(PP) ;AS IT MIGHT BE ILLEGAL CHAR
CAIE TB,340 ;UNLESS EBCDIC \
SOJA TC,CSMSNA ;ILLEGAL SO DON'T STORE
MOVEI TB,134 ;RESTORE \
JRST CSMSTR ;AND STORE IT
CSMEND:
;IF WE HAVE SEGMENTATION GENERATE LITERAL OF FILE NAME
IFN TOPS20,<
SKIPGE NRESSN## ;NEED TO CREATE LITERAL TO OVRLAY FILE?
SKIPN BINJFN## ;IT NEEDS A REL FILE THOUGH
JRST OVREND ;NO
PUSH PP,T1 ;SAVE SOME ACCS
PUSH PP,T2
PUSH PP,T3
MOVE T1,[LITHLD,,LITHLD+]
SETZM LITHLD ;CLEAR JUNK
BLT T1,LITHLD+7 ;8 WORDS MAX (39 CHAR + NULL)
MOVE T1,[POINT 7,LITHLD##] ;SOMEWHERE TO HOLD FILE NAME
MOVE T2,BINJFN
MOVE T3,[FLD(.JSAOF,JS%NAM)] ;ASK FOR FILE NAME ONLY
JFNS%
ERJMP .+1
IBP T1 ;END WITH A NULL
HRRZ TB,T1 ;ADDRESS ONLY
SUBI TB,LITHLD-1 ;NO. OF WORDS USED
POP PP,T3
POP PP,T2
POP PP,T1
MOVE TA,ELITPC
MOVEM TA,SEGFLG ;STORE LITERAL ADDRESS OFFSET
MOVSI TA,ASCLIT##
HRR TA,TB
PUSHJ PP,STASHI## ;DON'T BOTHER TO POOL THIS ONE
MOVN TB,TB
HRLZ TB,TB ;AOBJN PTR
MOVE TA,LITHLD(TB) ;GET ASCII WORD
PUSHJ PP,STASHL##
AOBJN TB,.-2 ;LOOP
ADDM TB,ELITPC
OVREND:>
;SEE IF START ADDRESS IS IN NON-RESIDENT SEGMENT
HRRZS TA,PROGST## ;GET START ADDRESS
TRC TA,200000
TRCE TA,200000
JRST GO ;LEAVE IT ALONE
TRC TA,600000 ;CHANGE 2 TO 4 (PROTAB LINK)
PUSHJ PP,LNKSET
SKIPE DEBSW## ;NEED DEBUGGING CODE?
SKIPN DBPARM## ; FOR PROCEDURE-NAMES?
JRST DBEND ;NO
PUSH PP,TA ;SAVE PROTAB LINK
LDB TA,PR.FLO## ;GET FLOTAB LINK
ADD TA,FLOLOC## ;ADD IN BASE
LDB CH,FL.LN## ;GET LINE NUMBER
HRROM CH,PROGLN## ;SAVE IT FOR PHASE G
POP PP,TA
DBEND: LDB CH,PR.PRI## ;GET LEVEL
CAMGE CH,SEGLIM## ;IN RESIDENT SECTION?
JRST GO ;YES
PUSHJ PP,GETTAG## ;NO
HRL CH,PROGST
MOVEM CH,PROGST ;NON-RES ADDRESS,,TAG
LDB TA,[POINT 15,CH,35] ;MAKE SURE THE TAG IS REFERENCED
PUSHJ PP,REFTAG##
;NOW WE ARE READY FOR ACTION
GO: SETZM EINTO## ;IN CASE PHASE C OR D LEFT TRASH HERE
PUSHJ PP,ENTERS ;SET UP PP LIST WITH ENTERS AS RETURN WITH FINAL
;RETURN [POPJ PP,]
AOBJP PP,KILL ;RESET PP TO LOOK AT ENTERS ON FINAL POPJ
ENTERS: MOVE EACA,EOPLOC ;MOVE PUSHDOWN XWD TO KEEP TRACK OF MOVING TABLES
;REMEMBER! TABLES DYNAMICALLY ALLOCATED!.
;RETURNS FROM SUBROUTINES WILL GENERALLY BE
;TO THE TAG, "ENTERS:"
MOVEM EACA,EOPNXT
SETZB EACC,ETEMPC ;ZERO OUT OPERAND TALLY-ER &
;CURRENT TEMP STORAGE REQUIRED
;BY A PARTICULAR GENERATOR DURING OBJECT TIME.
COMEBK: PUSHJ PP,READEM ;READ OPERAND PAIR(S) UNTIL OP-CODE FOUND
;POPJ PP, IS EXPECTED TO RETURN YOU HERE
;OR TO CALLING GENERATOR
MOVEI EACD,(W2) ;SEE IF OP-CODE IS WITHIN RANGE OF TABLE
CAIG EACD,ELAST
GO2NXT: JRST [SKIPL EOPCOD(W2) ;YES, ANYTHING SPECIAL TO DO?
JRST @EOPCOD(W2) ;NO
MOVEM W1,PREVW1## ;YES, SAVE W1 (LINE# FOR DEBUG INFO)
SKIPG PROGLN ;HAVE WE SAVED DEBUG INFO YET?
SKIPE INDCLR## ;AND ARE NOT IN DECLARATIVES?
JRST @EOPCOD(W2) ;YES
LDB TE,[POINT 13,W1,28] ;NO GET LINE #
MOVEM TE,PROGLN ;AND SAVE IF FOR COBOLG
JRST @EOPCOD(W2)]
CAIE EACD,ENDIT ;NO--IS IT "ENDIT"?
JRST EBADOP ;NOPE, BAD OPCODE
;END OF PHASE E -- WRAP UP
ERAPUP: MOVEI EACA,0 ;SET 'NO OPERANDS'
PUSHJ PP,SEGCLN ;CLEAN UP ANY DANGLING EXITS
;AND DUMP ALTERS > 50.
;SET UP OFFSET POINTER FOR PHASE F-G.
MOVE TA,TEMBAS
ADD TA,ETEMAX
MOVEM TA,DATBAS ;DATBAS = TEMBAS + LARGEST TEMP AREA REQUIRED
;BY OBJECT TIME PROGRAM.
;[ETEMAX]
ADDB TA,FILTBL ;FILTBL = FILTBL + DATBAS
ADDB TA,USEBAS ;USEBAS = USEBAS + FILTBL
ADDB TA,IMPPAR ;IMPPAR = IMPPAR + USEBAS
ADD TA,EAS1PC ;A50BAS = IMPPAR + EAS1PC
MOVEM TA,A50BAS ;A50BAS NOW UPDATED
ADD TA,EALTMX
MOVEM TA,RESDNT ;RESDNT = A50BAS + EALTMX
ADD TA,EAS2PC ;NONRES = RESDNT + EAS2PC
MOVEM TA,NONRES
;PARAGRAPH & SECTION "DANGLING EXITS" CLEANED UP
;OFFSETS UPDATED,
;NOW CLOSE OUT YOUR FILES
MOVEI CH,0 ;EOF FOR AS1 = A HEADER WORD OF 0....
PUSHJ PP,PUTAS1
IFE TOPS20,<
CLOSE AS1, ;AS1 CLOSED OUT
>
MOVSI CH,177740 ;PUT OUT
PUSHJ PP,PUTASN ; 'END-FILE' ON CURRENT FILE
MOVEI CH,0 ;PUT OUT
PUSHJ PP,PUTAS2 ; END-OF-DATA ON AS2
IFE TOPS20,<
CLOSE AS2, ;AS2 CLOSED OUT....
>
MOVEI CH,0 ;PUT OUT
IFN TOPS20,<
SKIPLE AS3JFN## ;SKIP IF NOT OPEN
>
PUSHJ PP,PUTAS3 ; END-OF-DATA ON AS3
IFE TOPS20,<
CLOSE AS3, ;AS3 CLOSED OUT....
>
SETOI DW, ;ALL 1'S ON ERA FILE = EOF
PUSHJ PP,PUTERA
IFE TOPS20,<
CLOSE ERA, ;ERROR FILE CLOSED OUT!!!!!!
>
IFN TOPS20,<
PUSHJ PP,RITASY## ;Write out last partial buffers
PUSHJ PP,RITERA## ;Write out last partial buffer
PUSHJ PP,CLSAS1## ;CLOSE AS1FIL
PUSHJ PP,CLSAS2## ;CLOSE AS2FIL
SKIPLE AS3JFN ;SKIP IF NEVER OPENED
PUSHJ PP,CLSAS3## ;CLOSE AS2FIL
PUSHJ PP,CLSERA## ;CLOSE ERAFIL
>
;ALL FILES CLOSED THAT THIS PHASE CLOSES!!!!!!!!
ENDFAZ E; ;THAT'S ALL FOLKS/////------->
;GONE TO PHASE F-G---------------->
READEM: PUSHJ PP,GETGEN ;READ TWO 36-BIT WORDS FROM GENFIL.
;ALL ITEMS ARE TREATED AS TWO 36-BIT WORDS:
;FIGURATIVE CONSTANTS WILL CONTAIN MEANINGLESS
;INFORMATION IN THEIR 2ND WORDS.
;W1_FIRST WORD
;W2_SECOND WORD
SKIPL W1 ;OPERATORS WILL HAVE BIT 0 OF W1 = 0, AND ACCUMULATOR
;W2 WILL CONTAIN RIGHT JUSTIFIED, THE OP CODE
;OPERANDS WILL HAVE BIT 0 OF ACCUMULATOR W1 = 1.
GOBACK: POPJ PP, ;RETURN IF IT'S AN OPERATOR.
GOBAK1: PUSHJ PP,PUSH12 ;STASH W1&W2 IN EOPTAB
AOS EACC ;KEEP TRACK OF # OF COUPLETS STASHED IN OPERAND
;TEMPORARY TABLE, EOPTAB.
;GET MORE INPUT AND KEEP STASHING OPERANDS
;IN EOPTAB UNTIL YOU FIND AN OPERATOR.
;Reference Modification code
TXNE W1,GNREFM ;is operand reference modified?
CAMN W1,[-1] ;Perhaps, but -1 is just junk
JRST READEM ;no
TLNE W1,GNFIGC ;is it FC of low-values?
JRST READEM ;yes
SETOM RMFLAG## ;turn on flag
GOBAK2: PUSHJ PP,GETGEN ;read next GENFIL pair
HRRZ TA,W2 ;
JUMPGE W1,GOBAK3 ;Not an operand
PUSHJ PP,PUSH12 ;yes, stack it
AOJA EACC,GOBAK2 ;increment count and return
GOBAK3: CAIE TA,OPEXP ;if operator, should be for EXPRGN
JRST GOBK.E ;it's not - error
PUSHJ PP,EXPRGN ;evaluate expression
PUSHJ PP,GETGEN ;get next two word pair
HRRZ TA,W2 ;
CAIE TA,OPREFM ;should be operator for Ref. Mod.
JRST GOBK.E ;it's not - error
PUSHJ PP,REFMOD## ;adjust operand on EOP stack
TXNE W1,RFMBTH ;does a length modifier follow?
JRST GOBAK2 ;yes
SETZM RMFLAG## ;no, zero flag
MOVE EACA,EOPNXT ;reset stack pointer
JRST READEM ;continue read of GENFIL as usual
;If error, clean modifiers off EOP stack and shut off GNREFM bit,
; try to continue processing as though the field were not modified
GOBK.E: CAIE TA,105 ;
JRST GBK.E1 ;
TLNE W1,400 ;If 400 bit on, error caused scan to
JRST YECCH ; a period, so wipe out all
GBK.E1: MOVE TA,EOPNXT ;
SKIPA ;
GBK.E2: SOS TA ;continue through rest of EOP stack
MOVE TB,0(TA) ; searching for operands
JUMPGE TB,GBK.E2 ; until finding the one
TXNN TB,GNREFM ; that has been reference modified
JRST GBK.E2 ;
TLNE TB,GNFIGC ;is it FC of low-values?
JRST GBK.E2 ; yes
TXZ TB,GNREFM ;
MOVEM TB,0(TA) ;put it back w/ ref mod flag off
MOVE TE,1(TA) ;get second word of the operand
HLRZ TB,1(TA) ;get LH of second word
LSH TB,1 ;count of modifier words
AOS TA ;
ADD TA,TB ;
MOVEM TA,EOPNXT ;RM
SETZM RMFLAG ;zero flag
CAIN W2,OPYECC ;
JRST READEM ;try continuing
SKIPL W1 ;
POPJ PP, ;try to process last op code read
JRST GOBAK1 ;continue as though operand not modified
;THE GENERATOR DISPATCH TABLE
EOPCOD: EXP EBADOP ; 0 SUBROUTINE ADDRESSES FOR THE VARIOUS OP CODES
VECTOR MOVGEN,DB ; 1
VECTOR ADDGEN,DB ; 2
VECTOR ADDTGN,DB ; 3
VECTOR SUBGEN,DB ; 4
VECTOR SUBFGN,DB ; 5
VECTOR MULGEN,DB ; 6
VECTOR MULBGN,DB ; 7
VECTOR DIVGEN,DB ; 10
VECTOR RESGEN ; 11
VECTOR REMGEN ; 12
VECTOR DIVBGN,DB ; 13
VECTOR DECLST ;[435] 14 START DECLARITIVES
VECTOR DECLEN ;[435] 15 END DECLARITIVES
EXP EBADOP ; 16
EXP EBADOP ; 17
VECTOR IFGEN,DB ; 20
VECTOR IFCGEN,DB ; 21
VECTOR IFTGEN,DB ; 22
VECTOR SPIFGN ; 23
VECTOR ELSEGN ; 24
VECTOR IFUGEN ; 25 IF IN PERFORM VARYING UNTIL
VECTOR ENDIFG ; 26
EXP EBADOP ; 27
VECTOR GOGOGN,DB ; 30
VECTOR GODPGN,DB ; 31
VECTOR PERFGN,DB ; 32
VECTOR PRFYGN,DB ; 33
VECTOR ALTGEN,DB ; 34
VECTOR SRCHGN,DB ; 35
VECTOR SINCGN ; 36
VECTOR GOBKGN,DB ; 37
VECTOR STOPGN,DB ; 40
EXP EBADOP ; 41
VECTOR INSPGN,DB ; 42
VECTOR SETTGN,DB ; 43
VECTOR SETDGN,DB ; 44
VECTOR SETUGN,DB ; 45
EXP ARGGEN ; 46
VECTOR CALLGN,DB ; 47
VECTOR COMPGN,DB ; 50
VECTOR CADDGN ; 51
VECTOR CSUBGN ; 52
VECTOR CMULGN ; 53
VECTOR CDIVGN ; 54
VECTOR CEXPGN ; 55
EXP EBADOP ; 56
VECTOR CENDGN ; 57
;THE GENERATOR DISPATCH TABLE (CONT'D).
VECTOR ACCGEN,DB ; 60
VECTOR DISPGN,DB ; 61
VECTOR OPENGN,DB ; 62
VECTOR CLOSGN,DB ; 63
VECTOR READGN,DB ; 64
VECTOR RITEGN,DB ; 65
VECTOR REWGEN,DB ; 66
VECTOR STRTGN,DB ; 67
VECTOR LPARGN ; 70
VECTOR RPARGN ; 71
VECTOR EXPRGN ; 72
VECTOR ENDXGN ; 73
VECTOR JUMPTO; ; 74
EXP EBADOP ; 75
EXP GOBACK ; 76
VECTOR NTRYGN ; 77
VECTOR SECGEN ;100
VECTOR PARGEN ;101
VECTOR TAGGEN ;102
EXP EBADOP ;103
VECTOR SEGBRK; ;104
EXP YECCH ;105
EXP NOOP ;106
VECTOR SCOLGN ;107
VECTOR SORTGN,DB ;110
VECTOR SKEYGN ;111
VECTOR SINGN ;112
VECTOR SOUTGN ;113
VECTOR SGIVGN ;114
VECTOR SUSEGN ;115
VECTOR SENDGN ;116
VECTOR MERGGN,DB ;117
VECTOR RELSGN ;120
VECTOR RETNGN ;121
VECTOR DELGEN,DB ;122
VECTOR INITRW,DB ;123
VECTOR GENRW,DB ;124
VECTOR TERMRW,DB ;125
VECTOR TRCGEN,DB ;126
EXP EBADOP ;127
VECTOR CANGEN,DB ;130
IFN DBMS,<VECTOR IFDBGN,DB> ;131
IFE DBMS,<EXP NOTIMP>
IFN MCS,<VECTOR DISGEN,DB ;132
VECTOR ACTGEN,DB ;133
VECTOR SNDGEN,DB ;134
VECTOR RCVGEN,DB> ;135
IFE MCS,<EXP NOTIMP
EXP NOTIMP
EXP NOTIMP
EXP NOTIMP>
VECTOR STRGEN ;136=SDELIM
EXP GOBACK ;STRNG - MUST HAVE BEEN A SYNTAX ERROR
; IT SHOULD BE READ IN BY STRGEN.
VECTOR UNSGEN ;140=UDELIM
VECTOR UNSGEN ;141=UNSDES
EXP GOBACK ;UNSTR - MUST HAVE BEEN A SYNTAX ERROR
; IT SHOULD BE READ IN BY STRGEN.
VECTOR FENQGN ;143 FILE ENQUEUE
VECTOR FUNAVG ;144 FILE UNAVAILABLE
VECTOR EFUNAV ;145 END FILE UNAVAILABLE
VECTOR EFENQG ;146 END FILE ENQUEUE
VECTOR RENQGN ;147 RECORD ENQUEUE
VECTOR ERENQG ;150 END RECORD ENQUEUE
VECTOR ERUNAV ;151 END RECORD UNAVAILABLE
VECTOR RDEQGN ;152 RECORD DEQUEUE
VECTOR ERDEQG ;153 END RECORD DEQUEUE
VECTOR ENRGEN ;154 END NOT RETAINED
VECTOR INSPCG,DB ;155 INSPECT CONVERTING
VECTOR INSPTG,DB ;156 INSPECT TALLYING
VECTOR INSPRG,DB ;157 INSPECT REPLACING
VECTOR CBPHE ;160 COMPILER-BREAK-ON-PHASE (E,F,O, OR G)
VECTOR SUPPRS ;161 SUPPRESS
VECTOR SETCGN,DB ;162 SET condition-name TO TRUE
VECTOR SETNGN,DB ;163 SET mnemonic-name TO ON
VECTOR SETFGN,DB ;164 SET mnemonic-name TO OFF
VECTOR EVALGN,DB ;165 EVALUATE
VECTOR INITGN,DB ;166 INITIALIZE
VECTOR IPRFGN,DB ;167 In-line PERFORM
VECTOR EPRFGN ;170 End in-line PERFORM
VECTOR EVTFGN ;171 TRUE/FALSE for EVALUATE
VECTOR EVNYGN ;172 ANY for EVALUATE
VECTOR EVNDGN ;173 END-EVALUATE
VECTOR EVSNGN ;174 END-SS in EVALUATE
VECTOR EVSSGN ;175 Process selection subject/object
VECTOR REFMOD ;176 Reference Modification
VECTOR ADTGGN,DB ;177 ADD ... TO ... GIVING
ELAST=.-1-EOPCOD
;TROUBLE WITH SYNTAX
YECCH: SETZM TAGTRU
SETZM ECXTRA
SETZM EMULSZ
SETZM ERESDP
SETZM FLTDIV## ;[637] INCASE OF EXPRESSION SCREW-UP
SETZM CMPLVL## ;INCASE IN COMPUTE
NOOP: POPJ PP,
EXTERNAL TAGTRU,ECXTRA,ERESDP,EMULSZ,AS.EXT
EBADOP: OUTSTR [ASCIZ "?Compiler error: bad GENFIL operator
"]
JRST READEM ;DIE AND DUMP EVERYTHING.
;The following routines should never be entered directly
ARGGEN: MOVEI DW,E.282
LDB CP,W1CP
LDB LN,W1LN
PUSHJ PP,FATAL
JRST COMEBK ;CONTINUE PROCESSING GENFIL
;PUT OUT DIAG 'NOT IMPLEMENTED IN THIS VERSION'
EXTERNAL W1LN,W1CP,FATAL
NOTIMP: LDB LN,W1LN
LDB CP,W1CP
MOVEI DW,E.91
JRST FATAL
END COBOLE