Google
 

Trailing-Edge - PDP-10 Archives - BB-H580C-SB_1981 - cobold.mac
There are 14 other files named cobold.mac in the archive. Click here to see a list.
; UPD ID= 3570 on 6/9/81 at 11:31 AM by NIXON                           
TITLE	COBOLD	FOR COBOL V12B	
SUBTTL	PROCEDURE DIV. SYNTAX SCAN	W.NEELY/CAM/SEB



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


	SEARCH	P

	%%P==:%%P
	TOPS20==:TOPS20
	IFN TOPS20,< SEARCH MONSYM>
	IFE TOPS20,< SEARCH UUOSYM>
	ISAM==:ISAM
	RPW==:RPW
	DBMS6==:DBMS6
	DBMS4==:DBMS4
	DBMS==:DBMS
	DEBUG==:DEBUG
	MCS==:MCS
	TCS==:TCS

TWOSEG
SALL
RELOC	400000

;EDITS
;NAME	DATE		COMMENTS

;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
;[222] /ACK	FIX NULL TABLE LINK PROBLEM FOR CORRESPONDING OPTION
;		  AND FOR PERFORM VARYING'S.
;214	CHANGE FATAL TO WARNING IF MORE THAN 6 CHARS IN SUBPROGRAM NAME
; EDIT 172 	FIXES 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	OPCBPH
	EXTERN	FI.ACC, FI.RTC, FI.SKY,FI.ERR,FI.NXT
	EXTERN	FILLOC,FILNXT,CURFIL,LNKSET
	EXTERN	DA.USG,DA.INS,DA.LOC,DA.RES
	EXTERN	KILL
IFN ANS74,<
	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
IFN RPW,<
	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
IFN ANS74,<
	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,
	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,5+SBSCR3##
	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	TBLOCK
	MOVE	TA,[XWD TBLOCK,TBLOCK+1]
	BLT	TA,TBLOCK+24
	SETZM	VARBLK##
	MOVE	TA,[XWD VARBLK,VARBLK+1]
	BLT	TA,VARBLK+^D134		;[222] WAS ^D80.
	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

IFN ANS74,<
	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

;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.S		;YES
	PUSHJ	PP,BLDNAM##	;NO--PUT IT IN
	HLRS	TA
	DPB	TA,[POINT	15,W2,15]
PA2.S:	TLZ	W1,004000	;'ROUNDED' BIT
IFN BIS,<
	DMOVEM	W1,ARG1##	;SAVE ITEM
>
IFE BIS,<
	MOVEM	W1,ARG1##	;SAVE ITEM
	MOVEM	W2,ARG1+1
>
	POPJ	PP,

PA2.L:	HLRZ	TB,W1
	ANDI	TB,177		;NO. OF CHARACTERS
	JUMPN	TB,PA2.L1	;NULL LITERAL?
	EWARNW	E.183		;YES
	MOVE	TA,[BYTE (7)7,7,7,7]
	MOVEM	TA,LITVAL##	;CREATE A DUMMY
	HRRZI	TB,4
PA2.L1:	MOVE	TC,[POINT 7,LITVAL]
	MOVEM	TC,TBLOCK+1	;STORE POINTER TO LITERAL
	MOVEM	TB,TBLOCK##
	HRRZI	TB,5(TB)
	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
	MOVE	TB,TBLOCK+1	;'GET' POINTER
	MOVE	TC,[POINT 7,0(TA),6]	;'PUT' POINTER
	HRRZ	TD,TBLOCK	;COUNTER
	DPB	TD,TC
PA2.Q:	SOJL	TD,PA2.S
	ILDB	TE,TB		;GET CHARACTER
	IDPB	TE,TC		;SAVE
	JRST	PA2.Q

IFN ANS74,<
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
IFN ANS74,<
	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
	CAIN	TB,(TC)		;SAME NAME AS THIS PARAGRAPH.
	EWARNJ	E.7		;IT HAS--ERROR.
	JRST	PA4.A		;LOOK FOR MORE

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,
;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
	HLRZ	TB,W1
	ANDI	TB,177
	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,66		;USE OP CODE (NEVER OUTPUT)
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.USE##
IFN RPW,<
	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
IFN ANS68,<
	INTER.	PA12.
PA12.:	SETO	TA,
	DPB	TA,OP.BEG##	;SET 'BEGINNING' BIT IN OPERATOR
	POPJ	PP,

	INTER.	PA13.
PA13.:	SETO	TA,
	DPB	TA,OP.END##	;SET 'ENDING' FLAG IN OPERATOR
	POPJ	PP,
>

	INTER.	PA14.
PA14.:	FLAGAT	NS
	SETO	TA,		;SET ERROR-PROCEDURE-ON-OPEN BIT
	DPB	TA,OP.OPN##
IFN ANS68,<
	DPB	TA,OP.UNT##	;SET OTHER BITS SO WE CAN TELL
	DPB	TA,OP.FIL##	; LATER ON THAT THIS IS REALLY "OPEN"
>
	POPJ	PP,

IFN ANS68,<
	INTER.	PA15.
PA15.:	SETO	TA,
	DPB	TA,OP.FIL##	;SET 'FILE' FLAG IN OPERATOR
	POPJ	PP,

	INTER.	PA16.
PA16.:	SETO	TA,
	DPB	TA,OP.UNT##	;SET 'REEL' ('UNIT') FLAG IN OPERATOR
	POPJ	PP,

	INTER.	PA17.
PA17.:	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.
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
	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
IFN ANS74,<
	JRST	PUTGEN		;OUTPUT ARG1
>
IFN ANS68,<
	CAIN	TC,TALLY	; [333] TALLY
	SKIPN	TBLOCK+7	; [333] TALLY- IS IT A SUBSCRIPT?
	JRST	PUTGEN		; [333] NO PUT LITERAL IN GENFIL
	MOVE	TD,TBLOCK+6	; [333] GET INDEX TO SUBSCRIPT TABLE
	ASH	TD,2		; [333] 4 WORDS EACH
	SKIPN	SBSCR1+2(TD)	; [333] DOES TALLY HAVE AN ADDITIVE?
	JRST	PUTGEN		; [333] NO PUT INTO GENFIL
	MOVEI	TC,1		; [333] ASSUME +
	SKIPGE	SBSCR1(TD)	; [333] UNLESS IT WAS -
	MOVEI	TC,2		; [333]
	DPB	TC,[POINT 2,TB,11]	; [333] STORE ADDITIVE OPERATOR
	JRST	PUTGEN		; [333] NO PUT TALLY OPERAND INTO GENFIL
>
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)
IFN ANS68,<
	CAIN	TC,TALLY
	HRLZI	TE,GNTALY	;TALLY
>
	CAIN	TC,TODAY
	HRLZI	TE,GNTODY	;TODAY
	IOR	TA,TE		;SET APPROPRIATE BITS
	JRST	PA21.B
PA21.C:	TLNE	TD,004000	;ROUNDED?
	TLO	TB,200000	;YES
	TLNN	TE,400000	;FLOTAB ENTRY?
	JRST	PA21.D		;NO
	SETZM	NSBSC1
	TLO	TB,100000	;YES--SET BIT IN OPERAND WORD
	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
	CAIN	TC,CD.DAT	;DATAB?
	JRST	.+3
	SETZM	NSBSC1
	JRST	PUTFT		;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
	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]
	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
	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
	SWON	UNCONT;
	JRST	PA22.C

IFN FT68274,<
	INTER.	PA22.X
PA22.X:	MOVE	TA,CURFIL
	LDB	TB,FI.ACC
	JUMPN	TB,PA22.	;ONLY WANT SEQ FILES
	LDB	TB,FI.ERM##	;GET RECORDING MODE
	CAIE	TB,%RM.7B	;ONLY WANT ASCII
	CAIN	TB,%RM.SA	;OR STANDARD-ASCII
	TRNA
	JRST	PA22.
	MOVEI	TB,[ASCIZ / BEFORE ADVANCING 1 LINE /]
	PUSHJ	PP,CVTICW##
	JRST	PA22.
>
	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.:	SWON	FREGWD;
	CAIN	TYPE,ELSE.	;[1005] ENCOUNTERED 'ELSE'?
	SETZM	SWHEN##		;[1005] YES, TERM. SEARCH WHEN, IF ACTIVE
	POPJ	PP,

	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,


;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.
	PJRST		PA111.		;GO PUT OUT INITIAL GENFIL CODE
					; FOR "EXPR" OPERATOR.


IFN ANS68,<
;PREVENT ERROR MESSAGE "PERIOD ASSUMED" WHEN "NOTE MUMBLE." IS THE
; LAST THING IN THE PROGRAM.

	INTER.	PA29.
PA29.:	TSWT	FEOF;			;WAS THAT THE END?
	SWONS	FREGWD;			;NO, REGET THE TOKEN.
	PUSHJ	PP,	PA0.		;IF IT WAS THE END, POP UP TWO
	JRST		PA0.		; LEVELS IN THE TREE OTHERWISE
					; ONLY POP UP ONE LEVEL.
>
	INTER.	PA30.
PA30.:	HRRZI	TA,3		;'ADD TO' OP CODE
	JRST	SETOP


	INTER.	PA33.
PA33.:	HRRZI	TA,2		;'ADD' OP CODE
	JRST	SETOP3


	INTER.	PA34.
PA34.:	HRRZI	TA,11		;'RESULT' OP CODE
	JRST	SETOP1


	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.:
IFN ANS68,<IFN MCS!TCS,<
	SKIPN	IFMSGF##	;ARE WE IN AN "IF MSG"
	JRST	.+4
	PUSHJ	PP,PA140.	;GENERATE TAGNAM AND END-SPIF
	SOS	IFMSGF##	;DECREMENT IF-MSG LEVEL
	JRST	.+5		;JUMP OVER GARBAGE
>>
	HRLZI	TA,026000	;ENDIF
	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+^D12		;[222] WAS ^D6.
	MOVE	TA,[XWD NSBSC2,NSBSC1]
	BLT	TA,SBSCR1+^D11		;[222] WAS ^D5.
	MOVE	TA,[XWD TBLOCK,NSBSC2##]
	BLT	TA,SBSCR2##+^D11	;[222] WAS ^D5.
	POPJ	PP,
	INTER.	PA49.
PA49.:	HRRZI	TA,62		;'OPEN' OP CODE
	JRST	SETOP1


	INTER.	PA50.
PA50.:
IFN ANS74,<
	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
	POPJ	PP,


	INTER.	PA52.
PA52.:	SETO	TA,
	DPB	TA,OP.LCK##	;SET 'LOCK' BIT
IFN ANS68,<
	POPJ	PP,
>
IFN ANS74,<
	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
>

IFN ANS74,<
	INTER.	PA52A.
PA52A.:	FLAGAT	HI
	SETO	TA,
	DPB	TA,OP.REM##	;SET 'FOR REMOVAL' BIT
	POPJ	PP,
>

	INTER.	PA53.
PA53.:	FLAGAT	HI
	SETO	TA,
	DPB	TA,OP.NRW##	;SET 'NO REWIND' BIT
	POPJ	PP,


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


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

IFN ANS74,<
	INTER.	PA59.
PA59.:	HRRZI	TA,106		;NO-OP OP CODE
	JRST	SETOP
>

	INTER.	PA61.
PA61.:
IFN FT68274,<
	MOVEI	TA,[ASCIZ /EXAMINE/]
	MOVEI	TB,[ASCIZ /INSPECT/]
	PUSHJ	PP,CVTRCW	;CONVERT EXAMINE TO INSPECT
>
	HRRZI	TA,42		;'INSPECT' OP CODE
	JRST	SETOP

	INTER.	PA62.
PA62.:
IFN FT68274,<
	MOVEI	TB,[ASCIZ /TALLY FOR /]
	PUSHJ	PP,CVTACW##	;INSERT AFTER TALLYING
	SETZM	CVTTLY##	;SIGNAL REALLY REQUIRED
>
	SETO	TA,
	DPB	TA,OP.TAL##	;SET 'TALLYING' FLAG
IFN ANS74,<
	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.:
IFN FT68274,<
	LDB	TA,OP.TAL	;DO WE HAVE THE TALLYING OPTION ALSO?
	JUMPE	TA,[PUSHJ PP,CV3.	;NO, JUST DELETE FIRST
		JRST	PA65X.]
	MOVEI	TA,[ASCIZ /FIRST/]
	MOVEI	TB,[ASCIZ /BEFORE INITIAL/]
	PUSHJ	PP,CVTRCW
PA65X.:>
	SETO	TA,
IFN ANS68,<
	DPB	TA,OP.UFR##
>
IFN ANS74,<
	DPB	TA,OP.CHR##
>
	POPJ	PP,

IFN ANS74,<
	INTER.	PA65A.
PA65A.:	JSP	TB,PREBA	;ONLY 1 BEFORE/AFTER CLAUSE ALLOWED
	SETO	TA,
	DPB	TA,OP.IAF##
	POPJ	PP,

	INTER.	PA65B.
PA65B.:	JSP	TB,PREBA	;ONLY 1 BEFORE/AFTER CLAUSE ALLOWED
	SETO	TA,
	DPB	TA,OP.IBF##
	POPJ	PP,

PREBA:	LDB	TA,OP.IBF##	;ANY PREVIOUS "BEFORE" CLAUSE
	JUMPN	TA,PREBAE	; FOR THIS ARGUMENT?
	LDB	TA,OP.IAF##	;OR "AFTER" CLAUSE?
	JUMPE	TA,(TB)		;NO, OK
PREBAE:	EWARNJ	E.724		;"Only one 'BEFORE' or 'AFTER' clause allowed"
>

IFN FT68274,<
	INTER.	PA65C.
PA65C.:	MOVEI	TA,[ASCIZ /UNTIL/]
	MOVEI	TB,[ASCIZ /CHARACTERS/]
	JRST	CVTRCW
>

	INTER.	PA66.
PA66.:
IFN FT68274,<
	LDB	TA,OP.TAL	;IS IT TALLYING AND REPLACING?
	JUMPE	TA,PA66NT	;NO
	LDB	TA,OP.UFR	;IS IT UNTIL FIRST 
	JUMPN	TA,[MOVEI TB,[ASCIZ /CHARACTERS /]
		PUSHJ	PP,CVTACW
		JRST	PA66NT]
	LDB	TA,OP.LEA	;LEADING?
	MOVE	TB,[EXP [ASCIZ /ALL /]
		EXP [ASCIZ /LEADING /]](TA)
	PUSHJ	PP,PCA5L.	;INSERT WORD AND LITERAL
PA66NT:>
	SETO	TA,
	DPB	TA,OP.RPL##
IFN ANS68,<
	POPJ	PP,
>
IFN ANS74,<
	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

;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.	PA70.
PA70.:	HRRZI	TA,1		;'MOVE' OP CODE
	JRST	SETOP


	INTER.	PA72.
PA72.:	HRRZI	TA,7		;'MULTIPLY BY' OP CODE
	JRST	SETOP

	INTER.	PA73.
PA73.:	HRRZI	TA,6		;'MULTIPLY GIVING' OP CODE
	JRST	SETOP3


	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,

IFN ANS74,<
	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
	JRST	SETOP1


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

IFN ANS74,<
	INTER.	PA81P.
PA81P.:	FLAGAT	HI
	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
	JRST	SETOP1

;SET UP DELETE OP-CODE

	INTER.	PA85D.
PA85D.:
IFN ISAM,<
	HRRZI	TA,122		;DELETE OP-CODE
	JRST	SETOP1
	>
IFE ISAM,<EWARNJ DE91.>		;?NOT IMPLEMENTED

;SET UP REWRITE OP-CODE

	INTER.	PA85R.
PA85R.:
IFN ISAM,<
	HRRZI	TA,66		;REWRITE OP-CODE
	JRST	SETOP1
	>
IFE ISAM,<EWARNJ DE91.>		;?NOT IMPLEMENTED


	INTER.	PA86.
PA86.:	SETO	TA,
	DPB	TA,OP.BAD##	;'BEFORE ADVANCING'
	POPJ	PP,


	INTER.	PA87.
PA87.:	SETO	TA,
	DPB	TA,OP.AAD##	;'AFTER ADVANCING'
	POPJ	PP,


	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)
	JRST	PA22.

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


	INTER.	PA91.
PA91.:	HRRZI	TA,5		;'SUBTRACT FROM' OP CODE
	JRST	SETOP


	INTER.	PA94.
PA94.:	HRRZI	TA,32		;'PERFORM' OP CODE
	JRST	SETOP1


	INTER.	PA95.
PA95.:	HRRZI	TA,33		;'PERFORM TIMES' OP CODE
	JRST	SETOP3
	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,VARBLK+^D134		;[222] WAS ^D80.
	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
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN##
	MOVE	TA,[XWD OPRTR,SAVPRF##]
	BLT	TA,SAVPRF+5
	POPJ	PP,
	INTER.	PA97.
PA97.:	AOS	TA,NVARY
	CAIG	TA,3
	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,3
	POPJ	PP,		;IGNORE FURTHER VARYINGS
	HRRZI	TA,-1(TA)
	IMULI	TA,^D45		;[222] WAS ^D27.
	MOVE	TB,ARG1		;INDEX
	MOVEM	TB,VARBLK(TA)
	MOVE	TB,ARG1+1
	MOVEM	TB,VARBLK+1(TA)
	HRRZI	TB,VARBLK+2(TA)
	HRLI	TB,NSBSC1
	BLT	TB,VARBLK+^D14(TA)	;[222] WAS ^D8.
PA98.X:	SETZM	NSBSC1		;CLR SUBSCRIPT STORE
	MOVE	TB,[XWD NSBSC1,NSBSC1+1]
	BLT	TB,NSBSC1+^D12	;[222] WAS ^D6.
	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,3
	POPJ	PP,		;IGNORE FURTHER VARYINGS
	HRRZI	TA,-1(TA)
	IMULI	TA,^D45		;[222] WAS ^D27.
	MOVE	TB,ARG1		;ORIGINAL VALUE OF INDEX
	MOVEM	TB,VARBLK+^D15(TA)	;[222] WAS ^D9.
	MOVE	TB,ARG1+1
	MOVEM	TB,VARBLK+^D16(TA)	;[222] WAS ^D10.
	HRRZI	TB,VARBLK+^D17(TA)	;[222] WAS ^D11.
	HRLI	TB,NSBSC1
	BLT	TB,VARBLK+^D29(TA)	;[222] WAS ^D17.
	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,3
	POPJ	PP,
IFN ANS74,<
	SETOM	IFPERF##	;SIGNAL ITS PERFORM LOOP CONTROL
>
	HRRZI	TA,-1(TA)
	IMULI	TA,^D45		;[222] WAS ^D27.
	MOVE	TB,ARG1
	MOVEM	TB,VARBLK+^D30(TA)	;INCREMENT ;[222] WAS ^D18.
	MOVE	TB,ARG1+1
	MOVEM	TB,VARBLK+^D31(TA)	;[222] WAS ^D19.
	HRRZI	TB,VARBLK+^D32(TA)	;[222] WAS ^D20.
	HRLI	TB,NSBSC1
	BLT	TB,VARBLK+^D44(TA)	;[222] WAS ^D26.
	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	HRLZI	TB,(CH)
	HRRI	TB,102		;'TAGNAM' OP CODE
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	HRRZ	TC,NVARY
	LSH	TC,1
	HRRZM	CH,VARTAG(TC)
	JRST	PUTGEN

	INTER.	PA101.
PA101.:	HRRZ	TA,NVARY
	CAILE	TA,3
	JRST	PA37.
	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.	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
IFN ANS74,<
	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;
	SKIPN	CH,NXTSNT
	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	JUMPE	CH,.-2
	HRRZM	CH,NXTSNT
PA103A:	HRLZI	TB,(CH)
	HRRI	TB,74		;JUMPTO OP CODE
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	JRST	PUTGEN

	INTER.	PA104.
PA104.:	SWOFF	FNOTF;
	SETZM	ARGLST##
	MOVE	TA,[XWD	ARGLST,ARGLST+1]
	BLT	TA,ARGLST+IF.DEP-1
	SETZM	TOPLVL
	SETZM	TRMLVL##
IFN ANS74,<
	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

IFN ANS74,<
	INTER.	PA106.
PA106.:	FLAGAT	HI
	SKPNAM
>

	INTER.	PA107.
PA107.:	TSWC	FNOTF;
	SETZM	TOPLVL
IFN ANS74,<
	MOVEM	LN,NOTLN##	;SAVE LOCATION OF "NOT"
	MOVEM	CP,NOTCP##
>
	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:	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	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
	HRLZI	TA,076000	;END-CONDITION OP CODE
	HRRZI	TB,76
	DPB	LN,[POINT	13,TA,28]
	DPB	CP,[POINT	7,TA,35]
	PUSHJ	PP,PUTGEN
	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
	HRLZ	TB,TC
	HRRI	TB,102		;TAGNAM OP CODE
	HRLZI	TA,102000
	DPB	LN,[POINT	13,TA,28]
	DPB	CP,[POINT	7,TA,35]
	JRST	PUTGEN


	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,
	DPB	TA,OP.FLS##	;'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,
	DPB	TA,OP.FLS	;'GO TO IF TRUE' FLAG
P130.B:	DPB	TC,OP.TRG	;TARGET TAG
IFN ANS68,<
	JRST	PA22.
>
IFN ANS74,<
	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.

IFN ANS68,<
;SKIP TO END OF NOTE IN MIDST OF PARAGRAPH

	INTER.	PA133N
PA133N:	PUSHJ	PP,PA133S
	JRST	P133EX
>

;[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
	CLOSE	GEN,2		;CLOSE OUTPUT SIDE
	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.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,<
	EXTERN	FATAL
	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
	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
IFN FT68274,<
	PUSHJ	PP,CVTDPL##	;DUMP THE PREVIOUS LINE BUFFER
	PUSHJ	PP,CVTCCL##	;COPY CURRENT TO PREVIOUS
	PUSHJ	PP,CVTDPL	;AND DUMP IT ALSO
	MOVEI	DW,E.773	;TALLY MAY NOT BE NEEDED
	MOVEI	CP,8		;IF WE NEED MESSAGE IT STARTS IN AREA "A"
	SKIPE	LN,CVTTLY	;IF ZERO THEN WE ACTUALLY NEED TALLY
	PUSHJ	PP,WARN##	;WE DON'T NEED IT
>
	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.	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:
IFN ANS68,<IFN MCS!TCS,<
	SKIPE	IFMSGF##	;ARE WE IN "IF MESSAGE"
	JRST	P139.X		;YES, EVERYTHING IS OK
>>
	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.	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
	JRST	PA139.		;CONTINUE AT PA139.

	INTER.	PA141.
PA141.:	SETO	TA,
	DPB	TA,OP.MAC##	;SET 'MACRO' BIT
	POPJ	PP,

IFN ANS68,<
	INTER.	PA142.
PA142.:	SETO	TA,
	DPB	TA,OP.FOR##	;SET 'FORTRAN-IV' 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
IFN RPW,<			;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.	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.

IFN ANS74,<
	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.	PA163F
PA163F:	FLAGAT	HI
	SKPNAM

	INTER.	PA163.
PA163.:	TLNE	W1,40000	;SIGNED?
	EWARNW	E.25		;[467] YES
	HLRZ	TE,W1
	ANDI	TE,777		;SIZE
	MOVE	TA,[XWD NAMWRD,NAMWRD+1]
	SETZM	NAMWRD
	BLT	TA,NAMWRD+4
	MOVE	TA,[POINT	7,LITVAL]
	MOVE	TB,[POINT	6,NAMWRD]
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]
	MOVEM	W1,ARG1
	MOVEM	W2,ARG1+1
	POPJ	PP,


	INTER.	PA164.
PA164.:	MOVE	TA,ARG1
	TLO	TA,GWALL	;SET 'ALL' BIT IN ARG1
	MOVEM	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
	JRST	SETOP1



	INTER.	PA170.
PA170.:	SETZM	GOTQUA##
	SKIPN	TA,NQUAL
	JRST	P170.1
	CAIE	TA,1
	JRST	P170.5
	MOVE	TA,QUALT##
	TLNN	TA,GWFIGC
	JRST	P170.5
	LDB	TB,[POINT 9,TA,17]
IFN ANS68,<
	CAIN	TB,TALLY
	JRST	PA170O
>
P170.5:	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
	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	PA170E

P170.2:	HRRZI	DW,E.60
PA170E:	LDB	LN,[POINT	13,QUALT+1,28]
	LDB	CP,[POINT	7,QUALT+1,35]
	IFN	DEBUG,<
	PUSHJ	PP,WARN
>
	IFE	DEBUG,<
	PUSHJ	PP,FATAL
>
	MOVEI	TA,<CD.DAT>B20+1	;ASSUME DUMMY DATAB ENTRY
	MOVEM	TA,QUALT
	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:	MOVE	TA,QUALT
	POP	PP,TE
	JRST	1(TE)

NOPOP:	MOVE	TA,QUALT
	POPJ	PP,		;FAILURE EXIT
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
	MOVE	TA,ARG1
	MOVEM	TA,QUALT(TC)
	MOVE	TA,ARG1+1
	MOVEM	TA,QUALT+1(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
IFN ANS74,<
	CAIN	TB,66		;USE FOR DEBUGGING?
	JRST	P173.X		;YES
>
IFN ANS68,<
	CAIN	TB,66		;USE
	JRST	P173.0		;NOT ERROR USE
>
	CAIN	TB,75
	JRST	P173.B		;ERROR USE
	JRST	P173.X

IFN ANS68,<
;NOT ERROR USE - FIX OFFSET AND DECIDE WHICH HALFWORD TO USE
P173.0:	CAIN	TA,3		;FILE-SPECIFIC OR EXTEND?
	TLNE	TE,10		;SKIP IF SPECIFIC FILE
	 SKIPA			;NO - GENERAL USE PROCEDURE
	  JRST	P173.C		;GO DO SPECIFIC FILE
	ADDI	TC,1
	TLNN	TE,40		;BEGINNING?
	ADDI	TC,2		;NO, FIX OFFSET
	TLNE	TE,100		;BEFORE?
	ADDI	TC,1		;AFTER, FIX OFFSET
	TLNE	TE,4		;FILE?
	 JRST	P1730F		;YES
	HLRZ	TD,USES(TC)	; REEL
	JUMPN	TD,P173.E	; ALREADY AN ENTRY - CONFLICTS WITH PREVIOUS USE
	HLRZ	TD,CURSEC	;GET SECTION TO STORE
	HRLM	TD,USES(TC)	;STORE IT
	JRST	P173.X		;DONE
P1730F:	HRRZ	TD,USES(TC)	;SEE IF CONFLICT
	JUMPN	TD,P173.E	;YES, COMPLAIN
	HLRZ	TD,CURSEC	;GET SECTION TO STORE
	HRRM	TD,USES(TC)	;STORE IT
	JRST	P173.X		;DONE
>

;ERROR USE (OR FILE-SPECIFIC)
P173.B:	CAIN	TA,3		;EXTEND OR FILE-SPECIFIC
IFN ANS74,<
;FILEN OPEN:	TE/ 4
;FILEN:		TE/ 0
;EXTEND:	TE/ 10

	TLNE	TE,10		; IF BIT ON ALSO, IT IS EXTEND
	 SKIPA			;AN ERROR USE, TC HAS OFFSET
	JRST	P173.C		;SPECIFIC FILE
>;END IFN ANS74
IFN ANS68,<
;FILEN OPEN:	TE/ 14
;FILEN:		TE/  0
;EXTEND:	TE/ 10

	JRST	[TLNN TE,14	;IF NEITHER BIT IS ON,
		 JRST P173.C	;SPECIFIC FILE ERROR USE PROCEDURE
		TLC TE,14	;IF BOTH OF THESE ARE ON,
		TLCN TE,14	; IT IS REALLY "FILENAME OPEN"
		JRST P173.C	;(THEY WERE BOTH ON)
		JRST .+1]	;OTHERWISE IT'S EXTEND ERROR
>;END IFN ANS68

;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
IFN ANS74,<
	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
>;END IFN ANS74

;FOR ANS68, WE CAN HAVE ALL KINDS OF USE PROCEDURES FOR SPECIFIC
; FILES.
IFN ANS68,<
	SETZ	TC,		;MAKE OFFSET IN TC
	MOVE	TE,OPRTR	;GET OPERATOR BITS AGAIN
	TLNE	TE,20		;ENDING?
	ADDI	TC,4		;YES
	TLNE	TE,100		;BEFORE?
	ADDI	TC,2		;AFTER
	TLNN	TE,10		;REEL?
	ADDI	TC,1		;NO, FILE

;IF FILE AND REEL ARE BOTH ON (FILENAME OPEN CASE),
; OR NEITHER IS ON, THIS IS A GENERAL
; USE PROCEDURE.
	TLNE	TE,10		;SKIP IF ONE IS OFF..
	 JRST	[TLNE TE,4	;BOTH ON?
		JRST P173.G	;YES, FILENAME OPEN (GENERAL)
		JRST P173.H]	;ONE ON, OTHER CASE
	TLNN	TE,4		;SKIP IF ONE IS ON
P173.G:	 SKIPA	TC,[FI.ERR]	;NO, GENERAL ERROR USE PROCEDURE
P173.H:	MOVE	TC,UTBL68(TC)	;GET A BYTE POINTER
	LDB	TB,(TC)		;IS THERE ALREADY AN ENTRY THERE?
	JUMPN	TB,P173.E	;YES, GIVE ERROR
	HLRZ	TD,CURSEC	;NO, STORE CURRENT SECTION
	DPB	TD,(TC)
	LDB	TB,[POINT 2,OPRTR,15] ;GET 14&15
	CAIN	TB,3		;IF BOTH ON, SET FI.ENT
	DPB	TB,FI.ENT##	;"ERROR-ON-OPEN" BIT
	POPJ	PP,

;USE PROCEDURE BYTE PTR TABLE
UTBL68:	FI.BBR##	;BEFORE BEGINNING REEL
	FI.BBF##	;BEFORE BEGINNING FILE
	FI.ABR##	;AFTER BEGINNING REEL
	FI.ABF##	;AFTER BEGINNING FILE
	FI.BER##	;BEFORE ENDING REEL
	FI.BEF##	;BEFORE ENDING FILE
	FI.AER##	;AFTER ENDING REEL
	FI.AEF##	;AFTER ENDING FILE
>;END IFN ANS68

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,

IFN ANS74,<
	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)
>;END IFN ANS74
IFN ANS74,<

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

;STILL IN "IFN ANS74"
;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]
;NOTE: STILL IN "IFN ANS74"..

	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
	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"
>;END IFN ANS74
	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", OR ANS68 "SEEK"

;22-AUG-79 /DAW  DIAGNOSE COMMON ERROR OF "START" USED
;	AS A PARAGRAPH NAME AND GIVE A CLEARER ERROR MESSAGE.

	INTER. PA177.
PA177.:	FLAGAT	HI
	HRLM	LN,DWLNCP	;SAVE LN
	HRRM	CP,DWLNCP	;,,CP
IFN FT68274,<
	PUSHJ	PP,CVTCTC##	;TURN SEEK CLAUSE INTO A COMMENT
>
	HRRZI	TA,67		;[68] 'SEEK' OR [74] 'START' OP CODE
	JRST	SETOP1

IFN ANS74,<
;HERE IF "START <PRIOD.>" SEEN
	INTER.	PA177A
PA177A:	HLRZ	LN,DWLNCP	;GET SAVED "LN"
	MOVEM	LN,WORDLN
	HRRZ	CP,DWLNCP	;GET SAVED "CP"
	MOVEM	CP,WORDCP	;SAVE FOR "WARN"
	EWARNJ	E.730		;"RESERVED WORD.. MAY NOT BE USED AS PARA. NAME"
>;END IFN ANS74
	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.:	MOVE	TE,OP.ALF##
P183.A:	SETZM	OPRTR+1
	HRRZI	TA,22		;'IFT' OP CODE
P183.C:	PUSHJ	PP,SETOP1
P183.B:	SETO	TA,
	DPB	TA,TE
	JRST	P189.A


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


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

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

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

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


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

	INTER.	PA187.
PA187.:	FLAGAT	HI
	TLNN	W1,GWRESV
	JRST	P187.E
	LDB	TA,GWVAL##
	CAIE	TA,ZERO.
	JRST	P187.E
	MOVE	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
IFN ANS74,<
	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

IFN ANS74,<
;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
	HRRZI	TA,50		;'COMPUTE' OP CODE
	SWON	FARITH;
	JRST	SETOP1


	INTER.	PA192.
PA192.:	PUSHJ	PP,PA103.
IFN ANS68,<IFN MCS!TCS,<
	SKIPN	IFMSGF##
	JRST	P192.A
	MOVE	TA,SPFLVL
	ADD	TA,IFLVL
	HLLZ	TB,ARGL2-1(TA)
	HRLM	TB,ARGL2-1(TA)
	HRLZI	TA,102000
	HRRI	TB,102
	PUSHJ	PP,PUTGEN
>>
P192.A:	HRRZ	TA,IFLVL
	ADD	TA,SPFLVL
	HRRZ	TC,ARGL2-1(TA)	;F-TARGET
	HLRM	TC,ARGL2-1(TA)	;CLEAR IT
	JRST	P127.A		;DEFINE IT


	INTER.	PA193.
PA193.:	HRLZ	TB,NXTSNT
	SETZM	NXTSNT
	JUMPE	TB,CPOPJ
	HRRI	TB,102		;TAGNAM OP CODE
	SETZ	TA,
	DPB	TB,[POINT	9,TA,8]
	DPB	LN,[POINT	13,TA,28]
	DPB	CP,[POINT	7,TA,35]
	JRST	PUTGEN		;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##
	JRST	P183.B


	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
	HLRZ	TB,W1
	ANDI	TB,177
	HRRZM	TB,CTR
	HRRZI	TA,LITVAL
	PUSHJ	PP,GETVAL
	CAIL	TC,0
	CAILE	TC,43
	EWARNJ	E.243
	MOVEM	TC,TBLOCK
	POPJ	PP,
	INTER.	PA198.
PA198.:	FLAGAT	HI
	SKIPN	ARG2
	SKIPE	ARG2+1
	JRST	P198.A		;PERFORM ... THRU ...
	PUSHJ	PP,PA159.	;PERFORM ...
P198.A:	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	JUMPE	CH,.-2
	HRRZM	CH,UNTTAG##
	HRLZI	TB,(CH)
	HRRI	TB,74		;'JUMPTO' OP CODE
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	JUMPE	CH,.-2
	HRLZI	TB,(CH)
	HRRZM	CH,UNTTAG+1
	HRRI	TB,102		;'TAGNAM' OP CODE
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	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
	HRRI	TB,102		;'TAGNAM' OP CODE
	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.:	PUSHJ	PP,GETTAG
	ANDI	CH,077777
	HRRZM	CH,UNTTAG
	HRLZI	TB,(CH)
	HRRI	TB,74		;'JUMPTO' OP CODE
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	PUSHJ	PP,P192.A	;IMPLICIT 'ELSE'
	HRLZ	TB,UNTTAG+1
	HRRI	TB,74		;'JUMPTO' OP CODE
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	PUSHJ	PP,PA37.
	HRLZ	TB,UNTTAG
	HRRI	TB,102
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	JRST	PUTGEN
	INTER.	PA200.
PA200.:	MOVE	TA,NVARY
	CAILE	TA,3
	HRRZI	TA,3
	MOVEM	TA,MVARY##
	MOVE	TA,[XWD SAVPRF,OPRTR]
	BLT	TA,ARG2+1
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	SKIPN	ARG1
	SKIPE	ARG1+1
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
P200.A:	SOSGE	TA,NVARY
	POPJ	PP,
	CAILE	TA,2
	JRST	P200.A		;MORE THAN 3 SEEN
	IMULI	TA,^D45		;[222] WAS ^D27.
	MOVSI	TB,VARBLK(TA)
	HRRI	TB,ARG1
	BLT	TB,ARG1+1
	MOVSI	TB,VARBLK+2(TA)
	HRRI	TB,NSBSC1
	BLT	TB,NSBSC1+^D12	;[222] WAS ^D6.
	MOVSI	TB,VARBLK+^D30(TA)	;[222] WAS ^D18.
	HRRI	TB,ARG2
	BLT	TB,ARG2+1
	MOVSI	TB,VARBLK+^D32(TA)	;[222] WAS ^D20.
	HRRI	TB,NSBSC2
	BLT	TB,NSBSC2+^D12	;[222] WAS ^D6.
	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
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	SKIPG	TA,NVARY
	JRST	P200.B
	LSH	TA,1
	HRLZ	TB,VARTAG+1(TA)
	HRRI	TB,102		;'TAGNAM' OP CODE
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	PUSHJ	PP,PA70.	;'MOVE' OPERATOR
	HRRZ	TA,NVARY
	IMULI	TA,^D45		;[222] WAS ^D27.
	MOVSI	TB,VARBLK(TA)
	HRRI	TB,ARG1
	BLT	TB,ARG1+1
	MOVSI	TB,VARBLK+2(TA)
	HRRI	TB,NSBSC1
	BLT	TB,NSBSC1+^D12	;[222] WAS ^D6.
	MOVSI	TB,VARBLK+^D15(TA)	;[222] WAS ^D9.
	HRRI	TB,ARG2
	BLT	TB,ARG2+1
	MOVSI	TB,VARBLK+^D17(TA)	;[222] WAS ^D11.
	HRRI	TB,NSBSC2
	BLT	TB,NSBSC2+^D12	;[222] WAS ^D6.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	JRST	P200.A

P200.B:	HRLZ	TB,VARTAG	;%S
	HRRI	TB,102		;'TAGNAM' OP CODE
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	SETZB	TA,NVARY
P200.C:	CAML	TA,MVARY
	JRST	P200.D
	PUSHJ	PP,PA70.	;'MOVE' OPERATOR
	HRRZ	TA,NVARY
	IMULI	TA,^D45		;[222] WAS ^D27.
	MOVSI	TB,VARBLK(TA)
	HRRI	TB,ARG1
	BLT	TB,ARG1+1
	MOVSI	TB,VARBLK+2(TA)
	HRRI	TB,NSBSC1
	BLT	TB,NSBSC1+^D12	;[222] WAS ^D6.
	MOVSI	TB,VARBLK+^D15(TA)	;[222] WAS ^D9.
	HRRI	TB,ARG2
	BLT	TB,ARG2+1
	MOVSI	TB,VARBLK+^D17(TA)	;[222] WAS ^D11.
	HRRI	TB,NSBSC2
	BLT	TB,NSBSC2+^D12	;[222] WAS ^D6.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA47.
	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
	AOS	TA,NVARY
	JRST	P200.C

P200.D:	HRLZ	TB,VARTAG+2	;%C1
	HRRI	TB,74		;'JUMPTO' OP CODE
	SETZ	TA,
	DPB	TB,[POINT 9,TA,8]
	DPB	LN,[POINT 13,TA,28]
	DPB	CP,[POINT 7,TA,35]
	PUSHJ	PP,PUTGEN
	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
	MOVEM	TB,CORRSP+4
	MOVE	TB,ARG2+1
	MOVEM	TB,CORRSP+5
	MOVE	TA,CORRSP
	MOVEM	TA,CORRSP+2	;'LEFT' OPERAND
	MOVE	TA,CORRSP+1
	MOVEM	TA,CORRSP+3	;'RIGHT' OPERAND
	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)



; THIS ROUTINE FINDS  THE FILE WHICH CONTAINS THE GIVEN RECORD NAME [257]
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.	PA205.
PA205.:	TSWF	FNOSUB		;IF SUBSCRIPTING NO ALLOWED
	EWARNW	E.275		;GIVE ERROR
	SETZM	NSBSC1
	MOVE	TA,[XWD NSBSC1,SBSCR1] ;SBSCR1=NSBSC1+1
	MOVEI	TB,MAXSUB*4-1	;CLEAR OUT SUBSCRIPT INFO BLOCK
	BLT	TA,SBSCR1(TB)	; . .
	PUSHJ	PP,PA170.
	MOVE	TA,[XWD ARG1,ARG3]
	BLT	TA,ARG3+1
	POPJ	PP,
	INTER.	PA206A
PA206A:
IFN ANS68,<
	HLRZ	TA,ARG1		; GET SUBCRIPT [250]
	CAIN	TA,GWRESV!GWFIGC!TALLY	; IS IT TALLY?
	JRST	PA206.		; YES GO ON [205]
>
	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##	; IS SUBSCRIPTED ITEM SUBSCRIPTED ? [137]
	SKIPE	TB		; ERROR IF SO [137]
	EWARNW	E.495		; ERROR MESSAGE [137]
	SKPNAM			; OK GO ON [137]

	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)
	POPJ	PP,
	INTER.	PA207.
PA207.:	FLAGAT	HI
IFN ANS74,<
	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
IFN ANS74,<
	SETOM	SRTMRG		;SIGNAL ITS MERGE
>
	SWON	FNOSUB;		;[645] SUBSCRIPTING NOT ALLOWED
	HRRZI	TA,117		;'MERGE'
	JRST	SETOP1

IFN ANS74,<
	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

IFN ANS74,<
	INTER.	PA212F
PA212F:	SKIPL	SRTMRG		;ONLY CHECK MULTIPLE FILES ON SORT
	FLAGAT	H
	SKPNAM
>

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


	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
IFN ANS68,<
	JRST	PA21.		; [257] STORE OPERANDS
>
IFN ANS74,<
	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
	HRRZI	TA,46		;'USING'
	JRST	SETOP1




	INTER.	PA218.
PA218.:	LDB	TE,[POINT 13,W2,28]
	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,2]
	PUSHJ	PP,GETENT
	MOVE	TB,[POINT 7,(TA)]
	HRRZI	TD,^D9
	MOVE	TC,[POINT 7,TBLOCK]
	IDPB	TD,TB
	ILDB	TD,TC
	JUMPN	TD,.-2
	HLRZ	W1,TA
	HRLI	W1,^D9
	TLO	W1,GWLIT
	MOVEM	W1,ARG1
	MOVEM	W2,ARG1+1
	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.:	MOVE	TA,[XWD ARG3,ARG1]
	BLT	TA,ARG1+1
	POPJ	PP,

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

	INTER.	PA223.
PA223.:	FLAGAT	HI
	MOVEI	TA,121		;'RETURN' OP CODE
	JRST	SETOP1

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

IFN RPW,<

;"GENERATE"

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

;"GENERATE <REPORT-ITEM-NAME>"

	INTER.	PA226.
PA226.:	MOVEM	W1,ARG1		;GET READY TO PUTGEN THIS ITEM
	MOVEM	W2,ARG1+1	; . .
	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
	MOVE	W1,ARG1
	MOVE	W2,ARG1+1	;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
	JRST	PA0.		;POP UP NODE STACK AND RETURN

PA226E:	EWARNW	E.361		;NOT A TYPE DETAIL ITEM
	JRST	PA0.		;POP UP TO HIGHER NODE
;STILL IN RPW

;"INITIATE"

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

IFN RPW,<
;"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
>;END IFN RPW

IFN ANS74,<
;SORT/MERGE COLLATING SEQUENCE

	INTER.	PA229A
PA229A:	PUSHJ	PP,PA2.
	PUSHJ	PP,PA21.
	JRST	PA160.
>;END IFN ANS74

IFN RPW,<
;"TERMINATE"

	INTER.	PA230.
PA230.:	FLAGAT	RP
	HRRZI	TA,125		;TERMINATE OP CODE
	JRST	SETOP1

;STILL IN RPW

;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
>;END IFN RPW
;"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

IFN RPW,<
	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
				; FOR THIS REPORT GROUP.
	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,
;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
	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.:	MOVEM	W1,ARG1		;STORE ITEM WORDS
	MOVEM	W2,ARG1+1
	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
	CAIN	TA,PRIOD.	;IF AT END OF SEARCH STATEMENT
	SWON	FPERWD		; [413]   REGET THE PERIOD
	CAIN	TA,WHEN.	;DID WE COME HERE ON "WHEN"?
	 JRST	PA245A		;YES--MAKE SURE NO PERIOD FOLLOWED LAST SENTENCE
PA245B:	HRRZI	TA,OPJUMP##
	PUSHJ	PP,SETOP
	HLLZ	TB,CURTAG
	HLLM	TB,OPRTR+1
	SWOFF	UNCONT;		;INCASE "GOTO" OR "STOP RUN" IN SEARCH
	JRST	PA22.		;GO OUTPUT JUMP OPERATOR
PA245A:	SKIPE	SWHEN##		;SKIP IF SOMETHING OTHER THAN 'WHEN' ENDED
				; LAST SENTENCE
	 JRST	PA245B		;NO, ALL OK
	HLRZ	LN,PERLNC	;GET LN & CP
	HRRZ	CP,PERLNC	; OF LAST PERIOD
	MOVEI	DW,E.621	;"PERIOD IGNORED"
	PUSHJ	PP,WARN
	JRST	PA245B		;RESUME PROCESSING

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

IFN ANS68,<
	INTER.	PA252.
PA252.:	FLAGAT	NS
IFN FT68274,<
	MOVEI	TA,[ASCIZ /GOBACK/]
	MOVEI	TB,[ASCIZ /EXIT PROGRAM/]
	PUSHJ	PP,CVTRCW##	;CONVERT GOBACK TO EXIT PROGRAM
>
	SETOM	SUBPRG		;INDICATE THIS IS A SUBPROGRAM
	HRRZI	TA,37		;'GOBACK' OP CODE
	PUSHJ	PP,SETOP1
	SETO	TA,
	DPB	TA,OP.GOB##	;'GOBACK' BIT
	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
;LITERAL FOR SUBPROGRAM NAME - CONVERT TO NORMAL NAME

	INTER.	PA254.
PA254.:	HLRZ	TB,W1		;GET CHAR COUNT
	ANDI	TB,177
	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
	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
	MOVEM	W1,ARG1		;SET UP ARGS
	MOVEM	W2,ARG1+1	;[631]
	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
IFN BIS,<
	DMOVEM	W1,ARG1		;NO NEED TO GIVE DIAGNOSTIC BECAUSE
				;  PHASE E DOES IT ALREADY
>
IFE BIS,<
	MOVEM	W1,ARG1		;NO NEED TO GIVE DIAGNOSTIC BECAUSE
	MOVEM	W2,ARG1+1	;  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

	HRRZI	TB,5(TB)	;[535] [273] CONVERT TO ASCII WORDS
	IDIVI	TB,5

	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.
IFN BIS,<
	DMOVEM	W1,ARG1
>
IFE BIS,<
	MOVEM	W1,ARG1
	MOVEM	W2,ARG1+1
>
	MOVE	TC,[POINT 6,NAMWRD]	;FROM PTR
	MOVE	TD,[POINT 7,(TA),6]	;TO PTR

	POP	PP,TB		;PUT BYTE COUNT IN ENTRY
	DPB	TB,TD

	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
	JRST	P183.C

;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.:	HLRZ	TB,W1		;GET THE VALUE OF THE INTEGER
	ANDI	TB,177
	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.:	
IFN DBMS4,<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:
IFN DBMS4,<JUMPN W1,FIXNMID>
	HRLZ	W1,TD		;MOVE COUNT IN W1
	TLO	W1,1B19		;SET BIT 1
	POPJ	PP,

IFN DBMS4,<
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,
>				;END IFN DBMS4

	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.:
  IFE DBMS4,<
	MOVE	TA,[SIXBIT /DBMS:N/]
	MOVEM	TA,NAMWRD
	MOVSI	TA,'ULL'
	MOVEM	TA,NAMWRD+1
	SETZM	NAMWRD+2		;[%336] CLEAR FOR PROPER MATCH
	SETZM	NAMWRD+3		;[%336] GET IT ALL
	SETZM	NAMWRD+4		;[%336]
	PUSHJ	PP,TRYNAM		;GET NAMTAB ADDRESS
	PUSHJ	PP,BLDNAM		;PUT IN TABLE IF NOT THERE
	HLRZ	TA,TA		;SWITCH HALVES
	DPB	TA,[POINT 15,W2,15]
	SETZM	TBLOCK
	SETZM	TBLOCK+1
	SETZM	TBLOCK+2
	SETZM	TBLOCK+3
	SETZM	TBLOCK+5
	SETZM	TBLOCK+6
	MOVEM	W2,TBLOCK+4	;SET UP ARGS 
	PUSHJ	PP,FINDAT	;GET DATAB ADDRESS
	SKIPE	DW		;SKIP IF IN DATAB
	MOVEI	TE,1		;USE NULL DATAB ENTRY
	HRRZ	W1,TE		;PUT TABLE LINK IN W1
	TRO	W1,1B20		;SET BIT TO INDICATE DATAB
  >
  IFN DBMS4,<
	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.




IFN	DBMS4,<			;NOT TRULY NECES SINCE REF ONLY BY NEW CODE
	INTER.	PA297A
PA297A:	MOVEI	W1,%FINDO##	;FIND OFFSET GETS SPECIAL PATH FOR V4
	JRST	PA278.
>				;END IFN DBMS4

	INTER.	PA298.
PA298.:	PUSHJ	PP,SAVEM.
IFE DBMS4,<PUSHJ	PP,PA297.>
IFN DBMS4,<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.:
	IFE DBMS4,<PUSHJ	PP,PA297.>
	IFN DBMS4,<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
	CAIN	TD,%US.1C	;[1104] MUST BE ONE-WORD COMPUTATIONAL
	JRST	PA304A		;[1104] OK
	HRRZI	DW,E.634	;[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
	IFE DBMS4,<PUSHJ	PP,PA297.>
	IFN DBMS4,<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
	CAIN	TD,%US.1C	;[1046] MUST BE ONE-WORD COMP.
	 JRST	PA306A		;[1046] OK
	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.:
IFE DBMS4,<PUSHJ PP,PA277.>
IFN DBMS4,<
	SETZM	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
	JRST	DBGTF.##	;GO PROCESS 1ST FILE (###DB1.TMP)
	>
SUBTTL	MCS/TCS SYNTAX


;DISABLE/ENABLE ACTIONS

IFN MCS!TCS,<
	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
	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

IFN ANS68,<
	INTER.	PA342.
PA342.:	AOS	IFMSGF##	;MAKE NEW LEVEL FOR "IF MSG"
	HRRZI	TA,133		;'ACCNT' OP CODE
	PUSHJ	PP,SETOP
	SETO	TA,
	DPB	TA,OP.IFM##	;IF MSG BIT
	POPJ	PP,

	INTER.	PA343.
PA343.:	PUSHJ	PP,PA325.	;OUTPUT CD-NAME
	PUSHJ	PP,PA22.	;AND OPERAND
	JRST	P341A
>
>;END OF MCS/TCS 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##
	POPJ	PP,
;CONVERT FIG CONSTANT TO A SINGLE CHARACTER LITERAL

IFN ANS68,<
	INTER.	PA367.
PA367.:	LDB	TB,[POINT 9,W1,17]	;GET FIG CON CODE
	SUBI	TB,HIVAL.	;MAKE INDEX TO TABLE
	XCT	%HV(TB)		;GET EQUIVALENT SINGLE LETTER LITERAL

;[1117] If it returned, the fig. const. is ok and TB
;[1117] contains the character in the high-order 7 bits.
;[1117] Or it was "TODAY" - Illegal, but message has been given
;[1117] and TB contains random characters. (who cares)
	MOVEM	TB,LITVAL
	MOVSI	W1,GWLIT!1	;SAY ITS A 1-CHAR LITERAL
	JRST	PCA5.		;CONTINUE AS IF NOTHING HAPPENED

%HV:	JRST	PCA5.		;[1117]
%LV:	JRST	PCA5.		;[1117]
%QUO:	MOVSI	TB,(ASCII /"/)
%SPA:	MOVSI	TB,(ASCII / /)
%TL:	JRST	BFGCN		;[1117] TALLY - Should never get here
%ZER:	MOVSI	TB,(ASCII /0/)
	JRST	BFGCN		;[1117] "ALL" - Should never get here
	EWARNW	E.184		;[1117] TODAY - Illegal

BFGCN:	OUTSTR	[ASCIZ/?Error in COBOLD at PA367.
/]
	JRST	KILL		;[1117] Defensive programming
>;END IFN ANS68
;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]	;GET WHICH FIG CONSTANT [265]
	CAIN	TA,ZERO.	; IS IT ZERO? [265]
	JRST	PA2.		; YES-OK [265]
	EWARNW	E.131		; NO- ILLEGAL [265]
	MOVEI	TA,ZERO.	; MAKE ZERO [265]
	DPB	TA,[POINT 9,W1,17]	; TO PREVENT MORE ERRORS [265]
	JRST	PA2.		; [265]

;SET WITH SEQUENCE CHECK FOR MERGE VERB

	INTER.	PA401.
PA401.:	FLAGAT	NS
	SETO	TA,
	DPB	TA,OP.WSC##
	POPJ	PP,
IFN CSTATS,<
;METER--JSYS

	INTER.	PA402.
PA402.:	FLAGAT	NS
	HRRZI	TA,155		;OPCODE
	SKIPE	METRSW##	;DID HE SPECIFY "WITH METER--ING"?
	 JRST	SETOP1		;YES--OK
	EWARNW	E.599		;? WITH METER--ING MUST BE SPECIFIED IN ENVIRON.
	HRRZI	TA,105		;"YECCH"
	JRST	SETOP1

	INTER.	PA403.
PA403.:	HLRZ	TB,W1
	ANDI	TB,177
	MOVEM	TB,CTR##	;LENGTH
	HRRZI	TA,LITVAL
	PUSHJ	PP,GETVAL##
	JUMPL	TC,JDE25.	;?POSITIVE INTEGER REQUIRED
	CAILE	TC,^D2500	;MUST BE LE 2500
	EWARNJ	E.600		;?MUST BE...
	MOVSI	TA,(1B0)	;SET OPERAND BIT
	MOVE	TB,TC		; 2ND WORD = NUMBER
	PJRST	PUTGEN		;SEND IT OUT

JDE25.:	EWARNJ	E.25

>;END IFN CSTATS
SUBTTL	COBOL-74 SYNTAX

IFN ANS74,<

;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
IFN ANS74,<
	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.
	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
	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,[POP PP,(PP)
		POP PP,(PP)
		JRST PCASKE]	; NO, ERROR
	PUSH	PP,TA		;SAVE # OF ENTRY
	MOVEI	TD,2		;WE'RE AT KEY #2 NOW
	PUSH	PP,TD
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
	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)
	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
	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!TCS,<
	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!TCS

	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
>;END IFN ANS74
;FOR DEBUGGING..

	INTER.	PA520.
PA520.:
IFN DEBUG,<
	PUSHJ	PP,PA2.		;READ LITERAL, CHECK FOR ERRORS
	HLRZ	TA,ARG1		;LOOK AT LITERAL
	ANDI	TA,177		;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].

IFN RPW,<
	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

>;END IFN RPW
	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
IFN ANS74,<
;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.

>;END IFN ANS74
;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:
;
;		BIT 0: INPUT
;		BIT 1: OUTPUT
;		BIT 2: INPUT-OUTPUT
;		BIT 3: NO REWIND
;		BIT 4: FOR READ
;		BIT 5: FOR REWRITE
;		BIT 6: FOR WRITE
;		BIT 7: FOR DELETE
;		BIT 8: FOR ALL
;		BIT 9: OTHERS NONE
;		BIT 10: OTHERS READ
;		BIT 11: OTHERS REWRITE
;		BIT 12: OTHERS WRITE
;		BIT 13: OTHERS DELETE
;		BIT 14: OTHERS ALL
;		BIT 15: USER SUPPLIED UNAVAILABLE STATEMENT (1ST FILENAME ONLY)
;		BIT 16: [74] EXTENDED
;		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,400000;	SET INPUT BIT
	MOVEI	TC,300002;	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,200000;	SET OUTPUT BIT
	MOVEI	TC,500002;	CLEAR INPUT AND INPUT-OUTPUT BITS
	JRST	PASU2A

	INTER.	PASUE.
PASUE.:	FLAGAT	HI
	MOVEI	TD,240002;	SET OUTPUT, NO REWIND & EXTEND BITS
	MOVEI	TC,500000;	CLEAR INPUT AND INPUT-OUTPUT BITS
	JRST	PASU2A

IFN ANS74,<
	INTER.	PASUR.
PASUR.:	FLAGAT	HI
	MOVEI	TD,1		;SET REVERSED BIT
	JRST	PASU6A
>

	INTER.	PASU4.
PASU4.:	MOVEI	TD,100000;	SET INPUT-OUTPUT BIT
	MOVEI	TC,640000;	CLEAR INPUT AND OUTPUT BITS
	JRST	PASU2A

	INTER.	PASU5.
PASU5.:	PUSHJ	PP,PASU2B;	SET UP TA
	ADDI	TA,BUFFER
	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
	JUMPE	TE,CPOPJ	;[757] OK IF NOT AN SD
	EWARNJ	E.291		;[757] IN AN SD, SO GIVE ERROR

	INTER.	PASU6.
PASU6.:	FLAGAT	HI
	MOVEI	TD,040000;	SET NO REWIND BIT
PASU6A:	SETZ	TC,;		CLEAR NO BITS
	JRST	PASU2A

	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,

	INTER.	PASU9.
PASU9.:	MOVEI	TD,020000;	SET FOR READ BIT
	JRST	PASU6A

	INTER.	PASU10
PASU10:	MOVEI	TD,010000;	SET FOR REWRITE BIT
	JRST	PASU6A

	INTER.	PASU11
PASU11:	MOVEI	TD,004000;	SET FOR WRITE BIT
	JRST	PASU6A

	INTER.	PASU12
PASU12:	MOVEI	TD,002000;	SET FOR DELETE BIT
	JRST	PASU6A

	INTER.	PASU13
PASU13:	MOVEI	TD,036000;	SET FOR ALL BIT
	JRST	PASU6A

	INTER.	PASU14
PASU14:	MOVEI	TD,000400;	SET OTHERS NONE BIT
	JRST	PASU6A

	INTER.	PASU15
PASU15:	MOVEI	TD,000200;	SET OTHERS READ BIT
	JRST	PASU6A

	INTER.	PASU16
PASU16:	MOVEI	TD,000100;	SET OTHERS REWRITE BI
	JRST	PASU6A

	INTER.	PASU17
PASU17:	MOVEI	TD,000040;	SET OTHERS WRITE BIT
	JRST	PASU6A

	INTER.	PASU18
PASU18:	MOVEI	TD,000020;	SET OTHERS DELETE BIT
	JRST	PASU6A

	INTER.	PASU19
PASU19:	MOVEI	TD,000360;	SET OTHERS ALL BIT
	JRST	PASU6A

	INTER.	PASU8.
PASU8.:	SKIPN	BUFCTR
	POPJ	PP,
	MOVE	TA,[XWD NAMWRD,HLDNAM##]	; [420] SAVE CURRENT
	BLT	TA,HLDNAM+4		; [420] SOURCE ITEM
	MOVEM	W1,HLDSRC##		; [420] STORE FIRST WORD OF SOURCE PARAMS
	MOVEM	W2,HLDSRC+1		; [420] 2ND  SOURCE WORD PARAMS
	MOVEM	CT,HLDSRC+2		; [420] 3RD SOURCE PARAMS
	SETZM	SU8FLG
	MOVE	TA,BUFCTR	;ADJUST SPACE REQUIRED FOR ENQ/DEQ BUFFERING
	LSH	TA,1
	ADD	TA,BUFCTR
	ADDI	TA,2
	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,000770
	JRST	PASU8R;		JUMP IF NO SIMULTANEOUS UPDATE
	TLNN	TD,100000
	 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	TA,FI.RMS##	;IS THIS AN RMS FILE?
	SKIPE	TA		;SKIP IF NO
	 PUSHJ	PP,ERRNRM	;GIVE ERROR ABOUT RMS-SIMULTANEOUS UPDATE
	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
	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	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,400000
	PUSHJ	PP,PA74.;	EXECUTE OLD ACTION PA74 OF NODE PD491
	MOVE	TB,SU8SVB
	TLNE	TB,200000
	PUSHJ	PP,PA75.;	EXECUTE OLD ACTION OF NODE PD492
	MOVE	TB,SU8SVB
	TLNE	TB,100000
	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.
IFN ANS74,<
	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,040000
	PUSHJ	PP,PA79.;	EXECUTE OLD ACTION PA79 OF NODE PD504
	TLNE	TB,(1B16)	;EXTENDED?
	PUSHJ	PP,PA79E.	;YES
IFN ANS74,<
	TLNE	TB,(1B17)	;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,000004;	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
	MOVE	W1,HLDSRC##		; [420] RESTORE FIRST WORD OF SOURCE PARAMS
	MOVE	W2,HLDSRC+1		; [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
	MOVE	W1,HLDSRC##		; [420] RESTORE FIRST WORD OF SOURCE PARAMS
	MOVE	W2,HLDSRC+1		; [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.
ERRNRM:	MOVEI	DW,E.625	;RMS-SIMUL. DON'T MIX
	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
	MOVE	TA,BUFFER;	SET BIT INDICATING USER SUPPLIED UNAVAILABLE STATEMENT
	TLO	TA,000004
	MOVEM	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 
	JRST	PA0.

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:	HRLZI	TA,000010;	SET FLAG INDICATING DATA NAME OR
	ORM	TA,SU30FG;	LITERAL SUPPLIED
	JRST	PA2.;		GO TO PA2. TO SAVE SAME

	INTER.	PASU33
PASU33:	HRLZI	TA,000400;	SET READ FLAG
PASU3X:	ORM	TA,SU30FG
	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

IFN ANS74,<
	INTER.	PASU90
PASU90:	HRLZI	TA,(1B15)	;SET "NEXT RECORD" FLAG
	JRST	PASU3X
>;END IFN ANS74

	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.ACC
	CAIE	TB,%ACC.I
	JRST	SUCS1		;SIZE OF SPACE REQUIRED TO SAVE KEY
				;IS ONE WORD IF FILE IS NOT INDEXED
IFN ANS68,<
	LDB	TA,FI.SKY	;MOVE ADDRESS OF DATAB ENTRY FOR
				;SYMBOLIC KEY TO TA
>;END IFN ANS68
IFN ANS74,<
	LDB	TA,FI.RKY	;Get record key
>;END IFN ANS74
	JUMPE	TA,SUCS1	;SYMBOLIC (68) OR RECORD (74) 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,2		;ADD 1 WORD FOR THE MISCELLANEOUS
				;WORD, 1 WORD FOR THE BLOCK NUMBER.
				;TC NOW CONTAINS THE LENGTH OF A
				;RETAINED RECORDS TABLE ENTRY AT RUN TIME.
	ADDM	TC,SURRTM
	MOVE	TA,CURFIL
	LDB	TB,FI.ACC	;GET ACCESS MODE FROM FILE TABLE
	CAIE	TB,2
	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:	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,2
	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

IFN ANS74,<
	INTER.	PASU92
PASU92:	HRLZI	TA,(1B15)	;SET "FILENAME NEXT" FLAG
	JRST	PASU3X
>;END IFN ANS74

;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
SUBTTL	COMPOUND ACTIONS

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

	INTER.	PCA2.
PCA2.:	PUSHJ	PP,PA4.
	PUSHJ	PP,PA137.
	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.

IFN ANS74,<
	INTER.	PCA5A.
PCA5A.:	TLNE	W1,GWSIGN!GWDP
	EWARNW	E.702
	JRST	PCA5.
>;END IFN ANS74

	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.

IFN FT68274,<
;PCA5X. IS A VERSION OF PCA5. THAT IS CALLED DURING -68 TO -74 CONVERSION
;OF SOME CASES OF EXAMINE TO INSPECT.
;IT STORES THE CURRENT LITERAL AND
;IF REPLACING UNTIL FIRST DELETES IT FROM THE .CVT FILE

	INTER.	PCA5X.
PCA5X.:	MOVEM	W1,CVTW1##	;STORE WHAT TYPE OF THING IT IS
	MOVE	TC,LITVAL	;GET FIRST WORD OF LITERAL
	MOVEM	TC,CVTLIT##	;FOR EXAMINE UNTIL FIRST CONVERSION
	LDB	TC,OP.UFR	;IS THIS UNTIL FIRST?
	JUMPE	TC,PCA5.	;NO
	LDB	TC,OP.TAL	;IS IT TALLYING OPTION
	JUMPN	TC,PCA5.	;YES
	PUSHJ	PP,PCA5.	;NO
	JRST	CV3.##		;DELETE THE LITERAL

;THIS VERSION OF PCA5. OUTPUTS THE LITERAL STORED AT PCA5X.

	INTER.	PCA5R.
PCA5R.:	LDB	TC,OP.UFR	;IS THIS UNTIL FIRST?
	JUMPE	TC,PCA5.	;NO
	PUSHJ	PP,PCA5.
	MOVEI	TB,[ASCIZ / BEFORE INITIAL /]
PCA5L.:	PUSHJ	PP,CVTACW
	MOVE	TE,CVTW1	;GET W1 OF ITEM
	TLNN	TE,GWLIT	;IS IT REALLY A LITERAL?
	JRST	PCA5FC		;NO, TRY FIG. CON.
	HLLZ	TB,CVTLIT	;MAKE SURE IT HAS A TERMINATOR
	TLZ	TB,3777		;CLEAN OUT REST OF THE JUNK
	TLNE	TE,GWNLIT	;IS IT A NUMERIC LITERAL?
	JRST	[TLO	TB,(<BYTE (7) 0," ">)	;SPACE
		JRST	.+3]
	LSH	TB,-7		;MAKE SPACE FOR "
	IOR	TB,[<ASCIZ /" " /> - <BYTE (7)0," ">]	;" "
	MOVEM	TB,CVTLIT
	MOVEI	TB,CVTLIT	;POINT TO LITERAL
	JRST	CVTACW		;INSERT IT

PCA5FC:	TLNE	TB,GWRESV	;BETTER BE A RESERVED WORD
	TLNN	TB,GWFIGC	;AND A FIG. CON.
	POPJ	PP,		;JUST GIVE UP
	LDB	TB,[POINT 9,CVTW1,17]
	MOVE	TB,[[ASCIZ /HIGH-VALUE /]
		[ASCIZ /LOW-VALUE /]
		[ASCIZ /QUOTE /]
		[ASCIZ /SPACE /]
		[ASCIZ /TALLY /]
		[ASCIZ /ZERO /]
		[ASCIZ /ALL /]
		[ASCIZ /TODAY /]]-HIVAL.(TB)
	JRST	CVTACW
>

;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
IFN ANS74,<
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.

IFN ANS74,<
	INTER.	PCA6A.
PCA6A.:	PUSHJ	PP,PA22.
	PUSHJ	PP,PA59.
	SKPNAM
>

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

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

;IN SEARCH STATEMENT, SET FLAG THAT SAYS "." SEEN TO DELIMIT
; STATEMENT. IF THE NEXT TOKEN IS A "WHEN", WE WILL ASSUME
; THAT THE "." IS A MISTAKE
; AND IGNORE IT.

	INTER.	PCA7B.
PCA7B.:	SETZM	SWHEN##		;CLEAR FLAG
	HRLZM	LN,PERLNC##	;STORE LN AND CP
	HRRM	CP,PERLNC	;OF THE "." INCASE AFTER PARSING THE
				;NEXT TOKEN WE DECIDE THIS PERIOD IS EXTRANEOUS
	JRST	PA0.		;POP UP A NODE

	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
	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.	PCA19.
PCA19.:	PUSHJ	PP,PA2.
	SKPNAM

	INTER.	PCA10.
PCA10.:	PUSHJ	PP,PA21.
	PUSHJ	PP,PA22.
IFN FT68274,<
	PUSHJ	PP,CVTUTC##	;TURN OFF COMMENTING NOW
>
	JRST	PA0.

IFN ANS74,<
	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.

IFN ANS74,<
	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.	PCA33.
PCA33.:	PUSHJ	PP,PA2.
	JRST	PA164.


	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.
IFN ANS74,<
	AOS	SU8CNT		;COUNT ONE MORE FOR FIPS FLAGGER
>
	JRST	PA2.
	INTER.	PCA51.
PCA51.:	PUSHJ	PP,PA173.
	JRST	PA0.

IFN ANS68,<
	INTER.	PCA52.
PCA52.:	PUSHJ	PP,PA12.
	JRST	PA13.


	INTER.	PCA53.
PCA53.:	PUSHJ	PP,PA16.
	JRST	PA15.
>

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


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


	INTER.	PCA56.
PCA56.:	PUSHJ	PP,PA22.
	JRST	PA90.

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

	INTER.	PCA60.
PCA60.:	PUSHJ	PP,PA37.
	PUSHJ	PP,PA148.
	JRST	PA0.


	INTER.	PCA61.
PCA61.:	PUSHJ	PP,PA37.
	PUSHJ	PP,PA24.
	PUSH	PP,TD		;[670] GET AN AC
	MOVEI	TD,PRIOD.	;[670] LOAD TOKEN FLAG FOR PERIOD (.)
	CAME	TD,PRVTOK##	;[670] WAS PREV TOKEN A PERIOD?
	JRST	PCA61M		;[670] NO
	MOVE	TD,IFLVL	;[670] LOAD CURR NO OF LEVELS OF "IF"
	JUMPLE	TD,PCA61M	;[670] JUMP IF NO LEVELS OUTSTANDING
	HRRZ	TD,-2(NODPTR)	;[744] ABOUT TO END A SEARCH STMT?
	CAIN	TD,PD1055##	;[744]
	 JRST	PCA61M		;[744] YES
PCA61J:	POP	NODPTR,NODE	;[670] UNWIND TWO LEVELS OF NODES FOR
	POP	NODPTR,NODE	;[670]   FOR EACH LEVEL OF "IF"
	HRRZ	TD,(NODPTR)	;[1050] SEE IF WE ARE UNWINDING A SPIF
	CAIN	TD,PD569.##	;[1050] AND WOULD RETURN HERE
	 JRST	[PUSHJ PP,PA139. ;[1050] YES, THIS IS THE I/O SPIF
		JRST .+2]	;[1050] GENERATE "END SPIF" AND SKIP
	PUSHJ	PP,PA37.	;[707] MAYBE OUTPUT FALSE-TAG
	SKIPLE	IFLVL		;[707] REACHED THE BOTTOM YET?
	JRST	PCA61J		;[670] NO
PCA61M:	POP	PP,TD		;[670] YES, RESTORE AC
	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.

ifn ans74,<
	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.:	PUSHJ	PP,FNDFIL	; [455] GET FILE FOR THIS RECORD
	  JRST	[SETZ	TB,		; [455] FORCE NOT IN SORT FILE ERROR
		JRST	PCA88A]		; [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
PCA88A:	MOVEI	DW,E.488	; [455] NOT IN SORT FILE ERROR CODE
	SKIPN	TB		; [455]
	PUSHJ	PP,FATAL	; [455] GIVE ERROR
	PUSHJ	PP,PA21.	; [455] PUT OUT OPERANDS
	JRST	PA160.		; [455] CONTINUE
SUBTTL	ANS-74 PROCEDURE DIVISION ACTIONS

IFN ANS74,<

;ACCEPT XXX FROM DATE.

	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
	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.
	MOVEM	W1,SVINSP##
	MOVEM	W2,SVINSP+1
	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.	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.
>
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.:	MOVE	CP,BLNKCP
	MOVE	LN,BLNKLN
	HRRZI	DW,E.125	;DIAGNOSTIC 125
	JRST	WARN		;WARNING ONLY

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