Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 1247 on 6/3/83 at 5:10 PM by HOFFMAN                          
TITLE	XFRGEN FOR COBOL V13
SUBTTL	TRANSFER-OF-CONTROL GENERATORS		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
	%%P==:%%P
	IFN TOPS20,<SEARCH MONSYM,MACSYM>

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000
SALL

;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.

ENTRY XFRGEN
XFRGEN:

INTERNAL PARGEN,GOGOGN,SECGEN,ALTGEN,PERFGN,STOPGN,GODPGN,PRFYGN
INTERN	IPRFGN,EPRFGN
INTERNAL  EWARN, RESOLV, SOLVER
INTERNAL TAGGEN, JUMPTO, SEGBRK, SEGCLN
INTERNAL DECLST,DECLEN	;[435]

EXTERNAL DCLTAG		;[435]
EXTERNAL INDCLR
EXTERNAL BADEOP,FATAL,WARN,LNKSET
IFE TOPS20,<
EXTERN	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
EXTERN	PRODSW
EXTERN 	SETOPN, PUT.B, PUT.LA, GETTAG, PUTTAG, CONVNL
EXTERN 	MXAC., MACX., PUTAS1, PUTASY, PUTASN, OPNFAT


;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
>
	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
	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

	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

	MOVEI	CH,C.TRCE##
	PUSHJ	PP,PUT.PJ
	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTASN
	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
	PUSHJ	PP,PUTASN
	HRRZ	CH,0(EACC)
	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

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
	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

;GENERATES:
;	SKIPN	%PARAM+n
;	JRST	.+7
;	SOS	%PARAM+n
;	HLRZ	10,0(17)
;	CAME	10,LEVEL.##
;	PUSHJ	17,EXIT.E##
;	SOS	LEVEL.##
;	JRST	@TRAC2.##

	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

;GENERATES:
;	SOSL	%PARAM+n
;	SOS	LEVEL.##	;If in DECLARATIVES
;	POPJ	17,
;	AOS	%PARAM+n

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)	;LHS is guaranteed to be zero

	CAIL	TA,500000	;Is it pointing to TAGTAB ?
	CAIL	TA,600000
	TRNA			;No, its a normal PROTAB entry
	JRST	PERF3		;Yes, get real address, and cont.

	PUSHJ	PP,LNKSET	;Get  flags for
	HRRZ	EACB,PTFLAG(TA)	;  "B"
	MOVS	TA,OPERND	;GET
	MOVE	TA,1(TA)	;  FLAGS
	PUSHJ	PP,LNKSET	;  FOR
	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
;GENERATES
;	AOS	%PARAM+n
	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

;GENERATES:
;	PUSHJ	17,<paragraph-name>

	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.
PERF2A:	HRLI	CH,EPJPP
	JRST	PUTASY		;GENERATE PUSHJ 17,<PERFORM-PARA>
;Here for in-line PERFORM
;If not in quick mode generates
;	AOS	11,LEVEL.##
;	MOVS	11,11
;	HRRI	11,.+3
;	PUSH	17,11
;	JRST	%TAG
;If in quick mode generates
;	PUSHJ	PP,%TAG

PERF3:	MOVE	CH,TA
	SKIPE	QUIKSW		;/Q?
	JRST	PERF2A		;YES, PERFORM-PARA = TAG
	PUSH	PP,CH		;SAVE TAG FOR JRST %TAG
	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
	MOVE	CH,[HRRI.##+ASINC+AC11,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.DOT+3
	PUSHJ	PP,PUTASY	;GENERATE HRRI 11,.+3
	PUSHJ	PP,PUTASA##
	MOVE	CH,[PUSH.##+AC17,,11]
	PUSHJ	PP,PUTASY	;GENERATE PUSH 17,11
	PUSHJ	PP,PUTASA##
	POP	PP,CH		;GET TAG
	AOS	CH
	HRLI	CH,XJRST.
	JRST	PUTASY		;GENERATE JRST %TAG

;HERE FOR PERFORM  OF EITHER NOT /Q OR NOT ALL RESIDENT (OR BOTH)

;GENERATES
;	AOS	11,LEVEL.##
;	MOVS	11,11
;	HRRI	11,.+4
;	PUSH	17,11
;	MOVEI	10,<paragraph-name>+1
;	JRST	@TRAC3.##

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

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 IS A COMP-1 ITEM

BADFP:	MOVEI	DW,E.321
	JRST	OPNFAT

;IN-LINE PERFORM GENERATOR

IPRFGN:	SWOFF	FEOFF1		;TURN OFF MOST FLAGS
	TLO	W2,AS.TAG	;CONVERT TO TAG NUMBER
	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR
	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;ANY OPERANDS?
	JRST	IPRF10		;NO, SIMPLE CASE
	HRRZ	TC,EOPLOC	;GET ADDRESS OF FIRST OPERAND
	ADDI	TC,1
	MOVEM	TC,OPERND
	MOVEI	TE,-1(EACA)	;ALSO ADDRESS OF SECOND OPERAND
	CAIE	TC,0(TE)	;IS THERE ONLY ONE OPERAND?
	JRST	BADEOP		;NO--ERROR
	MOVE	TE,0(TC)	;GET FIRST WORD OF OPERAND
	TLNE	TE,GNLIT	;IS IT A LITERAL OR FIG. CONST.?
	JRST	IPRFG1		;YES
	LDB	TE,[POINT 3,1(TC),20]	;NO--DATA-NAME?
	CAIE	TE,TB.DAT
	JRST	BADEOP		;NO--TROUBLE

;Similar code to PRFYG1
IPRFG1:	MOVEM	TC,CUREOP
	MOVEI	LN,EBASEA	;SET UP PARAMETERS
	PUSHJ	PP,SETOPN
	HRRZ	TE,EMODEA	;IS ITEM A LITERAL
	CAIN	TE,LTMODE	
	JRST	IPRFG2		;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	IPRFG3		;YES

;"TIMES" COUNT IS A LITERAL

IPRFG2:	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	IPRFG4

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

IPRFG4:	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	IPRFG5		;NO--MUST HAVE BEEN A DATA NAME
	PUSHJ	PP,IPRF20	;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
	PUSHJ	PP,PUTASY
	JRST	IPRF30		;Output jump over in-line PERFORM

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

IPRFG5::	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,IPRF20	;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
	PUSHJ	PP,PUTTAG
	JRST	IPRF30

IPRF10:	PUSHJ	PP,IPRF20	;Generate PERFORM entry
	JRST	IPRF30		;Generate jump over in-line PERFORM

;Generate code for entry to in-line PERFORM
;Similar code to PERF6 - generates code as if /P were on

IPRF20:	SKIPN	QUIKSW		;/Q?
	JRST	IPRF21		;NO
	HLRZ	CH,W2
	HRLI	CH,EPJPP
	JRST	PUTASY		;GENERATE PUSHJ 17,<TAG%>

IPRF21:	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
	MOVE	CH,[HRRI.##+ASINC+AC11,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.DOT+3
	PUSHJ	PP,PUTASY	;GENERATE HRRI 11,.+3
	PUSHJ	PP,PUTASA##
	MOVE	CH,[PUSH.##+AC17,,11]
	PUSHJ	PP,PUTASY	;GENERATE PUSH 17,11
	PUSHJ	PP,PUTASA	;ALTERNATE SET
	HLRZ	CH,W2
	HRLI	CH,XJRST.
	HRRZ	TA,CH
	PUSHJ	PP,REFTAG##
	JRST	PUTASY		;GENERATE JRST <TAG%>

IPRF30:	PUSHJ	PP,PUTASA	;ALTERNATE SET
	HLRZ	CH,W2
	AOS	TA,CH
	PUSHJ	PP,REFTAG##
	HRLI	CH,XJRST.
	PUSHJ	PP,PUTASY	;GENERATE JRST <TAG+1%>
	HLRZ	CH,W2		;Get tag number
	JRST	PUTTAG		;Put out tag to start of in-line PERFORM

;END OF IN-LINE PERFORM
;Same as EXITRP

EPRFGN:	TLO	W2,AS.TAG	;CONVERT TO TAG NUMBER
	HRRZ	TA,EOPLOC	;THERE SHOULD BE NO OPERANDS
	HRRZ	EACA,EOPNXT
	CAIE	TA,(EACA)
	JRST	BADEOP		;NO--TROUBLE
	SKIPE	QUIKSW		;/Q?
	JRST	EPRFGQ		;YES
				;NO
;HERE FOR NORMAL EXIT

	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.

;HERE FOR QUICK EXIT

EPRFGQ:	MOVSI	CH,POPJ.##+AC17
	PUSHJ	PP,PUTASY
	HLRZ	CH,W2		;Get tag number
	AOJA	CH,PUTTAG	;Put out tag after in-line PERFORM

SUBTTL 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 < LITERAL>
				;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.
	TLNE	EACB,1B19	;IS THE LITERAL OR FIGURATIVE CONSTANT FLAG UP?
	JRST	STPGN1		;YES
	LDB	EACB,[POINT 3,(EACA),20]
	CAIE	EACB,TB.MNE##	;IS IT A SYMBOLIC-CHARACTER?
	JRST	EBLTFC		;NOPE! IT WASN'T, BAD SHOW, BAD OPERAND TYPE.
STPGN1:	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.

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.
	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
	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"
	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,[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.
				;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,[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

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
	JRST	BADEP4		;NO--ERROR

;VARIABLE FOUND

GODPG3:	MOVEM	EACA,EOPNXT

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

	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

	PUSH	PP,EDEBDA	;DON'T WANT DEBUGGING CODE ON MOVE
	SETZM	EDEBDA
	MOVEI	TE,3
	MOVEM	TE,EAC
	PUSHJ	PP,MXAC.
	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.

	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
IFE TOPS20,<
	OUT	LIT,TD		;WRITE OUT REST OF TABLE
	  JRST	EBRPL1		;OK
	MOVEI	CH,LITDEV	;ERROR--KILL
	JRST	DEVDED
>
IFN TOPS20,<
	DMOVEM	TD,IOWLIT##	;STORE IOWD
	PUSHJ	PP,RITLIT##	;OUTPUT IT
>

EBRPL1:
IFE TOPS20,<
	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
>
IFN TOPS20,<
	PUSHJ	PP,CLSLIT##	;CLOSE IT
	PUSHJ	PP,SETLIT##	;SET UP LITFIL TO READ BACK IN DUMP MODE
>

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

	PUSHJ	PP,EBRPL2	;[167] GO GET LITERAL FROM LITFIL

;WRITE LITAB ONTO ASYFIL (CONT'D)

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

EBRPL4:	SOSG	EWORDB		;[167] SEE IF MORE LITERAL IN CORE.
	PUSHJ	PP,EBMOR	;[167] NO READ IN MORE FROM LITFIL

EBRPLA:	HRRZ	TE,1(EACC)	;[167] 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		;[167] NOT ALL OF LITERAL IN CORE. IS THERE A MINIMAL AMOUNT?
	PUSHJ	PP,EBMOR	;[167] GET READ MORE


EBRPL6:	HLRZ	TE,1(EACC)	;[167] 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	;[167] SEE IF MORE IN CORE
	PUSHJ	PP,EBMORA	;[210] NO READ IN MORE
	MOVE	CH,2(EACC)	;WRITE OUT DATA WORD
	PUSHJ	PP,PUTASY
	ADDI	EACC,1		;BUMP LOCATION
	SOJG	EACB,EBRPL7	;LOOP UNTIL DONE
	AOJA	EACC,EBRPL4	;BUMP LOCATION AND LOOP

EBRPL9:	POP	PP,(PP)		;[167] POP OFF CALL TO EBMOR
	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

IFE TOPS20,<
;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
IFE TOPS20,<
	IN	LIT,TE		;READ SOME WORDS
	  JRST	EBRP1A		;OK
	MOVEI	CH,LITDEV	;ERROR--KILL
	POP	PP,(PP)		;[167] REMOVE CALL
	JRST	DEVDED
>
IFN TOPS20,<
	DMOVEM	TE,IOWLIT	;STORE IOWD
	PUSHJ	PP,GETLIT##	;READ IT
>

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	EWORDB		;[167] COUNT DOWN TWO WORDS
	SOSG	TE,EWORDB	;[167]  AND SEE IF ANY LITERALS IN CORE
	PUSHJ	PP,EBMORB	;[210] TABLE EMPTY READ IN MORE
	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

	ADDI	EACC,2		;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	EWORDB		;[167] COUNT DOWN TWO WORDS
	SOSG	TE,EWORDB	;[167]  AND SEE IF ANY LITERALS IN CORE
	PUSHJ	PP,EBMORB	;[210] TABLE EMPTY READ IN MORE
	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
	ADDI	EACC,2		;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?
IFN TOPS20,<
	SKIPE	SEGFLG		;YES, FIRST TIME?
	JRST	EBURPX		;NO
>
	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.
	LDB	TE,FL.TAG##
	HRRZ	TA,(TA)		;GET WHERE YOU ARE POINTED.
	JUMPN	TE,CPOPJ	;If its a TAGTAB entry, exit
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 LITBLK
EXTERNAL AS.CNB,AS.GO,AS.MSC,AS.TAG,AS.LIT,AS.REL,AS.PRO
EXTERNAL TM.PRO
IFN TOPS20,<
EXTERNAL LITDEV,LITHDR
>

	END