Google
 

Trailing-Edge - PDP-10 Archives - BB-H580E-SB_1985 - xfrgen.mac
There are 7 other files named xfrgen.mac in the archive. Click here to see a list.
; UPD ID= 3346 on 1/16/81 at 2:29 PM by NIXON                           
TITLE	XFRGEN FOR COBOL V12C
SUBTTL	TRANSFER-OF-CONTROL GENERATORS		SERG POLEVITSKY/ALB/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

;EDITS
;NAME	DATE		COMMENTS

;V12A****************
;WTK	 8-Jan-81	[1111] PERFORM LIMIT EXCEEDED when doing many executions of DECLARATIVES.
;DMN	 1-FEB-80	[762] IMPLEMENT AND USE D. P. FLOATING POINT LITERALS

;V12*****************
;DAW	28-SEP-78	[561] FIX "GO DEPENDING" - /O PROBLEM

;V10*****************
;	10-AUG-76	[435] PUT IN CODE TO JUMP AROUND DECLARITIVES IN A DBMS PROG
;	14-APR-76	[425] FIX KPROG CALL IN NON-RESIDENT SECTION.
;DBT	1/20/75		SET AND CLEAR FLAG INDICATING INSTRUCTIONS
;			NOT BEING PUT INTO ASY RATHER LITTAB
;			SET AT SEGCLN AND CLEAR AT EBURPX
;DBT	1/18/75		IN GOENTR AND GOALTD THE REVERSED ORDER
;			OF PUTASY AND PUTASN CALLS IS FOOLING THE 
;			UUO CONVERTER - REVERSE THEM
;			ALSO EXITRP
;			IT IS NOT CLEAR THATTHIS WILL WORK BUT IT'S
;			WORTH A TRY
;ACK	22-APR-75	CONVERT LITAB EBCIDC CODE TO ASYFIL EBCDIC
;			CODE WHEN TRANSFERING LITERALS TO THE ASY FILES.
;********************

; EDIT 271 FIX SO THAT GENERATED PARA NAME NEVER GETS TRACED
;**; EDIT 210 ADD TO FIX 167-LITTAB OVERFLOW
;*;	EDIT 167 JEC 3/14/74 FIXES LITTAB OVERFLOW.
;		IN THIS ROUTINE THE REQUIREMENT THAT THE ENTIRE
;		LITERAL BE ALL IN CORE IS REMOVED.



TWOSEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

RELOC	400000
SALL
ENTRY XFRGEN
XFRGEN:

INTERNAL PARGEN,GOGOGN,SECGEN,ALTGEN,PERFGN,STOPGN,GODPGN,PRFYGN
INTERNAL  EWARN, RESOLV, SOLVER
INTERNAL TAGGEN, JUMPTO, SEGBRK, SEGCLN
INTERNAL DECLST,DECLEN	;[435]
EXTERNAL DCLTAG		;[435]
EXTERNAL INDCLR
EXTERNAL BADEOP,FATAL,WARN,LNKSET,DEVDED
EXTERNAL PUTAS1,PUTASY,PUTASN,DISPGN,PUTTAG,KILL,KILLF
EXTERNAL XPNALT,XPNLIT,XPNSEC,SETSEG,OPNFAT,PUT.EX,PUT.PJ,PUT.SX
EXTERNAL STASHP,STASHQ,POOLIT,PLITPC
EXTERNAL COMEBK
EXTERNAL TB.DAT,ESAVER,CUREOP,EOPLOC
EXTERNAL EBASEA,EMODEA,EDPLA,ESIZEA,EINCRA
EXTERNAL EBASEB,EMODEB,EDPLB,ESIZEB,EBASBX,EINCRB
EXTERNAL SOSLE.,SOSGE.,JRST.
EXTERNAL EAS1PC,AS.PAR,D1MODE,LTMODE,FCMODE,AS.OCT
EXTERNAL OPLINE


;CHECK PROTAB ENTRY FOR VALIDITY

DEFINE ISOPOK (ACSYM),<
	TRNE	ACSYM,PTDEF	;IS OPERAND DEFINED?
	TRNE	ACSYM,PTMULD	;BUT NOT MULTIPLY DEFINED?
	POPJ	PP,		;BAD OPERAND
	>
SUBTTL MISCELLANEOUS GENERATORS

TAGGEN:	HLRZ	CH,W2		;GET TAG NUMBER
	PUSHJ	PP,PUTTAG	;PUT TAG INTO TAG TABLE
	JRST	COMEBK		;RETURN WITHOUT DISTURBING EOPTAB

JUMPTO:	HLRZ	CH,W2		;GET TAG FROM LEFT HALF OF W2.
	ANDI	CH,TM.TAG
	IOR	CH,[XWD	JRST.,AS.TAG]	;CH _ JRST TAG [TAG CONVERTED TO F-G NOTATION].
	HRRZ	TA,CH		;GET TAG NUMBER
	PUSHJ	PP,REFTAG##	;REFERENCE IT
	PUSHJ	PP,PUTASY	;WRITE IT OUT
	JRST	COMEBK		;RETURN WITHOUT DISTURBING EOPTAB


SEGBRK:	SKIPE	TA,EPSECT	;CHECK TO SEE IF ANY SECTIONS PRIOR
				;TO THIS ONE [IF NOT, HOW COME THERE IS
				;A PRIORITY # FLOATING AROUND?]


	JRST	SETSEG		;PULL THE SCATTERED SEGMENT TOGETHER
	OUTSTR	[ASCIZ "Internal error: segment # found but no sections detected
"]
	JRST	KILL

;[435] FOR A DBMS PROG JUMP AROUND DECLARITIVES FROM DBMS SECTION
DECLST:	SETOM	INDCLR		;FLAG THAT WE ARE IN THE DECLARATIVES
IFN DBMS,<
	SKIPN	SCHSEC##	;IS THIS A DBMS PROGRAM?
>
	POPJ	PP,		;NO
IFN DBMS,<
	PUSHJ	PP,GETTAG	;[435] JUST BEFORE START OF DECLARITIVES GET A TAG TO JUMP TO
	HRLI	CH,JRST.	;[435] PUT IN JRST %TAG
	HRRZM	CH,DCLTAG	;[435] SAVE FOR LATER PUTTAG ADDR ASSIGNMENT
	HRRZ	TA,CH		;GET TAG NUMBER
	PUSHJ	PP,REFTAG##	;REFERENCE IT
	PJRST	PUTASY		;[435] PUT JRST %TAG INTO ASY FILE
>

DECLEN:	SETZM	INDCLR		;FLAG THAT WE ARE OUT OF THE DECLARATIVES
IFN DBMS,<
	SKIPE	SCHSEC		;IS THIS A DBMS PROGRAM?
	HRROS	DCLTAG		;[435] FLAG THAT WE ARE AT END OF DECLARITIVES
>
IFN ANS74,<
	HRRZ	CH,PROGLN##	;GET LINE NO. OF FIRST PROCEDURE
	DPB	CH,[POINT 13,PREVW1,28]	;SET IT INCASE FIRST PROCEDURE HAS NO VERB
>
	POPJ	PP,		;[435] RETURN
SUBTTL SECTION GENERATOR



				SEENIT=1B35



SECGEN:	HRRZ	TA,EOPLOC	;IS THERE ONE AND ONLY ONE OPERAND?
	HRRZ	EACA,EOPNXT
	CAIE	TA,-2(EACA)
	JRST	BADEOP		;NO--TROUBLE

	HRRZ	TA,(EACA)	;GET PROTAB POINTER.
	PUSHJ	PP,LNKSET	;CONVERT LINK TO REAL ADDRESS

	HRRZ	EACD,2(TA)	;GET PRIORITY # FROM PROTAB

	TROE	EACD,SEENIT	;CHECK TO SEE IF
				;YOU HAVE SEEN THIS SECTION BEFORE
				;AND MARK IT AS "SEEN".
				;IF YOU HAVE SEEN A SECTION BEFORE &
				;BECAUSE OF SEGMENTATION
				;YOU ARE DOING RANDOM READING, THE COMPILER
				;COULD ENDLESSLY LOOP IF YOU DIDN'T DO THIS
				;CHECK

	JRST	PREVLP		;PREVENT ENDLESS RE-READING OF THE SOURCE.
	HRRM	EACD,2(TA)	;UPDATE PROTAB ENTRY.



	LDB	EACC,FLAGPS	;GET PREVIOUSLY-SEEN SECTION'S FLAGS & PRIORITY #
	ANDI	EACC,ENREZE	;STRIP OFF ALL BUT PRIORITY BITS FOR LAST-SEEN OPERATOR
	ANDI	EACD,ENREZE	;STRIP OFF SECTION PRIORITY BITS FOR ITEM HELD IN HAND
	CAIE	EACC,(EACD)	;EQUAL ?
	PUSHJ	PP,SEGCLN	;NOPE! CHECK TO SEE IF CLEAN UP NECESSARY
				;THEN PROCESS THE OPERATOR HELD IN HAND

	SKIPGE	W2,EPPARA	;IF 1ST PARAGRAPH NOT SEEN YET, OR LAST
				;PARAGRAPH DOES NOT REQUIRE AN EXIT,
				;DO NOT CHECK LAST
				;PARAGRAPH'S STATUS.
				;BIT 0 WILL BE UP IN EPPARA IF EXIT REQUIRED
	PUSHJ	PP,ESETUP	;SET POINTERS UP FOR CALL TO PARGEN

	MOVEI	EACC,EPSECT	;POINTER NOW REFLECTS FLAGS AND LINK
				;FOR THE SECTION OPERATOR.

	SKIPL	W2,EPSECT	;IF PREVIOUS SECTION NEEDS EXIT, OR
	TLNE	W2,PTDECL*2	;  IT IS IN DECLARATIVES,
	PUSHJ	PP,EXITRP	;  PUT OUT EXIT.
	JRST	EGETPR		;LEAVE FROM HERE FOR PARGEN.  

ESETUP:	MOVEI	EACC,EPPARA	;TELL PARGEN THAT PREVIOUS
				;PROCEDURE NAME WAS A PARAGRAPH
				;NAME.
	JRST	EXITRP		;GO TO PARGEN


PREVLP:	OUTSTR	[ASCIZ "Internal error: incorrect source linkage
"]
	JRST	KILL
SUBTTL THE PARAGRAPH GENERATOR

	EPAREX=1B18		;THE ALERT FLAG TO SIGNAL THE
				;GENERATING OF AN EXIT AT THE END OF
				;THE LAST-SEEN PROCEDURE NAME OF TYPE
				;SPECIFIED BY (EACC).

	ECPFLG=6B20		;CHANGE THE PROTAB FLAG FROM
				;PHASE E NOMANCLATURE TO PHASE F-G
				;NOMANCLATURE.


PARGEN:	HRRZ	TA,EOPLOC	;IS THERE ONE AND ONLY ONE OPERAND?
	HRRZ	EACA,EOPNXT
	CAIE	TA,-2(EACA)
	JRST	BADEOP		;NO--TROUBLE

	MOVEI	EACC,EPPARA	;ADDRESS FOR WHICH "PREVIOUS"
				;PROCEDURE NAME WILL APPLY.
				;
				;
	SKIPGE	W2,EPPARA	;AS YOU COME TO THE PARAGRAPH
				;GENERATOR, EPPARA CAN BE EITHER
				;> 0 , OR = 0, THEN NO CHECKING NEEDED
				;< 0 THEN   CHECKS NEED TO BE MADE
	PUSHJ	PP,EXITRP	;AN EXIT IS REQUIRED!
;IF YOU COME FROM SCANNER ROUTINE,I.E., PARGEN CALLED DIRECTLY, YOU WILL
;BE INTERESTED IN THE PREVIOUS AND CURRENT PARAGRAPH OPERATORS.

;IF YOU COME FROM SECGEN, THEN YOU WILL BE INTERESTED IN THE PREVIOUS SECTION
;AND CURRENT SECTION OPERATORS

;IF YOU CAME TO THE PARAGRAPH GENERATOR AS PART OF THE CLEAN UP ACTIVITY AT
;A SEGMENT BREAK OR THE END OF PHASE E, THEN ALL THAT YOU
;ARE INTERESTED IN DOING IS GENERATING AN EXIT IF IT IS REQUIRED.

EGETPR:	MOVE	CH,EPGFIX	;"I AM A SECTION OR PARAGRAPH" TO CH.
				;RIGHT HALF LOADED WITH MASK WHICH WILL
				;CHANGE TABLE LINK TYPE FROM 4 TO 2.


	HRRZ	TA,(EACA)	;GET PROTAB LINK AS POINTED TO BY EACA.
	XORI	CH,(TA)		;CHANGE D-E NOTATION TO F-G NOTATION
				;FOR PROTAB ENTRY.

	HRRM	TA,(EACC)	;UPDATE EPSECT OR EPPARA WITH CURRENT PROTAB ENTRY.

	PUSHJ	PP,LNKSET	;GET REAL ADDRESS
IFN ANS74,<
	LDB	EACD,PR.DEB	;DEBUGGING ON THIS PARA?
	JUMPE	EACD,EGTPR1	;NO
	PUSH	PP,CH		;SAVE PARA NAME
	MOVE	CH,[SKIPA.##+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.DOT+1
	PUSHJ	PP,PUTASY	;SKIPA 16,.+1
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	MOVEI	CH,DBP%FT	;FALL THROUGH CODE
	PUSHJ	PP,PUTASN	;IN LHS
	LDB	CH,[POINT 13,PREVW1##,28]	;GET LINE # OF PREVIOUS  OPERATOR
	PUSHJ	PP,PUTASY
	MOVE	CH,[MOVEM.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVE	CH,DBPARM
	IORI	CH,AS.PAR
	PUSHJ	PP,PUTASY	;MOVEM 16,%PARAM+N
	POP	PP,CH
EGTPR1:>
	HRLZ	EACD,2(TA)	;EACD _ FLAG BITS FROM PROTAB
				;SEE COBOL MEMO 100-350-011.1
				;PAGES 15 - 16.
				;UNDER PROTAB FLAGS.

	TLNN	EACD,PTDEF	;IF ITEM IS NOT DEFINED,
	TLNE	EACD,PTMULD	; [271]  ON MEANS GENERATED PARA NAME
	SKIPA			; [271]
	POPJ	PP,		;  FORGET IT

	HRRZM	TA,CURPRO	;SAVE ADDRESS OF THIS ENTRY
	LSH	EACD,-^D1	; !.... SHIFT EACD RIGHT SO AS TO BE
				;ABLE TO FIT IN A FLAG IN THE SIGN BIT DENOTING
				;WHETHER OR NOT AN EXIT IS REQUIRED.
				;IF EITHER EPPARA OR EPSECT NEEDS EXIT

				;FOR CURRENT PROCEDURE NAME, CELL IS LESS THAN 0.

	TLNE	EACD,1B27	;BIT 26 (BEFORE THE LSH EACD,-1), NOW BIT 27
				;EQUIVALENT IN THE LEFT HALF OF EACD.
				;SAYS WHETHER OR NOT ITEM REQUIRES EXIT GENERATED
				;IF AN EXIT IS NEEDED, THEN
				;BIT 27'S LEFT HALF EQUIVALENT IS ON.  IF NO EXIT,
				;THEN BIT 27'S EQUIVALENT IN LEFT HALF IS OFF.
				;SKIP IF OFF.
	TLO	EACD,EPAREX	;EXIT REQUIRED FLAG GOES UP

				;PROTAB FLAGS +
	HLLM	EACD,(EACC)	;FLAG FOR EXIT <IF NEEDED> IN LEFT HALF
				;<LINK TO PROTAB IN RIGHT HALF>
				;RESULT ALSO LEFT IN EACD.
	TLNE	EACD,ENREZF	;IF ITEM IS RESIDENT (PRIORITY # FROM PROTAB ENTRY
				;IS ZERO IN BITS 19-25 (AFTER LSH -1))
				;PUT CH OUT ONTO AS2.
				;IF NON-RESIDENT, PUT ONTO AS3.
				;SKIP IF RESIDENT.

	SKIPA	TC,EAS3PC	;PRIORITY NOT = 0--->GET NON-RES PPC\
	MOVE	TC,EAS2PC	;PRIORITY = 0 ---> GET RES-PPC.

	MOVE	TA,CURPRO
	HRRM	TC,1(TA)	;PROTAB ENTRY UPDATED!

	PUSHJ	PP,PUTASN	;SECTION  OR PARAGRAPH OPERATOR GOES OUT
				;AND PPC IS NOT! BUMPED.
IFN DBMS,<
	SKIPL	DCLTAG		;[435] ARE WE AT END OF DECLARITIVES?
	JRST	EGTPR3		;[435] NO
	HRRZ	CH,DCLTAG	;[435] YES--GET JUMP TO TAG
	PUSHJ	PP,PUTTAG	;[435]   AND ASSIGN IT HERE
	SETZM	DCLTAG		;ONLY DO IT ONCE
EGTPR3:>			;[435]
	TLNE	EACD,PTDEF/2	; [271] IF GENERATED NAME NO TRACE
	SKIPE	PRODSW		;IF '/P' TYPED,
	POPJ	PP,		;  NO TRACE CODE

IFN CSTATS,<
	SKIPN	METRSW##	;METER--ING?
	 JRST	EGTNNN		;NO
	MOVE	CH,[MOVEI.+AC16,,^D1476] ;1476= PARAGRAPH TRACE CODE
	PUSHJ	PP,PUTASY##
	MOVEI	CH,METER.##
	PUSHJ	PP,PUT.PJ
EGTNNN:	>;END IFN CSTATS
	MOVEI	CH,C.TRCE##
	PUSHJ	PP,PUT.PJ
	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTASN
IFN ANS74,<
	MOVE	TA,CURPRO	;JUST INCASE
	LDB	CH,PR.DEB##	;DEBUGGING REQUIRED?
	SKIPN	CH
	AOSA	CH		;NO, SET CH TO 1 WORD
	MOVEI	CH,TC.DB+2	;YES, NEED 2 WORDS
>
IFN ANS68,<
	HRRZI	CH,1		;ARG COUNT
>
	PUSHJ	PP,PUTASN
	HRRZ	CH,0(EACC)
IFN ANS68,<
	TRZ	CH,700000	;GRNTEE ADRCON
	JRST	PUTASY		;PUT OUT CODE
>
IFN ANS74,<
	PUSHJ	PP,GETPR%	;GET CORRECT %PR OFFSET
	PUSHJ	PP,PUTASY
	LDB	CH,PR.DEB	;DID WE WANT DEBUGGING USE
	JUMPE	CH,CPOPJ##	;NO
	PUSH	PP,CH		;YES
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	HRLZ	CH,DBPARM##	;GET %PARAM TO USE
	TLO	CH,AS.PAR	;MAKE INTO %PARAM+N
	HRRI	CH,AS.MSC
	PUSHJ	PP,PUTASN
	POP	PP,TA		;DEBUG USE PROCEDURE
	ADD	TA,USELOC##	;POINT TO USE TABLE
	LDB	CH,US.PRO##	;GET TAG OF USE PROCEDURE
	JRST	PUTASY		;PUT OUT CODE
>

				;THE RETURN IS EITHER TO ENTERS IN THE
				;SCANNER ROUTINE
				;TO A CLEAN UP ROUTINE ,
				;OR TO THE SECTION GENERATOR

IFN ANS74,<
GETPR%:	TRZ	CH,700000	;GRNTEE ADRCON
	PUSH	PP,CH+1		;WE NEED TO CHANGE THE SIZE
	IDIVI	CH,SZ.PRO	; BECAUSE THE COMPILER USES SZ.PRO = 5
	IMULI	CH,SZ.PR6	; WORDS, WHERE AS COBDDT ONLY SEES SZ.PR6 = 4
	ADD	CH,CH+1		;WORDS. ADD IN THE EXTRA 1
	POP	PP,CH+1		;THIS SAVES SPACE AND MAKES -68 AND -74 THE SAME
	POPJ	PP,
>
EPGFIX:	XWD	740000,ECPFLG	; THE XOR OPERATION WITH THIS MASK
				;WILL SET UP THE PARAGRAPH OPERATOR USED
				;IN THIS PHASE (PHASE E) SO AS TO BE INTELLIGIBLE
				;TO THE ASSEMBLY PHASE.


EXITRP:	MOVSI	CH,1B18		;RESET EXIT REQ'D FLAG FOR THIS PROCEDURE NAME
	ANDCAM	CH,(EACC)	;STORE BACK INTO EITHER EPPARA OR EPSECT
IFN CSTATS,<
	SKIPN	METRSW##	;DOING METER--ING?
	 JRST	EXITR1		; NO
	MOVE	CH,[MOVEI.+AC16,,^D1475] ;1475= PERFORM EXIT (TIMED)
	PUSHJ	PP,PUTASY##
	MOVEI	CH,METER.##
	PUSHJ	PP,PUT.PJ
EXITR1:	>;END IFN CSTATS
	SKIPE	NRESSN##	;DID WE SEE ANY NON-RESIDENT SECTION?
	JRST	EXITNR		;YES, DO IT THE SLOW WAY

	MOVE	TA,(EACC)	;GET PROCEDURE NAME'S PROTAB LINK
				;...LINK POINT BACK TO LAST-SEEN PROCEEDURE
	PUSHJ	PP,LNKSET	;CONVERT LINK TO REAL ADDRESS
	HLRZ	CH,3(TA)	;GET EXIT WORD <IF ONE IN PROTAB>
	CAIN	CH,0		;NO LINK?  THEN GO ALLOCATE ONE...
				;TA IS EXPECTED TO HOLD POINTER TO
				;PROPER PROTAB ENTRY, ABSOLUTE ADDRESS TYPE.

	PUSHJ	PP,EALLOC	;ALLOCATE AN EXIT WORD [0CT 0]
				;EALLOC SUBROUTINE IS EXPECTED
				;TO RETURN LINK IN CH, IF
				;EXIT WORD NEEDS TO BE CREATED ON THE SPOT.
				;PROTAB UP-DATED BY EALLOC SUBROUTINE.

	PUSH	PP,CH		;SAVE ADDRESS
	SKIPE	QUIKSW##	;/Q?
	JRST	EXITQ		;YES
				;NO
;HERE FOR NORMAL EXIT IN RESIDENT SECTION

	MOVE	CH,[SKIPN.##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVE	CH,0(PP)
	PUSHJ	PP,PUTASY	;SKIPN %PARAM+N
	MOVE	CH,[JRST.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.DOT+7
	PUSHJ	PP,PUTASY	;JRST .+7
	MOVE	CH,[SOS.##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	POP	PP,CH
	PUSHJ	PP,PUTASY	;SOS %PARAM+N
	PUSHJ	PP,PUTASA
	MOVSI	CH,HLRZ.##+AC10+17
	PUSHJ	PP,PUTASY	;HLRZ 10,(17)
	MOVE	CH,[CAME.##+AC10,,LEVEL.]
	PUSHJ	PP,PUT.EX	;CAME 10,LEVEL.
	MOVEI	CH,EXIT.E##
	PUSHJ	PP,PUT.PJ	;PUSHJ P,EXIT.E
	MOVE	CH,[SOS.,,LEVEL.]
	PUSHJ	PP,PUT.EX	;SOS LEVEL.
	SKIPN	PRODSW
	JRST	EXITRN		;NON-PRODUCTION
	MOVSI	CH,POPJ.##+AC17
	JRST	PUTASY

EXITRN:	PUSHJ	PP,PUTASA##
	MOVE	CH,[XJRST.##+<(@)>,,TRAC2.##]
	JRST	PUT.EX		;NON-PRODUCTION
;HERE FOR QUICK EXIT IN RESIDENT SECTION

EXITQ:	PUSHJ	PP,PUTASA
	MOVE	CH,[SOSL.##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVE	CH,0(PP)
	PUSHJ	PP,PUTASY	;ASSUME WE PERFORMED THE EXIT
	LDB	CH,PR.DFD##	;[1111] FIND OUT IF THIS IS
	JUMPE	CH,EXITQA	;[1111]  A DECLARATIVE EXIT
	MOVE	CH,[SOS.,,LEVEL.]	;[1111] SOS LEVEL. (DECREMENT TO
	PUSHJ	PP,PUT.EX	;[1111] COMPLEMENT THE AOS IN PERF.)
EXITQA:	MOVSI	CH,POPJ.##+AC17
	PUSHJ	PP,PUTASY	;OK, WE DID
	MOVE	CH,[AOS.##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	POP	PP,CH
	JRST	PUTASY		;NO, WE DIDN'T

;HERE FOR EXIT WHEN NON-RESIDENT SECTION SEEN

EXITNR:	MOVE	CH,[ASINC+XIT##,,AS.MSC]	;EXIT UUO
	PUSHJ	PP,PUTASY
	MOVE	TA,(EACC)	;GET PROCEDURE NAME'S PROTAB LINK
				;...LINK POINT BACK TO LAST-SEEN PROCEEDURE
	PUSHJ	PP,LNKSET	;CONVERT LINK TO REAL ADDRESS
	HLRZ	CH,3(TA)	;GET EXIT WORD <IF ONE IN PROTAB>
	CAIN	CH,0		;NO LINK?  THEN GO ALLOCATE ONE...
				;TA IS EXPECTED TO HOLD POINTER TO
				;PROPER PROTAB ENTRY, ABSOLUTE ADDRESS TYPE.

	PUSHJ	PP,EALLOC	;ALLOCATE AN EXIT WORD [0CT 0]
				;EALLOC SUBROUTINE IS EXPECTED
				;TO RETURN LINK IN CH, IF
				;EXIT WORD NEEDS TO BE CREATED ON THE SPOT.
				;PROTAB UP-DATED BY EALLOC SUBROUTINE.

	JRST	PUTASN
SUBTTL THE PERFORM GENERATOR

PERFGN:	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR
	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;ANY OPERANDS?
	JRST	BADEOP		;NO--TROUBLE

	HRRZ	TC,EOPLOC	;GET ADDRESS OF FIRST OPERAND
	ADDI	TC,1
	MOVSM	TC,OPERND

	MOVEI	TE,-1(EACA)	;ALSO ADDRESS OF SECOND OPERAND
	HRRM	TE,OPERND

	CAIN	TC,0(TE)	;IS THERE ONLY ONE OPERAND?
	JRST	PERF1		;YES
	CAIE	TC,-2(TE)	;NO--IS THERE ONLY TWO OPERANDS?
	JRST	BADEOP		;NO--ERROR
	PUSHJ	PP,SOLVER	;CONVERT FLOTAB TO PROTAB FOR "A"
	MOVEM	TA,-2(EACA)

PERF1:	PUSHJ	PP,RESOLV	;CONVERT FLOTAB TO PROTAB FOR "B" (OR ONLY)
	MOVEM	TA,0(EACA)

	HRRZ	TA,(EACA)	;GET
	PUSHJ	PP,LNKSET	;  FLAGS FOR
	HRRZ	EACB,PTFLAG(TA)	;  "B"
	MOVS	TA,OPERND	;GET
	MOVE	TA,1(TA)	;  FLAGS
	PUSHJ	PP,LNKSET	;  FOR
IFN ANS74,<
	LDB	EACD,PR.DEB	;DEBUGGING ON THIS PARA?
	JUMPE	EACD,PERF2	;NO
	MOVE	CH,[SKIPA.##+AC11+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.DOT+1
	PUSHJ	PP,PUTASY	;SKIPA 16,.+1
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	SKIPN	CH,PERFCD##	;CODE ALREADY SET?
	MOVEI	CH,DBP%PL	;NO, USE PERFORM LOOP CODE
	PUSHJ	PP,PUTASN	;IN LHS
	SETZM	PERFCD
	LDB	CH,[POINT 13,PREVW1##,28]	;GET LINE # OF PREVIOUS  OPERATOR
	PUSHJ	PP,PUTASY
	MOVE	CH,[MOVEM.+AC11+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVE	CH,DBPARM
	IORI	CH,AS.PAR
	PUSHJ	PP,PUTASY	;MOVEM 16,%PARAM+N
PERF2:>
	MOVE	EACD,PTFLAG(TA)	;  "A"

	ISOPOK	EACB;		CHECK TO SEE THAT "B" LEGAL
	ISOPOK	EACD;		ALSO "A"

	TRNE	EACB,PTXFER	;DOES "B" HAVE UNCONDITIONAL TRANSFER?
	PUSHJ	PP,NOEXIT	;YES, WARN USER

	LDB	EACC,FLAGPP	;GET FLAGS FOR CURRENT PARAGRAPH
;EVERYTHING OK--GENERATE THE PERFORM

	MOVE	CH,[AOS.##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVE	TA,OPERND	;DO WE
	MOVE	TA,1(TA)	;  HAVE AN
	PUSHJ	PP,LNKSET	;  EXIT WORD
	HLRZ	CH,3(TA)	;  FOR THIS
	SKIPN	CH		;  PARAGRAPH OR SECTION?
	PUSHJ	PP,EALLOC	;NO--GET ONE
	PUSHJ	PP,PUTASY	;GENERATE AOS %PARAM+N
	SKIPE	QUIKSW		;/Q?
	SKIPE	NRESSN		;YES, ANY NON-RES SECTIONS?
	JRST	PERF6		;NOT /Q ALL RESIDENT

;HERE FOR PERFORM OF ALL RESIDENT SECTIONS IN QUICK MODE

	MOVS	TA,OPERND	;GET SET FOR THE "GO"
	HRRZ	CH,1(TA)
	MOVEI	CH,ECPFLG(CH)
	SETZM	GODPOV##	;[V10] MAKE SURE THAT THE SPECIAL
				;[V10]  GO DEPENDING FLAG IS OFF.
	HRLI	CH,EPJPP
	JRST	PUTASY		;GENERATE PUSHJ 17,<PERFORM-PARA>
;HERE FOR PERFORM  OF EITHER NOT /Q OR NOT ALL RESIDENT (OR BOTH)

PERF6:	MOVE	CH,[AOS.+AC11,,LEVEL.##]
	PUSHJ	PP,PUT.EX	;GENERATE AOS 11,LEVEL.##
	MOVE	CH,[MOVS.##+AC11,,11]
	PUSHJ	PP,PUTASY	;GENERATE MOVS 11,11
	CAIGE	EACC,1B24	;IN RESIDENT SECTION
	JRST	PERF7		;YES
	MOVE	CH,[TLO.##+AC11+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY	;NO
	LDB	CH,[POINT 7,EACC,24]	;GET CURRENT LEVEL
	LSH	CH,^D10
	PUSHJ	PP,PUTASN	;GENERATE TLO 11,LEVEL_^D10
PERF7:	XOR	EACC,EACD	;SEE IF IN SAME SECTION
	TRNE	EACC,ENREZE
	JRST	PERF8		;NOT
	XOR	EACC,EACD	;PUT SECTION NUMBER BACK
	MOVE	CH,[HRRI.##+ASINC+AC11,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.DOT+4
	SKIPE	PRODSW		;IF /P SEEN
	MOVEI	CH,AS.DOT+3	;ONE LESS WORD GENERATED
	PUSHJ	PP,PUTASY	;GENERATE HRRI 11,.+4
	PUSHJ	PP,PUTASA##
	MOVE	CH,[PUSH.##+AC17,,11]
	PUSHJ	PP,PUTASY	;GENERATE PUSH 17,11
	MOVS	TA,OPERND	;GET SET FOR THE "GO"
	HRRZ	CH,1(TA)
	MOVEI	CH,ECPFLG(CH)
	SETZM	GODPOV##	;[V10] MAKE SURE THAT THE SPECIAL
				;[V10]  GO DEPENDING FLAG IS OFF.
	SKIPN	PRODSW		;IF /P
	JRST	PERFDB		;PERFORM DEBUGGING
	PUSH	PP,CH		;SAVE CH FROM PUTASA
	PUSHJ	PP,PUTASA	;ALTERNATE SET
	POP	PP,CH		;RESTORE IT
	HRLI	CH,XJRST.
	JRST	PUTASY		;GENERATE JRST <PERFORM-PARA>

PERFDB:	HRLI	CH,MOVEI.+AC10+ASINC
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.ABS##+1
	PUSHJ	PP,PUTASY	;GENERATE MOVEI 10,<PERFORM-PARA>+1
	PUSHJ	PP,PUTASA##
	MOVE	CH,[XJRST.+<(@)>,,TRAC3.##]
	JRST	PUT.EX

;HERE WHEN DESTINATION AND SOURCE NOT SAME PRIORITY

PERF8:	XOR	EACC,EACD	;PUT SECTION PRIORITY BACK
	MOVE	CH,[HRRI.##+ASINC+AC11,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.DOT+6
	SKIPE	PRODSW		;IF /P SEEN
	MOVEI	CH,AS.DOT+4	;TWO LESS WORD GENERATED
	PUSHJ	PP,PUTASY	;GENERATE HRRI 11,.+6
	PUSHJ	PP,PUTASA##
	MOVE	CH,[PUSH.##+AC17,,11]
	PUSHJ	PP,PUTASY	;GENERATE PUSH 17,11
	SKIPE	PRODSW		;/P?
	JRST	PERF9		;YES
	MOVE	CH,[MOVEI.+AC10+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.DOT+3
	PUSHJ	PP,PUTASY	;GENERATE MOVEI 10,.+3
	PUSHJ	PP,PUTASA##
	MOVE	CH,[XJRST.+<(@)>,,TRAC3.]
	PUSHJ	PP,PUT.EX	;GENERATE PUSHJ 17,@TRAC3.
PERF9:	MOVE	CH,[OVLAY.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVS	TA,OPERND	;GET SET FOR THE "GO"
	HRRZ	CH,1(TA)
	MOVEI	CH,ECPFLG(CH)
	HRLM	CH,CURPRO	;SAVE PROTAB TO BE RESOLVED LATER
	SETZM	GODPOV##	;[V10] MAKE SURE THAT THE SPECIAL
				;[V10]  GO DEPENDING FLAG IS OFF.
	PUSHJ	PP,OVLHDR	;OVERLAY HEADER MAKER ROUTINE
	JRST	PUTASN		;OUTPUT THE OVERLAY CALL


;EXIT PROCEDURE-NAME ENDS WITH AN UNCONDITIONAL "GO"
NOEXIT:	MOVE	TC,OPERND
	HRRZM	TC,CUREOP
	MOVEI	DW,E.232
	JRST	OPNWRN##
SUBTTL THE "PERFORM TIMES" GENERATOR

EXTERNAL	PRODSW
EXTERNAL 	SETOPN, PUT.B, PUT.LA, GETTAG, PUTTAG, CONVNL
EXTERNAL 	MXAC., MACX., PUTAS1, PUTASY, PUTASN, OPNFAT

PRFYGN:	SWOFF	FEOFF1		;TURN OFF MOST FLAGS
	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR
	MOVE	EACC,[XWD 2,2]	;ASSUME ONLY ONE PROCEDURE NAME
	HRRZ	TC,EOPLOC	;SET "TC" TO SECOND OPERAND
	ADDI	TC,3
	MOVE	EACA,EOPNXT
	CAIL	TC,(EACA)	;IS THERE A SECOND ONE?
	JRST	BADEOP		;NO--TROUBLE

	MOVE	TE,0(TC)	;GET FIRST WORD OF SECOND OPERAND
	TLNE	TE,GNLIT	;IS IT A LITERAL OR FIG. CONST.?
	JRST	PRFYG1		;YES

	LDB	TE,[POINT 3,1(TC),20]	;NO--DATA-NAME?
	CAIN	TE,TB.DAT
	JRST	PRFYG1		;YES

	ADD	EACC,[XWD 2,2]	;NO--MUST HAVE TWO PROCEDURE-NAMES

	ADDI	TC,2		;STEP UP TO NEXT OPERAND
	CAIL	TC,(EACA)	;IS THERE ANOTHER?
	JRST	BADEOP		;NO--TROUBLE

;"TC" POINTS TO "TIMES" COUNT

PRFYG1:	ADD	EACC,EOPLOC
	MOVEM	EACC,EOPNXT
	MOVEM	TC,CUREOP
	MOVEI	LN,EBASEA	;SET UP PARAMETERS
	PUSHJ	PP,SETOPN

	HRRZ	TE,EMODEA	;IS ITEM A LITERAL
	CAIN	TE,LTMODE	
	JRST	PRFYG3		;YES

	CAIN	TE,FCMODE	;NO--FIG. CONST.?
	JRST	BADINT		;YES--ERROR
;"TIMES" COUNT IS A DATA-NAME

	CAIE	TE,FPMODE	;IS IT COMP-1?
	CAIN	TE,F2MODE	;OR COMP-2?
	JRST	BADFP		;YES--ERROR

	TSWF	FANUM		;IS ITEM NUMERIC?
	SKIPE	EDPLA		;YES--ANY DECIMAL PLACES?
	JRST	BADDP		;NO--ERROR
	HRRZ	TE,ESIZEA	;IS IT ONE WORD?
	CAILE	TE,^D10
	JRST	BADSIZ		;NO--ERROR
	JRST	PRFYG6		;YES

;"TIMES" COUNT IS A LITERAL

PRFYG3:	PUSHJ	PP,CONVNL	;GET VALUE OF LITERAL INTO TD & TC

	SKIPN	EDPLA		;ANY DECIMAL PLACES?
	TSWF	FLNEG		;NO--POSITIVE LITERAL?
	JRST	BADINT		;NO--ERROR

	JUMPN	TD,BADSIZ	;IS IT TWO WORDS?
	JUMPE	TC,BADINT	;NO--ZERO?

	MOVSI	CH,MOV##	;GET LITERAL INTO AC'S
	PUSHJ	PP,PUT.LA
	MOVEI	TE,D1MODE
	MOVEM	TE,EMODEA
	JRST	PRFYG7

PRFYG6:	HRLZM	TC,OPERND	;SAVE PTR TO OPERAND IN CASE SUBSCRIPTED
	PUSHJ	PP,MXAC.	;GET ITEM INTO AC'S

PRFYG7:	MOVE	CH,[XWD AS.OCT,1]	;ALLOCATE A %PARAM WORD
	PUSHJ	PP,PUTAS1
	MOVEI	CH,0
	PUSHJ	PP,PUTAS1
	HRRZ	EACC,EAS1PC
	IORI	EACC,AS.PAR
	AOS	EAS1PC
	MOVE	TE,[XWD EBASEA,EBASEB]
	BLT	TE,EBASBX
	MOVEI	TE,D1MODE
	MOVEM	TE,EMODEB
	MOVE	TE,[XWD ^D36,AS.MSC]
	MOVEM	TE,EBASEB
	SWON	FBSIGN;
	HRRZM	EACC,EINCRB
	PUSHJ	PP,MACX.	;STASH AC'S INTO %PARAM WORD
	PUSHJ	PP,GETTAG	;GET A TAG NUMBER
	HRRZM	CH,ESAVER+1	;SAVE IT 
	PUSHJ	PP,PUTTAG	;WRITE IT OUT
;ITEM HAS BEEN PUT INTO %PARAM

	MOVE	TE,@CUREOP	;WAS IT A LITERAL?
	TLNN	TE,GNLIT
	JRST	PRFY10		;NO--MUST HAVE BEEN A DATA NAME

	PUSHJ	PP,PRFY20	;YES--GENERATE THE PERFORM

	MOVSI	CH,SOSLE.	;YES--GENERATE <SOSLE B>
	PUSHJ	PP,PUT.B

	MOVSI	CH,JRST.	;GENERATE <JRST %TAG1>
	HRR	CH,ESAVER+1
	HRRZ	TA,CH		;TAG NUMBER
	PUSHJ	PP,REFTAG##	;REFERENCE IT
	JRST	PUTASY		;	AND RETURN

;ITEM IS A DATA-NAME--TEST HAS TO BE BEFORE THE PERFORM

PRFY10:	MOVSI	CH,SOSGE.	;GENERATE <SOSGE>
	PUSHJ	PP,PUT.B

	PUSHJ	PP,GETTAG	;GENERATE <JRST %TAG2>
	MOVEM	CH,ESAVER+2
	HRLI	CH,JRST.
	HRRZ	TA,CH
	PUSHJ	PP,REFTAG##
	PUSHJ	PP,PUTASY

	PUSHJ	PP,PRFY20	;GENERATE THE PERFORM

	MOVSI	CH,JRST.	;GENERATE <JRST %TAG1>
	HRR	CH,ESAVER+1
	HRRZ	TA,CH
	PUSHJ	PP,REFTAG##
	PUSHJ	PP,PUTASY

	HRRZ	CH,ESAVER+2	;PUT OUT %TAG2
	JRST	PUTTAG		;	AND RETURN


;SET UP EACA AS IF PERFORM WERE BEING CALLED, THEN CALL IT

PRFY20:	MOVE	EACA,EOPNXT
	JRST	PERFGN		;GO DO THE PERFORM
;ERROR ROUTINES

;LITERAL IS NEGATIVE OR HAS DECIMAL PLACES

BADINT:	MOVEI	DW,E.25
	JRST	OPNFAT

;IMPROPER SIZE OF DATA NAME

BADSIZ:	MOVEI	DW,E.278
	JRST	OPNFAT

;DATA-NAME HAS DECIMAL PLACES

BADDP:	MOVEI	DW,E.264
	JRST	OPNFAT

;DATA-NAME IA A COMP-1 ITEM

BADFP:	MOVEI	DW,E.321
	JRST	OPNFAT
SUBTTL THE STOP GENERATOR

;SEE COBOL MEMO 100-350-007
;"THE STOP GENERATOR"

				;IF THERE ARE NO OPERANDS
				;IN EOPTAB (EACC) = 0, THEN STOP RUN
				;IF MORE THAN 1 OPERAND <A LITERAL>
				;FOR THE STOP < LIEREAL>
				;CONDITION IS DISCOVERED, WE ARE IN TROUBLE.
				;
STOPGN:	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;ANY OPERANDS?
	JRST	ESTRUN		;NO--BETTER BE "STOP RUN"

	MOVE	EACB,-1(EACA)	;NOW CHECK TO SEE IF THE OPERAND TYPE IS A.O.K.

	TLNN	EACB,1B19	;IS THE LITERAL OR FIGURATIVE CONSTANT
				;FLAG UP?
	JRST	EBLTFC		;NOPE! IT WASN'T, BAD SHOW, BAD OPERAND TYPE.
				;EITHER (A): BIT UP SAYING "I AM A LITERAL"
				;OR     (B): BIT FROM (A) AND BIT SAYING "I AM
				;            I AM ALSO A FIGURATIVE CONSTANT"
				;**THESE ARE THE ONLY TWO CONDITIONS!!**


	PUSHJ	PP,DISPGN	;GENERATE THE DISPLAY
	MOVEI	CH,C.STOP##	;GENERATE <PUSHJ PP,C.STOP>
	JRST	PUT.PJ


;OPERAND FOR "STOP" WASN'T A LITERAL

EBLTFC:	OUTSTR	[ASCIZ /"STOP" operand not literal
/]
	JRST	KILLF


;GENERATE "STOP RUN"

ESTRUN:	MOVEI	CH,STOPR.##	;GENERATE <PUSHJ PP,STOPR.>
	JRST	PUT.PJ
SUBTTL THE ALTER GENERATOR

				;SOURCE EXAMPLE:
				;  C.  ALTER A TO PROCEED TO B.
				;NOMANCLATURE:
				;C. SHALL BE THE POINT OF ORIGIN
				;B. SHALL BE THE OBJECT OF THE ALTER
				;A. SHALL BE THE SUBJECT OF THE ALTER.

				;STRATEGY(?)
				;
				;(A) CHECK FOR TWO OPERANDS
				;(B) CHECK TO SEE IF A IS ALTERABLE.
				;(C) CHECK FOR A NOT BEING IN DECLARATIVES
				;(D) CHECK FOR B NOT BEING IN DECLARATIVES.
				; <A AND B AND C MUST BE TOTALLY WITHIN DECLARATIVES
				; OR TOTALLY EXCLUDED FROM DECLARATIVES.>

				;(E) SEE WHETHER OR NOT A'S PRIORITY # < 50.
				;(F) IF A < 50, THEN A AND B CAN BE IN
				;IN ANY SEGEMENTS <NO PRIORITY PROBLEMS>

				;(G) GOT A LINK TO AN ALTER WORD IN LEFT HAND
				;HALF OF
				;THE 2ND WORD IN A'S PROTAB ENTRY ?.  IF SO
				;ALTER WORD HAS BEEN GENERATED & ALLOCATED.
				;IF NOT, ALLOCATE ONE.

				;(H) AS LONG AS TRANS-SEGEMENT GO DOES NOT
				;CAUSE OVERLAY, GENERATE:
				;	MOVEI	0,<PHASE F-G TYPE CODE
				;		  FOR B'S PROTAB LINK>


				;	MOVEM	0,<ALLOCATED ALTER WORD ADDRESS>

				;(I) EXIT BACK TO SCANNER ROUTINE.




			;(1) NOT TWO OPERANDS ? DIE...
			;(2) B IN DECLARATIVES?  THEN A HAD BETTER
			;LIKEWISE BE WITHIN DECLARATIVES
			;IF A AND B NOT COMPATIBLE, PUT
			;OUT DIAGNOSTIC AND CONTINUE
			;(3) SAME AS FOR (2); A AND B HAD BETTER MATCH.
			;(4) IF A > 50, THEN THE GO TO
			;< C.'S PRIORITY> HAS TO BE = A.'S.

			;(5) OVERLAY CODING:
ALTGEN:	HRRZ	TA,EOPLOC	;IS THERE TWO AND ONLY TWO OPERANDS?
	MOVE	EACA,EOPNXT
	CAIE	TA,-4(EACA)
	JRST	BADEOP		;OOPS! BAD SHOW _ 

	PUSHJ	PP,RESOLV	;EACA IS LOOKING AT LAST OPERAND, B.
	HRRM	TA,(EACA)	;UPDATE EOPTAB.

	PUSHJ	PP,SOLVER	;RESOLV GETS B OPERNAD, SOLVER GETS
				;A OPERAND.
	HRRM	TA,-2(EACA)	;UPDATE EOPTAB.


	PUSHJ	PP,LNKSET	;CONVERT TO REAL ADDRESS.
	MOVEI	EACB,(TA)	;SAVE POINTER TO 1ST WORD IN PROTAB FOR A.
				;YOU MAY USE IT LATER
	HRRZ	W2,2(TA)	;GET A'S FLAGS & STUFF
	TRNN	W2,1B28		;IS A ALTERABLE ?
	POPJ	PP,		;NO--FORGET IT (PHASE D PUT OUT DIAG)



	ISOPOK	W2;

	HRRZ	TA,(EACA)	;GET B OPERAND






	MOVEI	CH,ECPFLG(TA)	;& SAVE IT!
				;CH _ PHASE F-G PROTAB CODE FOR B.
	PUSHJ	PP,LNKSET	;CONVERT LINK TO ENTRY ADDRESS
	HRRZ	EACD,2(TA)	;SAVE WORD 3 OF B'S PROTAB ENTRY IN EACD
	


	ISOPOK	EACD;
				;BEGIN LADDER TEST:
				;RUN DOWN NON-DECLARATIVE PATH/ IT WILL
				;BE MOST FREQUENT BY FAR.


				;THE OVERLAY GENERATOR EXPECTS TO FIND
				;CH WITH THE PHASE F-G ADDRESS TO WHICH
				;CONTROL IS TO BE TRANSFERRED
				;EACC WITH THE CURRENT PRIORITY # OF CURRENT PARAGRAPH
				;EACD WITH PRIORITY # OF (CH) ..OF WHERE YOU ARE GOING
				;SEE GO GENERATOR ALSO...



	LDB	EACC,FLAGPP	;GET WHERE YOU ARE PRESENTLY....
	TRNE	EACC,1B32	;IS C IN DECLARATIVES <SKIP IF NOT>?
	JRST	EBDECL		;C IS IN DECLARATIVES/ IF SO, A & B BOTH MUST
				;BE IN DECLARATIVES.!.


				;C WASN'T IN DECLARATIVES:
	TRNN	W2,1B32		;OK, IS A IN DECLARATIVES [BETTER NOT BE]
	TRNE	EACD,1B32	;IS B ?
	JRST	CWASNT		;BAD SHOW _ !! ALL NOT IN DECLARATIVES!



	CAIL	W2,^D50B24	;CHECK TO SEE IF GO TO IS LESS THAN 50 
	JRST	CKAEQB		;IF SEGMENT # > OR = 50, C AND A MUST BE =

EALTOK:	TRNE	W2,40		;ARE ALL ALTERS WITHIN CURRENT SEGMENT

	JRST	ALTOLA		;OVERLAY REQUIRED? SURE IS!
ALLDEC:	HRLI	CH,MOVEI.	;CH NOW CONTAINS:
				;MOVEI 0, B


QUICKY:	PUSHJ	PP,PUTASY	;PUT OUT & BUMP PPC.


				;NOW PUT OUT
				;MOVEM	0,<ALTER WORD>
ALTFIN:	MOVE	CH,[XWD	ASINC+MOVEM.,AS.MSC]	;MOVEM 0,<IMPURE ADDRESS
					;HOLDING ADDRESS OF DESTINATION>

	PUSHJ	PP,PUTASN	;1ST WORD DOESN'T BUMP PPC
				;BECAUSE THIS IS A TWO-WORD ENTRY
	HLRZ	CH,2(EACB)	;GET A'S ALTER WORD [IF PRESENT]

	JUMPE	CH,ALTWDN	;IF NO ALTER WORD, GO GENERATE ONE.
IFN ANS68,<
	JRST	PUTASY		;IF ALTER WORD WRITE IT OUT.

>
IFN ANS74,<
ALTDEB:	SKIPN	DEBSW##		;DO WE NEED DEBUG CODE?
	JRST	PUTASY		;NO
	PUSHJ	PP,PUTASY	;YES
	HLRZ	CH,4(EACB)	;GET PR.DEB
	JUMPE	CH,CPOPJ	;NOT WANTED HERE
	MOVEI	CH,DBALT.##
	PUSHJ	PP,PUT.PJ	;PUSHJ 17,DBALT.
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	HRRZ	CH,(EACA)	;GET "B" OPERAND
	PUSHJ	PP,GETPR%	;GET CORRECT %PR OFFSET
	PUSHJ	PP,PUTASN
	HRRZ	CH,-2(EACA)	;GET "A" OPERAND
	PUSHJ	PP,GETPR%	;GET CORRECT %PR OFFSET
	PUSHJ	PP,PUTASY
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	LDB	CH,W1LN##	;GET LINE NUMBER
	PUSHJ	PP,PUTASN
	HLRZ	TA,4(EACB)	;DEBUG USE PROCEDURE
	ADD	TA,USELOC##	;POINT TO USE TABLE
	LDB	CH,US.PRO##	;GET TAG OF USE PROCEDURE
	JRST	PUTASY
>
ALTOLA:	CAIGE	W2,^D1B24	;DO WE REALLY NEED A MOVE?
				;IF BOTH SEG PRIORITY # ARE = 0,
				;A MOVSI 0,<PROTAB LINK> WILL DO THE TRICK!

	CAIL	EACD,^D1B24	;SEE IF BOTH ARE 0

	JRST	NEEDMV		; _ SHORT-CUT LOST, AT LEST 1
				;PRIORITY # > RES => 0.

	HRLI	CH,MOVSI.	;SHORT-CUT PAYS OFF
	JRST	QUICKY


NEEDMV:	HRLM	CH,CURPRO	;SAVE PROTAB LINK
				;FOR OVLHDR ROUTINE.
				;START GENERATING:	MOVE 0,LIT
	MOVE	CH,[XWD	ASINC+MOV,AS.MSC]
	PUSHJ	PP,PUTASN	;1ST HALF OF INSTRUCTION OUT

	PUSH	PP,EACC		;SAVE ADDRESS OF CURRENT PARAGRAPH
	MOVE	EACC,W2		;SET IT TO "A".
	PUSHJ	PP,OVLHDR	;NOW CREATE AN XWD WITH THE ADDRESS
				;IN LEFT HALF, PRIORITY #'S IN RIGHT HALF
	POP	PP,EACC		;RESTORE ADDRESS OF CURRENT PARAGRAPH

	PUSHJ	PP,PUTASY	;FINISH UP SECOND HALF OF
				;INSTRUCTION BEGUN ABOVE
				;NOW YOU HAVE:

				;MOVE 0,LIT
				;LIT: XWD ADDRESS,PRI # PRI #
				;NOW GO BACK AND GENERATE MOVEM 0,ALTER WORD
				;MOVEM 0, PARAM

	JRST	ALTFIN


EBDECL:	TRNE	W2,1B32		;C IN DECLARATIVES. A MUST BE TOO.
	TRNN	EACD,1B32	;AS WELL AS "B".
				;TEST WHERE YOU ARE FOR BEING IN DECLARATIVES.

	JRST	CWASIN		;ONE OF A OR C WAS NOT IN DECLARATIVES
	JRST	ALLDEC		;ALL IN DECLARATIVES, WHICH MUST BE IN SEGMENT 0
				;NO NEED TO CHECK FOR OVERLAY REQUIRED
CWASNT:	TRNE	W2,1B32		;C WASN'T IN DECLARATIVES, BUT
				;EITHER A OR B OR BOTH WERE. FIND OUT WHICH ONES.

	PUSHJ	PP,AWASIT
	TRNE	EACD,1B32	;OK, WAS "B" IN DECLARATIVES
	JRST	BWASIT
	POPJ	PP,

CWASIN:	TRNN	W2,1B32		;C WAS IN DECLARATIVES, BUT EITHER A OR B OR BOTH
				;WERE OUTSIDE.
	PUSHJ	PP,AWASIT	;A WAS OUTSIDE
	TRNN	EACD,1B32	;TRY B
	JRST	BWASIT
	POPJ	PP,





AWASIT:	MOVEI	EACA,-2(EACA)		;POSITION POINTER TO LOOK AT A.
	PUSHJ	PP,BWASIT		;GIVE HIM THE DIAG.
	MOVEI	EACA,+2(EACA)		;REPOSITION POINTER TO LOOK AT B.
	POPJ	PP,

BWASIT:	MOVEI	DW,E.185		;TRYING TO CROSS DECLARATIVES DIAGNOSTIC
	JRST	EFATAL


CKAEQB:	MOVEI	TB,(W2)			;SAVE THE ORIGINAL (W2).
	ANDI	TB,ENREZE		;STRIP ALL BUT PRIORITY BITS
	MOVEI	TC,(EACC)		;PRESERVE EACC
	ANDI	TC,ENREZE
	CAIN	TC,(TB)			;SEE STANDARDS, P-2-81, FOR RESTRICTIONS ON ALTER VERB.


	JRST	EALTOK			;GREAT! THEY ARE =
	MOVEI	DW,E.90			;ALTERING A PROCEEDURE NAME OUTSIDE
	JRST	EFATAL			;YOUR OWN SEG WHEN YOU ARE IN A 50 OR GREATER SEGMENT.
					;N*O*T*E	ALTDWN REQUIRES
					;THAT PROTAB BE UPDATED WITH THE ADDRESS LINK
					;FOR THE ALTER WORD.





ALTWDN:	CAIL	EACC,^D50B24		;ARE WE IN A 50 OR > SEG.
					;IN OTHER WORDS, DO WE HAVE TO SAVE
					;THE ALTERS?
	JRST	SAVALT			;YEP!!!


	MOVE	CH,[XWD	AS.XWD,1]	;XWD HEADER 
	PUSHJ	PP,PUTAS1		;ONTO AS1 FILE
	TRNE	W2,40			;OK, HEADER OUT, NOW WHAT'S IT GONNA BE,
					;ADDRESS, PRIORITY BITS <FOR OVLAY>
					;OR
					;0,ADDRESS <FOR NON-OVERLAYED GOES.


	JRST	ADDPR1			;OK, ADDRESS, PRIORITY BITS NEEDED


	MOVEI	CH,0			;LEFT HALF OF XWD _ 0
	PUSHJ	PP,PUTAS1
	PUSHJ	PP,GETADR		;GET THE ADDRESS
FINXWD:	PUSHJ	PP,PUTAS1		;WRITE THAT ADDRESS OUT
	AOS	CH,EAS1PC		;BUMP THE PPC
	MOVEI	CH,100000-1(CH)		;ADD IN TABLE TYPE AND READJUST PPC
					;TO WHAT XWD IS.
	HRLM	CH,2(EACB)		;UPDATE PROTAB ENTRY.
IFN ANS68,<
	JRST	PUTASY			;FINISH UP THE INSTRUCTION WITH ITS ADDRESS 
>
IFN ANS74,<
	JRST	ALTDEB			;TEST FOR DEBUGGING CODE
>
GETADR:	HRRZ	TB,3(EACB)		;GET THE FLOTAB LINK FROM PROTAB ENTRY
	ANDI	TB,77777		;STRIP OFF ALL BUT OFFSET
	JUMPE	TB,NOFLOK		;NO  FLOTAB LINK?
					;TSK! TSK?


	ADD	TB,FLOLOC		;ADD BASE ADDRESS
	HRRZ	TD,FLONXT		;TB NOW HOLDS POINTER TO FLOTAB
					;CHECK POINTER AGAINST HIGHEST LEGAL
					;FLOTAB ENTRY <(FLONXT)>
	CAIGE	TD,3(TB)		;MAKE SURE THAT THE NEXT ENTRY
					;WHICH IS THE ONE YOU WANT, HAS BEEN
					;COMPLETED, I.E., TWO WORDS ENTERED
	JRST	NOFLOK			;TSK, TSK NO CHAINING THRU FLOTAB.
	MOVE	TA,2(TB)		;GET NEXT ENTRY
	LDB	CH,LNKCOD##		;IS THE ITEM A PROTAB LINK?
	CAIE	CH,TB.PRO
	JRST	NOFLOK			;NO--ERROR
	TLNN	TA,1B23			;IS THAT SOMETHING AN OBJECT OF
	JRST	NOFLOK			;
					;GO OR GO DEPENDING?

	MOVEI	CH,ECPFLG(TA)		;LINK  CONVERTED TO F-G NOTATION.
	POPJ	PP,


					;GOTO. DEFAULT ADDRESS SINCE
					;WE CANNOT CHAIN THRU FLOTAB.
NOFLOK:	MOVE	CH,EGOTO
	POPJ	PP,




ADDPR1:	PUSHJ	PP,GETADR		;XWD ADDRESS, PRIORITY BITS REQUIRED.
	PUSHJ	PP,PUTAS1		;WRITE IT OUT
	CAMN	CH,EGOTO		;SEE IF GOTO. IS ADDRESS,
					;THERE IS NO PROTAB ENTRY FOR HIM
	PUSHJ	PP,GOTOSG		;EVADE GOING TO LNKSET WITH
					;GOTO. AS A LINK.
					;LOAD UP WITH CURRENT PARA'S
					;PRIORITY BITS IN CH.
					;GOTO. IN TA.

					;WITH GOTO. AS LINK.
	PUSHJ	PP,GETBIT		;SHIFT BITS INTO CORRECT POSITIONS.
	JRST	FINXWD
SAVALT:	TRNE	W2,40			;ALL ALTERS WITHIN THE CURRENT SEG?
	JRST	ADDPR0			;NOPE! _


	MOVEI	TB,0

	PUSHJ	PP,PUTALT		;XWD 0,ADDRESS
					;ALL ENTRIES IN ALTAB ARE
					;XWD'S, SO HEADER DOESN'T NEED TO BE
					;SUPPLIED UNTIL YOU ARE BEGINNING
					;TO DUMP THE TABLE.

	PUSHJ	PP,GETADR
					;RESOLVE ADDRESS BY CHAINING THRU FLOTAB.
WRPALT:	MOVE	TB,CH
	PUSHJ	PP,INCALT		;INTO ALTAB + BUMP PPC.



	MOVEI	CH,700000-1(CH)
	HRLM	CH,2(EACB)		;UPDATE PROTAB
IFN ANS68,<
	JRST	PUTASY
>
IFN ANS74,<
	JRST	ALTDEB			;TEST FOR DEBUGGING CODE
>

ADDPR0:	PUSHJ	PP,GETADR
	MOVE	TB,CH
	PUSHJ	PP,PUTALT	;GET ADDRESS AND PUT IT IN LEFT HALF OF XWD
	CAMN	CH,EGOTO	;AVOID GIVING GOTO. TO A SUBROUTINE AS A VIABLE LINK
	PUSHJ	PP,GOTOSG	;GOTO. IS IN THE RES SEG.
				;EACD = DESTINATION PRIORITY BITS = RES
	PUSHJ	PP,GETBIT	;RIGHT HALF HAS PRI #S IN IT.

	JRST	WRPALT		;FINISH UP////

GOTOSG:	MOVEI	CH,AS.CNB
	MOVEI	TC,(W2)		;SAVE (W2) PLEASE!!
	ANDI	TC,ENREZE	;STRIP OFF ALL BUT PRIORITY BITS
	LSH	TC,-^D2		;ALIGN POINT ORIGIN  PRIORITY < BITS>
	TLO	CH,(TC)
	POP	PP,TE		;PREPARE TO TAKE THE SKIP EXIT BACK
	JRST	1(TE)		;BACK + 1 WE GOT
SUBTTL THE GO GENERATOR

GOGOGN:	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;IF NO OPERANDS,
	JRST	EXTGO		;  MUST BE 'GO TO.'
	HRRZ	TE,EOPLOC	;THERE ARE OPERANDS, THERE MUST
	CAIE	TE,-2(EACA)	;  BE ONLY ONE
	JRST	BADEOP		;SOMETHING IS WRONG

	SETZM	GODPOV##	;[V10] MAKE SURE THE SPECIAL GO
				;[V10]  DEPENDING FLAG IS OFF.
	SETZM	USEXJR##	;DON'T USE "XJRST"
IFN ANS74,<
	PUSHJ	PP,GODBTS	;SEE IF DEBUGGING INFO NEEDED
>

;[V10] GO DEPENDING ENTERS HERE FOR EACH PROCEDURE-NAME.

GOGO1:	PUSHJ	PP,RESOLV	;RESOLVE (IF NECESSARY, PROTAB-FLOTAB ENTRY).
	HRRM	TA,(EACA)	;UPDATE EOPTAB

	TLNE	W1,1B27		;IS THIS A SPECIAL GO; ONE CREATED BY
				;THE SYNTAX SCANNER TO CONNECT THE
				;SEGMENTS TOGETHER

	JRST	GOCKIT		;"SPECIAL" GO FOUND

RESUME:	MOVEI	CH,(TA)		;CHANGE
	ANDI	CH,TM.PRO	;  ADDRESS CODE TO
	IORI	CH,AS.PRO	;  ASSEMBLY NOTATION
	PUSHJ	PP,LNKSET	;CONVERT LINK TO REAL ADDRESS
	MOVE	EACD,2(TA)	;GET FLAGS FOR OBJECT OF GO



				;CHECK FOR BONA FIDE OPERAND.
	ISOPOK	EACD;

	LDB	EACC,FLAGPP	;GET FLAGS FROM EPPARA

	TRNE	EACD,1B32	;CHECK TO SEE IF DESTINATION IS IN DECLARATIVES.
	JRST	GODDEC		;GO HAS DESINATION IN DECLARATIVES, ALL
				;IS NOT LOST YET FOR THE GUY. HE MAY BE
				;O.K. IF SOURCE IS IN DECLARATIVES.

	TRNE	EACC,1B32	;O.K., NOW CHECK FOR SOURCE IN DECLARATIVES
				;COME HERE ONLY IF 1ST TEST SHOWS DESTINATION OUT OF
				;DECLARATIVES.

	JRST	DECWRN		;YEP, SOURCE IN DECLARATIVES. THIS IS O.K.
				;ONLY IF DESTINATION IN DECLARATIVES.

DECOK:	TRNE	EACC,140	;CHECK FOR PRESENT PP'S BEING ALTERED:
				;AN ALTERED GO.


	JRST	GOALTD

				;GET EXPRESSION SET UP
GOENTR:	HRLI	CH,JRST.	;ADD IN A <JRST> TO CONVERTED LINK TO PROTAB

	ANDI	EACC,ENREZE	;STRIP OFF ALL BUT SOURCE'S PRIORITY BITS.
	ANDI	EACD,ENREZE	;STRIP OFF ALL BUT DESTINATION'S  PRIORITY BITS

	CAIN	EACD,(EACC)	;DESTINATION & SOURCE OF = PRIORITY ?
				;
	JRST	GOENT1		;DESTINATION & SOURCE =, JRST IS OK.

	HRLM	CH,CURPRO	;SAVE CH, WHICH CONTAIN PROTAB
				;POINTER, WHICH WILL BE RESOLVED TO ADDRESS
	SKIPN	GODPOV##	;[561] SKIP IF SPECIAL "GO DEPENDING"
	 JRST	GOENT0		;[561] NO

;[561] WRITE OUT THE "MOVEI" USING OPCODE "XMOVI." SO THE OPTIMIZER
;[561] DOESN'T THINK IT CAN TAMPER WITH IT.

	PUSHJ	PP,PUTASA	;[561] USE 2ND CODE SET FOR "XMOVI."
	SKIPA	CH,[XMOVI.##+AC16+ASINC,,AS.MSC] ;[561] SKIP WITH CH LOADED
GOENT0:	MOVE	CH,[XWD OVLAY.+ASINC,AS.MSC] ;[561] NEW LABEL

	PUSHJ	PP,PUTASY	;WRITE OUT THE CALL OR "MOVEI" TO BE XCT'D

	PUSHJ	PP,OVLHDR	;GO OFF TO OVERLAY HEADER MAKER ROUTINE.
				;CH WILL (!) <?> RETURN WITH CH LOADED
				;WITH ADDRESS REQUIRED TO FINISH OVLAY INSTRUCTION.

	JRST	PUTASN		;DBT

GOENT1:	SKIPN	USEXJR##	;SKIP IF XJRST
	 JRST	PUTASY		;NO
	HRLI	CH,XJRST.	;[561] USE "XJRST"
	PUSH	PP,CH
	PUSHJ	PP,PUTASA##
	POP	PP,CH
	JRST	PUTASY
EXTGO:	TLNE	W1,1B28			;IS HE GONNA FALL OF THE EDGE OF THE WORLD?
	JRST	EDGE			; _ YEP, SURE IS!


					; _ GO TO. IN HAND
	LDB	EACC,FLAGPP		;GET CURRENT PARAGRAPH'S PROTAB LINK
	TRNN	EACC,140		;LET'S SEE IF HE REALLY EVER DOES ALTER THIS GO.
	JRST	GOWRN			; _ HMMM! GO TO. THAT'S NEVER ALTERED!???


					;<GOTO.. REQUIRED>


	MOVEI	EACD,0			;_ SOME NON-RESIDENT
					; MUST BE ASSUMED FOR A GOTO. THAT'S NOT
					;RESOLVED. OTHERWISE, CHAINNING OF
					;THE DAMN GLOBAL WILL KILL YOU
					;SINCE THE ASSEMBLER WON'T BE ABLE TO 
					;TELL THE LOADER ABOUT THE CHAIN THAT
					;VANISHES.

	SKIPA	EACB,EGOTO		;TO SEGMENT 0/
					; ^ NOTE THAT SKIP WILL ALWAYS TAKE
					;YOU OVER THE SAVING OF THE OPERAND
					;IF THERE WAS NOT AN OPERAND
GOALTD:	MOVEI	EACB,(CH)		;IF YOU ARE COMING FROM THE OPERAND SIDE,
					;SAVE THE OPERAND!!



	TRNN	EACC,40			;OK, CHECK  ALL PLACES THAT WE MIGHT BE GOING
					;ALL PLACES IN THE SAME SEGMENT?


	SKIPA	CH,[XWD	ASINC+JRST.+1B31,AS.MSC]
					; ^ YEP. ALL OBJECTS IN SAME SEGMENT.

	MOVE	CH,[XWD OVLAY.+ASINC,AS.MSC]	;OVERLAY REQUIRED, MAKE ONE & UPDATE
					;1ST PART OF JRST @ OR OVLAY. OUT
					;ADDRESS PORTION COMING UP!!!
	PUSHJ	PP,PUTASY		;DBT

	HRRZ	TA,EPPARA		;GET PROTAB LINK FOR THIS PARAGRAPH
					;<THE 1 THAT'S GOT THE GO WE'RE TALKING ABOUT>.
	PUSHJ	PP,LNKSET		;CONVERT TO REAL ADDRESS
	HLRZ	CH,2(TA)		;GET THE ALTER WORD <IF ONE IS THERE>
	JUMPN	CH,PUTASN		;DBT, IF NON-ZERO, WORD ALLOCATED, SO
					;PUT IT ON ASSEMBLER INPUT FILE & BUMP PPC.


					; _ NO WORD ALLOCATED
					;ALLOCATE ONE, BUT MAKE ADDRESS
					;GOTO. IN THE EVENT THAT HE DOES NOT
					;FILL IN THE BLANK AT OBJECT TIME.


					;FINISH  UP  JRST @ WITH ADDRESS
					;OF XWD JUST PUT OUT.
					;OR... PUT OUT LAST HALF OF OVLAY. UUO
					;WITH ADDRESS OF XWD JUST PUT OUT.

	CAIL	EACC,^D50B24		;ARE WE IN A 50 OR GREATER SEG?
					;IF SO, WE HAVE TO  SAVE THE ALTERS
					;FOR THE BLT RESTORATION.
	JRST	SAVBLT			;YEP! IN 50 OR GT. SAVE ALTS/

	PUSHJ	PP,MAKXWD		;MAKE AN XWD
					;EITHER A) XWD 0,ADDRESS FOR JRST @
					;OR B) XWD ADDRESS, PRIORITY BITS
					;FOR OVERLAY.




	HRRZ	TA,EPPARA		;GET ADDRESS OF
	PUSHJ	PP,LNKSET		;  CURRENT PARAGRAPH
	HRLM	CH,2(TA)		;UPDATE PROTAB WITH ALTER-WORD ADDRESS.
	JRST	PUTASN			;DBT, FINISH UP INSTRUCTION WITH ADDRESS OF XWD
					;SINCE WE ARE NOT IN A 50 OR GREATER SEG,
					;ALL ALTER WORDS GO ON AS1.
EDGE:	PUSHJ	PP,CKEXIT		;CLEAN UP EXITS

	SKIPN	SLASHJ##		;/J ON (FORCE MAIN PROG)?
	SKIPN	SUBPRG##		;NO, /I ON (SUBPROG)?
	SKIPE	PROGST##		;MAIN PROG BUT DOES IT HAVE  START
	JRST	EDGE1			;YES, OR ITS A SUBPROG
	SETZ	CH,			;USE TAG 0
	PUSHJ	PP,PUTTAG		;DEFINE IT
	MOVEI	CH,AS.TAG		;AND TO START ADDRESS
	MOVEM	CH,PROGST

EDGE1:	MOVE	CH,[EPJPP,,KPROG.##]	;HE'S GONNA TRY TO FALL OFF
					;THE EDGE OF THE WORLD
					;INTO HIS LITERAL POOL.

	HLLZ	TA,EPPARA		;SEE IF YOU ARE IN RES/SEG
	TLNE	TA,ENREZF


	PUSHJ	PP,FXPROG		;SET FLAG IN EXTAB SHOWING REFERENCE
					;TO EXTERNAL NAME MADE FROM NON-RES


	JRST	PUTASY			;WRITE IT ON APPROPRIATE FILE AND BUMP PPC.
GOCKIT:	PUSHJ	PP,CKEXIT	;IN ANY EVENT, GENERATE EXITS AS REQUIRED.

	SKIPE	TA,EPSECT	;IF NO LAST SECTION, THEN WE CANNOT
				;BE IN THE DECLARATIVES
	TLNN	TA,1B33		;THERE WAS A LAST SECTION, SKIP IF IT WAS IN THE DECLARATIVES
				;REMEMBER, THAT EPSECT'S FLAGS SHIFTED RIGHT 1

	JRST	RESTOR		;PUSHJ TO OBJECT TIME ERROR ROUTINE NOT NEEDED.
				;THERE MUST HAVE BEEN A LAST SECTION
				;AND IT MUST HAVE BEEN IN THE DECLARATIVES, AND


				;PLACE WHERE SYNTAX ROUTINE IS SENDING
				;YOU MUST BE OUTSIDE THE DECLARATIVES.



	HRRZ	TA,(EACA)	;GET WHERE SYNTAX IS SENDING YOU
	PUSHJ	PP,LNKSET
	MOVE	TB,2(TA)

	TRNE	TB,1B32		;ITEM OUTSIDE DECLARATIVES ?

	JRST	RESTOR		;NO, YOU CAN GO BACK


	MOVE	CH,[EPJPP,,KDECL.##]	;OOOPS, HE MIGHT FALL INTO LITERALS

	HLLZ	TA,EPPARA	;SEE WHETHER OR NOT WE IN RESIDENT SECTION.
	TLNE	TA,ENREZF

	PUSHJ	PP,FXDECL	;FIXUP OF USER TO DIE WHEN
				;FALLING OUT OF DECLARATIVES
				;REQUIRED, BUT PUSHJ 17
				;MUST BE INDIRECT BECAUSE
				;EXTERNALS CANNOT BE CHAINED
				;INTO/OUT OF NON-RES SEGS.


	JRST	PUTASY
				;THE CATCHER GENERATED <NO FALLING OUT OF
				;THE DECLARATIVES>
				;RETURN
FXDECL:	SKIPA	TA,[EXP STOPR.]	;PREPARE TO UPDATE EXTAB'S NON-RES REFERENCE FLAG
FXPROG:	HRRZI	TA,KPROG.
	ANDI	TA,77777
	ADDI	TA,<CD.EXT>B20
	PUSHJ	PP,LNKSET
	MOVSI	TB,NR.EXT
	IORM	TB,1(TA)	;[425] SET IN NON-RESIDENT SECTION.

	POPJ	PP,





RESTOR:	HRRZ	TA,(EACA)	;RESTORE TA FOR MAIN LINE PROGRAM
	JRST	RESUME



GODDEC:	TRNE	EACC,1B32	;SEE IF SOURCE IS IN THE DECLARATIVES.
	JRST	DECOK		;EVERYTHING'S OK

IFN ANS74,<
GODBTS:	SKIPN	DBPARM##	;ANY CHANCE WE NEED TO OUTPUT DEBUG INFO?
	POPJ	PP,		;NO, NORMAL CODE
	LDB	CH,W1LN		;GET LINE#
	HRLI	CH,MOVEI.##+AC16
	PUSHJ	PP,PUTASY
	MOVE	CH,[MOVEM.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVE	CH,DBPARM
	IORI	CH,AS.PAR
	JRST	PUTASY		;MOVEM 16,%PARAM+N
>
DECWRN:	MOVEI	DW,E.185		;VIOLATION OF DECLARATIVES BOUNDARY
	JRST	EFATAL



GOWRN:	HRRZ	TA,EPPARA		;GET THIS PP'S PROTAB LINK
	PUSHJ	PP,LNKSET		;GET REAL ADDRESS
	HRRZ	TB,3(TA)		;GET FLOTAB NTRY
	ANDI	TB,77777		;STRIP OFF ALL BUT OFFSET
	ADD	TB,FLOLOC		;NOW YOU HAVE FLOTAB ENTRY.!
	MOVEI	EACA,2(TB)		;POINT EACA SO THAT -1(EACA)
					;WILL LOOK AT LN & CP
	MOVEI	DW,E.94			;GO TO. NOT ALTERED.
	JRST	EWARN
SAVBLT:	MOVEI	W2,(TA)		;COME HERE WHEN NO
				;ALTER WORD HAS BEEN ALLOCATED FOR AN
				;ALTERED GO.

				;START BY SAVING THE ADDRESS
				;OF THE PROTAB ENTRY THAT WILL BE
				;UPDATED, SHOWING
				;THAT AN ALTER WORD HAS BEEN ALLOCATED.

	TRNE	EACC,40		;ALL ALTERS IN  THIS SEG?
	JRST	ADDPR2		;NOPE!

	MOVEI	TB,0
	PUSHJ	PP,PUTALT
	MOVE	TB,EACB		;GET SAVED ADDRESS.
FINBLT:	PUSHJ	PP,INCALT	;THE ADDRESS GOES IN RIGHT HAND
				;HALF OF XWD. INCALT BUMPS ALTAB'S PPC

	MOVEI	CH,700000-1(CH)	;RESTORE ALTAB'S PPC TO
				;WHAT IT SHOULD BE TO POINT TO
				;XWD JUST CREATED, AND ADD IN TABLE TYPE CODE.


	HRLM	CH,2(W2)	;UPDATE THAT OLD PROTAB ENTRY
				;THIS WILL ALLOW YOU TO GET
				;A HANDLE ON ALTERED GOES
	JRST	PUTASN		;DBT

ADDPR2:	MOVE	TB,EACB		;RETRIEVE SAVED ADDRESS.
	PUSHJ	PP,PUTALT	;ADDRESS IN LEFT HALF OF XWD
	HRRZ	TA,EPPARA	;HAVE TO HAVE THE PROTAB ADDRESS
	PUSHJ	PP,GTBIT1

	MOVE	TB,CH		;GET PRI BITS INTO TB FROM CH   &
	JRST	FINBLT
				;FINISH UP
EGOTO:	XWD	AS.GO,AS.MSC	;POINTS TO JRST GOTO.
SUBTTL THE "GO DEPENDING" GENERATOR

EXTERNAL SETOPN,PUTASY,PUTASN,MXAC.

GODPGN:	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;ANY OPERANDS?
	JRST	BADEOP		;NO--TROUBLE
	MOVEM	W1,OPLINE	;SAVE OPERATOR'S LN&CP

;SCAN THRU EOPTAB FROM TOP, LOOKING FOR VARIABLE

	MOVE	EACA,EOPLOC

	SETZM	GODPOV##	;[V10] CLEAR THE CALL OVERLAY FLAG.
	SETOM	USEXJR##	;MAKE SURE WE GENERATE "XJRST'S" FOR
				; GOTO'S

GODPG1:	MOVE	TE,1(EACA)	;GET FIRST WORD OF AN OPERAND
	TLNE	TE,GNLIT	;IS IT A LITERAL OR FIG. CONST.?
	JRST	GODPG2		;YES

	MOVE	TA,2(EACA)	;NO--IS IT
	LDB	TE,LNKCOD	;  A DATA-NAME?
	CAIN	TE,TB.DAT
	JRST	GODPG3		;YES

	ADD	EACA,[XWD 2,2]	;[V10] MOVE UP TO THE SECOND
				;[V10]  WORD OF THE CURRENT OPERAND.

	PUSHJ	PP,RESOLV	;[V10] GO MAKE SURE WE HAVE A
				;[V10]  PROTAB LINK.
	PUSHJ	PP,LNKSET##	;[V10] MAKE IT INTO AN ADDRESS.
	MOVE	EACD,2(TA)	;[V10] GET THE DESTINATION'S FLAGS.
	LDB	EACC,FLAGPP	;[V10] GET THE CURRENT SEGMENT'S FLAGS.
	XORI	EACD,(EACC)	;[V10] IF THE DESTINATION ISN'T
	TRNE	EACD,ENREZE	;[V10]  IN THE CURRENT SEGMENT,
	SETOM	GODPOV##	;[V10]  NOTE THAT WE HAVE TO
				;[V10]  CALL THE OVERLAY HANDLER.

	CAME	EACA,EOPNXT	;KEEP LOOKING

	JRST	GODPG1
	JRST	BADEP6
;LITERAL OR FIG. CONST. FOUND

GODPG2:	MOVEI	TC,1(EACA)	;SETUP CUREOP
	MOVEM	TC,CUREOP	;INCASE OF ERROR
IFN ANS68,<
	TLNE	TE,GNFIGC	;FIG. CONST.?
	TLNN	TE,GNTALY	;YES--TALLY?
>
	JRST	BADEP4		;NO--ERROR

;VARIABLE FOUND

GODPG3:	MOVEM	EACA,EOPNXT

	MOVEI	TC,1(EACA)
	MOVEM	TC,CUREOP
	MOVSM	TC,OPERND

IFN ANS74,<
	SETOM	EDEBDA##	;WE MIGHT NEED TO DEBUG ON DEPENDING VARIABLE
	SOS	EDEBDA		;BUT ONLY IF "ALL REFERENCE OFF"
>
	MOVEI	LN,EBASEA	;SET UP PARAMETERS FOR VARIABLE
	PUSHJ	PP,SETOPN

	HRRZ	TE,EMODEA
	CAIE	TE,FPMODE	;IS IT COMP-1?
	CAIN	TE,F2MODE	;OR COMP-2?
	JRST	BADEP7		;YES--ERROR
	TSWF	FANUM		;IS IT NUMERIC?
	SKIPE	EDPLA		;YES--DECIMAL PLACES?
	JRST	BADEP1		;BAD VARIABLE
	MOVE	TE,ESIZEA	;IS IT ONLY ONE WORD?
	CAILE	TE,^D10
	JRST	BADEP2		;NO--BAD VARIABLE
;MOVE 'DEPENDING' ITEM INTO AC3

IFN ANS74,<
	PUSH	PP,EDEBDA	;DON'T WANT DEBUGGING CODE ON MOVE
	SETZM	EDEBDA
>
	MOVEI	TE,3
	MOVEM	TE,EAC
	PUSHJ	PP,MXAC.
IFN ANS74,<
	POP	PP,EDEBDA	;PUT BACK DEBUGGING INFO
>

;HOW MANY NAMES?

GODPG5:	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;ANY PROCEDURE NAMES?
	JRST	BADEOP		;NO--TROUBLE

	HRRZ	TC,EACA		;COMPUTE NUMBER OF NAMES
	MOVE	TD,EOPLOC
	SUBI	TC,0(TD)
	LSH	TC,-1

	CAILE	TC,77777	;IN-BOUNDS?
	JRST	BADEOP		;NO--TROUBLE

	SKIPE	GODPOV##	;[V10] IF WE HAVE TO WORRY
	JRST	GODPD		;[V10]  ABOUT SEGMENTS, GO ON.

IFN ANS74,<
	PUSHJ	PP,GODBTS	;SEE IF DEBUGGING ON PROCEDURES INFO NEEDED
	SKIPE	EDEBDA		;IF DEBUGGING ON "A"
	JRST	[PUSHJ PP,PUTASA	; WE NEED TO SAVE ACC 3
		MOVE	CH,[PUSH.+AC17,,3]
		PUSHJ	PP,PUTASY	;USE STACK
		PUSHJ	PP,GDEBA##	;GENERATE DEBUGGING INFO ON DEPENDING VARIABLE
		PUSHJ	PP,PUTASA	;NOW RESTORE ACC 3
		MOVE	CH,[POP.##+AC17,,3]
		PUSHJ	PP,PUTASY
		JRST	.+2]
	PUSHJ	PP,GDEBA##	;GENERATE DEBUGGING INFO ON DEPENDING VARIABLE
>
;GENERATE:	CAIG	3,N
;		JUMPG	3,.+1(3)
;		JRST	%TAG (.+N+1)	;[561]
;WHERE "N" IS THE NUMBER OF PROCEDURE NAMES

	MOVSI	CH,CAIG.+AC3
	HRR	CH,TC
	PUSHJ	PP,PUTASY

	MOVE	CH,[XWD JUMPG.+AC3+ASINC+3,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZI	CH,AS.DOT+1
	PUSHJ	PP,PUTASN

;[561]	PUSHJ	PP,PUTASA##
;[561]	MOVE	CH,[XWD XJRST.+ASINC,AS.MSC]
;[561]	PUSHJ	PP,PUTASY
;[561]	MOVEI	CH,AS.DOT+1(TC)
;[561]	PUSHJ	PP,PUTASN
;
	PUSHJ	PP,GETTAG	;[561] GET A TAG FOR TARGET OF JRST
	PUSH	PP,CH		;[561] SAVE ON PUSHDOWN STACK
	HRLI	CH,JRST.	;[561] FINISH INSTRUCTION -- "JRST %TAG"
	PUSHJ	PP,GOENT1	;[561] PUT OUT JRST OR XJRST
	HRRZ	TA,CH		;[561] NOW REFERENCE THE TAG
	PUSHJ	PP,REFTAG	;[561] SO THE OPTIMIZER WILL WORK

;NOW PUT OUT ALL THE GO'S

GODPG6:	;[V10] COME BACK HERE AFTER WORRYING ABOUT SEGMENTS.

	MOVE	EACA,EOPLOC

GODPG7:	ADD	EACA,[XWD 2,2]	;BUMP TO NEXT ENTRY
	PUSHJ	PP,GOGO1

	CAME	EACA,EOPNXT	;DONE?
	JRST	GODPG7		;NO--LOOP

	SETZM	GODPOV##	;[V10] MAKE SURE THE WORRY ABOUT
				;[V10]  SEGMENTS FLAG IS OFF.

	POP	PP,CH		;[561] GET TAG TO PUT OUT
	PJRST	PUTTAG		;[561] OUTPUT IT AND RETURN
;[V10] COME HERE ON A GO DEPENDING WHEN THE DESTINATION ISN'T IN THE
;[V10] CURRENT SEGMENT.

;[V10]	(TC) = N, THE NUMBER OF DESTINATIONS

;[V10] GENERATE:	JUMPLE	3,	%TAG (.+5+N) ;[561]
;[V10]	 		CAILE	3,	N
;[V10]	 		JRST		%TAG (.+3+N)
;[V10]	 		XCT		.+1(3)
;[V10]	 		PUSHJ	17,	OVRLAY.

GODPD:	PUSHJ	PP,	GETTAG		;[561] GET A TAG TO JUMP TO
	PUSH	PP,	CH		;[561] SAVE IT ON STACK

;[V10] GENERATE THE "JUMPLE 3,%TAG"
	HRLI	CH,	JMPLE.##+AC3	;[561]
	PUSHJ	PP,	PUTASY		;[V10]

;[V10] GENERATE THE "CAILE 3,N"
	MOVSI	CH,	CAILE.##+AC3	;[V10]
	HRRI	CH,	(TC)		;[V10]
	PUSHJ	PP,	PUTASY		;[V10]

;[V10] GENERATE THE "JRST %TAG"
	HRRZ	CH,	(PP)		;[561] GET TAG (ON TOP OF STACK)
	HRLI	CH,	JRST.##		;[561]
	PUSHJ	PP,	PUTASY		;[V10]

;[561]  REFERENCE THE TAG TWICE
	HRRZ	TA,	(PP)		;[561]
	PUSHJ	PP,	REFTAG		;[561]
	HRRZ	TA,	(PP)		;[561]
	PUSHJ	PP,	REFTAG		;[561]

;[V10] GENERATE THE "XCT .+1(3)"
	MOVE	CH,	[XWD	XCT.##+ASINC+3,AS.MSC]	;[V10]
	PUSHJ	PP,	PUTASY		;[V10]
	MOVEI	CH,	AS.DOT+1	;[V10]
	PUSHJ	PP,	PUTASN		;[V10]

;[V10] GENERATE THE "PUSHJ 17,OVLAY."
	MOVEI	CH,	OVLAY%##	;[V10]
	PUSHJ	PP,	GNPSX.##	;[V10]
;[V10] NOW WE HAVE TO PUT OUT EITHER "JRST <PROCEDURE-NAME>", IF
;[V10]  THE DESTINATION IS IN THE SAME SECTION WE ARE CURRENTLY IN
;[V10]  OR "MOVE 16,[XWD <PROCEDURE-NAME>,<PRIORITY>]", IF IT ISN'T,
;[V10]  FOR ALL <PROCEDURE-NAMES> GIVEN.

	JRST		GODPG6		;[V10] GO BACK TO THE OLD
					;[V10]  CODE.  THE SUBROUTINE
					;[V10]  GOGO1 WAS HACKED SO
					;[V10]  THAT IT WOULD PRODUCE
					;[V10]  THE CORRECT CODE WHEN
					;[V10]  GODPOV WAS NON-ZERO.
;ERRORS

;VARIABLE ISN'T NUMERIC, OR HAS DECIMAL PLACES

BADEP1:	PUSHJ	PP,BADDP
	JRST	BADEP3

;VARIABLE IS TOO LARGE

BADEP2:	PUSHJ	PP,BADSIZ

BADEP3:	MOVSI	CH,MOVEI.+AC3	;GENERATE <MOVEI 3,0> SO WE CAN GO ON
	PUSHJ	PP,PUTASY
	JRST	GODPG5

;A FIGURATIVE CONSTANT, BUT NOT TALLY.

BADEP4:	MOVEI	DW,E.184
	PUSHJ	PP,OPNFAT

BADEP5:	MOVEM	EACA,EOPNXT
	JRST	BADEP3

;COULDN'T FIND A LITERAL NOR A DATA NAME

BADEP6:	OUTSTR	[ASCIZ "No variable for GODEP
"]
	JRST	BADEP5

;COMP-1 WHEN IT SHOULDN'T BE

BADEP7:	PUSHJ	PP,BADFP
	JRST	BADEP3

AC3==3B30	;AC USED BY GODEP

EXTERNAL ESIZEA,EBASEA,EDPLA
EXTERNAL EOPLOC,EOPNXT,CUREOP,OPERND,AS.DOT,EAC,TB.DAT
EXTERNAL CAIG.,MOVEI.,JUMPG.,JRST.
SUBTTL GENERATOR SERVICE ROUTINES






				;THE VALTAB TO LITAB XFER SUBROUTINE:
				;TRANSFERS ASCII FROM VALTAB TO LITAB
				;AND SUPPLIES LITAB WITH A HEADER WORD
				;ENTRY.

				;ONLY GOOD FOR ASCII!

				;EACA IS EXPECTED TO CONTAIN A POINTER
				;TO A WORD WHICH, IN TURN, POINTS TO A
				;RELATIVE ADDRESS IN VALTAB. THE ENTRY IN
				;VALTAB CONTAINS IN BITS 0-5 [OF THE 1ST WORD]
				;THE NUMBER OF CHARACTERS IN THE ASCII STRING.
				;REFER TO COBOL MEMO 100-350-11.01, PAGE
				;20 FOR FURTHER DESCRIPTION OF WORD LAYOUT
				;IN VALTAB AND BIT ASSIGNMENTS.



				;CALL:
				;[PUSHJ	PP,EVALIT]
				;TA IS EXPECTED TO POINT TO THE ORIGIN'S
				;[REAL ! ADDRESS!!] 1ST ENTRY.
				;THIS ENTRY IS EXPECTED TO HAVE A CHARACTQR
				;COUNT IN THE 1ST ASCII CHARACTER!
				;
				;
				;THE SUBROUTINE CAN BE EXPECTED TO CLOBBER:
				;EACA _ WHICH RETURNS WITH THE # OF WORDS PUT IN AS.LIT
				;EACB
				;EACC
				;EACD
				;
				;TA - TE
				;EACC AND EACD ARE EXPECTED TO BE CONTIGUOUS,
				;I.E., EACC MUST BE 1 LESS THAN EACD,
				;MODULO 20 OCTAL.
				;PUT A WORD FROM TB
				;INTO LITAB
				;AND KEEP LITNXT & TA
				;CORRECTLY POINTING TO
				;WHERE THEY SHOULD
				;
				;TA WILL BE = LITNXT UPON EXITING.
				;CALL IS [PUSHJ	PP,PUTLIT]
				;




INCALT:	AOSA	CH,EALTPC	;BUMP PPC
	PUSHJ	PP,XPNALT	;EXPAND THE ALTER TABLE
PUTALT:	MOVE	TA,ALTNXT
	AOBJP	TA,.-2
	MOVEM	TB,(TA)
	MOVEM	TA,ALTNXT
	POPJ	PP,



LINUM:	POINT	13,-1(EACA),28	;13 BITS LONG STOPPING AT BIT #28


				;DW IS EXPECTED TO CONTAIN THE APPROPRIATE
				;DECIMAL DIAGNOSTIC NUMBER UPON ARRIVING HERE.
EWARN:	LDB	LN,LINUM	;ALSO, W1 IS EXPECTED TO
				;CONTAIN THE OPERAND'S LN & CP.
	HRRZ	CP,-1(EACA)	;GET CHARACTER POSITION
	JRST	WARN		;PUT OUT DIAG & RETURN


EFATAL:	LDB	LN,LINUM	;LIKEWISE FOR FATAL DIAGNOSTIC
	HRRZ	CP,-1(EACA)
	JRST	FATAL		;PUT OUT DIAG & RETURN
				;ALLOCATE A WORD FOR EXIT ROUTINE.
				;
				;USES ACCUMULATORS
				;TC
				;TD
				;TE

				;TA IS EXPECTED TO POINT AT APPLICABLE PROTAB
				;ENTRY UPON ENTERING SUBROUTINE

				;CH IS EXPECTED TO RETURN WITH THE
				;PHASE F EAS1PC + TYPE CODE LINK IN IT.


EOCT1:	XWD	6B20!ASCOCT,000001
EALLOC:	MOVE	CH,EOCT1	;ASSEMBLER OCTAL INFORMATION
	PUSHJ	PP,PUTAS1
	MOVEI	CH,0		;THE 1 WORD OF OCTAL RADIX = 0.
	PUSHJ	PP,PUTAS1
	AOS	CH,EAS1PC	;BUMP PPC
	MOVEI	CH,100000-1(CH)	;LEAVE TYPE CODE + PPC BEFORE BUMPING
				;IN CH
	HRLM	CH,3(TA)	;UP-DATE PROTAB.


	POPJ	PP,		;---------------> RETURN
;WRITE LITAB ONTO CURRENT ASYFIL

EBURPL:	SKIPG	LITBLK		;ANYTHING ON LITFIL?
	JRST	EBRP10		;NO

	HRRZ	TE,LITNXT	;YES--COMPUTE HOW
	HRRZ	TD,LITLOC	;  MANY WORDS
	SUB	TD,TE		;  STILL IN LITAB
	JUMPE	TD,EBRPL1	;IF NONE--NO NEED TO WRITE

	MOVM	TE,TD		;INCREMENT LITBLK
	ADDM	TE,LITBLK
	MOVSS	TD		;BUILD
	HRR	TD,LITLOC	;  IOWD LIST FOR
	SETZ	TC,		;  OUTPUT
	OUT	LIT,TD		;WRITE OUT REST OF TABLE
	  JRST	EBRPL1		;OK
	MOVEI	CH,LITDEV	;ERROR--KILL
	JRST	DEVDED

EBRPL1:	CLOSE	LIT,

	MOVE	TE,LITHDR	;CREATE
	HLLZ	TD,LITHDR+1	;  LOOKUP
	SETZB	TC,TB		;  PARAMETERS
	LOOKUP	LIT,TE		;OPEN FOR INPUT
	  JRST	EBRP11		;CANNOT FIND IT--MONITOR TROUBLE

	SETZM	EWORDB		;CLEAR COUNT OF WORDS IN TABLE
	MOVE	TE,LITLOC	;RESET LITNXT
	MOVEM	TE,LITNXT

	PUSHJ	PP,EBRPL2	; GO GET LITERAL FROM LITFIL [167]
;WRITE LITAB ONTO ASYFIL (CONT'D)

EBRPL3:	HRRZ	EACC,LITLOC	;START AT TOP OF TABLE
	JRST	EBRPLA		; GO GET LITERALL [167]

EBRPL4:	SOSG	EWORDB		; SEE IF MORE LITERAL IN CORE [167].
	PUSHJ	PP,EBMOR	; NO READ IN MORE FROM LITFIL [167]
EBRPLA:				; NEED NEW LABEL [167]
	HRRZ	TE,1(EACC)	;GET CODE AND SIZE
	LSH	TE,6		;SEPARATE CODE
	HLLM	TE,1(EACC)	;STORE IN LHS WHERE EXPECTED
	MOVEI	TE,770000
	ANDCAM	TE,1(EACC)	;CLEAR CODE FROM COUNT SIDE
	HLRZ	TE,1(EACC)	;GET LITAB CODE
	CAILE	TE,MAXLIT##	;IF ILLEGAL,
	JRST	EBRPLX		;  TROUBLE

	HRRZ	EACB,1(EACC)	;GET GROUP SIZE

	MOVE	TE,EWORDB	;IS ENTIRE GROUP IN CORE?
	CAIL	TE,1(EACB)
	JRST	EBRPL6		;YES
	CAIG	TE,1000	; NOT ALL OF LITERAL IN CORE. IS THERE A MINIMAL AMOUNT ? [167]
	PUSHJ	PP,EBMOR	; GET READ MORE [167]


EBRPL6:				; MOVE LABEL [167]
	HLRZ	TE,1(EACC)	;GET CODE BACK
	XCT	BRPTAB(TE)	;EXECUTE SOME ROUTINE
	HRRI	CH,(EACB)	;IT WASN'T BYTE OR XWD--GET SIZE
	PUSHJ	PP,PUTASN	;WRITE OUT HEADER WORD

EBRPL7:	SOSG	TE,EWORDB	; SEE IF MORE IN CORE [167]
	PUSHJ	PP,EBMORA	; NO READ IN MORE [210]
	MOVE	CH,2(EACC)	;WRITE OUT DATA WORD
	PUSHJ	PP,PUTASY
	MOVEI	EACC,1(EACC)	;BUMP LOCATION
	SOJG	EACB,EBRPL7	;LOOP UNTIL DONE
	AOJA	EACC,EBRPL4	;BUMP LOCATION AND LOOP

EBRPL9:	POP	PP,(PP)		; POP OFF CALL TO EBMOR [167]
	MOVE	TE,LITLOC	;RESET LITNXT
	MOVEM	TE,LITNXT
EBRPLE:	POPJ	PP,
;WRITE LITAB ONTO ASYFIL (CONT'D)

EBRPLX:	OUTSTR	[ASCIZ "?Bad LITAB code--compiler error
"]
	SKIPL	LITBLK
	SETZM	LITBLK
	JRST	EBRPL9

;NOTHING WAS WRITTEN ON LITFIL

EBRP10:	MOVE	TE,LITNXT
	SUB	TE,LITLOC
	JUMPE	TE,EBRPLE
	HRRZM	TE,EWORDB
	JRST	EBRPL3

;CANNOT FIND LITFIL

EBRP11:	OUTSTR	[ASCIZ "?Cannot find LITFIL--compiler error
"]
	JRST	KILL


;[167]	READ MORE LITERALS FROM THE LITFIL
;[167]	CODE EBRPL5 AND EBRPL2 MADE INTO A SUBROUTINE HERE
;[167]	INSERTED AT EBRP11+2

EBMORA:	SKIPG	LITBLK		;[210] ANYMORE ON LITFIL
	JRST	EBRPL9		;[210] NO QUIT
	PUSHJ	PP,EBMOR	;[210] READ IN MORE
	JRST	EBMORC		;[210] FINISH UP
EBMORB:	SKIPG	LITBLK		;[210] ANY MORE ON LITFIL?
	JRST	EBRPL9		;[210] NO QUIT
	AOS	EWORDB		;[210] KEEP ANY WORDS NOT USED
	PUSHJ	PP,EBMOR	;[210] GET MORE
	SOS	EWORDB		;[210] FIX UP WORD COUNT
EBMORC:	SOS	EACC		;[210] FIX LITTAB POINTER
	POPJ	PP,		;[210] RETURN
EBMOR:	SKIPG	TE,EWORDB	;[167] MAKE SURE WE DONT GO NEGATIVE
	SETZB	TE,EWORDB	;[167] SET NEGATIVE TO ZERO
	HLRE	TD,LITLOC	;RESET THE NUMBER OF WORDS LEFT FOR
	ADD	TD,TE		; LITNXT.
	HRLM	TD,LITNXT
	HRRZ	TD,LITLOC	;[167] NO-- WAS BRPPL5
	ADDI	TD,1		;MOVE UP
	HRLI	TD,1(EACC)	;  UNUSED
	ADD	TE,LITLOC	;  WORDS
	CAME	TE,LITLOC
	BLT	TD,0(TE)	;[210]

	HRRM	TE,LITNXT	;RESET LITNXT
	SKIPG	LITBLK		;ANYTHING LEFT IN FILE?
	JRST	EBRPL9		;NO--QUIT
EBRPL2:	MOVE	TE,LITBLK	;GET NUMBER OF WORDS IN FILE
	CAILE	TE,1600		;IF MORE THAN ^D768,
	MOVEI	TE,1600		;  USE ^D768
	ADDM	TE,EWORDB	;INCREMENT TABLE COUNT

EBRP12:	HLRE	TD,LITNXT	;WILL LITFIL READ IN OVER TAGTAB?
	ADDI	TD,(TE)		;  (THE TABLE AFTER LITTAB)
	JUMPLE	TD,EBRP13	;NO
	PUSHJ	PP,XPNLIT	;YES, EXPAND LITTAB
	JRST	EBRP12

EBRP13:	MOVNS	TE		;DECREMENT
	ADDM	TE,LITBLK	;  FILE WORD COUNT

	MOVSS	TE		;CREATE
	HRR	TE,LITNXT	;  IOWD LIST
	SETZ	TD,		;  FOR INPUT

	IN	LIT,TE		;READ SOME WORDS
	  JRST	EBRP1A		;OK
	MOVEI	CH,LITDEV	;ERROR--KILL
	POP	PP,(PP)		;[167] REMOVE CALL
	JRST	DEVDED

EBRP1A:	HRRZ	EACC,LITLOC	;[167] GET LITTAB START
	POPJ	PP,		;[167] RETURN
;WRITE LITAB ONTO ASYFIL (CONT'D)

BRPTAB:	JRST	EBRPLX		;0 --ERROR
	JRST	BRPXWD		;1 --XWD
	JRST	BRPBYT		;2 --BYTE POINTER
	MOVSI	CH,6B20!ASCASC	;3 --ASCII
	MOVSI	CH,6B20!ASCSIX	;4 --SIXBIT
	MOVSI	CH,6B20!ASCD1	;5 --ONE-WORD DECIMAL
	MOVSI	CH,6B20!ASCD2	;6 --TWO-WORD DECIMAL
	MOVSI	CH,6B20!ASCFLT	;7 --FLOATING POINT
	MOVSI	CH,6B20!ASCOCT	;10--OCTAL
	MOVSI	CH,6B20!ASCEBC	;11--EBCDIC
	AOJA	EACC,BRPXTN	;12--EXTEND OPCODE
	MOVSI	CH,6B20!ASCF2	;[762] 13--D. P. FLOATING POINT

;ITEM IS AN XWD

BRPXWD:	LSH	EACB,-1		;HALVE THE COUNT
	MOVEI	CH,(EACB)	;BUILD A HEADER WORD
	HRLI	CH,5B20
	PUSHJ	PP,PUTASN	;WRITE IT OUT

BRPX1:	SOS	TE,EWORDB	; COUNT DOWN TWO WORDS [167]
	SOSG	TE,EWORDB	; AND SEE IF ANY LITERALS IN CORE [167]
	PUSHJ	PP,EBMORB	; TABLE EMPTY READ IN MORE [210]
	MOVE	CH,2(EACC)	;GET LEFT-HALF INFO
	PUSHJ	PP,PUTASN	;WRITE IT OUT
	MOVE	CH,3(EACC)	;GET RIGHT-HALF INFO
	PUSHJ	PP,PUTASY	;WRITE IT OUT

	MOVEI	EACC,2(EACC)	;BUMP TO NEXT DATUM
	SOJG	EACB,BRPX1	;LOOP IF MORE DATA FOR THIS ITEM

	AOJA	EACC,EBRPL4	;LOOP BACK TO GET NEXT ITEM


;ITEM IS A BYTE POINTER.

BRPBYT:	LSH	EACB,-1		;HALVE THE COUNT

BRPB1:	SOS	TE,EWORDB	; COUNT DOWN TWO WORDS [167]
	SOSG	TE,EWORDB	; AND SEE IF ANY LITERALS IN CORE [167]
	PUSHJ	PP,EBMORB	; TABLE EMPTY READ IN MORE [210]
	MOVSI	CH,4B20		;BUILD HEADER WORD
	HRR	CH,2(EACC)
	LDB	TE,[POINT 3,CH,20] ;GET TYPE OF ADDRESS
	CAIN	TE,AC.EXT##	;EXTERNAL?
	 JRST	[PUSHJ PP,PUT.EX	 ;YES, CHECK FOR NON-RES
		JRST .+2]
	PUSHJ	PP,PUTASY	;NORMAL ADDRESS PART--WRITE THAT OUT
	MOVE	CH,3(EACC)	;GET INCREMENT WORD
	PUSHJ	PP,PUTASN	;WRITE THAT OUT
	MOVEI	EACC,2(EACC)	;BUMP TO NEXT DATUM
	SOJG	EACB,BRPB1	;LOOP IF MORE DATA FOR THIS ITEM
	AOJA	EACC,EBRPL4	;LOOP TO GET NEXT ITEM
;ITEM IS AN EXTEND [OPCODE]

BRPXTN:	PUSHJ	PP,PUTASA	;THEY ARE IN OTHER OPCODE SET
	SOSG	EWORDB		;ONLY ONE WORD?
	PUSHJ	PP,EBMORB	;TABLE EMPTY READ IN MORE
	MOVSI	CH,ZOP.##	;GET BASE OPCODE
	ADD	CH,1(EACC)	;GET WHICH EXTEND
	LDB	TE,[POINT 3,CH,20]	;GET CODE
	PUSHJ	PP,[CAIE TE,AC.EXT##	;EXTERNAL
		AOJA	EACC,PUTASY	;NO
		TLNN	CH,(@)		;YES, INDIRECT SIGN ON?
		AOJA	EACC,PUT.EX	;NO
		AOJA	EACC,PUT.SX]	;YES
BRPXT1:	SOJLE	EACB,EBRPL4	;ONLY ONE WORD
	SOSG	TE,EWORDB	;SEE IF TABLE EMPTY
	PUSHJ	PP,EBMORB	;YES, FILL IT
	MOVE	CH,1(EACC)	;GET NEXT
	PUSHJ	PP,PUTASN
	AOJA	EACC,BRPXT1	;LOOP
;PUT AN ENTRY INTO SECTAB

	PUSHJ	PP,XPNSEC
PUTSEC:	MOVE	TA,SECNXT
	AOBJP	TA,.-2
	MOVEM	TB,(TA)
	MOVEM	TA,SECNXT
	POPJ	PP,


;UPDATE SECTAB, BURP OUT LITAB AND ALTAB

SEGCLN:	PUSHJ	PP,CKEXIT	;CHECK FOR EXITS REQUIRING GENERATION
	TSWF	FAS3		;ARE WE IN A NON-RESIDENT SEGMENT?
	SKIPA	TB,EAS3PC	;YES--USE EAS3PC
	MOVE	TB,EAS2PC	;NO--USE EAS2PC
	MOVSI	TB,(TB)		;LH _ RH
	PUSHJ	PP,PUTSEC	;STASH THAT IN SECTAB

	MOVEI	TB,0
	PUSHJ	PP,PUTSEC	;MAKE ROOM FOR 2ND ENTRY
				;IF REQUIRED. IF NOT NEEDED, 2ND
				;ENTRY WILL BE 0'S.///


	SETOM	LITASY##	;FLAG FOR UUO CONVERSION - LITTAB TO ASY

				;PUT OUT A RELOC OPERATOR & DUMP LITAB (IF NECESSARY)
	SKIPN	W2,ELITPC	;ANYTHING IN LITAB?
	JRST	ETSTAL		;NOTHING IN LITAB, CHECK ALTERS.

	MOVE	CH,[XWD	AS.REL+1,AS.MSC]	;RELOC OPERATOR OUT
	PUSHJ	PP,PUTASN	;WRITE IT OUT
	MOVEI	CH,AS.LIT	;ADD TO BASE OF LITERALS FLAG + 0.




	PUSHJ	PP,PUTASN	;WRITE IT OUT
;SPILL CONTENTS OF LITAB TO ASYFIL

	PUSHJ	PP,EBURPL

ETSTAL:	SKIPE	W2,EALTPC	;IF PPC IS 0, NO DUMPING
	PUSHJ	PP,EBPALT	;BURP OUT ALTER FOR > 50.

	TSWT	FAS3		;ARE WE IN A NON-RESIDENT SEGMENT?
	JRST	ETSTA1		;NO
	MOVE	TA,EAS3PC	;YES--IF BIGGER
	CAMLE	TA,HILOC	;	THAN LAST ONE,
	MOVEM	TA,HILOC	;	RESET PROGRAM BREAK

ETSTA1:	JUMPE	EACA,EBURPX	;IF END OF PROG--NO CHECKS
	HRRZ	TA,(EACA)	;GET OPERAND'S FLAGS
				;IN THE CASE OF THE CALL FROM ERAPUP,
				;THIS MAY BE A DUMMY CREATED BY SELF.
	PUSHJ	PP,LNKSET
	HRRZ	TA,2(TA)	;THERE, GOT THE PRIORITY # FOR NEXT GUY <OR DUMMY>
	CAIL	TA,^D1B24	;GOING TO RES ?
	SWON	FAS3		; _ NOPE, SET "IN NON-RES FLAG.
				; _ YEP, INITIAL CASE = SET TO
				;RESIDENT, SO CONTINUE THINKING YOU ARE
				;IN RESIDENT UNTIL YOU SEE NON-RES.
				;FROM THE 1ST TIME YOU SEE NON-RES,
				;ALL SUBSEQUENT SEGS WILL BE NON-RES.
	TSWF	FAS3		;ANY NON-RESIDENTS SEEN?
	SETOM	SEGFLG		;YES--SET INDICATOR FOR PHASE G

;CLEAR SOME WORK AREA

EBURPX:	SETZB	TB,EZEROL
	SETZM	ELITPC		;CLEAR LIT'S PPC.
	SETZM	EALTPC		;AND ALT'S PPC.
	SETZM	LITASY##	;CLEAR LITTAB TO ASY FLAG
	MOVE	TE,[XWD EZEROL,EZEROL+1]
	BLT	TE,EZEROH

	JRST	POOLINI##	;RESET LITERAL POOLER AND RETURN
EBPALT:	HRRZ	EACB,EAS3PC		;SAVE EAS3 PC
	HRLI	EACB,(W2)		;SAVE EALT PC TOO.

	MOVSI	CH,5B20			;XWD HEADER
	HRRI	CH,(W2)			;WITH TYPE  CODE  AND # 2-WORD ENTRIES.
	PUSHJ	PP,PUTASN		;ONTO WRITE-LOCKED AS2 OR AS3.
	SKIPA	TA,ALTLOC		;ENTER DUMP
MORALT:	MOVEI	TA,2(TA)		;GET NEXT GUY & CONTINUE

	MOVE	CH,1(TA)		;1ST WORD
	PUSHJ	PP,PUTASN		;= LEFT HALF OF XWD
	MOVE	CH,2(TA)		;
	PUSHJ	PP,PUTASY		;2ND WORD = RIGHT HALF OF XWD
	SOJG	W2,MORALT		;MORE?  YES ^; NO FALLS THRU


					;NOPE _

;ALTAB HAS BEEN DUMPED, RESET IT TO ITS INITIAL VALUE SO THAT IF
; SUBSEQUENT SECTIONS CONTAIN ALTERS, THEY WILL BE DUMPED.

	MOVE	TA,ALTLOC##
	MOVEM	TA,ALTNXT##

					;UPDATE 2ND WORD IN SECTAB NOW!
					;SECNXT POINTS TO WORD YOU ARE GOING
					;TO UPDATE:
	HRRZ	TA,SECNXT		;GET POINTER

	MOVEM	EACB,(TA)		;SECTAB ENTRY FOR THIS SEG COMPLETED!
					;NOW SEE WHO IS LARGER,
	HLRZ	EACB,EACB		;EALTPC FOR THIS SEG?
	CAMLE	EACB,EALTMX		;OR BIGGEST SEEN TO DATE?
	HRRZM	EACB,EALTMX		;PRESENT ONE BECOMES CONTENDER.
	POPJ	PP,			;EVERTYTHING TAKEN CARE OF, RETURN.
					;ALTERS WERE BURPED OUT
CKEXIT:	SKIPGE	W2,EPPARA	;CLEAN UP PRESENT PARAGRAPH
				;FIRST: CHECK FOR PREVIOUS PARAGRAPH'S REQUIRING EXIT.
	PUSHJ	PP,SETUPP	;SET UP FOR GENERATING PARAGRAPH'S EXIT
	SKIPGE	W2,EPSECT	;SECOND: DO SAME FOR SECTION LAST SEEN
	PUSHJ	PP,SETUPS	;SET UP FOR GENERATING SECTION'S EXIT
	POPJ	PP,		;---------------> RETURN






SETUPP:	MOVEI	EACC,EPPARA	;SET POINTER TO INFORMATION ABOUT PREVIOUS PARAGRAPH
	JRST	EXITRP		;GO GENERATE THE EXIT


SETUPS:	MOVEI	EACC,EPSECT
	JRST	EXITRP
MAKXWD:	MOVE	CH,[XWD	AS.XWD,1]		;BUILD UP 1ST 3 WORDS OF AN XWD
	PUSHJ	PP,PUTAS1
	TRNE	EACC,40			;ARE ALL ALTERS IN THIS SEG?
	JRST	ADDBIT			;NOPE! <NOT ALL OF DESTINATIONS IN THIS SEG>.

	MOVEI	CH,0
	PUSHJ	PP,PUTAS1		;AND WRITE OUT THE LEFT HALF
	MOVE	CH,EACB			;ADDRESS FOR JRST @ ALTERED GO
					;GOES IN RIGHT HALF OF XWD
ENDXWD:	PUSHJ	PP,PUTAS1		;XWD & THERE IS 1 OF ME
					;LEFT HALD IS 0

	AOS	CH,EAS1PC
	MOVEI	CH,100000-1(CH)		;BUMP PPC FOR THE WHOLE WORD TO BE PUT OUT
					;RESTORE PPC COUNT TO PRIOR SETTING & GET F-G
					;TABLE INTO CH

	POPJ	PP,			;--------------- RETURN


ADDBIT:	MOVE	CH,EACB			;ADDRESS FOR THIS GUY GOES IN LEFT HALF
	PUSHJ	PP,PUTAS1
	CAMN	CH,EGOTO		;WHETHER IT'S EGOTO

	PUSHJ	PP,GOTOSG
	PUSHJ	PP,GETBIT		;PRIORITY BITS INTO RIGHT HALF
	JRST	ENDXWD			;FINISH UP THE OVLAY. XWD
SOLVER:	SKIPA	TA,-2(EACA)	;GET PROCEEDING LINK [NEXT EARLIER ONE ENTERED]
RESOLV:	MOVE	TA,(EACA)	;GET LINK AS POINTED TO BY EACA IN EOPTAB.
	TLNN	TA,EUNREZ	;IS THIS A FLOTAB ENTRY WHICH NEEDS TO BE RESOLVED
				;INTO A PROTAB ENTRY ?
	JRST	ITISOK		;IT'S OK, THAT IS, IT'S ALREADY A PROTAB ENTRY.
	ANDI	TA,77777		;GET JUST THE OFFSET BITS
	ADD	TA,FLOLOC	;ADD TO RELATIVE OFFSET, THE STARTING TABLE ADDRESS
				;HELD IN FLOLOC.
	HRRZ	TA,(TA)		;GET WHERE YOU ARE POINTED.
ITISOK:	MOVEI	TA,(TA)		;INSURE LEFT HALF OF TA CLEAR
	CAIL	TA,400001	;NOW THAT YOU HAVE RESOLVED ENTRY, IS IT
				;REALLY A PROTAB ENTRY /
				;BETWEEN 400001 AND 500000 IS IT ?
	CAIL	TA,500000
	POP	PP,TE
	POPJ	PP,		;THE POP IS THE ERROR CONDITION, WHICH
				;WILL THEN POPJ YOU TO CALLING ROUTINE.
OVLHDR:	MOVE	TA,[XWD XWDLIT,2];HEADER FOR XWD
	PUSHJ	PP,STASHP	;OUT ON FILE AS2, OR 3

	HLRZ	TA,CURPRO	;ADDRESS INTO LEFT HALF OF
				;THE XWD YOU ARE BUILDING.

	PUSHJ	PP,STASHQ
				;INTO THE RIGHT HALF OF XWD YOU ARE BUILDING:
	MOVEI	TA,ENREZE	;MASK FOR ALL BUT PRIORITY BITS
	ANDI	TA,(EACD)	;NOW THE PRIORITY BITS FOR   THE DESTINATION.
				; PRI BITS/ PRI BITS,AS.CNB
				;= WORD OUT
	LSH	TA,^D7		;MAKING ROOM FOR THE
	MOVEI	TC,(EACC)	;SAVE OLD EACC 1ST THOUGH!!!!
	ANDI	TC,ENREZE	;STRIP OFF ALL BUT PRITOITY BITS
	LSH	TC,-^D2		;SHIFTED
	TLO	TA,(TC)		;SOURCE PRIORITY BITS INTO TB, RIGHT[TEST] HALF.
	HRRI	TA,AS.CNB	;CONSTANT INCREMENT TYPE CODE

	PUSHJ	PP,POOLIT	;PUT OUT LAST WORD
	SKIPN	CH,PLITPC
	AOSA	CH,ELITPC	;BUMP PC
	TROA	CH,AS.LIT
	MOVEI	CH,AS.LIT-1(CH)	;ADD IN TYPE CODE & READJUST PPC COUNT TO LOOK
				;AT WORD JUST OUTPUT, NOT NEXT WORD.
	POPJ	PP,
GETBIT:	MOVEI	TA,-ECPFLG(CH)		;RESTORE LINK TO E NOTATION.

GTBIT1:	PUSHJ	PP,LNKSET
	HRRZ	CH,2(TA)		;GET PRIORITY BITS


	ANDI	CH,ENREZE
	LSH	CH,^D7			;POSITION SEG # BITS.
	MOVEI	TC,(EACC)		;SAVE OLD EACC!!
	ANDI	TC,ENREZE		;INSURE THAT NO MORE BITS THAN
					;THE PRIORITY BITS GET INTO XWD.
	LSH	TC,-^D2
	TLO	CH,(TC)			;SEG PRIORITY BITS IN LEFT
					;HALF, AS.CNB INTO RIGHT HALF.
	HRRI	CH,AS.CNB
	POPJ	PP,
	ENREZF=774B27		;THE NON-RESIDENT MASK USED
				;TO DISCERN A RESIDENT PROCEDURE NAME
				;[ENREZF = ALL 0] FROM A NON-RESIDENT ONE.
				;THE CODE KEY KEPT IN EPPARA AND EPSECT
				;IS SLIGHTLY DIFFERENT FROM THE FORMAT
				;AS IT IS STORED IN PROTAB...
				;THE PRIORITY # IS SHIFTED RIGHT 1.
				;... SEE PARGEN FOR FURTHER DESCRIPTION.

	ENREZE=774B26		;MASK FOR PRIORITY # [AS ABOVE] BUT SHIFTED 1
				;TO THE LEFT. PRIORITY # & FLAGS 
				;LINE UP WITH PROTAB ENTRY..

	EUNREZ=1B20		;UNRESOLVED 1ST PASS OPERAND FLAG

FLAGPP:	POINT 18,EPPARA,18	;ALL OF EPPARA'S FLAGS SHIFTED LEFT 1 BIT
				;SO THAT THEY ARE IN SYNC WITH FLAGS IN PROTAB.
FLAGPS:	POINT 18,EPSECT,18	;DITTO FOR SECTION FLAGS


EXTERNAL FPMODE,F2MODE,PTFLAG,CURPRO,EWORDB,LNKCOD,TM.TAG
EXTERNAL ALTLOC,ALTNXT,EALTMX,EALTPC
EXTERNAL EAS1PC,EAS2PC,EAS3PC,EZEROH,EZEROL
EXTERNAL LITLOC,LITNXT,SECNXT,FLOLOC,FLONXT
EXTERNAL OVLAY.
EXTERNAL MOVSI.,JRST.,MOVEI.,MOVEM.,EPJPP
EXTERNAL ELITPC,EPPARA,EPSECT,XWDLIT,AS.XWD,TB.PRO,HILOC,SEGFLG
EXTERNAL LITDEV,LITHDR,LITBLK
EXTERNAL AS.CNB,AS.GO,AS.MSC,AS.TAG,AS.LIT,AS.REL,AS.PRO
EXTERNAL TM.PRO

	END