Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/cobole.mac
There are 14 other files named cobole.mac in the archive. Click here to see a list.
; UPD ID= 1613 on 5/17/84 at 9:53 AM by HOFFMAN                         
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
;NAME	DATE		COMMENTS

;V13 RELEASED   *****
;JEH	16-MAY-84	[1535] Adjust subscript count if error w/ ref. modifier
;JEH	26-APR-84	[1522] Clean up EOP stack if error w/ ref. modifiers

;V12B RELEASED  *****
;DMN	21-Jun-82	[1363] Fix errors in handling alphabet-name in SPECIAL-NAMES.

;V12A 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
	TSWFZ	FERROR		;[1522] Error detected with modifiers?
	JRST	GBK.E1		;[1522] Yes, clear EOP stack
	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
	TXNE	W1,RFMLEN	;[1535] If length modifier triggered error,
	SUBI	TB,2		;[1535]  sub count includes ref modifiers
	SKIPGE	TB		;[1535]
	SETZ	TB,		;[1535]
	HRLM	TB,1(TA)	;[1535]
	LSH	TB,1		;count of modifier words
	AOS	TA		;
	ADD	TA,TB		;
	MOVEM	TA,EOPNXT	;RM
	SETZM	RMFLAG		;zero flag
	CAIE	W2,OPREFM	;[1522]
	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