Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/cobold.mac
There are 14 other files named cobold.mac in the archive. Click here to see a list.
; UPD ID= 1612 on 5/17/84 at 9:52 AM by HOFFMAN                         
TITLE	COBOLD	FOR COBOL V13	
SUBTTL	PROCEDURE DIV. SYNTAX SCAN	W.NEELY/CAM/SEB/MEM

	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, 1985 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P

	%%P==:%%P
	TOPS20==:TOPS20
	IFN TOPS20,< SEARCH MACSYM,MONSYM>
	IFE TOPS20,< SEARCH MACTEN,UUOSYM>
	DBMS==:DBMS
	DBMS6==:DBMS6
	DEBUG==:DEBUG
	MCS==:MCS

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
SALL
RELOC	400000
;EDITS
;NAME	DATE		COMMENTS

;V13*****************
;MEM	4-NOV-85	[1635] Stop putting out an extra start expression 
;				operator for IF FOO(1:2) EQUALS BAR(1:2)
;MEM	16-OCT-86	[1631] Add error recovery for when we have dummy datab
;				 entry
;MJC	15-JUL-85	[1602] Fix NEXT SENTENCE broken by edit 1541
;MJC	21-JUN-85	[1600] Implement INITIALIZE for tables
;MJC	 4-APR-85	[1573] Fix edit 1556. Make a PCA7BA that is PCA7B
;				with out the FPERWD
;MJC	26-MAR-85	[1566] Zero INPTAG when done with it in pa199.
;JEH	22-MAR-85	[1564] Fix 'set condition-name' code.
;KWS	21-MAR-85	[1563] Make sure that the report writer check
;;				the NO REWIND bit also.
;JEH	20-MAR-85	[1562] In the ref. mod. routines, if current
;;				operator is zero, check 'implop' field 
;;				that 'IF' uses for storing op codes.
;JEH	20-MAR-85	[1561] If reference modification is being done
;;				within the scope of an IF statement then 
;;				save the open parenthesis count and
;;				restore it when the modifications are done.
;MJC	22-JAN-85	[1556] Remove code that allowed SEARCH ... WHEN to
;;				ignore extraneous periods.
;MJC	30-NOV-84	[1553] Rework PA823. to do END-XXX scope termination
;;				by popping from the node stack
;MJC	10-AUG-84	[1541] Make IF-END and ELSE define tags without using
;;				NXTSEN.
;JEH	16-MAY-84	[1535] If error w/ ref. mod. expression, put out
;;				expected op code, but with error bit set
;JEH	14-MAY-84	[1527] Skip warning test if 'GENERATE data-name'
;;				instead of 'GENERATE report-name'
;JEH	26-APR-84	[1522] Let expression scanner handle errors with
;				reference modifiers
;JEH	14-FEB-84	[1514] Shut off AMRGN. flag while comparing PRVTOK
;V12B****************
;JEH	02-MAY-83	[1466] Give error on WRITE ADV/POS if not ASCII file
;DMN	28-Apr-83	[1465] Fix edit 1354 to use DKEYSZ rather than KEYRLN.
;RLF	19-APR-83	[1460] Give error message when key is subcripted.
;SMI	 8-Dec-82	[1443] Test for no decimal places in COMP field.
;DMN	 9-Nov-82	[1431] Fix bug caused by edits 1046 and 1104 to DBMS FIND with INDEX item.
;JEH	 7-May-82	[1354] Wrong alternate key selected if multiple keys are
;				defined with the same starting location.
;RLF	 1-OCT-82       [1412] Make RETAIN do RETAIN NEXT so LSU works
;                               for ISAM Sequential access
;DMN	 5-Mar-82	[1343] 68274 converter does not convert NOTE into a comment.
;DMN	15-Feb-82	[1340] 68274 converter does not flag NOT Abbrev. Combined Relation Conditions.
;RJD	29-Jan-82	[1334] Supersedes edits 1322 and 1326.
;WTK	18-Dec-81	[1326] Fix edit 1322 breaking of CREF listings.
;WTK	 8-Oct-81	[1322] Check last paragraph for ending in unconditional goto.
;JSM	 3-Aug-81	[1313] Check for IF <cond> paragraph-name.
;JSM	24-Jun-81	[1311] Bad placement of diag. 179 in listing.

;V12B****************
;DAW	6-Feb-81	[1117] Make fig. constants work correctly when
;			"UNSTRING delimited by fig-const."
;JSM	21-Jan-81	[1114] Fix edit 1035 to bypass SUB-SCHEMA error message if no INVOKE seen.
;CLRH	17-Dec-80	[1104] More of edit 1046, patch to edit 675.
;DAW	 5-Nov-80	[1070] Fix MOVE CORRESPONDING when items are subscripted.
;JSM	24-Oct-80	[1062] Fix fatal error on NOTE with COPY REPLACING.
;DAW	25-AUG-80	[1050] BAD CODE GEN FOR NESTED IF..I-O VERB..IF..
;CLRH	12-AUG-80	[1046] IN FIND RSE3, IDENTIFIER-2 MUST BE 1-WORD COMP.
;CLRH	10-JUL-80	[1035] FIX DBMS "IF" TO CHECK THAT USERNAME IS IN SUBSCHEMA
;DMN	 2-JUL-80	[1033] TURN OFF COPY REPLACING FLAGS DURING ERROR RECOVERY.
;CLRH	18-JUN-80	[1026] MOVE CURRENCY STATUS FOR RECORD REQUIRES RECORD.
;JSM	2-APR-80	[1005] MAKE IF OR SEARCH ILLEGAL IN WHEN CLAUSE OF SEARCH VERB
;LEM	22-FEB-80	[772] MAKE DA.CLA EXTERNAL
;DAW	31-JAN-80	[765] FIX "NULL TABLE LINK" IF UNSTRING ITEM HAS
;				MORE THAN ONE SUBSCRIPT.
;DAW/CLRH 9-JAN-80	[757] DON'T ALLOW OPEN OF A SORT FILE
;DAW			[744] FIX EDITS 707/670
;V12*****************
;DAW	 7-MAY-79	[707] FIX EDIT 670 - IT BROKE NESTED IF'S.
;DMN	 4-APR-79	[675] CHECK FIND RSE 3 SYNTAX THAT COULD LOOK LIKE FIND RSE 5
;JSM	28-MAR-79	[670] FIX NESTED IF . ELSE PROBLEM
;DMN	20-MAR-79	[665] RECOVER CORRECTLY FROM PROCEDURE DIVISION MIS-SPELLED
;DAW	28-FEB-79	[645] FIX ERROR RECOVERY IN SORT STATEMENT; ALSO
;;; ADD RESTRICTION TO "MERGE" STATEMENT TO NOT ALLOW SUBSCRIPTING
;DMN	28-JAN-79	[631] DON'T USE ARG2 AT PA258. THUS PREVENTING CATASTROPHE IN PHASE D
;DMN	12-DEC-78	[612] INITIALIZE FNOSUB AT THE START OF PHASE D (THIS WAS IN THE BWR FILE)
;DAW	11-OCT-78	[574] DON'T SET BIT 1 FOR USER-NAME EXTERNAL ENTRY (BIT WENT AWAY)
;EHM	17-SEP-78	[552] GIVE ERROR IF DECLAR. & NO END DECLARITIVES
;EHM	04-MAY-78	[535] FIX EDIT [273] FOR IF SET NOT EMPTY
;EHM	29-MAR-78	[532] FIX [511] TO PROCESS ERRORS CORRECTLY

;V11*****************
;SSC	28-SEPT-77	ADDED ACTIONS TO SUPPORT DBMS-V6 ENHANCEMENTS (AFTER PA321.)
;EHM	19-SEP-77	[511] MAKE NESTED SEARCH STATMENTS WORK
;VR	19-APR-77	[467] SET LN, CP AND RIGHT DIAG. MESSAGE FOR
;			STATEMENT: GO TO -(NUMBER)
;EHM	28-JAN-77	[461] FIX TALLY FOR RECORD-NAME IN WRITE CAUSES CRASH
;EHM	17-JAN-77	[460] FIX THIS STATEMENT CANNOT BE REACHED AFTER SEARCH ALL
;VR	17-DEC-76	[455] FLAG SORT KEYS NOT DEFINED IN SD STATEMENT AS FATAL ERROR
;SSC	 2-AUG-76	      ADD DBMS S. U. ACTIONS
;	 8-AUG-76	[435] FIX DECLARITIVES IN DBMS PROG SO THAT DBMS SECTION GOES AROUND IT
;	 6-APR-76	[420] FIX FOR MISSING PERIOD ON OPEN STATEMENT
;	24-MAR-76	[413] FIX SEARCH MIXED WITH IF
;	30-JAN-76	[405] FIX QUALIFICATION OF SUBSCRIPTS
;GPS	MAR-12-75	ADDED CODE TO COMPUTE LENGTH OF SU TABLES
;DBT	MAR-7-75	REMOVE CANCEL ERROR MESSAGE WHICH CREPT BACK IN
;SSC	MAR-5-75	PLACED 6A EDIT %316 DIRECTLY INTO V10
;GPS	12/23/74	ADD SIMULTANEOUS UPDATE
;DBT	12/1/74		CHANGE DA96. TO DA96.D TO AVOID ONESEG PROBLEM
;********************

; EDIT 363 FIX RECOVERY IF TOO MANY LEVELS OF SUBSCRIPTING.
; EDIT 362 RECOVER FROM ERROR IN SEARCH STATEMENT.
; EDIT 353 FIX DBMS IF STATEMENT WITH UNDEFINED VARIABLE TO FLAG CORRECT PLACE.
; EDIT 336 FIX FIND5 FROM GENERATING BAD ARG BLOCK FOR RECORD NAMES
;		LONGER THAN 12 CHARS WHEN OPTIONAL WORD 'RECORD' NOT USED
; EDIT 333 ALLOW TALLY AS A SUBSCRIPT TO BE ADDED TO SUBTRACTED FROM
; EDIT 327 PUT IN GENERATED AFTER DECLARATIVES.
; EDIT 324 SET DECLARATIVE SWITCH IF PROGRAM HAS DECLARATIVES.
; EDIT 314 FIX RECOVERY IN A COMPUTE STATEMENT HAVING AN UNDEFINED VARIBLE.
; EDIT 313 DBMS- FIX IF STATEMENT ERROR MESSSAGE OHAVING UNDEFINED VARIABLE IN WORD FOLLOWING THE "IF ".
; EDIT 312 FIXSTATEMENTS FOLLOWING A GO TO PARAGRAPH.
; EDIT 307 FIX CANCEL
; EDIT 276 CHECK FOR RECORD NAME FOR WRITE, DELETE, REWRITE AND RELASE VERBS
; EDIT 273 DBMS FIX. ROUNED UP FOR ASCII WORD SIZE IS WRONG
; EDIT 271  FIX CATASTROPHE IN PHASE D IF NO PARA NAME IMMEDIATELY  AFTER SECTION NAME
; EDIT 265 ALLOW FIG CONSTANT "ZERO" FOR PERFORM LITERALS
; EDIT 262 FIXES HANLDING OF UNDEFINED SUBSCRIPT
; EDIT 261 FIXES CHECKING OF NAMTAB TABLE WHEN ITS END IS REACHED [261]
; EDIT FIX RELEASE AND RETURN SO THAT PARMS ARE ONLY IN SORT FILE [257]
; EDIT 250 ALLOW TALLY TO BE A SUBSCRIPT 
; EDIT 246 FIX MULTIPLE CALL "SUB".
; EDIT 244 FLAGS AS ERROR AN ELSE FOLLWING A PERIOD.
; EDIT 242 ALLOWS SUBCRIPTING FOR ITEMS WITH FILE NAME QUALIFIERS.
; EDIT 240 FIXES QUALIFICATION PROBLEM OF DATA NAMES USUALLY IN SEARCHES
; EDIT 222 /ACK FIX NULL TABLE LINK PROBLEM FOR CORRESPONDING OPTION
;		  AND FOR PERFORM VARYING'S.
; EDIT 214 CHANGE FATAL TO WARNING IF MORE THAN 6 CHARS IN SUBPROGRAM NAME
; EDIT 172 FIXES EDIT 151 UNBALL PAREN CHECK DONE TOO SOON (AT SUB EXPRESSION LEVEL).
; EDIT 171 MAKES ENTER COBOL EQUIVALENT TO CALL.
; EDIT 137 GIVE ERROR MESSAGE IF SUBSCRIPT IS IN LINKAGE
;	   SECTION OR IF SUBSCRIPT IS SUBSCRIPTED.
; EDIT 165 FIXES COMPILER LOOP IF RIGHT PAREN MISSING FOR SUBSCRIPTED DATA-NAME.
; EDIT 155 FIXES "ADDRESS CHECK..." WHEN SORT FILE SHARES SAME BUFFER AREA
; EDIT 151 FIXES UNBALL PARENTHESIS PROBLEM IN COMPUTE STATEMENT
; 	EDIT 111 FIXES COMPILER LOOP FOR SEARCH ALL.. AT END STOP RUN-- STATEMENT
; EDIT 110 OPEN STATEMENT DOES NOT GIVE PERIOD ASSUMED MESSAGE IF A
;	   PERIOD IS MISSING AND STATEMENT IS LAST ONE IN A PARA.
ENTRY	COBOLD


	INTERN	PASU8.,PASU9.,PASU6.,PASU66,PASU60,PASU61
	INTERN	PASU64,PASU63,PASU62,PASU4.,PASU7.,PASU41
	INTERN	PASU45,PASU40,PASU44,PASU42,PASU5.,PASU2.
	INTERN	PASU21,PASU20,PASU3.,PASU39,PASU38,PASU36
	INTERN	PASU34,PASU31,PASU37,PASU35,PASU30,PASU33
	INTERN	PASU1.,PASU19,PASU18,PASU17,PASU14,PASU10
	INTERN	PASU16,PASU12,PASU15,PASU13,PASU11

	EXTERN	FI.ORG, FI.RTC, FI.SKY,FI.ERR,FI.NXT
	EXTERN	FILLOC,FILNXT,CURFIL,LNKSET
	EXTERN	DA.USG,DA.INS,DA.LOC,DA.RES
	EXTERN	KILL
	EXTERN	FI.FAM,USELOC
	EXTERN	AK.DLK,AK.FLK
	EXTERN	DTREE
	EXTERN	SURRTM,SURRT.,SUEQTM,SUEQT.,SUFBTM,SUFBT.
	EXTERN	BUFFER,BUFCTR,CPOPJ,CPOPJ1
	EXTERN	PASU4T,SU30F1,SU30F2,SU30FG,SU8CNT,SU8FLG
	EXTERN	SU8SVA,SU8SVB,SU8SVC
	EXTERN	DWLNCP,WORDLN,WORDCP
	EXTERN	INUPRG

COBOLD:	SETFAZ	D;
	MOVE	NODPTR,INDPTR##
IFN DEBUG,<
	MOVE	TE,CORESW##
	SWOFF	FNDTRC;
	TRNE	TE,TRACEP	;TRACE PD NODES?
	SWON	FNDTRC;		;YES
	>
	SETZM	PROGST##	;CLR FIRST PARA ADDR
	SETZM	DECLR.##	; [324] CLR DECLARITIVES IN PROG SWTICH
	SETZM	MAXDBC##	;CLEAR MAX. DEBUG-CONTENT SIZE
	SETZM	SPFNIO##	;Clear "Special-IF" flag
	HRRZI	TA,STRTD.##	;FIRST PD NODE
	PUSH	NODPTR,TA
	PUSHJ	PP,SQURL.##	;BEGIN
	OUTSTR	[ASCIZ "COBOLD--lost; too many POPJ's
"]
	JRST	KILL
SUBTTL	PROCEDURE DIVISION ACTIONS

	INTER.	PA0.
PA0.:	POP	NODPTR,NODE	;POP UP CURRENT NODE
IFN DEBUG,<PUSHJ PP,PTPOP.##>	;IF TRACING, LIST NODE POPING UP TO
	POPJ	PP,

;ADVANCE TO NEXT WORD
;SAME AS IA0.G IN COBOLB - KEEP SEPARATE TO AID LOCALITY

	INTER.	PA0.G
PA0.G:	SWOFF	FREGWD		;CLR REGET WORD FLAG
	PJRST	GETITM		;GET NEXT ITEM
	INTER.	PA1.
PA1.:	MOVE	SAVPTR,ISVPTR##	;INITIALIZE PD POINTER
	SWOFF	FNOTF!UNCONT!INDECL!FARITH!FEXPR!FNOSUB	;[612]
	SETZM	OPRTR##
	MOVE	TA,[OPRTR,,OPRTR+1]
;	BLT	TA,ARG3##+1
;	SETZM	NSBSC1##
;	MOVE	TA,[XWD NSBSC1,SBSCR1]
	BLT	TA,SBSCR3##+4*MAXSUB-1
	SETZM	CURSEC
	SETZM	LSTPRI##
	SETZM	PRIOR##
	SETZM	IFLVL##
	SETZM	SPFLVL##
	SETZM	NQUAL##
	SETZM	ELEVEL##
	SETZM	CLEVEL##
	SETZM	TOPLVL##
	SETZM	NXTSNT##
	SETZM	IMPLOP##
	SETZM	IMPLOP+1
	SETZM	SCPTRM##	;[1553] END-XXX SCOPE TERMINATOR
	SETZM	INPTAG##	;[1566] ZERO THE IN-LINE PERORM TAG
	SETZM	INIDAT##	;[1600] Initialize DATTAB pointer
	SETZM	INIVAL##	;[1600] Initialize VALTAB pointer
	SETZM	TBLOCK
	MOVE	TA,[XWD TBLOCK,TBLOCK+1]
IFL MAXSUB-6,<
	BLT	TA,TBLOCK+24
>
IFGE MAXSUB-6,<
	BLT	TA,TBLOCK+MAXSUB*4
>
	SETZM	VARBLK##
	MOVE	TA,[XWD VARBLK,VARBLK+1]
	BLT	TA,VARLST##		;ZERO ALL VARBLK
	HRRZ	TA,SECLOC##
	SETZM	1(TA)
	HRLZI	TB,1(TA)
	HRRI	TB,2(TA)
	BLT	TB,^D200(TA)
	SETZM	USES##
	MOVE	TA,[XWD USES,USES+1]
	BLT	TA,USES+USES.L##-1
;28-OCT-80 /DAW: This shrinking of VALTAB to save space used to
;be possible until version 12B, when subscript parsing was implemented
;in PHASE C.  PHASE E must be able to look at constant subscript values
;stored in VALTAB in PHASE C.
;	MOVE	TA,VALLOC##
;	MOVEM	TA,VALNXT##
	SETZM	1(TA)
	SETZM	ARGLST##
	MOVE	TA,[XWD	ARGLST,ARGL2##]
	BLT	TA,ARGL2+13
	JRST	PA219.
;HERE ON USE PROCEDURES TO TEST FOR FIPS FLAGGER
;PA2U.1 ON FIRST FILE NAME, PA2U.2 ON SUBSEQUENT ONES

	INTER.	PA2U.1
PA2U.1:	PUSHJ	PP,PA2.
	SKIPN	FLGSW		;WANT FIPS FLAGGER?
	POPJ	PP,		;NO
	MOVE	TA,ARG1
	ADD	TA,FILLOC
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
	MOVE	TA,[%LV.L		;SEQUENTIAL
		%LV.LI			;RELATIVE
		%LV.H			;INDEXED
		0](TB)
	PJRST	FLG.ER##	;FLAG IF ILLEGAL

	INTER.	PA2U.2
PA2U.2:	PUSHJ	PP,PA2.
	SKIPN	FLGSW		;WANT FIPS FLAGGER?
	POPJ	PP,		;NO
	MOVE	TA,ARG1
	ADD	TA,FILLOC
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
	MOVE	TA,[%LV.HI		;SEQUENTIAL
		%LV.HI			;RELATIVE
		%LV.H			;INDEXED
		%LV.HI](TB)
	PJRST	FLG.ER##	;FLAG IF ILLEGAL

	INTER.	PA2.8
PA2.8:	FLAGAT	8
	JRST	PA2.

;FLAG THE NOT BEFORE A CONDITIONAL

	INTER.	PA2.NT
PA2.NT:	PUSHJ	PP,TSTNOT	;SEE IF WE SHOULD FLAG PREVIOUS NOT
	SKPNAM

	INTER.	PA2.HI
PA2.HI:	FLAGAT	HI
	SKPNAM

	INTER.	PA2.
PA2.:	TLNE	W1,GWLIT	;IS ITEM A LITERAL?
	JRST	PA2.L		;YES
	TLZN	W1,GWNOT	;IS ITEM IN NAMTAB?
	JRST	PA2.R		;YES
	PUSHJ	PP,BLDNAM##	;NO--PUT IT IN
	HLRS	TA
	DPB	TA,[POINT	15,W2,15]
PA2.R:	TLZ	W1,004000	;'ROUNDED' BIT
	DMOVEM	W1,ARG1##	;SAVE ITEM
	POPJ	PP,

PA2.L:		LDB	TB,GWVAL	;NO. OF CHARACTERS
	JUMPN	TB,PA2.L1	;NULL LITERAL?
	EWARNW	E.183		;YES
	MOVE	TA,[BYTE (7)7,7,7]
	MOVEM	TA,LITVAL##	;CREATE A DUMMY
	HRRZI	TB,3
PA2.L1:	MOVEM	TB,TBLOCK##	;SAVE SIZE
	ADDI	TB,2+4		;COUNT PLUS ROUNDING
	IDIVI	TB,5		;NO. OF WORDS REQUIRED
	HRRZI	TA,(TB)
	HRLI	TA,CD.VAL	;VALTAB CODE
	PUSHJ	PP,GETENT##	;GET VALTAB ENTRY
	HLR	W1,TA		;UPDATE ITEM
	HRRZ	TD,TBLOCK	;COUNTER
	DPB	TD,[POINT 14,(TA),13]	;STORE COUNT
	MOVE	TB,[POINT 7,LITVAL]	;'GET' POINTER
	MOVSI	TC,(POINT 7,0(TA),13)	;'PUT' POINTER
PA2.Q:	SOJL	TD,PA2.R
	ILDB	TE,TB		;GET CHARACTER
	IDPB	TE,TC		;SAVE
	JRST	PA2.Q

TSTNOT:	SKIPN	FLGSW		;DO WE WANT FIPS FLAGGER?
	POPJ	PP,		;NO
	EXCH	LN,NOTLN##	;SWAP CURRENT POINTERS
	EXCH	CP,NOTCP##
	MOVEI	TA,%LV.HI	;FLAG AS IN NUC 2
	PUSHJ	PP,FLG.ES##
	EXCH	LN,NOTLN
	EXCH	CP,NOTCP
	POPJ	PP,
	INTER.	PA3.
PA3.:	TSWTZ	UNCONT;
	JRST	PA3.A
	HLRZ	TA,CURPAR##
	JUMPE	TA,PA3.A
	PUSHJ	PP,LNKSET
	SETO	TB,
	DPB	TB,PR.TUT##
	HLRZ	TA,CURSEC##
	JUMPE	TA,PA3.A
	PUSHJ	PP,LNKSET
	SETO	TB,
	DPB	TB,PR.TUT
PA3.A:	MOVE	TA,ARG1+1
	SETZM	OPRTR
	DPB	TA,OP.LNC##	;LN, CP
	HRRZI	TA,100		;OP CODE FOR SECTION OPERATOR
	PUSHJ	PP,SETOP3
	LDB	TA,[POINT 15,ARG1+1,15]
	HRRZI	TB,CD.PRO	;PROTAB CODE
	PUSHJ	PP,FNDLNK##	;LOOK FOR PROTAB LINK
	  JRST	PA3.P		;NONE FOUND
PA3.L:	LDB	TC,PR.SEC##	;PARAGRAPH/SECTION FLAG FROM PROTAB
	JUMPE	TC,PA3.E	;DUPLICATE SECTION NAME
	PUSHJ	PP,FNDNXT##	;NO--TRY AGAIN
	  JRST	PA3.P		;NO MORE
	JRST	PA3.L		;TEST THIS ENTRY

PA3.P:	TLO	W2,GWDEF	;PUT DEFINING REFERENCE IN CREF FILE
	LDB	TA,[POINT 20,ARG1+1,35]	;USE LN&CP FOR THE NAME --
	DPB	TA,[POINT 20,W2,35]	;  NOT THE PERIOD AFTER IT
	MOVE	TA,[NAMWRD,,NAMWRD+1]	;MOVE SECTION NAME BACK TO NAMWRD
	SETZM	NAMWRD##
	BLT	TA,NAMWRD+4
	LDB	TA,[POINT 15,ARG1+1,15]
	HRRZ	TB,NAMLOC##
	ADDI	TA,1(TB)
	HRLI	TA,(POINT 6,0)
	MOVE	TB,[POINT 6,NAMWRD]
PA3.X:	HRRZ	TC,.JBREL##	;SEE IF LAST ENTRY ENDED ON A K BOUNDARY
	CAIG	TC,(TA)		;IF SO, THATS THE END OF NAMTAB
	JRST	PA3.Y		;YES
	ILDB	TC,TA
	TRNN	TC,60		;FINISHED YET?
	JRST	PA3.Y		;YES
	IDPB	TC,TB
	JRST	PA3.X
PA3.Y:	PUSHJ	PP,PUTCRF##	;INDICATE THAT SECT-NAME IS HERE DEFINED
	MOVE	TA,[XWD CD.PRO,SZ.PRO]
	PUSHJ	PP,GETENT	;GET AN ENTRY IN PROTAB
	PUSHJ	PP,PA4SUB	;STORE PTR TO PROTAB ENTRY
	MOVE	TC,LSTPRI	;PRIORITY OF LAST SECTION
	MOVE	TD,PRIOR	;PRIORITY OF NEW SECTION
	CAMGE	TC,SEGLIM##	;LAST SECTION NON-RESIDENT?
	CAML	TD,SEGLIM	;NO --- IS NEW ONE?
	CAIN	TC,(TD)		;ONE OR BOTH NON-RESIDENT
	JRST	PA3.P1		;BOTH RESIDENT OR IN SAME SEGMENT
	MOVE	TE,ARG1
	MOVEM	TE,TBLOCK+21
	MOVE	TE,ARG1+1
	MOVEM	TE,TBLOCK+22	;SAVE ARG1
	MOVE	TE,OPRTR
	MOVEM	TE,TBLOCK+23
	MOVE	TE,OPRTR+1
	MOVEM	TE,TBLOCK+24	;AND OPERATOR
	MOVEM	TA,TBLOCK+20	;PROTAB POINTER FOR NEW SECTION
	SETZM	OPRTR
	SETZM	OPRTR+1
	SKIPN	TA,CURSEC
	JRST	PA3.P0
	LDB	TB,PR.TUT	;IF SECTION ENDED WITH UNCONDITIONAL
	JUMPN	TB,PA3.P0	;TRANSFER, SPECIAL GO NOT NEEDED
	PUSHJ	PP,PA25.	;CREATE 'GO TO' OPERATOR
	HLRZ	TA,TBLOCK+20	;NEW SECTION PROTAB POINTER
	HRRZM	TA,ARG1		;PUT IN OPERAND
	SETO	TB,
	DPB	TB,OP.CLN##	;SET SPECIAL FLAG SO THAT EXITS WILL
				;BE GENERATED BEFORE THIS GO
	PUSHJ	PP,PA21.	;OUTPUT OPERAND
	PUSHJ	PP,PA22.	;AND OPERATOR
PA3.P0:	MOVSI	TA,104000
	DPB	W2,[POINT	20,TA,35]
	HRRZI	TB,104		;SEGMENT BREAK OPERATOR
	PUSHJ	PP,PUTGEN
	MOVE	TE,TBLOCK+21
	MOVEM	TE,ARG1
	MOVE	TE,TBLOCK+22
	MOVEM	TE,ARG1+1
	MOVE	TE,TBLOCK+23
	MOVEM	TE,OPRTR
	MOVE	TE,TBLOCK+24
	MOVEM	TE,OPRTR+1
	MOVE	TA,TBLOCK+20
PA3.P1:	MOVEM	TA,CURSEC	;CURRENT SECTION
	SETZM	CURPAR		;NO CURRENT PARAGRAPH YET
	HRRZ	TE,SECLOC
	HRRZI	TE,1(TE)
	HRLI	TE,TD
	MOVEM	TE,PNTR
	MOVE	TD,PRIOR
	CAMGE	TD,SEGLIM	;IS CURRENT SECTION RESIDENT?
	SETZ	TD,		;YES
	ASH	TD,1		;PRIORITY*2
	SKIPE	TA,@PNTR##
	JRST	PA3.P2		;THIS SEGMENT WAS SEEN BEFORE
	HLLZ	TA,CURSEC
	HLRS	TA		;PROTAB POINTER FOR CURRENT SECTION
	MOVEM	TA,@PNTR	;SET UP AS BOTH FIRST AND LAST SECTION OF
				;THIS PRIORITY
	MOVE	TB,GENWRD##
	HRRZI	TD,1(TD)
	MOVEM	TB,@PNTR	;INITIAL BLOCK OF THIS PRIORITY
	MOVE	TA,CURSEC
	JRST	PA3.Q
PA3.P2:	MOVEM	TD,TBLOCK+15
	PUSHJ	PP,LNKSET
	MOVE	TB,GENWRD
	DPB	TB,PR.GNW##
	HLRZ	TB,CURSEC
	MOVE	TD,TBLOCK+15
	HRRM	TB,@PNTR
	MOVE	TA,CURSEC
PA3.Q:	HLRZM	TA,ARG1		;SET UP OPERAND TABLE LINK
	LDB	TB,[POINT 15,ARG1+1,15]
	IORI	TB,CD.PRO*1B20	;TABLE TYPE CODE
	MOVSM	TB,(TA)
	SETO	TB,
	DPB	TB,PR.DEF##	;SET DEFINED BIT
	TSWF	INDECL;
	DPB	TB,PR.DFD##	;DEFINED IN DECLARATIVES
	HRRZ	TC,PRIOR
	DPB	TC,PR.PRI##	;PRIORITY
	HLRZ	TB,(TA)		;NAMTAB REL. ADDR.
	ANDI	TB,077777
	HRRI	TA,(TB)
	MOVEM	TA,TBLOCK	;SAVE PUTLNK PARAMETER
	PUSHJ	PP,PUTLNK##	;PUT ENTRY IN CHAIN
	MOVE	TA,[XWD	CD.FLO,SZ.FLO]
	PUSHJ	PP,GETENT
	SETO	TB,
	DPB	TB,FL.PND##	;PROCEDURE-NAME DEFINITION FLAG IN FLOTAB
	TSWF	INDECL;
	DPB	TB,FL.RDC##	;REFERENCED IN DECLARATIVES
	HLRZ	TB,TBLOCK	;PROTAB ENTRY REL. ADDR.
	DPB	TB,FL.PRO##	;PUT PROTAB LINK IN FLOTAB
	DPB	W2,FL.LNC##	;PUT NAMTAB POINTER, LN, CP IN FLOTAB
	MOVEM	TA,CURFLO##
	HLRZ	TA,TBLOCK
	PUSHJ	PP,LNKSET##	;GET ADDRESS OF PROTAB ENTRY
	HLRZ	TB,CURFLO
	DPB	TB,PR.FLO##	;LINK PROTAB TO FLOTAB
	LDB	TB,PR.DFD	;IF DEFINED IN DECLARATIVE SECTION
	JUMPN	TB,CPOPJ	;DON'T SET DEBUGGING LINK
	LDB	TB,PR.SEC	
	JUMPN	TB,CPOPJ	;ONLY DEBUG PROCEDURES
	SKIPE	TB,DEBALP	;DEBUGGING ALL PROCEDURES?
	DPB	TB,PR.DEB##	;YES, SET LINK
	POPJ	PP,

PA3.E:	SETO	TC,
	DPB	TC,PR.MDF##	;MULTIPLY DEFINED
	EWARNW	E.171
	JRST	PA3.P
	INTER.	PA4.
PA4.:	TSWTZ	UNCONT;
	JRST	PA4.B
	HLRZ	TA,CURPAR
	JUMPE	TA,PA4.B
	PUSHJ	PP,LNKSET
	SETO	TB,
	DPB	TB,PR.TUT
PA4.B:	LDB	TA,[POINT 15,ARG1+1,15]
	HRRZI	TB,CD.PRO
	PUSHJ	PP,FNDLNK
	  JRST	PA4.P		;NONE FOUND
PA4.L:	LDB	TD,PR.LSC##	;SECTION LINK
	LDB	TC,PR.SEC	;PARAGRAPH/SECTION FLAG
	JUMPE	TC,PA4.C	;THIS IS A SECTION
	HLRZ	TC,CURSEC	;PARAGRAPH
	CAIN	TC,(TD)		;IN CURRENT SECTION?
	JRST	PA4.E		;YES--ERROR
PA4.A:	PUSHJ	PP,FNDNXT	;MORE PROTAB ENTRIES FOR THIS NAME?
	  JRST	PA4.P		;NO
	JRST	PA4.L

PA4.C:	HRRZ	TC,CURSEC	;CHECK TO SEE WHETHER
	HLRZ	TC,(TC)		;CURRENT SECTION HAS THE
	HLRZ	TB,(TA)		;SAME NAME AS THIS PARAGRAPH
	ANDI	TB,077777	;NAMTAB POINTER OF THIS ENTRY
	ANDI	TC,077777	;NAMTAB POINTER OF CURRENT SECTION
	CAIE	TB,(TC)		;SAME NAME AS THIS PARAGRAPH.
	JRST	PA4.A		;NO, LOOK FOR MORE
	MOVEI	TA,OPYECC	;YES, PREVENT MORE ERRORS
	PUSHJ	PP,SETOP3
	EWARNJ	E.658		;WARN USER

PA4.E:	SETO	TC,
	DPB	TC,PR.MDF
	EWARNW	E.172
PA4.P:	TLO	W2,GWDEF	;PUT DEFINING REFERENCE IN CREF FILE
	LDB	TA,[POINT 20,ARG1+1,35]	;USE LN&CP FOR THE NAME --
	DPB	TA,[POINT 20,W2,35]	;  NOT THE PERIOD AFTER IT
	PUSHJ	PP,PUTCRF
	MOVE	TA,[XWD CD.PRO,SZ.PRO]
	PUSHJ	PP,GETENT	;GET ENTRY
	PUSHJ	PP,PA4SUB	;SAVE PTR TO PROTAB ENTRY
	MOVEM	TA,TBLOCK+1	;SAVE ADDRESS
	PUSHJ	PP,PA3.Q	;SET IT UP
	MOVE	TA,TBLOCK+1
	HLRZ	TB,CURSEC	;REL. ADDR. OF CURRENT SECTION PROTAB ENTRY
	DPB	TB,PR.LSC	;SECTION LINK
	SETO	TB,
	DPB	TB,PR.SEC	;SET PARAGRAPH BIT
	MOVEM	TA,CURPAR	;SET UP CURRENT PARAGRAPH POINTER
	POPJ	PP,
;Here to check the very last paragraph for an unconditional GO TO

PA4.Z:	TSWTZ	UNCONT
	POPJ	PP,
	HLRZ	TA,CURPAR
	JUMPE	TA,CPOPJ
	PUSHJ	PP,LNKSET
	SETO	TB,
	DPB	TB,PR.TUT
	POPJ	PP,

;SAVE PTR TO PROTAB ENTRY
;  AND SAVE INITIAL SECTION OR PARA NAME FOR START CODE

PA4SUB:	MOVEM	TA,CURPRO##	;SAVE PROTAB PTR
	TSWT	INDECL		;IN DECLARATIVES?
	SKIPE	PROGST		;INITIAL PARA NAME SAVED ALREADY?
	POPJ	PP,		;YES

	HLRZ	TB,TA		;GET THE PROTAB LINK
	XORI	TB,600000	;CONVERT D-E TABLE CODE TO F-G CODE (4 BECOMES 2)
	HRRM	TB,PROGST	;SAVE ADDR OF INITIAL PROC NAME
	POPJ	PP,
	INTER.	PA5.
PA5.:	SETZ	TA,
	EXCH	TA,PRIOR	;PRIOR_0
	MOVEM	TA,LSTPRI
	POPJ	PP,

	INTER.	PA6.
PA6.:	FLAGAT	LI
	TLNN	W1,GWLIT	;IS ITEM A LITERAL?
	JRST	PA6.E		;NO
	TLNN	W1,GWNLIT	;IS ITEM A NUM. LIT.?
	JRST	PA6.E		;NO
	TLNE	W1,GWDP		;IS IT INTEGER?
	JRST	PA6.E		;NO
	LDB	TB,GWVAL
	MOVEM	TB,CTR##	;LENGTH
	HRRZI	TA,LITVAL	;LOCATION
	PUSHJ	PP,GETVAL##
	JUMPL	TC,PA6.E	;NEGATIVE
	CAILE	TC,143		;99. IS MAXIMUM
	HRRZI	TC,143
	CAMGE	TC,SEGLIM	;IS THIS RESIDENT?
	TDZA	TC,TC		;YES
	SETOM	NRESSN##	;NO, SIGNAL NON-RESIDENT SECTION SEEN
	MOVEM	TC,PRIOR
	POPJ	PP,

PA6.E:	MOVE	TC,LSTPRI
	MOVEM	TC,PRIOR
	EWARNJ	E.25
	INTER.	PA7.
PA7.:	HLRZ	TA,CURSEC
	JUMPE	TA,CPOPJ	;NO SECTION LINK
	PUSHJ	PP,LNKSET
	HRRZ	TC,PRIOR
	DPB	TC,PR.PRI	;PUT PRIORITY IN PROTAB ENTRY
	POPJ	PP,

	INTER.	PA8.
PA8.:	HRRZI	TA,16		;[*DMN*] USE OP CODE (NEVER OUTPUT)
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.USE##
	SETZM	INUPRG		;NO LONGER IN A USE PROCEDURE FOR A
				; REPORT GROUP
	POPJ	PP,

	INTER.	PA9.
PA9.:	SETO	TA,
	DPB	TA,OP.AFT##	;SET AFTER BIT
	POPJ	PP,


	INTER.	PA10.
PA10.:	SETZ	TA,
	DPB	TA,OP.AFT	;SET BEFORE BIT
	POPJ	PP,


	INTER.	PA11.
PA11.:	HRRZI	TA,75		;ERROR USE
	JRST	SETOP3
	INTER.	PA14.
PA14.:	FLAGAT	NS
	SETO	TA,		;SET ERROR-PROCEDURE-ON-OPEN BIT
	DPB	TA,OP.OPN##
	POPJ	PP,

	INTER.	PA18.
PA18.:	HRRZI	TA,2
	DPB	TA,OP.USE	;I-O USE
	POPJ	PP,

	INTER.	PA19.
PA19.:	HRRZI	TA,0
	DPB	TA,OP.USE	;INPUT USE
	POPJ	PP,

	INTER.	PA20.
PA20.:	HRRZI	TA,1		;OUTPUT USE
	DPB	TA,OP.USE
	POPJ	PP,

	INTER.	PA20X.
PA20X.:	FLAGAT	HI
	SETO	TA,		;EXTEND USE
	DPB	TA,OP.XTD##
	POPJ	PP,
	INTER.	PA21.R
PA21.R:	SKIPN	REFCON##	;IS IT CALL BY CONTENTS?
	JRST	PA21.		;NO
	MOVSI	TB,4000		;SET ROUNDED BIT IN ARG1
	IORM	TB,ARG1		;FOR CALL BY CONTENTS
	SKPNAM

	INTER.	PA21.
PA21.:	SETZM	TBLOCK+7	;FLAG SAYS THIS IS NOT A SUBSCRIPT
PA21.0:	HRRZ	TB,ARG1		;R. H. OF GETSRC W1
	MOVE	TA,ARG1+1	;GETSRC W2
	SKIPN	TB		;IF THERE IS AN ARG, CONTINUE
	SKIPN	TE,RMFLG##	;IF NOT REFERENCE MODIFYING, CONTINUE
	JRST	PA21.G		;
;Ref. Mod. - this may appear unusual here, but most verbs expect to 
;put out an operand. If that operand is being reference modified,
;the Ref. Mod. routines put it out and follow it with modifiers,
;then resume the interrupted verb's scan. Rather than modify every
;verb's tree structure, a flag is set and the original verb's op code
;restored and its scan continued.
	DMOVE	TB,RMOPR##	;RESTORE ORIGINAL VERB
	DMOVEM	TB,OPRTR	;
	SETZM	RMFLG##	;ZERO RM FLAG
	HRRZI	TB,2		;[1600]
	ADDM	TB,REPSUB	;[1600]Ref. mod uses two entrys
	POPJ	PP,		;EXIT
PA21.G:	MOVE	TE,TA		;W2
	MOVE	TD,ARG1		;W1
	AND	TA,[XWD	3,777777]	;LN, CP
	TLO	TA,400000	;SET OPERAND BIT
	TLNN	TD,GWLIT	;IS ITEM A LITERAL?
	JRST	PA21.A		;NO
	SETZM	NSBSC1
	TLO	TA,GNLIT	;YES--SET LITERAL BIT
	TLNE	TD,GWASCI	;IS ITEM 'PURE' ASCII?
	TLO	TA,020000	;YES -- SET BIT
	TLNE	TD,GWNLIT	;IS ITEM A NUMERIC LITERAL?
	TLO	TA,GNNUM	;YES--SET NUMERIC LITERAL BIT
	JUMPE	TB,PA21.E
PA21.B:	TLNE	TD,GWALL	;'ALL' ITEM?
	TLO	TA,GNALL	;YES--SET ALL BIT
	SETZM	ARG1
	SETZM	ARG1+1
	JRST	PUTGEN		;OUTPUT ARG1
PA21.A:	TLNN	TD,GWFIGC	;IS ITEM A FIGURATIVE CONSTANT?
	JRST	PA21.C		;NO
	SETZM	NSBSC1
	TLO	TA,GNLIT!GNFIGC	;YES---SET FIGURATIVE CONSTANT BIT
	HLRZ	TC,TD
	ANDI	TC,777		;YES--GET VALUE
	SETZ	TE,
	CAIN	TC,HIVAL.
	HRLZI	TE,GNFCHV	;HIGH-VALUE(S)
	CAIN	TC,LOVAL.
	HRLZI	TE,GNFCLV	;LOW-VALUE(S)
	CAIN	TC,QUOTE.
	HRLZI	TE,GNFCQ	;QUOTE(S)
	CAIN	TC,ZERO.
	HRLZI	TE,GNFCZ	;ZER0((E)S)
	CAIN	TC,SPACE.
	HRLZI	TE,GNFCS	;SPACE(S)
	IOR	TA,TE		;SET APPROPRIATE BITS
	JRST	PA21.B
PA21.C:	TLNE	TD,004000	;ROUNDED?
	TLO	TB,GNROUN	;YES
	TLNN	TE,400000	;FLOTAB ENTRY?
	JRST	PA21.D		;NO
	TLO	TB,100000	;YES--SET BIT IN OPERAND WORD
PA21.F:	SETZM	NSBSC1
	JRST	PUTFT

PA21.D:	HRRZI	TC,(TD)		;TABLE LINK
	JUMPE	TC,PA21.E	;NULL
	LSH	TC,-17		;TABLE TYPE CODE
	CAIN	TC,CD.CON	;CONTAB?
	JRST	PUTFT		;YES, DON'T CLR NSBSC1
	CAIE	TC,CD.DAT	;DATAB?
	JRST	PA21.F		;NO--OUTPUT AS IS

	MOVEM	TA,TBLOCK
	MOVEM	TB,TBLOCK+1
	MOVEM	TD,TBLOCK+2
	MOVEM	TE,TBLOCK+3
	HRRZ	TA,TB		;LINK
	PUSHJ	PP,LNKSET	;ABS. ADDR. OF DATAB ENTRY
	MOVE	TC,TA		;ENTRY ADDRESS
	MOVE	TA,TBLOCK
	MOVE	TB,TBLOCK+1
	MOVE	TD,4(TC)	;WORD 5 OF DATAB ENTRY
	TRNE	TD,100		;LINKAGE SECTION
	TLO	TA,(LKSFLG)	;YES
	TLNE	TD,100000	;SYNC LEFT?
	TLO	TA,010000	;YES
	TLNE	TD,040000	;SYNC RIGHT?
	TLO	TA,004000	;YES
	TLNE	TD,000010	;JUST RIGHT?
	TLO	TA,001000	;YES
	TLO	TA,002000	;SET NUMERIC BIT
	TLNE	TD,400000	;NOT NUMERIC
	TLNE	TD,200000	;SKIP IF NUMERIC
	TLZ	TA,002000	;TURN OFF NUMERIC BIT
	TRNE	TD,400000	;DD ERROR?
	TLO	TB,400000	;YES
	MOVE	TD,RMFLG	;
	TRZE	TD,400000	;
	TXO	TA,GNREFM	;bit to signify operand is RM'ed
	MOVEM	TD,RMFLG	;don't do it twice
	EXCH	TA,	TC		;PUT DATAB OFFSET IN TA & SAVE TC.
	LDB	TD,	DA.USG##	;PICK UP THE ITEM'S USAGE.
	EXCH	TA,	TC		;PUT THINGS BACK THE WAY THEY WERE.
	DPB	TD,	[POINT 4,TA,13]	;PUT THE USAGE IN THE FIRST GENFIL WORD.
PUTFT:	SKIPN	TBLOCK+7	;DOING A SUBSCRIPT?
	JRST	PUTFT0		;NO
	MOVE	TD,TBLOCK+6	;GET INDEX TO SUBSCRIPT TABLE
	ASH	TD,2		;4 WORDS EACH
	SKIPN	SBSCR1##+2(TD)	;DOES IT HAVE AN ADDITIVE?
	JRST	PUTFT0		;NO
	MOVEI	TC,1		;ASSUME +
	SKIPGE	SBSCR1(TD)
	MOVEI	TC,2		;NO, -
	DPB	TC,[POINT 2,TB,11]	;STORE ADDITIVE OPERATOR
PUTFT0:	SETZM	ARG1
	SETZM	ARG1+1
	HRRZI	TC,(TB)
	JUMPE	TC,PA21.E
	SKIPN	TD,NSBSC1	;NUMBER OF SUBSCRIPTS
	JRST	PUTGEN
	HRRZM	TD,TBLOCK+6
	MOVNI	TC,MAXSUB	;ALSO COUNT ADDITIONS TO SUBSCRIPTS
	MOVSI	TC,(TC)
PUTFT3:	SKIPE	SBSCR1+2(TC)	;THIS SUBSCRIPT HAVE AN ADDITIVE?
	AOJ	TD,		;YES
	ADDI	TC,3		;AIM AT NEXT SUBSCRIPT
	AOBJN	TC,PUTFT3
	DPB	TD,[POINT 6,TB,17]
	ADDM	TD,REPSUB	;[1600]Ref. mod + subscripts + additives
	PUSHJ	PP,PUTGEN
PUTFT1:	SOSGE	TD,TBLOCK+6
	JRST	PUTFT2
	ASH	TD,2
	HRLZI	TC,SBSCR1(TD)
	HRRI	TC,ARG1
	BLT	TC,ARG1+1
	SETZM	NSBSC1
	AOS	TBLOCK+7	;TELL PA21. WE ARE DOING A SUBSCRIPT
	PUSHJ	PP,PA21.0
	MOVE	TD,TBLOCK+6	;GET INDEX TO SUBSCRIPT TABLE
	ASH	TD,2
	SKIPN	TA,SBSCR1+2(TD)	;IS THERE AN ADDITIVE?
	JRST	PUTFT1		;NO
	MOVE	TB,SBSCR1+3(TD)	;YES, GET 2ND WORD OF ADDITIVE
	MOVEM	TA,ARG1
	MOVEM	TB,ARG1+1
	PUSHJ	PP,PA21.
	JRST	PUTFT1

PUTFT2:	MOVE	TA,[XWD NSBSC1,SBSCR1]
	MOVEI	TB,MAXSUB*4-1
	BLT	TA,SBSCR1(TB)
	POPJ	PP,

PA21.E:	OUTSTR	[ASCIZ /PA21.: null table link
/]
	HRRZI	TA,105		;'YECCH' OP CODE
	PUSHJ	PP,SETOP3
	EWARNJ	E.263
; THIS ROUTINE OUTPUTS THE OPERATOR. IT ALSO CHECKS
;FOR STATEMENTS THAT CAN'T BE REACHED

	INTER.	PA22.
PA22.:	LDB	TC,OP.OP2##	;OP CODE
	CAIN	TC,105		;YECCH?
	JRST	PA22.A		;YES
	CAIE	TC,26		;ENDIF OPERATOR?
	JRST	PA22.Z
PA22.A:	SWOFF	UNCONT;
	JRST	PA22.C

PA22.Z:	TSWT	UNCONT;
	JRST	PA22.B
	CAIE	TC,15		;END DECLARATIVES
	CAIN	TC,20		;IF <, ETC.
	JRST	PA22.C		; ARE LEGAL
	CAIG	TC,50		;COMPUTE ARITHMETIC OPERATOR?
	JRST	PA22.Q		;NO
	CAIG	TC,57
	JRST	PA22.C		;YES
; /DAW 8-MAR-79:  IF A DISPLAY (OP CODE 61) FOLLOWS A STOP RUN
;IT DOESN'T GET FLAGGED. OPEN,CLOSE, AND SEVERAL MORE ALSO WOULDN'T
;GET FLAGGED.  THE TEST FOR TYPE=PERIOD IS MADE AT THE END OF PARSING
;THESE STATEMENTS, THEREFORE IT SUCCEEDS!.
;  SINCE IT IS DIFFICULT TO FIGURE OUT WHERE COMMENTING
;OUT THE CHECKING OF AC "TYPE" MIGHT CAUSE PROBLEMS, I LEFT THE TEST FOR
;"WHEN" IN.. HOPEFULLY NOTHING WILL BREAK!!
;	CAIE	TYPE,PRIOD.	;PERIOD OK
	CAIN	TYPE,WHEN.	;ARE WE LOOKING AT A "WHEN"?
	JRST	PA22.C		;YES - ITS LEGAL
	CAIL	TC,70		;COMPUTE OPERATOR?
	CAILE	TC,73
	JRST	PA22.Q		;NO
	JRST	PA22.C

PA22.Q:	LDB	LN,OP.LN##
	LDB	CP,OP.CP##
	HRRZI	DW,E.188	; % THIS STATEMENT CANNOT BE REACHED
	PUSHJ	PP,WARN##
	LDB	TC,OP.OP2
PA22.B:	CAIE	TC,30		;IS IT 'GO'?
	JRST	PA22.D		;NO
	LDB	TC,OP.CLN	;SPECIAL TYPE?
	JUMPN	TC,PA22.C	;YES
	SKIPN	EVALFL		;IF IN EVALUATE, DON'T TURN ON
	SWON	UNCONT;
PA22.C:	MOVE	TA,OPRTR	;OUTPUT
	MOVE	TB,OPRTR+1	;OP
	SETZM	OPRTR
	SETZM	OPRTR+1
	JRST	PUTGEN

PA22.D:	CAIE	TC,40		;'STOP'?
	JRST	PA22.C		;NO
	LDB	TB,OP.RUN##	;'RUN'?
	JUMPE	TB,PA22.C	;NO
	SKIPN	EVALFL		;IF IN EVALUATE, DON'T TURN ON
	SWON	UNCONT;
	JRST	PA22.C
	INTER.	PA23.
PA23.:	SWON	FARITH;
	SWOFF	FRTST!FNOCPY	;[1033] TURN OFF COPY REPLACING FLAGS
PA23.1:	PUSHJ	PP,SKPSRC##
	TSWF	FEOF;
	JRST	PA23.X
	CAIE	CP,7
	JRST	PA23.1
PA23.2:	PUSHJ	PP,SKPSRC
	TSWF	FEOF;
	JRST	PA23.X
	CAIL	CP,^D12
	JRST	PA23.1
	CAIN	CH," "
	JRST	PA23.2
PA23.X:	SWOFF	FARITH;
	SWON	FREGCH;
	SKPNAM

	INTER.	PA23.Z
PA23.Z:	SWOFF	FREGWD		; [312] MAKE SURE WE DON'T REGET BAD WORD
	PUSHJ	PP,GETITM##
	SKPNAM

	INTER.	PA24.
PA24.:	CAIE	TYPE,ELSE.	;[1005][1553] ENCOUNTERED 'ELSE'?
	SKIPE	SCPTRM##	;[1553] OR END-XXX?
	SETZM	SWHEN##		;[1005] YES, TERM. SEARCH WHEN, IF ACTIVE
	SKPNAM

	INTER.	PA24.R
PA24.R:	SWON	FREGWD;
	POPJ	PP,

	INTER.	PA24.S
PA24.S:	FLAGAT	8
	JRST	PA24.

	INTER.	PA25.
PA25.:	HRRZI	TA,30		;'GO TO' OP CODE
	JRST	SETOP

	INTER.	PA26.F
PA26.F:	FLAGAT	HI
	SKPNAM

	INTER.	PA26.
PA26.:	SKIPN	ARG1
	SKIPE	ARG1+1
	PUSHJ	PP,PA21.	;PUT OUT ARG1 IF NOT NULL
	PUSHJ	PP,PA22.	;PUT OUT OP
	HLRZ	TA,CURPAR
	JUMPE	TA,PA26.E
	PUSHJ	PP,LNKSET	;PROTAB ENTRY OF CURRENT PARAGRAPH
	SETO	TB,
	DPB	TB,PR.ALT##	;SET ALTERABLE FLAG IN PROTAB
	POPJ	PP,

PA26.E:	OUTSTR	[ASCIZ /PA26.: no PROTAB link for paragraph name
/]
	EWARNW	E.262
	JRST	KILL
	INTER.	PA27.
PA27.:	PUSHJ	PP,PA21.
	PUSHJ	PP,PA24.
	HRRZI	NODE,PD153.##
	MOVEM	NODE,(NODPTR)
	HRRZI	NODE,PD157.##
	PUSH	NODPTR,NODE
	HRRZI	NODE,PD395F##
	PUSH	NODPTR,NODE
	POPJ	PP,

;ONLY 1 ITEM BEFORE DEPENDING ON CLAUSE

	INTER.	PA27A.
PA27A.:	FLAGAT	8
	PUSHJ	PP,PA21.
	HRRZI	NODE,PD153.##
	MOVEM	NODE,(NODPTR)
	HRRZI	NODE,PD157.##
	PUSH	NODPTR,NODE
	HRRZI	NODE,PD395G##
	PUSH	NODPTR,NODE
	POPJ	PP,


;SEE IF WE WERE PROCESSING A CONDITIONAL FOR 'IF' OR WHETHER WE WERE
; JUST DOING AN ORDINARY DATA NAME.

	INTER.	PA28.
PA28.:	MOVE	TB,	[XWD	PD643A##,PD669.##]
	JRST	PA28.1+1		;GET TRACE RIGHT

	INTER.	PA28.1
PA28.1:	MOVE	TB,	[XWD	PD643A##,PD714.##]

	HRRZ	TA,	ARG1		;GET THE TABLE LINK.
	LSH	TA,	-17		;ISOLATE THE TABLE CODE.
	CAIN	TA,	CD.CON		;IS IT CONTAB?
	JRST		PA0.		;YES, POP UP TO THE NODE WE
					; PUSHED DOWN FROM.

;  IT WASN'T A CONDITIONAL - TRY TO FAKE OUT SQUIRL.

	HLRZM	TB,	(NODPTR)	;PRETEND WE WERE AT PD643A
	HRRZM	TB,	-1(NODPTR)	; AND HAD PUSHED DOWN FROM
					; PD669 OR PD714.
	SKIPN	RMFLG##			;IF REF MODIFYING, THIS HAS BEEN DONE
	PJRST		PA111.		;GO PUT OUT INITIAL GENFIL CODE
					; FOR "EXPR" OPERATOR.
	POPJ	PP,			;JUST EXIT
	INTER.	PA30.
PA30.:	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	SETZM	ATGFLG##	;CLEAR ADD TO FLAG
	MOVEI	TA,OPADDT	;'ADD TO' OP CODE
	JRST	SETOP

	INTER.	PA31.
PA31.:	SETOM	ATGFLG		;SIGNAL ADD TO SEEN
	POPJ	PP,

	INTER.	PA33.
PA33.:	SKIPE	ATGFLG		;HAVE WE HAVE ALREADY SEEN "TO"?
	JRST	PA34.A		;YES, ITS -8x OPTIONAL "TO"
	MOVEI	TA,OPADD	;NO, SET 'ADD' OP CODE
	JRST	SETOP3

PA34.A:	FLAGAT	8
	MOVEI	TA,OPADTG	;SIGNAL SPECIAL "ADD TO GIVING"
	JRST	SETOP3

	INTER.	PA34.
PA34.:	HRRZI	TA,11		;'RESULT' OP CODE
	SKIPN	RMFLG		;If Ref. Modding,
	JRST	SETOP1
	PUSHJ	PP,SETOP1	; set up op code
	DMOVE	TB,OPRTR	; then store it
	DMOVEM	TB,RMOPR	; 
	POPJ	PP,		; 

	INTER.	PA35.
PA35.:	MOVE	TA,ARG1
	TLO	TA,004000	;SET 'ROUNDED' BIT
	MOVEM	TA,ARG1
	POPJ	PP,


	INTER.	PA36.
PA36.:	SETO	TA,
	DPB	TA,OP.SZE##
	PUSHJ	PP,PA22.
	HRRZI	TA,23		;'SPECIAL IF' OP CODE
	PUSHJ	PP,SETOP2
	SETO	TA,
	DPB	TA,OP.SZE
	JRST	PA90.A
	INTER.	PA37.
PA37.:	HRLZI	TA,026000	;ENDIF
	SETZM	EWFLG##		;[1553] Turn off when seen flag
	HRRZI	TB,26
	DPB	W2,[POINT	20,TA,35]
	PUSHJ	PP,PUTGEN
	HRRZ	TA,IFLVL
	ADD	TA,SPFLVL
	HRRZ	TC,ARGL2-1(TA)	;F-TARGET FOR CURRENT LEVEL
	HLRM	TC,ARGL2-1(TA)	;CLEAR ENTRY
	PUSHJ	PP,P127.A	;DEFINE TAG
	PUSH	PP,TA		;[1130] GET AN AC TO WORK WITH
	HRRZ	TA,IFLVL	;[1130] GET VALUE OF IF LEVEL
	CAILE	TA,0		;[1130] CAN'T GO NEGATIVE
	SOS	IFLVL
	POP	PP,TA		;[1130] GIVE BACK AC
	SWOFF	UNCONT;
	POPJ	PP,
	INTER.	PA38.
PA38.:	SETO	TA,
	DPB	TA,OP.UPO##	;SET 'UPON' BIT
	POPJ	PP,


	INTER.	PA43.
PA43.:	HRRZI	TA,60		;'ACCEPT' OP CODE
	JRST	SETOP

	INTER.	PA45.
PA45.:	HRRZI	TA,34		;'ALTER' OP CODE
	JRST	SETOP


	INTER.	PA47.
PA47.:	MOVE	TA,ARG1
	EXCH	TA,ARG2##
	MOVEM	TA,ARG1
	MOVE	TA,ARG1+1
	EXCH	TA,ARG2+1
	MOVEM	TA,ARG1+1
	MOVE	TA,[XWD NSBSC1,TBLOCK]
	BLT	TA,TBLOCK+MAXSUB*4
	MOVE	TA,[XWD NSBSC2,NSBSC1]
	BLT	TA,SBSCR1+MAXSUB*4-1
	MOVE	TA,[XWD TBLOCK,NSBSC2##]
	BLT	TA,SBSCR2##+MAXSUB*4-1
	POPJ	PP,
	INTER.	PA49.
PA49.:	HRRZI	TA,62		;'OPEN' OP CODE
	MOVEM	TYPE,CURVRB	;Store it in case 'UNAVAIL'
	JRST	SETOP1


	INTER.	PA50.
PA50.:	SETZM	SU8CNT		;COUNT FILES INCASE FIPS FLAGGER
PA50A.:	HRRZI	TA,63		;'CLOSE' OP CODE
	JRST	SETOP1


	INTER.	PA51.
PA51.:	SETO	TA,
	DPB	TA,OP.REE##	;SET 'REEL' BIT
PA51.A:				;
	HRRZ	TA,CURFIL	;
	LDB	TE,FI.RMS	;CHECK IF RMS FILE AND GIVE WARNING IF SO
	CAIN	TE,0		; IS NOT, JUST RETURN
	POPJ	PP,
	HRRZI	DW,E.853	;GIVE NOT SUPPORTED MESSAGE
	PUSHJ	PP,WARN##	;
	POPJ	PP,		;


	INTER.	PA52.
PA52.:	SETO	TA,
	DPB	TA,OP.LCK##	;SET 'LOCK' BIT
	SKIPN	FLGSW##		;FIPS FLAGGER WANTED?
	POPJ	PP,		;NO
	MOVE	TA,ARG1		;GET FILE TABLE
	ADD	TA,FILLOC
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
 IFN %ACC.S,<
	CAIE	TB,%ACC.S	;ONLY SEQUENTIAL IS SPECIAL
	POPJ	PP,
 >
 IFE %ACC.S,<
	JUMPN	TB,CPOPJ
 >
	MOVEI	TA,%LV.HI	;SEQUENTIAL
	PJRST	FLG.ES##	;FLAG IF ILLEGAL

	INTER.	PA52A.
PA52A.:	FLAGAT	HI
	SETO	TA,
	DPB	TA,OP.REM##	;SET 'FOR REMOVAL' BIT
	JRST	PA51.A		;

	INTER.	PA53.
PA53.:	FLAGAT	HI
	SETO	TA,
	DPB	TA,OP.NRW##	;SET 'NO REWIND' BIT
	JRST	PA51.A		;


	INTER.	PA54.
PA54.:	HRRZI	TA,57		;'CEND' OP CODE
	SWOFF	FARITH;
	JRST	SETOP1

	INTER. PA54A
PA54A:	SKIPG	CLEVEL		; [172] ARE ALL PARENTHESIS CLOSED?
	JRST PA54A1		; [172] YES OK
PA54A2:	EWARNW	E.261		; [172] NO
	SOSLE	CLEVEL		; [172]
	JRST	PA54A2		; [172] TELL HIM ABOUT ALL UNBALANCED ONES
PA54A1:	SETZM	CLEVEL		; [172] CLEAR PAREN COUNT
	SETZM	ELEVEL		; [172] CLEAR BALANCE COUNT
	JRST	PA54.		; [172] FINISH UP


	INTER.	PA55.
PA55.:	HRRZI	TA,61		;'DISPLAY' OP CODE
	JRST	SETOP
	INTER.	PA57.
PA57.:	HRRZI	TA,13		;'DIVBY' OP CODE
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	JRST	SETOP


	INTER.	PA58.
PA58.:	HRRZI	TA,10		;'DIVIDE' OP CODE
	JRST	SETOP3

	INTER.	PA59.
PA59.:	HRRZI	TA,106		;NO-OP OP CODE
	JRST	SETOP

	INTER.	PA61.
PA61.:	HRRZI	TA,42		;'INSPECT' OP CODE
	JRST	SETOP

	INTER.	PA62.
PA62.:	HRRZI	TA,156		;GET "TALLYING" OPERATOR
	MOVEM	TA,SVINSO##	; SAVE NEXT OPERATOR
	POPJ	PP,

	INTER.	PA64.
PA64.:	SETO	TA,
	DPB	TA,OP.LEA##
	POPJ	PP,

	INTER.	PA65.
PA65.:	SETO	TA,
	DPB	TA,OP.CHR##
	POPJ	PP,

	INTER.	PA65A.
PA65A.:	PUSHJ	PP,PREA		;ONLY 1 AFTER CLAUSE ALLOWED
	SETO	TA,
	DPB	TA,OP.IAF##
	LDB	TA,OP.IBF##
	SKIPE	TA		;"BEFORE" SPECIFIED PRIOR TO "AFTER"
	POPJ	PP,		;YES
	SETO	TA,
	DPB	TA,OP.IAB##	;INSPECT "AFTER" XXX "BEFORE" YYY
	POPJ	PP,

	INTER.	PA65B.
PA65B.:	PUSHJ	PP,PREB		;ONLY 1 BEFORE CLAUSE ALLOWED
	SETO	TA,
	DPB	TA,OP.IBF##
	POPJ	PP,

PREB:	LDB	TA,OP.IBF##	;ANY PREVIOUS "BEFORE" CLAUSE
	JUMPN	TA,PREBAE	; FOR THIS ARGUMENT?
	POPJ	PP,

PREA:	LDB	TA,OP.IAF##	;ANY PREVIOUS "AFTER" CLAUSE
	JUMPN	TA,PREBAE	; FOR THIS ARGUMENT?
	POPJ	PP,

PREBAE:	EWARNJ	E.724		;"Only one 'BEFORE' and 'AFTER' clause allowed"

	INTER.	PA66.
PA66.:	SETO	TA,
	DPB	TA,OP.RPL##
	SKPNAM

	INTER.	PA66A.
PA66A.:	HRRZI	TA,157		;"REPLACING" OPERATOR
	MOVEM	TA,SVINSO##	;SAVE IT
	POPJ	PP,

	INTER.	PA67.
PA67.:	SETO	TA,
	DPB	TA,OP.FIR##
	POPJ	PP,

	INTER.	PA68.
PA68.:	HRRZI	TA,31		;'GO DEPENDING' OP CODE
	JRST	SETOP
	
	INTER.	PA69.
PA69.:	FLAGAT	8
	HRRZI	TA,OPINSC	;'INSPECT CONVERTING' OP CODE
	MOVEM	TA,SVINSO##
	JRST	PCA92.

	INTER.	PA70.
PA70.:	HRRZI	TA,1		;'MOVE' OP CODE
;	JRST	SETOP

;HERE TO SET UP OPERATOR WORDS

SETOP:	SETZM	ARG1
	SETZM	ARG1+1
SETOP1:	SETZM	OPRTR
SETOP2:	DPB	W2,OP.LNC
SETOP3:	DPB	TA,OP.OPC##
	DPB	TA,OP.OP2
	POPJ	PP,


	INTER.	PA72.
PA72.:	HRRZI	TA,7		;'MULTIPLY BY' OP CODE
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	JRST	SETOP

	INTER.	PA73.
PA73.:	HRRZI	TA,6		;'MULTIPLY GIVING' OP CODE
	SKIPN	RMFLG##	;If Ref. Modding
	JRST	SETOP3
	PUSHJ	PP,SETOP3	; set up op code
	DMOVE	TB,OPRTR	; then store it
	DMOVEM	TB,RMOPR##	;
	POPJ	PP,		;

	INTER.	PA74.
PA74.:	MOVE	TB,OP.INP##
PA74.A:	HRRZI	TA,62		;'OPEN' OP CODE
	LDB	TC,OP.LNC
	SETZM	OPRTR
	DPB	TC,OP.LNC
	PUSHJ	PP,SETOP3
	SETO	TA,
	DPB	TA,TB
	POPJ	PP,


	INTER.	PA75.
PA75.:	MOVE	TB,OP.OUT##
	JRST	PA74.A


	INTER.	PA76.
PA76.:	MOVE	TB,OP.INO##
	JRST	PA74.A
	INTER.	PA77.
PA77.:	HRRZ	TA,ARG1
	JUMPE	TA,CPOPJ
	PUSHJ	PP,LNKSET
	LDB	TB,OP.INO
	SETO	TC,
	XCT	[POPJ	PP,
		DPB	TC,FI.INO##		;OPEN INPUT
		DPB	TC,FI.OUO##		;OPEN OUTPUT
		DPB	TC,FI.IOO##](TB)	;OPEN I-O
	POPJ	PP,


	INTER.	PA78.
PA78.:	SETZ	TA,
	DPB	TA,OP.NRW	;CLEAR NO REWIND BIT
	POPJ	PP,


	INTER.	PA79.
PA79.:	SETO	TA,
	DPB	TA,OP.NRW	;SET NO REWIND BIT
	POPJ	PP,

	INTER.	PA79E.
PA79E.:	SETO	TA,
	DPB	TA,OP.EXT##	;SET EXTEND BIT
	POPJ	PP,

	INTER.	PA79R.
PA79R.:	SETO	TA,
	DPB	TA,OP.REV##	;SET REVERSED BIT
	DPB	TA,OP.NRW	;AND SET NO REWIND BIT
	POPJ	PP,
	INTER.	PA80.
PA80.:	HRRZI	TA,64		;'READ' OP CODE
	SETZM	REINTO##	;CLR READ INTO FLAG
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	JRST	SETOP1


	INTER.	PA81.
PA81.:	HRRZI	TA,23		;'SPECIAL IF'
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.ATE##	;'AT END'
	JRST	PA90.A

	INTER.	PA81Q.
PA81Q.:	SKIPLE	AS7482		;WANT COBOL-8x?
	EWARNW	E.829		;YES, WARN USER
	SKPNAM

	INTER.	PA81P.
PA81P.:	FLAGAT	HI
	HRRZ	TA,CURFIL
	LDB	TA,FI.LCP##	;SEE IF LINAGE CLAUSE SPECIFIED
	SKIPN	TA		;YES, OK
	EWARNW	E.752		;NO, IT SHOULD BE
	HRRZI	TA,23		;'SPECIAL IF'
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.EOP##	;'AT END OF PAGE'
	JRST	PA90.A

	INTER.	PA82.
PA82.:	HRRZI	TA,43		;'SET TO' OP CODE
	JRST	SETOP

	INTER.	PA83.
PA83.:	HRRZI	TA,45		;'SET UP BY' OP CODE
	JRST	SETOP3

	INTER.	PA84.
PA84.:	HRRZI	TA,44		;'SET DOWN BY' OP CODE
	JRST	SETOP3
;SET UP WRITE OP-CODE

	INTER.	PA85.
PA85.:	HRRZI	TA,65		;'WRITE' OP CODE
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	JRST	SETOP1

;SET UP DELETE OP-CODE

	INTER.	PA85D.
PA85D.:	HRRZI	TA,122		;DELETE OP-CODE
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	JRST	SETOP1

;SET UP REWRITE OP-CODE

	INTER.	PA85R.
PA85R.:	HRRZI	TA,66		;REWRITE OP-CODE
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	JRST	SETOP1

	INTER.	PA86.
PA86.:	SETO	TA,
	DPB	TA,OP.BAD##	;'BEFORE ADVANCING'
	JRST	PA87.1		;[1466] CHECK RECORDING MODE


	INTER.	PA87.
PA87.:	SETO	TA,
	DPB	TA,OP.AAD##	;'AFTER ADVANCING'
PA87.1:	SKIPN	TA,CURFIL	;[1466] 
	POPJ	PP,
	LDB	TB,FI.ERM##	;[1466] GET EXTERNAL REC. MODE
	LDB	TA,FI.RM2##	;WAS ONE REALLY DECLARED?
	CAIE	TB,%RM.7B	;[1466] IS IT ASCII?
	SKIPN	TA		;ZERO => NONE DECLARED
	POPJ	PP,		;[1466] OK - EXIT
	EWARNJ	E.365		;[1466] NO, ERROR


	INTER.	PA88.
PA88.:	FLAGAT	NS
	SETZI	TA,	;WHOPS, MAKE THAT POSITIONING INSTEAD OF ADVANCING.
	DPB	TA,	OP.ADV##	;CLEAR ADVANCING.
	SETOI	TA,
	DPB	TA,	OP.PSG##	;SET POSITIONING.
	POPJ	PP,
;WRITE RECORD ADVANCING PAGE.

	INTER.	PA89.
PA89.:	PUSHJ	PP,PA2.
	HRRZ	TB,ARG1		;R. H. OF GETSRC W1
	MOVE	TA,ARG1+1	;GETSRC W2
	MOVE	TE,TA		;W2
	MOVE	TD,ARG1		;W1
	TLZ	TA,777774	;LN, CP
	TLO	TA,400000	;SET OPERAND BIT
	SETZM	NSBSC1
	SETZM	ARG1
	SETZM	ARG1+1
	HLRZ	TB,TD
	ANDI	TB,777		;GET VALUE
	JRST	PUTGEN		;OUTPUT ARG1
	INTER.	PA90.
PA90.:	HRRZI	TA,23		;'SPECIAL IF'
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.INK##	;'INVALID KEY'
PA90.A:	PUSHJ	PP,GETTAG##
	ANDI	CH,077777
	JUMPE	CH,PA90.A	;%0 NOT ALLOWED
	DPB	CH,OP.TRG##
	AOS	TA,SPFLVL
	ADD	TA,IFLVL
	CAILE	TA,IF.DEP	;ARGL2 OVERFLOW?
	JRST	PA90.B		;YES
	HRLZM	CH,ARGL2-1(TA)
	PUSHJ	PP,PA22.
	JRST	PA820.		;STORE VERB FOR MATCHING END-XXX


PA90.B:	EWARNW	E.323
	JRST	PA133.		;GIVE UP


	INTER.	PA91.
PA91.:	HRRZI	TA,5		;'SUBTRACT FROM' OP CODE
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	JRST	SETOP


	INTER.	PA94.
PA94.:	HRRZI	TA,32		;'PERFORM' OP CODE
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	SETZM	PERFAB##	;DEFAULT TO PERFORM BEFORE TEST
	JRST	SETOP1


	INTER.	PA95.
PA95.:	HRRZI	TA,33		;'PERFORM TIMES' OP CODE
	SKIPN	RMFLG		;If Ref. Modding,
	JRST	SETOP3
	PUSHJ	PP,SETOP3	; set up op code
	DMOVE	TB,OPRTR	; then save off new op code
	DMOVEM	TB,RMOPR	;
	POPJ	PP,		;
	INTER.	PA96.
PA96.:	FLAGAT	HI
	SKIPN	ARG2
	SKIPE	ARG2+1
	JRST	PA96.A
	PUSHJ	PP,PA159.
	JRST	.+2
PA96.A:	PUSHJ	PP,PA47.
	SETZM	NVARY##
	SETZM	VARBLK
	MOVE	TA,[XWD VARBLK,VARBLK+1]
;	BLT	TA,VARLST
;	SETZM	VARTAG##
;	MOVE	TA,[XWD VARTAG,VARTAG+1]
	BLT	TA,VARTAG##+6
	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	JUMPE	CH,.-2
	HRRZM	CH,VARTAG	;%S
	HRLZI	TB,(CH)
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
	MOVE	TA,[XWD OPRTR,SAVPRF##]
	BLT	TA,SAVPRF+5
	POPJ	PP,
	INTER.	PA97.
PA97.:	AOS	TA,NVARY
	CAIG	TA,MXPERF
	POPJ	PP,
	EWARNJ	E.156		;ONLY THREE VARYINGS ALLOWED


	INTER.	PA98.
PA98.:	HRRZ	TA,NVARY	;WE HAD SEEN 'VARYING'.  NOW WE SAW 'FROM'
				; SO WE SAVE WHAT TO VARY IN VARBLK.
	CAILE	TA,MXPERF
	POPJ	PP,		;IGNORE FURTHER VARYINGS
	HRRZI	TA,-1(TA)
	IMULI	TA,VARSIZ##	;SIZE OF ONE OCCURANCE OF VARBLK
	MOVE	TB,ARG1		;INDEX
	MOVEM	TB,VARBLK(TA)	;SAVE SUBJECT
	MOVE	TB,ARG1+1
	MOVEM	TB,VARBLK+1(TA)
	HRRZI	TB,VARSSB##(TA)
	HRLI	TB,NSBSC1
	BLT	TB,VARIVL-1(TA)	;SAVE THE SUBSCRIPTS
PA98.X:	SETZM	NSBSC1		;CLR SUBSCRIPT STORE
	MOVE	TB,[XWD NSBSC1,NSBSC1+1]
	BLT	TB,NSBSC1+MAXSUB*4
	POPJ	PP,


	INTER.	PA99.
PA99.:	HRRZ	TA,NVARY	;WE HAD SEEN 'FROM'.  NOW WE SAW 'BY'
				; SO SAVE THE INITIAL VALUE IN VARBLK.
	CAILE	TA,MXPERF
	POPJ	PP,		;IGNORE FURTHER VARYINGS
	HRRZI	TA,-1(TA)
	IMULI	TA,VARSIZ	;SIZE OF ONE OCCURANCE OF VARBLK
	MOVE	TB,ARG1		;ORIGINAL VALUE OF INDEX
	MOVEM	TB,VARIVL##(TA)	;SAVE INITIAL VALUE
	MOVE	TB,ARG1+1
	MOVEM	TB,VARIVL+1(TA)
	HRRZI	TB,VARSIV##(TA)
	HRLI	TB,NSBSC1
	BLT	TB,VARSIN-1(TA)	;SAVE THE SUBSCRIPTS
	JRST	PA98.X		;CLR SUBSCRIPT STORE & RETURN
	INTER.	PA100.
PA100.:	HRRZ	TA,NVARY	;HAD SEEN A 'BY'. NOW WE SAW AN 'UNTIL'
				; SO SAVE THE INCREMENT IN VARBLK.
	CAILE	TA,MXPERF
	POPJ	PP,
	SETOM	IFPERF##	;SIGNAL ITS PERFORM LOOP CONTROL
	SUBI	TA,1
	IMULI	TA,VARSIZ	;SIZE OF ONE OCCURANCE OF VARBLK
	MOVE	TB,ARG1
	MOVEM	TB,VARINC##(TA)		;INCREMENT
	MOVE	TB,ARG1+1
	MOVEM	TB,VARINC+1(TA)
	HRRZI	TB,VARSIN##(TA)
	HRLI	TB,NSBSC1
	BLT	TB,VARNXT##-1(TA)	;SAVE THE SUBSCRIPTS
	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	HRRZ	TC,NVARY
	LSH	TC,1
	HRRZM	CH,VARTAG(TC)
	HRLZI	TB,(CH)
	JRST	P198.D		;OUTPUT 'TAGNAM' OP CODE

	INTER.	PA101.
PA101.:	HRRZ	TA,NVARY
	CAILE	TA,MXPERF
	JRST	PA37.
	MOVE	CH,INPTAG##	;Get tag generated by inline perform
	JUMPE	CH,PA101A	;If no tag, must not be inline perform

;The following code generates the same code as PA101A. The difference
;between this and PA101A, is that the tag number for the next statement
;is incremented by one. Two calls to GETTAG are executed at PA833. with
;the first tag being the starting address of the statements within the
;perform, and the second tag for the next statement.

	ANDI	CH,077777
	HRRZ	TA,NVARY
	LSH	TA,1
	HRRZM	CH,VARTAG-1(TA)
	AOS	VARTAG-1(TA)
	PUSHJ	PP,PA103A	;GENERATE JUMPTO OP CODE
	SETZM	INPTAG
	JRST	PA37.

PA101A:	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	HRRZ	TA,NVARY
	LSH	TA,1
	HRRZM	CH,VARTAG-1(TA)
	PUSHJ	PP,PA103A	;GENERATE JUMPTO OP CODE
	JRST	PA37.
	INTER.	PA102X
PA102X:	PUSHJ	PP,PA821.	;PUT CURRENT RESERVED WORD ON TEMTAB STACK
	SKPNAM

	INTER.	PA102.
PA102.:	SETZM	OPRTR+1
	CAIE	TYPE,UNTIL.	;[1005] WAS IT UNTIL?
	CAIN	TYPE,WHEN.	;[1005] WAS IT 'WHEN'?
	JRST	PA102A		;[1005] BYPASS TEST FOR 'WHEN' ACTIVE
	CAIE	TYPE,UNTIL.+AMRGN.	;SAME TEST AS ABOVE BUT ALLOW
	CAIN	TYPE,WHEN.+AMRGN.	; VERB TO BE IN "A" MARGIN
	JRST	PA102A		;YES, BYPASS TEST FOR 'WHEN' ACTIVE
	SKIPE	SWHEN##		;[1005] 'WHEN' ALREADY ACTIVE?
	EWARNW	E.632		;[1005] GIVE ERROR MSG
PA102A:	SETZM	ERSKIP##	;Clear "Error caused us to skip to next period"
	HRRZI	TA,20		;'IF' OP CODE
	SKIPE	IFPERF##	;SEE IF ITS PERFORM LOOP CONTROL
	HRRZI	TA,25		;YES, 'IF' OP CODE FOR PERFORM VARYING UNTIL
	JRST	SETOP1

	INTER.	PA103.
PA103.:	SWOFF	UNCONT;
;[1541]	SKIPN	CH,NXTSNT
	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	JUMPE	CH,.-2
;[1541]	HRRZM	CH,NXTSNT
PA103A:	HRLZI	TB,(CH)
	HRRI	TB,74		;JUMPTO OP CODE
	JRST	P198.E

	INTER.	PA103N		;[1602]Duplicate PA103. for NEXT SENTANCE
PA103N:	SWOFF	UNCONT		;[1602]No GOTOs
	SKIPN	CH,NXTSNT	;[1602]Already defined?
	PUSHJ	PP,GETTAG	;[1602]Then don't get a new one
	ANDI	CH,077777	;[1602]
	JUMPE	CH,.-2		;[1602]Can't use tag zero
	HRRZM	CH,NXTSNT	;[1602]Save it for when we find a period
	HRLZI	TB,(CH)		;[1602]
	HRRI	TB,74		;[1602]JUMPTO OP CODE
	JRST	P198.E		;[1602]

	INTER.	PA104.
PA104.:	SWOFF	FNOTF;
	SETZM	ARGLST##
	MOVE	TA,[XWD	ARGLST,ARGLST+1]
	BLT	TA,ARGLST+IF.DEP-1
	SETZM	TOPLVL
	SETZM	TRMLVL##
	SKIPE	FLGSW		;FIPS FLAGGER REQUIRED?
	SKIPN	IFLVL		;AND NESTED?
	TRNA			;NO
	PUSHJ	PP,TST.HI	;YES, TEST AT HIGH-INTERMEDIATE LEVEL
	AOS	TA,IFLVL
	ADD	TA,SPFLVL	;ARGL2 OVERFLOW?
	CAIG	TA,IF.DEP
	POPJ	PP,
	JRST	PA90.B		;YES

	INTER.	PA106.
PA106.:	FLAGAT	HI
	SKPNAM

	INTER.	PA107.
PA107.:	TSWC	FNOTF;
	SETZM	TOPLVL
	DMOVEM	LN,NOTLN	;SAVE LOCATION OF "NOT"
	POPJ	PP,
	INTER.	PA111.
PA111.:	MOVE	TA,TOPLVL
	MOVEM	TA,ELEVEL
	MOVE	TB,CLEVEL
	SUB	TB,TA
	MOVEM	TB,CLEVEL
	SWON	FEXPR+FARITH
	HRRZI	TA,72		;'EXPRESSION' OP CODE
	PUSHJ	PP,SETOP0
	HRLZI	TA,070000
	DPB	W2,[POINT 20,TA,35]
	HRRZI	TB,70		;'(' OP CODE
	CAIA
	PUSHJ	PP,PUTGEN
	SOSL	TOPLVL
	JRST	.-2
	SETZM	TOPLVL
	POPJ	PP,
;OUTPUT CODES FOR "AND"

	INTER.	PA118.
PA118.:	PUSHJ	PP,SETCTR	;# OF LEVELS FROM HERE UP
P118.2:	ADD	TB,CLEVEL	;(TB STILL CONTAINS VALUE OF CTR)
	HRRZ	TB,ARGLST(TB)	;ANY TAG THERE?
	JUMPN	TB,P118.1	;YES
	SOSLE	TB,CTR		;NO, FINISHED ALL ENTRIES ABOVE THIS LEVEL?
	JRST	P118.2		;NOT YET
	PUSHJ	PP,PA129.	;NONE FOUND. NORMAL "AND".
	JRST	SETCTR		;RETURN WITH CTR SET UP

P118.1:	AOS	CLEVEL
	PUSHJ	PP,PA130.	;INVERTED "AND". GOIF-TRUE ONE LEVEL UP.
	SOS	CLEVEL
	PUSHJ	PP,SETCTR
P118.3:	PUSHJ	PP,PA127.	;OUTPUT ALL FALSE TAGS
	SOSL	CTR
	JRST	P118.3
	MOVE	TB,CLEVEL	;DEFINE F-TARGET AT THIS LEVEL
	HRLZ	TB,ARGLST(TB)	;ONE THERE ALREADY?
	JUMPN	TB,P118.4	;YES
P118.5:	PUSHJ	PP,GETTAG	;NO, GET ONE
	ANDI	CH,077777
	JUMPE	CH,P118.5
	MOVE	TB,CLEVEL
	HRRM	CH,ARGLST(TB)
P118.6:	HRLZ	TB,CH
P118.4:	HRRI	TB,74		;OUTPUT JUMPTO
	HRLI	TA,074000
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	JRST	SETCTR		;RETURN WITH CTR SET UP
;OUTPUT CODES FOR "OR"

	INTER.	PA119.
PA119.:	PUSHJ	PP,SETCTR	;# OF LEVELS FROM HERE UP
P119.2:	ADD	TB,CLEVEL	;(TB STILL CONTAINS VALUE OF CTR)
	HLRZ	TB,ARGLST(TB)	;ANY TAG THERE?
	ANDI	TB,077777
	JUMPN	TB,P119.1	;YES
	SOSLE	TB,CTR		;NO, FINISHED ALL ENTRIES ABOVE THIS LEVEL?
	JRST	P119.2		;NOT YET
	PUSHJ	PP,PA130.	;NONE FOUND. NORMAL "OR".
	JRST	SETCTR		;RETURN WITH CTR SET UP

P119.1:	PUSHJ	PP,PA129.	;INVERTED "OR".
	PUSHJ	PP,SETCTR
P119.3:	PUSHJ	PP,PA131.	;OUTPUT ALL TRUE TAGS
	SOSL	CTR
	JRST	P119.3
	MOVE	TB,CLEVEL	;DEFINE T-TARGET AT THIS LEVEL
	HLLZ	TB,ARGLST(TB)	;ONE THERE ALREADY?
	JUMPN	TB,P118.4	;YES
P119.5:	PUSHJ	PP,GETTAG	;NO, GET ONE
	ANDI	CH,077777
	JUMPE	CH,P119.5
	MOVE	TB,CLEVEL
	HRLM	CH,ARGLST(TB)
	JRST	P118.6
; "AND" IN IF-STATEMENT
;DEFINE FALSE-TARGET AT THIS LEVEL,
;OUTPUT GOIF-FALSE,
;AND OUTPUT TRUE-TARGET TAGS AT HIGHER LEVELS.

	INTER.	PA120.
PA120.:	FLAGAT	HI
	HRRZ	TA,CLEVEL
	SKIPGE	TA,ARGLST(TA)	;NOT FLAG ON?
	JRST	P121.0		;YES
P120.0:	PUSHJ	PP,PA118.	;OUTPUT AND CODES
P120.1:	PUSHJ	PP,PA131.	;OUTPUT T-TAGS AT HIGHER LEVELS
	SOSLE	CTR
	JRST	P120.1
P120.2:	MOVEI	TA,OPIF		;[1635] This indicates to PCA94A that we had
	MOVEM	TA,OPRTR+1	;[1635] an AND or OR following an IF
	SKIPN	TA,TRMLVL	;COMING DOWN FROM HIGHER LEVEL?
	POPJ	PP,		;NO
P120.3:	ADD	TA,CLEVEL	;YES
	MOVE	TB,ARGLST(TA)	;CLEAR NOT BIT AT ALL UPPER LEVELS
	TLZ	TB,400000
	MOVEM	TB,ARGLST(TA)
	SOSE	TA,TRMLVL
	JRST	P120.3
	POPJ	PP,

; "OR" IN IF-STATEMENT
;DEFINE TRUE-TARGET AT THIS LEVEL (FALSE-TARGET IF NOT FLAG IS ON),
;OUTPUT GOIF-TRUE
;AND OUTPUT FALSE-TARGET TAGS AT THIS AND HIGHER LEVELS

	INTER.	PA121.
PA121.:	FLAGAT	HI
	HRRZ	TA,CLEVEL
	SKIPGE	TA,ARGLST(TA)	;NOT FLAG ON?
	JRST	P120.0		;YES
P121.0:	PUSHJ	PP,PA119.	;OUTPUT OR CODES
P121.1:	PUSHJ	PP,PA127.	;OUTPUT F-TAGS
	SOSL	CTR
	JRST	P121.1
	JRST	P120.2
	INTER.	PA122.
PA122.:	SOSGE	CLEVEL
	EWARNJ	E.261		;UNBALANCED PARINS
	AOS	TRMLVL
	POPJ	PP,


	INTER.	PA123.
PA123.:	SKIPG	EVALFL		;LOOKING FOR IMPERATIVE STMT IN EVALUATE?
	JRST	P123.0		; NO
	MOVE	TB,IMPLOP	;SELECTION SUBJ/OBJ
	MOVEM	TB,EVLNCP##	;STORE LN, CP FOR EVALUATE OP CODE
P123.0:	SKIPG	CLEVEL		;ALL PARINS CLOSED?
	JRST	P123.3		;YES
P123.4:	EWARNW	E.261		;NO
	SOSLE	CLEVEL
	JRST	P123.4		;TELL HIM ABOUT ALL OF THEM
P123.3:	PUSHJ	PP,PA118.	;OUTPUT AND CODES
P123.1:	PUSHJ	PP,PA131.	;OUTPUT ALL TRUE-TAGS
	SOSL	CTR
	JRST	P123.1
	HRRZ	TA,ARGLST
	HRRZ	TB,IFLVL
	ADD	TB,SPFLVL
	HRRZM	TA,ARGL2-1(TB)
	SETZM	CLEVEL
	SETZM	TOPLVL
	SETZM	ARGLST
	MOVE	TA,[XWD	ARGLST,ARGLST+1]
	BLT	TA,ARGLST+13
	HRRZI	TB,76		;END-CONDITION OP CODE
	PUSHJ	PP,P198.E
	JRST	PA0.

SETCTR:	MOVEI	TB,IF.DEP-1	;MAX LENGTH OF ARGLST - 1
	SUB	TB,CLEVEL	;LESS WHERE WE ARE NOW
	MOVEM	TB,CTR		;EQUALS PART OF LIST TO CHECK
	POPJ	PP,


	INTER.	PA125.
PA125.:	HRRZI	TA,52		;'CSUB' OP CODE
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.UNM##	;UNARY MINUS
	JRST	PA22.
	INTER.	PA126.
PA126.:	TSWF	FEXPR;
	JRST	P126.A
	AOS	TA,CLEVEL
	CAILE	TA,IF.DEP	;ARGLST OVERFLOW?
	JRST	P126.B		;YES
	AOS	TOPLVL
	SETZ	TB,
	TSWFZ	FNOTF;
	HRLZI	TB,4B20
	HLLZ	TC,ARGLST-1(TA)	;NOT ON AT LOWEL LEVEL?
	TLZ	TC,377777
	XOR	TB,TC		;IF SO, COMPLEMENT NOT AT CURRENT LEVEL
	MOVEM	TB,ARGLST(TA)
	POPJ	PP,
P126.A:	AOS	ELEVEL
	HRRZI	TA,70		;'(' OP CODE
SETOP0:	PUSHJ	PP,SETOP1
	JRST	PA22.

P126.B:	EWARNW	E.324
	JRST	PA133.

;OUTPUT FALSE-TARGET TAG AT LEVEL=CLEVEL+CTR

	INTER.	PA127.
PA127.:	HRRZ	TA,CLEVEL	;DESIRED LEVEL
	ADD	TA,CTR
	HRRZ	TC,ARGLST(TA)	;F-TARGET
	HLRM	TC,ARGLST(TA)	;CLEAR ENTRY
P127.A:	ANDI	TC,077777	;GET TARGET TAG
	JUMPE	TC,CPOPJ	;NONE THERE
	SKIPE	PERFAB		;ARE WE IN PERFORM ... WITH TEST AFTER?
	HRRM	TC,PERFAB	;YES, NEEDED FOR VARYING CASE
	HRLZ	TB,TC
	JRST	P198.D		;TAGNAM OP CODE


	INTER.	PA128.
PA128.:	SOSGE	ELEVEL
	JRST	P128.A
P128.Q:	HRRZI	TA,71		;')' OP CODE
	JRST	SETOP0
P128.A:	SETZM	ELEVEL
	PUSHJ	PP,PA24.
	PUSHJ	PP,PA132.
	JRST	PA0.
;DEFINE FALSE-TARGET

	INTER.	PA129.
PA129.:	HRRZ	TA,CLEVEL	;TAG THERE ALREADY?
	HRRZ	TC,ARGLST(TA)
	ANDI	TC,077777
	JUMPN	TC,P129.A	;YES
	PUSHJ	PP,GETTAG	;NO, GET A NEW ONE
	ANDI	CH,077777
	JUMPE	CH,.-2
	HRRZ	TA,CLEVEL	;OUTPUT GOIF-FALSE
	HRRZ	TC,ARGLST(TA)
	IOR	TC,CH
	HRRM	TC,ARGLST(TA)
P129.A:	MOVE	TA,[XWD	IMPLOP,OPRTR]
	BLT	TA,OPRTR+1
	SETO	TA,		;'GO TO IF FALSE' FLAG
	JRST	P130.B

;DEFINE TRUE-TARGET

	INTER.	PA130.
PA130.:	HRRZ	TA,CLEVEL	;TAG THERE ALREADY?
	HLRZ	TC,ARGLST(TA)
	ANDI	TC,077777
	JUMPN	TC,P130.A	;YES
	PUSHJ	PP,GETTAG	;NO, GET A NEW ONE
	ANDI	CH,077777
	JUMPE	CH,.-2
	HRRZ	TA,CLEVEL	;PUT IT ON THE LIST AT THIS LEVEL
	HLRZ	TC,ARGLST(TA)
	IOR	TC,CH
	HRLM	TC,ARGLST(TA)
P130.A:	MOVE	TA,[XWD	IMPLOP,OPRTR]
	BLT	TA,OPRTR+1
	SETZ	TA,		;'GO TO IF TRUE' FLAG
P130.B:	DPB	TA,OP.FLS##
	DPB	TC,OP.TRG	;TARGET TAG
	MOVSI	TA,OPM.IF##	;GET COMPLEMENT MASK
	TSWFZ	FNOTF		;NOT SEEN ALSO
	XORM	TA,OPRTR	;YES, SWAP TEST
	PUSHJ	PP,PA22.	;OUTPUT OPCODE
	MOVE	TC,CLEVEL
	SKIPGE	ARGLST(TC)	;IF NOT ON AT THIS LEVEL
	POPJ	PP,		;LEAVE IT ALONE
	MOVSI	TC,4		;ELSE
	ANDCAM	TC,IMPLOP	;TURN NOT OFF FOR ABREV. LIST
	POPJ	PP,
;OUTPUT TRUE-TARGET TAG AT LEVEL=CLEVEL+CTR

	INTER.	PA131.
PA131.:	HRRZ	TA,CLEVEL	;AIM AT DESIRED LEVEL
	ADD	TA,CTR
	HLRZ	TC,ARGLST(TA)	;T-TARGET
	HRRZI	TB,(TC)		;CLR TAG FROM ENTRY
	ANDI	TB,7B20
	HRLM	TB,ARGLST(TA)
	JRST	P127.A		;OUTPUT TAG

	INTER.	PA132.
PA132.:	MOVE	TA,ELEVEL
	ADDM	TA,CLEVEL
	SOSGE	ELEVEL
	JRST	.+3
	PUSHJ	PP,P128.Q
	JRST	.-3
	SETZM	ELEVEL
	HRRZI	TA,73		;'END EXPRESSION' OP CODE
	SWOFF	FEXPR+FARITH
	HRRZ	TB,CLEVEL
	SKIPGE	TC,ARGLST+1(TB)
	SWON	FNOTF;
	JRST	SETOP0
	INTER.	PA133.
PA133.:	HRRZI	DW,E.306
	PUSHJ	PP,PA133S

;9-FEB-81 /DAW: Add two SETZM's to clear "IF" levels
; if the program gets a syntax error. (Otherwise the compiler
; gets very confused since IFLVL is non-zero at the start of
; the next statement!).
	SETZM	IFLVL		;Don't leave these up-in-the-air.
	SETZM	SPFLVL		; . .
	HRRZI	DW,E.307
P133EX:	SWOFF	FREGWD;
	PUSHJ	PP,GETITM
	TSWF	FEOF;
	JRST	PA24.
	JRST	PA148.


;[1062] Avoid fatal errors on NOTE with COPY REPLACING
;[1062] turn off replacing because NOTE text is simply dumped
;[1062] to the output text buffer instead of parsed.
;[1062] Both flags will be turned on by RPLTST for next input
;[1062] Cobol library COPY member which is subject to REPLACING.

PA133S:	SWOFF	FRTST!FNOCPY	;[1062] [1033] TURN OFF COPY REPLACING FLAGS
	SETOM	ERSKIP##	;Set parse flag that says we skipped to
				; next period

;22-AUG-79 /DAW  HOPEFULLY THE NEXT TWO LINES OF CODE WILL
;	IMPROVE ERROR RECOVERY SO IF PERIOD IS SEEN AT THE WRONG
;	TIME, THE NEXT TOKEN WILL BE PARSED AS IF IT WERE THE START
;	OF A STATEMENT.. THE COMPILER USED TO SKIP THE PARSING OF THE
;	NEXT STATEMENT.

	CAIN	TYPE,PRIOD.	;IF ALREADY AT PERIOD, DON'T DO ANYTHING
	 JRST	P133.X
	SWON	FARITH;
P133.1:	PUSHJ	PP,SKPSRC
	TSWF	FEOF;
	JRST	P133.X
	CAIN	CP,7
	JRST	P133.3		;START OF NON-CONTINUATION LINE
P133.2:	CAIN	CH,"."
	JRST	P133.5		;PERIOD IN B-MARGIN
	CAIE	CH," "
	JRST	P133.1		;JUST A CHARACTER
	MOVE	TA,SAVBLN##
	JUMPE	TA,P133.4	;IF 0, SAVBLN NOT IN USE 
	MOVEM	TA,BLNKLN##
	MOVE	TA,SAVBCP##
	MOVEM	TA,BLNKCP##
P133.4:	PUSHJ	PP,SKPSRC
	CAIN	CP,7
	JRST	P133.3		;A-MARGIN
	CAIE	CH," "
	JRST	P133.2
	JRST	P133.4		;ANOTHER IN A STRING OF BLANKS

P133.3:	PUSHJ	PP,SKPSRC	;GET CHARACTER IN THE A-MARGIN
	TSWF	FEOF;
	JRST	P133.X
	CAIL	CP,^D12
	JRST	P133.2		;NOW IN B-MARGIN
	CAIN	CH," "
	JRST	P133.3		;A SPACE
	CAIL	CH,"0"
	CAILE	CH,"9"
	SKIPA			;NOT A DIGIT
	JRST	P133.E		;POSSIBLY A PROCEDURE-NAME
	CAIL	CH,"A"
	CAILE	CH,"Z"
	JRST	P133.2		;SOME GARBAGE IN A-MARGIN--TREAT AS B-MARGIN
P133.E:	PUSHJ	PP,DE125.
	SWON	FREGCH;
P133.X:	SWOFF	FARITH;
	POPJ	PP,

P133.5:	PUSHJ	PP,SKPSRC
	CAIE	CH," "
	JRST	P133.1
	SWOFF	FNEEDS;
	JRST	P133.X		;PERIOD FOLLOWED BY SPACE
	INTER.	PA134.
PA134.:	HRRZI	TA,40		;'STOP' OP CODE
	JRST	SETOP1

PA135.:	SETO	TA,
	DPB	TA,OP.RUN	;SET 'RUN' BIT IN OPERATOR
	POPJ	PP,

PA137.:	MOVE	TA,ARG1+1
	DPB	TA,OP.LNC	;PUT LN, CP IN OPERATOR
	HRRZI	TA,101		;OP CODE FOR PARAGRAPH OPERATOR
	JRST	SETOP3
	INTER.	PA138.
PA138.:	TSWF	UNCONT;
	JRST	A831AP
	PUSHJ	PP,PA25.
	MOVE	TA,OPRTR
	MOVE	TB,OPRTR+1
	TLO	TA,200
	PUSHJ	PP,PUTGEN
A831AP:	SKIPN	CURSEC		;ANY SECTIONS?
	JRST	PA138A		;NO --- THEN NO SEGMENT BREAK, ALL RESIDENT
	MOVSI	TA,104000
	DPB	W2,[POINT	20,TA,35]
	HRRZI	TB,104		;SEGMENT BREAK
	PUSHJ	PP,PUTGEN
PA138A:	MOVE	TA,GENWRD	;SAVE WORD NUMBER OF
	MOVEM	TA,ARG2		;ENDIT OPERATOR
	MOVE	TA,[XWD	377003,777607]
	HRRZI	TB,377		;ENDIT OPERATOR
	PUSHJ	PP,PUTGEN
IFE TOPS20,<
	CLOSE	GEN,2		;CLOSE OUTPUT SIDE
>
IFN TOPS20,<
	PUSHJ	PP,PUTGN1##	;Write out last partial buffer
	PUSHJ	PP,CLSGEN##	; And close file
>
	SETZM	CURPAR
	SETZM	CURSEC
	HRRZ	TA,FLOLOC##	;BEGINNING OF FLOTAB
	AOJA	TA,P138Z1	;NOW POINTS TO ENTRY PROPERLY
				;ENTER ROUTINE TO CLEAR UP
P138FZ:	HRRZ	TA,CURFLO
	ADDI	TA,SZ.FLO	;NEXT ENTRY
P138Z1:	HRRZ	TB,FLONXT##	;FIRST UNUSED PROTAB ENTRY
	CAILE	TA,(TB)
	JRST	FLODN
	HRRZM	TA,CURFLO
	LDB	TB,FL.TAG##	;Is it a link to TAGTAB ?
	JUMPN	TB,P138FZ	;If so, skip it
	LDB	TB,FL.PND	;PROCEDURE-NAME DEFINITION FLAG
	JUMPE	TB,P138F2	;NOT PROCEDURE-NAME DEFINITION
	LDB	TA,FL.PRO	;PROTAB LINK
	PUSHJ	PP,LNKSET	;GET ABS. ADDR.
	HRRZ	TB,CURFLO	;FLOTAB ENTRY ABS. ADDR.
	HRL	TA,(TB)		;PUT PROTAB REL. ADDR. IN TA L. H.
	LDB	TC,PR.SEC	;PARAGRAPH/SECTION FLAG
	JUMPE	TC,P138F1	;JUMP IF SECTION
	MOVEM	TA,CURPAR	;SAVE LINK OF CURRENT PARAGRAPH
	JRST	P138FZ		;GET NEXT ENTRY

P138F1:	SETZM	CURPAR		;THIS ENTRY IS A SECTION
	MOVEM	TA,CURSEC	;SAVE LINK OF CURRENT SECTION
	JRST	P138FY

P138F2:	LDB	TB,FL.QUA##	;QUALIFIED ENTRY?
	JUMPN	TB,PF2Q		;YES
	PUSHJ	PP,RESLVU	;NO --- RESOLVE
	JRST	PF2
PF2Q:	PUSHJ	PP,RESLVQ	;RESOLVE QUALIFIED ENTRY
PF2:	MOVEM	TA,SAVETA##
	LDB	TA,FL.PRO
	JUMPE	TA,PF2.1
	PUSHJ	PP,LNKSET
	LDB	TB,PR.MDF
	JUMPN	TB,MDF138
	LDB	TB,PR.DEF
	JUMPE	TB,P138FY	;NOT DEFINED
PF2.1:	MOVE	TA,SAVETA
	LDB	TB,FL.SAL##	;SUBJECT OF ALTER?
	JUMPE	TB,PF3		;NO
	MOVEM	TA,SAVETA	;SAVE FLOTAB ENTRY ADDRESS
	LDB	TA,FL.PRO	;PROTAB LINK
	MOVEM	TA,TBLOCK+17	;SAVE IT
	JUMPE	TA,P138FZ	;ENTRY WAS NOT RESOLVED
	PUSHJ	PP,LNKSET
	LDB	TB,PR.ALT	;ALTERABLE?
	JUMPN	TB,P138FZ	;YES --- CONTINUE
	HRRZI	DW,E.113	;DIAGNOSTIC 113.
E138:	MOVE	TA,SAVETA
	LDB	LN,FL.LN##	;LINE NUMBER
	LDB	CP,FL.CP##	;CHARACTER POSITION
IFN DEBUG,<
	PUSHJ	PP,WARN
>
IFE DEBUG,<
	PUSHJ	PP,FATAL##
>
P138FY:	SETZM	TBLOCK+17
	JRST	P138FZ
MDF138:	HRRZI	DW,E.187	;DIAGNOSTIC 187.
	JRST	E138
PF3:	LDB	TB,FL.OAL##	;OBJECT OF ALTER?
	JUMPE	TB,PF6		;NO
	LDB	TA,FL.PRO
	JUMPE	TA,PF3E		;ENTRY WAS NOT RESOLVED
	PUSHJ	PP,LNKSET	;ADDRESS OF OBJECT'S PROTAB ENTRY
	LDB	TB,PR.PRI	;PRIORITY OF OBJECT
	MOVEM	TB,TBLOCK+16	;SAVE
	MOVE	TA,TBLOCK+17
	JUMPE	TA,P138FZ	;NO SUBJECT SAVED
	PUSHJ	PP,LNKSET	;ADDRESS OF SUBJECT'S PROTAB ENTRY
	SETO	TD,
	HRRZ	TC,TBLOCK+16	;PRIORITY OF OBJECT
	LDB	TB,PR.PRI	;PRIORITY OF SUBJECT
	CAME	TB,TC		;SAME AS THAT OF OBJECT?
	JRST	PF5		;NO
	DPB	TD,PR.ARS##	;ALTERED TO SAME SEGMENT
	JRST	P138FY

PF5:	DPB	TD,PR.ANR##	;ALTERED TO DIFFERENT SEGMENT
	JRST	P138FY

PF6:	LDB	TB,FL.OPF##	;OBJECT OF PERFORM?
	JUMPE	TB,P138FY	;NO
	LDB	TA,FL.PRO
	JUMPE	TA,P138FY	;ENTRY WAS NOT RESOLVED
	PUSHJ	PP,LNKSET
	SETO	TB,
	DPB	TB,PR.EXR##	;SET EXIT REQUIRED BIT
	JRST	P138FY

PF3E:	PUSHJ	PP,P138FE
	JRST	P138FY
RESLVU:	LDB	TA,FL.NAM##	;NAMTAB POINTER
	HRRZI	TB,CD.PRO
	PUSHJ	PP,FNDLNK	;IS THERE A PROTAB LINK FOR THIS NAME?
	  JRST	P138FE		;N0--UNDEFINED
	SETZM	TBLOCK+2	;PTR TO PARAGRAPH IN THIS SECTION
	SETZM	TBLOCK+3	;PTR TO PARAGRAPH IN ANOTHER SECTION
	SETZM	TBLOCK+4	;PTR TO SECTION OF THIS NAME
	SETZM	TBLOCK+5	;0 UNLESS MORE THAN ONE PARAGRAPH OF
				;THIS NAME IN OTHER SECTIONS
P138F8:	MOVEM	TB,CURPRO	;SAVE LINK FOUND
	HRRZ	TA,TB
	LDB	TC,PR.SEC	;SECTION/PARAGRAPH FLAG
	JUMPN	TC,P138F3	;JUMP IF PARAGRAPH
	SKIPE	TBLOCK+4	;HAVE WE SEEN A SECTION BEFORE?
	JRST	P138E1		;YES---ERROR
	MOVEM	TB,TBLOCK+4	;NO, SAVE THIS LINK
	JRST	P138F5
P138F3:	LDB	TD,PR.LSC	;SECTION LINK FROM PROTAB ENTRY
	HRLS	TD		;PUT LINK ALSO IN LEFT HALF
	XOR	TD,CURSEC
	TLNE	TD,777777	;IS IT THE CURRENT SECTION?
	JRST	P138F4		;NO
	SKIPE	TBLOCK+2	;IS THERE A PARAGRAPH OF THIS NAME
				;IN THE CURRENT SECTION?
	JRST	P138E2		;YES---ERROR
	MOVEM	TB,TBLOCK+2	;NO, SAVE LINK
	JRST	P138F5

P138F4:	SKIPE	TBLOCK+3	;PARAGRAPHS OF THIS NAME IN OTHER SECTS?
	SETOM	TBLOCK+5	;YES--SET FLAG WORD
	MOVEM	TB,TBLOCK+3	;SAVE LINK
P138F5:	PUSHJ	PP,FNDNXT	;FIND ANOTHER PROTAB LINK
	  JRST	.+2		;NO--NOW EVALUATE
	JRST	P138F8		;YES---PROCESS
	HRRZ	TA,CURFLO	;FLOTAB ENTRY ABS. ADDR.
	SKIPN	TC,TBLOCK+2	;PARAGRAPH IN CURRENT SECTION?
	JRST	P138F6		;NO
	SKIPE	TBLOCK+4	;YES--WAS THERE A SECTION OF THIS NAME?
	JRST	P138E3		;YES---ERROR
P138F7:	HLRS	TC		;GET LINK IN RIGHT HALF
	DPB	TC,FL.PRO	;AND PUT IN FLOTAB
	POPJ	PP,
P138F6:	SKIPE	TC,TBLOCK+4	;ANY SECTION OF THIS NAME?
	JRST	P138F7		;YES---PUT IN FLOTAB
	SKIPN	TC,TBLOCK+3	;NO--ANY PARAGRAPHS IN OTHER SECTIONS?
	JRST	P138E4		;NO---ERROR
	SKIPE	TBLOCK+5	;MORE THAN 1 PARAGRAPH OF THIS NAME?
	JRST	P138E2		;YES---ERROR
	JRST	P138F7		;NO--PUT IN FLOTAB

P138E1:	HRRZI	DW,E.178
P138EE:	HLRS	TC
	HRRZ	TA,CURFLO	;[1311] FLOTAB ENTRY ADDRESS
	DPB	TC,FL.PRO	;ASSUMED MEANING
P138EF:	LDB	LN,FL.LN	;GET LINE NUMBER AND
	LDB	CP,FL.CP	;CHARACTER POSITION FROM FLOTAB
IFN DEBUG,<
	PUSHJ	PP,WARN
>
IFE DEBUG,<
	PUSHJ	PP,FATAL
>
	MOVE	TA,CURFLO
	POPJ	PP,

P138E2:	HRRZI	DW,E.179
	JRST	P138EE

P138E3:	HRRZI	DW,E.180
	JRST	P138EE

P138E4:	HRRZI	DW,E.181
	JRST	P138EE

P138FE:	MOVE	TA,[SIXBIT	/UNDEF;/]
	MOVEM	TA,NAMWRD
	SETZM	NAMWRD+1
	SETZM	NAMWRD+2
	SETZM	NAMWRD+3
	SETZM	NAMWRD+4
	PUSHJ	PP,TRYNAM##
	  JRST	FE1381
	MOVEM	TA,CURNAM##
	HLRZS	TA
	HRRZI	TB,CD.PRO
	PUSHJ	PP,FNDLNK
	  JRST	FE1382
	HRRZ	TA,CURFLO
	HLRS	TB
	DPB	TB,FL.PRO
	HRRZI	DW,E.181
	JRST	P138EF
FE1381:	PUSHJ	PP,BLDNAM
	MOVEM	TA,CURNAM
FE1382:	MOVE	TA,[XWD	CD.PRO,SZ.PRO]
	PUSHJ	PP,GETENT
	HLRM	TA,CURNAM
	HLRZ	TB,CURNAM	;NAMTAB POINTER
	ANDI	TB,077777
	IORI	TB,CD.PRO*1B20
	HRLZM	TB,(TA)
	HLRZ	TB,TA
	HRRZ	TA,CURFLO
	DPB	TB,FL.PRO
	MOVS	TA,CURNAM
	PUSHJ	PP,PUTLNK
	MOVE	TA,CURFLO
	HRRZI	DW,E.181
	JRST	P138EF
FLODN:	HRRZ	TC,SECLOC
	ADDI	TC,1
	HRLI	TC,TD
	MOVEM	TC,PNTR
	SETZB	TD,TBLOCK	;WILL HOLD WORD NUMBER OF LOWEST SEGMENT
	SETZM	TBLOCK+1	;R. H. POINTS TO LAST SECTION OF MOST RECENT SEGMENT
P138S1:	MOVE	TA,@PNTR	;GET SEGTAB ENTRY
	JUMPE	TA,P138S9	;NOTHING FOR THIS SEGMENT
	SKIPE	TBLOCK		;ANYTHING AT ALL SEEN BEFORE?
	JRST	P138S2		;YES
	ADDI	TD,1
	MOVE	TB,@PNTR	;GENFIL BLOCK FOR THIS SEGMENT
	MOVEM	TB,TBLOCK
	MOVEM	TA,TBLOCK+1
	AOJA	TD,P138S3
P138S2:	MOVEM	TD,TBLOCK+2
	EXCH	TA,TBLOCK+1	;NEW 'LAST SEGMENT SEEN' POINTER
	PUSHJ	PP,LNKSET
	MOVE	TD,TBLOCK+2
	ADDI	TD,1
	MOVE	TB,@PNTR	;GENFIL WORD NUMBER FOR NEW SEGMENT
	DPB	TB,PR.GNW	;INTO OLD SECTION PROTAB ENTRY
	AOJA	TD,P138S3
P138S9:	ADDI	TD,2
P138S3:	CAIG	TD,306		;198.
	JRST	P138S1
	SKIPE	TBLOCK		;SKIP IF NO SEGMENTS
	JRST	P138S4
	MOVEI	TA,100
	HRLM	TA,PROGST##
	JRST	PRODN

P138S4:	HRRZ	TB,TBLOCK
	JUMPN	TB,.+2
	HRRZI	TB,100
	HRLM	TB,PROGST	;BLOCK NUMBER OF LOWEST SEGMENT IN PROGST L.H.
	MOVE	TA,TBLOCK+1
	JUMPE	TA,PRODN
	PUSHJ	PP,LNKSET
	MOVE	TB,ARG2		;ENDIT WORD NUMBER
	DPB	TB,PR.GNW	;PUT IN LAST SECTION OF LAST SEGMENT
PRODN:	PUSHJ	PP,CLEAND##	;CLEAN UP AFTER THE PHASE
	PUSHJ	PP,CLENTA##	;CLEAN UP TABLES
	ENDFAZ	D
RESLVQ:	HRRZ	TA,CURFLO
	ADDI	TA,SZ.FLO	;QUALIFICATION ENTRY ADDRESS
	LDB	TA,FL.NAM	;NAMTAB POINTER OF QUALIFIER
	HRRZI	TB,CD.PRO
	PUSHJ	PP,FNDLNK	;FIND PROTAB LINK
	  JRST	P138QE		;THERE IS NONE
P138Q2:	LDB	TC,PR.SEC	;PARAGRAPH/SECTION FLAG
	JUMPE	TC,P138Q3	;JUMP IF THIS IS A SECTION
	PUSHJ	PP,FNDNXT	;FIND NEXT ENTRY
	  JRST	P138QE		;NO MORE
	JRST	P138Q2

P138Q3:	MOVEM	TB,TBLOCK+6	;SAVE LINK TO SECTION PROTAB ENTRY
	HRRZ	TA,CURFLO
	LDB	TA,FL.NAM	;NAMTAB POINTER FOR QUALIFIED ITEM
	HRRZI	TB,CD.PRO
	PUSHJ	PP,FNDLNK	;FIND A PROTAB ENTRY FOR IT
	  JRST	P138QE		;NONE
P138Q4:	LDB	TC,PR.SEC	;PARAGRAPH/SECTION FLAG
	JUMPN	TC,P138Q6	;JUMP IF PARAGRAPH
P138Q5:	PUSHJ	PP,FNDNXT	;ANY MORE ENTRIES?
	  JRST	P138QE		;NO--COULD NOT RESOLVE IT
	JRST	P138Q4		;YES--TEST IT

P138Q6:	LDB	TD,PR.LSC	;GET SECTION LINK FOR THIS PARAGRAPH
	HLRZ	TC,TBLOCK+6	;GET LINK TO QUALIFIER ENTRY
	CAME	TC,TD		;ARE THEY THE SAME?
	JRST	P138Q5		;NO--TRY FURTHER
	HLRS	TB
	HRRZ	TA,CURFLO	;SET UP TA
	DPB	TB,FL.PRO	;RESOLVED IT
P138Q7:	MOVE	TA,CURFLO
	MOVE	TB,TA
	ADD	TB,[XWD	SZ.FLO,SZ.FLO]
	MOVEM	TB,CURFLO	;SET UP CURFLO TO IGNORE QUALIFIER ENTRY
	POPJ	PP,

P138QE:	PUSHJ	PP,P138FE
	JRST	P138Q7
	INTER.	PA140.

;[12B] SPECIAL IFS THAT DON'T NEED THE PHASE E HLDTAB ENTRY
;    GENERATED FOR THEM.
PA140.:	SKIPG	SPFLVL
	POPJ	PP,		;NO SPIF ACTIVE
	SETOM	SPFNIO##	;SPECIAL IF, NOT FOR I-O
	SKPNAM			;CONTINUE AT PA139.

	INTER.	PA139.
PA139.:	SKIPG	SPFLVL
	POPJ	PP,		;NO SPIF ACTIVE
	SKIPN	REINTO		;'INTO' SEEN?
	JRST	PA139A		;NO
	PUSHJ	PP,GETTAG	;GET A TAG SO 'AT END' SKIPS 'INTO' CODE
	ANDI	CH,077777
	JUMPE	CH,.-2
	PUSH	PP,CH		;SAVE IT FOR A MINUTE
	HRLZI	TB,(CH)		;OUTPUT A JUMP TO THIS TAG
	HRRI	TB,74
	HRLI	TA,074000
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
PA139A:	MOVE	TA,SPFLVL
	ADD	TA,IFLVL
	HLLZ	TB,ARGL2-1(TA)		;TARGET FOR SPIF
	JUMPE	TB,P139.E
	HRLM	TB,ARGL2-1(TA)		;REMOVE ENTRY
	HRLZI	TA,102000		;TAGNAM OP CODE
	HRRI	TB,102
	PUSHJ	PP,PUTGEN
P139.X:	SOS	SPFLVL
	SWOFF	UNCONT;
	HRRZI	TA,26		;'ENDIF' OP CODE
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.SPI##	;SPECIAL IF
	MOVE	TA,SPFNIO##	;SEE IF SPECIAL IF, NOT I-O
	DPB	TA,OP.SPN##	; SEE FLAG IN OPERAND
	SETZM	SPFNIO##	;CLEAR FLAG

	SKIPN	REINTO		;'INTO' SEEN?
	JRST	PA22.		;NO
	PUSHJ	PP,PA22.	;OUTPUT THE ENDIF
	POP	PP,CH		;GET BACK THAT TAG
PA139X:	HRLZI	TB,(CH)		;OUTPUT TAGNAM
	HRRI	TB,102
	HRLI	TA,102000
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	JRST	PUTGEN

P139.E:	SKIPN	ARGL2-1(TA)
	JRST	P139.F
	OUTSTR	[ASCIZ /PA139.: ENDSPIF encountered, but ENDIF expected
/]
	TRNA
P139.F:	OUTSTR	[ASCIZ /PA139.: ENDSPIF encountered, but ARGL2 entry null
/]
	EWARNW	E.260
	JRST	KILL
	INTER.	PA141.
PA141.:	SETO	TA,
	DPB	TA,OP.MAC##	;SET 'MACRO' BIT
	POPJ	PP,

	INTER.	PA143.
PA143.:	SETZ	TA,
	DPB	TA,OP.COB##	;SET 'COBOL' FLAG
	POPJ	PP,

	INTER. PA143A
PA143A:	PUSHJ	PP,PA143.	; SET UP COBOL FLAG [171]
	JRST	PA248A		; GO SET UP CALL OPERAND [171]

	INTER.	PA145A
PA145A:
IFN DBMS,<
	SKIPN	SCHSEC##	;IS THIS A DBMS PROGRAM?
	EWARNW	E.431		;NO, DECL IS IN WRONG PLACE
>
	SKPNAM			;PROCEED AS NORMAL

	INTER.	PA145.
PA145.:	SETOM	DECLR.		; [324] SET DECLARATIVES IN PROGRAM
	DPB	LN,[POINT 13,DECLR.,28]	;[552] SAVE LINE NUMBER
	DPB	CP,[POINT 7,DECLR.,35]	;[552] AND CHAR. POS.
	SWON	INDECL
	HRRZI	TA,14		;[435] SET DECLARITIVES START OP CODE
	JRST	PA147A

	INTER.	PA147.
PA147.:	SWOFF	INDECL
	HRRZI	TA,15		;[435] END DECLARITIVES OP CODE
PA147A:	PUSHJ	PP,SETOP	;[435] SET UP OPERAND
				;AT "DECLARATIVES" OR "END DECLARATIVES":
	SETZM	INUPRG		; WE'RE NOT IN A USE PROCEDURE FOR A
				;REPORT GROUP RIGHT NOW.
	JRST	PA22.		;[435] PUT INTO GENFIL

	INTER.	PA148.
PA148.:	SWON	FPERWD!FREGWD	;RETURN PERIOD
	POPJ	PP,

	INTER.	PA148A		;[1556] IF IT IS A PERIOD
PA148A:	SWOFF	FPERWD!FREGWD	;[1556] GET THE NEXT TOKEN
	POPJ	PP,		;[1556]

	INTER.	PA149.
PA149.:	SWOFF	FREGWD;
	POPJ	PP,
	INTER.	PA150.
PA150.:	MOVE	TA,FL.OGO##	;OBJECT OF GO
FLENT.:	MOVEM	TA,PNTR
	MOVE	TA,[XWD	CD.FLO,SZ.FLO]
	PUSHJ	PP,GETENT	;GET A FLOTAB ENTRY
	MOVEM	TA,CURFLO
	SETO	TB,
	DPB	TB,PNTR		;SET TYPE OF ENTRY FLAG
	TSWF	INDECL;
	DPB	TB,FL.RDC	;REFERENCED IN DECLARATIVES
	MOVE	TB,ARG1+1	;GETSRC W2
	DPB	TB,FL.NLC##	;NAMTAB POINTER, LN, CP
	TLO	TB,400000	;SET FLOTAB REFERENCE BIT
	MOVEM	TB,ARG1+1	;IN OPERAND
	HLRM	TA,ARG1		;PUT FLOTAB POINTER IN OPERAND
	POPJ	PP,

	INTER.	PA151.
PA151.:	MOVE	TA,ARG1
	MOVEM	TA,TBLOCK+23
	MOVE	TA,ARG1+1
	MOVEM	TA,TBLOCK+24
	SETZM	ARG1
	SETZM	ARG1+1
	POPJ	PP,

	INTER.	PA152.
PA152.:	MOVE	TA,TBLOCK+23
	MOVEM	TA,ARG1
	MOVE	TA,TBLOCK+24
	MOVEM	TA,ARG1+1
	POPJ	PP,

	INTER.	PA153.
PA153.:	HRRZ	TA,CURFLO
	SETO	TB,
	DPB	TB,FL.QUA##
	POPJ	PP,

	INTER.	PA154.
PA154.:	MOVE	TA,FL.SAL	;'SUBJECT OF ALTER'
	JRST	FLENT.

	INTER.	PA155.
PA155.:	MOVE	TA,FL.OAL##	;'OBJECT OF ALTER'
	JRST	FLENT.


	INTER.	PA156.
PA156.:	MOVE	TA,FL.SPF##	;'SUBJECT OF PERFORM'
	JRST	FLENT.

	INTER.	PA157.
PA157.:	MOVE	TA,FL.OPF##	;'OBJECT OF PERFORM'
	JRST	FLENT.

	INTER.	PA158.
PA158.:	MOVE	TA,FL.DEB##	;'OBJECT OF USE FOR DEBUGGING'
	JRST	FLENT.

	INTER.	PA159.
PA159.:	MOVE	TA,ARG1+1
	TLNN	TA,400000	;FLOTAB ENTRY?
	POPJ	PP,		;NO
	HRRZ	TA,ARG1
	ANDI	TA,077777
	HRRZ	TB,FLOLOC
	ADDI	TA,(TB)		;POINTS TO FLOTAB ENTRY FOR ARG1
	SETO	TB,
	DPB	TB,FL.OPF	;'OBJECT OF PERFORM' FLAG
	POPJ	PP,

	INTER.	PA160.
PA160.:	MOVE	TA,OPRTR
	MOVEM	TA,TBLOCK
	MOVE	TA,OPRTR+1
	MOVEM	TA,TBLOCK+1
	PUSHJ	PP,PA22.
	MOVE	TA,TBLOCK
	MOVEM	TA,OPRTR
	MOVE	TA,TBLOCK+1
	MOVEM	TA,OPRTR+1
	POPJ	PP,

	INTER.	PA161.
PA161.:	HRRZ	TA,CURDAT	;GET DATA-RECORD SPECIFIED
	LDB	TB,DA.RPW	;GET RPWTAB LINK
	SKIPE	TB		;IS THERE AN RPWTAB LINK
	EWARNW	E.787		;YES, MUST BE DEFINED IN REPORT SECTION, ERROR
	POPJ	PP,

	INTER.	PA162.
PA162.:	HRRZ	TA,CURFIL	;GET CURRENT FILE ENTRY
	LDB	TB,FI.ONE##
	SKIPE	TB		;IS THERE AN RD SEEN FOR THIS FILE ?
	EWARNW	E.787		;YES, GENERATE ERROR
	POPJ	PP,
	INTER.	PA163F
PA163F:	FLAGAT	HI
	SKPNAM

	INTER.	PA163.
PA163.:	TLNE	W1,40000	;SIGNED?
	EWARNW	E.25		;[467] YES
	LDB	TE,GWVAL	;SIZE
	MOVE	TA,[XWD NAMWRD,NAMWRD+1]
	SETZM	NAMWRD
	BLT	TA,NAMWRD+4
	MOVE	TB,[POINT	6,NAMWRD]
	MOVE	TA,[POINT	7,LITVAL]
PA163A:	ILDB	TC,TA
	SUBI	TC,40		;CONVERT TO SIXBIT
	IDPB	TC,TB
	SOJG	TE,PA163A
	TLZ	W2,GWDEF	;ENTER REF. TO NUMERIC PARA. NAME
	PUSHJ	PP,PUTCRF	;  IN CREF TABLE
	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM	;NOT FOUND
	HRRZ	W1,(TA)
	HLRZS	TA
	DPB	TA,[POINT	15,W2,15]
	DMOVEM	W1,ARG1
	POPJ	PP,


	INTER.	PA164.
PA164.:	MOVSI	TA,GWALL	;SET 'ALL' BIT IN ARG1
	IORB	TA,ARG1
	POPJ	PP,


	INTER.	PA165.
PA165.:	HRRZI	TA,105		;'YECCH!' OPERATOR
	PUSHJ	PP,SETOP3
	PUSHJ	PP,PA22.
	SETZM	ARG1
	SETZM	ARG1+1
	SETZM	NQUAL
	POPJ	PP,

	INTER.	PAYECC
PAYECC:	HRRZI	TA,105		;SET OPERATOR TO 'YECCH'
	JRST	SETOP3		; AND RETURN

	INTER.	PA166.
PA166.:	HRRZI	TA,4		;'SUBTRACT' OP CODE
	JRST	SETOP3


	INTER.	PA168.
PA168.:	HRRZI	TA,12		;'REMAIN' OP CODE
	JRST	SETOP
	INTER.	PA169.
PA169.:	HRRZI	TA,47		;'ENTER' OP CODE
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	JRST	SETOP1



	INTER.	PA170.
PA170.:	SETZM	GOTQUA##
	SKIPN	TA,NQUAL
	JRST	P170.1
	LDB	TA,[POINT 15,QUALT+1,15]	;ITEM'S NAMTAB POINTER
	HRRZI	TB,CD.DAT
	PUSHJ	PP,FNDLNK
	  JRST	P170.0		;MAY BE CONDITION-NAME
PA170A:	HLRM	TB,QUALT##
	PUSHJ	PP,DOQUAL
	  JRST	PA170B
	SKIPE	GOTQUA
	JRST	P170.2		;INSUFFICIENT QUALIFICATION
	HRRZM	TA,GOTQUA	;TA CONTAINS QUALT ON RETURN
PA170B:	PUSHJ	PP,LNKSET
	PUSHJ	PP,FNDNXT##	;FIND THE NEXT ITEM WITH THE SAME
				; NAME IN THE CURRENT TABLE.
	  SKIPA	TB,SAVE1##	;NO MORE IN THIS TABLE.
	JRST	PA170A		;GO SEE IF THIS NAME WORKS.
	CAIE	TB,CD.CON	;IF IT WAS CONTAB, WE'RE THROUGH.
	JRST	P170.0		;GO LOOK AT CONTAB.
PA170C:	SKIPN	TA,GOTQUA	;ANY FOUND?
	JRST	P170.1		;NO
PA170O:	HLL	TA,QUALT
	MOVEM	TA,ARG1
	HRLM	TA,CURDAT	;PUT RELATIVE OFFSET IN LH OF CURDAT
	PUSHJ	PP,LNKSET	;GET ABSOLUTE OFFSET
	HRRM	TA,CURDAT	;STORE IT IN RH OF CURDAT
	MOVE	TA,QUALT+1
	MOVEM	TA,ARG1+1
	SETZM	NQUAL
	POPJ	PP,
P170.0:	LDB	TA,[POINT	15,QUALT+1,15]		;ITEM'S NAMTAB POINTER
	HRRZI	TB,CD.CON
	PUSHJ	PP,FNDLNK
	  JRST	PA170C		;NO CONTAB LINK
	JRST	PA170A

P170.1:	HRRZI	DW,E.104	;NOT DEFINED
	JRST	PA170F		;HOP AROUND THE TWO LDB'S AT PA170E BECAUSE
				; QUALT+1 CONTAINS ZEROES WHEN THE DATA
				; FIELD IS NOT DEFINED

P170.2:	HRRZI	DW,E.60
PA170E:	LDB	LN,[POINT	13,QUALT+1,28]
	LDB	CP,[POINT	7,QUALT+1,35]
PA170F:
	IFN	DEBUG,<
	HRRZ	TA,OPRTR + 1	;IF OP CODE REPLACED,
	CAIE	TA,OPYECC	; THEN ERROR ALREADY GIVEN
	PUSHJ	PP,WARN
>
	IFE	DEBUG,<
	HRRZ	TA,OPRTR + 1	;IF OP CODE REPLACED,
	CAIE	TA,OPYECC	; THEN ERROR ALREADY GIVEN
	PUSHJ	PP,FATAL
>
	MOVEI	TA,<CD.DAT>B20+1	;ASSUME DUMMY DATAB ENTRY
	MOVEM	TA,QUALT
	DPB	LN,[POINT 13,QUALT+1,28] ;CARRY THIS LN AND CP BECAUSE THIS
	DPB	CP,[POINT  7,QUALT+1,35] ;IS ALL WE HAVE FOR A NOT DEFINED
					 ;ITEM
	JRST	PA170O
DOQUAL:	HRRZI	TA,1
	HRRZM	TA,CURQUA##	;CURRENT ENTRY NUMBER-1
	HRRZ	TA,QUALT
	JUMPE	TA,NOPOP
	HRLZM	TA,CURDAT##
	PUSHJ	PP,LNKSET
	HRRM	TA,CURDAT
	HRRZ	TC,CURQUA
DQULUP:	CAML	TC,NQUAL
	JRST	DOOUT
NXTPOP:	PUSHJ	PP,GETPOP	;FIND FATHER OF CURDAT ITEM
	  JRST	NOPOP		;FOUND NONE
	MOVEM	TA,CURDAT	;SAVE FATHER LINK
	LDB	TB,DA.NAM##	;FATHER'S NAMTAB LINK
	HRRZ	TC,CURQUA
	LSH	TC,1
	LDB	TD,[POINT	15,QUALT+1(TC),15]	;NAMTAB LINK OF ITEM SOUGHT
	CAME	TB,TD		;ARE THEY THE SAME?
	JRST	NXTPOP		;NO --- TRY HIGHER
	HLRM	TA,QUALT(TC)	;PUT LINK IN QUALT ENTRY
	AOS	TC,CURQUA
	JRST	DQULUP		;CHECK FOR MORE QUALIFIERS

DOOUT:	AOS	(PP)		;SKIP RETURN
NOPOP:	MOVE	TA,QUALT
	POPJ	PP,
GETPOP:	MOVE	TA,CURDAT
	JUMPE	TA,CPOPJ
	LDB	TB,[POINT	3,CURDAT,2]
	CAIN	TB,CD.DAT
	JRST	NXTTRY		;DATAB ITEM
	CAIE	TB,CD.CON
	POPJ	PP,
	LDB	TA,CO.DAT##	;CONTAB ITEM FATHER LINK
	JUMPN	TA,GOTFA	;NOT NULL
	POPJ	PP,

NXTTRY:	LDB	TB,DA.FAL##	;FATHER/BROTHER FLAG
	JUMPN	TB,ISFAL	;FATHER
	LDB	TA,DA.BRO##	;GET BROTHER LINK
	JUMPE	TA,CPOPJ	;NULL
	PUSHJ	PP,LNKSET
	  JRST	NXTTRY
ISFAL:	LDB	TA,DA.POP##	;GET FATHER LINK
	JUMPE	TA,CPOPJ	;NULL
GOTFA:	HRRZM	TA,TBLOCK
	LDB	TB,LNKCOD##	;COULD BE AN RPW LINK
	JUMPE	TB,GOTRPW	;MAYBE
GOTFA1:	PUSHJ	PP,LNKSET
GOTFA2:	HRL	TA,TBLOCK
	POP	PP,TE
	JRST	1(TE)

GOTRPW:	HRRZI	TC,(TA)
	HRRZ	TA,CURDAT	;SEE IF LINE- OR PAGE-COUNTER BIT ON
	LDB	TB,DA.LPC##
	JUMPE	TB,GOTRP1	;NO, MUST BE A FILTAB LINK
	HRRZ	TA,RPWLOC	;YES, GET RPWTAB ADDRESS
	ADDI	TA,(TC)
	JRST	GOTFA2

GOTRP1:	HRRZI	TA,(TC)		;RESTORE TA
	JRST	GOTFA1
	INTER.	PA171.
PA171.:	HRRZ	TC,NQUAL
	LSH	TC,1
	CAIL	TC,144		;SIZE OF TABLE
	EWARNJ	E.190		;TOO MANY QUALIFIERS
	DMOVE	TB,ARG1
	DMOVEM	TB,QUALT(TC)
	SETZM	ARG1
	SETZM	ARG1+1
	AOS	NQUAL
	POPJ	PP,
	INTER.	PA172.
PA172.:	HRRZI	TB,CD.EXT
	LDB	TA,[POINT	15,W2,15]
	PUSHJ	PP,FNDLNK
	  JRST	P172.A		;NOT FOUND
	HLRM	TB,W1
	HLRM	TB,ARG1
	SKIPN	PRIOR
	POPJ	PP,
	HRRZ	TA,W1
	PUSHJ	PP,LNKSET
	MOVE	TB,1(TA)
	TLO	TB,NR.EXT	;[574]
	MOVEM	TB,1(TA)
	POPJ	PP,

P172.A:	MOVE	TA,[XWD	CD.EXT,SZ.EXT]
	PUSHJ	PP,GETENT
	HLRM	TA,W1
	HLRM	TA,ARG1
	LDB	TB,[POINT	15,W2,15]
	IORI	TB,500000
	MOVSM	TB,(TA)
	SKIPN	PRIOR		;[574] SKIP IF SECTION PRIORITY NOT ZERO
	TDZA	TB,TB		;[574] NOT EXTERNAL--GET 0 AND SKIP
	MOVSI	TB,NR.EXT	;[574] SET EXTERNAL BIT
	MOVEM	TB,1(TA)
	LDB	TB,[POINT	15,W2,15]
	HRR	TA,TB
	JRST	PUTLNK


	INTER.	PA173.
PA173.:	MOVEI	TC,5		;MULTIPLY-ING FACTOR
	LDB	TA,OP.USE
	IMUL	TC,TA		;GET OFFSET FOR OPEN MODE
	LDB	TB,OP.OPC
	MOVE	TE,OPRTR	;GET OPERATOR FLAGS
	CAIE	TB,66		;USE FOR DEBUGGING?
	CAIE	TB,75		;NO, IS IT ERROR USE
	JRST	P173.X		;DEBUGGING OR NOT ERROR USE
;	JRST	P173.B		;ERROR USE

;ERROR USE (OR FILE-SPECIFIC)
;FILEN OPEN:	TE/ 4
;FILEN:		TE/ 0
;EXTEND:	TE/ 10

P173.B:	CAIN	TA,3		;EXTEND OR FILE-SPECIFIC
	TLNE	TE,10		; IF BIT ON ALSO, IT IS EXTEND
	 SKIPA			;AN ERROR USE, TC HAS OFFSET
	JRST	P173.C		;SPECIFIC FILE

;ERROR USE, NOT SPECIFIC FILE
	SKIPE	TB,USES(TC)
	JRST	P173.E		;CONFLICTS WITH PREVIOUS USE
	HLRZ	TD,CURSEC
	HRRZM	TD,USES(TC)
P173.X:	SETZM	ARG1
	SETZM	ARG1+1
	POPJ	PP,

;FILE-SPECIFIC USE PROCEDURE
P173.C:	HRRZ	TA,ARG1
	JUMPE	TA,P173.X	;?NOTHING THERE..??
	PUSHJ	PP,LNKSET	;GET PTR TO IT
	LDB	TD,FI.ERR	;IS ONE ALREADY DEFINED?
	JUMPN	TD,P173.E	;YES, COMPLAIN
	HLRZ	TD,CURSEC	;NO, DEFINE IT
	DPB	TD,FI.ERR
	LDB	TB,[POINT 1,OPRTR,15]	;GET ERROR-ON-OPEN BIT
	DPB	TB,FI.ENT##	;IF ON, SET IT IN FILTAB
	JRST	P173.X		;RETURN


P173.E:	MOVEM	TB,TBLOCK
	MOVEM	TE,TBLOCK+1
	MOVEM	TA,TBLOCK+2
	MOVE	TA,CURSEC
	LDB	TA,PR.FLO
	ADD	TA,FLOLOC
	LDB	LN,FL.LN
	LDB	CP,FL.CP
	HRRZI	DW,E.505
	PUSHJ	PP,FATAL
	MOVE	DW,TBLOCK
	PUSHJ	PP,PUTERA##
	MOVE	TE,TBLOCK+1
	MOVE	TA,TBLOCK+2
	POPJ	PP,
	INTER.	PA174.
PA174.:	SETO	TA,
	DPB	TA,OP.IN2##	;'INTO'
	SETOM	REINTO		;REMEMBER 'INTO' SEEN FOR 'AT END'
	POPJ	PP,

	INTER.	PA174N
PA174N:	SETO	TA,
	DPB	TA,OP.NXT##	;'NEXT'
	SKIPN	FLGSW		;WANT FIPS FLAGGER?
	POPJ	PP,		;NO
	MOVE	TA,CURFIL
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
	JRST	@[CPOPJ			;SEQUENTIAL
		TST.HI			;RELATIVE
		TST.H			;INDEXED
		CPOPJ](TB)
;READ ... KEY IS
	INTER.	PA174K
PA174K:	FLAGAT	H
	MOVE	TA,CURFIL	;MAKE SURE THIS FILE IS AN INDEXED FILE
	LDB	TB,FI.ORG
	CAIE	TB,%ACC.I
	 JRST	P174KE		;NO, GIVE ERROR
	LDB	TB,FI.FAM	;MAKE SURE ACCESS MODE IS NOT SEQUENTIAL
	CAIN	TB,%FAM.S
	 JRST	P174KF		;SEQ ACCESS MODE, CAN'T DO THIS
	LDB	TB,OP.NXT##	;HE BETTER NOT HAVE SAID "READ.. NEXT RECORD.."
	JUMPN	TB,P174KG	; ELSE COMPLAIN
	SETO	TA,
	DPB	TA,OP.KIS##	;"KEY IS"
	POPJ	PP,		;'KEY' IS DATA-NAME

P174KE:	EWARNW	E.626		;"FILE MUST BE INDEXED"
	JRST	PAYECC		;SET OPR TO "YECCH"
P174KF:	EWARNW	E.740		;"KEY IS" ONLY ALLOWED WHEN FAM IS NOT SEQ
	JRST	PAYECC		;SET OPR TO "YECCH"
P174KG:	EWARNW	E.714		;'NOT ALLOWED WITH READ NEXT'
	JRST	PAYECC		;SET OPR TO "YECCH"
;HERE WHEN READ THE (POSSIBLY QUALIFIED) "KEY IS.." DATANAME.
; CHECK TO SEE IF IT IS ONE OF THE POSSIBLE KEYS IN THIS FILE.
; IF SO, PUT THE NUMBER IN THE GENFIL AS [-1 + KEY-NUMBER]

	INTER.	PCAKIS
PCAKIS:	PUSH	PP,CURFIL	;SAVE THE REAL "CURFIL"
	PUSHJ	PP,FNDFIL	;FIND FILE WHICH CONTAINS THE RECORD NAME
	 JRST	PCAKS1		;?NOT FOUND.. GIVE ERROR
	POP	PP,TB		;RESTORE CURFIL
	CAME	TB,CURFIL	;IS IT THE CORRECT FILE?
	 JRST	PCAKS2		;NO, GIVE ERROR
	HRRZ	TC,ARG1		;TC:= DATANAME IN QUESTION
	MOVE	TA,TC		;[1460] CALL LINKSET
	PUSHJ	PP,LNKSET	;[1460] AND FIND OUT IF
	LDB	TB,DA.SUB	;[1460] THE KEY IS SUBSCRIPTED,
	JUMPN	TB,PCAKS5	;[1460] IF SO, GIVE FATAL ERROR
	MOVEI	TB,1		;ASSUME IT'S PRIMARY KEY
	MOVE	TA,CURFIL	;LOOK AT DEFINED KEYS OF THIS FILE
	LDB	TD,FI.RKY##	;CHECK TO SEE IF IT'S THE PRIMARY KEY
	JUMPE	TD,PAYECC	;(IF RECORD KEY IS NULL, PROGRAM HAS ERRORS,
				; DON'T TRY TO GENERATE CODE FOR "START")
	CAMN	TD,TC		;DID HE SAY "KEY IS PRIMARY-KEY"?
	 JRST	PCAKS3		;YES, GO WRITE IT OUT
	LDB	TA,FI.ALK##	;MAYBE AN ALTERNATE KEY..?
	JUMPE	TA,PCAKS4	;NO, GIVE ERROR
	ADD	TA,AKTLOC##
	HRRZ	TA,TA		;GET RH ONLY
PCKS2A:	LDB	TD,AK.DLK	;GET DATAB LINK
	ADDI	TB,1		;BUMP KEY NUMBER
	CAMN	TD,TC		;IS THIS IT?
	 JRST	PCAKS3		;YES, GO WRITE OUT KEY NUMBER
	ADDI	TA,SZ.AKT	;NO, LOOK AT NEXT ALTERNATE KEY
	HRRZ	TE,AKTNXT##	; (TO SEE IF WE FELL OFF END)
	CAML	TA,TE		;DID WE FALL OFF END OF TABLE?
	 JRST	PCAKS4		;YES, DATANAME IS NOT A VALID KEY
	LDB	TD,AK.FLK	;GET FILE LINK
	HLRZ	TE,CURFIL
	CAME	TD,TE		;SAME FILE?
	 JRST	PCAKS4		;NO, NOT A VALID KEY
	JRST	PCKS2A		;TRY AGAIN

;WRITE KEY OUT, TB = KEY NUMBER
PCAKS3:	SETO	TA,		;FIRST WORD IN TA
	JRST	PUTGEN		;OUTPUT TO GENFIL AND POPJ

PCAKS1:	POP	PP,CURFIL	;RESTORE OLD CURFIL
	JRST	PCAKS4		;GIVE ERROR

PCAKS2:	MOVEM	TB,CURFIL	;RESTORE REAL CURFIL
PCAKS4:	LDB	CP,[POINT 7,ARG1+1,35]	;POINT AT DATANAME
	LDB	LN,[POINT 13,ARG1+1,28]
	MOVEI	DW,E.741	;"KEY DATANAME NOT IN CORRECT FILE"
	PUSHJ	PP,FATAL
	JRST	PAYECC		;SET OPR TO "YECCH"
PCAKS5:	LDB	CP,[POINT 7,ARG1+1,35]	;[1460] POINT AT THE
	LDB	LN,[POINT 13,ARG1+1,28]	;[1460] KEY WITH ERROR
	MOVEI	DW,E.760		;[1460] AND GIVE THE
	PUSHJ	PP,FATAL		;[1460] MESSAGE THAT IT
	JRST	PAYECC			;[1460] CAN'T BE SUBSCRIPTED.
	INTER.	PA175.
PA175.:	SKIPN	TA,CURFIL##
	POPJ	PP,
	LDB	TB,	OP.ADV##	;ADVANCING ON?
	TRNE	TB,	1
	SKIPA	TB,	FI.ADV##	;YES.
	MOVE	TB,	FI.PSN##	;NO, MUST BE POSITIONING THEN.
	SETOI	TC,	
	DPB	TC,	TB		;SET THE APPROPRIATE FLAG.
	POPJ	PP,


	INTER.	PA176.
PA176.:	SETO	TA,
	DPB	TA,OP.FRM##	;'FROM'
	POPJ	PP,
;"START"

	INTER. PA177.
PA177.:	FLAGAT	HI
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	HRLM	LN,DWLNCP	;SAVE LN
	HRRM	CP,DWLNCP	;,,CP
	HRRZI	TA,67		;[68] 'SEEK' OR [74] 'START' OP CODE
	JRST	SETOP1

;HERE IF "START <PRIOD.>" SEEN
	INTER.	PA177A
PA177A:	HLRZ	LN,DWLNCP	;GET SAVED "LN"
	HRRZ	CP,DWLNCP	;GET SAVED "CP"
	DMOVEM	LN,WORDLN	;SAVE FOR "WARN"
	EWARNJ	E.730		;"RESERVED WORD.. MAY NOT BE USED AS PARA. NAME"
	INTER.	PA178.
PA178.:	HRRZI	TA,51		;'CADD' OP CODE
	JRST	SETOP0


	INTER.	PA179.
PA179.:	HRRZI	TA,52		;'CSUB' OP CODE
	JRST	SETOP0


	INTER.	PA180.
PA180.:	HRRZI	TA,53		;'CMUL' OP CODE
	JRST	SETOP0


	INTER.	PA181.
PA181.:	HRRZI	TA,54		;'CDIV' OP CODE
	JRST	SETOP0


	INTER.	PA182.
PA182.:	HRRZI	TA,55		;'CEXP' OP CODE
	JRST	SETOP0


	INTER.	PA183.
PA183.:	MOVEI	TE,OP%ALF##
P183.A:	SETZM	OPRTR+1
	HRRZI	TA,22		;'IFT' OP CODE
	PUSHJ	PP,SETOP1
	DPB	TE,OP.IFT##	;STORE INDEX VALUE
	JRST	P189.A


	INTER.	PA184.
PA184.:	MOVEI	TE,OP%NUM##
	JRST	P183.A


	INTER.	PA185N
PA185N:	PUSHJ	PP,TSTNOT	;SEE IF WE SHOULD FLAG PREVIOUS NOT
	SKPNAM

	INTER.	PA185.
PA185.:	FLAGAT	HI
	MOVEI	TE,OP%POS##
	JRST	P183.A

	INTER.	PA186N
PA186N:	PUSHJ	PP,TSTNOT	;SEE IF WE SHOULD FLAG PREVIOUS NOT
	SKPNAM

	INTER.	PA186.
PA186.:	FLAGAT	HI
	MOVEI	TE,OP%NEG##
	JRST	P183.A

	INTER.	PA187R
PA187R:	PUSHJ	PP,TSTNOT	;SEE IF WE SHOULD FLAG PREVIOUS NOT
	SKPNAM

	INTER.	PA187S
PA187S:	FLAGAT	8
	JRST	PA187C

	INTER.	PA187N
PA187N:	PUSHJ	PP,TSTNOT	;SEE IF WE SHOULD FLAG PREVIOUS NOT
	SKPNAM

	INTER.	PA187.
PA187.:	FLAGAT	HI
PA187C:	SKIPG	EVALFL		;Scanning for imp. stmt in or out of EVALUATE?
	JRST	PA187D		; Yes
	SWON	FREGWD		; No, selection subj/obj, turn on REGET WORD
	JRST	PA0.		; and exit
PA187D:	TLNN	W1,GWRESV
	JRST	P187.E
	LDB	TA,GWVAL##
	CAIE	TA,ZERO.
	JRST	P187.E
	MOVEI	TE,OP%ZER##
	JRST	P183.A

P187.E:	PUSHJ	PP,PA165.	;"YECCH"
	SOS	IFLVL		;COME DOWN ONE LEVEL OF IF
	EWARNW	E.86
	JRST	PA0.		;POP UP ONE BRANCH IN TREE


	INTER.	PA188.
PA188.:	PUSHJ	PP,PA102A	;'IF' OP CODE
	SETO	TA,
	DPB	TA,OP.GRT##	;'GREATER' FLAG
	JRST	P189.A


	INTER.	PA189.
PA189.:	PUSHJ	PP,PA102A	;'IF' OP CODE
	SETO	TA,
	DPB	TA,OP.LES##	;'LESS' OP CODE
P189.A:	TSWTZ	FNOTF;
	TDZA	TA,TA
	SETO	TA,
	HRRZ	TB,CLEVEL
	HLRZ	TC,ARGLST(TB)
	TRNE	TC,400000
	TRC	TA,1
	DPB	TA,OP.NOT##
	MOVE	TA,[XWD	OPRTR,IMPLOP]
	BLT	TA,IMPLOP+1
	SETZM	IFPERF		;CLEAR PERFORM LOOP CONTROL FLAG
	POPJ	PP,

	INTER.	PA190.
PA190.:	PUSHJ	PP,PA102A	;'IF' OP CODE
	SETO	TA,
	DPB	TA,OP.EQU##	;'EQUALS' OP CODE
	JRST	P189.A

;HERE FOR NOT GREATER, NOT LESS, NOT EQUALS

	INTER.	PA188N
PA188N:	TSWC	FNOTF		;COMPLEMENT NOT FLAG
	PUSHJ	PP,PA102A	;'IF' OP CODE
	SETO	TA,
	DPB	TA,OP.LES	;NOT 'GREATER' OP CODE
	DPB	TA,OP.EQU	;...
	JRST	P189.A

	INTER.	PA189N
PA189N:	TSWC	FNOTF		;COMPLEMENT NOT FLAG
	PUSHJ	PP,PA102A	;'IF' OP CODE
	SETO	TA,
	DPB	TA,OP.GRT	;NOT 'LESS' OP CODE
	DPB	TA,OP.EQU	;...
	JRST	P189.A

	INTER.	PA190N
PA190N:	TSWC	FNOTF		;COMPLEMENT NOT FLAG
	PUSHJ	PP,PA102A	;'IF' OP CODE
	SETO	TA,
	DPB	TA,OP.GRT	;NOT 'EQUALS' OP CODE
	DPB	TA,OP.LES	;...
	JRST	P189.A

	INTER.	PA191.
PA191.:	FLAGAT	HI
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	HRRZI	TA,50		;'COMPUTE' OP CODE
	SWON	FARITH;
	JRST	SETOP1


	INTER.	PA192.
PA192.:	PUSHJ	PP,PA103.
	MOVEI	TC,IF.		;[1553] UNWIND TERM STACK TO AN IF
	PUSHJ	PP,PA824.	;[1553] CLEAN UP TERM STACK
	SETZM	EWFLG##		;[1553] Turn off when seen flag
	HRRZ	TA,IFLVL	;[1541] MOVE P192.A
	ADD	TA,SPFLVL
	HRRZ	TC,ARGL2-1(TA)	;F-TARGET
	HRRM	CH,ARGL2-1(TA)	;[1541]SAVE NEW ELSE TAG
	JRST	P127.A		;DEFINE IT

;[1541] DUPLICATE PA192. FOR P192.A BECAUSE IT DOESN'T NEED THE EDIT
P192.A:	HRRZ	TA,IFLVL	;[1541]
	ADD	TA,SPFLVL	;[1541]
	HRRZ	TC,ARGL2-1(TA)	;[1541]F-TARGET
	HLRM	TC,ARGL2-1(TA)	;[1541]ZERO OUT ENTRY
	JRST	P127.A		;[1541]DEFINE IT

	INTER.	PA193.
PA193.:	HRLZ	TB,NXTSNT
	SETZM	NXTSNT
	JUMPE	TB,CPOPJ
	JRST	P198.D		;DEFINE SENTENCE TAG


	INTER.	PA194.
PA194.:	SETZM	OPRTR+1
	HRRZI	TA,21		;'IFC' OP CODE
	PUSHJ	PP,SETOP1
	JRST	P189.A
	INTER.	PA195.
PA195.:	MOVE	TE,OP.ON##
P195.A:	SETZM	OPRTR+1
	HRRZI	TA,21
	PUSHJ	PP,SETOP1
	MOVE	TB,TBLOCK
	DPB	TB,OP.SWT##
P195.B:	SETO	TA,
	DPB	TA,TE
	JRST	P189.A


	INTER.	PA196.
PA196.:	MOVE	TE,OP.OFF##
	JRST	P195.A


	INTER.	PA197.
PA197.:	SETZM	TBLOCK
	SETZM	OPRTR+1
	HRRZI	TA,76		;CLREOP
	PUSHJ	PP,SETOP0
	TLNE	W1,GWNLIT
	TLNE	W1,GWDP
	EWARNJ	E.25
	LDB	TB,GWVAL
	HRRZM	TB,CTR
	HRRZI	TA,LITVAL
	PUSHJ	PP,GETVAL
	CAIL	TC,0
	CAILE	TC,43
	EWARNJ	E.243
	MOVEM	TC,TBLOCK
	POPJ	PP,
;PERFORM ... UNTIL condition

	INTER.	PA198.
PA198.:	FLAGAT	HI
	SKIPN	ARG2
	SKIPE	ARG2+1
	JRST	P198.A		;PERFORM ... THRU ...
	PUSHJ	PP,PA159.	;PERFORM ...
P198.A:	SETZM	UNTTAG		;MAKE SURE ZERO INCASE WE DON'T NEED IT
	SKIPE	PERFAB		;IF TEST AFTER 
	JRST	P198.F		;DON'T GENERATE GOTO, JUST FALL THROUGH
	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	JUMPE	CH,.-2
	HRRZM	CH,UNTTAG##
	HRLZI	TB,(CH)
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
P198.F:	PUSHJ	PP,GETTAG
	SETZM	PERFAB		;CLEAR JUST IN CASE
	ANDI	CH,077777
	JUMPE	CH,P198.F	;[1566]WAS .-2
	HRLZI	TB,(CH)
	HRRZM	CH,UNTTAG+1
	PUSHJ	PP,P198.D	;OUTPUT 'TAGNAM' OP CODE
	SKIPN	ARG2
	SKIPE	ARG2+1
	JRST	P198.B		;PERFORM ... THRU ...
	PUSHJ	PP,PCA25.
	JRST	P198.C

P198.B:	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
P198.C:	HRLZ	TB,UNTTAG
	JUMPE	TB,CPOPJ		;DON'T GENERATE IF NOT WANTED
P198.D:	HRRI	TB,102		;'TAGNAM' OP CODE
P198.E:	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	JRST	PUTGEN##
	INTER.	PA199.
PA199.:	SKIPN	CH,INPTAG		;Is this an inline perform until ?
	JRST	PA199A			;If not must be PERFORM para-name UNTIL
	ANDI	CH,077777
	HRRZM	CH,UNTTAG
	SETZM	INPTAG			;[1566]Zero the in-line perf. tag
	AOS	UNTTAG
	HRLZI	TB,(CH)
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
	PUSHJ	PP,P192.A	;IMPLICIT 'ELSE'
	HRLZ	TB,UNTTAG+1
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
	PUSHJ	PP,PA37.
	JRST	P198.C		;OUTPUT TAG
;PA199A Is the same as PA199 except that it does not increment the tag
;numbers, an it also generates tags ( PA833. does this for the other case )
PA199A:	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	HRRZM	CH,UNTTAG
	HRLZI	TB,(CH)
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
	PUSHJ	PP,P192.A	;IMPLICIT 'ELSE'
	HRLZ	TB,UNTTAG+1
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
	PUSHJ	PP,PA37.
	JRST	P198.C		;OUTPUT TAG
;Here for end of PERFORM VARYING

	INTER.	PA200.
PA200.:	MOVE	TA,NVARY
	CAILE	TA,MXPERF
	HRRZI	TA,MXPERF
	MOVEM	TA,MVARY##
	MOVE	TA,[XWD SAVPRF,OPRTR]
	BLT	TA,ARG2+1
	PUSHJ	PP,PA21.	;procedure-name-1
	PUSHJ	PP,PA47.
	SKIPN	ARG1
	SKIPE	ARG1+1
	PUSHJ	PP,PA21.	;procedure-name-2
	PUSHJ	PP,PA22.	;PERF operator
	SKIPLE	AS7482		;WANT ANS-8x?
	JRST	Q200.		;YES
P200.A:	SOSGE	TA,NVARY
	POPJ	PP,
	CAILE	TA,MXPERF-1
	JRST	P200.A		;MORE THAN MAXIMUM SEEN
	IMULI	TA,VARSIZ	;SIZE OF ONE OCCURANCE OF VARBLK
	MOVSI	TB,VARBLK(TA)	;SUBJECT
	HRRI	TB,ARG1
	BLT	TB,ARG1+1
	MOVSI	TB,VARSSB(TA)
	HRRI	TB,NSBSC1
	BLT	TB,NSBSC1+MAXSUB*4
	MOVSI	TB,VARINC(TA)	;SECOND ARG
	HRRI	TB,ARG2
	BLT	TB,ARG2+1
	MOVSI	TB,VARSIN(TA)	;SUBSCRIPTS
	HRRI	TB,NSBSC2
	BLT	TB,NSBSC2+MAXSUB*4
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA30.	;'ADDTO' OPERATOR
	PUSHJ	PP,PA22.
	PUSHJ	PP,PA34.	;'RESULT' OPERATOR
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	HRRZ	TA,NVARY
	LSH	TA,1
	HRLZ	TB,VARTAG+2(TA)
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
	SKIPG	TA,NVARY
	JRST	P200.B
	LSH	TA,1
	HRLZ	TB,VARTAG+1(TA)
	PUSHJ	PP,P198.D	;OUTPUT 'TAGNAM' OP CODE
	PUSHJ	PP,PA70.	;'MOVE' OPERATOR
	HRRZ	TA,NVARY
	IMULI	TA,VARSIZ	;SIZE OF ONE OCCURANCE OF VARBLK
	MOVSI	TB,VARBLK(TA)	;SUBJECT
	HRRI	TB,ARG1
	BLT	TB,ARG1+1
	MOVSI	TB,VARSSB(TA)	;SUBSCRIPTS
	HRRI	TB,NSBSC1
	BLT	TB,NSBSC1+MAXSUB*4
	MOVSI	TB,VARIVL(TA)	;SECOND ARG
	HRRI	TB,ARG2
	BLT	TB,ARG2+1
	MOVSI	TB,VARSIV(TA)	;SUBSCRIPTS
	HRRI	TB,NSBSC2
	BLT	TB,NSBSC2+MAXSUB*4
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	JRST	P200.A

;Code is similar to P200.A except that identifier-2 is augmented before
;identifier-5 is set. ANS-74 has this the other way.

Q200.:	SOSGE	TA,NVARY
	POPJ	PP,
	CAILE	TA,MXPERF-1
	JRST	Q200.		;MORE THAN MAXIMUM SEEN

;Here to augment current identifier
Q200.A:	IMULI	TA,VARSIZ	;SIZE OF ONE OCCURANCE OF VARBLK
	MOVSI	TB,VARBLK(TA)	;SUBJECT
	HRRI	TB,ARG1
	BLT	TB,ARG1+1
	MOVSI	TB,VARSSB(TA)
	HRRI	TB,NSBSC1
	BLT	TB,NSBSC1+MAXSUB*4
	MOVSI	TB,VARINC(TA)	;SECOND ARG
	HRRI	TB,ARG2
	BLT	TB,ARG2+1
	MOVSI	TB,VARSIN(TA)	;SUBSCRIPTS
	HRRI	TB,NSBSC2
	BLT	TB,NSBSC2+MAXSUB*4
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA30.	;'ADDTO' OPERATOR
	PUSHJ	PP,PA22.
	PUSHJ	PP,PA34.	;'RESULT' OPERATOR
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	MOVE	TA,NVARY
	ADDI	TA,1
	CAMN	TA,MVARY	;IS THIS THE INNERMOST IDENTIFIER?
	JRST	Q200.C		;YES, THEN NOTHING TO RESET

;Here to reset next higher identifier
Q200.B:	PUSHJ	PP,PA70.	;'MOVE' OPERATOR
	HRRZ	TA,NVARY
	ADDI	TA,1
	IMULI	TA,VARSIZ	;SIZE OF ONE OCCURANCE OF VARBLK
	MOVSI	TB,VARBLK(TA)	;SUBJECT
	HRRI	TB,ARG1
	BLT	TB,ARG1+1
	MOVSI	TB,VARSSB(TA)	;SUBSCRIPTS
	HRRI	TB,NSBSC1
	BLT	TB,NSBSC1+MAXSUB*4
	MOVSI	TB,VARIVL(TA)	;SECOND ARG
	HRRI	TB,ARG2
	BLT	TB,ARG2+1
	MOVSI	TB,VARSIV(TA)	;SUBSCRIPTS
	HRRI	TB,NSBSC2
	BLT	TB,NSBSC2+MAXSUB*4
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
Q200.C:	HRRZ	TA,NVARY
	LSH	TA,1
	HRLZ	TB,VARTAG+2(TA)
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
	SKIPG	TA,NVARY	;ANYMORE TO DO?
	JRST	P200.B		;NO
	LSH	TA,1
	HRLZ	TB,VARTAG+1(TA)
	PUSHJ	PP,P198.D	;OUTPUT 'TAGNAM' OP CODE
	SOS	TA,NVARY
	JRST	Q200.A		;LOOP FOR NEXT CONTROL ITEMS

P200.B:	HRLZ	TB,VARTAG	;%S
	PUSHJ	PP,P198.D	;OUTPUT 'TAGNAM' OP CODE
	SETZB	TA,NVARY
P200.C:	CAML	TA,MVARY
	JRST	P200.D
	PUSHJ	PP,PA70.	;'MOVE' OPERATOR
	HRRZ	TA,NVARY
	IMULI	TA,VARSIZ	;SIZE OF ONE OCCURANCE OF VARBLK
	MOVSI	TB,VARBLK(TA)	;SUBJECT
	HRRI	TB,ARG1
	BLT	TB,ARG1+1
	MOVSI	TB,VARSSB(TA)	;SUBSCRIPTS
	HRRI	TB,NSBSC1
	BLT	TB,NSBSC1+MAXSUB*4
	MOVSI	TB,VARIVL(TA)	;SECOND ARG
	HRRI	TB,ARG2
	BLT	TB,ARG2+1
	MOVSI	TB,VARSIV(TA)	;SUBSCRIPTS
	HRRI	TB,NSBSC2
	BLT	TB,NSBSC2+MAXSUB*4
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	AOS	TA,NVARY
	JRST	P200.C

P200.D:	SKIPE	TB,PERFAB	;ARE WE IN PERFORM ... WITH TEST AFTER?
	CAMN	TB,[-1]		;AND HAVE TAG TO GO TO?
	JRST	P200.E		;NO
	HRLZ	TB,TB		;YES, GET TAG
	SETZM	PERFAB		;CLEAR JUST IN CASE
	TRNA
P200.E:	HRLZ	TB,VARTAG+2	;%C1
	HRRI	TB,74		;'JUMPTO' OP CODE
	PUSHJ	PP,P198.E
	HRLZ	TB,VARTAG+1	;%Z
	HRRI	TB,102
	DPB	TB,[POINT 9,TA,8]
	JRST	PUTGEN
	INTER.	PA201.
PA201.:	MOVE	TA,ARG2		;SAVE
	MOVEM	TA,HROUND##	;  "ROUND" FLAG
	SETZM	CORRSP+12
	SETO	TA,
	DPB	TA,OP.COR##
	MOVE	TA,[XWD OPRTR,CORRSP+10]
	BLT	TA,CORRSP+11
	MOVE	TA,[XWD CORRSP+6,OPRTR]
	BLT	TA,OPRTR+1
	HRRZ	TA,ARG1
	JUMPE	TA,P201.X
	LDB	TB,LNKCOD
	CAIE	TB,CD.DAT
	JRST	P201.X
	HRLZM	TA,CORRSP##
	PUSHJ	PP,LNKSET
	HRRM	TA,CORRSP
	LDB	TB,DA.SON
	JUMPE	TB,P201E1	;CANNOT BE ELEMENTARY
	HRRZ	TA,ARG2
	JUMPE	TA,P201.X
	LDB	TB,LNKCOD
	CAIE	TB,CD.DAT
	JRST	P201.X
	HRLZM	TA,CORRSP+1
	PUSHJ	PP,LNKSET
	HRRM	TA,CORRSP+1
	LDB	TB,DA.SON
	JUMPE	TB,P201E1
	MOVE	TB,ARG1+1
	MOVE	TA,ARG2+1
	DMOVEM	TB,CORRSP+4
	DMOVE	TB,CORRSP
	DMOVEM	TB,CORRSP+2	;'LEFT' AND 'RIGHT' OPERANDS
	MOVE	TA,[XWD NSBSC1,CORRSP+.CORLS]	;[1070]
	BLT	TA,CORRSP+.CORLS+<MAXSUB*4>+1	;[1070]
	MOVE	TA,[XWD NSBSC2,CORRSP+.CORRS]	;[1070]
	BLT	TA,CORRSP+.CORRS+<MAXSUB*4>+1	;[1070]
P201.1:	MOVE	TA,CORRSP+2
	LDB	TA,DA.SON
	JUMPE	TA,P201E2	;SHOULDN'T BE POSSIBLE
	HRLZM	TA,CORRSP+2
	PUSHJ	PP,LNKSET
	HRRM	TA,CORRSP+2	;'LEFT'_SON('LEFT')
P201.3:	LDB	TB,DA.LVL##
	CAIN	TB,76
	JRST	P201.2		;IGNORE 66 LEVEL ITEMS
	LDB	TB,DA.OCC##
	JUMPN	TB,P201.2	;IGNORE ITEMS WITH OCCURS CLAUSES
	LDB	TB,DA.RDF##
	JUMPN	TB,P201.2
	LDB	TB,DA.NAM
	ADD	TB,NAMLOC
	HLRZ	TC,(TB)		;L. H. OF NAMTAB ENTRY HEADER
	ANDI	TC,07777
	CAIN	TC,FILLE.
	JRST	P201.2		;IGNORE FILLER
	MOVE	TA,CORRSP+3
	LDB	TA,DA.SON##
	JUMPE	TA,P201.2
	HRLZM	TA,CORRSP+3
	PUSHJ	PP,LNKSET
	HRRM	TA,CORRSP+3
P201.5:	LDB	TB,DA.LVL
	CAIN	TB,76
	JRST	P201.4
	LDB	TB,DA.OCC
	JUMPN	TB,P201.4
	LDB	TB,DA.RDF
	JUMPN	TB,P201.4
	LDB	TB,DA.NAM
	HRRZI	TD,(TB)
	ADD	TB,NAMLOC
	HLRZ	TC,(TB)
	ANDI	TC,077777
	CAIN	TC,FILLE.
	JRST	P201.4
	HRRZ	TA,CORRSP+2
	LDB	TB,DA.NAM
	CAIE	TB,(TD)
	JRST	P201.4		;NOT THE SAME NAME
	LDB	TB,DA.SON	;SON OF 'LEFT'
	HRRZ	TA,CORRSP+3
	LDB	TC,DA.SON	;SON OF 'RIGHT'
	JUMPE	TB,.+2		;'LEFT' IS ELEMENTARY
	JUMPN	TC,P201.1	;NEITHER IS ELEMENTARY
	IORI	TB,(TC)
	JUMPE	TB,P201.O	;BOTH ELEMENTARY
	LDB	TC,OP.OPC
	CAIE	TC,1
	JRST	P201.2		;NOT 'MOVE' --- BOTH MUST BE ELEMENTARY
P201.O:	MOVE	TA,CORRSP+2
	HLRZM	TA,ARG1
	MOVE	TC,CORRSP+4
	MOVEM	TC,ARG1+1
	MOVE	TA,CORRSP+3
	HLR	TA,HROUND	;GET POSSIBLE "ROUND" FLAG
	MOVSM	TA,ARG2
	MOVEM	TC,ARG2+1
	MOVE	TA,[XWD CORRSP+.CORLS,NSBSC1]	;[1070]
	BLT	TA,NSBSC1+<MAXSUB*4>		;[1070]
	MOVE	TA,[XWD CORRSP+.CORRS,NSBSC2]	;[1070]
	BLT	TA,NSBSC2+<MAXSUB*4>		;[1070]
	PUSHJ	PP,PA21.		;'LEFT'
	LDB	TB,OP.OPC
	CAIE	TB,1
	JRST	P201O1		;NOT 'MOVE'
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	MOVE	TA,[XWD OPRTR,CORRSP+6]
	BLT	TA,CORRSP+7		;SAVE OPERATOR
P201O2:	PUSHJ	PP,PA22.
	MOVS	TA,[XWD OPRTR,CORRSP+6]
	BLT	TA,OPRTR+1
	AOS	CORRSP+12
	JRST	P201.4

P201O1:	MOVE	TA,[XWD OPRTR,CORRSP+6]
	BLT	TA,CORRSP+7
	PUSHJ	PP,PA22.
	PUSHJ	PP,PA47.
	MOVE	TB,CORRSP+5	;GET CORRECT LINE & CHAR POS. OF 2ND
	MOVEM	TB,ARG1+1	;  GROUP ARG IN CASE OF ERROR
	PUSHJ	PP,PA21.
	MOVE	TA,[XWD CORRSP+10,OPRTR]
	BLT	TA,OPRTR+1
	JRST	P201O2		;OUTPUT 'RESULT'

P201.4:	HLRZ	TB,CORRSP+3	;'RIGHT'
	HLRZ	TC,CORRSP+1
	CAIN	TB,(TC)
	JRST	P201.X		;FINISHED
	PUSHJ	PP,FNDBRO
	JRST	P201.6		;NO BROTHER
	HRLZM	TB,CORRSP+3
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	HRRM	TA,CORRSP+3
	JRST	P201.5

P201.6:	HLRZ	TB,CORRSP+3
	HLRZ	TC,CORRSP+1
	CAIN	TB,(TC)
	JRST	P201.X
	PUSHJ	PP,FNDPOP
	JRST	P201.X
	LDB	TC,[POINT 3,TB,20]
	CAIE	TC,CD.DAT
	JRST	P201.X
	HRLZM	TB,CORRSP+3
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	HRRM	TA,CORRSP+3
P201.2:	HLRZ	TB,CORRSP+2	;'LEFT'
	HLRZ	TC,CORRSP
	CAIN	TB,(TC)
	JRST	P201.X
	PUSHJ	PP,FNDBRO
	JRST	P20121
	HRLZM	TB,CORRSP+2
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	HRRM	TA,CORRSP+2
	JRST	P201.3

P20121:	HLRZ	TB,CORRSP+2
	HLRZ	TC,CORRSP
	CAIN	TB,(TC)
	JRST	P201.X
	PUSHJ	PP,FNDPOP
	JRST	P201.X
	HLRZ	TC,CORRSP
	CAIN	TB,(TC)
	JRST	P201.X
	LDB	TC,[POINT 3,TB,20]
	CAIE	TC,CD.DAT
	JRST	P201.X
	HRRZI	TA,(TB)
	HRLZM	TB,CORRSP+2
	PUSHJ	PP,LNKSET
	HRRM	TA,CORRSP+2
	JRST	P201.6

P201.X:	SKIPE	CORRSP+12
	JRST	P201X1
	LDB	LN,OP.LN
	LDB	CP,OP.CP
	HRRZI	DW,E.105	;NO CORRESPONDING ELEMENTS
	PUSHJ	PP,WARN
P201X1:	SETZM	OPRTR
	MOVE	TA,[XWD OPRTR,OPRTR+1]
	BLT	TA,ARG2+1
	POPJ	PP,

P201E1:	LDB	LN,OP.LN
	LDB	CP,OP.CP
	HRRZI	DW,E.265
	JRST	FATAL

P201E2:	OUTSTR	[ASCIZ /PA201.: internal compiler error
/]
	JRST	KILL

;ENTER WITH TB= DATAB LINK TO ITEM
;RETURNS .+1 IF NO FATHER
;RETURNS .+2 WITH TB= DATAB LINK TO FATHER
FNDPOP:	JUMPE	TB,CPOPJ
	LDB	TC,[POINT 3,TB,20]
	CAIE	TC,CD.DAT
	POPJ	PP,
	HRRZI	TA,(TB)
POP.1:	HRRZM	TA,TBLOCK
	PUSHJ	PP,LNKSET
	LDB	TB,DA.FAL
	JUMPE	TB,POP.2	;BROTHER LINK
	LDB	TB,DA.POP
	POP	PP,TE
	JRST	1(TE)

POP.2:	LDB	TA,DA.BRO
	JUMPN	TA,POP.1
	POPJ	PP,

FNDBRO:	JUMPE	TB,CPOPJ
	LDB	TC,[POINT 3,TC,20]
	CAIE	TC,CD.DAT
	POPJ	PP,
	HRRZI	TA,(TB)
	PUSHJ	PP,LNKSET
	LDB	TB,DA.FAL
	JUMPN	TB,CPOPJ
	LDB	TB,DA.BRO
	JUMPE	TB,CPOPJ
	POP	PP,TE
	JRST	1(TE)



;[257] THIS ROUTINE FINDS THE FILE WHICH CONTAINS THE GIVEN RECORD NAME

FNDFIL:	SETZM	CURFIL		; [275] CLEAR FILENAME
	HRRZ	TB,ARG1		; [275] GET ITEM
	JUMPE	TB,CPOPJ	; [275] NONE - ERROR
	LDB	TC,[POINT 3,TB,20]; [275] GET TYPE OF ITEM
	CAIN	TC,CD.FIL	; [275] IS IT A FILE-NAME?
	JRST	FIL.F		; [275] YES GO IT
	CAIN	TC,CD.DAT	; [275] IS ITEM A DATA-NAME?
FIL.A:	PUSHJ	PP,FNDPOP	; [275] GET FATHER OF DATA-ITEM
	  POPJ	PP,		; [275] NONE- DATA ITEM NOT IN A FILE-ERROR RETURN
	LDB	TC,[POINT 3,TB,20]; [275] GET TYPE OF FATHER
	CAIN	TC,CD.DAT	; [275] IF FATHER IS A DATA NAME
	JRST	FIL.A		; [275] THEN LOOP TO GET NEXT FATHER
	CAIE	TC,CD.FIL	; [275] IS FATHER A FILE-NAME
	POPJ	PP,		; [275] NO NOT A FILE OR DATA NAME- ERROR EXIT
FIL.F:	HRLZM	TB,CURFIL	; [275] STORE THE FILE NAME RELATIVE ADDRESS
	HRRZI	TA,(TB)		; [275] NOW GET ITS REAL
	PUSHJ	PP,LNKSET	; [275] ADDRESS
	HRRM	TA,CURFIL	; [275] STORE FILENAME ADDRESS
	JRST	CPOPJ1		; [257] FOUND --SKIP RETURN
	INTER.	PA202.
PA202.:	MOVE	TA,[XWD OPRTR,CORRSP+6]
	BLT	TA,CORRSP+7
	POPJ	PP,


	INTER.	PA203.
PA203.:	PUSHJ	PP,PA34.
	SETO	TA,
	DPB	TA,OP.SZE
	POPJ	PP,


	INTER.	PA204.
PA204.:	SETZM	OPRTR
	DPB	LN,OP.LN
	DPB	CP,OP.CP
	HRRZI	TA,23		;'SPIF' OPERATOR
	PUSHJ	PP,SETOP3
	SETO	TA,
	DPB	TA,OP.SZE
	DPB	TA,OP.COR
	JRST	PA90.A


	INTER.	PA205I
PA205I:				;Compute nbr of subscripts field needs
	SKIPE	RMFLG##		;If we already started to scan a ref modifier,
	JRST	P205.E		; can't nest subcripts or ref mods
	PUSHJ	PP,PA170.	;Fix up entries in QUALT table
	HRRZ	TA,ARG1		;Field's DATAB link
	LDB	TB,LNKCOD
	CAIN	TB,CD.DAT	;DATAB?
	JRST	P205.0		;Yes
	CAIE	TB,CD.CON	;CONTAB?
	JRST	[SETZ	TB,		;Probably an error
		JRST	P205.2]		;Return zero
	PUSHJ	PP,LNKSET
	LDB	TA,CO.DAT##	;Get DATAB link
P205.0:	PUSHJ	PP,LNKSET	;
	SOS	TA		;[1631]Dummy entry is at 1+@datloc
	CAMN	TA,DATLOC	;[1631]IS IT THE DUMMY ENTRY?
	JRST	P205.3		;[1631]YES - error 
	AOS	TA		;[1631]Restore TA
	LDB	TB,DA.SUB	;Is the item subscripted?
	JUMPE	TB,P205.2	;No, zero counter
	TDZA	TB,TB		;Initialize TB
P205.1:	PUSHJ	PP,LNKSET	;Get DATAB entry address
	LDB	TC,DA.OCC##	;Is there an OCCURS at this level?
	SKIPE	TC		;No
	AOS	TB		;Yes, bump counter
	LDB	TA,DA.OCH##	;Link to occurs at higher level?
	JUMPN	TA,P205.1	;Yes
P205.2:	HRRM	TB,NBRSUB##	;No, store final count
	POPJ	PP,		;

P205.E:	EWARNW	E.561		;Cannot be subscripted
P205.3:	PUSHJ	PP,PCA12.	;[1631]Skip to period
	JRST	PA0.		;Pop up one node

	INTER.	PA205.
PA205.:	SETZM	NSBSC1
	MOVE	TA,[XWD NSBSC1,SBSCR1] ;SBSCR1=NSBSC1+1
	MOVEI	TB,MAXSUB*4-1	;CLEAR OUT SUBSCRIPT INFO BLOCK
	BLT	TA,SBSCR1(TB)	; . .
	SKIPN	NBRSUB		;If field can't have subscripts,
	JRST	PA0.		; pop back up and scan ref modders
	MOVE	TA,[XWD ARG1,ARG3##]
	BLT	TA,ARG3+1
PA205A:	TSWF	FNOSUB		;FIELD IS SUBSCRIPTABLE,
	EWARNW	E.275		; BUT USED WHERE SUBSCRIPTS NOT ALLOWED
	POPJ	PP,
	INTER.	PA206A
PA206A:	HRRZ	TA,ARG1		; [405] GET SUBSCRIPT RELATIVE DATAB ADDRESS
	PUSHJ	PP,LNKSET	; [405] GET IS REAL ADDRESS
	MOVEM	TA,CURDAT	; [405] NOW STORE IT
	LDB	TB,DA.SUB##	;[137] IS SUBSCRIPTED ITEM SUBSCRIPTED ?
	SKIPE	TB		;[137] ERROR IF SO
	EWARNW	E.495		;[137] ERROR MESSAGE
	SKPNAM			;[137] OK GO ON

	INTER.	PA206.
PA206.:	AOS	TA,NSBSC1
	CAILE	TA,MAXSUB
	JRST	[MOVEI	TA,MAXSUB	; [363] RESTORE TO MAXIMUM
		MOVEM	TA,NSBSC1	; [363] LIMIT
		EWARNJ	E.277]		; [363] TOO MANY SUBSCRIPTS.
	ASH	TA,2
	HRRZI	TA,SBSCR1-4(TA)
	HRRZI	TB,1(TA)
	HRLI	TA,ARG1
	BLT	TA,(TB)
	CAIE	TYPE,PLUS.	; if subscript is followed
	CAIN	TYPE,MINUS.	;  by a relative index
	POPJ	PP,		;  don't leave yet
	MOVE	TB,NBRSUB	;nbr of subs field requires
	CAMLE	TB,NSBSC1	;nbr of subs scanned
	POPJ	PP,		;still expect more
	PUSHJ	PP,PA220.	;put out what's found
	SETOM	RMFLG##	;
	JRST	PA0.		;pop back up and check for ref modders
	INTER.	PA207.
PA207.:	FLAGAT	HI
	SETZM	SRTMRG##	;SIGNAL ITS SORT NOT MERGE
	SKIPE	FLGSW##		;ARE WE CHECKING FIPS LEVEL?
	SKIPN	ESRTSN##	;YES, ONLY ONE SORT ALLOWED UNLESS HIGH LEVEL
	SOSA	ESRTSN		;OK, BUT SIGNAL SEEN ONE
	PUSHJ	PP,FLG.H##	;TEST AT HIGH LEVEL
	HRRZI	TA,110		;'SORT'
	SWON	FNOSUB		;SUBSCRIPTING NOT ALLOWED
	JRST	SETOP1


	INTER.	PA207A
PA207A:	FLAGAT	H
	SETOM	SRTMRG		;SIGNAL ITS MERGE
	SWON	FNOSUB;		;[645] SUBSCRIPTING NOT ALLOWED
	HRRZI	TA,117		;'MERGE'
	JRST	SETOP1

	INTER.	PA207C
PA207C:	FLAGAT	H
	MOVEI	TA,107		;COLLATING SEQUENCE
	JRST	SETOP1

	INTER.	PA208.
PA208.:	HRRZI	TA,111		;'KEY'
	JRST	SETOP1


	INTER.	PA209.
PA209.:	PUSHJ	PP,PA208.
	SETO	TA,
	DPB	TA,OP.ASC##	;'ASCENDING KEY'
	POPJ	PP,


	INTER.	PA210.
PA210.:	MOVEI	TA,112		;'INPUT PROCEDURE' OP CODE
	JRST	SETOP1


	INTER.	PA211.
PA211.:	MOVEI	TA,113		;'OUTPUT PROCEDURE' OP CODE
	JRST	SETOP1

	INTER.	PA212F
PA212F:	SKIPL	SRTMRG		;ONLY CHECK MULTIPLE FILES ON SORT
	FLAGAT	H
	SKPNAM

	INTER.	PA212.
PA212.:	HRRZI	TA,115		;'USING'
	JRST	SETOP1

	INTER.	PA213S
PA213S:	FLAGAT	8		;EXTENSION FOR COBOL-82
	SKPNAM

	INTER.	PA213.
PA213.:	HRRZI	TA,114		;'GIVING'
	JRST	SETOP1


	INTER.	PA214.
PA214.:	HRRZI	TA,116		;'ENDSRT'
	SWOFF	FNOSUB		;TURN SUBSCRIPTING BACK ON
	JRST	SETOP0
	INTER.	PA215.
PA215.:	HRRZ	TA,ARG1
	JUMPE	TA,CPOPJ
	LDB	TB,LNKCOD
	CAIE	TB,CD.FIL
	POPJ	PP,
	PUSHJ	PP,LNKSET
	LDB	TB,OP.OPC
	CAIE	TB,115		;'USING'
	JRST	P215.A
	SETO	TB,
	DPB	TB,FI.INO
	JRST	P215.B

P215.A:	CAIE	TB,114		;'GIVING'
	POPJ	PP,
	SETO	TB,
	DPB	TB,FI.OUO
P215.B:	LDB	TB,FI.DSD##
	JUMPE	TB,CPOPJ
	LDB	CP,[POINT 7,ARG1+1,35]
	LDB	LN,[POINT 13,ARG1+1,28]
	HRRZI	DW,E.291
	JRST	FATAL
	INTER.	PA216.
PA216.:	PUSHJ	PP,PCA83.	; [257] CHECK THAT RECORD IS 01 OR 77 LEVEL
	PUSHJ	PP,FNDFIL	; [257] GO GET ASSOC FILE
	  JFCL			; [257] WILL CATCH ERROR IN IOGEN PHASE E
	JRST	PCA5G.		;TEST TO SEE IF FIPS FLAGGER WANTED

	INTER.	PA217.
PA217.:	SETO	TB,
	DPB	TB,OP.USI##
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	SETZM	OPRTR+1
	SETZM	REFCON##	;Initialize to CALL BY REFERENCE
	HRRZI	TA,46		;'USING'
	JRST	SETOP1

	INTER.	PA218.
PA218.:	FLAGAT	NS
	LDB	TE,GWLN##	;LINE NUMBER
	MOVE	TA,[POINT 7,TBLOCK+1]
	SETZM	TBLOCK+1
	HRRZI	TC,^D1000
P218.A:	IDIVI	TE,(TC)
	ADDI	TE,"0"
	IDPB	TE,TA
	IDIVI	TC,^D10
	HRRZI	TE,(TD)
	JUMPG	TC,P218.A
	MOVE	TB,[ASCII /LINE /]
	MOVEM	TB,TBLOCK
	MOVE	TA,[XWD CD.VAL,3]
	PUSHJ	PP,GETENT
	HRRZI	TD,^D9
	DPB	TD,[POINT 14,(TA),13]
	MOVE	TC,[POINT 7,TBLOCK]
	MOVSI	TB,(POINT 7,(TA),13)
	ILDB	TD,TC
	IDPB	TD,TB
	JUMPN	TD,.-2
	HLRZ	W1,TA
	HRLI	W1,^D9
	TLO	W1,GWLIT
	DMOVEM	W1,ARG1
	JRST	PA21.
	INTER.	PA219.
PA219.:	MOVE	TA,[XWD NAMWRD,NAMWRD+1]
	SETZM	NAMWRD
	BLT	TA,NAMWRD+4
	MOVE	TA,[XWD [SIXBIT /:GENERATED:SECTION:NAME:/],NAMWRD]
	BLT	TA,NAMWRD+3
	SETZM	PRIOR
	MOVSI	W1,GWNOT
	PUSHJ	PP,PA2.
	PUSHJ	PP,PCA3A	; [271]  SET UP SECTION NAME
	MOVE	TA,CURPRO	;GET PTR TO PROTAB ENTRY
	SETZ	TB,		;CLEAR DEFINED FLAG SO THIS WONT BE
	DPB	TB,PR.DEF	;  ON LISTING
PA219X:	MOVE	TA,[XWD NAMWRD,NAMWRD+1]	; [271] NEW LABEL 
	SETZM	NAMWRD
	BLT	TA,NAMWRD+4
	MOVE	TA,[XWD [SIXBIT /:GENERATED:PARAGRAPH:NAME:/],NAMWRD]
	BLT	TA,NAMWRD+4
	MOVSI	W1,GWNOT
	PUSHJ	PP,PA2.
	PUSHJ	PP,PCA2.
	MOVE	TA,CURPRO	;GET PTR TO PROTAB ENTRY
	SETZB	TB,PROGST	;CLEAR DEFINED FLAG AND DON'T COUNT AS REAL PRO NAMES

	DPB	TB,PR.DEF
	POPJ	PP,

;THIS ACTION IS SO THAT THE STARTING ADDRESS "PROGST" DOESN'T GET
;RESET IN A DBMS PROGRAM, AFTER THE DECLARATIVES.
	INTER.	PA219A
PA219A:	MOVE	TA,PROGST	;SAVE STARTING ADDRESS
	PUSH	PP,TA		;SAVE ON STACK
	PUSHJ	PP,PA219.	;DO THE NORMAL STUFF
	POP	PP,TA
	MOVEM	TA,PROGST	;RESET IT (MAY BE ZERO)
	HRRZ	TA,CURPRO	; [327] GET GENERATED PARA PROTAB POINER
	SETO	TB,		; [327] TURN ON THE
	DPB	TB,PR.MDF	; [327] MULTI-DEFINED BIT- NOTE DEFINED BIT OFF
				; [327] THIS TELLS PARGEN IN XFRGEN IN PHASE E THIS IS A GENERATED PARA
	POPJ	PP,
	INTER.	PA220.
PA220.:	MOVS	TA,[XWD ARG1,ARG3]
	BLT	TA,ARG1+1
	SKIPN	RMFLG		;if here with rmflag on,
	POPJ	PP,		;
	SETZM	RMFLG		;  then never found colon for ref. mod.
	TSWT	FNOSUB		;  
	POPJ	PP,		;(phase E flags some)
	LDB	LN,[POINT 13,ARG1+1,28]	; so reset flag
	LDB	CP,[POINT 7,ARG1,35]	; and give error
	HRRZI	DW,E.275	;
	JRST	WARN		;

	INTER.	PA222.
PA222.:	FLAGAT	HI
	MOVEI	TA,120		;'RELEASE' OP CODE
	JRST	SETOP1

	INTER.	PA223.
PA223.:	FLAGAT	HI
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	MOVEI	TA,121		;'RETURN' OP CODE
	JRST	SETOP1

	INTER.	PA224.
PA224.:	MOVE	TA,FL.OEN##	;'OBJECT OF ENTER'
	JRST	FLENT.
SUBTTL REPORT WRITER SYNTAX

;"GENERATE"

	INTER.	PA225.
PA225.:	FLAGAT	RP
	HRRZI	TA,124		;GENERATE OP CODE
	JRST	SETOP1

;"GENERATE <REPORT-ITEM-NAME>"

	INTER.	PA226.
PA226.:	DMOVEM	W1,ARG1		;GET READY TO PUTGEN THIS ITEM
	PUSHJ	PP,DA96.D	;CONVERT QUALIFIERS TO A DATAB LINK
	HRRZI	TA,(TE)		;CONVERT DATAB LINK TO RPWTAB LINK
	HRRZI	TB,(TE)
	TRZ	TB,077777
	CAIE	TB,100000
	JRST	PA226E
	PUSHJ	PP,LNKSET
	LDB	TB,DA.RPW##
	HRRZ	TA,RPWLOC##
	ADDI	TA,(TB)
	LDB	TC,RW.TYP##
	CAIE	TC,%RG.DE
	JRST	PA226E
	HRRM	TB,ARG1		;OK, STORE REAL DATAB LINK
	DMOVE	W1,ARG1		;READY TO CALL PA2.
	SKPNAM

;"GENERATE <REPORT-NAME>"

	INTER.	PA227.
PA227.:	PUSHJ	PP,PA2.		;GET ITEM IN ARG1, ARG1+1
	PUSHJ	PP,CHKUFL	;MAKE SURE NOT IN USE PROCEDURE AND
				; REFERENCING A REPORT IN THE SAME FILE
	PUSHJ	PP,PA21.	;WRITE OUT THE ARGUMENT
	PUSHJ	PP,PA22.	;WRITE OUT OPERATOR
	MOVE	TA,W1		;[1527] GET RPWTAB LINK TO RD ENTRY
	ADD	TA,RPWLOC	;[1527] MAKE ABSOLUTE ADDRESS
	LDB	TC,RW.TYP##	;[1527] DID WE PROCESS A <REPORT-ITEM-NAME>?
	CAIN	TC,%RG.DE	;[1527]
	JRST	PA0.		;[1527]  YES, THEN EXIT NOW
	SETOM	TD		;[1527] SET NUMBER OF DETAIL GROUPS TO -1
	LDB	TA,RW.FGP##	;GET ADDRESS OF LAST GROUP IN RD ENTRY
PA227A:	CAIE	TA,1		;[1527] POINTING TO DUMMY DATAB ENTRY
	SKIPN	TA		;OR NO GROUPS ?
	JRST	PA0.		;YES, POP UP NODE STACK AND RETURN
	PUSHJ	PP,LNKSET	;GET ABSOLUTE ADDRESS
	LDB	TA,DA.RPW	;GET RPWTAB LINK
	ADD	TA,RPWLOC	;MAKE IT ABSOLUTE
	LDB	TB,RW.TYP	;GET TYPE OF THIS GROUP
	CAIN	TB,%RG.DE	;TYPE DETAIL ?
	AOJ	TD,		;YES, ADD ONE TO COUNTER
	SKIPLE	TD		;SEEN MORE THAN ONE DETAIL GROUP ?
	JRST	PA227E		;YES, GENERATE WARNING
	LDB	TB,RW.DAT##	;REGET DATAB LINK
	LDB	TC,RW.DAT	;FNDBRO IS DIFFERENT IN THIS MODULE
	PUSHJ	PP,FNDBRO	;GET BROTHER
	JRST	PA0.
	MOVE	TA,TB
	JRST	PA227A		;REPEAT FOR NEXT GROUP

PA226E:	EWARNW	E.361		;NOT A TYPE DETAIL ITEM
	JRST	PA0.		;POP UP TO HIGHER NODE
PA227E:	EWARNW	E.786		;CAN ONLY HAVE ONE DETAIL GROUP WHEN SUMMARY
	JRST	PA0.		;POP UP TO HIGHER NODE
;"INITIATE"

	INTER.	PA228.
PA228.:	FLAGAT	RP
	HRRZI	TA,123		;INITIATE OP CODE
	JRST	SETOP1

;"INITIATE/TERMINATE <REPORT-NAME>"

	INTER.	PA229.
PA229.:	PUSHJ	PP,PA2.		;GET ITEM IN ARG1, ARG1+1
	PUSHJ	PP,CHKUFL	;MAKE SURE WE ARE NOT IN A USE PROCEDURE AND
				; REFERENCING A REPORT IN THE SAME FILE
	PUSHJ	PP,PA21.	;WRITE OUT ARGUMENT
	JRST	PA160.		;WRITE OPERATOR AND SAVE INCASE THERE IS A LIST

;SORT/MERGE COLLATING SEQUENCE

	INTER.	PA229A
PA229A:	PUSHJ	PP,PA2.
	PUSHJ	PP,PA21.
	JRST	PA160.

;"TERMINATE"

	INTER.	PA230.
PA230.:	FLAGAT	RP
	HRRZI	TA,125		;TERMINATE OP CODE
	JRST	SETOP1
;ROUTINE TO CHECK FOR BEING IN A "USE BEFORE REPORTING" PROCEDURE
; WHEN A REPORT IS REFERENCED.  THIS IS NOT ALLOWED BY THE ANSI
; COBOL-74 STANDARD, BUT DEC ALLOWS IT IF THE REPORT REFERENCED
; IS NOT IN THE SAME FILE.
;  THIS ROUTINE WILL GENERATE A WARNING AND SET THE OPERATOR TO "YECCH"
;IF THE USER HAS ILLEGALLY REFERENCED A REPORT.
;
;CALL:	PUSHJ	PP,CHKUFL
;	<RETURN HERE ALWAYS>

CHKUFL:	SKIPN	TA,INUPRG	;SKIP IF IN A "USE BEFORE REPORTING"
				; DECLARATIVES PROCEDURE
	  POPJ	PP,		;NOT, OK THEN
	ADD	TA,RPWLOC	;COULD BE TROUBLE--POINT TO GROUP ITEM
	LDB	TA,RW.RDL##	;GET LINK TO RD
	ADD	TA,RPWLOC	;POINT TO RD
	LDB	TE,RW.FIL##	;TE:= LINK TO FILTAB OF "USE" REPORT

;FIND FILTAB OFFSET OF THE NAMED REPORT OR REPORT GROUP,
; GIVE WARNING IF THEY ARE THE SAME.
	MOVE	TA,ARG1		;OFFSET IN RPWTAB OF GROUP OR RD
	ADD	TA,RPWLOC
	SKIPL	(TA)		;SKIP IF GROUP
	 JRST	CHKUF1		;BIT 0 = 0, MEANS RD
	LDB	TA,RW.RDL	;GET LINK TO RD
	ADD	TA,RPWLOC
CHKUF1:	LDB	TA,RW.FIL	;TA:= LINK TO FILTAB OF NAMED REPORT
	CAMN	TA,TE		;SAME FILE REFERENCED?
	 POPJ	PP,		;NO, LET HIM GET AWAY WITH IT
				; NO HARM DONE EXCEPT VIOLATE THE "STANDARD"

;SAME FILENAME - COULD BE TROUBLE - INFINITE LOOP AT RUNTIME WOULD
;BE POSSIBLE
;"FMay not reference a report in a USE BEFORE REPORTING procedure
;which uses the same file as the USE report group"
	EWARNW	E.644		;GENERATE THE ABOVE ERROR
	MOVEI	TA,105		;SET OPERATOR TO "YECCH"
	PJRST	SETOP3		; THEN RETURN
;"WITH NO ADVANCING" CLAUSE FOR "DISPLAY" VERB

	INTER.	PA231.
PA231.:	SETO	TA,
	DPB	TA,OP.DNA##	;SET NO ADVANCING BIT
	POPJ	PP,

;"WITH DELETE" CLAUSE FOR CLOSE

	INTER.	PA232.
PA232.:	FLAGAT	NS
	SETO	TA,
	DPB	TA,OP.WDL##	;SET "DELETE" BIT
	POPJ	PP,

;"USE BEFORE REPORTING" STATEMENT

	INTER.	PA233.
PA233.:	PUSHJ	PP,DA96.D	;GET REPORT GROUP NAME WITH QUALIFIER
	HRRZ	TA,DATLOC##	;MAKE PTR TO ITEM
	ADDI	TA,(TE)
	SUBI	TA,<CD.DAT>B20
	LDB	TB,DA.RPW	;GET CORRESP. RPWTAB LINK
	JUMPE	TB,JCE267	;?MUST BE A REPORT GROUP
	MOVEM	TB,INUPRG	;REMEMBER WE ARE IN A USE PROCEDURE
	LDB	TC,DA.LVL	;MAKE SURE IT IS A GROUP-LEVEL ITEM
	SOJN	TC,JCE267	; (ERROR IF NOT LEVEL 01)
	HRRZ	TA,RPWLOC	;MAKE PTR TO RPWTAB ENTRY
	ADDI	TA,(TB)
	MOVEM	TA,CURRPW##	;SAVE IT
	PUSHJ	PP,GETTAG	;GET TAG FOR USE PROCEDURE
	HRRZ	TA,CURRPW	;STORE TAG IN RPWTAB
	DPB	CH,RW.USE##
	JRST	PRFSUB##	;OUTPUT PRF. UUO TO AS2FILE

JCE267:	EWARNJ	E.267
;PLUS SIGN FOLLOWS SUBSCRIPT IDENTIFIER

	INTER.	PA234.
PA234.:	MOVE	TA,NSBSC1	;MAKE INDEX TO SUBSCRIPT TABLE
	ASH	TA,2
	MOVSI	TB,400000	;CLR BIT 0 OF 1ST WORD OF ENTRY
	ANDCAM	TB,SBSCR1-4(TA)	;  TO INDICATE PLUS
	POPJ	PP,

;MINUS SIGN FOLLOWS SUBSCRIPT IDENTIFIER

	INTER.	PA235.
PA235.:	MOVE	TA,NSBSC1
	ASH	TA,2
	MOVSI	TB,400000	;SET BIT 0 OF 1ST WORD OF ENTRY
	IORM	TB,SBSCR1-4(TA)	;  TO INDICATE MINUS
	POPJ	PP,

;INTEGER TO BE ADDED TO SUBSCRIPT

	INTER.	PA236.
PA236.:	PUSHJ	PP,PA2.		;PROCESS LITERAL
	MOVE	TA,NSBSC1	;MAKE INDEX TO SUBSCRIPT TABLE
	ASH	TA,2
	MOVE	TB,ARG1		;STORE WORDS FOR ADDITIVE
	MOVEM	TB,SBSCR1-2(TA)
	MOVE	TB,ARG1+1
	MOVEM	TB,SBSCR1-1(TA)
	POPJ	PP,

	INTER.	PA236A
PA236A:				; did the index end the last expected
	MOVE	TB,NBRSUB	;  subscript?
	CAMLE	TB,NSBSC1	;
	POPJ	PP,		; No, keep looking
	PUSHJ	PP,PA220.	; Yes, all found
	SETOM	RMFLG##		; turn on Ref Mod flag
	JRST	PA0.		; pop up one level
;SET UP TRACE OPERATOR

	INTER.	PA237.
PA237.:	FLAGAT	NS
	HRRZI	TA,126		;"TRACE" OP CODE
	SKIPE	PRODSW##	;/P ON?
	HRRZI	TA,105		;YES, GENERATE A YECCH INSTEAD
	JRST	SETOP1

	INTER.	PA238.
PA238.:
IFN DEBUG,<SETOM TRACFL##>	;TURN ON SYNTAX SCAN TRACE (PROVIDED /TP ON)
	SKIPE	PRODSW		;/P ON?
	POPJ	PP,		;YES
	SETO	TA,		;'ON' FLAG
PA238A:	DPB	TA,OP.TRC##
	POPJ	PP,

	INTER.	PA239.
PA239.:
IFN DEBUG,<SETZM TRACFL>	;TURN OFF SYNTAX SCAN TRACE
	SKIPE	PRODSW		;/P ON?
	POPJ	PP,		;YES
	SETZ	TA,		;'OFF' FLAG
	JRST	PA238A
SUBTTL	TABLE HANDLING SYNTAX

;SET UP SEARCH OPERATOR

	INTER.	PA240.
PA240.:	FLAGAT	HI
	PUSHJ	PP,GETTAG	;GET TAG FOR END OF WHENS
	ANDI	CH,077777
	JUMPE	CH,PA240.	;[511] %0 NOT ALLOWED
	HRRZM	TYPE,CURVRB	;SAVE VERB FOR END-SEARCH
	AOS	TA,SPFLVL	;[511] GET NESTED LEVEL
	ADD	TA,IFLVL	;[511] ADD IF NESTED LEVEL
	CAILE	TA,IF.DEP	;[511] MORE THAN LIMIT?
	JRST	PA240A		;[511] YES OVERFLOW
	HRLZM	CH,ARGL2-1(TA)	;[511] SAVE THE TAG FOR LATER
	HRLZM	CH,CURTAG##	;  & SAVE IT (USING CURTAG(LH) FOR SCRATCH)
	SKIPE	SWHEN##		;[1005] 'WHEN' ALREADY ACTIVE?
	EWARNW	E.632		;[1005] GIVE ERROR MSG.
	SETOM	SWHEN##		;DIDN'T SEE "." BEFORE "WHEN"
	HRRZI	TA,OPSEAR	;SEARCH OP CODE
	JRST	SETOP

PA240A:	EWARNW	E.323		;[511] MORE THAN 12 NESTED IF/SEARCH 
	JRST	PA133.		;[511] GET OUT

;DATA NAME FOR SEARCH & INDEX FOR SEARCH

	INTER.	PA241.
PA241.:	DMOVEM	W1,ARG1		;STORE ITEM WORDS
	PUSHJ	PP,PA820.	;[1553]SAVE CURRENT RESERVED WORD.
	PUSHJ	PP,DA96.D	;GET ALL QUALIFIERS
	HRRM	TE,ARG1
	JRST	PA21.

;SET SEARCH 'ALL' FLAG

	INTER.	PA242.
PA242.:	SETO	TB,
	DPB	TB,OP.ALL##
	POPJ	PP,

;SINCR OPERATOR AFTER ALL WHENS DONE

	INTER.	PA244.
PA244.:	HRRZI	TA,(TYPE)
	ANDI	TA,777		;TYPE LESS A-MARGIN BIT
	CAIE	TA,PRIOD.	;IF NOT A PERIOD, TURN OFF FLAG THAT PA245.
	SWOFF	FPERWD		; [413] TURNED ON, BECAUSE WE ARE COMING UP FROM
				;AN 'ELSE'
	PUSHJ	PP,PA37.
	PUSHJ	PP,PA246.	;OUTPUT SINCR
	JRST	PA247.		;OUTPUT %ENDWHN TAG
;OUTPUT JUMPTO TAG-FOLLOWING-ALL-WHENS

	INTER.	PA245.
PA245.:	HRRZI	TA,(TYPE)
	ANDI	TA,777		;TYPE LESS A-MARGIN BIT
	SETZM	EWFLG##		;[1553] RESET WHEN SEEN FLAG
	CAIN	TA,PRIOD.	;IF AT END OF SEARCH STATEMENT
	SWON	FPERWD		; [413]   REGET THE PERIOD
PA245B:	HRRZI	TA,OPJUMP	;[1556] REMOVE EXTRANEOUS PERIOD CODE
	PUSHJ	PP,SETOP
	HLLZ	TB,CURTAG
	HLLM	TB,OPRTR+1
	SWOFF	UNCONT;		;INCASE "GOTO" OR "STOP RUN" IN SEARCH
	MOVEI	TC,SEARC.	;[1553] TERMINATOR TO LOOK FOR
	PUSHJ	PP,PA824.	;[1553] CLEAN UP TERMINATOR STACK
	JRST	PA22.		;GO OUTPUT JUMP OPERATOR

;OUTPUT SINCR

	INTER.	PA246.
PA246.:	HRRZI	TA,OPSINC
	PUSHJ	PP,SETOP
	JRST	PA22.

;OUTPUT %ENDWHN TAG

	INTER.	PA247.
PA247.:	MOVE	TA,SPFLVL		;[511] GET SEARCH LEVEL
	ADD	TA,IFLVL		;[511] ADD IF LEVEL FOR INDEX
	HLRZ	CH,ARGL2-1(TA)		;[511] RETRIEVE TAG
	HLLM	CH,ARGL2-1(TA)		;[511] REMOVE ENTRY
	SOS	SPFLVL			;[511] SUBTRACT 1 LEVEL
	SWOFF	UNCONT			;[460] SEARCH IS NOT UNCOND. GO TO
	JRST	PA139X
;CALL

	INTER.	PA248.
PA248.:	FLAGAT	LI
	PUSHJ	PP,PA169.	;SET 'ENTER' OP CODE
PA248A:	SETO	TA,		;[171] NEW LABEL FOR ENTRY FROM PA143A FOR ENTER COBOL

	DPB	TA,OP.CAL##	;SET 'CALL' BIT
	POPJ	PP,

;ENTER FORTRAN

	INTER.	PA249.
PA249.:	SETO	TA,		;SET 'FORTRAN' BIT
	DPB	TA,OP.F10##
	POPJ	PP,


;CANCEL

	INTER.	PA250.
PA250.:	FLAGAT	HI
	HRRZI	TA,130		;'CANCEL' OP CODE
	JRST	SETOP1

;OPERANDS FOR CANCEL

	INTER.	PA251.
PA251.:	PUSHJ	PP,PA2.		;SET UP OPERAND
	PUSHJ	PP,PA172.	;PUT IN EXTAB
	HRRZ	TA,W1		;GET EXTAB LINK
	PUSHJ	PP,LNKSET
	PUSHJ	PP,PA251S	;PUT OPERAND NAME IN HLDTAB
	JRST	PA21.
;PUT A NAME IN HLDTAB FOR USE BY PHASE E

PA251S:	HRRZM	TA,CUREXT##	;SAVE ABS PTR

	LDB	TB,EX.NAM	;MAKE PTR TO NAME
	HRRZ	TA,NAMLOC
	ADDI	TB,1(TA)
	HLRZ	TD,NAMLOC	;[261] GET SIZE OF NAMTAB TABLE
	TRC	TD,-1		;[261] MAKE IT POSITIVE
	ADDI	TA,(TD)		;[261] GET LAST NAMTAB TABLE ADDRESS
PA251A:	CAIGE	TA,(TB)		;[261] ARE WE STILL IN NAMTAB
	JRST	PA251T		;[261] NO- DONE
	MOVE	TC,(TB)		;[261]GET NAMTAB WORD
	TLNE	TC,600000	;BEGINNING OF NEXT ENTRY?
	AOBJP	TB,PA251A	;NO, COUNT IT

PA251T:	HLRZ	TB,TB		;[261] GET NAMWRD COUNT
	PUSH	PP,TB		;SAVE COUNT
	ADDI	TB,2		;SIZE OF HLDTAB ENTRY WANTED
	MOVSI	TA,CD.HLD	;GET SPACE FOR ENTRY
	HRRI	TA,(TB)
	PUSHJ	PP,GETENT
	MOVEI	TB,100		;ENTRY TYPE CODE
	DPB	TB,HL.COD##
	POP	PP,TB		;COUNT OF EXTRA WORDS
	DPB	TB,HL.QAL##
	PUSH	PP,TA		;SAVE HLDTAB LINK

	HRRZ	TA,CUREXT	;SET UP 'FROM' PTR
	LDB	TB,EX.NAM##
	HRRZ	TA,NAMLOC
	ADDI	TB,(TA)
	HRLI	TB,(POINT 6,0,35)
	HRRZ	TA,(PP)		;SET UP 'TO' PTR
	ADDI	TA,2
	HRLI	TA,(POINT 6,)
PA251B:	ILDB	TD,TB
	TRNN	TD,60		;2 HI ORDER BITS ZERO?
	JRST	PA251C		;YES, END OF NAME
	CAIN	TD,':'		;CONVERT : TO -
	MOVEI	TD,'-'
	IDPB	TD,TA
	JRST	PA251B

PA251C:	POP	PP,TA		;PUT HLDTAB LINK IN EXTAB
	HLRZ	TB,TA
	HRRZ	TA,CUREXT	;GET BACK EXTAB PTR
	DPB	TB,EX.HLD##
	POPJ	PP,
;EXIT PROGRAM

	INTER.	PA253.
PA253.:	FLAGAT	LI
	SETOM	SUBPRG##	;INDICATE THIS IS A SUBPROGRAM
	HRRZI	TA,37		;'GOBACK' OP CODE
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.PGM##	;'EXIT PROGRAM' BIT
	JRST	PA22.		;OUTPUT OPERATOR

	INTER.	PA253A
PA253A:				;Wanted 'PROGRAM', found period
	EWARNW	E.18		;Improper clause
	SWON	FREGWD		;
	JRST	PA253.		;Fall into 'EXIT PROGRAM' code
;LITERAL FOR SUBPROGRAM NAME - CONVERT TO NORMAL NAME

	INTER.	PA254.
PA254.:	LDB	TB,GWVAL	;GET CHAR COUNT
	CAILE	TB,^D30		;RESTRICT TO 30 CHARS
	MOVEI	TB,^D30
	MOVE	TC,[POINT 7,LITVAL]
	MOVE	TD,[POINT 6,NAMWRD]
PA254A:	SOJL	TB,PA254B	;LOOP TO MOVE CHARS
	ILDB	TE,TC
	CAIL	TE,141		;CONVERT LC TO UC
	TRZ	TE,40
	CAIG	TE,"Z"		;CK FOR ILLEGAL CHARS
	CAIGE	TE,"A"
	CAIG	TE,"9"
	CAIGE	TE,"0"
	CAIN	TE,"-"
	CAIA
	EWARNJ	E.57		;?ILLEGAL CHAR
	SUBI	TE,40		;CONVERT TO SIXBIT
	IDPB	TE,TD
	JRST	PA254A

PA254B:	HRLZI	W1,GWNOT
	PUSHJ	PP,TRYNAM
	  POPJ	PP,		;NOT FOUND
	HLRZ	TB,(TA)		;WAS IT A RESERVED WORD?
	TRNE	TB,GWRESV
	EWARNJ	E.315		;YES
	SETZ	W1,
	HLRS	TA		;[246]  GET NAMTAB RELATIVE LOCATION
	DPB	TA,[POINT 15,W2,15]	;[246] STORE FOR LATER CHECK AT PA260.
	POPJ	PP,		;RESUME NORMAL PROCESSING
;OVERFLOW OPTION FOR CALL/ENTER

	INTER.	PA255.
PA255.:	FLAGAT	HI
	PUSHJ	PP,PA820.	;PUT RESERVED WORD ON TEMTAB STACK
	LDB	TA,OP.OPC	;USING OPERATOR WAITING?
	CAIN	TA,46
	PUSHJ	PP,PA22.	;YES, PUT IT OUT
	HRRZI	TA,23		;'SPECIAL IF'
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.OVR##	;'ON OVERFLOW'
PA255A:	PUSHJ	PP,GETTAG##
	ANDI	CH,077777
	JUMPE	CH,PA255A	;%0 NOT ALLOWED
	DPB	CH,OP.TRG##
	AOS	TA,SPFLVL
	ADD	TA,IFLVL
	CAILE	TA,^D12		;ARGL2 OVERFLOW?
	JRST	PA255B		;YES
	HRLZM	CH,ARGL2-1(TA)
	JRST	PA22.

PA255B:	EWARNW	E.323
	JRST	PA133.		;GIVE UP
;ENTRY

	INTER.	PA256.
PA256.:	FLAGAT	NS
	SETOM	SUBPRG		;INDICATE THIS IS A SUBPROGRAM
PA256A:	SWOFF	UNCONT		;MAY FOLLOW UNCONDIT GOTO
	HRRZI	TA,77		;'ENTRY' OP CODE
	JRST	SETOP1

;ENTRY-NAME

	INTER.	PA257.
PA257.:	PUSHJ	PP,PA2.		;PUT SYMBOL IN NAMTAB
	PUSHJ	PP,CHKEXT	;CHECK LENGTH
	PUSHJ	PP,PA172.	;PUT IN EXTAB
	HRRZ	TA,W1		;GET LINK TO EXTAB ENTRY
	PUSHJ	PP,LNKSET
PA257A:	SETO	TB,		;SET ENTRY BIT
	DPB	TB,EX.ENT##
	PJRST	PA251S		;PUT ENTRY NAME IN HLDTAB

;CHECK LENGTH OF EXTERNAL NAME

CHKEXT:	SKIPN	NAMWRD+1	;MORE THAN 6 CHARS?
	POPJ	PP,		;NO
	HRRZI	DW,E.410	;[214]
	JRST	WARN		;YES, ERROR

;SET UP PROCEDURE DIVISION ENTRY

	INTER.	PA258.
PA258.:	PUSHJ	PP,PA256A	;'ENTRY' OP CODE
	SETO	TB,		;SET PROC DIV ENTRY FLAG
	DPB	TB,OP.PD##
	HRR	W1,PIDLNK##	;GET LINK TO PROGRAM-ID
	DMOVEM	W1,ARG1		;[631] SET UP ARGS
	HRRZI	TA,(W1)		;PUT PROGRAM-NAME IN HLDTAB
	PUSHJ	PP,LNKSET
	PJRST	PA251S

;USING CLAUSE FOR PROCEDURE DIVISION HEADER

	INTER.	PA259.
PA259.:	FLAGAT	LI
	SETOM	SUBPRG		;SET SUBPROGRAM FLAG
	POPJ	PP,

;PROGRAM-NAME FOR CALL & ENTER

	INTER.	PA260.
PA260.:	PUSHJ	PP,CHKEXT	;CHECK SIZE OF NAME
	PUSHJ	PP,PA172.	;SET UP EXTAB ENTRY
	LDB	TE,OP.CAL	;IS THIS A CALL?
	JUMPE	TE,CPOPJ	;NO
	HRRZ	TA,W1		;YES, GET EXTAB LINK
	PUSHJ	PP,LNKSET
	SETO	TE,		;SET "REFERENCED-BY-CALL" BIT
	DPB	TE,EX.CAL##
	POPJ	PP,
;OUTPUT TAG IF NO INITIAL SECTION OR PARA NAME

	INTER.	PA261.
PA261.:	SKIPE	PROGST##	;STORED ALREADY?
	JRST	PA24.		;YES
	PUSHJ	PP,GETTAG	;NO, GET A TAG FOR IT
	HRRM	CH,PROGST	;REMEMBER FOR START CODE IN COBOLG
	HRRZ	TA,CH
	PUSHJ	PP,REFTAG##	;IT WILL BE REFERENCED IN PHASE G
	ANDI	CH,077777	;OUTPUT TAG
	HRLI	TB,(CH)
	HRRI	TB,102		;TAG OP CODE
	HRLZI	TA,102000
	PUSHJ	PP,PUTGEN
	JRST	PA24.

;ENTRY IS ALREADY IN EXTAB

	INTER.	PA262.
PA262.:	PUSHJ	PP,PA2.
	HRRZ	TA,W1		;GET LINK TO EXTAB ENTRY
	PUSHJ	PP,LNKSET
	LDB	TB,EX.ENT	;GET ENTRY DEFN BITS
	JUMPE	TB,PA257A	;REF'D BY A CALL -- LET PHASE E FLAG IT
	EWARNW	E.397		;?DUPLICATE ENTRY DEFN
	HRRZI	TA,105		;"YECCH" OP CODE
	JRST	SETOP1
;IMPROPER SUBSCRIPT ERROR

	INTER.	PA263.
PA263.:	MOVEI	W1,<CD.DAT>B20+1	;USE DUMMY DATA ITEM FOR SUBSCRIPT
	TLZ	W2,777770
	DMOVEM	W1,ARG1		;NO NEED TO GIVE DIAGNOSTIC BECAUSE
				;  PHASE E DOES IT ALREADY
	SWOFF	FREGWD		;GO ON TO NEXT SOURCE ITEM
	HRRZI	TA,(W1)		;[262] SET UP DUMMY RELATIVE ADDRESS
	PUSHJ	PP,LNKSET	;[262] GET DATAB ADR FOR DUMMY
	HRRM	TA,CURDAT	;[262] STORE IT
	HRLM	W1,CURDAT	;[262] PUT BACK DATAB RELATIVE ADR
	POPJ	PP,

;SET DECLARED BY ENTRY OR PD USING CLAUSE BIT IN DATAB

	INTER.	PA264.
PA264.:	HRRZI	TA,(W1)		;GET DATAB LINK
	PUSHJ	PP,LNKSET
PA264A:	SETO	TB,		;[***]
	DPB	TB,DA.RBE##
	LDB	TB,DA.LVL	;[***] GET LEVEL
	SOJN	TB,CPOPJ	;[***] GIVE UP UNLESS LEVEL 1
	LDB	TA,DA.BRO##	;[***] DOES IT HAVE A BROTHER
	JUMPE	TA,CPOPJ	;[***] NO, GIVE UP
	PUSHJ	PP,LNKSET	;[***] YES, POINT TO IT
	LDB	TB,DA.RDF	;[***] IS IT A REDEFINES
	JUMPN	TB,PA264A	;[***] YES, SET BIT IN HERE ALSO
	POPJ	PP,		;[***]
SUBTTL	DBMS SYNTAX

IFN DBMS,<

;SAVE SET-NAME AS A LITERAL FOR 'IF SET-NAME SET [NOT] EMPTY' CONDITION
;  OR 'IF RECORD [NOT] [MEMBER/OWNER] OF SET-NAME/ANY SET' CONDITION

	INTER.	PA265.
PA265.:	MOVEI	TC,^D30		;CHAR CTR
	MOVE	TB,[POINT 6,NAMWRD]
PA265A:	ILDB	TD,TB
	SKIPE	TD		;END OF WORD?
	SOJG	TC,PA265A	;LOOKED AT ALL 30 CHARS?

	MOVEI	TB,^D30		;GET POS CHAR COUNT
	SUBI	TB,(TC)
	PUSH	PP,TB		;SAVE CHAR COUNT

	ADDI	TB,2+4		;ALLOW FOR COUNT AND ROUNDING
	IDIVI	TB,5		;CONVERT TO WORDS

	HRRZI	TA,(TB)		;GET VALTAB ENTRY OF THAT SIZE
	HRLI	TA,CD.VAL
	PUSHJ	PP,GETENT

	HLR	W1,TA		;SAVE OPERAND
	TLO	W1,GWLIT	;SET LITERAL FLAG
	TLZ	W2,777774	;[353] CLEAR ALL BUT LINE AND CHAR POSITION.
	DMOVEM	W1,ARG1

	POP	PP,TB		;PUT BYTE COUNT IN ENTRY
	DPB	TB,[POINT 14,(TA),13]

	MOVE	TC,[POINT 6,NAMWRD]	;FROM PTR
	MOVSI	TD,(POINT 7,(TA),13)	;TO PTR
	MOVE	W1,[POINT 7,LITVAL]	;[1035] MAKE BYTE POINTER

PA265B:	ILDB	TE,TC
	ADDI	TE,40		;MAKE ASCII
	CAIN	TE,":"		;CONVERT GETITM'S COLON TO DASH
	MOVEI	TE,"-"
	IDPB	TE,TD
	IDPB	TE,W1		;[1035] SAVE IN LITVAL, TOO
	SOJG	TB,PA265B	;DONE ALL YET?
	IDPB	TB,W1		;[1035] STORE A NULL AT THE END FOR FNDSYM
	MOVE	W1,ARG1		;RESTORE W1 AGAIN
	SKIPN	SYMTAB		;[1035] CHECK FOR INVOKE DONE
	 JRST	PA265D		;[1035] NO, MESSED UP
	MOVS	TA,NAMWRD	;GET SET NAME
	CAIN	TA,'ANY'	;BUT DON'T CHECK FOR ANY
	POPJ	PP,		;AS ITS ALWAYS VALID
	MOVEI	TA,[-2,,0	;[1035] GET ARGUMENTS
		SYMTAB##	;[1035] TABLE
		17B12+LITVAL]+1 ;[1305] SYMBOL
	PUSH	PP,0		;[1035] PRESERVE ACS OVER CALL
	PUSH	PP,1		;[1035] ...
	PUSHJ	PP,FNDSYM##	;[1035] LOOK FOR SYMBOL IN SUBSCHEMA
	MOVE	TA,0		;[1035] COPY NAME
	POP	PP,1		;[1035] RESTORE ACS
	POP	PP,0		;[1035] ...
	JUMPN	TA,CPOPJ	;[1035] OK IF FOUND
	SKIPE	SYMTAB		;[1114] [1035] SKIP SUB-SCHEMA MSG IF NO INVOKE
	EWARNJ	E.588		;[1035] MUST BE DEFINED IN SUBSCHEMA

;IF "<undefined name>" and no INVOKE done. Probably not DBMS.
PA265D:	SWON	FREGWD;		;Set so we reget word
	POPJ	PP,		;Let compiler give "undefined" error
;STILL IN IFN DBMS

;SET UP IFDB OPERATOR FOR 'IF SET-NAME SET [NOT] EMPTY'

	INTER.	PA266.
PA266.:	PUSHJ	PP,PA21.	;SET UP OPERAND
	MOVE	TE,OP.EMP##	;GET SET EMPTY CONDITION FLAG
PA266A:	SETZM	OPRTR+1	
	HRRZI	TA,131		;IFDB OPERATOR
	PUSHJ	PP,SETOP1
	JRST	P195.B

;ERROR: 'IF <USER-NAME>' NOT FOLLOWED BY 'SET'

	INTER.	PA267.
PA267.:	LDB	LN,[POINT 13,ARG1+1,28]
	LDB	CP,[POINT 7,ARG1+1,35]
	HRRZI	DW,E.104	; [314] UNDEFINED
	JRST	FATAL
;STILL IN IFN DBMS

;SAVE OPRTR FLAG FOR 'IF RECORD *MEMBER* OF SET-NAME SET'

	INTER.	PA268.
PA268.:	MOVE	TE,OP.MEM##
PA268A:	MOVEM	TE,TBLOCK
	POPJ	PP,

;SAVE OPRTR FLAG FOR 'IF RECORD *OWNER* OF SET-NAME/ANY SET'

	INTER.	PA269.
PA269.:	MOVE	TE,OP.OWN##
	JRST	PA268A

;SAVE OPRTR FLAG FOR 'IF RECORD <<OWNER OR MEMBER>> OF SET-NAME/ANY SET'

	INTER.	PA270.
PA270.:	MOVE	TE,OP.MOO##
	JRST	PA268A

;SET UP OPERATOR FOR 'IF RECORD [MEMBER/OWNER] OF SET-NAME/ANY SET'

	INTER.	PA271.
PA271.:	PUSHJ	PP,PA21.	;SET UP OPERAND
	MOVE	TE,TBLOCK	;GET PTR TO FLAG BIT
	JRST	PA266A
;STILL IN IFN DBMS

;SET UP USETAB ENTRY FOR 'USE IF ERROR-STATUS'

	INTER.	PA272.
PA272.:	MOVE	TB,['ERROR:']	;CK FOR ERROR-STATUS DATA-NAME
	CAME	TB,NAMWRD
	JRST	PA272E		;NO
	MOVE	TB,['STATUS']
	CAME	TB,NAMWRD+1
	JRST	PA272E		;NO
	SKIPE	NAMWRD+2
	JRST	PA272E		;NO

	MOVE	TA,[CD.USE,,SZ.USE]	;GET ROOM FOR NEW ENTRY
	PUSHJ	PP,GETENT
	MOVEI	TB,%UT.ES	;SET ERROR-STATUS FLAG
	DPB	TB,US.TYP##
	HLRZ	TB,CURPRO	;LINK USE TO CURRENT SECTION
	DPB	TB,US.PRO##
	HLRZM	TA,CURUSE##	;REMEMBER REL ADDR OF USETAB ENTRY
	POPJ	PP,

	INTER.	PA272E
PA272E:	EWARNW	E.405		;?ERROR-STATUS EXPECTED
	SWOFF	FREGWD		;SKIP TO NEXT SOURCE ITEM
	HRRZI	NODE,PD1127##	;RETURN TO ERROR NODE IN TREE
	HRRZM	NODE,(NODPTR)
	POPJ	PP,
;STILL IN IFN DBMS

;SCAN USETAB FOR ERROR-STATUS ENTRIES WITH SELECTED CODES
;  WHICH WOULD MEAN AN ILLEGAL COMBINATION OR ERROR-STATUS USE-PROCS
;
;CTR=0 IMPLIES ANY OTHER ERROR-STATUS ENTRY IS AN ERROR
;CTR NOT = 0 IMPLIES ANY ENTRY WITH CODE=CTR IS AN ERROR
;	AND ANY ENTRY WITH CODE -1 (GENERAL PURPOSE ENTRY) IS AN ERROR
;SKIP RETURN IF NO ERROR

PA272S:	HRRZ	TA,USELOC##	;INIT SCAN OF USETAB ERROR-STATUS ENTRIES
	ADDI	TA,1
	HRRZ	TB,USELOC	;STOP WHEN ENTRY BEFORE CURRENT HAS BEEN CHECKED
	ADD	TB,CURUSE

PA272A:	CAIL	TA,(TB)		;CHECKED ALL?
	JRST	CPOPJ1		;YES, NO ERRORS

	LDB	TC,US.TYP##	;THIS AN ERROR-STATUS ENTRY?
	CAIE	TC,%UT.ES
	JRST	PA272B		;NO

	LDB	TC,US.XTR##	;EXTRA WORDS ALLOCATED FOR THIS ENTRY?
	JUMPE	TC,PA272B	;NO (MUST HAVE BEEN LEFT BY AN ERROR)

	SKIPN	CTR		;WHICH TYPE OF CHECK ARE WE DOING?
	EWARNJ	E.406		;ANY OTHER ENTRY IS AN ERROR

	LDB	TC,US.CNT	;GET EXTRA WORDS COUNT
	MOVE	TD,[POINT 18,1(TA),17]	;SET PTR TO GET ERROR CODES
PA272D:	ILDB	TE,TD		;GET NEXT ERROR CODE FROM ENTRY
	JUMPE	TE,PA272B	;NO MORE

	CAIE	TE,-1		;-1 OR CTR IS AN ERROR
	CAMN	TE,CTR
	EWARNJ	E.406
	SOJG	TC,PA272D	;CK WORD COUNT

PA272B:	LDB	TC,US.XTR	;ADVANCE TO NEXT ENTRY
	JUMPE	TC,PA272C	;NO EXTRA WORDS IN THIS ENTRY
	LDB	TC,US.CNT##	;GET # OF EXTRA WORDS
	ADDI	TA,(TC)
PA272C:	AOJA	TA,PA272A	;TRY NEXT ENTRY
;STILL IN IFN DBMS

;STORE GIVEN ERROR-STATUS CODE IN USETAB ENTRY

	INTER.	PA273.
PA273.:	LDB	TB,GWVAL	;GET THE VALUE OF THE INTEGER
	MOVEM	TB,CTR
	HRRZI	TA,LITVAL
	PUSHJ	PP,GETVAL
	MOVEM	TC,CTR		;SAVE VALUE FOR LATER STORAGE

	PUSHJ	PP,PA272S	;SCAN USETAB FOR SAME CODE OR GEN-PURP CODE
	  POPJ	PP,		;ERROR RETURN

PA273A:	HRRZ	TA,USELOC	;GET PTR TO CURRENT USETAB ENTRY
	ADD	TA,CURUSE
	LDB	TB,US.XTR	;ANY EXTRA WORDS ALREADY ALLOCATED?
	JUMPN	TB,PA273F	;YES

	MOVE	TA,[CD.USE,,SZ.USE]	;GET ROOM FOR 1ST EXTRA WORD
	PUSHJ	PP,GETENT
	HRRZ	TA,USELOC	;GET BACK PTR TO CURRENT USETAB ENTRY
	ADD	TA,CURUSE
	SETO	TB,		;SET EXTRA WORD FLAG
	DPB	TB,US.XTR
	MOVEI	TB,1		;SET EXTRA WORD COUNT IN ENTRY
	DPB	TB,US.CNT
	AOJA	TA,PA273H	;BUMP PTR UP TO EXTRA WORD

PA273F:	LDB	TC,US.CNT	;GET # OF EXTRA WORDS
	MOVEI	TC,1(TC)	;BUMP WORD COUNT IN ENTRY
	DPB	TC,US.CNT
	TRNE	TC,1		;HOW MANY CODES STORED ALREADY?
	JRST	PA273G		;ODD #

	MOVE	TA,[CD.USE,,SZ.USE]	;GET ANOTHER WORD
	PUSHJ	PP,GETENT
	MOVE	TC,CTR		;STORE NEW CODE IN LEFT HALF OF NEW WORD
	HRLZM	TC,(TA)
	POPJ	PP,

PA273G:	LSH	TC,-1		;MAKE PTR TO LAST EXTRA WORD
	ADDI	TA,1(TC)
PA273H:	MOVE	TC,CTR		;STORE NEW WORD IN RIGHT HF OF WORD
	HRRM	TC,(TA)
	POPJ	PP,
;STILL IN IFN DBMS

;STORE CODE FOR GENERAL PURPOSE 'USE IF ERROR-STATUS' ENTRY

	INTER.	PA274.
PA274.:
	;;;	JUST FORBID A PRIOR "USE" OF SAME FORM
	MOVEI	TC,-1		;STORE GENERAL PURPOSE CODE IN ENTRY
	MOVEM	TC,CTR
	PUSHJ	PP,PA272S	;SCAN USETAB FOR OTHER E-S ENTRIES
	  POPJ	PP,		;ERROR RETURN
	JRST	PA273A


	INTER.	PA277R		;[1026] HANDLE MOVE CURRENCY STATUS FOR <REC> RECORD
PA277R:	MOVE	TA,W1		;[1026] GET "RECORD NAME" TABLE LINK
	PUSHJ	PP,LNKSET	;[1026] GET DATA TABLE
	LDB	TB,DA.LVL	;[1026] GET LEVEL NUMBER
	CAIN	TB,LVL.01	;[1026] CHECK FOR LEVEL 1 (A RECORD)
	 JRST	PA277.		;[1026] YES, GO ON
	EWARNJ	E.422		;[1026] COMPLAIN THAT IT MUST BE A RECORD

;PROCESS "CLOSE ALL" DBMS COMMAND

	INTER.	PA275.
PA275.:	FLAGAT	DB
	PUSHJ	PP,PA276.
	SKPNAM

	INTER.	PA277.
PA277.:	MOVSI	W1,5!GWLIT!GWNLIT
PA277A:	MOVE	TA,[POINT	6,NAMWRD]	;GET PTR TO USER-NAME
	PUSHJ	PP,FIXLIT	;FIX IT LIKE A LITERAL
	PUSHJ	PP,PA2.		;SET UP OPERAND
	JRST	PA21.		;OUTPUT OPERAND

FIXLIT:	MOVE	TB,[POINT	7,LITVAL]
	SETZ	TD,		;CLEAR CHAR COUNT
FIX2:	ILDB	TC,TA		;GET CHAR
	CAIL	TD,^D30		;WOULD THIS CHAR BE OUT-OF-BOUNDS?
	SETZM	TC		;YES, SO FAKE TERM-CHAR
	CAIN	TC,':'		;CONVERT ALL ":" BACK TO "-"
	MOVEI	TC,'-'
	SKIPE	TC		;DON'T CONVERT IF ZERO
	ADDI	TC,40		;CONVERT TO ASCII
	IDPB	TC,TB		;DEPOSIT IT IN LITVAL
	JUMPE	TC,FIX3
	AOJA	TD,FIX2		;BUMP COUNTER

FIX3:	JUMPN	W1,FIXNMID
	HRLZ	W1,TD		;MOVE COUNT IN W1
	TLO	W1,1B19		;SET BIT 1
	POPJ	PP,

FIXNMID:
	SM.NMID==SM.USR##+1
	MOVEI	TA,[-2,,0
			SYMTAB##
		   17B12+LITVAL]+1
	;;;	0/1 USED BY SUBROUT
	SKIPN	SYMTAB				;INVOKE STAT MESSED UP?
	JRST	FIXNM1				;YES
	PUSH	PP,0
	PUSH	PP,1
	PUSHJ	PP,FNDSYM##
	MOVE	TA,0				;FIND A SYMBOL
	POP	PP,1
	POP	PP,0
	JUMPN	TA,FIXNM2
FIXNM1:	EWARNW	E.588				;NO BAD
	SKIPA	TB,[ASCII/00000/]		;FUDGE IT
FIXNM2:	MOVE	TB,SM.NMID(TA)
	MOVEM	TB,LITVAL
	POPJ	PP,

	INTER.	PA276.
PA276.:	MOVEI	W1,%CLOSE##	;SET UP "CLOSD" ADDRESS
	SKPNAM

	INTER.	PA278.
PA278.:	FLAGAT	DB
	PUSHJ	PP,PA169.	;SET UP ENTER OPRTR
	PUSHJ	PP,PA141.	;...AND MACRO BIT
	PUSHJ	PP,PA2.		;CONSTRUCT ARG1,ARG1+1
	JRST	PA217.		;OUTPUT THEM

	INTER.	PA279.
PA279.:	MOVEI	W1,%STORE##		;GET STORE EXTAB OFFSET
	PUSHJ	PP,PA278.
	JRST	PA277.


;SET UP "INSERT" REFERENCE.

	INTER.	PA280.
PA280.:	MOVEI	W1,%INSRT##
	JRST	PA278.

;MODIFY <REC-NAME>.

	INTER.	PA281.
PA281.:	MOVEI	W1,%MODIF##
	JRST	PA278.


;SET UP REFERENCE TO "GETS"

	INTER.	PA282.
PA282.:	MOVEI	W1,%GETS##
	JRST	PA278.

;OUTPUT OPERAND REFERENCE TO DBMS-NULL.

	INTER.	PA283.
PA283.:	MOVE	TB,[ASCII/00000/]	;PASS 0 CAUSE SIMPLER & NO ARG PASSING PROB
	MOVEM	TB,LITVAL
	MOVSI	W1,5!GWLIT!GWNLIT
	PUSHJ	PP,PA2.		;SET UP ARG1
	JRST	PA21.		;OUTPUT OPERAND

;REMOVE VERB

	INTER.	PA284.
PA284.:	MOVEI	W1,%REMOV##
	JRST	PA278.
;STILL IN IFN DBMS
;ACTIONS FOR "DELETE" VERB.

SAVEPP:	POP	PP,TE		;GET RETURN ADDRESS
	PUSH	PP,W1
	PUSH	PP,W2
	PUSH	PP,CT
	PUSH	PP,NAMWRD
	PUSH	PP,NAMWRD+1
	PUSH	PP,NAMWRD+2
	PUSH	PP,NAMWRD+3
	PUSH	PP,NAMWRD+4
	JRST	(TE)

GETPP:	POP	PP,TE
	POP	PP,NAMWRD+4

	POP	PP,NAMWRD+3
	POP	PP,NAMWRD+2
	POP	PP,NAMWRD+1
	POP	PP,NAMWRD
	POP	PP,CT
	POP	PP,W2
	POP	PP,W1
	JRST	(TE)


	INTER.	PA285.
PA285.:	PUSHJ	PP,SAVEPP
	MOVEI	W1,%DELET##
	PUSHJ	PP,PA278.
	PUSHJ	PP,PA283.	;OUTPUT DBMS-NULL
	PUSHJ	PP,GETPP
	JRST	PA277.

;PROCESS THE STATEMENT:	DELETE.

	INTER.	PA285A
PA285A:	MOVEI	W1,%DELET
	PUSHJ	PP,PA278.
	PUSHJ	PP,PA283.
	JRST	PA283.

	INTER.	PA286.
PA286.:	PUSHJ	PP,SAVEPP
	PUSHJ	PP,GETEM.	;GET <REC-NAME> BACK AGAIN
	PUSHJ	PP,PA2.		;OUTPUT IT
	PUSHJ	PP,PA171.
	PUSHJ	PP,GETPP
	PUSHJ	PP,PA170.	;NOW, WE ARE LOOKING AT "INVALID"
	PUSHJ	PP,PA216.
	PUSHJ	PP,PA22.
	JRST	PA90.
	INTER.	PA287.
PA287.:	MOVEI	W1,%DELET
	PUSHJ	PP,PA278.
	PUSHJ	PP,GETEM.	;GET <REC-NAME> BACK
	PUSHJ	PP,PA277.	;OUTPUT AS LITERAL
	JRST	PA283.		;OUTPUT DBMS-NULL.


	INTER.	PA288.
PA288.:	PUSHJ	PP,SAVEPP
	MOVEI	W1,%DELET
	PUSHJ	PP,PA278.
	PUSHJ	PP,GETEM.	;GET <REC-NAME>
	PUSHJ	PP,PA277.
	PUSHJ	PP,GETPP
	JRST	PA277.

	INTER.	PA288A;		;'DELETE <REC-NAME> OF ...'
PA288A:	PUSHJ	PP,	SAVEPP
	PUSHJ	PP,	GETEM.
	PUSHJ	PP,	PA2.
	PUSHJ	PP,	PA171.
	PUSHJ	PP,	GETPP
	POPJ	PP,
;STILL IN IFN DBMS

;THESE SUBROUTINES ARE DESIGNED TO PRESERVE THE VITAL
;INFORMATION ABOUT THE CURRENT ITEM BEING SCANNED.  THIS INFO CAN
;THEN BE RESTORED LATER AS IF THE SCANNER WAS RETURNING TO THE
;PREVIOUS WORD.

	INTER.	SAVEM.
SAVEM.:	PUSH	SAVPTR,W1
	PUSH	SAVPTR,W2
	PUSH	SAVPTR,CT
	PUSH	SAVPTR,NAMWRD
	PUSH	SAVPTR,NAMWRD+1
	PUSH	SAVPTR,NAMWRD+2
	PUSH	SAVPTR,NAMWRD+3
	PUSH	SAVPTR,NAMWRD+4
	POPJ	PP,


	INTER.	GETEM.
GETEM.:	POP	SAVPTR,NAMWRD+4
	POP	SAVPTR,NAMWRD+3
	POP	SAVPTR,NAMWRD+2
	POP	SAVPTR,NAMWRD+1
	POP	SAVPTR,NAMWRD
	POP	SAVPTR,CT
	POP	SAVPTR,W2
	POP	SAVPTR,W1
	POPJ	PP,
;STILL IN IFN DBMS
;SET UP "MOVE" EXTERNAL REFERENCE.

	INTER.	PA289.
PA289.:	MOVEI	W1,%MOVEC##
	JRST	PA278.





;OUTPUT DBMS-NULL, AND "RUN-UNIT".

	INTER.	PA290.
PA290.:	PUSHJ	PP,SAVEM.		;SAVE "RUN-UNIT"
	PUSHJ	PP,PA283.		;OUTPUT DBMS-NULL
	PUSHJ	PP,GETEM.
	MOVEI	TA,15		;15=SIXBIT /-/
	DPB	TA,[POINT	6,NAMWRD,23]
	JRST	PA277.			;NOW, PUT OUT "RUN-UNIT".
;STILL IN IFN DBMS
;ACTIONS FOR "FIND" VERB AND RSE.

	INTER.	PA291.
PA291.:	PUSHJ	PP,PA292.
	JRST	PA283.



	INTER.	PA292.
PA292.:	MOVEI	W1,%FIND2##
	JRST	PA278.



	INTER.	PA293.
PA293.:	MOVEI	W1,%FIND4##
	JRST	PA278.



	INTER.	PA294.
PA294.:	PUSHJ	PP,PA292.
	PUSHJ	PP,GETEM.	;GET <REC-NAME> BACK AGAIN
	JRST	PA277.		;PUT IT OUT.



;FIND OWNER <SET-NAME>.
	INTER.	PA295.
PA295.:	PUSHJ	PP,PA293.
	PUSHJ	PP,GETEM.
	JRST	PA277.




	INTER.	PA296.
PA296.:	PUSHJ	PP,SAVEM.
	PUSHJ	PP,PA297.
	PUSHJ	PP,GETEM.
	JRST	PA277.




	INTER.	PA297.
PA297.:	MOVEI	W1,%FIND3##
	JRST	PA278.




	INTER.	PA297A
PA297A:	MOVEI	W1,%FINDO##	;FIND OFFSET GETS SPECIAL PATH FOR V4
	JRST	PA278.

	INTER.	PA298.
PA298.:	PUSHJ	PP,SAVEM.
	PUSHJ	PP,PA297A
	PUSHJ	PP,GETEM.
	JRST	PCA5.		;OUTPUT INTEGER

	INTER.	PA299.
PA299.:	PUSHJ	PP,SAVEM.	;COME HERE ON "DUPLICATE"
	PUSHJ	PP,PA300.
	PUSHJ	PP,GETEM.
	SETZ	TA,
	DPB	TA,[POINT	6,NAMWRD,23]	;TRUNCATE TO "DUP"
	JRST	PA277.




	INTER.	PA300.
PA300.:	MOVEI	W1,%FIND5##
	JRST	PA278.




	INTER.	PA301.
PA301.:	MOVEI	W1,%FIND1##
	JRST	PA278.




	INTER.	PA302.
PA302.:	PUSHJ	PP,PA301.
	PUSHJ	PP,GETEM.
	JRST	PA277.




	INTER.	PA303.
PA303.:	PUSHJ	PP,PA300.
	PUSHJ	PP,PA283.
	PUSHJ	PP,GETEM.
	JRST	PA277.

	INTER.	PA304.
PA304.:	PUSHJ	PP,PA297A
	PUSHJ	PP,GETEM.
	PUSHJ	PP,PA2.		;[675] MAKE SURE ITS IN NAMTAB
	HRRZ	TA,ARG1		;[675] GET TABLE ENTRY
	JUMPE	TA,PA304A	;[675] INCASE OF ERROR
	PUSHJ	PP,LNKSET	;[675] SET UP POINTER TO DATAB
	LDB	TD,DA.CLA##	;[675] GET CLASS OF DATAB
	LDB	TE,DA.NDP##	;[675] GET NUMBER OF DECIMAL PLACES
	CAIN	TD,%CL.NU	;[675] MUST BE NUMERIC
	JUMPE	TE,PA304B	;[1104] [675] AND HAVE NO DECIMAL PLACES
	HRRZI	DW,E.264	;[675] NO, ERROR
PA304C:	LDB	CP,[POINT 7,ARG1+1,35]	;[1104] [675]
	LDB	LN,[POINT 13,ARG1+1,28]	;[675]
	PUSHJ	PP,FATAL	;[675]
PA304A:	PUSHJ	PP,PA21.	;[675]
	JRST	PA283.

PA304B:	LDB	TD,DA.USG	;[1104] GET USAGE
	CAIE	TD,%US.1C	;[1431] [1104] MUST BE ONE-WORD COMPUTATIONAL
	CAIN	TD,%US.IN	;[1431]  OR INDEX
	JRST	PA304A		;[1104] OK
	HRRZI	DW,E.639	;[1431] [1104] GET ERROR
	JRST	PA304C		;[1104] AND PROCESS


	INTER.	PA305.
PA305.:	PUSHJ	PP,SAVEPP
	PUSHJ	PP,PA304.	;OUTPUT <REC>, NULL.
	PUSHJ	PP,GETPP
	JRST	PA277.




	INTER.	PA306.
PA306.:	PUSHJ	PP,SAVEPP
	PUSHJ	PP,PA297A
	PUSHJ	PP,GETEM.
	PUSHJ	PP,PA2.		;[1046] BREAK UP PCA5. CALL INTO TWO PIECES
	HRRZ	TA,ARG1		;[1046] GET THE ENTRY
	JUMPE	TA,PA306A	;[1046] ...
	PUSHJ	PP,LNKSET	;[1046] GET DATAB ENTRY
	LDB	TD,DA.USG	;[1046] GET USAGE
	LDB	TE,DA.NDP	;[1443] GET NO. DECIMAL PLACES
	CAIE	TD,%US.1C	;[1431] [1046] MUST BE ONE-WORD COMP
	CAIN	TD,%US.IN	;[1431]  OR INDEX
	 JUMPE	TE,PA306A	;[1443] [1046] AND NO DECIMAL PLACES
	HRRZI	DW,E.639	;[1046] NO GOOD, GIVE ERROR
	LDB	CP,[POINT 7,ARG1+1,35]	;[1046] GET CHARACTER POSITION
	LDB	LN,[POINT 13,ARG1+1,28]	;[1046] AND LINE NUMBER
	PUSHJ	PP,FATAL	;[1046] GIVE FATAL ERROR
PA306A:	PUSHJ	PP,PA21.	;[1046]
	PUSHJ	PP,GETPP
	JRST	PA277.




	INTER.	PA307.
PA307.:	PUSHJ	PP,SAVEPP
	PUSHJ	PP,PA297.
	PUSHJ	PP,GETEM.
	PUSHJ	PP,PA277.
	PUSHJ	PP,GETPP
	JRST	PA277.




	INTER.	PA308.
PA308.:	PUSHJ	PP,PA297.
	PUSHJ	PP,GETEM.
	PUSHJ	PP,PA277.
	JRST	PA283.




	INTER.	PA309.
PA309.:	PUSHJ	PP,PA299.	;OUTPUT "DUP"
	JRST	GETEM.		;POP GARBAGE OFF STACK




	INTER.	PA310.
PA310.:	PUSHJ	PP,PA301.
	JRST	PA283.
;STILL IN IFN DBMS
;ACTIONS FOR "OPEN" VERB.

	INTER.	PA311.
PA311.:	FLAGAT	DB
	SETZM	BUFCTR##
	MOVEI	W1,%OPEND##
	JRST	PA278.




	INTER.	PA312.
PA312.:	MOVE	TA,BUFCTR	;GFET # OF ENTRIES
	CAIL	TA,^D10		;IS TABLE FULL?
	EWARNJ	E.428		;YES, GIVE ERROR AND IGNORE NEW ENTRY.
	LSH	TA,3		;MULTIPLY BY 8
	ADDI	TA,BUFFER##-1	;GET ADDRESS OF NEW ENTRY
	PUSH	TA,W1
	PUSH	TA,W2		;PUSH ALL GOOD STUFF INTO TABLE
	PUSH	TA,CT
	PUSH	TA,NAMWRD
	PUSH	TA,NAMWRD+1
	PUSH	TA,NAMWRD+2
	PUSH	TA,NAMWRD+3
	PUSH	TA,NAMWRD+4
	AOS	BUFCTR		;BUMP COUNT
	POPJ	PP,




	INTER.	PA313.
PA313.:	SETZ	TA,
	DPB	TA,[POINT	6,NAMWRD,29]
	JRST	SAVEM.		;SAVE "EXCLUSIVE"




; ***	OPEN VERB NOW COMES HERE IF BOTH ACCESS &SHARE-LEVEL SPEC
	INTER.	PA314.
PA314.:	PUSHJ	PP,PA277.
	PUSHJ	PP,GETEM.	;GET TYPE OF UPDATE
	JRST	PA277.		;OUTPUT IT


	INTER.	PA315.
PA315.:	SETZ	W1,		;SO FIXLIT WILL KNOW TRUE LIT...I.E. NOT PRESENT
	PUSHJ	PP,PA277A	;SKIP THE PRESET
	SKPNAM
	INTER.	PA316.
PA316.:	SETZ	TB,		;OUTPUT ALL OPERANDS STORED IN BUFFER
P3161.:	MOVE	TA,TB		;GET TEMP COUNTER
	LSH	TA,3		;MULTIPLY BY 8
	ADDI	TA,BUFFER-1+^D8	;POINT TO END OF NEXT ENTRY
	HRLI	TA,^D10		;SET UP FAKE PUSH-DOWN COUNT
	POP	TA,NAMWRD+4
	POP	TA,NAMWRD+3	;GET GOOD STUFF
	POP	TA,NAMWRD+2
	POP	TA,NAMWRD+1
	POP	TA,NAMWRD
	POP	TA,CT
	POP	TA,W2
	POP	TA,W1
	PUSH	PP,TB		;SAVE COUNTER FOR NOW
	PUSHJ	PP,PA277.	;OUTPUT OPERAND
	POP	PP,TB
	AOS	TB		;BUMP COUNTER
	CAME	TB,BUFCTR	;HAVE WE GOTTEN ALL ENTRIES?
	JRST	P3161.		;NO
	POPJ	PP,

; ***	OPEN VERB COMES HERE IF JUST ACCESS SPEC
	INTER.	PA317.
PA317.:	PUSHJ	PP,PA277.
	JRST	PA283.

	INTER.	PA318.
PA318.:	MOVE	TA,[SIXBIT /RETR/]	;OUTPUT "RETR"
	MOVEM	TA,NAMWRD
	JRST	PA277.

	INTER.	PA319.
PA319.:	FLAGAT	DB
	PUSHJ	PP,SAVEM.	;SAVE "ALL"
	PUSHJ	PP,PA311.	;OUTPUT EXTERNAL REFERENCE
	PUSHJ	PP,GETEM.
	JRST	PA312.

	INTER.	PA320.
PA320.:	PUSHJ	PP,PA318.
	PUSHJ	PP,PA283.
	PUSHJ	PP,PA283.
	JRST	PA316.





	INTER.	PA321.
PA321.:	PUSHJ	PP,PA283.	;OUTPUT NULL
	JRST	PA22.		;OUTPUT BAD OPERAND


IFN DBMS6,<
	INTER.	PAOT01
PAOT01:	MOVEI	W1,%OPENT##	;OPEN A TRANSACTION
	JRST	PA278.

	INTER.	PACT01
PACT01:	MOVEI	W1,%CLOTR##	;CLOSE A TRANSACTION
	JRST	PA278.

	INTER.	PADT01
PADT01:	MOVEI	W1,%DELTR##	;DELETE A TRANSACTION
	JRST	PA278.

	INTER.	PAFIN6
PAFIN6:	MOVEI	W1,%FIND6##	;FIND RSE6
	PUSHJ	PP,PA278.
	PUSHJ	PP,GETEM.	;GET BACK THE RECNAME THAT HAS ALREADY BEEN EATEN
	JRST	PA277.		;PUT IT OUT IN ADDITION TO THE CALL & GO BACK TO PARSE
	>			;END IFN DBMS6
>;END IFN DBMS




;COME HERE BEFORE DECLARATIVES TO SEE IF THERE IS
;A DBMS FILE TO BE PROCESSED.

	INTER.	PA322.
PA322.:	SKIPN	FINVD##		;IS OUR FLAG SET?
	POPJ	PP,		;NO, EXIT
IFE DBMS,<
	OUTSTR	[ASCIZ /?PA322.: FINVD flag is set
/]
	JRST	KILL##
>
IFN DBMS,<
	SETZM	FINVD		;THIS TELLS GETITM TO DELETE FILES
	;[%316] DELETE BUMP OF DBCNTC SINCE RCLAIM NO MORE
	AOS	DBCNTD##	;Bump count of INVOKES
	PUSHJ	PP,DBGTF.##	;GO PROCESS 1ST FILE (###DB1.TMP)
	SETOM	FINVOK##	;SET INVOKE FLAG
	SETZM	SRCCOL##
	TSWFZ	FSEQ		;[453] IS /S SWITCH ON--IF YES TURN IT OFF
	SETOM	DBONLY##	;[453] IT WAS ON, REMEMBER IT
	POPJ	PP,
>
SUBTTL	MCS SYNTAX


;DISABLE/ENABLE ACTIONS

IFN MCS,<
	INTER.	PA323.
PA323.:	FLAGAT	HI
	HRRZI	TA,132		;DISABLE OPERATOR
	JRST	SETOP

	INTER.	PA324.
PA324.:	PUSHJ	PP,PA323.	;SET UP OP CODE
	SETO	TA,
	DPB	TA,OP.ENA##	;SET ENABLE BIT
	POPJ	PP,

	INTER.	PA325.
PA325.:	HRRZ	TA,W1		;CHECK TO MAKE SURE IT'S AN...
	ADD	TA,CDLOC##	;...INPUT CD!
	SKIPGE	1(TA)		;INPUT CD?
	EWARNW	E.458		;NO
	JRST	PA328.		;GO ON

	INTER.	PA326.
PA326.:	SETO	TA,
	DPB	TA,OP.TRM##	;SET TERMINAL BIT
	POPJ	PP,

	INTER.	PA327.
PA327.:	SETO	TA,
	DPB	TA,OP.OT2##	;SET OUTPUT
	POPJ	PP,

	INTER.	PA328A
PA328A:	LDB	TE,GWVAL	;TEST FOR ZERO ONLY
	CAIN	TE,ZERO.
	JRST	PA328.		;OK
	EWARNW	E.638		;TELL USER
	MOVEI	TE,ZERO.	;TURN IT INTO ZERO
	DPB	TE,GWVAL	;TO AVOID ERROR IN COBOLE
	SKPNAM

	INTER.	PA328.
PA328.:	PUSHJ	PP,PA2.		;OUTPUT OPERAND
	JRST	PA21.

	INTER.	PA329.
PA329.:	FLAGAT	HI
	HRRZI	TA,133
	PUSHJ	PP,SETOP	;SET OP CODE
	JRST	PA328.

	INTER.	PA330.
PA330.:	FLAGAT	HI
	HRRZI	TA,134		;SEND OP CODE
	JRST	SETOP

	INTER.	PA330A
PA330A:	HRRZ	TA,W1		;CHECK FOR OUTPUT CD
	ADD	TA,CDLOC##
	SKIPL	1(TA)
	EWARNW	E.453		;ERROR IF INPUT CD
	JRST	PA328.		;NO, OUTPUT OPERAND
	INTER.	PA331.
PA331.:	MOVSI	TA,(ASCIZ /0/)	;OUTPUT "0"

;SUBROUTINE TO OUTPUT A LITERAL NUMERIC
OUTLIT:	MOVEM	TA,LITVAL
	MOVSI	W1,1B19+1B23+1	;SET "LITERAL","NUMERIC LITERAL",LENGTH (ALWAYS 1)
	JRST	PA328.		;OUTPUT IT


	INTER.	PA332.
PA332.:	HRRZ	TA,W1		;CHECK FOR ALPHANUMERIC
	PUSHJ	PP,LNKSET	;FIND DATAB ENTRY
	LDB	TB,DA.CLA##	;[772] GET DATA TYPE
IFN TOPS20,<
	CAIE	TB,%CL.NU	;TCS WANTS TO ALLOW INTEGERS HERE
	JRST	PA332A		;NOT NUMERIC, CONTINUE TESTING
	LDB	TB,DA.USG	;GET USAGE
	CAIE	TB,%US.1C	;1-WORD COMP?
	CAIN	TB,%US.IN	;OR INDEX?
	JRST	PA2.		;YES
	TRNA			;NO, GIVE ERROR
PA332A:>
	CAIE	TB,%CL.AN
	EWARNW	E.454		;NOT ALPHANUMERIC
	JRST	PA2.


	INTER.	PA333.
PA333.:	MOVSI	TA,(ASCIZ /1/)	;ESI
	JRST	OUTLIT


	INTER.	PA334.
PA334.:	MOVSI	TA,(ASCIZ /2/)	;EMI
	JRST	OUTLIT

	INTER.	PA335.
PA335.:	MOVSI	TA,(ASCIZ /3/)	;EGI
	JRST	OUTLIT

IFE TOPS20,<
	INTER.	PA336.
PA336.:	MOVSI	TA,(ASCIZ /4/)	;EPI
	JRST	OUTLIT
>

	INTER.	PA337.
PA337.:	SETO	TA,
	DPB	TA,OP.AF2##	;SET "AFTER" BIT
	POPJ	PP,
	INTER.	PA338.
PA338.:	SETO	TA,
	DPB	TA,OP.PAG##	;SET PAGE BIT
	JRST	PA331.



	INTER.	PA339.
PA339.:	FLAGAT	HI
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	HRRZI	TA,135		;'RECEIV' OP CODE
	JRST	SETOP

	INTER.	PA340.
PA340.:	SETO	TA,
	DPB	TA,OP.SEG##	;SET SEGMENT BIT
	POPJ	PP,

	INTER.	PA341.
PA341.:	SETO	TA,
	DPB	TA,OP.NDP##	;SET 'NO DATA PHRASE' BIT
	PUSHJ	PP,PA22.	;OUTPUT RECEIV OPERATOR
P341A:	HRRZI	TA,23		;SPIF OP CODE
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.ATE##	;SET 'AT END' BIT
	DPB	TA,OP.SPN##	;SPECIAL IF, NO I-O
	JRST	PA90.A		;OUTPUT SPIF

>;END OF MCS ACTIONS
;STRING ACTIONS

;OUTPUT DUMMY DATAB ENTRY FOR MISSING DATA ITEM

	INTER.	PA360.
PA360.:	PUSHJ	PP,DE111.	;?IDENTIFIER EXPECTED
	PUSHJ	PP,PA263.	;SUBSTITUTE DUMMY DATAB ENTRY
	JRST	PA21.

;SET UP SDELIM OPERATOR

	INTER.	PA361.
PA361.:	HRRZI	TA,SDELIM
	JRST	SETOP

;MISSING DELIMITED BY CLAUSE

	INTER.	PA363.
PA363.:	EWARNW	E.462		;?'DELIMITED BY' CLAUSE REQUIRED
	PUSHJ	PP,PA361.	;SET UP SDELIM OPERATOR WITH SIZE FLAG
	SKPNAM

;SET 'DELIMITED BY SIZE' FLAG

	INTER.	PA362.
PA362.:	SETO	TA,
	DPB	TA,OP.DSZ##
	POPJ	PP,

;SET UP STRING OPERATOR

	INTER.	PA364.
PA364.:	HRRZI	TA,STRNG
	JRST	SETOP

;SET 'WITH POINTER' FLAG

	INTER.	PA365.
PA365.:	SETO	TA,
	DPB	TA,OP.PTR##
	POPJ	PP,

;SET 'ON OVERFLOW' FLAG

	INTER.	PA366.
PA366.:	SETO	TA,
	DPB	TA,OP.OVF##
	PUSHJ	PP,PA820.	;PUT RESERVED WORD ON TEMTAB STACK
	POPJ	PP,
;UNSTRING ACTIONS

	INTER.	PA370.
PA370.:	HRLZI	TA,ARG1		;SAVE SOME THINGS ABOUT SOURCE-ITEM
	HRRI	TA,STRSAV##	;ADDR OF SAVE AREA
	BLT	TA,STRSAV+1	;[765] SAVE OPERAND (TWO WORDS)
	MOVE	TB,NSBSC1
	MOVEM	TB,STRSAV+2	;SAVE # OF SUBSCRIPTS
	HRLI	TA,SBSCR1
	HRRI	TA,STRSAV+3
	BLT	TA,STRSAV+3+<MAXSUB*4>-1 ;[765] SAVE SUBSCRIPT INFO
	SETZM	NSBSC1##	;RESET SUBSCRIPT COUNT FOR NEXT ITEM.
	POPJ	PP,

	INTER.	PA372.
PA372.:	HRRZI	TA,UDELIM	;SET UP UDELIM OPERATOR
	JRST	SETOP

	INTER.	PA373.
PA373.:	SETO	TA,		;SET THE 'ALL' FLAG
	DPB	TA,OP.ALL##
	POPJ	PP,

	INTER.	PA374.
PA374.:	PUSHJ	PP,PA22.	;OUTPUT PREVIOUS UDELIM
	JRST	PA372.		;SET UP NEW UDELIM OP

	INTER.	PA375.
PA375.:	HRRZI	TA,UNSDES	;SET UP UNSDES OPERATOR
	JRST	SETOP

	INTER.	PA376.
PA376.:	SETO	TA,		;SET 'DELIMITER IN' FLAG
	DPB	TA,OP.DEL##
	POPJ	PP,

	INTER.	PA377.
PA377.:	SETO	TA,		;SET 'COUNT IN' FLAG
	DPB	TA,OP.COU##
	POPJ	PP,

	INTER.	PA378.
PA378.:	PUSHJ	PP,PA22.	;OUTPUT LAST UNSDES OP
	HRLZI	TA,STRSAV	;SET UP TO RESTORE SOURCE-ITEM
	HRRI	TA,ARG1
	BLT	TA,ARG1+1
	MOVE	TB,STRSAV+2
	MOVEM	TB,NSBSC1	;GET # OF SUBSCRIPTS
	HRLI	TA,STRSAV+3
	HRRI	TA,SBSCR1	;RESTORE SUBSCRIPT INFO
	BLT	TA,SBSCR1+<MAXSUB*4>-1 ;[765] FOUR WORDS FOR EACH SUBSCRIPT
	PUSHJ	PP,PA21.	;OUTPUT IT
	HRRZI	TA,UNSTR	;SET UP UNSTR OPERATOR
	JRST	SETOP

	INTER.	PA379.
PA379.:	SETO	TA,		;SET 'TALLYING IN' FLAG
	DPB	TA,OP.TLG##
	POPJ	PP,

	INTER.	PA380.
PA380.:	PUSHJ	PP,PA22.	;OUTPUT PREVIOUS UNSDES OPERATOR
	JRST	PA375.		;SET UP NEW UNSDES OP


; CHECK FIG CONSTANT- ONLY ZERO IS LEGAL.

	INTER. PA400.
PA400.:	LDB	TA,[POINT 9,W1,17]	;[265] GET WHICH FIG CONSTANT
	CAIN	TA,ZERO.	;[265] IS IT ZERO?
	JRST	PA2.		;[265] YES-OK
	EWARNW	E.131		;[265] NO- ILLEGAL
	MOVEI	TA,ZERO.	;[265] MAKE ZERO
	DPB	TA,[POINT 9,W1,17]	;[265] TO PREVENT MORE ERRORS
	JRST	PA2.		; [265]

;SET WITH SEQUENCE CHECK FOR MERGE VERB

	INTER.	PA401.
PA401.:	FLAGAT	NS
	SETO	TA,
	DPB	TA,OP.WSC##
	POPJ	PP,

;Error recovery nodes

	INTER.	PA450.
PA450.:	PUSHJ	PP,PAYECC	;SET OPERATOR TO "YECCH"
	EWARNJ	E.104		;DATA-NAME NOT DEFINED

	INTER.	PA451.
PA451.:	PUSHJ	PP,PAYECC	;SET OPERATOR TO "YECCH"
	EWARNJ	E.101		;IDENTIFIER EXPECTED
SUBTTL	COBOL-74 SYNTAX

;START FILE-NAME KEY ARITHMETIC-CONDITION

	INTER.	PA500.
PA500.:	SETO	TA,
	DPB	TA,OP.EQU
	POPJ	PP,

	INTER.	PA501.
PA501.:	SETO	TA,
	DPB	TA,OP.GRT
	POPJ	PP,

	INTER.	PA502.
PA502.:	SETO	TA,
	DPB	TA,OP.LES
	POPJ	PP,

	INTER.	PA503.
PA503.:	PUSHJ	PP,PA2.		;GET FILTAB
	MOVE	TA,ARG1
	HRLZM	TA,CURFIL	;SAVE FOR LATTER CHECKING
	SKIPN	FLGSW		;WANT FIPS FLAGGER?
	JRST	PA21.		;NO, WRITE OPERAND
	ADD	TA,FILLOC	;ADD IN BASE
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
	MOVE	TA,[0			;SEQUENTIAL - NOT POSSIBLE
		%LV.HI			;RELATIVE
		%LV.H			;INDEXED
		0](TB)
	PUSHJ	PP,FLG.ES##	;FLAG IF ILLEGAL
	JRST	PA21.		;OUTPUT OPERATOR
;START.. KEY IS DATANAME
; DATANAME MUST BE EITHER
;1) A KEY OF THAT FILE
;2) AN ITEM SUBORDINATE TO THAT KEY WITH THE SAME STARTING POSITION
;  IF 2),
;  AND DATANAME SIZE IS LESS THAN KEY SIZE, THE SIZE IS PASSED TO PHASE E

	INTER.	PA504.
PA504.:	HLRZ	TA,CURFIL
	PUSHJ	PP,LNKSET	;CONVERT TO ADDRESS
	HRRM	TA,CURFIL
	HRRZ	TB,ARG1		;GET ITEM
	LDB	TC,FI.ORG##
	JRST	@[EXP PA504E,PA504R,PA504I,PA504E](TC)

;RELATIVE FILE
PA504R:	LDB	TC,FI.ACK##	;GET ACTUAL KEY
	CAMN	TC,TB		;IS IT THE SAME AS USER SPECIFIED?
	 POPJ	PP,		;YES, ALL IS WELL
	CAIE	TC,AS.MSC##	;NO, COULD IT BE A CONVERTED KEY?
	 JRST	PCASER		;NO
	LDB	TC,FI.CKA##	;YES, GET REAL KEY
	CAME	TC,TB		;CHECK AGAIN
	 JRST	PCASER		;STILL WRONG
	POPJ	PP,
;INDEXED FILES

PA504I:
;CHECK THE PRIMARY RECORD KEY
PCASK0:	MOVE	TA,TB		;PTR TO ITEM
	PUSHJ	PP,LNKSET	;GET ITEM PTR
	LDB	TD,DA.DFS##	;Better be defined in the file section..
	JUMPE	TD,PCASKE	; No, can't be a key then.

;This data item is defined in the file section. Now we can check
; LOC and RES to see if it starts in the same place as a key.
; [1354] Also store size in case multiple keys with the same offsets.
	LDB	TD,DA.INS##	;[1354] Get size of user's item
	MOVEM	TD,DKEYSZ##	;[1465] [1354]  save for later test
	LDB	TD,DA.LOC	;GET LOC
	LDB	TE,DA.RES	;AND RESIDUE
	MOVE	TA,CURFIL
	LDB	TA,FI.RKY	;GET PTR TO RECKEY
	JUMPE	TA,PAYECC	;(If no record key defined, then this
				; program has errors. Forget about trying
				; to generate code for this START statement).
	PUSH	PP,TD		;SAVE LOC
	PUSH	PP,TE		; and RES of the user's item
	PUSHJ	PP,LNKSET	;Point to DATAB entry of RECORD KEY.
	LDB	TD,DA.LOC
	LDB	TE,DA.RES
	CAMN	TD,-1(PP)	;DOES ITEM START SAME PLACE AS KEY?
	CAME	TE,0(PP)
	 JRST	PCASAK		;NO, TRY ALTERNATE KEYS
	LDB	TD,DA.INS	;[1354] Get size of key field
	CAMGE	TD,DKEYSZ	;[1465] [1354] If key greater or equal, match
	JRST	PCASAK		;[1354]  else search alternatives
	POP	PP,(PP)
	POP	PP,(PP)		;FIX STACK
	JRST	PCASK1		;GO USE RECORD KEY

;NOT THE PRIMARY RECORD KEY.. TRY ALTERNATE KEYS
;TOP OF STACK HAS RESIDUE & LOC OF THE ITEM
PCASAK:	MOVE	TA,CURFIL
	LDB	TA,FI.ALK	;SEE IF ANY ALTERNATE KEYS EXIST
	JUMPE	TA,PCASKP	;NO, ERROR, CLEAN UP STACK
	PUSH	PP,TA		;SAVE # OF ENTRY (1 INITIALLY)
	PUSH	PP,[2]		;WE'RE AT KEY #2 NOW
PCASK2:	ADD	TA,AKTLOC	;POINT TO ALTERNATE KEY TABLE
PCAS2A:	LDB	TA,AK.DLK	;DATAB LINK IN TA
	PUSHJ	PP,LNKSET
	LDB	TD,DA.LOC
	LDB	TE,DA.RES
	CAMN	TD,-3(PP)
	CAME	TE,-2(PP)	;MATCH?
	 JRST	PCASK3		;NO, TRY NEXT ALT KEY
	LDB	TD,DA.INS	;[1354] Get size of key field
	CAMGE	TD,DKEYSZ	;[1465] [1354] If key greater or equal, match
	JRST	PCASK3		;[1354]  else search alternatives
	POP	PP,TD		;FIX STACK
	POP	PP,(PP)
	POP	PP,(PP)
	POP	PP,(PP)
	JRST	PCASKG		;GO WRITE KEY VALUE

;THIS KEY ISN'T THE ONE. TRY THE NEXT ONE, IF ANY.
PCASK3:	MOVEI	TA,SZ.AKT	;BUMP UP TO NEXT ENTRY
	ADDB	TA,-1(PP)	;TA= ENTRY NUMBER
	ADD	TA,AKTLOC	;POINT TO ENTRY
	HRRZ	TA,TA		;JUST RH
	HRRZ	TB,AKTNXT	;CHECK PAST END OF TABLE
	CAML	TA,TB		;ARE WE PAST IT?
	 JRST	PCASK6		;YES, GIVE ERROR
	AOS	(PP)		;ASSUME OK, BUMP KEY NUMBER
	LDB	TC,AK.FLK	;CHECK FILTAB LINK
	HLRZ	TB,CURFIL
	CAMN	TB,TC		;STILL SAME FILE?
	JRST	PCAS2A		;YES, GO TRY THIS KEY

;NO KEY MATCHED.. ADJUST STACK AND GIVE ERROR
PCASK6:	POP	PP,(PP)
	POP	PP,(PP)
PCASKP:	POP	PP,(PP)
	POP	PP,(PP)
	JRST	PCASKE

;HERE IF PRIMARY KEY IS THE ONE
;TA POINTS TO RECKEY, ARG1 IS LINK TO ITEM
PCASK1:	MOVEI	TD,1		;SET TD TO 1

;KEY# IS IN "TD"
;TA POINTS TO ALTKEY OR RECKEY, ARG1 IS LINK TO ITEM
PCASKG:	PUSH	PP,TD		;SAVE KEY NUMBER

;ITEM IS THE KEY OR ITEM SUBORDINATE TO IT.
	LDB	TC,DA.INS	;IS SIZE THE SAME?
	PUSH	PP,TC
	HRRZ	TA,ARG1
	PUSHJ	PP,LNKSET
	LDB	TD,DA.INS
	POP	PP,TC
	CAME	TC,TD		;SKIP IF SAME SIZE
	 JRST	PCASG0		;NO, "APPROXIMATE KEY"
	POP	PP,TB		;KEY # IN RH
	SETO	TA,		;-1 + 0,,KEY#
	PJRST	PUTGEN		;WRITE IT OUT AND RETURN

;APPROXIMATE KEY
PCASG0:	HRRZ	TE,TD		;INTERNAL SIZE
	POP	PP,TD		;KEY #
;
;WRITE OUT ARG AS -1 + SIZE,,KEY#
	SETO	TA,		;-1
	HRLZ	TB,TE		;SIZE IN LH
	HRR	TB,TD		;KEY # IN RH
	DPB	TA,OP.APK##	;SET APPROX. KEY BIT
	PJRST	PUTGEN		;WRITE TO GENFIL AND RETURN

;CONT'D ON NEXT PAGE..
;PCASKI ROUTINE (CONT'D)    ** ERRORS **

;Organization not relative or indexed.
PA504E:	MOVEI	DW,E.205	;ORGANIZATION MUST BE RELATIVE OR INDEXED
	JRST	PCASEX

PCASER:	SKIPA	DW,[E.739]	;THIS ITEM MUST BE THE RELATIVE KEY
PCASKE:	MOVEI	DW,E.619	;MUST BE A KEY OR ITEM SUBORDINATE TO IT
PCASEX:	LDB	CP,[POINT 7,ARG1+1,35]	;POINT AT DATANAME
	LDB	LN,[POINT 13,ARG1+1,28]
	PUSHJ	PP,FATAL	;GIVE ERROR
	JRST	PAYECC		;SET OPERAND TO "YECCH"
;USE FOR DEBUGGING ...

	INTER.	PA510.
PA510.:	FLAGAT	LI
	SKIPN	DEBSW##		;DEBUG STUFF REQUIRED?
	JRST	SKPSEC		;NO, SKIP REST OF SECTION
	MOVEI	TA,17		;[*DMN*] CHANGE OPERATOR TO "USE FOR DEBUGGING"
	PUSHJ	PP,SETOP3	;[*DMN*] SO ALL IS HANDLED CORRECTLY
	MOVE	TA,[CD.USE,,SZ.USE]	;GET ROOM FOR NEW ENTRY
	PUSHJ	PP,GETENT
	MOVEI	TB,%UT.DB	;SET USE FOR DEBUGGING CODE
	DPB	TB,US.TYP##
	HLRZ	TB,CURPRO	;LINK USE TO CURRENT SECTION
	DPB	TB,US.PRO##
	HLRZM	TA,CURUSE##	;REMEMBER REL ADDR OF USETAB ENTRY
	POPJ	PP,

	INTER.	PA511.
PA511.:	HRRZ	TE,CURUSE	;GET CURRENT USETAB ENTRY
	JUMPE	TE,CPOPJ	;GIVE UP
	MOVEM	TE,DEBALP##	;TURN ON ALL PROCEDURES FLAG FOR PHASE E
	POPJ	PP,

IFN MCS,<
	INTER.	PA512.
PA512.:	PUSHJ	PP,PA2.HI	;CD-NAME
	HRRZ	TA,ARG1		;GET LINK POINTER
	JUMPE	TA,CPOPJ	;GIVE UP
	ADD	TA,CDLOC
	LDB	TB,CD.DUP##	;SEE IF ALREADY DEFINED
	JUMPN	TB,JDE517	;YES, ERROR
	HRRZ	TB,CURUSE	;LINK TO CURRENT USE SECTION
	DPB	TB,CD.DUP
	LDB	TB,CD.RDL##	;GET 01 RECORD ASSOCIATED WITH CD-NAME
	MOVEM	TB,CURDAT	;IT MIGHT MOVE SO SAVE TABLE LINK
	MOVE	TA,[CD.DAT,,SZ.DAT]	;GET A BASIC DATAB ENTRY
	PUSHJ	PP,GETENT
	EXCH	TA,CURDAT	;SAFE PLACE 
	PUSHJ	PP,LNKSET	;GET CD RECORD DATAB ADDRESS
	HRLZ	TA,TA		;FROM
	HRR	TA,CURDAT	;TO
	MOVEI	TB,SZ.DAT-1(TA)	;END
	BLT	TA,(TB)		;COPY DATA
	MOVE	TA,ARG1		;GET CDTAB LINK
	ADD	TA,CDLOC
	HLRZ	TB,CURDAT	;LINK TO DATAB
	DPB	TB,CD.FDL##	;SO DEBUG USE CAN FIND IT
	MOVE	TB,0(TA)	;GET CD.NAM,,CD.SNL
	MOVE	TA,CURDAT	;POINT TO NEW DATAB
	MOVEM	TB,0(TA)	;AND POINT NEW DATAB AT NAMTAB
	POPJ	PP,
>;END IFN MCS

	INTER.	PA513.
PA513.:	PUSHJ	PP,PA2.HI	;FILE-NAME
	HRRZ	TA,ARG1		;GET LINK POINTER
	JUMPE	TA,CPOPJ	;GIVE UP
	PUSHJ	PP,LNKSET
	LDB	TB,FI.DEB##	;SEE IF ALREADY DEFINED
	JUMPN	TB,JDE517	;YES, ERROR
	LDB	TB,FI.IRM##	;GET RECORD USAGE
	LDB	TC,FI.MRS##	;GET SIZE
	IDIV	TC,[EXP 6,1,5,4,5](TB)	;GET SIZE IN WORDS
	SKIPE	TB
	ADDI	TC,1		;COUNT REMAINDER
	CAMLE	TC,MAXDBC##	;BIGGEST YET?
	MOVEM	TC,MAXDBC	;YES
	HLRZ	TA,CURPRO	;SEE IF WE ALREADY HAVE A TAG FOR THIS USE PROCDURE
	ANDI	TA,077777
	ADD	TA,PROLOC##
	LDB	CH,PR.SFI##	;GET IT
	SKIPN	CH		;SKIP IF DEFINED
	PUSHJ	PP,GETTAG	;ELSE, GET NEXT TAG
	HRRZ	TA,ARG1
	ADD	TA,FILLOC	;POINT TO FILTAB
	DPB	CH,FI.DEB##	;SAVE TAG IN FILE TABLE
	HLRZ	TA,CURPRO
	ANDI	TA,077777
	ADD	TA,PROLOC##
	DPB	CH,PR.SFI##	;SIGNAL CLEAND TO USE THIS TAG
	POPJ	PP,

	INTER.	PA514.
PA514.:	TLNN	W1,GWNOT	;IS ITEM ALREADY IN NATAB?
	JRST	[HALT]		;YES, THEN ITS NOT A PROCEDURE REQUEST
	PUSHJ	PP,PA2.
	PUSHJ	PP,PA158.	;PUT USE PROCEDURE IN FLOTAB
	HRRZ	TA,CURUSE	;POINT BACK TO START OF USETAB ENTRY
	ADD	TA,USELOC
	LDB	TB,US.XTR##	;HAVE WE BEEN HERE BEFORE
	JUMPN	TB,PA514A	;YES
	MOVE	TA,[CD.USE,,1]	;NO
	PUSHJ	PP,GETENT	;EXPAND ENTRY
	HRRZ	TA,CURUSE
	ADD	TA,USELOC	;GET ADDRESS BACK
	MOVEI	TB,1
	DPB	TB,US.XTR	;SET EXTRA WORD FLAG
	DPB	TB,US.CNT##	;AND NEW COUNT
	JRST	PA514B		;THE FIRST TIME IS SPECIAL

PA514A:	LDB	TB,US.CNT##	;GET CURRENT COUNT
	ADD	TB,TA		;ADVANCE POINTER
	HRRZ	TC,(TB)		;DO WE ALREADY HAVE VALUE STORED?
	JUMPN	TC,PA514B	;YES, NEED EXTRA WORD
	HLRZ	TC,CURFLO
	HRRM	TC,(TB)		;STORE FLOTAB LINK
	POPJ	PP,

PA514B:	LDB	TB,US.CNT
	ADDI	TB,1
	DPB	TB,US.CNT	;MAKE ONE BIGGER
	MOVE	TA,[CD.USE,,1]	;EXPAND CURRENT USETAB ENTRY
	PUSHJ	PP,GETENT
	HLRZ	TB,CURFLO	;GET FLOTAB 
	HRLZM	TB,(TA)		;SAVE IT IN EXTRA USETAB WORD
	POPJ	PP,

	INTER.	PA515.
PA515.:	PUSHJ	PP,PA516.	;ALL REFERENCES OF IDENTIFIER-1
	SETO	TB,
	DPB	TB,DB.ARO##	;SET ALL REF. FLAG
	POPJ	PP,

	INTER.	PA516.
PA516.:	HRRZ	TA,ARG1		;GET LINK POINTER
	JUMPE	TA,CPOPJ	;GIVE UP
	PUSHJ	PP,LNKSET
	LDB	TB,DA.DEB##	;SEE IF ALREADY DEFINED
	JUMPN	TB,JDE517	;YES, ERROR
	SETO	TB,
	DPB	TB,DA.DEB	;SET IT NOW
	MOVE	TA,[CD.DEB,,SZ.DEB]
	PUSHJ	PP,GETENT	;GET SPACE IN DEBTAB
	HRRZ	TB,ARG1		;GET DATAB
	DPB	TB,DB.DAT##	;SAVE POINTER
	HRRZ	TB,CURUSE	;LINK TO CURRENT USE SECTION
	DPB	TB,DB.DUP##
	POPJ	PP,

JDE517:	EWARNJ	E.517
;FOR DEBUGGING..

	INTER.	PA520.
PA520.:
IFN DEBUG,<
	PUSHJ	PP,PA2.		;READ LITERAL, CHECK FOR ERRORS
	HLRZ	TA,ARG1		;LOOK AT LITERAL
	ANDI	TA,777		;GET LENGTH
	CAIE	TA,1		;MUST BE ONE CHAR LONG.
	 JRST	P520E1		;NO, GIVE ERROR
	HRRZ	TA,ARG1		;LOOK IN VALTAB
	TRZ	TA,700000
	ADD	TA,VALLOC##	;GET ADDRESS OF IT
	HRLI	TA,(POINT 7,)
	IBP	TA		;SKIP OVER LENGTH
	ILDB	TB,TA		;GET THE LETTER
	CAIN	TB,"D"
	 JRST	P520DD		;COMPILER BREAK IN PHASE D
	CAIN	TB,"E"
	 JRST	P520.E		;PASS INFO TO PHASE E
	CAIE	TB,"O"
	CAIN	TB,"G"
	 JRST	P520.E		;PASS INFO TO PHASE E
	OUTSTR	[ASCIZ/?PA520: bad value for literal
/]
	JRST	P520.X		;SET OPR TO "YECCH"

;COMPILER-BREAK-IN-PHASE "E"
P520.E:	PUSHJ	PP,PA21.		;WRITE OPERAND = LITERAL
	HRRZI	TA,OPCBPH	;"COMPILER BREAK IN PHASE"
	JRST	SETOP1		;SET OPERATOR

P520E1:	OUTSTR	[ASCIZ/?PA520: one-character literal expected after/]
	JRST	P520EE

;HERE TO SET BREAKPOINT FOR PHASE D
P520DD:	OUTSTR	[ASCIZ/[$CBD]
/]
$CBD::	JFCL				;FALL INTO P520.X
>;END IFN DEBUG

;COMPILER-BREAK-IN-PHASE "<BAD LETTER>"
P520.X:	HRRZI	TA,105		;"YECCH"
	JRST	SETOP1		;SET OPERAND AND RETURN

	INTER.	PA521.
PA521.:
IFN DEBUG,<
	OUTSTR	[ASCIZ/?PA521.: non-numeric literal expected after/]
P520EE:	OUTSTR	[ASCIZ/
"COMPILER-BREAK-IN-PHASE"
/]
>;END IFN DEBUG
	JRST	P520.X		;SET OPERATOR TO "YECCH" AND RETURN
;RPW: SUPPRESS [PRINTING].

	INTER.	PA523.
PA523.:	HRRZI	TA,161		;"SUPPRESS" OP CODE
	PUSHJ	PP,SETOP	;SET IT UP
	SKIPN	INUPRG		;SKIP IF WE ARE IN GOOD USE PROCEDURE..
	 JRST	P523.E		;NO, COMPLAIN

;DON'T ALLOW SUPPRESSION OF A TYPE DETAIL GROUP
	HRRZ	TA,INUPRG	;POINT TO RPWTAB ENTRY
	ADD	TA,RPWLOC	; ABS. ADDR
	LDB	TB,RW.TYP##	;MAKE SURE NOT TYPE DE
	CAIN	TB,%RG.DE
	 JRST	P523.F		;COMPLAIN

;GET A %PARAM WORD UNLESS WE GOT ONE ALREADY.
	HRRZ	TA,INUPRG	;POINT TO RPWTAB ENTRY
	ADD	TA,RPWLOC	; ABS ADDR
	LDB	TB,RW.SUP##	;GET RUNTIME LOCATION
	JUMPN	TB,P523A	;ALREADY GOT IT
	AOS	TB,RPWPRS##	;GET ONE AND INCREMENT COUNTER
	DPB	TB,RW.SUP##	; REMEMBER A 'SUPPRESS' IS DONE FOR
				; THIS REPORT GROUP
				;ROUTINE "SETRPW" CALLED AT BEGINNING
				; OF PHASE E ALLOCATES THE %PARAM WORD
P523A:	MOVSI	TA,(1B0)	;SET OPERAND BIT
	PJRST	PUTGEN		;WRITE IT OUT

;ERROR: "May only appear in a USE BEFORE REPORTING procedure"
P523.E:	EWARNW	E.636
	JRST	P523.X		;SET "YECCH" OPERATOR

;ERROR: "SUPPRESS not allowed for DETAIL lines - use GENERATE RD-name"
P523.F:	EWARNW	E.637
;	JRST	P523.X		;SET "YECCH" OPERATOR

P523.X:	HRRZI	TA,105		;"YECCH"
	JRST	SETOP3		;SET OPERAND AND RETURN
	INTER.	PA524.
;Here after parsing "IF <condition>..." or "WHEN <condition>.." expecting
; a statement. This routine checks to see if there was an error parsing
;<condition> and if so, POP's up a node in the syntax tree since we
;have eaten to the next period.
PA524.:	CAIN	TYPE,PRIOD.	;Are we at "." now?
	SKIPN	ERSKIP##	;Yes, error in condition parsing?
	 POPJ	PP,		;No, let parser give error for random "."
	SETZM	ERSKIP##	;Yes, clear flag
	JRST	PA0.		;Pop up node in tree
;SKIP THE ENTIRE SECTION 
;REQUIRED FOR DEBUG MODULE WHEN "FOR DEBUGGING" IS NOT SPECIFIED.
;WE HAVE TO SKIP THE CURRENT PARAGRAPH AND ALL SUBSEQUENT ONES
;UNTIL ANOTHER SECTION IS FOUND

SKPSEC:	PUSHJ	PP,SKPPGF##	;SKIP REST OF THIS PARAGRAPH
	PUSHJ	PP,GETITM	;GET FIRST WORD OF NEXT PARAGRAPH
	CAIE	TYPE,END.+AMRGN.	;IS IT RESERVED WORD END DECLARATIVES
	CAIN	TYPE,ENDIT.	;OR END-OF-FILE?
	JRST	SKPSC1		;YES
	CAIE	TYPE,USERN.+AMRGN.	;POSSIBLE PARAGRAPH NAME?
	JRST	SKPSEC		;NO
	PUSHJ	PP,PA2.		;DO ACTION OF PD14.
	PUSHJ	PP,GETITM	;GET NEXT WORD
	CAIE	TYPE,SECT.	;SECTION?
	JRST	SKPSEC		;NO
	MOVEI	NODE,PD20.##
	MOVEM	NODE,(NODPTR)	;RESET THE CURRENT NODE TO PD20.
	JRST	PCA1.		;AND PERFORM THE ACTION OF NODE PD20.

SKPSC1:	MOVEI	NODE,PD36.##
	MOVEM	NODE,(NODPTR)	;RESET THE CURRENT NODE TO PD36.
	JRST	PA147.		;AND PERFORM THE ACTION OF NODE PD36.
;READ & FIND A DEFINED DATA-NAME WITH ALL QUALIFIERS
;RETURNS TE=DATAB LINK

	INTER.	DA96.D
DA96.D:	SETZM	TBLOCK		;CLR TBLOCK
	MOVE	TA,[TBLOCK,,TBLOCK+1]
	BLT	TA,TBLOCK+24
	MOVEM	W2,TBLOCK+4	;FACTS ABOUT DATA-NAME TO TBLOCK SETUP
DA96.1:	PUSHJ	PP,GETITM	;READ NEXT SOURCE WORD
	CAIE	TYPE,OF.	;IS IT "OF" OR "IN"?
	JRST	DA96.2		;NO, TIME TO EXIT
	PUSHJ	PP,GETITM	;YES, QUALIFIER SHOULD FOLLOW
	CAILE	TYPE,ENDIT.	;IS IT A RESERVED WORD?
	JRST	DA96.0		;NO, IT'S OK
	SWON	FREGWD		;YES, PREPARE TO REGET THAT ITEM
	EWARNJ	E.101		;& FLAG THIS AS ILLEGAL QUALIFIER

DA96.0:	AOS	TA,TBLOCK+1	;COUNT THE QUALIFIER
	LDB	TB,[POINT 15,W2,15]	;GET NAMTAB LINK
	JUMPL	W1,JDE104	;[240] QUALIFIER MUST BE DEFINED
	MOVEM	TB,TBLOCK+4(TA)	;STORE NAMTAB LINK OF QUAL IN TBLOCK
	JRST	DA96.1		;ANY MORE QUALS?

DA96.2:	SWON	FREGWD		;REGET THIS LAST WORD THAT WASN'T "OF"
	PUSHJ	PP,FINDAT##	;FIND A DATAB MATCH FOR THE ITEM
	JUMPN	DW,DA96.3	;SKIP IF ERROR
	POPJ	PP,		;RETURN WITH DATAB LINK IN TE

JDE104:	MOVEI	DW,E.104	;[240] NAME IS UNDEFINED
DA96.3:	PUSHJ	PP,FATAL##	;GIVE MESSAGE
	MOVEI	TE,<CD.DAT>B20+1	;AIM AT DUMMY ENTRY
	POPJ	PP,
	SUBTTL	SIMULTANEOUS UPDATE SYNTAX

; ACTIONS PASU1 THROUGH PASU21 ARE USED TO SCAN THE OPEN STATEMENT,
; AS MODIFIED TO SUPPORT SIMULTANEOUS UPDATE. NO GEN FILE OUTPUT IS
; PRODUCED UNTIL THE OPEN STATEMENT IS COMPLETELY SCANNED.
;
;
; EACH FILENAME SCANNED DURING THE SCANNNING OF AN OPEN STATEMENT
; RESULTS IN THE CREATION OF A TABLE ENTRY IN THE TABLE CALLED BUFFER.
; THERE MAY BE UP TO EIGHT SUCH TABLE ENTRIES.
; EACH TABLE ENTRY HAS THE FOLLOWING FORMAT:
;
;   	WORD 0:
;
OPN%I==400000		;BIT 0: INPUT
OPN%O==200000		;BIT 1: OUTPUT
OPN%IO==100000		;BIT 2: INPUT-OUTPUT
OPN%NR==040000		;BIT 3: NO REWIND
OPN%FR==020000		;BIT 4: FOR READ
OPN%FC==010000		;BIT 5: FOR REWRITE (CHANGE)
OPN%FW==004000		;BIT 6: FOR WRITE
OPN%FD==002000		;BIT 7: FOR DELETE
OPN%FA==001000		;BIT 8: FOR ALL
OPN%ON==000400		;BIT 9: OTHERS NONE
OPN%OR==000200		;BIT 10: OTHERS READ
OPN%OC==000100		;BIT 11: OTHERS REWRITE (CHANGE)
OPN%OW==000040		;BIT 12: OTHERS WRITE
OPN%OD==000020		;BIT 13: OTHERS DELETE
OPN%OA==000010		;BIT 14: OTHERS ALL
OPN%UN==000004		;BIT 15: USER SUPPLIED UNAVAILABLE STATEMENT (1ST FILENAME ONLY)
OPN%EX==000002		;BIT 16: [74] EXTENDED
OPN%RV==000001		;BIT 17: [74] REVERSED
;
;	WORD 1: SAVE W1
;
;	WORD 2: SAVE W2
;
;	WORD 3: SAVE CT
;
;	WORD 4: SAVE NAMWRD
;	
;	WORD 5: SAVE NAMWRD + 1
;
;	WORD 6: SAVE NAMWRD + 2
;
;	WORD 7: SAVE NAMWRD + 3
;
;	WORD 8: SAVE NAMWRD + 4
; THE GENFIL GENERATED FOR AN OPEN STATEMENT INCLUDING SIMULTANEOUS
; UPDATE LOOKS LIKE THIS:
;
;	FILE-NAME-1
;	FENQ (OP CODE 143) WITH FLAGS INDICATING USAGE
;	.
;	.
;	.
;	FILE-NAME-N
;	FENQ, AS ABOVE
;	EFENQ (OP CODE 146) WITH FLAG INDICATING IF USER SUPPLIED
;		AN UNAVAILABLE STATEMENT
;	FILE-NAME-1
;	OPEN
;	.
;	.
;	.
;	FILE-NAME-M  M>=N
;	OPEN
;	FUNAV (OP CODE 144) IF USER SUPPLIED UNAVAILABLE STATEMENT
;	[GENFIL FOR UNAVAILABLE STATEMENT]
;	EFUNAV (OP CODE 145) IF USER SUPPLIED UNAVAILABLE STATEMENT
	INTER.	PASU1.
PASU1.:	SETZM	BUFCTR;		INITIALIZE BUFFER TABLE
	SETZM	BUFFER;		INITIALIZE WORD 0 OF THE 1ST ENTRY
	JRST	PA49.;		EXECUTE PA49 IN CASE THIS IS A DBMS OPEN

	INTER.	PASU2.
PASU2.:	MOVEI	TD,OPN%I;	SET INPUT BIT
	MOVEI	TC,OPN%O!OPN%IO!OPN%EX;	CLEAR OUTPUT AND INPUT-OUTPUT BITS
PASU2A:	PUSHJ	PP,PASU2B;	SET UP TA
	MOVE	TB,BUFFER(TA)
	TLZ	TB,0(TC);	ZERO BITS INDICATED BY TC
	TLO	TB,0(TD);	SET BITS INDICATED BY TD
	MOVEM	TB,BUFFER(TA)
	POPJ	PP,

PASU2B:	MOVE	TA,BUFCTR;	THIS SUBROUTINE PREPARES IN TA A 
	CAIGE	TA,^D16;	RELATIVE POINTER TO THE CURRENT ENTRY
	JRST	PASUYY
	EWARNW	E.573;		IN THE BUFFER TABLE, AFTER CHECKING
	SETZB	TA,BUFCTR
PASUYY:	LSH	TA,3;		THAT THE NUMBER OF FILE NAMES HAS NOT
	ADD	TA,BUFCTR;	EXCEEDED 16.
	POPJ	PP,

	INTER.	PASU3.
PASU3.:	MOVEI	TD,OPN%O;	SET OUTPUT BIT
	MOVEI	TC,OPN%I!OPN%IO!OPN%EX;	CLEAR INPUT AND INPUT-OUTPUT BITS
	JRST	PASU2A

	INTER.	PASUE.
PASUE.:	FLAGAT	HI
	MOVEI	TD,OPN%O!OPN%NR!OPN%EX;	SET OUTPUT, NO REWIND & EXTEND BITS
	MOVEI	TC,OPN%I!OPN%IO;	CLEAR INPUT AND INPUT-OUTPUT BITS
	JRST	PASU2A

	INTER.	PASUR.
PASUR.:	FLAGAT	HI
	PUSHJ	PP,PASU6B	;CHECK FOR NOT SUPPORTED WITH RMS FILES
	MOVEI	TD,OPN%RV	;SET REVERSED BIT
	JRST	PASU6A

	INTER.	PASU4.
PASU4.:	MOVEI	TD,OPN%IO;	SET INPUT-OUTPUT BIT
	MOVEI	TC,OPN%I!OPN%O!OPN%NR!OPN%EX;	CLEAR INPUT AND OUTPUT BITS
	JRST	PASU2A

	INTER.	PASU5.
PASU5.:	PUSHJ	PP,PASU2B;	SET UP TA
	ADDI	TA,BUFFER
	MOVE	TB,TA		;MAKE A COPY FOR LATER TEST
	PUSH	TA,W1;		SAVE EVERYTHING NECESSARY TO
	PUSH	TA,W2;		LATER PRETEND WE HAVE JUST
	PUSH	TA,CT;		SEEN THE FILENAME
	PUSH	TA,NAMWRD
	PUSH	TA,NAMWRD+1
	PUSH	TA,NAMWRD+2
	PUSH	TA,NAMWRD+3
	PUSH	TA,NAMWRD+4
	HRRZ	TA,W1		;[757] GET FILE
	ADD	TA,FILLOC	;[757] IN FILE TABLE
	LDB	TE,FI.DSD	;[757] GET SD BIT
	SKIPE	TE		;[757] OK IF NOT AN SD
	EWARNJ	E.291		;[757] IN AN SD, SO GIVE ERROR
	LDB	TE,FI.LCP##	;DOES FILE HAVE LINAGE CLAUSE
	SKIPL	AS7482##	;OK IN COBOL-74
	SKIPN	TE		;BUT NOT IN COBOL-8x
	JRST	PASU5A
	HLRZ	TE,(TB)		;GET OPEN MODE
	TRNE	TE,OPN%EX	;OPEN EXTEND IS ILLEGAL
	EWARNJ	E.825		;TELL USER
PASU5A:	LDB	TE,FI.RPG##
	JUMPE	TE,CPOPJ	;OK IF NOT A REPORT WRITER FILE
	HLRZ	TE,(TB)		;GET FLAGS
	TRZ	TE,OPN%O!OPN%EX!OPN%NR	;[1563] ONLY ALLOW OUTPUT, EXTEND, OR 
					;[1563] NO REWIND
	JUMPE	TE,CPOPJ	;OK
	EWARNJ	E.748		;NO, WARN USER

	INTER.	PASU6.
PASU6.:	FLAGAT	HI
	PUSHJ	PP,PASU6B	;TEST FOR UNSUPPORTED CLASUE WITH RMS FILE
	MOVEI	TD,OPN%NR;	SET NO REWIND BIT
PASU6A:	SETZ	TC,;		CLEAR NO BITS
	JRST	PASU2A

PASU6B:				;
	HRRZ	TA,CURFIL	;
	LDB	TE,FI.RMS	;CHECK FOR RMS FILE AND WARN IF SO
	CAIN	TE,0		;
	 POPJ	PP,		; IS NOT
	HRRZI	DW,E.853	;IT IS, SO WARN
	PUSHJ	PP,WARN##	;
	POPJ	PP,		;

	INTER.	PASU7.
PASU7.:	PUSHJ	PP,PASU2B;	SET UP TA
	MOVE	TB,BUFFER(TA)
	TLZ	TB,037774;	INITIALIZE 1ST WORD OF NEXT ENTRY
	MOVEM	TB,BUFFER+^D9(TA)
	AOS	BUFCTR;		PUSH BUFFER TABLE
	 POPJ	PP,		;RETURN

	INTER.	PASU9.
PASU9.:	MOVEI	TD,OPN%FR;	SET FOR READ BIT
	JRST	PASU6A

	INTER.	PASU10
PASU10:	MOVEI	TD,OPN%FC;	SET FOR REWRITE BIT
	JRST	PASU6A

	INTER.	PASU11
PASU11:	MOVEI	TD,OPN%FW;	SET FOR WRITE BIT
	JRST	PASU6A

	INTER.	PASU12
PASU12:	MOVEI	TD,OPN%FD;	SET FOR DELETE BIT
	JRST	PASU6A

	INTER.	PASU13
PASU13:	MOVEI	TD,OPN%FR!OPN%FC!OPN%FW!OPN%FD;	SET FOR ALL BITS
	JRST	PASU6A

	INTER.	PASU14
PASU14:	MOVEI	TD,OPN%ON;	SET OTHERS NONE BIT
	JRST	PASU6A

	INTER.	PASU15
PASU15:	MOVEI	TD,OPN%OR;	SET OTHERS READ BIT
	JRST	PASU6A

	INTER.	PASU16
PASU16:	MOVEI	TD,OPN%OC;	SET OTHERS REWRITE BI
	JRST	PASU6A

	INTER.	PASU17
PASU17:	MOVEI	TD,OPN%OW;	SET OTHERS WRITE BIT
	JRST	PASU6A

	INTER.	PASU18
PASU18:	MOVEI	TD,OPN%OD;	SET OTHERS DELETE BIT
	JRST	PASU6A

	INTER.	PASU19
PASU19:	MOVEI	TD,OPN%OR!OPN%OC!OPN%OW!OPN%OD;	SET OTHERS ALL BITS
	JRST	PASU6A

	INTER.	PASU8.
PASU8.:	SKIPN	BUFCTR
	POPJ	PP,
	MOVE	TA,[XWD NAMWRD,HLDNAM##]	; [420] SAVE CURRENT
	BLT	TA,HLDNAM+4		; [420] SOURCE ITEM
	DMOVEM	W1,HLDSRC##		; [420] STORE FIRST WORD OF SOURCE PARAMS
					; [420] 2ND  SOURCE WORD PARAMS
	MOVEM	CT,HLDSRC+2		; [420] 3RD SOURCE PARAMS
;;;;;
;
; THE FOLLOWING 6 LINES OF CODE COMPUTE AND STORE THE SIZE OF THE ENQ
; BLOCK WHICH IS BEING CREATED FOR A SMU OPEN VERB. HOWEVER, THEY DO IT
; OBSCURELY. THEY START OFF WITH THE BUFCTR VALUE AS THE COUNT OF FILES
; IN THE OPEN, THEN THEY MULTIPLY THIS BY THREE WITH THE LSH AND ADD.
; THEY ORIGINALLY ADDED 2 TO INCLUDE THE ENQ BLOCK HEADER. I REALIZED
; THAT IT BUFCTR WAS ONE COUNT SHORT (OFF-BY-ONE BUG) FOR THE PURPOSES
; OF ARITHMETIC, SO I COMPOUNDED THE OBSCURITY BY SIMPLY ADDING 3 TO THE
; 2 MAKING 5. THIS PROCEDURE IDENTIFIES ONLY THE BUFFER SIZE FOR THE
; CURRENT OPEN, SO IT HAS TO BE COMPARED AGAINST THAT FOR THE BIGGEST
; SIZE SO FAR AND SAVED IN SUEQT., IF IT IS NOW THE BIGGEST. THIS ENQ
; BUFFER IS KNOWN AS THE SU.EQT TABLE, AND IT ALSO IS USED BY THE RETAIN
; VERB. SO A SIMILAR CALCULATION IS DONE AT SUCS1: UNDER PASU44:.
;
;;;;;
	SETZM	SU8FLG
	MOVE	TA,BUFCTR	;ADJUST SPACE REQUIRED FOR ENQ/DEQ BUFFERING
	LSH	TA,1
	ADD	TA,BUFCTR
	ADDI	TA,5		;MAKE IT LONG ENOUGH TO COVER HDR + 1 REQ
	CAMLE	TA,SUEQT.
	MOVEM	TA,SUEQT.
	SETZB	TC,SU8CNT;	GET READY FOR FIRST PASS OF BUFFER TABLE
				;DURING THE 1ST PASS, DETERMINE
PASU8A:	CAML	TC,BUFCTR;	WHICH FILES, IF ANY, ARE TO BE OPENED
	JRST	PASU8B;		WITH SIMULTANEOUS UPDATE, AND FOR THOSE
	LSH	TC,3;		FILES WHICH ARE, GENERATE APPROPRIATE
	ADD	TC,SU8CNT;	CODE.
	MOVE	TD,BUFFER(TC)
	TLNN	TD,OPN%ON!OPN%OR!OPN%OC!OPN%OW!OPN%OD!OPN%OA
	JRST	PASU8R;		JUMP IF NO SIMULTANEOUS UPDATE
	TLNN	TD,OPN%IO
	 PUSHJ	PP,ERRNIO	;GIVE ERROR ABOUT NOT I-O MODE
	HRRZ	TA,BUFFER+1(TC) ;GET FILE-TABLE ADDRESS
	ANDI	TA,77777	;JUST GET TABLE OFFSET
	ADD	TA,FILLOC	;LOOK AT THE FILTAB ENTRY
	LDB	TB,FI.RMS##	;IS THIS AN RMS FILE?
	CAIN	TB,0		;IS BIT ON?
	 JRST	PAS8A0		; NO, FILE IS NOT RMS. GO CHECK FOR SEQUENTIAL
	LDB	TB,FI.ABL##	;FILE IS RMS, ARE WE DOING BASIC-LOCKING?
	JUMPN	TB,PAS8A1	; JUMP IF WE ARE. LET BASIC-LOCKING DO 
				;  ITS OWN THING IN RMS
PAS8A0:				;DON'T ALLOW SMU OPTION 1 ON SEQUENTIAL FILES
	LDB	TB,FI.ORG##	;GET FILE'S ORGANIZATION, AT THIS POINT 
				; IT IS NOT UNDETERMINED ANY MORE
	SKIPN	TB,		; SKIP IF NOT SEQUENTIAL
	 PUSHJ	PP,ERRNSQ	;GIVE ERROR ABOUT NO OPTION 1 SIMULTANEOUS 
				; UPDATE FOR SEQUENTIAL FILES
PAS8A1:
	MOVE	TA,BUFFER+2(TC); SET UP LINE NUMBER AND CHARACTER POSITION
	TLZ	TA,777774;	ZERO IRRELEVANT FIELDS
	TLO	TA,400000;	SET OPERAND BIT
	HRRZ	TB,BUFFER+1(TC); SET UP FILE NAME TABLE ADDRESS
	TRZ	TB,700000;	ZERO IRRELEVANT BITS
	MOVEM	TC,SU8SVC
	PUSHJ	PP,PUTGEN;	GENERATE FILE NAME OPERAND
	MOVE	TC,SU8SVC
	MOVE	TD,BUFFER(TC)
	LSH	TD,-4;		GET R, W, D BITS IN POSITION
	TLZ	TD,777077;	ZERO EVERYTHING ELSE
	MOVE	TA,BUFFER(TC)
	LSH	TA,-2;		GET OR, OR, OW, OD BITS IN POSITION
	TLZ	TA,777703;	ZERO EVERYTHING ELSE
	OR	TA,TD
	TLO	TA,143000;	COMBINE AND ADD  OP CODE
	HRRI	TA,0
	TLZ	W2,777774
	OR	TA,W2;		ADD LINE AND CHARACTER POSITION
	HRRZI	TB,000143;	SET UP WORD 2
	MOVE	TE,BUFFER(TC)	;CHECK TO SEE IF WE HAVE UNAVAILABLE CLAUSE
	TLNE	TE,OPN%UN	; SPECIFIED FOR THIS FILE
	 HRLI	TB,1		;YES, STICK FLAG INTO LH OF WORD 2, WHICH
				; IS CURRENTLY UNUSED.
	PUSHJ	PP,PUTGEN;	GENERATE OPERATOR
	SETOM	SU8FLG
	JRST	PASU8C

PASU8R:	TLNE	TD,037000
	EWARNW	E.575		;WARN IF FOR BUT NO OTHERS
PASU8C:	AOS	TC,SU8CNT
	JRST	PASU8A

PASU8B:
	SKIPN	ABSEEN##	;SKIP IF APPLY BASIC-LOCKING SEEN
	SKIPN	SU8FLG
	JRST	PASU8F;		JUMP IF NO FILES OPENED FOR SIMULTANEOUS UPDATE
	MOVE	TA,BUFFER
	LSH	TA,6;		GET FLAG INDICATING IF USER SUPPLIED
	TLZ	TA,777377;	AN UNAVAILABLE STATEMENT AND MOVE
	TLO	TA,146000;	TO BIT 9 OF OPERATOR FLAG FIELD
	TRZ	TA,777777
	TLZ	W2,777774
	OR	TA,W2
	HRRZI	TB,000146
	PUSHJ	PP,PUTGEN;	GENERATE EFENQ OPERATOR
PASU8F:	SETZB	TA,SU8CNT;	PREPARE TO MAKE SECOND PASS OF BUFFER TABLE
PASU8D:				;THIS TIME, GENERATE REGULAR OPEN CODE
				;FOR FILES NOT OPEN FOR SIMULTANEOUS UPDATE
	CAML	TA,BUFCTR
	JRST	PASU8E
	LSH	TA,3
	ADD	TA,SU8CNT
	MOVE	TB,BUFFER(TA)
	TLNE	TB,000770
	JRST	PASU8Z		;JUMP IF OPEN FOR SIMULTANEOUS UPDATE
	MOVEM	TA,SU8SVA
	PUSHJ	PP,PA49.;	EXECUTE OLD ACTION PA49 OF NODE PD491A
	MOVE	TA,SU8SVA
	MOVE	TB,BUFFER(TA)
	MOVEM	TB,SU8SVB
	TLNE	TB,OPN%I
	PUSHJ	PP,PA74.;	EXECUTE OLD ACTION PA74 OF NODE PD491
	MOVE	TB,SU8SVB
	TLNE	TB,OPN%O
	PUSHJ	PP,PA75.;	EXECUTE OLD ACTION OF NODE PD492
	MOVE	TB,SU8SVB
	TLNE	TB,OPN%IO
	PUSHJ	PP,PA76.;	EXECUTE OLD ACTION PA76 OF NODE PD493
	MOVE	TA,SU8SVA
	ADDI	TA,BUFFER+^D8
	HRLI	TA,20
	POP	TA,NAMWRD+4
	POP	TA,NAMWRD+3
	POP	TA,NAMWRD+2
	POP	TA,NAMWRD+1
	POP	TA,NAMWRD
	POP	TA,CT
	POP	TA,W2
	POP	TA,W1
	PUSHJ	PP,PA2.;	EXECUTE OLD ACTION PCA48 OF NODE PD496
	PUSHJ	PP,PA77.
	SKIPN	FLGSW##		;FIPS FLAGGER WANTED?
	JRST	PASU8J		;NO
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
	SKIPE	SU8CNT		;IF NOT FIRST FILE
	ADDI	TB,4		;PUT IN SECOND SET
	LDB	LN,[POINT 13,W2,28]	;LOAD LN &
	LDB	CP,[POINT 7,W2,35]	;CP JUST IN CASE
	MOVE	TA,[%LV.L		;SEQUENTIAL FIRST FILE
		%LV.LI			;RELATIVE FIRST FILE
		%LV.H			;INDEXED FIRST FILE
		0
		%LV.HI			;SEQUENTIAL NOT FIRST FILE
		%LV.LI			;RELATIVE, NOT FIRST FILE
		%LV.H			;INDEXED, NOT FIRST FILE
		0](TB)
	PUSHJ	PP,FLG.ES##	;FLAG IF ILLEGAL
PASU8J:	PUSHJ	PP,PA78.
	MOVE	TB,SU8SVB
	TLNE	TB,OPN%NR	;NO REWIND?
	PUSHJ	PP,PA79.;	EXECUTE OLD ACTION PA79 OF NODE PD504
	TLNE	TB,OPN%EX	;EXTENDED?
	PUSHJ	PP,PA79E.	;YES
	TLNE	TB,OPN%RV	;REVERSED?
	PUSHJ	PP,PA79R.	;YES
	PUSHJ	PP,PA21.	;EXECUTE OLD ACTION PCA49 OF NODE PD507
	PUSHJ	PP,PA160.
	AOS	TA,SU8CNT
	JRST	PASU8D

PASU8E:	MOVE	TB,BUFFER
	TLNN	TB,OPN%UN;	TEST IF USER SUPPLIED UNAVAILABLE STATEMENT
	JRST	PASU8M		;[420] DO OLD ACTION
	MOVE	TA,W2
	TLZ	TA,777774
	TLO	TA,144000;	GENERATE FUNAV OPERATOR
	HRRZI	TB,000144
	PUSHJ	PP,PUTGEN
	MOVE	TA,[XWD HLDNAM,NAMWRD]	; [420] RESTORE CURRENT
	BLT	TA,NAMWRD+4		; [420] SOURCE ITEM
	DMOVE	W1,HLDSRC##		; [420] RESTORE FIRST WORD OF SOURCE PARAMS
					; [420] 2ND  SOURCE WORD PARAMS
	MOVE	CT,HLDSRC+2		; [420] 3RD SOURCE PARAMS
	POPJ	PP,

PASU8M:	MOVE	TA,[XWD HLDNAM,NAMWRD]	; [420] RESTORE CURRENT
	BLT	TA,NAMWRD+4		; [420] SOURCE ITEM
	DMOVE	W1,HLDSRC##		; [420] RESTORE FIRST WORD OF SOURCE PARAMS
					; [420] 2ND  SOURCE WORD PARAMS
	MOVE	CT,HLDSRC+2		; [420] 3RD SOURCE PARAMS
	JRST	PA0.			;EXECUTE OLD ACTION PA0. OF NODE PD508


;ERRORS THAT POINT TO THE FILENAME
; THESE ARE ROUTINES THAT RETURN AFTER CALLING "FATAL"
;WHEN CALLED, THEY ASSUME BUFFER+1(TC) HAS THE LN&CP INFO.
ERRNSQ:	MOVEI	DW,E.659	;SMU OPTION 1 NOT ALLOWED FOR SEQENTIAL FILES
	JRST	ERRFXX		;FILE ERROR
ERRNIO:	MOVEI	DW,E.574	;FILE MUST BE OPENED FOR I-O
ERRFXX:	MOVE	TA,BUFFER+2(TC)	;GET LN & CP INFO
	LDB	LN,[POINT 13,TA,28]
	LDB	CP,[POINT 7,TA,35] ;SAME BITS AS OPRTR FIELDS
	PJRST	FATAL		;GO GIVE FATAL ERROR AND RETURN
	INTER.	PASU20
PASU20:	FLAGAT	NS
	PUSHJ	PP,PA820.	;STORE IN TEMTAB IN CASE END-OPEN
	MOVSI	TA,OPN%UN;	SET BIT INDICATING USER SUPPLIED UNAVAILABLE STATEMENT
	IORB	TA,BUFFER
	JRST	PASU8.

	INTER.	PASU21
PASU21:	HRLZI	TA,145000
	TLZ	W2,777774
	OR	TA,W2
	HRRZI	TB,000145
	PUSHJ	PP,PUTGEN;	GENERATE EFUNAV OPERATOR
	PUSHJ	PP,PA24.
	SWOFF	UNCONT;	SET SWITCH TO INDICATE IT'S OK FOR AN UNLABELED STATEMENT TO FOLLOW 
;
;THE PURPOSE OF THE FOLLOWING CHANGE IS TO LET THE UNAVAILABLE CLAUSE
;BE FOLLOWED BY THE OPEN-MODE CLAUSE (I.E. INPUT, OUTPUT, I-O, EXTEND)
;SO THAT EACH FILE NAME MAY HAVE AN UNAVAILABLE CLAUSE. THIS WILL BE
;USED FOR SMU OPTION 5 WHERE THE LOCKING AT OPEN TIME WILL BE DONE ON
;A PER-FILE BASIS.
;
;;;;;	JRST	PA0.
	POPJ	PP,

PASU8Z:	HRRZ	TA,BUFFER+1(TA)
	HRLZM	TA,CURFIL
	PUSHJ	PP,LNKSET	;GET ADDRESS OF FILE TABLE
	HRRM	TA,CURFIL
	SETO	TB,
	DPB	TB,FI.IOO	;SET BIT INDICATING I-0 OPEN SEEN
	AOS	TA,SU8CNT
	JRST	PASU8D
;ACTIONS PASU30 THROUGH PASU45 GENERATE GENFIL FOR THE RETAIN
;STATEMENT. THE GENFIL FOR A RETAIN STATEMENT LOOKS LIKE THIS:
;
;	FILE-NAME-1
;	[DATA-NAME-1 OR LITERAL-1]
;	RENQ (OP CODE 147) WITH FLAGS INDICATING USAGE
;	.
;	.
;	.
;	FILE-NAME-N
;	[DATA-NAME-N OR LITERAL-N]
;	RENQ, AS ABOVE
;	ERENQ (OP CODE 150) WITH FLAG INDICATING IF USER SUPPLIED
;		AN UNAVAILABLE STATEMENT
;	[CODE FOR THE UNAVAILABLE STATEMENT]
;	ERUNAV (OP CODE 151) IF USER SUPPLIED UNAVAILABLE STATEMENT


	INTER.	PASU30
PASU30:	MOVE	TA,W2;		CREATE FILENAME OPERAND
	TLZ	TA,777774;	AND SAVE IN SU30F1, SU30F2
	TLO	TA,400000
	HRRZ	TB,W1	
	TRZ	TB,700000
	MOVEM	TA,SU30F1
	MOVEM	TB,SU30F2
	SETZM	SU30FG;		ZERO FLAGS
	POPJ	PP,

	INTER.	PASU31
PASU31:
	SKIPE	SU30FG		;FOR FIRST KEY NAME THIS FLAG WORD CONTAINS 0
	 JRST	PASU3A		; FOR SURROGATES IT IS NON-ZERO

;IF RMS INDEXED FILE, TEST FOR A VALID KEY FIELD FROM RECORD FORMAT 
; NAMED IN KEY CLAUSE OF RETAIN VERB

	SETZM	CURMKY##	;INIT CURRENT RMS RETAIN KEY
	MOVE	TA,SU30F2##	;GET FILE'S REFERENCE NUMBER
	PUSHJ	PP,LNKSET##	;GET ITS FILE TABLE ADDRESS
	LDB	TB,FI.RMS##	;GET ITS RMS BIT
	CAIE	TB,1		; AND SEE IF IT IS ON
	 JRST	PAS31C		;  IS NOT
	LDB	TB,FI.ORG	;GET ITS ORG BITS
	CAIE	TB,%ACC.I	; IS IT INDEXED?
	 JRST	PAS31C		;  NO
	HRRZ	TE,W1		;GET KEY'S DATA REFERENCE LINK
	LSH	TE,-17		;SLIDE IT OVER TO GET 3-BIT TYPE CODE
	CAIN	TE,1		;SEE IF IT IS A DATA REF LINK CODE
	 JRST	PAS31D		; IT IS
	EWARNJ	E.662		;IF NOT, GIVE FATAL DIAG
	JRST	PAS31X		;
PAS31D:				;
	HRRZ	TE,W1		;GET KEY'S DATA REFERENCE LINK AGAIN 
	MOVEM	TE,CURMKY##	; AND SAVE IT ASIDE
	LDB	TB,FI.RKY##	;GET DATA REF LINK FOR FILE'S PRIMARY KEY
	CAMN	TE,TB		; ARE THEY THE SAME?
	 JRST	PAS31C		;  YES
	MOVE	TC,TA		;SAVE FILTAB LINK
PAS31E:	MOVE	TA,TE		;FIND DATAB ENTRY
	PUSHJ	PP,LNKSET	;
	LDB	TE,DA.SNL##	;IS THERE ANOTHER FIELD W/ SAME NAME?
	JUMPE	TE,PAS31F	; NO
	CAME	TE,TB		;YES, IS IF FILE'S PRIMARY KEY?
	 JRST	PAS31E		; NO, SEE IF ANOTHER
	MOVEM	TE,CURMKY	; YES, CLEAN UP DATAB REFERENCES
	HRR	W1,TE		;
	JRST	PAS31C		;
PAS31F:	HRRZ	TE,W1		;RESTORE KEY'S DATA REFERENCE LINK 
	MOVE	TA,TC		;GET FILTAB OFFSET
	LDB	TA,FI.ALK##	;GET FILE'S FIRST ALTERNATE KEY REF
	CAIN	TA,0		; ARE THERE NONE?
	 JRST	PAS31B		;  YUP - UNFORTUNATELY
	ADD	TA,AKTLOC##	;GET ABSOLUTE ADDRESS OF AKT ENTRY
PAS31A:				;
	LDB	TB,AK.FLK##	;GET ALT KEY'S FILE REFERENCE LINK
	CAME	TB,SU30F2##	; SAME FILE?
	 JRST	PAS31B		;  NO, WE ARE THROUGH THE ALT KEYS
	LDB	TB,AK.DLK##	;GET THE KEY'S DATA LINK
	CAMN	TE,TB		;SAME AS OUR DATA LINK FOR RETAIN KEY?
	 JRST	PAS31C		; YES
	MOVE	TC,TA		;SAVE FILTAB OFFSET
	MOVE	TA,TE		;
	PUSHJ	PP,LNKSET	;
PAS31G:	LDB	TE,DA.SNL	;ANOTHER WITH SAME NAME?
	JUMPE	TE,PAS31I	; NO
	CAMN	TE,TB		;DOES IT MATCH KEY FIELD?
	 JRST	PAS31H		; YES
	MOVE	TA,TE		;NO, WELL LOOK FOR ANOTHER
	PUSHJ	PP,LNKSET	;
	JRST	PAS31G		;

PAS31H:	MOVEM	TE,CURMKY	;CLEAN UP DATAB REFERENCES
	HRR	W1,TE		;
	JRST	PAS31C		; AND SAY MATCH FOUND

PAS31I:	EXCH	TA,TC		;LOOK AT AKTTAB ENTRY AGAIN
	HRRZ	TE,W1		;RESTORE ORIGINAL DATAB FIELD
	ADDI	TA,SZ.AKT	;BUMP UP TO NEXT ENTRY AND GO TRY AGAIN
	JRST	PAS31A		;
				;
PAS31B:				;REPORT SYNTAX ERROR - BAD RMS RETAIN KEY
	EWARNJ	E.665		;
	JRST	PAS31X		;
PAS31C:				;GO ON TO SET UP RETAIN KEY
	HRLZI	TA,000010	;SET FLAG INDICATING DATA NAME OR
	ORM	TA,SU30FG	;LITERAL SUPPLIED
PAS31X:				;
	JRST	PA2.		;

PASU3A:
	;COMPARE SURROGATE RMS RETAIN KEYS WITH THE SPECIFIED KEY WHICH
	;HAS ALREADY BEEN PROCESSED IN PASU31. THEY MUST BE COMPATIBLE
	;WITH THE SPECIFIED KEY ACCORDING TO DATA USAGE MODE AND SIZE OF
	;PIC CLAUSE.

	MOVE	TA,SU30F2	;GET FILE'S FILE TABLE NUMBER
	PUSHJ	PP,LNKSET##	;FIND ITS FILE TABLE ADDRESS
	LDB	TB,FI.RMS##	;IS IT RMS FILE?
	CAIE	TB,1		;
	 JRST	[EWARNJ	E.664	;NO, FATAL ERROR, SURROGATE NOT ALLOWED
		 JRST   PAS3AC]	;
	LDB	TB,FI.ORG	;LOOK AT FILE'S ORGANIZATION
	CAIE	TB,%ACC.I	;IF INDEXED IS OK
	 JRST	[EWARNJ E.664	; OTHERWISE, IS FATAL ERROR
		 JRST   PAS3AC]	;  AND BYPASS THE REST

	HRRZ	TE,W1		;GET KEY'S DATA REFERENCE LINK
	LSH	TE,-17		;SLIDE IT OVER TO GET 3-BIT TYPE CODE
	CAIE	TE,1		;SEE IF IT IS A DATA REF LINK CODE
	 JRST	[EWARNJ E.662	; IS NOT, FATAL ERROR
		 JRST   PAS3AC] ;
	MOVE	TA,CURMKY##	;GET CURRENT RMS RETAIN KEY DATA LINK
	PUSHJ	PP,LNKSET##	;GET ITS ABSOLUTE TABLE ADDRESS
	LDB	TC,DA.USG##	;GET ITS DATA USAGE MODE
	LDB	TD,DA.INS##	; AND ITS SIZE
	LDB	TE,DA.CLA##	; AND ITS CLASS
				;  FOR COMPARISIONS BELOW
	MOVE	TA,W1		;GET CURRENT SURROGATE'S DATA REF LINK AGAIN
	PUSH	PP,TC		;PRESERVE TC, TD AND TE ACROSS CALL TO LNKSET
	PUSH	PP,TD		;
	PUSH	PP,TE		;
	PUSHJ	PP,LNKSET##	;GET SURROGATE'S DATA REF LINK
	POP	PP,TE		;RESTORE AC'S FOR COMPARISONS BELOW
	POP	PP,TD		;
	POP	PP,TC		;
	LDB	TB,DA.USG##	;GET SURROGATE'S DATA USAGE MODE
	CAME	TB,TC		; SAME AS CURRENT RMS KEY?
	 JRST	PAS3AA		;  NO, FATAL ERROR
	LDB	TB,DA.CLA##	;GET SURROGATE'S CLASS
	CAME	TB,TE		; SAME AS CURRENT RMS KEY?
	 JRST	PAS3AA		;  NO, FATAL EROR
	LDB	TB,DA.INS##	;GET SURROGATE'S PIC SIZE
	CAMN	TB,TD		; SAME AS CURRENT RMS KEY?
	 JRST	PAS3AB		;  YES, SUCCESS. THIS SURROGATE IS OK
	LDB	TB,DA.CLA##	;GET SURROGATE'S CLASS AGAIN
	CAIN	TB,2		;IS SURROGATE NUMERIC
	CAIE	TE,2		; AND SPECIFIED KEY NUMERIC TOO?
	 JRST	PAS3AA		;AT LEAST ONE IS NOT, FATAL ERROR
	LDB	TB,DA.INS##	;GET SURROGATE'S PIC SIZE AGAIN
	CAMG	TB,TD		;LENGTH OF SURROGATE CAN BE LESS
	 JRST	PAS3AB		; LENGTH OK
;	 JRST	PAS3AA		; FATAL ERROR IF SURROGATE LONGER 
PAS3AA:				;
	EWARNJ	E.666		;GIVE FATAL ERROR MESSAGE
	JRST	PAS3AC		;
PAS3AB:				;EXIT FROM THIS ROUTINE
	HRLZI	TA,000010	;SET FLAG INDICATING DATA NAME OR
	ORM	TA,SU30FG	;LITERAL SUPPLIED
PAS3AC:				;
	JRST	PA2.		;
	INTER.	PASU33
PASU33:	HRLZI	TA,000400;	SET READ FLAG
PASU3X:	ORM	TA,SU30FG
	MOVE	TC,TA		;[1412] SAVE IT, NEED TO
;;;;;[R-JSM-2/20/84]	MOVE	TA,CURFIL	;[1412] GET CURRENT FILE
	MOVE	TA,SU30F2	;[A-JSM-2/20/84]THIS IS WHERE CURRENT FILE'S 
				;[A-JSM-2/20/84]DISPLACEMENT IN FILE TABLE IS
	PUSHJ	PP,LNKSET##	;[A-JSM-2/20/84] GET IT'S ADDRESS INTO TA.
	LDB	TB,FI.ORG	;[1412] TO CHECK ON ORGANIZATION.
	CAIE	TB,%ACC.I	;[1412] IS IT INDEXED?
	 JRST	PASU3Y		;[1412] YES, DON'T NEED TO GO FURTHER.
	LDB	TB,FI.FAM	;[1412] OTHERWISE, CHECK ACCESS MODE.
	CAIE	TB,%FAM.S	;[1412] IF NOT SEQUENTIAL,
	 JRST	PASU3Y		;[1412] DO NOTHING,
	MOVE	TA,TC		;[1412] OTHERWISE,
	HRLZI	TA,(1B15)	;[1412] SET BIT FOR RETAIN NEXT,
	ORM	TA,SU30FG	;[1412] SO ISAM SEQUENTIAL WORKS.
PASU3Y:				;[1412]
	POPJ	PP,

	INTER.	PASU34
PASU34:	HRLZI	TA,000600;	SET READ, REWRITE FLAGS
	JRST	PASU3X

	INTER.	PASU35
PASU35:	HRLZI	TA,000500;	SET READ, WRITE FLAGS
	JRST	PASU3X

	INTER.	PASU36
PASU36:	HRLZI	TA,000040;	SET DELETE FLAG
	JRST	PASU3X

	INTER.	PASU37
PASU37:	HRLZI	TA,000100;	SET WRITE FLAG
	JRST	PASU3X

	INTER.	PASU38
PASU38:	HRLZI	TA,000200;	SET REWRITE FLAG
	JRST	PASU3X

	INTER.	PASU39
PASU39:	HRLZI	TA,000740;	SET ALL FLAGS
	JRST	PASU3X

	INTER.	PASU40
PASU40:	HRLZI	TA,000020;	SET UNTIL FREED FLAG
	JRST	PASU3X

	INTER.	PASU90
PASU90:	HRLZI	TA,(1B15)	;SET "NEXT RECORD" FLAG
	JRST	PASU3X

;;;;;
;
; PASU44 HAS THE TASK OF SETTING UP THE RETAIN STATEMENT, AND THIS INCLUDES
; SETTING UP THREE TABLES WHICH ARE GOING TO BE USED AT RUN-TIME. THE
; FIRST IS THE FILL-FLUSH BUFFER TABLE (SU.FBT), WHICH CONSISTS OF A
; LIST OF LOCAL BUFFER ADDRESSES IN ONE-WORD TABLE ENTRIES. THE NEXT IS
; THE ENQ/DEQ TABLE (SU.EQT) WHICH IS THE ENQ BLOCK FOR THE MONITOR
; CALLS, AND THE ENQ MODIFY TABLE (SU.MQT) AND THE DEQ TABLE (SU.DQT)
; ARE OVERLAPPED INTO THIS AREA. UNFORTUNATELY ALL OF THESE TABLES CAN
; OVERLAP AND THE WHOLE AREA IS A WORK AREA, SO IT IS A MESS TO DETERMINE
; WHAT IS IN THIS AREA ON A LONG-TERM BASIS. THERE IS A FOURTH AREA, THE
; RETAINED-RECORDS TABLE (SU.RRT), WHICH IS MORE PERMANENT. THIS AREA
; PRECEDES THE AREA OF THE PREVIOUS THREE AT RUN-TIME, AND THE TWO ARE
; CONTIGUOUS AND ALLOCATED CONTIGUOUSLY AT RESET TIME IN CBLIO.
; PASU41 MASSAGES THESE INDIVIDUAL VALUES TO FIND THE LARGEST ONE OF
; EACH OF THE FOUR IN ORDER TO SET UP AND ACQUIRE THE CORE SPACE AT RESET
; TIME.
;
;;;;;
	INTER.	PASU44
PASU44:	AOS	SUFBTM		;INCREMENT SPACE REQUIRED IN THE
				;FILL FLUSH BUFFER TABLE
	MOVEI	TA,3
	ADDM	TA,SUEQTM	;INCREMENT SPACE REQUIRED IN EACH
				;OF THE ENQ/DEQ TABLES.

	HRRZ	TA,SU30F2	;MOVE ADDRESS OF FILE TABLE TO TA
	HRLZM	TA,CURFIL
	PUSHJ	PP,LNKSET
	HRRM	TA,CURFIL

	MOVEI	TC,1
	LDB	TB,FI.ORG
	CAIE	TB,%ACC.I
	JRST	SUCS1		;SIZE OF SPACE REQUIRED TO SAVE KEY
				;IS ONE WORD IF FILE IS NOT INDEXED
	LDB	TA,FI.RKY	;Get record key
	JUMPE	TA,SUCS1	;RECORD KEY NOT DEFINED

	HRLZM	TA,CURDAT
	PUSHJ	PP,LNKSET
	HRRM	TA,CURDAT
	LDB	TB,DA.USG
	CAIE	TB,%US.1C
	CAIN	TB,%US.C1
	JRST	SUCS1		;JUMP IF KEY 1 WORD COMP OR COMP-1
	CAIN	TB,%US.IN
	JRST	SUCS1		;JUMP IF KEY INDEX
	MOVEI	TC,2
	CAIE	TB,%US.2C
	CAIN	TB,%US.C2
	JRST	SUCS1		;JUMP IF KEY 2 WORD COMP OR COMP-2
	CAIN	TB,%US.D6
	MOVEI	TC,6		;SET DIVISOR TO 6 IF KEY DISPLAY-6
	CAIN	TB,%US.D7
	MOVEI	TC,5		;SET DIVISOR TO 5 IF KEY DISPLAY-7
	CAIE	TB,%US.EB
	CAIN	TB,%US.C3
	MOVEI	TC,4		;SET DIVISOR TO 4 IF KEY DISPLAY-9 OR COMP-3
	LDB	TD,DA.INS	;GET INTERNAL SIZE FROM DATAB ENTRY
	SETZ	TE,
	DIV	TE,TC
	MOVE	TC,TE	
	SKIPE	TD
	ADDI	TC,1

;	AT THIS POINT TC CONTAINS THE NUMBER OF WORDS REQUIRED TO
;	STORE A KEY OF THE FILE

SUCS1:	ADDI	TC,3		;ADD 1 WORD FOR THE MISCELLANEOUS
				;WORD, 1 WORD FOR THE BLOCK NUMBER,
				;AND 1 WORD FOR THE RMS KEY-OF-REF WORD.
				;TC NOW CONTAINS THE LENGTH OF A
				;RETAINED RECORDS TABLE ENTRY AT RUN TIME.
	ADDM	TC,SURRTM
	MOVE	TA,CURFIL
	LDB	TB,FI.ORG	;GET ACCESS MODE FROM FILE TABLE
	CAIE	TB,%ACC.I
	JRST	PASUAA		;JUMP IF FILE NOT INDEXED
	LDB	TB,FI.RTC
	JUMPN	TB,PASUAA	;JUMP IF A PRIOR ELEMENT IN THIS
				;RETAIN STATEMENT REFERENCES THE SAME FILE

	SUBI	TC,1		;OTHERWISE, ADD TO THE SPACE REQUIRED
				;IN THE RETAINED RECORDS TABLE, ROOM
				;TO TEMPORARILY SAVE THE KEY OF THE FILE
				;WHEN DOING FAKE LOW-VALUES READS AT RUN TIME.
	ADDM	TC,SURRTM

	DPB	TC,FI.RTC	;SET FI.RTC TO NON-ZERO TO INDICATE WE
				;PROCESSED AN ELEMENT OF THIS RETAIN
				;STATEMENT NAMING THIS FILE.
	MOVEI	TC,3
	ADDM	TC,SUEQTM	;INCREMENT THE SPACE REQUIRED IN EACH
				;OF THE ENQ/DEQ TABLE BY 3 (FOR THE FILE INDEX)
PASUAA:	HRLZI	TA,147000
PASU4Z:	MOVEM	TA,PASU4T
	MOVE	TA,SU30F1
	MOVE	TB,SU30F2
	PUSHJ	PP,PUTGEN;	GENERATE FILE NAME
	MOVE	TA,SU30FG
	TLNE	TA,000010
	PUSHJ	PP,PA21.;	GENERATE DATA NAME OR LITERAL, IF ANY
	MOVE	TA,SU30F1
	TLZ	TA,777774
	OR	TA,SU30FG
	OR	TA,PASU4T
	HLRZ	TB,PASU4T
	LSH	TB,-9
	JRST	PUTGEN;		GENERATE RENQ OPERATOR AND RETURN

	INTER.	PASU41
PASU41:	PUSHJ	PP,PA820.	;PUT RESERVED WORD ON TEMTAB STACK
	HRLZI	TC,150400
PASU4Y:	MOVEM	TC,SU41TP##
	MOVE	TC,SURRTM	;SET SURRT., SUEQT., SUFBT. TO THE
				;LARGEST REQUIREMENT OF ANY RETAIN
				;STATEMENT PROCESSED SO FAR.
	CAMLE	TC,SURRT.
	MOVEM	TC,SURRT.
	MOVE	TC,SUEQTM
	ADDI	TC,5		;MAKE IT LONG ENOUGH TO COVER HDR + 1 REQ
				; THIS IS THE SAME MAGIC 5 AS IN PASU8.
	CAMLE	TC,SUEQT.
	MOVEM	TC,SUEQT.
	MOVE	TC,SUFBTM
	CAMLE	TC,SUFBT.
	MOVEM	TC,SUFBT.
	PUSHJ	PP,SUZRTC	;ZERO FI.RTC IN ALL FILE TABLES
	MOVE	TA,SU30F1
	TLZ	TA,777774
	OR	TA,SU41TP##
	HRRZI	TB,000150
	PJRST	PUTGEN;		GENERATE ERENQ OPERATOR AND RETURN

SUZRTC:	MOVE	TA,FILLOC	;ZERO FI.RTC IN ALL FILE TABLES AND RETURN
	CAMN	TA,FILNXT
	POPJ	PP,
	HRRZI	TA,CD.FIL*1B20+1
SUZRT1:	HRLZM	TA,CURFIL
	PUSHJ	PP,LNKSET
	HRRM	TA,CURFIL
	SETZ	TB,
	DPB	TB,FI.RTC
SUZRT2:	HRRZ	TA,CURFIL
	LDB	TA,FI.NXT
	JUMPN	TA,SUZRT1
	POPJ	PP,

	INTER.	PASU42
PASU42:	HRLZI	TC,150000
	PUSHJ	PP,PASU4Y
	JRST	PA0.;		POP UP

	INTER.	PASU45
PASU45:	MOVE	TA,SU30F1;	GENERATE ERUNAV OPERATOR
	TLZ	TA,777774;	AND POP UP
	TLO	TA,151000
	HRRZI	TB,000151
	PUSHJ	PP,PUTGEN
	PUSHJ	PP,PA24.
	SWOFF	UNCONT;		0K FOR GO TO OR STOP TO PRECEDE NEXT STATEMENT
	JRST	PA0.


	INTER.	PASU64
PASU64:	HRLZI	TA,000200;	SET FILENAME EVERY FLAG
	JRST	PASU3X

	INTER.	PASU92
PASU92:	HRLZI	TA,(1B15)	;SET "FILENAME NEXT" FLAG
	JRST	PASU3X
;ACTIONS PASU60 THROUGH PASU81 GENERATE GENFIL FOR THE FREE STATEMENT.
;THE GENFIL FOR THE FREE STATEMENT LOOKS LIKE THIS:
;
;	FILE-NAME-1
;	[DATA-NAME-1 OR LITERAL-1]
;	RDEQ (OP CODE 152)
;	.
;	.
;	.
;	FILE-NAME-N
;	[DATA-NAME-N OR LITERAL-N]
;	RDEQ, AS ABOVE
;	ERDEQ (OP CODE 153) WITH FLAG INDICATING IF USER SUPPLIED
;	A NOT RETAINED STATEMENT
;	[CODE FOR THE NOT RETAINED STATEMENT]
;	ENR (OP CODE 154) IF USER SUPPLIED NOT RETAINED STATEMENT
;
	INTER.	PASU60
PASU60:	MOVE	TA,W2;		GET LINE NUMBER AND CHARACTER POSITION
	TLZ	TA,777774
	TLO	TA,152400;	SET RDEQ AND EVERY FLAG
	HRRZI	TB,000152
	JRST	PUTGEN

	INTER.	PASU61
PASU61:	HRLZI	TC,153400;	SET NOT RETAINED FLAG
PASU6Y:	MOVE	TA,W2
	TLZ	TA,777774
	OR	TA,TC
	HRRZI	TB,000153;	GENERATE ERDEQ
	PJRST	PUTGEN

	INTER.	PASU63
PASU63:	HRLZI	TC,153000
	PUSHJ	PP,PASU6Y;	GENERATE ERDEQ
	JRST	PA0.;		POP UP

	INTER.	PASU62
PASU62:	MOVE	TA,W2;		GENERATE ENR AND POP UP
	TLZ	TA,777774
	TLO	TA,154000
	HRRZI	TB,000154
	PUSHJ	PP,PUTGEN
	PUSHJ	PP,PA24.
	SWOFF	UNCONT;		OK FOR GO OR STOP TO PRECEDE NEXT STATEMENT
	JRST	PA0.

	INTER.	PASU66
PASU66:	HRLZI	TA,152000;	GENERATE RDEQ
	JRST	PASU4Z

;STUB FOR UNLOCK VERB.

;WHEN VAX VMS COBOL V2-STYLE SMU IS IMPLEMENTED IN THIS COBOL, THE UNLOCK
; VERB PROCESSING WILL BEGIN HERE. BUT, FOR NOW IT IS JUST A STUB. 
; IF IT IS USED WITH APPLY BASIC-LOCKING IN THE SAME PROGRAM, THE USER
; WILL GET A DIAGNOSTIC TO SAY THAT IT IS ILLEGAL TO USE BASIC-LOCKING
; WITH UNLOCK. IF HE JUST TRIES TO USE UNLOCK HE WILL GET THE STANDARD
; NOT IMPLEMENTED MESSAGE.

	INTER. PASU70
PASU70:	SKIPE	ABSEEN##	;SEEN APPLY BASIC-LOCKING?
	 JRST	PASU7E		; YES
	EWARNJ	E.91		; NO - NOT IMPLEMENTED

PASU7E:	EWARNJ	E.831		; YES - NOT LEGAL
SUBTTL	ANS-82 SYNTAX

	INTER.	PA800.
PA800.:	MOVEI	TA,OPSETC	;Change to SET condition-name 
PA800A:	PUSHJ	PP,SETOP3
	SKIPN	FLGSW		;WANT FIPS FLAGGER?
	POPJ	PP,		;NO
	LDB	LN,OP.LN
	LDB	CP,OP.CP
	MOVEI	TA,%LV.8
	JRST	FLG.ES		;FLAG AT -82 LEVEL

	INTER.	PA801.
PA801.:	MOVEI	TA,OPSWON	;Change to SET mnemonic-name ON 
	JRST	PA800A

	INTER.	PA802.
PA802.:	MOVEI	TA,OPSWOF	;Change to SET mnemonic-name OFF 
	JRST	PA800A

	INTER.	PA803.
PA803.:	MOVEI	TE,OP%LCA##	;IF ... ALPHABETIC-LOWER
	JRST	P183.A

	INTER.	PA804.
PA804.:	MOVEI	TE,OP%UCA##	;IF ... ALPHABETIC-UPPER
	JRST	P183.A

	INTER.	PA805.
PA805.:	FLAGAT	8		;ANSI-8x STANDARD
	SETZM	REFCON##	;BY REFERENCE
	POPJ	PP,

	INTER.	PA806.
PA806.:	FLAGAT	8		;ANSI-8x STANDARD
	SETOM	REFCON##	;BY CONTENT
	POPJ	PP,

	INTER.	PA807.
PA807.:	FLAGAT	8		;ANSI-8x STANDARD
	SETZM	PERFAB		;PERFORM BEFORE TEST
	POPJ	PP,

	INTER.	PA808.
PA808.:	FLAGAT	8		;ANSI-8x STANDARD
	SETOM	PERFAB		;PERFORM AFTER TEST
	POPJ	PP,

	INTER.	PA809.
PA809.:	FLAGAT	8		;ANSI-8x STANDARD
	MOVEI	TA,106		;NOOP OP CODE FOR CONTINUE
	JRST	SETOP		;SET IT UP

	INTER.	PA810.
PA810.:	FLAGAT	8		;ANSI-8x STANDARD
	SOS	PRGLVL##	;COUNT DOWN CONTAINED PROGRAM LEVEL
	MOVE	TA,PROGID##	;NAME OF CURRENT PROGRAM
	CAMN	TA,NAMWRD	;SAME AS THIS?
	SKIPE	NAMWRD+1	;AND ONLY 6 CHARACTERS?
	EWARNJ	E.4		;NO, WARN USER
	POPJ	PP,
;INITIALIZE identifier REPLACING class-type DATA BY {identifier|literal}

	INTER.	PA811.
PA811.:	FLAGAT	8
	;[1600]inidat defined?
	SKIPE	INIDAT		;[1600]Counter defined?
	JRST	PA811A		;[1600]Yes use old one
	;[1600]no make a -generated-initialize-counter- DATAB entry
	MOVE	TA,[XWD NAMWRD,NAMWRD+1]	; [1600]
	SETZM	NAMWRD		;[1600]
	BLT	TA,NAMWRD+4	;[1600]
	MOVE	TA,[XWD [SIXBIT /:GENERATED:INITIALIZE:COUNTER:/],NAMWRD];[1600]
	BLT	TA,NAMWRD+4	;[1600]
	PUSHJ	PP,BLDNAM	;[1600]Get a NAMTAB entry
	HLRZ	W1,TA		;[1600]Save for now
	MOVE	TA,[CD.DAT,,SZ.DAT]	;[1600]Get a basic datab entry
	PUSHJ	PP,GETENT	;[1600]
	MOVEM	TA,INIDAT	;[1600]Save the address
	DPB	W1,DA.NAM##	;[1600]Save the NAMTAB pointer
	MOVE	TB,EAS1PC##	;[1600]Get a core location
	DPB	TB,DA.LOC##	;[1600]
	AOS	EAS1PC		;[1600]Bump the PC
	HRRZI	TB,LVL.01	;[1600]Set the level
	DPB	TB,DA.LVL##	;[1600]
	HRRZI	TB,%US.1C	;[1600]1-WORD COMP
	DPB	TB,DA.USG##	;[1600]Set usage
	HRRZI	TB,%CL.NUM	;[1600]Numeric
	DPB	TB,DA.CLA##	;[1600]Set the class	
	SETOM	TB		;[1600]This is a fake entry
	DPB	TB,DA.FAK##	;[1600]
	DPB	TB,DA.DEF##	;[1600]Item is defined
	HRRZI	TB,6		;[1600]1 word = 6 characters
	DPB	TB,DA.EXS##	;[1600]External size is 1 word
	DPB	TB,DA.INS##	;[1600] so is internal size
	DPB	LN,DA.LN##	;[1600]Point errors at INITIALIZE
	DPB	CP,DA.CP##	;[1600]Line number and character position
	MOVE	CH,[XWD AS.XWD##,1]	;[1600]Put an xwd
	PUSHJ	PP,PUTAS1##	;[1600] into AS1FIL
;	MOVE	CH,[XWD AS.CNS##,0]	;[1600]Value of zero
	HRRZI	CH,AS.CNB##	;[1600]
	PUSHJ	PP,PUTAS1	;[1600]Put it into AS1FIL
	HRRZI	CH,AS.CNB##	;[1600]
	PUSHJ	PP,PUTAS1	;[1600]Put it into AS1FIL
	MOVE	TA,[CD.VAL,,1]	;[1600]Get a valtab entry 1 word long
	PUSHJ	PP,GETENT	;[1600]
	MOVEM	TA,INIVAL	;[1600]Save VALTAB pointer
	HRRZI	TB,1		;[1600]Size is 1
	DPB	TB,VA.SIZ##	;[1600]
	HRRZI	TB,"1"		;[1600]ASCII '1'
	DPB	TB,VA.LFC##	;[1600]Store the character value
PA811A:				;[1600]yes use old one
	HLRZ	TB,INIDAT	;[1600] DATAB for counter
	HRLZI	TA,400000	;[1600] Set operand bit
	HRRZI	TD,%US.1C	;[1600]One word comp
	DPB	TD,[POINT 4,TA,13]	;[1600]PUT USAGE IN FIRST GENFIL WORD.
	DPB	LN,[POINT 13,TA,28]	;[1600]Line number
	DPB	CP,[POINT 7,TA,35]	;[1600]Character position
	PUSHJ	PP,PUTGEN	;[1600] put it in the genfil
	HRLZI	TA,400000	;[1600] Set operand bit
	TLO	TA,GNLIT	;[1600] SET LITERAL BIT
	TLO	TA,GNNUM	;[1600] SET NUMERIC LITERAL BIT
	DPB	LN,[POINT 13,TA,28]	;[1600]Line number
	DPB	CP,[POINT 7,TA,35]	;[1600]Character position
	HLRZ	TB,INIVAL	;[1600] valtab + 1 offset
	PUSHJ	PP,PUTGEN	;[1600] Put the VALTAB entry into GENFIL
	MOVEI	TA,OPITLZ	;INITIALIZE
	JRST	SETOP

	INTER.	PA812.
PA812.:	MOVEI	TA,OP%ALF##	;ALPHABETIC
	JRST	PA816A

	INTER.	PA813.
PA813.:	MOVEI	TA,OP%ANM##	;ALPHANUMERIC
	JRST	PA816A

	INTER.	PA814.
PA814.:	MOVEI	TA,OP%NUM##	;NUMERIC
	JRST	PA816A

	INTER.	PA815.
PA815.:	MOVEI	TA,OP%AED##	;ALPHANUMERIC-EDITED
	JRST	PA816A

	INTER.	PA816.
PA816.:	MOVEI	TA,OP%NED##	;NUMERIC-EDITED
PA816A:	DPB	TA,OP.ILZ##
	SETZM	REPSUB		;[1600]Start counting subscripts from here
	POPJ	PP,

	INTER.	PA817.		;[1600]
PA817.:	HRRZ	TB,REPSUB##	;[1600]The number of subs on replace item
	HRLZI	TA,400000	;[1600] Set operand bit
	TLO	TA,GNLIT	;[1600] SET LITERAL BIT
	TLO	TA,GNNUM	;[1600] SET NUMERIC LITERAL BIT
	DPB	LN,[POINT 13,TA,28]	;[1600]Line number
	DPB	CP,[POINT 7,TA,35]	;[1600]Character position
	PUSHJ	PP,PUTGEN	;[1600]Put it in genfil
	POPJ	PP,		;[1600]Done

;GLOBAL attribute for USE ...

	INTER.	PA819.
PA819.:	FLAGAT	8
	EWARNJ	E.899		;NOT SUPPORTED YET
;Explicit scope termination routines

	INTER.	PA820.
PA820.:	SKIPN	CURVRB##	;Anything to store?
	POPJ	PP,		;No
	MOVE	TA,[CD.TEM,,SZ.TEM]
	PUSHJ	PP,GETENT
	MOVE	TB,CURVRB	;Get verb we really want
	TRZ	TB,AMRGN.	;Shut off any margin flag
	MOVEM	TB,(TA)		;Store verb any any info in LHS.
	SETZM	CURVRB
	POPJ	PP,

	INTER.	PA821.
PA821.:	MOVE	TA,[CD.TEM,,SZ.TEM]
	PUSHJ	PP,GETENT
	TRZ	TYPE,AMRGN.	;[1541]SHUT OFF ANY MARGIN FLAG
	HRRZM	TYPE,(TA)	;Store current verb
	POPJ	PP,

	INTER.	PA822.
PA822.:	FLAGAT	HI
	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	POPJ	PP,

	INTER.	PA822N
PA822N:	FLAGAT	NS
	SKIPE	ABSEEN##		;APPLY BASIC-LOCKING SEEN?
	 JRST	PA822X		; YES - FATAL ERROR - NOT ALLOWED WITH BASIC-LOCKING

	HRRZM	TYPE,CURVRB	;SAVE CURRENT RESERVED WORD.
	POPJ	PP,

PA822X:	EWARNJ	E.832		;GIVE FATAL DIAGNOSTIC MESSAGE

	INTER.	PA823.
PA823.:	SKIPE	SCPTRM##	;[1553] Did we get here from a popped node?
	JRST	PA823E		;[1553] Yes - Check next token
	DMOVE	TB,NAMWRD	;remove END- from current token
	LSHC	TB,4*6
	DMOVEM	TB,NAMWRD
	SKIPN	TA,NAMWRD+2	;Should not happen
	JRST	PA823A		; Since longest is 12 characters
	MOVE	TB,NAMWRD+1
	LSH	TB,-4*6
	LSHC	TB,4*6
	DMOVEM	TB,NAMWRD+1
PA823A:	PUSHJ	PP,TRYNAM	;Get reserved word type
	  JRST	KILL		;[1553] Cannot happen
	HLRZ	TYPE,(TA)	;Get first word of NAMTAB
	TRZN	TYPE,GWRESV	;Should be a reserved word
	  JRST	KILL		;[1553] Should not happen
	MOVEM	TYPE,ENDTOK##	;[1553] Save the token that we found
	SETOM	SCPTRM##	;[1553] Flag to Pop nodes for one level
	MOVE	TA,TEMNXT##	;[1553] Start at bottom of stack
	JRST	PA823D		;[1553]

PA823B:	MOVE	TA,TEMNXT##	;[1553] Restore last location
	SUB	TA,[SZ.TEM,,SZ.TEM]	;Back up 1 item
	MOVEM	TA,TEMNXT##	;[1553] Save new pointer
PA823D:	CAMN	TA,TEMLOC##	;[1553] Back up to top yet ?
	JRST	PA823C		;Yes, we did not find a match
	HRRZ	TB,(TA)		;Get token
	SETZM	PEREPR##	;[1553]
	TRNE	TB,400000	;Is this an inline PERFORM xxx END-PERFORM ?
	SETOM	PEREPR##	;[1553] Yes
	ANDI	TB,177777	;[1553] Clear per-endper and if-else flags
	MOVE	TYPE,ENDTOK##	;[1553] Get the token back
	CAMN	TYPE,TB		;Is this the matching pair?
	JRST	PA823F		;[1553] Yes - end the loop
	SWON	FREGWD		;[1553] Turn on REGET word 
	CAIN	TB,PERFO.	;[1553] Is it END-PERFORM ?
	JRST	PA823P		;[1553] Yes
	JRST	PA0.		;[1553] No, Pop node and try next
PA823F:	MOVM	TA,SCPTRM##	;[1553] Change flag
	MOVEM	TA,SCPTRM##	;[1553]   to match found
	CAIN	TYPE,PERFO.	;[1553] Is it END-PERFORM ?
	JRST	PA823P		;[1553] Yes
	SWOFF	UNCONT		;Switch off unconditional GOTO flag
	SWON	FREGWD		;[1553] Turn on REGET word 
	JRST	PA0.		;

PA823E: SKIPG	SCPTRM##	;[1553] Found the match yet?
	JRST	PA823B		;[1553] No - check next token
	SWOFF	FREGWD		;[1553] Clear reget word
	SETZM	SCPTRM##	;[1553] Reset flag
	MOVE	TA,TEMNXT##	;[1553] Get current stack
	SUB	TA,[SZ.TEM,,SZ.TEM]	;[1553] Back up 1 item
	MOVEM	TA,TEMNXT	;[1553] Reset bottom of stack
	POPJ	PP,		;[1553]

PA823P:	SKIPE	PEREPR##	;[1553]Is it inline PERFORM xxx END-PERFORM ?
	JRST	PA823E		;[1553]Yes, don't put out opcode
	SOS	ILPERF		;[1553] Count down active in-line PERFORMs
	JRST	PA0.		;[1553]No pop its node

	INTER.	PA823C
PA823C:	SETZM	SCPTRM##	;[1553]Incorrect scope terminator
	SWOFF	FREGWD		;[1553]Reset flags, Get next word
	SETZM	EWFLG##		;[1553]Don't give E.855 error
	EWARNJ	E.820

;[1553] PA824. removes the tokens from the terminator stack whose scope
;[1553] is terminated by an ELSE or a WHEN.  It is called from the ELSE
;[1553] and WHEN action routines with the token (IF, EVLAUATE or SEARCH)
;[1553] in TC.

	INTER.	PA824.
PA824.:	CAIN	TYPE,PRIOD.	;[1553] Did we scan a period?
	POPJ	PP,		;[1553] No more terminator stack
	SKIPA	TA,TEMNXT##	;[1553] Start at bottom of stack
PA824A:	SUB	TA,[SZ.TEM,,SZ.TEM]	;[1553] Back up 1 item
	CAMN	TA,TEMLOC##	;[1553] Back up to top yet ?
	EWARNJ	E.855		;[1553] Yes, we did not find the matching one
	HRRZ	TB,(TA)		;[1553] Get token
	CAME	TB,TC		;[1553] Is this the matching token ?
	JRST	PA824A		;[1553]	No keep looking
	MOVEM	TA,TEMNXT	;[1553] Reset bottom of stack
	CAIE	TC,IF.		;[1553] IF-ELSE ?
	POPJ	PP,		;[1553] No - return 
	TRO	TB,200000	;[1553] Flag this IF as having an ELSE
	HRRZM	TB,(TA)		;[1553] Up date the terminator stack
	POPJ	PP,		;[1553] Done
;In-line PERFORM routines

;Save current literal until we know what to do with it

	INTER.	PA830.
PA830.:	DMOVEM	W1,ARG1
	MOVE	TA,[LITVAL,,SAVLIT##]
	BLT	TA,SAVLIT+MAXWLT-1
	POPJ	PP,

;It a numeric paragraph name - do action as for PA163.

	INTER.	PA831.
PA831.:	EXCH	W1,ARG1		;Get previous values
	EXCH	W2,ARG1+1	;...
	TLNE	W1,40000	;SIGNED?
	EWARNW	E.25		;[467] YES
	LDB	TE,GWVAL	;SIZE
	MOVE	TA,[XWD NAMWRD,NAMWRD+1]
	SETZM	NAMWRD
	BLT	TA,NAMWRD+4
	MOVE	TB,[POINT 6,NAMWRD]
	MOVE	TA,[POINT 7,SAVLIT]
PA831A:	ILDB	TC,TA
	SUBI	TC,40		;CONVERT TO SIXBIT
	IDPB	TC,TB
	SOJG	TE,PA831A
	TLZ	W2,GWDEF	;ENTER REF. TO NUMERIC PARA. NAME
	PUSHJ	PP,PUTCRF	;  IN CREF TABLE
	PUSHJ	PP,TRYNAM
	  PUSHJ	PP,BLDNAM	;NOT FOUND
	HRRZ	W1,(TA)
	HLRZS	TA
	DPB	TA,[POINT 15,W2,15]
	EXCH	W1,ARG1
	EXCH	W2,ARG1+1
	POPJ	PP,

;It an in-line PERFORM n times

	INTER.	PA832.
PA832.:	AOS	ILPERF##	;Increment nesting level
	DMOVE	W1,ARG1
	MOVS	TA,[LITVAL,,SAVLIT##]
	BLT	TA,LITVAL+MAXWLT-1
	PUSHJ	PP,PA2.		;Action of PD518.
	MOVEI	TA,OPIPRF	;In-line PERFORM
	PUSHJ	PP,SETOP3
PA832A:	PUSHJ	PP,GETTAG	;Get next tag
	ANDI	CH,077777
	JUMPE	CH,PA832A	;%0 is not allowed
	HRLM	CH,CURVRB	;Store in terminator stack for END-PERFORM
	DPB	CH,OP.TRG	;And in operator word
	PUSHJ	PP,GETTAG	;Get %tag+1 also
	PUSHJ	PP,PA820.	;Store PERFORM verb on terminator stack
	JRST	PA21.		;Action of PD530.

;It's an in-line PERFORM VARYING or PERFORM UNTIL
	INTER.	PA833.
PA833.:	AOS	ILPERF		;Increment nesting level
	PUSHJ	PP,PA156.
	SETO	TB,
	DPB	TB,FL.TAG	;Set bit for link is a TAGTAB entry
PA833A:	PUSHJ	PP,GETTAG	;Get a tag
	TRNN	CH,077777	;Is the tag %0 ?
	JRST	PA833A		; Yes, %0 is not allowed
	MOVEM	CH,INPTAG##	;Save tag for later use
	DPB	CH,FL.PRO	;Set paragraph name link to TAGTAB
	SOS	CH
	HRLM	CH,CURVRB	;Also save for exit
	AOS	CH
	PUSHJ	PP,PA820.	;Store PERFORM verb on terminator stack
	PUSHJ	PP,GETTAG	;Get tag+1 for next statement after perform
	DPB	CH,OP.TRG
	POPJ	PP,

;In-line PERFORM xxx END-PERFORM
	INTER.	PA834.
PA834.:	MOVE	TA,[CD.TEM,,SZ.TEM]
	PUSHJ	PP,GETENT
	MOVE	TB,CURVRB	;Set verb to be perform in temtab
	IORI	TB,400000	;Set first bit in temtab entry
	TRZ	TB,AMRGN.	;[1541]RESET A MARGIN FLAG
	MOVEM	TB,(TA)
	SETZM	CURVRB
	POPJ	PP,
	
;[1553] In-line perform wrap up actions
	INTER.	PA835.
PA835.:	MOVEI	TC,PERFO.	;[1553] Find the last perform
	PUSHJ	PP,PA824.	;[1553]   in the terminator stack
	MOVEI	TA,OPEPRF	;[1553] End in-line PERFORM opcode
	PUSHJ	PP,SETOP	;[1553]
	HRRZ	TA,TEMNXT	;[1553]
	HLRZ	TB,(TA)		;[1553] It hasn't moved yet
	DPB	TB,OP.TRG	;[1553] Store tag number
	PUSHJ	PP,PA22.	;[1553]
	SWON	FREGWD		;[1553] Reget the word
	JRST	PA0.		;[1553] Pop the node
;EVALUATE ACTIONS ...

	INTER.	PA840.
PA840.:			;Initialize Evaluate Verb
	FLAGAT	8		;
	SKIPN	TB,EV.LVL##	;Are we in EVALUATE already?
	JRST	P840.1		;No
	SKIPE	ERSKIP		;Error during last pass?
	SOS	TB,EV.LVL	;Yes, back  up one level
	SETZM	ERSKIP		;
	JUMPE	TB,P840.1	;Nothing to save, at outermost level
	CAIL	TB,EV.DEP	;Already 3 deep?
	JRST	P840.E		;That's the limit
	SOS	TB		;
	IMULI	TB,EV.SIZ	;Get next available 5 word block
	MOVE	TA,EVALFL	;Save flag word
	MOVEM	TA,EV.TAB##(TB)	;
	HRRZ	TA,EVSSCT	;Save SS count,
	HRL	TA,EVSOCT	; SO count
	AOS	TB		;Bump counter
	MOVEM	TA,EV.TAB(TB)	;
	HRRZ	TA,EVNXTS	;Save next selection set tag,
	HRL	TA,EVDONE	; save done tag
	AOS	TB		;Bump counter
	MOVEM	TA,EV.TAB(TB)	;
	HRRZ	TA,EVCOND	;Save false tag of condition test,
	HRL	TA,EVNOT	; save false tag of NOT test
	AOS	TB		;Bump counter
	MOVEM	TA,EV.TAB(TB)	;
	MOVE	TA,EVLNCP	;Save LN, CP of beginning of conditional exp
	AOS	TB		;Bump counter
	MOVEM	TA,EV.TAB(TB)	;
P840.1:	AOS	EV.LVL		;Add one to nest level
	SETZ	TA,		;Zero flag word
	TXO	TA,EVALF	;Set in EVALUATE flag
	MOVEM	TA,EVALFL	;Store in flag word
	SETZM	EVSSCT##		;Init Selection Subject Counter
	HRRZI	TA,OPEVAL		;"EVALUATE" op code
	PUSHJ	PP,SETOP1		;Set up the operator
	PUSHJ	PP,PA22.		;Put it in GENFIL
	HRRZM	TYPE,CURVRB		;Set up scope terminator
	PUSHJ	PP,PA820.		;Put it in TEMTAB
	POPJ	PP,			;Return

P840.E:	EWARNW	E.824		;Nested too deep error
	JRST	P840.1		;Try to keep checking syntax

	INTER.	PA841F
PA841F:			;Set up TRUE operator for "False"
	SETZ	TC,		;Clear a work AC
	TXO	TC,EVFABT	;Set "Not" flag for FALSE (bit 15)
	JRST	P841.1		; and go produce TRUE operator

	INTER.	PA841.
PA841.:			;Set up TRUE operator
	SETZ	TC,		;"Not" flag is null for "True"
P841.1:
	MOVE	TA,EVALFL	;
	TXO	TA,EVALTF	;Set TRUE/FALSE flag
	MOVEM	TA,EVALFL	;
	HRRZI	TA,OPTRUE	;Op code for TRUE/FALSE
	PUSHJ	PP,SETOP1	;Set up opcode in OPRTR+0,+1
	MOVE	TA,OPRTR	;
	MOVE	TB,OPRTR+1	;
	MOVE	TD,EVALFL	;
	TXNE	TD,EVWHEN	;
	HRL	TB,EVNXTS	;store false tag
	IOR	TA,TC		; Do "Not" flag
	TXNN	TD,EVWHEN	;Seen "When" in Evaluate yet?
	TXO	TA,EVSSBT	;No, turn on bit 9 to tell Phase E
				; to save result in Selection Subject table
	JRST	PUTGEN		;Put operator in Genfil

	INTER.	PA841E
PA841E:	SKIPG	EVALFL		;If not EVALUATE, or in EVAL, but want imp stmt
	JRST	P841.E		; give syntax error
	JRST	PA0.		;no error if EVALUATE selection subj/obj
P841.E:	EWARNW	E.86		;found error while scanning
	JRST	PCA12.		;	expression for IF


	INTER.	PA842.
PA842.:			;Finish up a selection subject
	AOS	EVSSCT		;increment selection subj counter
	MOVE	TA,EVALFL	;
	TXNN	TA,EVALTF	;Has TRUE/FALSE been scanned?
	JRST	P842.1		; no
	TXZ	TA,EVALTF	; yes, zero flag
	MOVEM	TA,EVALFL	;
	POPJ	PP,		;  and leave
P842.1:	HRRZI	TA,OPEVGN	;Op code for processing selection subj/obj
	PUSHJ	PP,SETOP1	;set up operator
	MOVE	TA,OPRTR	;
	TXO	TA,EVSSBT	;distinguish selection subject from object
	MOVEM	TA,OPRTR	;
	HRRZ	TA,ARGLST+IF.DEP-1 ;IF's tag table, relationals expression will
	SKIPN	TA		; leave a false tag, if zero, no expression,
	JRST	P842.2		;so skip ahead
	DPB	TA,OP.TRG	; else store it to declare later
	HLRM	TA,ARGLST+IF.DEP-1	;
P842.2:	PUSHJ	PP,PA22.	;put operator in GENFIL
	POPJ	PP,		;

	INTER.	PA843I
PA843I:			;Put out "End SS for Evaluate" Operator
	HRRZI	TA,OPEVSS	; "END SS" op code
	PUSHJ	PP,SETOP1	;
	PUSHJ	PP,PA22.	;
P843I:	PUSHJ	PP,GETTAG	;get tag for JRST %NNN,
	ANDI	CH,077777	; done after each imperative
	JUMPE	CH,P843I	; statement, all can use same tag
	MOVEM	CH,EVDONE##	;
	SKPNAM			; and on to handle "When"

	INTER.	PA843.
PA843.:			;When clause of Evaluate
	PUSHJ	PP,GETTAG	;Get a tag
	ANDI	CH,077777	; to mark start of next selection set
	JUMPE	CH,PA843.	; (preferably non-zero)
	MOVEM	CH,EVNXTS##	;so can jump ahead if fail to match SS/SO's
	SETZM	EVSOCT##		;Init Selection Object Counter
	SETZM	EWFLG##		;[1553] Turn off when seen for E.855
	MOVE	TA,EVALFL	;
	TXO	TA,EVWHEN	;Set flag for "Wehn" clause
	MOVEM	TA,EVALFL	;
	MOVEI	TC,EVAL.	;[1553] The token to look for
	JRST	PA824.		;[1553] Clean up terminator stack


	INTER.	PA844.
PA844.:			;"Any" Operator of Evaluate
	MOVE	TA,EVALFL	;
	TXO	TA,EVNYSN	;Set 'ANY' seen bit
	MOVEM	TA,EVALFL	;
	HRRZI	TA,OPANY	; "ANY" op code
	PUSHJ	PP,SETOP1	;
	PUSHJ	PP,PA22.	;
	POPJ	PP,		;

	INTER.	PA845.
PA845.:			;completed scan of selection object
	AOS	EVSOCT		;increment so counter
	MOVE	TA,EVALFL	;
	TXNE	TA,EVNYSN!EVALTF	;If scanned 'ANY or  'TRUE/FALSE'
	JRST	P845.4		; don't need this
	HRRZI	TA,OPEVGN	;setup op code to process selection subj/obj
	SKIPE	EVLNCP		;(If SS/SO is expression
	EXCH	W2,EVLNCP	; use LN, CP of start of expression)
	PUSHJ	PP,SETOP1	;to trigger phase E set up of ss operand
	SKIPE	EVLNCP		;
	EXCH	W2,EVLNCP	;must restore w2, it's the next scanned token
	MOVE	TA,EVALFL	;
	TXNN	TA,EVCND	;
	JRST	P845.0		;
	MOVE	TA,OPRTR	;
	TXO	TA,EVCDBT	;
	MOVEM	TA,OPRTR	;
	HRRZ	TB,EVCOND	;
	JRST	P845.2		;
P845.0:	MOVE	TA,IFLVL	;
	SOS	TA		;
	HRRZ	TB,ARGL2(TA)	;Was an expression scanned?
	JUMPE	TB,P845.1	;No
	HLRM	TB,ARGL2(TA)	;Yes, zero tag table entry
P845.2:	DPB	TB,OP.TRG	; and store tag
	PUSHJ	PP,PA22.	;
	HRLZ	TB,EVNXTS	;Set up failure jrst
	HRRI	TB,OPJUMP	;
	PUSHJ	PP,P198.E	;
	JRST	P845.4		;

P845.1:	PUSHJ	PP,PA22.	;put it in GENFIL
	HRRZI	TA,OPIF		;set up IF op code
	PUSHJ	PP,SETOP1	;
	MOVE	CH,EVNXTS##	;tag for failure to match,
	DPB	CH,OP.TRG	; will mark start of next selection set
	SETO	TA,		;
	DPB	TA,OP.FLS	;mark tag as false tag
	DPB	TA,OP.EQU	;test on equality
	MOVE	TB,EVALFL	;
	TXNE	TB,EVTHRU	;Is this the end of a 'THRU' clause?
	DPB	TA,OP.GRT	;Yes, need test on LESS or EQUAL
	TXNE	TB,EVNOTF	;'NOT' scanned?
	DPB	TA,OP.NOT	;Yes, set bit in op code
	PUSHJ	PP,PA22.	;

	HRRZI	TB,OPCLRE	;end-condition op code (GOBACK)
	PUSHJ	PP,P198.E	;needed to clear EOPTAB
	MOVE	TB,EVALFL	;
	TXNE	TB,EVNOTF	;If 'NOT'
	TXNN	TB,EVTHRU	; 'THRU' scanned
	JRST	P845.4		;
	HRLZ	TB,EVNOT	; put out tag for TRUE case
	PUSHJ	PP,P198.D	; 

;Ascertain Action and Return Point
P845.4:	MOVE	TA,EVALFL	;
	TXZ	TA,EVNYSN!EVALTF!EVCND!EVNOTF!EVTHRU	;Zero some flags
	TSWFZ	FNOTF		;Did we see 'NOT' in scan ahead?
	TXO	TA,EVNOTF	;Yes
	MOVEM	TA,EVALFL	;
	SETZM	EVCOND##	;Zero 
	SETZM	EVNOT##		;  out 
	SETZM	EVLNCP##	;    tag holders
	SKIPLE	IFLVL		;
	SOS	IFLVL		;Decrement IF level
	MOVE	TA,EVSOCT##	;Current count of Selection Objects
	CAMGE	TA,EVSSCT##	; up to count of Selection Subjects?
	JRST	PA0.		; and return to superior node
P845.5:
	MOVE	TA,EVALFL	;
	TXO	TA,EVIMPS	;Set imperative stmt flag
	MOVEM	TA,EVALFL	;
	MOVE	TE,[XWD	0,PD2094##] ;Node to fake to for SOIS
	HRRZM	TE,(NODPTR)	;Diddle the node list
	POPJ	PP,		; and return to SQURL.

	INTER.	PA846.
PA846.:			;Wrap up Set of Imperative Stmts for "When" clause
	HRRZI	TA,(TYPE)		;Did we munch up to a period (.)?
	ANDI	TA,777		;Get TYPE less A-Margin
	CAIN	TA,PRIOD.		;Is it a period?
	SWON	FPERWD		;Set flag to re-get period.
	SKIPE	SCPTRM##	;[1553] or a scope terminator?
	SWON	FREGWD		;[1553] Set flag to re-get the terminator.

	MOVE	TB,EVALFL	;
	TXNE	TB,EVOTHR	;is this the imperative of WHEN OTHER?
	JRST	P846.1		;yes, don't need tag or JRST
	HRLZ	TB,EVDONE##	;else we have completed imperative statement,
	HRRI	TB,OPJUMP	; now need JUMPTO to end of EVALUATE
	PUSHJ	PP,P198.E	;
	HRLZ	TB,EVNXTS##	;generate TAGNAM for next selection set
	PUSHJ	PP,P198.D	;put in GENFIL
P846.1:	SETZM	EVSOCT		;reset selection object counter
	MOVE	TA,EVALFL	;
	TXZ	TA,EVIMPS	;
	MOVEM	TA,EVALFL	;
	SETZM	SWHEN		;GETITM turned on SEARCH's 'WHEN SEEN' flag
	JRST	PA0.		;Go to PA0. to pop up a node

	INTER.	PA847.
PA847.:		;Wrap-up actions for Evaluate Verb
P847.1:	HRLZ	TB,EVDONE##	;put out tag for JRST's after
	PUSHJ	PP,P198.D	; imperative statements
	HRRZI	TA,OPEVND	; "END-EVALUATE" op code
	PUSHJ	PP,SETOP1	;
	PUSHJ	PP,PA22.	;

	SETZM	EVALFL##	;Reset Evaluate counters and pointers
	SETZM	EVSOCT##	;
	SETZM	EVSSCT##	;
	SOSG	TB,EV.LVL	;Decrement EVALUATE nest count
	POPJ	PP,		;If zero, no other levels
	CAIL	TB,EV.DEP	;Error should have been caught elsewhere
	POPJ	PP,		;
	SOS	TB		;Backup one
	IMULI	TB,EV.SIZ	;Multiply by entry size
	MOVE	TA,EV.TAB(TB)	;Get flag word
	MOVEM	TA,EVALFL	; restore
	AOS	TB		;
	MOVE	TA,EV.TAB(TB)	;Get SS and SO counts
	HRRM	TA,EVSSCT	; restore
	HLRM	TA,EVSOCT	;
	AOS	TB		;
	MOVE	TA,EV.TAB(TB)	;Get tags
	HRRM	TA,EVNXTS	; restore
	HLRM	TA,EVDONE	;
	AOS	TB		;
	MOVE	TA,EV.TAB(TB)	;Get more tags
	HRRM	TA,EVCOND	; restore
	HLRM	TA,EVNOT	;
	AOS	TB		;
	MOVE	TA,EV.TAB(TB)	;Get expression LN, CP
	MOVEM	TA,EVLNCP	; restore
	POPJ	PP,		;

	INTER.	PA848.
PA848.:			;Evaluate "OTHER"
	MOVE	TA,EVALFL	;
	TXO	TA,EVOTHR	;Set "Other" flag
	MOVEM	TA,EVALFL	;
	POPJ	PP,		;

	INTER.	PA849.
PA849.:			;Fatal error in selection subject/object?
	SKIPN	ERSKIP		;Trapped during expression scan,
	POPJ	PP,		; so any error messages were
	SETZM	EVALFL		; generated there
	SETZM	EWFLG		;[1553] This is not a scope term error
	SETZM	EVSOCT		;Have scanned to period, so will
	PUSHJ	PP,PA165.	; put out a yecch and
	JRST	PA0.		; fall into evaluate wrap up stuff 

	INTER.	PA850.
PA850.:				;Scanned an 88 level
	MOVE	TA,EVALFL	;
	TXO	TA,EVCND	;turn on CONDITION-NAME flag
	MOVEM	TA,EVALFL	;
	PUSHJ	PP,PA2.HI	;set up operand
	PUSHJ	PP,PA21.	;put it in GENFIL
	HRRZI	TA,OPIFC	;op code for conditional IF
	PUSHJ	PP,SETOP1	;
P850.0:	PUSHJ	PP,GETTAG	;get tag for false jrst
	ANDI	CH,077777	;
	JUMPE	CH,P850.0	;
	HRRM	CH,EVCOND	;save it in RH of evcond
	DPB	CH,OP.TRG	;
	SETO	TA,		;
	DPB	TA,OP.FLS	;
	DPB	TA,OP.EQU	;
	MOVE	TB,EVALFL	;
	TXNE	TB,EVNOTF	;
	DPB	TA,OP.NOT	;
	PUSHJ	PP,PA22.	;put operator in GENFIL
	POPJ	PP,		;exit

	INTER.	PA851.
PA851.:				;Scanned 'THRU' in selection object
	MOVE	TA,EVALFL	;
	TXOE	TA,EVTHRU	;
	JRST	P851.E		;Can't have 2 'THRU's
	MOVEM	TA,EVALFL	;
	HRRZI	TA,OPEVGN	;op code for processing selection subj/obj
	PUSHJ	PP,SETOP1	;
	MOVE	TA,OPRTR	;Get first word of op code
	TXO	TA,EVTHRB	;Set 'THRU' bit
	MOVEM	TA,OPRTR	;
	PUSHJ	PP,PA22.	;Put op code in GENFIL
	HRRZI	TA,OPIF		;Set up IFGEN op code
	PUSHJ	PP,SETOP1	; in OPRTR+0,+1
	SETO	TA,		;
	DPB	TA,OP.EQU	;Set EQUAL bit
	DPB	TA,OP.LES	; and GREATER bit
	DPB	TA,OP.FLS	;Set jump if false
	MOVE	TA,EVALFL	;
	TXNN	TA,EVNOTF	;If 'NOT ... THRU',
	JRST	P851.1		;
	PUSHJ	PP,GETTAG	; need tag for TRUE case
	ANDI	CH,077777	;
	HRRM	CH,EVNOT	;Store in flag word
	SKIPA			;
P851.1:	MOVE	CH,EVNXTS	;Get target
	DPB	CH,OP.TRG	; for false jump
	PUSHJ	PP,PA22.	;Put it in GENFIL
	HRRZI	TA,OPCLRE	;Put out GOBACK op code
	PUSHJ	PP,SETOP1	; to clear EOPTAB after
	PUSHJ	PP,PA22.	; leaving IFGEN
	JRST	PA0.		;
P851.E:	EWARNW	E.258		;Give error if another 'THRU'
	JRST	PA0.		;

	INTER.	PA852.
PA852.:				;'NOT' seen at beginning of expression
	MOVE	TA,EVALFL	;
	TXO	TA,EVNOTF	;turn on 'NOT' flag
	MOVEM	TA,EVALFL	;
	POPJ	PP,		;Exit

	INTER.	PA853.
PA853.:				;'PERIOD' scanned
	SKIPN	ERSKIP		;
	SWON	FGTPER		;
	POPJ	PP,		;

	INTER.	PA854.
PA854.:				;About to scan selection object
	MOVE	TA,EVALFL	;
	TXNE	TA,EVTHRU	;If not handling a 'THRU' clause
	POPJ	PP,		;
	AOS	TA,IFLVL	; add 1 to IF depth
	ADD	TA,SPFLVL	;
	CAIG	TA,IF.DEP	;exceeded maximum?
	POPJ	PP,		;no
	JRST	PA90.B		;yes, error

	INTER.	PA860.
PA860.:				;No length given with reference modification
	SETZ	TA,		;
	HRLM	TA,RMFLG	;
	HRRZI	TA,OPREFM	;
	PUSHJ	PP,SETOP1	;
	MOVE	TA,OPRTR	;[1535] Get op code
	SKIPN	ERSKIP		;[1535] Was there an error with modifier?
	TXO	TA,RFMERR	;[1535] Yes, set bit in op code
	MOVEM	TA,OPRTR	;[1535] Restore it
	MOVE	TB,RMOPPAR##	;[1561] Get stored open paren count
	MOVEM	TB,ELEVEL	;[1561] Restore for IF expression
	PUSHJ	PP,PA22.	;
	POPJ	PP,		;

	INTER.	PA861.
PA861.:				;Reference modification w/ length modifier
	HRRZI	TA,OPREFM	;
	PUSHJ	PP,SETOP1	;
	MOVE	TA,OPRTR	;
	TXO	TA,RFMBTH	;set bit marking both offset and length
	MOVEM	TA,OPRTR	; as being modified
	PUSHJ	PP,PA22.	;put out op code
	POPJ	PP,		;

	INTER.	PA862.
PA862.:				;Reference modifier for length
	CAIN	TYPE,COLON.	;
	EWARNW	E.845		;Expression scan found a second COLON
	CAIE	TYPE,RPREN.	;If scan didn't end on a RPREN.,
	PUSHJ	PP,PA132.	; something wrong in modifier expression
	HRRZI	TA,OPREFM	;
	PUSHJ 	PP,SETOP1	;
	MOVE	TA,OPRTR	;
	TXO	TA,RFMLEN	;
	MOVEM	TA,OPRTR	;
	SWOFF	FREGWD		;
	MOVE	TB,RMOPPAR##	;[1561] Get stored open paren count
	MOVEM	TB,ELEVEL	;[1561]	Restore for IF expression
	JRST	PA22.		;

	INTER.	PA863.
PA863.:				;Subscripts only in (  )'s
	SETZM	RMFLG		;
	POPJ	PP,		;

	INTER.	PA864.
PA864.:				;Error while scanning subs or ref modders
	SKIPN	ERSKIP		;If on, error msg already given
	EWARNW	E.849		;Incorrect sub or ref modder
	PUSHJ	PP,PA860.	;[1522] Expression scanner handled error,
	DMOVE	TB,RMOPR	;[1522]  put out op code and continue
	DMOVEM	TB,OPRTR	;
	JRST	PA0.		;

	INTER.	PA865.
PA865.:				;Error in expression within ( ), give yecch
	EWARNW	E.849		;
	PUSHJ	PP,PA860.	;[1535] Put out op code
	JRST	PA0.		;[1535] Pop up one node
SUBTTL	COMPOUND ACTIONS

	INTER.	PCA1.
PCA1.:	PUSHJ	PP,PA3.
	PUSHJ	PP,PA21.
	JRST	PA22.

	INTER.	PCA2.
PCA2.:	PUSHJ	PP,PA137.	;SET PARA OPERATOR
	PUSHJ	PP,PA4.		;CHECK TO SEE NOT DUPLICATED
	JRST	PCA25.

	INTER.	PCA3.
PCA3.:	PUSHJ	PP,PCA3A	; [271] SET UP SECTION
	MOVE	TB,PROGST	; [271] SAVE START OF PROG
	PUSH	PP,TB		; [271]
	PUSHJ	PP,PA219X	; [271] MAKE GENERATED PARA NAME FOR NEW SECTION
	POP	PP,TB		; [271] RESTORE
	MOVEM	TB,PROGST	; [271] START OF PROG
	SETO	TB,		; [271] SET MULTI-DEFINED BIT ON
	DPB	TB,PR.MDF	; [271] DEFINED BIT OFF-MEANS GENERATED PARA IN XFRGEN
	POPJ	PP,		; [271]

PCA3A:	PUSHJ	PP,PA3.		; [271] ADD LABEL 
	PUSHJ	PP,PA7.
	JRST	PCA25.

	INTER.	PCA5A.
PCA5A.:	TLNE	W1,GWSIGN!GWDP
	EWARNW	E.702
	JRST	PCA5.

	INTER.	PCA5.8
PCA5.8:	FLAGAT	8		;ANS-8x code
	JRST	PCA5.

	INTER.	PCA5.M
PCA5.M:	HRRZ	TA,CURFIL
	LDB	TA,FI.LCP##	;SEE IF LINAGE CLAUSE SPECIFIED
	SKIPE	TA		;NO, OK
	EWARNW	E.754		;YES, GIVE ERROR
	SKPNAM

	INTER.	PCA5.F
PCA5.F:	FLAGAT	HI
	JRST	PCA5.

	INTER.	PCA5.N
PCA5.N:	FLAGAT	NS
	SKPNAM

	INTER.	PCA5.
PCA5.:	PUSHJ	PP,PA2.
	JRST	PA21.
;PCA5F. IS A VERSION OF PCA5. THAT IS CALLED WHEN A FILE NAME
; IS READ, TO SET UP "CURFIL".
	INTER.	PCA5F.
PCA5F.:	PUSHJ	PP,PA2.
	MOVE	TA,ARG1
	HRLM	TA,CURFIL	;SET UP CURFIL
	ADD	TA,FILLOC
	HRRM	TA,CURFIL
PCA5G.:	SKIPN	FLGSW		;WANT FIPS FLAGGER?
	JRST	PA21.		;NO, WRITE OPERAND
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
	MOVE	TA,[%LV.L		;SEQUENTIAL
		%LV.LI			;RELATIVE
		%LV.H			;INDEXED
		0](TB)
	PUSHJ	PP,FLG.ES##	;FLAG IF ILLEGAL, NOTE LN & CP ARE SET UP
	JRST	PA21.		;WRITE OPERAND

	INTER.	PCA5Z.
PCA5Z.:	LDB	TE,GWVAL	;TEST FOR ZERO ONLY
	CAIN	TE,ZERO.
	JRST	PCA5.		;OK
	EWARNW	E.638		;TELL USER
	MOVEI	TE,ZERO.	;TURN IT INTO ZERO
	DPB	TE,GWVAL	;TO AVOID ERROR IN COBOLE
	JRST	PCA5.

	INTER.	PCA6A.
PCA6A.:	PUSHJ	PP,PA22.
	PUSHJ	PP,PA59.
	SKPNAM

	INTER.	PCA6.
PCA6.:	PUSHJ	PP,PA22.
	JRST	PA0.

	INTER.	PCA7C.		;[1334]
PCA7C.:	PUSHJ	PP,PA4.Z		;[1322] SAME AS PCA7., BUT CHECK LAST PARA
	JRST	PCA7.		;[1322]  FOR ENDING IN UNCONDITIONAL GOTO

;IN A SEARCH STATEMENT.. SET FLAG THAT SAYS "WHEN" SEEN TO DELIMIT
; STATEMENT, NOT "."

	INTER. 	PCA7A.
PCA7A.:	SETOM	SWHEN##
	SKPNAM			;REGET THE "WHEN" AND POP UP A NODE

	INTER.	PCA7.
PCA7.:	PUSHJ	PP,PA24.
	JRST	PA0.

;[1556] REMOVE CODE TO IGNORE A EXTRA PERIOD IN A SEARCH ... WHEN

	INTER.	PCA7B.
PCA7B.:	SWON	FPERWD		;[1573] REGET THE PERIOD
	SKPNAM			;[1573] ON TO PCA7BA

	INTER.	PCA7BA		;[1573]
PCA7BA:	SETZM	SWHEN##		;[1573] CLEAR FLAG
	SETZM	SCPTRM##	;[1553] CLEAR END-XXX
	MOVE	TA,TEMLOC	;Reset scope terminator stack
	MOVEM	TA,TEMNXT
	SKIPLE	ILPERF		;[1553] Do the in-line PERFORMs balance?
	EWARNW	E.821		;No
	SETZM	ILPERF
	JRST	PA0.		;POP UP A NODE

;[1553] The next four entries make sure an ELSE or a WHEN after an Incorrect
;[1553] Scope terminator gets a good error message

	INTER.	PCA7G.
PCA7G.:	SKIPN	ERSKIP		;[1553] Skip if doing error recovery
	SETOM	EWFLG##		;[1553] Set flag that ELSE was seen
	JRST	PCA7.		;[1553] Pop the node

	INTER.	PCA7D.
PCA7D.:	SKIPN	ERSKIP		;[1553] Skip if doing error recovery
	SETOM	EWFLG##		;[1553] Set flag that WHEN was seen
	JRST	PCA7A.		;[1553] Set flag and pop a node

	INTER.	PCA7E.
PCA7E.:	SETZM	EWFLG##		;[1553] Reset the flag
	POPJ	PP,		;[1553]

	INTER.	PCA7F.
PCA7F.:	SKIPE	EWFLG##		;[1553] Flag still set?
	JRST	PCA7FX		;[1553] Yes - Must have had a bad END-XXX 
	EWARNJ	E.148		;[1553] No - Use the old error
PCA7FX:	EWARNJ	E.855		;[1553] Scope already terminated

;Test for incomplete IF statement

	INTER.	PCA7X.
PCA7X.:	PUSH	PP,TE		;[1313] GET AN AC TO WORK WITH
	MOVE	TE,IFLVL##	;[1313] GET THE CURRENT IF LEVEL
	ADD	TE,SPFLVL	;[1313] PLUS THAT OF SPECIAL IF
	JUMPE	TE,PCA7X1	;[1313] OK IF ZERO
	CAIN	TYPE,USERN.+AMRGN.	;[1313] USER NAME IN A-MARGIN?
	EWARNW	E.148		;[1313] YES, GIVE DIAGNOSTIC MESSAGE
PCA7X1:	POP	PP,TE		;[1313] RESTORE AC
	JRST	PCA7.		;[1313] AND CONTINUE

	INTER.	PCA11.
PCA11.:	PUSHJ	PP,PCA10.
	JRST	PA24.

	INTER.	PCA12.
PCA12.:	SWOFF	FNOSUB;		;[645] CLEAR "SUBSCRIPTING NOT ALLOWED" FLAG
	PUSHJ	PP,PA165.	;OUTPUT "YECCH"
	PUSHJ	PP,PA133.	;SKIP TO NEXT PERIOD
	SETZM	RMFLG		;CLEAR UP REF MOD FLAG
	JRST	PA0.		;GO POP UP A LEVEL

	INTER.	PCA13.
PCA13.:	PUSHJ	PP,PA148.
	JRST	PA0.

	INTER.	PCA14.
PCA14.:	PUSHJ	PP,PA135.
	JRST	PA22.

	INTER.	PCA15.
PCA15.:	PUSHJ	PP,PCA5.
	HRRZ	TA,W1		;GET FILTAB LINK
	PUSHJ	PP,LNKSET
	LDB	TB,FI.DSD	;LOOK FOR SORT FLAG
	JUMPN	TB,PA22.	;OK
	EWARNW	E.44		;NOT A SORT FILE
	JRST	PA22.

	INTER.	PCA16.
PCA16.:	PUSHJ	PP,PA148.
	JRST	PA0.

	INTER.	PCA17.
PCA17.:	PUSHJ	PP,PA2.
	JRST	PA150.

	INTER.	PCA18.
PCA18.:	PUSHJ	PP,PA151.
	PUSHJ	PP,PA153.
	PUSHJ	PP,PA2.
	PUSHJ	PP,PA150.
	JRST	PA152.

	INTER.	PCA19S
PCA19S:	FLAGAT	8
	SKPNAM

	INTER.	PCA19.
PCA19.:	PUSHJ	PP,PA2.
	SKPNAM

	INTER.	PCA10.
PCA10.:	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	JRST	PA0.

	INTER.	PCA19A
PCA19A:	PUSHJ	PP,PA2.
	MOVE	TA,ARG1		;GETSRC W1
	TLNE	TA,GWSIGN!GWDP	;TEST FOR SIGN AND POINT
	EWARNW	E.702		;TOO BAD
	JRST	PCA10.

	INTER.	PCA21.
PCA21.:	PUSHJ	PP,PA151.
	PUSHJ	PP,PA153.
	PUSHJ	PP,PA2.
	PUSHJ	PP,PA154.
	JRST	PA152.

	INTER.	PCA22.
PCA22.:	PUSHJ	PP,PA151.
	PUSHJ	PP,PA153.
	PUSHJ	PP,PA2.
	PUSHJ	PP,PA155.
	JRST	PA152.

	INTER.	PCA23.
PCA23.:	PUSHJ	PP,PA47.
	PUSHJ	PP,PA2.
	JRST	PA155.

	INTER.	PCA25C		;CLOSE VERB
PCA25C:	SKIPN	FLGSW##		;FIPS FLAGGER WANTED?
	JRST	PCA25.		;NO
	MOVE	TA,ARG1		;GET FILE TABLE
	ADD	TA,FILLOC
	LDB	TB,FI.ORG	;GET FILE ORGANIZATION
	SKIPE	SU8CNT		;IF NOT FIRST FILE
	ADDI	TB,4		;PUT IN SECOND SET
	LDB	LN,[POINT 13,ARG1+1,28]	;LOAD LN &
	LDB	CP,[POINT 7,ARG1+1,35]	;CP JUST IN CASE
	MOVE	TA,[%LV.L		;SEQUENTIAL FIRST FILE
		%LV.LI			;RELATIVE FIRST FILE
		%LV.H			;INDEXED FIRST FILE
		0
		%LV.HI			;SEQUENTIAL NOT FIRST FILE
		%LV.LI			;RELATIVE, NOT FIRST FILE
		%LV.H			;INDEXED, NOT FIRST FILE
		0](TB)
	PUSHJ	PP,FLG.ES##	;FLAG IF ILLEGAL
	SKPNAM

	INTER.	PCA25.
PCA25.:	PUSHJ	PP,PA21.
	JRST	PA22.

	INTER.	PCA26.
PCA26.:	PUSHJ	PP,PA151.
	PUSHJ	PP,PA153.
	PUSHJ	PP,PA2.
	PUSHJ	PP,PA156.
	JRST	PA152.
	INTER.	PCA27.
PCA27.:	PUSHJ	PP,PA151.
	PUSHJ	PP,PA153.
	PUSHJ	PP,PA2.
	PUSHJ	PP,PA157.
	JRST	PA152.


	INTER.	PCA28.
PCA28.:	PUSHJ	PP,PA47.
	PUSHJ	PP,PA2.
	JRST	PA157.


	INTER.	PCA29.
PCA29.:	PUSHJ	PP,PA159.
	JRST	PA21.


	INTER.	PCA30.
PCA30.:	PUSHJ	PP,PA163.
	JRST	PA150.


	INTER.	PCA31.
PCA31.:	PUSHJ	PP,PA47.
	PUSHJ	PP,PA163.
	JRST	PA155.


	INTER.	PCA32.
PCA32.:	PUSHJ	PP,PA47.
	PUSHJ	PP,PA163.
	JRST	PA157.

	INTER.	PCA34.
PCA34.:	PUSHJ	PP,PA2.
	PUSHJ	PP,PA21.
	JRST	PA38.

	INTER.	PCA36.
PCA36.:	PUSHJ	PP,PA24.
	PUSHJ	PP,PA139.
	JRST	PA0.

	INTER.	PCA36A
PCA36A:	PUSHJ	PP,PA24.
	PUSHJ	PP,PA140.	;SPIF, NOT FOR I-O
	JRST	PA0.

	INTER.	PCA37.
PCA37.:	PUSHJ	PP,PA22.
	JRST	PA34.


	INTER.	PCA38.
PCA38.:	PUSHJ	PP,PA21.
	JRST	PA166.


	INTER.	PCA39.
PCA39.:	PUSHJ	PP,PA73.
	JRST	PA22.


	INTER.	PCA40.
PCA40.:	PUSHJ	PP,PA34.
	JRST	PA36.
	INTER.	PCA41.
PCA41.:	PUSHJ	PP,PA34.
	PUSHJ	PP,PA22.
	JRST	PA0.


	INTER.	PCA42.
PCA42.:	PUSHJ	PP,PA2.
	JRST	PA171.

	INTER.	PCA44.
PCA44.:	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	JRST	PA21.


	INTER.	PCA45.
PCA45.:	PUSHJ	PP,PA95.
	JRST	PA21.


	INTER.	PCA46.
PCA46.:	PUSHJ	PP,PA24.
	PUSHJ	PP,PA26.
	PUSHJ	PP,DE125.
	JRST	PA0.


	INTER.	PCA47.
PCA47.:	PUSHJ	PP,PA50A.
	AOS	SU8CNT		;COUNT ONE MORE FOR FIPS FLAGGER
	JRST	PA2.
	INTER.	PCA51.
PCA51.:	PUSHJ	PP,PA173.
	JRST	PA0.

	INTER.	PCA54.
PCA54.:	PUSHJ	PP,PA22.
	JRST	PA81.


	INTER.	PCA55.
PCA55.:	PUSHJ	PP,PA175.
	JRST	PA22.


	INTER.	PCA56.
PCA56.:	PUSHJ	PP,PA22.
	PUSHJ	PP,PA820.	;PUT RESERVED WORD ON TEMTAB STACK
	JRST	PA90.

	INTER.	PCA59.
PCA59.:	PUSHJ	PP,PA132.
	JRST	PA0.

	INTER.	PCA60.
PCA60.:	PUSHJ	PP,PA37.
	SKIPN	SCPTRM##	;[1553] Scope Terminator?	
	PUSHJ	PP,PA148.
	JRST	PA0.


	INTER.	PCA61.
PCA61.:	PUSHJ	PP,PA37.
	PUSHJ	PP,PA24.
	SWON	FREGWD		;[1553] Reget the period
	JRST	PA0.

	INTER.	PCA62.
PCA62.:	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	JRST	PA160.


	INTER.	PCA63.
PCA63.:	PUSHJ	PP,PA73.
	PUSHJ	PP,PA21.
	JRST	PA22.


	INTER.	PCA64.
PCA64.:	PUSHJ	PP,PA22.
	SKPNAM

	INTER.	PCA64A
PCA64A:	PUSHJ	PP,PA21.
	JRST	PA34.

	INTER.	PCA65.
PCA65.:	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	JRST	PA34.


	INTER.	PCA66.
PCA66.:	FLAGAT	HI
	PUSHJ	PP,PA22.
	JRST	PA168.


	INTER.	PCA67.
PCA67.:	PUSHJ	PP,PA47.
	JRST	PA202.


	INTER.	PCA68.
PCA68.:	PUSHJ	PP,PA2.
	PUSHJ	PP,PA215.
	PUSHJ	PP,PA21.
	JRST	PA22.

	INTER.	PCA69.
PCA69.:	SWOFF	FGTPER!FREGWD	;
	PUSHJ	PP,PA1.		;[665] INITIALIZE
	PUSHJ	PP,PA258.	;[665] SET UP PROCEDURE DIVISION ENTRY
	JRST	PCA25.		;[665] OUTPUT THE OPERATOR

	INTER.	PCA70.
PCA70.:	PUSHJ	PP,PA151.
	PUSHJ	PP,PA153.
	PUSHJ	PP,PA2.
	PUSHJ	PP,PA224.
	JRST	PA152.

	INTER.	PCA71.
PCA71.:	PUSHJ	PP,PA2.
	JRST	PA224.

	INTER.	PCA72.
PCA72.:	HRRZI	TA,72		;EXPR OP CODE
	PUSHJ	PP,SETOP
	PUSHJ	PP,PA22.
	JRST	PA2.

	INTER.	PCA73.
PCA73.:	PUSHJ	PP,PA21.
	HRRZI	TA,73		;ENDEXP OP CODE
	PUSHJ	PP,SETOP
	JRST	PA22.

;ITEM DECLARED IN ENTRY OR PD USING CLAUSE

	INTER.	PCA74.
PCA74.:	PUSHJ	PP,PA2.
	JRST	PA264.

	INTER.	PCA75.
PCA75.:	PUSHJ	PP,PA21.	;OUTPUT OPERAND
	JRST	PA0.		;POP TO PREVIOUS NODE
; CHECK TO SEE IF RECORD IS IN A SORT FILE [257]
;	AND INSERT RECORD OPERANDS INTO GENFIL , EVEN IF ERROR

	INTERN.	PCA80.
PCA80.:	PUSHJ	PP,PCA83.	; [276] SEE IF RECORD LEVEL 
	MOVEI	DW,E.206	; [257] SET UP NOT RECORD ERROR CODE
	PUSHJ	PP,FNDFIL	; [257] GET CORR FILE FOR THIS RECORD
	  JRST	PCA80B		; [257] NOT A RECORD ERROR
	LDB	TB,FI.DSD	; [257] IS RECORD IN SORT FILE
PCA80A:	MOVEI	DW,E.488	; [257] NOT IN SORT FILE ERROR CODE
	SKIPN	TB		; [257]
	PUSHJ	PP,FATAL	; [257] GIVE ERROR
	JRST	PA21.		; [257] PUT OUT OPERANDS-EVEN IF ERROR ONES

PCA80B:	PUSHJ	PP,FATAL	; [257] GIVE ERROR 
	SETZ	TB,		; [257] WILL FORCE NOT IN SORT FILE ERROR
	JRST	PCA80A		; [257] CONTINUE

; [257] SEE IF FILE IS SORT FILE
	INTER.	PCA81.
PCA81.:	PUSHJ	PP,PCA5.	; [257] SET UP ARG1 AND OPERAND
	HRRZ	TA,W1		; [257] GET FILTAB LINK
	PUSHJ	PP,LNKSET	; [257]
	LDB	TB,FI.DSD	; [257] IS IT A SORT FILE
	JUMPN	TB,CPOPJ	; [257] YES OKAY
	EWARNJ	E.44		; [257] NO ILLEGAL

	INTER. PCA82.
PCA82.:	SETZM	CLEVEL		; [313] CLEAR THE PAREN
	SETZM	ELEVEL		; [313] COUNTS- BECAUSE WE LOSE COUNT
	JRST	DE111.		; [313] GIVE ERROR MESSAGE AND RETURN

; CHECK THAT DATA NAME IS RECORD ( 01 OR 77 LEVEL).
	INTER. PCA83.
PCA83.:	HRRZ	TA,ARG1		; [276] GET DATAB REL LOCACTION
	JUMPE	TA,PCA83A	;[461] IF ARG IS ZERO TROUBLE
	PUSHJ	PP,LNKSET	; [276] GET REAL ADDRESS
	MOVE	TC,ARG1+1	; [276] GET LINE AND CHAR POSITION
	LDB	LN,[POINT 13,TC,28]	; [276] EXTRACT OUT LINE
	LDB	CP,[POINT 7,TC,35]	; [276] EXTRACT OUT CHAR POS.
	LDB	TB,DA.LVL	; [276] GET LEVEL OF DATA ITEM
	CAIE	TB,1		; [276] RECORD NAME IF 01
	CAIN	TB,^D77		; [276] 0R 77 LEVEL
	POPJ	PP,		; [276] OK
	MOVEI	DW,E.159	; [276] NOT AT RECORD LEVEL
	JRST	FATAL		; [276] FLAG ERROR AND RETURN

PCA83A:	MOVEI	TA,<CD.DAT>B20+1	;[461] USE DUMMY DATA ITEM
	MOVEM	TA,ARG1		;[461] SO PHASE E DOESN'T CRASH
	JRST	FATAL		;[461] AND GET OUT

	INTER.	PCA84.;		; [362]
PCA84.:	SOS	SPFLVL		;[532] [511] COUNT DOWN ONE MORE ADDED BY
	SOSGE	SPFLVL		; [362] COUNT DOWN "IF" LEVEL IN
				; [362]"SEARCH" STATEMENTS
	SETZM	SPFLVL		; [362] ZERO MINIMUM
	EWARNJ	E.390		; [362] "WHEN" EXPECTED ERROR MSG

	INTER.	PCA88.
PCA88.:	SKIPN	RMFLG		;IF REF. MOD.
	JRST	PCA88A		;
	DMOVE	TB,RMOPND##	; NEED TO RESTORE ORIGINAL OPERAND
	DMOVEM	TB,ARG1		; 
PCA88A:	PUSHJ	PP,FNDFIL	; [455] GET FILE FOR THIS RECORD
	  JRST	[SETZ	TB,		; [455] FORCE NOT IN SORT FILE ERROR
		JRST	PCA88B]		; [455] CONTINUE
	MOVE	TC,ARG1+1	; [455] GET LINE AND CHAR POSITION
	LDB	LN,[POINT 13,TC,28]	; [455] EXTRACT LINE
	LDB	CP,[POINT 7,TC,35]	; [455] EXTRACT CHAR POS
	LDB	TB,FI.DSD	; [455] IS RECORD IN SORT FILE
PCA88B:	MOVEI	DW,E.488	; [455] NOT IN SORT FILE ERROR CODE
	SKIPN	TB		; [455]
	PUSHJ	PP,FATAL	; [455] GIVE ERROR
	SKIPE	RMFLG		;IF REF. MOD., OPERAND IS ALREADY OUT,
	SETZM	ARG1		; BUT PERFROM ANYWAY FOR OTHER CLEANUP
	PUSHJ	PP,PA21.	; [455] PUT OUT OPERANDS
	JRST	PA160.		; [455] CONTINUE
SUBTTL	ANS-74 PROCEDURE DIVISION ACTIONS

;ACCEPT XXX FROM DAY, DATE, TIME, DAY-OF-WEEK.

	INTER.	PCA90X
PCA90X:	FLAGAT	8
	SKPNAM

	INTER.	PCA90.
PCA90.:	PUSHJ	PP,PA2.
	HRRZ	TB,ARG1		;R. H. OF GETSRC W1
	MOVE	TA,ARG1+1	;GETSRC W2
	MOVE	TE,TA		;W2
	MOVE	TD,ARG1		;W1
	TLZ	TA,777774	;LN, CP
	SETZM	NSBSC1
	TLO	TA,400000!GNLIT!GNFIGC	;SET OPERAND AND FIGURATIVE CONSTANT BITS
	HLRZ	TC,TD
	ANDI	TC,777		;YES--GET VALUE
	SETZ	TE,
	CAIN	TC,DATE..
	HRLZI	TE,GNTODY!GNDATE
	CAIN	TC,DAY..
	HRLZI	TE,GNTODY!GNDAY
	CAIN	TC,TIME..
	HRLZI	TE,GNTODY!GNTIME
	CAIN	TC,DOW.
	HRLZI	TE,GNTODY!GNDOW
	IOR	TA,TE		;SET APPROPRIATE BITS
	SETZM	ARG1
	SETZM	ARG1+1
	JRST	PUTGEN		;OUTPUT ARG1

;COMPUTE SERIES

	INTER.	PCA93.
PCA93.:	PUSHJ	PP,PA191.	;COMPUTE OP-CODE
	JRST	PA2.		;DATAN.

;DIVIDE INTO SERIES

	INTER.	PCA95.
PCA95.:	PUSHJ	PP,PA22.	;DUMP DIV OPERATOR
	SKPNAM

	INTER.	PCA96.
PCA96.:	PUSHJ	PP,PA21.	; AND LAST OPERAND
	jrst	pa2.
;SAVE DATA ITEM IN CASE TYPE 3 INSPECT

	INTER.	PCA91.
PCA91.:	PUSHJ	PP,PA2.
	DMOVEM	W1,SVINSP##
	POPJ	PP,

;RESTORE DATA ITEM AND OP-CODE FOR INSPECT

	INTER.	PCA92.
PCA92.:	PUSHJ	PP,PA22.	;OUTPUT LAST OPERATOR
	MOVE	TA,SVINSO##	;EITHER "TALLYING" OR "REPLACING" ARG
	PJRST	SETOP		; SETUP FRESH OPERATOR

	INTER.	PCA92T
PCA92T:	PUSHJ	PP,PA22.	;OUTPUT PREVIOUS "TALLYING" OPERAND
	MOVE	TA,SVINSO	; GET "TALLYING" AGAIN
	PUSHJ	PP,SETOP	;SETUP FRESH OPERATOR
	JRST	PA2.		;READ DATAN

	INTER.	PCA92L
PCA92L:	PUSHJ	PP,PCA92.
	JRST	PA64.		;LEADING

	INTER.	PCA92F
PCA92F:	PUSHJ	PP,PCA92.
	JRST	PA67.		;FIRST

	INTER.	PCA92C
PCA92C:	PUSHJ	PP,PCA92.
	JRST	PA65.		;CHARACTER

	INTER.	PCA92Y
PCA92Y:	FLAGAT	8
	SKPNAM

	INTER.	PCA92R
PCA92R:	PUSHJ	PP,PCA92.
	JRST	PCA5.		;READ DATAN

	INTER.	PCA92S
PCA92S:	PUSHJ	PP,PCA92.
	JRST	PA2.		;READ DATAN

	INTER.	PCA92E
PCA92E:	SETO	TA,
	DPB	TA,OP.EIN##	;"LAST ARGUMENT" FOR INSPECT
	JRST	PCA6.

	INTER.	PCA94.
PCA94.:	SKIPE	TA,RMFLG##	;RM - may be set in PA205 or here
	TRZE	TA,200000	;RM - have we seen a COLON already?
	JRST	PCA94A		;RM - no
	MOVEM	TA,RMFLG	;RM - 	
	EWARNW	E.845		;RM - found two colons
	PUSHJ	PP,PA132.	;RM - put out OPENDX (073)
	HRRZI	TA,OPREFM	;RM - 
	PUSHJ	PP,SETOP	;RM - 
	JRST	PA22.		;RM - 

PCA94A:	SKIPN	RMFLG		;RM - don't want to overwrite flag settings
	SETO	TA,		;turn on flag
	MOVEM	TA,RMFLG	;RM
	DMOVE	TB,ARG1		;save current operand 
	DMOVEM	TB,RMOPND	; in case needed for later syntax error
	DMOVE	TC,OPRTR	;save current verb's op code
;[1562] If oprtr is zero, the operator and its operands have already been
;[1562] written to genfil; have now scanned another operand without 
;[1562] a new operator => have found an expression continued by an 'AND'
;[1562] or an 'OR'. A prior routine will have put the current op code in
;[1562] implop.

;[1635]  If we have 	IF  FOO(1:2) EQUALS BAR(1:2)
;[1635]			AND FOO(3:4) EQUALS BAR(3:4)
;[1635]  then we come here four times for each of the RM. The first time
;[1635]  OPRTR will be non-zero but the other three times it will be zero.
;[1635]  We want to put out a '072' for the first RM after a IF, AND or OR.
;[1635]  If we had an AND or OR then OPRTR+1, and therefore, TB was set to
;[1635]  OPIF.

	SKIPN	TC		;[1562] If no current verb
	MOVE	TC,IMPLOP	;[1635] get it from implop
	DMOVEM	TC,RMOPR	;
	CAIE	TB,OPIF		;[1561]	Is this an 'IF' clause
	JRST	PA21.		;[1561] No, go put out data field
	PUSHJ	PP,PA111.	; Then put '072' in genfil first
	MOVE	TA,ELEVEL	;[1561] Elevel has open paren count
	MOVEM	TA,RMOPPAR##	;[1561] Save until ref. modifiers are processed
	JRST	PA21.		;put out data field

	INTER.	PCA97.
PCA97.:	SWON	FREGWD		;[1553] Clean up for END-EVALUATE
	PUSHJ	PP,PA847.	;[1553] Wrap-up actions
	JRST	PA0.		;[1553] Pop a node

	INTER.	PCA98.
PCA98.:	PUSHJ	PP,PA800.	;[1564] BUILD OP CODE FOR SET CONDITION-NAME
	JRST	PA22.		;[1564] PUT IT IN GENFIL
SUBTTL	ERRORS USED BY PD SYNTAX SCAN

	INTER.	DE111.
DE111.:	TLNE	W1,GWLIT!GWFIGC	;LITERAL OR FIG. CONST?
	EWARNJ	E.101		;? IDENTIFIER EXPECTED
	TLNN	W1,GWRESV	;SKIP IF RESERVED WORD
	EWARNJ	E.104		;NO, SAY "?NOT DEFINED"
	SKPNAM			;ELSE "CAN NOT BE A DATA-NAME"

	INTER.	DE103.
DE103.:	HRRZI	DW,E.103	;DIAGNOSTIC 103
	LDB	TA,[POINT 9,W1,17]
	TLNE	W1,GWRESV
	CAIE	TA,FILLE.
	JRST	WARNW##
	EWARNJ	E.289

	INTER.	DE125.
DE125.:	DMOVE	LN,BLNKLN	;GET LN & CP
	HRRZI	DW,E.125	;DIAGNOSTIC 125
	JRST	WARN		;WARNING ONLY

IFE ONESEG,<	END	COBOLD>
IFN ONESEG,<	END	>