Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/iogen.mac
There are 22 other files named iogen.mac in the archive. Click here to see a list.
; UPD ID= 1958 on 3/3/89 at 8:39 AM by KSTEVENS                        

TITLE	IOGEN FOR COBOL V13
SUBTTL	I/O GENERATORS		AL BLACKINGTON/SIP/CAM/MEM

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1974, 1983, 1984, 1986 BY DIGITAL EQUIPMENT CORPORATION


	SEARCH	P
	%%P==:%%P
	IFN TOPS20,<SEARCH	MONSYM,MACSYM>
	IFE TOPS20,<SEARCH	UUOSYM,MACTEN>

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

;EDITS

;V13*****************
;NAME	DATE		COMMENTS
;RLF	12-JUL-90	[1653]	12C only.
;KWS	22-FEB-89	[1652]	Change code generation so that when Sorting an
;				RMS file, the correct code is generated.
;RLF	04-AUG-87	[1643]	SELECTed sequential file gets error message
;				erroneously from FREE EVERY RECORD statement
;MEM	12-NOV-86	[1636] Check for a depending variable when calculating
;			        the size of an item to be displayed.
;JEH	31-MAY-84	[1536] Restore AC16 to curfil value before using it

;V12B****************
;NAME	DATE		COMMENTS
;RLF	11-JUL-83	[1474] Correction to edit 1450.
;RLF	22-APR-83	[1464] Correction to edit 1450.
;RLF	27-JAN-83	[1450] Give error message on FREE syntax error.
;RLF     1-OCT-82       [1412] Make RETAIN do RETAIN NEXT so LSU works
;                               for ISAM Sequential access.
;SMI	 2-Aug-82	[1375] Bad move generated on variable length records.
;JEH	28-Jun-82	[1370] Make CURAKT an absolute addr so XPAND updates it correctly.
;JEH	13-Jan-82	[1331] Fix failure in phase E when WRITE ADVANCING data-name has a syntax error.
;DMN	11-Aug-81	[1305] Wrong code for WRITE record-name AFTER ADVANCING data-name
;				where record-name has an OCCURS DEPENDING ON clause
;DMN	 6-Jul-81	[1303] RMS variable length records always take DEPENDING ON error return.
;DMN	23-Jun-81	[1302] Bad table link if RMS RECORD KEY is missing.

;V12A****************
;NAME	DATE		COMMENTS
;WTK	04-DEC-80	[1101] REWRITE and DELETE generating WRITV. when record
;				has a DEPENDING ON clause.
;DAW	29-DEC-80	[1107] Make error message point to correct place
;				if there are errors in depending variable usage
;DAW	22-SEP-80	[1053] FIX "ACCEPT ITEM(SUBSCRIPTS) FROM DATE/DAY/TIME".
;DMN	26-JUN-80	[1030] MORE OF EDIT 605 WHEN OCCURS IS NOT ELEMENTRY ITEM.
;JEH	24-JUN-80	[1027] BUILD RECORD NAME TABLE IF NESTED READS
;DMN	24-OCT-79	[750] COBOL-74  BAD TABLE LINK IF RELATIVE KEY CONVERSION REQUIRED

;V12*****************
;NAME	DATE		COMMENTS
;DMN	 1-DEC-78	[605] MAKE VARIABLE LENGTH READS WORK USEFULLY

;V10*****************
;NAME	DATE		COMMENTS
;VR	20-SEP-77	[512] CHECK FOR COMP ITEM AT 01 LEVEL WHEN DOING A BINARY WRITE
;EHM	20-MAY-77	[474] PUT OUT ERROR MESSAGE WHEN TRYING TO DO A
;				READ INTO ON A RECORD OF ZERO SIZE.
;MDL	04-NOV-76	[447] GIVE WARNING WHEN ATTEMPTING TO 'ACCEPT' MORE THAN
;				1023 CHARACTERS INTO AN AREA.
;SSC	 2-AUG-76	      MAKE ERENQ GEN CALL TO CNTAI. FOR COMPOUND RETAIN
;DPL	23-JUN-76	[430] FIX ACCGEN WHEN ARG HAS FAULTY SUBSCRIPT
;	18-FEB-76	[407] FIX STD ASCII WRITING BEFORE/AFTER
;ACK	26-APR-75	      DISPLAY DISPLAY-9 ITEMS.
;********************

; EDIT 366 FIX DISPLAY OF DISPLAY-7 ITEMS SO NO EXTRA <CR-LF> DONE.
; EDIT 357 FIX RECOVERY IF RECORD NAME IS NOT DEFINED IN READ INTO STATEMENTS.
; EDIT 345 FIX SUBSCRIPTED DISPLAY ITEM SO NO ADVANCING WORKS.
; EDIT 252 FIXES POSSIBLE PUSHDOWN LIST PROBLEM OF EDIT 122
; EDIT 245 FIXES READ INTO AT END GENERATE TO MAKE INTO WORK
; EDIT 176 FIXES ACCEPT FOO FOR FOO A DISPLAY ITEM IN LINKAGE SECTION.
; EDITS 166,163 131 ALLOW ADVANCING ITEM TO BE SUBSCRIPTED.
;EXIT IF THE ERROR FLAG IS ON
	DEFINE EQUIT,<
	TSWF FERROR
	POPJ PP,
	>


;PRINT A MESSAGE
	DEFINE TYPE(ADDR),<
	IFE TOPS20,<
	OUTSTR ADDR
	>
	IFN TOPS20,<
	HRROI	1,ADDR
	PSOUT%
	>
	>

;DIE WITH A MESSAGE
	DEFINE DIE(MSG),<
	TYPE	[ASCIZ/MSG/]
	JRST	KILL
	>
;; ** BITS THAT WILL BE DEFINED IN COMUNI FOR V13 **

;THESE ARE HERE BECAUSE IN 12B THEY MAY CONFLICT WITH EXISTING DEFINITIONS.
; THESE ARE VALID ONLY FOR RMS FILES IN 12B.

;IO VERBS
	O%BOPR==POINT 4,IOFLGS,3	;PLACE TO STORE VALUE
	O%SM5B==POINT 9,IOFLGS,17	;SMU OPTION 5 BITS FOR SELF, OTHERS, + FLAGS
					; FOR OPEN VERB WITH RMS FILES
	V%OPEN==1		;OPEN
	V%CLOS==2		;CLOSE
	V%READ==3		;READ
	V%WRIT==4		;WRITE
	V%RWRT==5		;REWRITE
	V%DELT==6		;DELETE
	V%STRT==7		;START
	V%ACPT==10		;ACCEPT
	V%DPLY==11		;DISPLAY
	V%OPS5==12		;OPEN RMS FILE FOR SMU OPTION 5
				; ASSUME OPEN FOR I-O AND ANY BITS ARE FOR
				; SHARING OR UNAVAILABLE
	V%SORT==13		;[1652]Sort

O.BOPR:	O%BOPR
O.SM5B: O%SM5B

;OPEN FLAG BITS
	OPN%IN==1B9		;OPEN FOR INPUT
	OPN%OU==1B10		;OPEN FOR OUTPUT
	OPN%IO==1B11		;OPEN FOR I/O
	OPN%EX==1B13		;OPEN FOR EXTEND

;CLOSE FLAG BITS
	CLS%CF==1B12		;CLOSE FILE
	CLS%LK==1B13		;WITH LOCK
	CLS%DL==1B14		;WITH DELETE

;READ FLAGS
	RD%NXT==1B9		;READ NEXT RECORD
	RD%KRF==1B10		;KEY OF REFERENCE GIVEN
	RD%NIK==1B11		;NO INVALID KEY/AT END CLAUSE RETURN--CALL
				; THE ERROR RETURN

;WRITE FLAGS
	WT%SEQ==1B9		;WRITE WITH SEQUENTIAL ACCESS
	WT%NIK==1B11		;NO INVALID KEY CLAUSE GIVEN

;REWRITE FLAGS -- FOR COMPLETENESS
	RW%SEQ==1B9		;REWRITE WITH SEQUENTIAL ACCESS
	RW%NIK==1B11		;NO INVALID KEY CLAUSE GIVEN

;DELETE FLAG BITS
	DL%SEQ==1B9
	DL%NIK==1B11		;NO "INVALID KEY" CLAUSE GIVEN

;START FLAG BITS
	STA%EQ==3B13		;EQUAL TO (IF 0)
	STA%NL==1B12		;NOT LESS THAN
	STA%GT==1B13		;GREATER THAN
	STA%AK==1B14		;START WITH APPROX. KEY
	STA%NI==1B15		;NO "INVALID KEY" CLAUSE GIVEN

	;DEQUEUE FLAG BITS
		DQ%KEY==10		;[1450] FREE WITH KEY
		DQ%EVR==200		;[1450] FREE EVERY RECORD
		DQ%ALR==400		;[1474] FREE RECORDS IN ALL FILES

;BIT DEFINITIONS FOR 12B NON-RMS FILES
	STA%AP==1B8		;NON-RMS FILE START WITH APPROX. KEY
IOGEN::

EXTERNAL MOVGEN
EXTERNAL PUTASY, PUTASN
EXTERNAL MOVGN., MXX., MXTMP., MACX., MXAC.
EXTERNAL SETOPN, GETEMP,SUBSCR,PUT.LD,LITD.
EXTERNAL STASHP,STASHQ,POOLIT,POOL,PLITPC
EXTERNAL FATAL,  OPFAT,OPWRN, OPNFAT, BADEOP, LNKSET,WARN
EXTERNAL KILL, BMPEOP, EWARN
EXTERNAL ASRJ.,AQRJ.,AZRJ.,SPIFGN,READEM
EXTERNAL FPMODE,F2MODE,DSMODE
EXTERNAL ESIZEZ,ADDI.,TLO.,TLZ.

ENTRY READGN	;"READ" GENERATOR
ENTRY RITEGN	;"WRITE" GENERATOR
ENTRY OPENGN	;"OPEN" GENERATOR
ENTRY CLOSGN	;"CLOSE" GENERATOR
ENTRY STRTGN	;"START" GENERATOR
ENTRY DISPGN	;"DISPLAY" GENERATOR
ENTRY ACCGEN	;"ACCEPT" GENERATOR
ENTRY REWGEN	;"REWRITE" GENERATOR
ENTRY DELGEN	;"DELETE" GENERATOR
ENTRY CRHLD	; CREATE HLDTAB ENTRY FOR "READ INTO" - USED BY RETNGN

INTERN	LARGE,LARGER	;[245] FIND LARGEST RECORD FOR A FILE
INTERN	INTOCK		;TO CHECK INTO OPTION FOR VALIDITY
SUBTTL	OPEN

OPENGN:	PUSHJ	PP,SETOP	;SET UP EOPTAB
	EQUIT;

;AT THIS POINT, IF BASIC-LOCKING IS IN EFFECT AND WE HAVE AN RMS FILE
;OPEN, WE CAN ASSUME THAT IT IS FOR SIMULTANEOUS UPDATE (OPTION 5).
;HOWEVER, WE ARE JUST GOING TO DO A SINGLE FILE OPEN BECAUSE WE DON'T
;HAVE TO WORRY ABOUT ACCUMULATING LOCKS. IF THE USER DOES AN UNAVAILABLE
;CLAUSE ON THE OPEN, HE CAN HANDLE PROBLEMS WITH THE INDIVIDUAL FILE.
;HOWEVER, IF HE DOES NOT, HE WILL GET A FATAL I-O ERROR, AND THAT'S LIFE.

	SKIPN	ABSEEN##	;APPLY BASIC-LOCKING IN EFFECT?
	 JRST	OPNG1		; NO - NON-SMU OPEN FOR A FILE

;IF APPLY BASIC-LOCKING HAS BEEN SEEN IN THIS PROGRAM, A LOT OF POSSIBILITIES
;ARISE, AND WE HAVE TO FILTER THEM OUT, AS INDICATED BELOW.

	LDB	TD,FI.RMS##	;GET RMS FLAG FROM FILE TABLE
	LDB	TE,[POINT 9,W1,8] ;GET OPCODE OF GENFIL OPERATOR

;FIRST FILTER -- IS IT AN RMS FILE?

	SKIPN	TD		;SKIP IF FI.RMS BIT IS ON

		;IF NOT, SECOND FILTER -- GENFIL OPER MUST BE 62 (ASSUMED)
		;FOR A NON-SMU OPEN

	 JRST	[CAIE	TE,143	;WAS GENFIL OPERATOR FOR FENQGN?
		  JRST	OPNG1	; NO - NON-SMU OPEN
		 MOVEI	DW,E.833 ;YES - FATAL ERROR
		 JRST	OPFAT]	;

;FOR RMS FILE -- SECOND FILTER -- IS GENFIL OPERATOR 143 FOR SMU?

	LDB	TC,FI.ABL##	;GET FILE'S BASIC-LOCKING FLAG
	CAIE	TE,143		;WAS GENFIL OPERATOR FOR FENQGN?
	 JRST	OPNG1		;NO - NON-SMU OPEN

	;FOR SMU OPEN - THIRD FILTER -- BASIC LOCKING ON THIS FILE?
	SKIPE	TC		;DOING OPEN FOR BASIC-LOCKING
	 JRST	OPENG2		; YES, SKIP OVER STUFF FOR NON RMS OPEN
	MOVEI	DW,E.833	;NO - FATAL ERROR
	JRST	OPFAT		;


OPNG1:

;DON'T ALLOW "OPEN EXTEND" FOR ANYTHING BUT SEQUENTIAL FILES.
	TXNN	W1,1B13		;IS THE "EXTEND" BIT ON?
	 JRST	OPENG0		;NO
	LDB	TE,FI.ORG	;FETCH FILE ORGANIZATION
	CAIE	TE,%ACC.S	;SEQUENTIAL?
	 JRST	ENOPNX		;NO, COMPLAIN

OPENG0:	LDB	CH,FI.LCI##	;NEED TO CONVERT LINAGE-COUNTER
	JUMPE	CH,OPENG2	;NO
	PUSHJ	PP,RIFTAG##	;REFERENCE IF TAG
	HRLI	CH,EPJPP	;"PUSHJ PP,"
	PUSHJ	PP,PUTASY	;GENERATE CALL TO INLINE ROUTINE
OPENG2:	LDB	TE,FI.RMS##	;IS THIS AN RMS FILE?
	JUMPN	TE,OPNM		;YES, GO DO IT
	MOVSI	CH,OPN##
	LDB	TE,[POINT 2,W1,14]
	DPB	TE,[POINT 2,CH,14]	;PASS ON OPEN EXTENDED AND REVERSED
OPNGN1:	LDB	TE,[POINT 3,W1,11]
	DPB	TE,[POINT 3,CH,11]
OPNGN3:	PUSHJ	PP,CNVKYB	;SEE IF KEY NEEDS CONVERTING
	PUSHJ	PP,PUTOP
	PUSHJ	PP,CNVKYC	;SEE IF KEY NEEDS CONVERTING BACK
OPNGN4:	LDB	CH,FI.DEB##	;WANT DEBUG CODE FOR THIS FILE?
	JUMPE	CH,CPOPJ	;NO
	MOVEI	CH,DBIO.##	;YES
OPNGN5:	PUSHJ	PP,PUT.PJ	;PUSHJ 17,DBIO. OR DBRD.
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	LDB	CH,[POINT 13,PREVW1##,28] ;GET LINE # OF PREVIOUS OPERATOR
	PUSHJ	PP,PUTASN
	HLRZ	CH,CURFIL
	IORI	CH,AS.FIL	;CONVERT INTO FILTAB ADDRESS
	JRST	PUTASY		;XWD LINE #,FILTAB
SUBTTL	OPEN RMS FILE

OPNM::	MOVEI	TD,V%OPEN	;[1652]SET OPEN VERB
	DPB	TD,O.BOPR	;TELL LIBOL THE OPERATION

	LDB	TE,[POINT 9,W1,8] ;GET GENFIL OP CODE BACK FROM W1
	CAIE	TE,143		;GENFIL OPCODE OF 143 FOR RMS SMU?
	 JRST	OPNM1		; NO
	LDB	TE,FI.ABL##	;APPLY BASIC-LOCKING TO THIS FILE?
	 JUMPE	TE,OPNM1	; NO
	MOVEI	TD,V%OPS5	;SMU OPTION 5 STYLE OPEN
	DPB	TD,O.BOPR	; OPERATION CODE TO PASS TO LSU
	LDB	TD,[POINT 9,W1,17] ;GET BITS FOR SELF, OTHERS, + FLAGS
	DPB	TD,O.SM5B	; AND PUT IN IOFLAGS WORD
	LDB	TD,[POINT 1,W2,17] ;GET UNAVAILABLE FLAG
	MOVSS	TD,TD		; GET IT IN THE LEFT HALF OF THE AC
	IORM	TD,IOFLGS##	; AND PUT IT INTO THE I-O FLAG WORD
	 JRST	OPNM2		;HOP OVER NON-SMU I-O CODE PROCESSING.

OPNM1:

; SET IOFLGS FOR TYPE OF OPEN
	MOVX	TD,OPN%IN	;INPUT
	MOVE	TE,EIOOP	;[1652]GET OPERATOR
	CAIE	TE,SORT##	;[1652]SORT?
	 JRST 	OPNM11		;[1652]NO
	IORM	TD,IOFLGS	;[1652]YES, SET INPUT
	JRST	OPNM2		;[1652]AND CONTINUE
OPNM11:	TXNE	W1,1B10		;[1652] "INPUT"
	IORM	TD,IOFLGS	;SET IN IO FLAGS.
	MOVX	TD,OPN%OU	;OUTPUT
	TXNE	W1,1B9		;"OUTPUT"
	IORM	TD,IOFLGS##	;SET IN IO FLAGS

	MOVX	TD,OPN%IO
	LDB	TE,[POINT 2,W1,10] ;"INPUT" AND "OUTPUT" BITS
	CAIN	TE,3		;BOTH SET?
	IORM	TD,IOFLGS##	;YES, NOW ALL THREE SET IN IOFLGS

	MOVX	TD,OPN%EX	;SET UP OPEN FOR EXTEND BIT
	TXNE	W1,1B13		;EXTEND BIT SET IN FILE FLAG WORD?
	IORM	TD,IOFLGS##	;YES, SET IT IN IO FLAG WORD

REPEAT 0,<
;GET PTR TO KEYS
	PUSHJ	PP,KYPTR	;GET KEY PTR IN EACA
	 POPJ	PP,		;RETURN ON ERRORS

;GENERATE AN "OPEN" ARG LIST:
;	FLAG-BITS,,FILTAB-ADDR
;	        0,,ADDR OF KEY-INFO    NOTE: THIS LINE NOT GENERATED IN V13

	PUSH	PP,EACA		;SAVE ADDR OF KEY-INFO
> ; END REPEAT 0

OPNM2:			;START TO GENERATE THE LITERAL BLOCK.

	MOVE	TE,ELITPC	;SAVE LITERAL PC NOW
	MOVEM	TE,LPCSAV

	MOVE	TA,[XWDLIT,,2]	;START OF LITERAL BLOCK
	PUSHJ	PP,STASHP
	HLLZ	TA,IOFLGS	;GET FLAG BITS
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ	;PUT IT OUT
	HLRZ	TA,CURFIL	;CURRENT FILE
	IORI	TA,AS.FIL	; SAY IN FILTAB

REPEAT 0,<
	PUSHJ	PP,STASHQ	;WRITE IT OUT
	AOS	ELITPC		;BUMP LITERAL PC
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHP	;NEXT WORD
	SETZ	TA,
	PUSHJ	PP,STASHQ	;XWD 0,,
	POP	PP,EACA		; ADDRESS OF KEY INFO
	HRLZ	TA,EACA		;%LIT00
	HRRI	TA,AS.MSC
> ; END REPEAT 0

	PUSHJ	PP,POOLIT	;FINISH UP AND POOL LITERALS
	AOS	ELITPC		;BUMP LITERAL PC

	MOVE	TE,LPCSAV	;IF WE POOLED, RESTORE LITERAL PC
	SKIPE	PLITPC
	 MOVEM	TE,ELITPC
;GENERATE "MOVEI 16,ADDR"
;	"PUSHJ PP,OP.MIX"

	SKIPN	CH,PLITPC	;GET PC IF POOLED
	 MOVE	CH,LPCSAV	;NOT POOLED, GET STARTING PC
	IORI	CH,AS.LIT
	PUSH	PP,CH		;SAVE INCREMENT IN %TEMP
	MOVE	CH,[MOVEI.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	POP	PP,CH		;GET INCREMENT
	PUSHJ	PP,PUTASN	;WRITE IT

	MOVEI	CH,OP.MIX##
	PUSHJ	PP,PUT.PJ

	HLRZ	TA,CURFIL	;CHECK TO SEE IF DEBUGGING WANTED
	ADD	TA,FILLOC	;FOR THIS FILE
	JRST	OPNGN4		;TA: = PTR TO FILTAB ENTRY

;HERE TO GIVE ERROR IF HE SAID "OPEN EXTEND"
ENOPNX:	MOVEI	DW,E.631	;"OPEN EXTEND only allowed for sequential files"
	JRST	OPFAT		;GIVE FATAL ERROR AND POPJ
;GENERATE A "CLOSE"

CLOSGN:	PUSHJ	PP,SETOP
	EQUIT;
	LDB	TE,FI.RMS##	;CHECK FOR RMS FILE
	JUMPN	TE,CLOM		; GO GENERATE THE RMS CLOSE
	MOVSI	CH,CLOS##
	TLNE	W1,(1B13)	;IF 'FOR REMOVAL' BIT ON
	TLO	CH,(1B13)	;PASS IT ON
	TLNN	W1,DELETF	;IF 'DELETE' FLAG NOT UP,
	JRST	OPNGN1		;  THIS IS A STANDARD CLOSE


	MOVSI	CH,PURGE.	;THIS IS A 'CLOSE WITH DELETE'
	JRST	OPNGN3		;SEE IF KEY NEEDS CONVERTING
SUBTTL	RMS CLOSE


CLOM::	MOVEI	TE,V%CLOS	;[1652]TELL LIBOL THIS IS "CLOSE"
	DPB	TE,O.BOPR	;SET LIBOL OPERATION CODE

	MOVX	TE,CLS%CF	;TURN ON "CLOSE" BIT
	IORM	TE,IOFLGS

	MOVX	TE,CLS%LK	;WITH LOCK
	TXNE	W1,1B10
	IORM	TE,IOFLGS	;YES, TURN ON FLAG

	MOVX	TE,CLS%DL	;WITH DELETE
	TXNE	W1,1B12
	IORM	TE,IOFLGS	;YES, TURN ON FLAG

;ARGLIST: FLAG-BITS,,FILTAB-ADDR

	PUSHJ	PP,STDAGL	;STANDARD ARG LIST

;GEN	"PUSHJ PP,CL.MIX"

	MOVEI	CH,CL.MIX##
	PUSHJ	PP,PUT.PJ

	HLRZ	TA,CURFIL	;CHECK TO SEE IF DEBUGGING WANTED
	ADD	TA,FILLOC	;FOR THIS FILE
	JRST	OPNGN4		;TA: = PTR TO FILTAB ENTRY
SUBTTL	STDAGL - WRITE A STANDARD ARG LIST AND MOVEI 16,ADDR

;CALL:	IOFLGS/ IO FLAGS
;	PUSHJ	PP,STDAGL
;	<RETURN HERE>

;CODE GENERATED:
;	MOVEI	16,%LITT
;  . .
;%LITT:	FLAG-BITS,,FILTAB-ADDR

STDAGL:	PUSH	PP,ELITPC	;SAVE CURRENT LIT PC
	PUSHJ	PP,STDW1	;WRITE STD. WORD 1
	PUSHJ	PP,POOL		;POOL THE LITERAL
	SKIPN	PLITPC		;DID WE POOL?
	 AOS	ELITPC		;NO, BUMP LITERAL PC
	POP	PP,CH		;GET STARTING PC
	SKIPE	PLITPC		; IF WE POOLED,
	MOVE	CH,PLITPC	;USE THAT
	IORI	CH,AS.LIT	;MAKE IT LOOK LIKE A LITERAL ADDRESS
	PUSH	PP,CH
	MOVE	CH,[MOVEI.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	POP	PP,CH
	PJRST	PUTASN

;WRITE 1ST STD WORD, DON'T TOUCH ELITPC.
; FORMAT IS XWD FLAGS,FILE-TABLE-ADDRESS
STDW1:	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHP
	HLLZ	TA,IOFLGS
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	HLRZ	TA,CURFIL
	IORI	TA,AS.FIL
	PJRST	STASHQ
SUBTTL	READ

READGN:	PUSHJ	PP,SETOP	;SET UP OPERAND
	EQUIT;			;QUIT IF ERRORS
	LDB	TE,FI.RMS	;RMS FILE?
	JUMPN	TE,READM	;YES
	MOVEI	CH,READ##
	LDB	TE,FI.ORG	;[1412] GET FILE ORGANIZATION
	CAIE	TE,%ACC.I	;[1412] IS IT INDEXED?
	 JRST	RDGNX		;[1412] NO,
	LDB	TE,FI.FAM	;[1412] YES, CHECK ACCESS MODE.
	CAIE	TE,%FAM.S	;[1412] IF SEQUENTIAL, JUST DO READ NEXT.
RDGNX:				;[1412] OTHERWISE DO CHECK FOR READ NEXT.
	TLNE	W1,(1B10)	;READ NEXT?
	MOVEI	CH,RDNXT.##	;YES
	MOVEM	CH,EIOOP
	PUSHJ	PP,VLTST	;[605] TEST FOR VARIABLE LENGTH

RDGN0:	SETZM	EINTO		;CLEAR "INTO" INDICATION
	TLNN	W1,INTO		;"INTO" OPTION FOR THIS READ?
	JRST	RDGN1		;NO

	PUSHJ	PP,LARGE	;YES--FIND LARGEST DATA RECORD FOR THIS FILE
	PUSHJ	PP,INTOOK	;SEE IF "INTO" OK
	 JRST	RDGN9		;NO, GO COMPLAIN
	PUSHJ	PP,INTOCK	;SEE IF INTO IS ALLOWED
RDGN1:	HRRZ	CH,EIOOP	;17-AUG-79 /DAW	DON'T ALLOW DELETE FOR SEQ. FILE
	CAIE	CH,DELETE##
	JRST	RDGN1A		;NOT DELETE, OK

	MOVE	TA,CURFIL	;FIND ACCESS MODE FOR FILE
	LDB	TD,FI.ORG
	JUMPN	TD,RDGN1A	;DELETE IS OK
	MOVEI	DW,E.729	;"DELETE NOT ALLOWED FOR SEQ FILES"
	PUSHJ	PP,OPFAT

RDGN1A:	MOVS	CH,EIOOP
	PUSHJ	PP,CNVKYB	;SEE IF KEY NEEDS CONVERTING
	PUSHJ	PP,PUTOP
	PUSHJ	PP,CNVKYA	;SEE IF KEY NEEDS CONVERTING BACK
;"READ" (CONT'D)

;CHECK TO SEE THAT THE NEXT OPERATOR IS "SPIF"

	PUSHJ	PP,RDGN10	;READ UP THRU NEXT OPERATOR
	CAIN	TE,SPIF.	;IS IT SPIF.?
	TLNN	W1,ATINVK	;AND SOME KIND OF AT-END/INVALID-KEY ?
	JRST	RDGN5		;NO

	LDB	TE,FI.FAM##	;GET ACCESS MODE
	JRST	@[EXP RDGN2,RDGN2,RDGN3D,RDGN3D](TE)

RDGN3D:	MOVE	TE,EIOOP	;GET LAST OPERATOR
	CAIE	TE,RDNXT.	;READ NEXT IS SEQUENTIAL
	JRST	RDGN3		;RANDOM
				;SEQUENTIAL

RDGN2:	TLNE	W1,ATEND	;YES--IS SPIF "AT END"?
	JRST	SPIF74		;YES--DO IT

	MOVEI	DW,E.208	;NO--TROUBLE
	JRST	RDGN4

RDGN3:	TLNE	W1,INVKEY	;IT'S RANDOM FILE--IS SPIF "INVALID KEY"?
	JRST	SPIF74		;YES--DO IT
	MOVEI	DW,E.209	;NO--TROUBLE
RDGN4:	LDB	CP,W1CP
	LDB	LN,W1LN
	PUSHJ	PP,WARN
	JRST	SPIFGC

RDGN5:	CAIE	TE,NOOP.##	;DUMMY TO MAKE READ HAPPY?
	JRST	RDGN6		;NO
	MOVE	TE,EIOOP	;
	CAIE	TE,DELETE	;IF DELETE <FILE-NAME>
	JRST	RDGN5A		;NOT
	LDB	TE,FI.FAM	;GET ACCESS
	CAIG	TE,%FAM.S	;IF SEQUENTIAL
	JRST	NOOPGN		;GENERATE A NOOP SINCE INVALID KEY NOT ALLOWED
RDGN5A:	LDB	TA,FI.ERR##	;SEE IF THERE IS A FILE SPECIFIC ERROR PROCEDURE
	JUMPE	TA,[SKIPN TB,USP.I##	;NO, SEE IF GENERAL USE PROCEDURE
		SKIPE	TB,USP.IO##	;OR FOR I-O
		JRST	RDGN5C		;OK, USE IT
		JRST	RDGN6A]		;NO, GIVE ERROR RETURN
RDGN5B:	LDB	TB,LNKCOD
	CAIE	TB,CD.PRO
	JRST	RDGN6A		;NOT A PROTAB LINK
	PUSHJ	PP,LNKSET	;GET PROTAB
	MOVE	TB,PR.DUP##(TA)	;GET PR.SFI AND PR.DEB
	MOVE	TE,EIOOP	;GET I/O OPERATOR
RDGN5C:	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	MOVE	CH,[JRST.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZI	CH,AS.DOT+2
	TLNE	TB,-1		;IF DEBUGGING ON PROCEDURE-NAME?
	ADDI	CH,3		;WE NEED MORE SPACE
	MOVE	TE,EIOOP
	CAIN	TE,DELETE
	TDZA	TE,TE		;DON'T DEBUG ON DELETE OR
	LDB	TE,FI.DEB	;ARE WE DUBUGGING ON FILE-NAME?
	SKIPE	TE
	ADDI	CH,1		;YES, NEED JUMP AROUND SPIF. CODE
	PUSHJ	PP,PUTASN	;OK RETURN
	TLNN	TB,-1		;IF NOT DEBUGGING?
	JRST	RDGN5D		;DON'T GENERATE SPECIAL CODE

	PUSHJ	PP,IODBU	;GENERATE SOME CODE

	MOVE	TE,EIOOP
	CAIN	TE,DELETE
	TDZA	CH,CH
	LDB	CH,FI.DEB	;DO WE NEED DEBUGGING CODE?
	JUMPE	CH,RDGN5D	;NO
	MOVE	CH,TB		;GET TAG
	HRLI	CH,EPJPP	;PUSHJ PP,
	PUSHJ	PP,PUTASY##	;EOF RETURN
	MOVE	CH,[JRST.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.DOT+3
	PUSHJ	PP,PUTASN
	PUSHJ	PP,RDGN5E
	PUSHJ	PP,CRHLD	;CREATE HLDTAB ENTRY
	JRST	ENDIFR##	;SEE IF READ INTO

RDGN5D:	MOVE	CH,TB		;GET TAG
	HRLI	CH,EPJPP	;PUSHJ PP,
	PUSHJ	PP,PUTASY##	;EOF RETURN
	PUSHJ	PP,CRHLD	;CREATE HLDTAB ENTRY
	JRST	ENDIFR##	;SEE IF READ INTO

RDGN5E:	MOVE	TE,EIOOP	;SEE WHAT IT WAS
	CAIE	TE,READ
	CAIN	TE,RDNXT.
	JRST	[MOVEI	CH,DBRD.##	;READ IS SPECIAL
		JRST	OPNGN5]		;AS DEBUG HAS MORE TO DO
	JRST	OPNGN4		;PUT OUT DBIO. CODE
;READ WAS NOT FOLLOWED BY A "SPIF" OF CORRECT TYPE
;CHECK FOR USE ERROR PROCEDURE AND IF GIVEN USE IT

RDGN6:	MOVE	TA,CURFIL
	LDB	TE,FI.ENT##	;IS USE PROCEDURE FOR OPEN
	JUMPN	TE,RDGN6A	;YES, GIVE ERROR
	LDB	TA,FI.ERR##	;ERROR USE GIVEN
	JUMPN	TA,RDGN5B	;YES, OUTPUT IT
RDGN6A:	MOVE	TA,CURFIL
	MOVEI	DW,E.318	;ASSUME FILE IS SEQUENTIAL
	LDB	TE,FI.ORG	;IF FILE IS NOT
	SKIPE	TE		;  SEQUENTIAL
	MOVEI	DW,E.319	;  USE 'INVALID KEY REQUIRED'

RDGN7:	MOVE	TC,OPLINE
	LDB	CP,TCCP
	LDB	LN,TCLN
	PUSHJ	PP,FATAL
	CAIN	W2,NOOP.	;IF NOOP.,
	  POPJ	PP,		; SKIP IT
	JRST	GO2NXT		;GO TO NEXT OPERATOR ACTION

;NOT ENOUGH OPERANDS FOR "READ INTO"
RDGN9:	SETZM	EINTO
	JRST	BADEOP


;READ UP THRU NEXT OPERATOR

RDGN10:	MOVE	EACA,EOPLOC	;RESET
	MOVEM	EACA,EOPNXT	;  EOPTAB
	SETZB	EACC,ETEMPC	;MORE RESETS
	PUSHJ	PP,READEM	;DO THE READ
	HRRZ	TE,W2		;PICK UP OPERATOR CODE
	MOVE	TA,CURFIL	;SET 'TA' TO CURRENT FILE
	POPJ	PP,
;SEE IF DEBUGGING CODE IS NEEDED AFTER CALL TO SPIF.

SPIF74:	LDB	TD,FI.DEB	;DEBUGGING ON FILE-NAME
	JUMPE	TD,SPIFGC	;NO
	MOVE	TE,PREVW1	;YES, GET LINE # OF PREVIOUS OPERATOR
	MOVEM	TE,DBSPIF+1	;SAVE LINE NUMBER
	MOVE	TE,EIOOP	;CURRENT OPERATOR
	HLLZ	TD,CURFIL	;GET FILE-TABLE
	HRRI	TD,DBIO.	;ROUTINE TO USE
	CAIE	TE,READ		;UNLESS READ
	CAIN	TE,RDNXT.	;OR READ NEXT
	HRRI	TD,DBRD.	;IN WHICH CASE WE NEED DBRD.
	MOVEM	TD,DBSPIF##	;FLAG TO BE DONE AFTER SPIF.
	JRST	SPIFGC

SPIFGC:	PUSHJ	PP,CRHLD	;CREATE HLDTAB ENTRY FOR "ENDIFG"
	JRST	SPIFGN		;GO TO IFGEN TO GENERATE THE INITIAL "JRST"
SUBTTL	RMS READ

READM::	MOVEI	TE,V%READ	;[1652]TELL LIBOL THIS IS A "READ"
	DPB	TE,O.BOPR	; . .

	MOVX	TE,RD%NXT	;GET BIT TO SET
	MOVE	TA,CURFIL
	LDB	TD,FI.FAM	;IF SEQ. ACCESS, TURN THE BIT ON
	CAIE	TD,%FAM.S
	TXNE	W1,1B10		; SHALL WE?
	IORM	TE,IOFLGS	;YES

;CHECK FOR VARIABLE LENGTH RECORDS WHERE THE DEPENDING ITEM
;IS NOT PART OF THE RECORD ITSELF
;.. SET UP "EDEPFT" FOR IFGEN IF IT IS.
	PUSHJ	PP,VLTST

;CHECK FOR "READ .. KEY IS .."
;COBOLD HAS ONLY ALLOWED THIS SYNTAX WHEN:
;1) FILE ORGANIZATION IS INDEXED
;2) FILE ACCESS IS NOT SEQUENTIAL
;3) "READ NEXT" HAS NOT BEEN SPECIFIED

	SETZM	KEYREF##	;CLEAR "KEY OF REFERENCE"
	TXNN	W1,1B11		;"KEY IS"?
	 JRST	RDM0		;NO

;FIND THE OPERAND, GET KEY OF REFERENCE (WHICH WILL BE 2ND WORD),
; THEN BLT DOWN THE REST OF THE OPERANDS AS IF "KEY IS" WAS THE SECOND
; ONE GIVEN.  (THIS IS BECAUSE COBOLD HAS PROCESSED THE OPERANDS IN
; ANY ORDER).
	MOVE	TC,OPERND	;GO GET OPERAND
	MOVEM	TC,CUREOP
RDM00:	PUSHJ	PP,BMPEOP
	 POPJ	PP,		;ERRORS.. RETURN
	MOVE	TC,CUREOP	;POINT TO CURRENT OPERAND (-1 + KEY)
	MOVE	TD,0(TC)	;IS THIS THE ONE?
	CAME	TD,[-1]
	 JRST	RDM00		;NO, GO LOOK FOR IT
	MOVE	TD,1(TC)	;GET KEY OF REFERENCE
	MOVEM	TD,KEYREF##	;STORE AWAY

	HRRZ	TE,EOPNXT	;COPY REST OF OPERANDS DOWN
	SUBI	TE,2		;TO HERE
	HRRZ	TD,OPERND	;FROM HERE
	SUB	TD,TE		;GET -# WORDS
	HRLI	TE,-1		;PREVENT "PUSHDOWN OVERFLOW"
	AOJE	TD,RDM0		;JUMP IF NO MORE OPERANDS TO POP
	POP	TE,2(TE)	;COPY OPERAND
	JRST	.-2		;LOOP
;CHECK FOR "READ INTO"
RDM0:	SETZM	EINTO		;CLEAR "INTO" INDICATOR
	MOVE	TE,EIOOP	;[1652]CHECK FOR SORT
	CAIE	TE,SORT##	;[1652]
	TLNN	W1,INTO		;"INTO" OPTION FOR THIS READ?
	 JRST	RDM1		;[1652]NOT INTO, OR SORT

	PUSHJ	PP,LARGE	;INTO--FIND LARGEST DATA RECORD FOR THIS FILE
	SKIPE	KEYREF		;SKIP IF NO KEY OF REFERENCE ITEM
	 JRST	[PUSHJ	PP,INTOK1	;THERE IS ANOTHER OPERAND TO WORRY ABOUT
		  JRST	RDGN9		;NOT SUFFICIENT
		JRST	RDM0A]		;OK
	PUSHJ	PP,INTOOK	; SEE IF "INTO" IS OK
	 JRST	RDGN9		;NO, COMPLAIN
RDM0A:	PUSHJ	PP,INTOCK	;SEE IF INTO IS ALLOWED

;;AT THIS POINT WE ARE DONE READING ALL OPERANDS FOR THE "READ".
; WE WILL READ AHEAD TO SEE IF AN INVALID KEY/AT END CLAUSE IS
; PRESENT

RDM1:
	PUSHJ	PP,CNVKYB	;CHECK IF GENERATE KEY CONVERSION ROUTINE
	PUSHJ	PP,RDGN10	;READ UP THRU NEXT OPERATOR
	CAIN	TE,SPIF.	;IS IT SPIF.?
	TLNN	W1,ATINVK	;AND SOME KIND OF AT END/INVALID KEY?
	 JRST	RDM7		;NO

;A SPIF. IS THERE. MAKE SURE IT IS THE PROPER TYPE.
	MOVE	TD,IOFLGS	;GET FLAGS FOR THE READ
	TXNN	TD,RD%NXT	;SKIP IF A "READ NEXT"
	 JRST	RDM5		;NO

;READ NEXT.. AT END
	TLNE	W1,ATEND	;AT END?
	 JRST	RDM6		;YES, GO DO IT

	MOVEI	DW,E.208	;NO, GIVE ERROR
	JRST	RDM5A

RDM5:	TLNE	W1,INVKEY	;"INVALID KEY"
	 JRST	RDM6		;YES, GO DO IT

	MOVEI	DW,E.209	;NO, GIVE ERROR
RDM5A:	PUSHJ	PP,OPWRN	;SOMETHING ASSUMED..
	JRST	RDM6		;GO DO IT

;HERE IF NO SPIF AFTER THE READ.. CHECK FOR "USE" PROCEDURE
; AND GIVE ERROR IF THERE IS NONE.
RDM7:	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	LDB	TE,FI.ENT##	;IS USE PROCEDURE FOR OPEN
	JUMPN	TE,RDM6A	;YES, GIVE ERROR
	LDB	TA,FI.ERR##	;ERROR USE GIVEN
	JUMPN	TA,RDM7A	;YES, GO OUTPUT IT
	SKIPN	TB,USP.I##	;NO, SEE IF A GENERAL USE PROCEDURE
	SKIPE	TB,USP.IO##	; OR FOR I-O
	 JRST	RDM7A		;YES, USE IT
	MOVE	TE,EIOOP	;[1652]GET OPERATOR
	CAIN	TE,SORT##	;[1652]IS IT SORT
	  JRST	RDM7A		;[1652]YES

;NO VALID "USE" PROCEDURE AND "INVALID KEY" OR "AT END" NOT GIVEN.
; THIS IS AN ERROR.
RDM6A:	MOVEI	DW,E.129	;"AT END" OR "INVALID KEY" CLAUSE MISSING
	JRST	RDGN7		;GO GIVE ERROR

RDM7A:	MOVX	TE,RD%NIK	;SET "NO AT END RETURN"
	IORM	TE,IOFLGS	;SET THE FLAG

RDM6:	MOVE	TE,IOFLGS	;GET IO FLAGS
	TXNE	TE,RD%NXT	;READ NEXT?
	 JRST	RDM2		;NO, ONE-WORD ARG LIST
	SKIPE	KEYREF		;DO WE HAVE A KEY OF REFERENCE?
	MOVX	TE,RD%KRF	;YES, SAY "KEY OF REFERENCE GIVEN"
	IORM	TE,IOFLGS

;GET OCTAL ADDRESS OF KEY, AND PUT IN ADRKEY
	HLRZ	TA,CURFIL	;POINT TO CURRENT FILE
	ADD	TA,FILLOC
	MOVE	TE,KEYREF	;GET KEY OF REFERENCE
	CAILE	TE,1		;SKIP IF PRIMARY KEY, OR NONE GIVEN
	 JRST	RDM1A		;ALTERNATE KEY
	LDB	TA,FI.RKY	;GET RECORD KEY DATANAME
	PUSHJ	PP,UKADR	; GET KEY ADDRESS, AND USE IT
	JRST	RDM1B

;ALTERNATE KEY - FIND A KEY BUFFER ADDRESS
RDM1A:	LDB	TA,FI.ALK##	;FIND POINTER TO FIRST ALTERNATE KEY
	ADD	TA,AKTLOC	;GET ABS POINTER
	SUBI	TE,2		;TE= OFFSET INTO AKTTAB
	IMULI	TE,SZ.AKT	; # SIZE OF ENTRY = OFFSET TO FIRST WORD
	ADD	TA,TE		;TA POINTS TO ENTRY NOW
	LDB	TA,AK.DLK	;GET DATANAME LINK
	PUSHJ	PP,UKADR	; GET KEY ADDRESS, AND USE IT

;"KEYADR" HAS NOW BEEN SET UP
RDM1B:	EQUIT;			;QUIT IF ERRORS SO FAR
	PUSH	PP,ELITPC	;SAVE STARTING LITERAL PC
	PUSHJ	PP,STDW1	;WRITE STD WORD 1
	AOS	ELITPC		;BUMP LITERAL PC

;WRITE KEY OF REF,,ADDR OF KEY
	MOVE	TA,[XWDLIT,,2]	;WRITE THE STUFF
	PUSHJ	PP,STASHP
	MOVE	TA,KEYREF
	SKIPE	TA		;WRITE 0 IF NONE GIVEN
	SUBI	TA,1		;MAKE PRIMARY=0, ETC.
	PUSHJ	PP,STASHQ	;XWD KEYREF,
	MOVE	TA,KEYADR##	;GET KEY ADDRESS
	PUSHJ	PP,POOLIT	;FINISH XWD, AND LITERAL POOL

	MOVE	CH,[MOVEI.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY	;START MOVEI OF ARG LIST INST.
	POP	PP,CH		;GET OLD LITERAL PC
	SKIPN	PLITPC		;DID WE POOL?
	AOSA	ELITPC		;NO, BUMP LITERAL PC
	MOVEM	CH,ELITPC	;YES, RESTORE ORIGINAL
	SKIPE	PLITPC		;SKIP IF WE DIDN'T
	MOVE	CH,PLITPC	;GET THE POOLED VALUE
	IORI	CH,AS.LIT	; MAKE IT LOOK LIKE A LITERAL
	PUSHJ	PP,PUTASN	;FINISH ARG
	JRST	RDM3		;NOW GO GENERATE THE PUSHJ

;GENERATE THE "READ NEXT" ARG LIST AND MOVEI 16,%LIT
RDM2:	PUSHJ	PP,STDAGL	;STANDARD ARG LIST

;DECIDE WHICH ROUTINE TO CALL, BASED ON THE ACCESS MODE
RDM3:	MOVEI	CH,RD.MIR##	;ASSUME RANDOM
	MOVE	TE,IOFLGS	;SEE IF READ NEXT
	TXNE	TE,RD%NXT
	MOVEI	CH,RD.MIS##	;YES, SEQUENTIAL ACCESS
RDM4:
	MOVE	TE,EIOOP	;[1652]GET OPERATOR
	CAIN	TE,SORT##	;[1652]IS IT SORT?
	  MOVEI	CH,RD.MIS##	;[1652]ALWAYS READ SEQ.
	PUSHJ	PP,PUT.PJ	;GENERATE CALL
	PUSHJ	PP,CNVKYA	;CHECK IF GENERATE KEY CONVERSION ROUTINES
	MOVE	TE,EIOOP	;[1652]GET OPERATOR
	CAIN	TE,SORT##	;[1652]IS IT SORT?
	 POPJ	PP,		;[1652]YES, LET'S LEAVE.
	MOVE	TE,IOFLGS	;DO WE HAVE A SPIF. WAITING?
	TXNE	TE,RD%NIK
	 JRST	RDMNSP		;NO
	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	LDB	TD,FI.DEB	;DEBUGGING ON FILE-NAME?
	JUMPE	TD,SPIFGC	;NO
	MOVEM	W1,DBSPIF+1	;YES, SAVE LINE NUMBER
	HLLZ	TD,CURFIL	;GET FILE-TABLE NUMBER
	HRRI	TD,DBRD.	;ROUTINE TO USE
	MOVEM	TD,DBSPIF##	;FLAG TO BE DONE AFTER SPIF.
	JRST	SPIFGC

;READ HAD NO SPECIAL "IF" - CALL THE ERROR USE PROCEDURE
RDMNSP:	HLRZ	TA,CURFIL	;SET UP "TA" THE WAY RDGN5A EXPECTS IT
	ADD	TA,FILLOC
	JRST	RDGN5A		;GO REJOIN OLD CODE
SUBTTL	CRHLD - CREATE HLDTAB ENTRY FOR READ

; CRHLD creates a HLDTAB entry for every "SPIF" seen. See
;comments in IFGEN at ENDIFG to see how it is used.
;
;Input parameters:
;	EINTO - if non-zero, "into" operand is stored
;	EDEPFT - variable length read information
;[74]	DBSPIF - debugging code
;
;Output parameters:
;	-NONE-

CRHLD:	MOVSI	TA,CD.HLD	;HLDTAB CODE
	HRRI	TA,.HESIZ	;SIZE OF ENTRY NEEDED
	PUSHJ	PP,GETENT##	;RETURNS ADDRESS IN TA
	MOVE	TD,PTRHLD##	;GET PREVIOUS POINTER
	HLRZM	TA,PTRHLD##	;STORE NEW PTR
	MOVEM	TD,.HEHDR(TA)	;SAVE OLD PTR IN NEW ENTRY

;Store information in the entry
	SKIPN	EINTO		;READ..INTO OR RETURN..INTO?
	 JRST	CRHLD1		;NO
	MOVX	TB,HE%RIN	;SET FLAG
	IORM	TB,PTRHLD	; IN PTRHLD
	HRLI	TB,EINTO	;COPY FROM HERE..
	HRRI	TB,.HERIN(TA)	; TO HERE
	MOVEI	TC,.HERIN(TA)	; FIND LAST LOCATION
	ADDI	TC,OPNSIZ+OPNMAX
	BLT	TB,-1(TC)	;COPY THE TWO OPERANDS..
	SETZM	EINTO		;CLEAR FLAG
CRHLD1:	SKIPN	TE,EDEPFT	;READ... VARIABLE LENGTH RECORD?
	 JRST	CRHLD2		;NO
	MOVX	TB,HE%VLR	;SET THE FLAG
	IORM	TB,PTRHLD	; IN PTRHLD
	MOVEM	TE,.HEVLR(TA)	;STORE THE WORD IN HLDTAB ENTRY
	SETZM	EDEPFT		;CLEAR FLAG
CRHLD2:	SKIPN	TE,DBSPIF	;SPECIAL-IF CODE?
	 JRST	CRHLD3		;NO
	MOVX	TB,HE%DEB	;SET THE FLAG
	IORM	TB,PTRHLD	; IN PTRHLD
	MOVEM	TE,.HEDEB(TA)	;STORE THE WORD IN HLDTAB ENTRY
	SETZM	DBSPIF		;CLEAR FLAG
CRHLD3:	POPJ	PP,		;RETURN NOW
SUBTTL	INTOOK - SEE IF "INTO" CLAUSE IS OK

;THIS ROUTINE SKIPS IF # OPERANDS FOR "INTO" IS SUFFICIENT
; IF OK, STORE IN EINTO

INTOOK:	HRRZ	TA,EOPLOC
	ADDI	TA,1		;LOCATION OF 1ST OPERAND
	HRRZ	TE,EOPNXT
	SUBI	TE,2(TA)	;TOTAL NUMBER OF SPARE WORDS
	JUMPL	TE,CPOPJ	;BETTER BE AT LEAST ONE MORE OPERAND
	HRLI	TD,2(TA)	;FROM HERE..
	PUSHJ	PP,INTOCP	;COPY OPERAND
	JRST	CPOPJ1		;SKIP RETURN

;SAME AS ABOVE, BUT ACCOUNTS FOR AN OPERAND BEFORE THE REST.
INTOK1:	MOVE	TA,OPERND
	HRRZ	TE,EOPNXT
	SUBI	TE,4(TA)	;TWO OPERANDS, EACH TWO WORDS
	JUMPL	TE,CPOPJ	;THERE BETTER BE MORE..
	HRLI	TD,4(TA)	;START AT THE 3RD OPERAND
	PUSHJ	PP,INTOCP	;COPY OPERAND
	JRST	CPOPJ1		;SKIP RETURN

;COPY OPERAND TO EINTO
; TE/ # WORDS TO COPY - 1
; TD/ ADDRESS TO START AT,,XXX

INTOCP:	ADDI	TE,EINTO+3	;TE= FINAL ADDRESS
	HRRI	TD,EINTO+2	;COPY TO HERE
	BLT	TD,(TE)		;COPY OPERAND TO HLDTAB
	POPJ	PP,		;RETURN
SUBTTL	REWRITE -- WRITE

REWGEN:	PUSHJ	PP,SETOP	;SET UP OPERAND
	EQUIT;			;QUIT IF ERRORS
	MOVEI	CH,RERIT.
	JRST	RITGN0

;SUBTTL	WRITE

RITEGN:	PUSHJ	PP,SETOP	;SET UP OPERAND
	EQUIT;			;QUIT IF ERRORS
	MOVEI	CH,WRITE##	;SET UP 'WRITE' UUO
RITGN0:	MOVEM	CH,EIOOP

RITG00:	MOVE	TE,CURFIL	;OPERAND IS ACTUALLY
	MOVEM	TE,CURDAT	;  A RECORD-NAME
	PUSHJ	PP,GTFATH	;SET UP "FT"
	EQUIT
	MOVE	TA,CURFIL
	LDB	TE,FI.RMS	;RMS BIT SET?
	JUMPN	TE,WRTM		;YES, GO GENERATE THE CODE
	MOVE	TA,CURDAT
	LDB	TE,DA.EXS	;GET RECORD SIZE
REPEAT 0,<
;EDIT 512 WAS ADDED TO WRITE OUT ONLY 1 WORD FOR A 1-WORD COMP RECORD.
; IF THE KEY WAS S9(10), COBOL TREATED THIS AS 10 CHARACTERS, WHICH
; TRANSLATED TO 2 WORDS IN CBLIO.
;
;  THIS IS REMOVED IN VERSION 12 FIELD TEST BECAUSE SOMEONE FOUND THAT
;THIS MAKES IT INCOMPATIBLE WITH READ. FIXING "READ" IS NOT A GOOD IDEA
;BECAUSE THAT MAKES IT INCOMPATIBLE WITH FILES WRITTEN BEFORE VERSION 12.
;THEREFORE, THE OLD CODE HAS BEEN RESTORED.
	LDB	TB,DA.USG	;[512] GET USAGE
	SKIPE	EBCMP3##	;[512] DO WE HAVE   /X
	JRST	RITG10		;[512] YES- CHECK FOR COMP
	CAIN	TB,SIXLIT##	;[512] IS IT 1-WORD COMP?
	MOVEI	TE,6		;[512] YES-USE SIZE OF SIX CHARS
	CAIN	TB,FPMODE	;[512] IS IT 2-WORD COMP?
	MOVEI	TE,12		;[512] YES - USE SIZE OF 12 CHARS
RITG1B:
>;END REPEAT 0 FOR EDIT 512
	MOVEM	TE,ERECSZ	;SAVE IT

	SETZM	WDPITM		;ASSUME NO DEPENDING ITEM
	MOVE	TA,CURFIL
	LDB	TE,FI.DEP##	;VARIABLE RECORD DEPENDING ON ITEM?
	JUMPN	TE,RITG1A	;YES, THEN ITS VARIABLE FORMAT
	HLRZ	TA,CURDAT	;NO, CHECK FOR DEPENDING VARIABLES
	HRRZM	TA,ETABLA##	; SO WE CAN DO A VARIABLE LENGTH WRITE
	PUSHJ	PP,DEPTSA##	;SKIP IF WE HAVE ONE
	 JRST	RITG1C		;NO
	HRRZ	TE,ETABLA	; YES--SAVE LINK
RITG1A:	HRRZM	TE,WDPITM	;SAVE 0,,LINK

RITG1C:	TLNN	W1,FROM
	JRST	RITGN1

	MOVE	TC,OPERND	;GET RECORD TABLE-LINK
	MOVEI	TA,2(TC)	;GET "FROM" DATA-NAME
	MOVEM	TA,CUREOP
	PUSH	PP,CURDAT	;SAVE CURRENT DATAB
	SETOM	EDEBDA##	;SEE IF DEBUGGING WANTED
	PUSHJ	PP,MOVGN.	;GENERATE MOVE
	PUSHJ	PP,GDEBA##	;GENERATE DEBUGING CODE IF REQUIRED
	POP	PP,TA		;NEED TO RESTORE CURDAT
	MOVEM	TA,CURDAT	; SINCE MOVGN. MIGHT DESTROY IT
	HLRZ	TA,TA		;  IF SUBSCRIPTED
	PUSHJ	PP,LNKSET	;HOWEVER MAKE SURE TABLES HAVE NOT MOVED
	HRRM	TA,CURDAT	; SINCE BEFORE CALL TO MOVGEN

RITGN1:	MOVE	TA,CURDAT	;GET RECORD NAME
	MOVEI	LN,EBASEA	;POINT TO "A" DATA BLOCK
	SETOM	EDEBDA##	;SEE IF DEBUGGING WANTED
	PUSHJ	PP,TSDEBA	; ...
	PUSHJ	PP,GDEBA##	;GENERATE DEBUGING CODE IF REQUIRED
	MOVE	TA,CURFIL
	LDB	TD,FI.ORG
	MOVE	TE,EIOOP	;GET VERB BACK

	JUMPE	TD,RITG1E	;IF SEQUENTIAL, WE CAN HAVE ADVANCING
	TLNN	W1,ADVANC	;IS THERE AN ADVANCING CLAUSE?
	JRST	RITGN2		;NO ADVANCING

	MOVEI	DW,E.372	;'ADVANCING ILLEGAL'
	PUSHJ	PP,OPFAT
	JRST	RITGN3

RITG1E:	TLNE	W1,ADVANC!POSTNG	;"ADVANCING" OR "POSITIONING" OPTION.
	JRST	WADVGN		;YES
	CAIE	TE,WRITE	;IF ITS DELETE OR REWRITE
	JRST	RITGN2		;DON'T SET WADV. BY MISTAKE
	LDB	TB,FI.ERM	;GET EXTERNAL RECORDING MODE
	CAIE	TB,%RM.SA	; [407] IF NOT STD ASCII
	CAIN	TB,%RM.7B	; [407] OR ASCII
	CAIN	TE,%ACC.I	;  OR ACCESS MODE IS INDEXED,
	JRST	RITGN2		;  USE NORMAL WRITE
	HRLOI	TC,(1B12)	;SAY "DEFAULT ADVANCING"
				;BY SETTING "THIS IS AN ADDRESS"
				; AND VALUE = -1
	TLO	W1,AFTER	;"AFTER"
	JRST	WADVG5
;"WRITE" GENERATOR  (CONT'D).

; NO ADVANCING

;PUT OUT 'WRITE', 'REWRITE', OR 'DELETE'

RITGN2:	HRLZ	CH,EIOOP	;GET OP-CODE
	PUSHJ	PP,CNVKYB	;SEE IF KEY NEEDS CONVERTING
	MOVE	TE,EIOOP	;[1101] IF THIS IS NOT A WRITE
	CAIE	TE,WRITE##	;[1101] SKIP OVER
	JRST	RITG2C		;[1101] VARIABLE RECORD CODE
	SKIPE	TE,WDPITM##	;DEPENDING VARIABLE OPTION?
	TRNN	TE,-1		;ARE WE SURE?
	 JRST	RITG2C		;NO
	TLNE	TE,-1		; HAVE TO PRESERVE %PARAM+0?
	SETOM	SAVPR0##	;YES, TELL SZDPVA
	HRRZM	TE,ETABLA	;LOOK FOR LINK IN ETABLA
	HRRZ	TE,EOPLOC	;[1107] POINT TO THE RECORD OPERAND
	ADDI	TE,1		;[1107] IN CASE OF ERROR
	HRLM	TE,OPERND	;[1107] "A" OPERAND
	MOVEI	TE,15		; LOAD SIZE IN RUNTIME AC 15
	PUSHJ	PP,SZDPVR	;SEE WHICH KIND OF VARIABLE LENGTH
	 JRST	DPPER1		;?ERRORS

;PUT OUT "MOVEI AC16,LIT"
;	PUSHJ	PP,WRITV.##

	HLRZ	CH,CURFIL
	ANDI	CH,LMASKB
	IORI	CH,AS.FIL
	HRLI	CH,MOVEI.##+AC16
	PUSHJ	PP,PUTASY

	MOVEI	CH,WRITV.##
	PUSHJ	PP,PUT.PJ
	JRST	PUTXDD		;GO PUT OUT XWD FOLLOWING

; THIS SHOULD NEVER HAPPEN
DPPEMS:	ASCIZ/%IOGEN -- problem with depending variable, ignored
/
DPPER1:	TYPE	DPPEMS		;% PROBLEM WITH DEPENDING VARIABLE--IGNORED
;	JRST	RITG2C

RITG2C:	PUSHJ	PP,PUTOP	;SET UP AND WRITE OPERATOR

PUTXDD:	SETZM	WDPITM##	;CLEAR DEPENDING ITEM FLAG
	MOVE	CH,[XWD AS.XWD,1]	;PUT OUT XWD
	PUSHJ	PP,PUTASY
	MOVE	CH,ERECSZ	;PUT RECORD SIZE IN
	ROT	CH,-14		;  BITS 0-11
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTASN
	HRRZI	CH,0		;ZERO FOR RIGHT HALF
	PUSHJ	PP,PUTASN
	PUSHJ	PP,CNVKYA	;SEE IF KEY NEEDS CONVERTING BACK
;IF FILE IS RANDOM OR ISAM--"INVALID KEY" REQUIRED

RITGN3:	SETZM	WDPITM##	;CLEAR DEPENDING ITEM
	PUSHJ	PP,RDGN10	;READ UP THRU NEXT OPERATOR
	CAIE	TE,SPIF.
	JRST	RITGN5

;REWRITE WITH FILE ACCESS MODE OF SEQUENTIAL IS NOT ALLOWED TO
; HAVE AN INVALID KEY CLAUSE.
	MOVE	TE,EIOOP
	CAIE	TE,RERIT.	;IS THIS REWRITE?
	 JRST	RITGN4		;NO
	LDB	TE,FI.FAM	;GET FILE ACCESS MODE
	CAIE	TE,%FAM.S	;SEQUENTIAL?
	 JRST	RITGN4		;NO
	LDB	TE,FI.ORG	;UNLESS IT'S INDEXED
	CAIE	TE,%ACC.I
	 JRST	RITGN6		;RELATIVE--"Invalid key not allowed"
RITGN4:	LDB	TE,FI.ORG
	TLNN	W1,INVKEY
	JRST	RITGN7

;"INVALID KEY" FOUND

	JUMPN	TE,SPIFGC	;IF NOT SEQ, ALL OK

RITGN6:	MOVEI	DW,E.320	;"INV KEY NOT ALLOWED"
	JRST	RDGN7

;"AT END" FOUND

RITGN7:	JUMPN	TE,RITGN8	;FILE NOT SEQ.
	TLNE	W1,ATEOP##	;END OF PAGE?
	 JRST	SPIFGC		;YES
	MOVEI	DW,E.320	;"This conditional not allowed for SEQUENTIAL files"
	JRST	RDGN7

RITGN8:	MOVEI	DW,E.319	;"INV KEY REQUIRED"
	JRST	RDGN7

;NO "SPIF" OF ANY KIND FOUND
;[74] CHECK FOR ERROR USE PROCEDURE AND IF GIVEN USE IT

RITGN5:	MOVE	TE,EIOOP	;IS THIS A REWRITE?
	CAIE	TE,RERIT.
	 JRST	RTGN5A		;NO
	LDB	TE,FI.ORG	;IS FILE RELATIVE?
	CAIE	TE,%ACC.R
	 JRST	RTGN5A		;NO
	LDB	TE,FI.FAM	;AND SEQ. ACCESS MODE?
	CAIE	TE,%FAM.S
	 JRST	RTGN5A
	PUSHJ	PP,NOOPGN	;GO GENERATE NO-OP SINCE INV KEY NOT ALLOWED.
	JRST	GO2NXT		; AND GENERATE THIS NEXT OPERATOR

RTGN5A:	LDB	TE,FI.ORG	;GET ORGANIZATION
	JUMPE	TE,RITGN9		;SEQUENTIAL
	LDB	TA,FI.ERR##		;SEE IF FILE SPECIFIC ERROR PROCEDURE
	JUMPE	TA,[SKIPN TA,USP.O##	;NO, SEE IF GENERAL USE PROCEDURE
		SKIPE	TA,USP.IO##	;OR FOR I-O
		JRST	RTGN8A		;OK, USE IT
		JRST	RITGN7]		;NO, GIVE ERROR
	LDB	TB,LNKCOD
	CAIE	TB,CD.PRO
	JRST	RITGN7			;NOT A PROTAB?
	PUSHJ	PP,LNKSET		;GET ADDRESS
	LDB	TA,PR.SFI##		;GET TAG
RTGN8A:	MOVE	CH,[JRST.+ASINC,,AS.MSC##]	;JRST.
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.DOT##+2		;.+2
	PUSHJ	PP,PUTASN
	MOVE	CH,TA			;GET TAG
	HRLI	CH,EPJPP		;PUSHJ PP,
	PUSHJ	PP,PUTASY
	JRST	GO2NXT			;DO NEXT OPERATOR

RITGN9:	LDB	TE,FI.ORG	;IF FILE IS NOT SEQ,
	JUMPN	TE,RITGN8	;  TROUBLE
	JRST	GO2NXT

REPEAT 0,<
;(EDIT 512 HAS BEEN REMOVED)
;BINARY WRITE - WITH  /X

RITG10:	CAIN	TB,SIXLIT	;[512] IS IT 1-WORD COMP?
	MOVEI	TE,4		;[512] YES - USE SIZE OF 4 CHARS
	CAIN	TB,FPMODE	;[512] IS IT 2-WORD COMP?
	MOVEI	TE,8		;[512] YES - USE SIZE OF 8 CHARS
	JRST	RITG1B		;[512] CONTINUE
>;END REPEAT 0
;GENERATE CODE FOR "WRITE"  (WITH ADVANCING)

WADVGN:	HRRZ	EACC,EOPLOC	; [163] LOCATION OF 2ND OPERATOR WORD
	HLRZ	TA,2(EACC)	; [163] PICK UP NO. OF SUBSCRIPTS OF RECORD
	IMULI	TA,2		; [163] SKIP TO NEXT  ITEM-2ND WORD
	ADDI	EACC,4(TA)	; [163]
	TLNN	W1,FROM		; [166] SEE IF ANY FROM OPERAND
	JRST	WADVGA		; [166] NO WE ARE AT ADVANCING ITEM
	HLRZ	TA,(EACC)	; [166] SEE IF FROM OPERAND SUBSCRIPTED
	IMULI	TA,2		; [166] SKIP AROUND ANY FROM SUBSCRIPTS
	ADDI	EACC,2(TA)	; [166] NOW WE ARE AT ADVANCING ITEM-2N WRD
WADVGA:	HRRZM	EACC,CUREOP	; [166] [163] SAVE ADVANCING ITEM
	SOS	CUREOP		; [163] POINT BACK TO 1ST WORD OF ADV ITEM
	SKIPN	TA,0(EACC)	;GET TABLE-LINK FOR "ADVANCING" OPERAND
	JRST	[MOVE	TC,-1(EACC)	;MIGHT BE "ZERO"
		TLNN	TC,GNFIGC+GNFCZ	;IS IT?
		JRST	BADLIN		;NO, GIVE ERROR
		SETZ	TC,		;YES
		JRST	WADG2B]		;AND CONTINUE

	CAIN	TA,PAGE.	;'ADVANCING PAGE'
	 JRST	WADG2P		;YES, PUT OUT CHANNEL 1

	PUSHJ	PP,LNKSET

	MOVE	TC,-1(EACC)
	TLNN	TC,GNLIT	;IS IT A LITERAL?
	JRST	WADVG4		;NO

	TLNN	TC,GNNUM	;YES--IS IT NUMERIC?
	JRST	BADLIN		;NO--ERROR

	HRLI	TA,(POINT 7,0,13)	;YES--CREATE AN ILDB BYTE POINTER TO LITERAL IN VALTAB
	LDB	TD,VA.SIZ##	;GET SIZE
	JUMPE	TD,BADLIN	;IF ZERO--ERROR

	MOVEI	TC,0		;SET RESULT TO ZERO

WADVG2:	ILDB	TE,TA		;GET A DIGIT
	CAIG	TE,"9"		;IS IT REALLY A DIGIT?
	CAIGE	TE,"0"
	JRST	BADLIN		;NO--ERROR
	ADDI	TC,-"0"(TE)	;YES--ADD INTO RESULT

	CAILE	TC,^D66		;TOO BIG?
	JRST	BADLIN		;YES--ERROR

	SOJLE	TD,WADG2B	;NO--ANY MORE DIGITS?

	IMULI	TC,^D10		;YES
	JRST	WADVG2
WADG2B:	TLNN	W1,	POSTNG		;POSITIONING?
	JRST		WADVG3		;NO, GO DO ADVANCING.
	JUMPN	TC,	WADG2D		;DOES HE WANT A FORM FEED?
WADG2P:					;[ANS74] ADVANCING PAGE
	MOVE	TC,	[XWD	1,1]	;YES, PUT OUT CHANNEL 1.
	JRST		WADVG5

WADG2D:	CAILE	TC,	3		;ONLY ALLOW UP TO TRIPLE SPACING
	JRST		BADPNU		; FOR POSITIONING.

WADVG3:	HRRZI	TC,(TC)		;SET CHANNEL TO 8 MOD 8.
	JRST	WADVG5

WADVG4:	LDB	TE,[POINT 3,0(EACC),20]	;GET TYPE OF OPERAND
	CAIE	TE,TB.MNE
	JRST	WADVG6

	MOVE	TC,1(TA)
	TLNN	TC,MTCHAN
	JRST	BADLIN

	LDB	TC,CHANUM
	MOVSS	TC
	HRRI	TC,1
;GENERATE CODE FOR "WRITE ADVANCING" (CONT'D)

WADVG5:
	MOVSI	CH,WADV.	;SET UP OP-CODE
	PUSHJ	PP,CNVKYB	;SEE IF KEY NEEDS CONVERTING
	SKIPE	TE,WDPITM##	;DEPENDING ITEM?
	TRNN	TE,-1		;ARE WE SURE?
	 JRST	WADV5A		;NO
	PUSHJ	PP,WADVV	;[1305] YES, GENERATE CODE FOR IT
	JRST	OVRPUT		;JUMP OVER PUTOP

WADVV:	PUSH	PP,TC		;[1305] SAVE TC NOW
	TLNE	TE,-1		; HAVE TO PRESERVE %PARAM+0?
	SETOM	SAVPR0##	;YES, TELL SZDPVA
	HRRZM	TE,ETABLA	;LINK IN ETABLA
	HRRZ	TE,EOPLOC	;[1107] POINT TO THE RECORD OPERAND
	ADDI	TE,1		;[1107] IN CASE OF ERROR
	HRLM	TE,OPERND	;[1107] "A" OPERAND
	MOVEI	TE,15		; LOAD SIZE IN RUNTIME AC 15
	PUSHJ	PP,SZDPVR	;SEE WHICH KIND OF VARIABLE LENGTH
	 JRST	DPPER2		; GO REPORT ERROR

;PUT OUT "MOVEI AC16,LIT"
;	PUSHJ	PP,WADVV.##

	HLRZ	CH,CURFIL
	ANDI	CH,LMASKB
	IORI	CH,AS.FIL
	HRLI	CH,MOVEI.+AC16
	PUSHJ	PP,PUTASY

	MOVEI	CH,WADVV.##
	PUSHJ	PP,PUT.PJ

	POP	PP,TC		;RESTORE TC
	POPJ	PP,		;[1305] RETURN

;THIS SHOULD NEVER HAPPEN.  IF IT DOES, THE PROGRAM SHOULD STILL WORK ANYWAY.
DPPER2:	OUTSTR	DPPEMS		;REPORT PROBLEM WITH DEPENDING VARIABLE
	POP	PP,TC		;RESTORE TC
	POPJ	PP,		; AND PRETEND IT'S NOT THERE

WADV5A:	PUSHJ	PP,PUTOP	;WRITE OUT OPERATOR

OVRPUT:	MOVE	TE,ERECSZ	;GET SIZE OF OUTPUT RECORD
	DPB	TE,[POINT 12,TC,11]

	TLNN	W1,AFTER	;"AFTER ADVANCING"?
	TLO	TC,1B31		;NO--SET "BEFORE"
	MOVE	CH,[XWD AS.XWD,1];CREATE THE XWD
	PUSHJ	PP,PUTASY
	MOVE	CH,TC
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTASN
	HRRZ	CH,TC
	CAIN	CH,777777	;DID WE USE THE DEFAULT?
	HRROI	CH,AS.CNB	;YES, PUT "-1" IN RH
	JRST	WADVG9
;ADVANCING <DATA-NAME> LINES

WADVG6:	CAIE	TE,TB.DAT
	JRST	BADLIN

	LDB	TE,DA.DEF	;IF ITEM IS
	JUMPE	TE,UNDEFD	;  UNDEFINED, TROUBLE

	TLNE	W1,POSTNG	;WRITE POSITIONING?
	JRST	WPSGN		;YES GO WORRY OVER IT.

	LDB	TE,DA.CLA	;IS THIS NUMERIC?
	CAIE	TE,2
	JRST	NOTINT

	LDB	TE,DA.NDP
	JUMPN	TE,NOTINT
	LDB	TE,DA.USG
	CAIE	TE,%US.1C	; [166] ITEM 1-WORD COMP
	JRST	WADVGB		; [166] NO NEED MOVE TO TEMP
	MOVE	TA,CUREOP	; [166] SEE IF COMP  ADV ITEM SUBSCRIPTED
	HLRZ	EACC,1(TA)	; [166] IF SO NEED TO MOVE TO TEMP
	JUMPN	EACC,WADVGB	; [166] SUBSCRIPTED ADV ITEM MUST MOVE TO TEMP
	HRRZ	EACC,1(TA)	; [166] NOT SUBSCRIPTED SAVE NO MOVE NEEDED
	JRST	WADVG8		; [166] GET ADV ITEM ADDRESS AND GO
;CHECK POSITIONING ITEM OUT.  IT MUST BE AN ITEM DESCRIBED BY "PIC X".

WPSGN:	LDB	TC,DA.EDT##	;IF IT'S EDITED
	JUMPN	TC,BADPSN	; COMPLAIN.
	LDB	TC,DA.USG##	;IF IT'S A ONE
	LDB	TD,DA.EXS##	; CHARACTER DISPLAY
	CAIG	TC,%US.DS	; ITEM,
	SOJE	TD,WPSGND	; GO ON.

;IT ISN'T, COMPLAIN.

BADPSN:	HRRZI	DW,E.582	;POSITIONING ITEM MUST BE A
	JRST	ADVERA		; NON-EDITED ONE CHARACTER
				; DISPLAY DATA ITEM.

BADPNU:	HRRZI	DW,E.583	;MUST BE AN INTEGER IN THE RANGE 0 - 3.
	JRST	ADVERA

WPSGND:	MOVEI	TE,1		;GET A TEMP.
	PUSHJ	PP,GETEMP

	MOVEM	EACC,EINCRB##	;SAVE ITS ADDRESS.
	MOVSM	EACC,ESAVAC##

	SETZM	EDPLB		;SET UP A ONE
	MOVEI	TE,1		; CHARACTER
	MOVEM	TE,ESIZEB	; RIGHT JUSTIFIED
	MOVE	TE,[XWD	7,AS.MSC]
	MOVEM	TE,EBASEB	; DISPLAY-7 DATA
	MOVEI	TE,D7MODE	; ITEM IN THE
	MOVEM	TE,EMODEB	; TEMP.
	SWOFF	FBNUM!FBSUB;

	MOVEI	LN,EBASEA	;SET UP THE SOURCE
	HRRZ	TC,CUREOP
	HRLZM	TC,OPERND
	PUSHJ	PP,SETOPN

	TSWF	FANUM;		;IF IT'S NUMERIC,
	JRST	BADPSN		; GO COMPLAIN.

	PUSHJ	PP,MXX.		;GO DO THE MOVE.
	JRST	WADV7D		;GO PUT OUT THE WADV.
;GENERATE CODE FOR "WRITE ADVANCING"  (CONT'D)
;ADVANCING <DATA-NAME> LINES (CONT'D)

;<DATA-NAME> IS NOT A 1-WORD COMP--CONVERT AND STASH IN TEMP
WADVGB:	MOVEI	TE,1		; [166] GET A SINGLE TEMP WORD
	PUSHJ	PP,GETEMP
	MOVEM	EACC,EINCRB
	MOVSM	EACC,ESAVAC

	SETZM	EDPLB
	MOVEI	TE,^D10
	MOVEM	TE,ESIZEB
	MOVE	TE,[XWD ^D36,AS.MSC]
	MOVEM	TE,EBASEB
	MOVEI	TE,D1MODE
	MOVEM	TE,EMODEB

	MOVEI	LN,EBASEA
	HRRZ	TC,CUREOP	; [163] GET BACK ADV ITEM ADDRESS
	HRLZM	TC,OPERND	; [163] GET ADDRESS OF ADV ITEM
	PUSHJ	PP,SETOPN
	TSWF	FERROR		;[1331] DOES ADV ITEM HAVE AN ERROR?
	JRST	BADADV		;[1331] YES, GIVE ERROR MESSAGE HERE ALSO
	SWOFF	FASIGN;		;SET "A" IS UNSIGNED
	SWON	FBSIGN		;SET "B" IS SIGNED
	PUSHJ	PP,MXX.		;GENERATE A MOVE TO TEMPORARY

WADV7D:
	MOVE	EACC,ESAVAC
	HRRI	EACC,AS.MSC

WADVG8:

	MOVSI	CH,WADV.	;WRITE WITH ADVANCING OPERATOR

WDVG8C:	PUSHJ	PP,CNVKYB	;SEE IF KEY NEEDS CONVERTING
	SKIPE	TE,WDPITM##	;[1305] DEPENDING ITEM?
	TRNN	TE,-1		;[1305] ARE WE SURE?
	JRST	WDVG8A		;[1305] NO
	PUSHJ	PP,WADVV	;[1305] YES, GENERATE CODE FOR IT
	JRST	WDVG8B		;[1305] JUMP OVER PUTOP

WDVG8A:	PUSHJ	PP,PUTOP	;[1305]
WDVG8B:	MOVE	CH,[XWD AS.XWD,1]	;[1305]
	PUSHJ	PP,PUTASY
	MOVE	CH,[EXP 1B12+AS.CNB]
	TLNN	W1,AFTER
	TLO	CH,1B31
	TLNE	W1,POSTNG	;WRITE POSITIONING?
	TLO	CH,(1B14)	;YES, SET THE FLAG.
	MOVE	TE,ERECSZ	;PUT IN RECORD SIZE
	DPB	TE,[POINT 12,CH,11]
	PUSHJ	PP,PUTASN
	MOVE	CH,EACC
WADVG9:	PUSHJ	PP,PUTASN
	PUSHJ	PP,CNVKYA	;SEE IF KEY NEEDS CONVERTING BACK
	PUSHJ	PP,RDGN10	;READ UP THRU NEXT OPERATOR
	CAIN	TE,SPIF.
	JRST	RITGN4
	LDB	TE,FI.LCP##	;ANY LINAGE-COUNTER?
	JUMPE	TE,RITGN5	;NO
	PUSHJ	PP,PUTASA	;YES
	MOVSI	CH,JFCL.##	; NEED A NO-OP INCASE OF PAGE OVERFLOW
	PUSHJ	PP,PUTASY	; AND NO EOP ROUTINE CALLED
	JRST	RITGN5
SUBTTL	WRITE - RMS RECORD

;WRITE AND REWRITE COME HERE
WRTM:	MOVEI	TE,V%WRIT	;TELL LIBOL THIS IS A WRITE
	MOVE	TD,EIOOP	;GET TYPE OF OPERATION
	CAIE	TD,WRITE	;SKIP IF WRITE
	MOVEI	TE,V%RWRT	; TELL LIBOL IT'S A REWRITE
	DPB	TE,O.BOPR	;. .

	MOVE	TA,CURDAT	;POINT TO RECORD
	LDB	TE,DA.EXS	;GET RECORD SIZE
	MOVEM	TE,ERECSZ	;SAVE IT

;CHECK FOR DEPENDING VARIABLE, SO WE CAN DO A VARIABLE-LENGTH WRITE
	SETZM	WDPITM		;ASSUME NO DEPENDING ITEM
	MOVE	TA,CURFIL
	LDB	TE,FI.DEP##	;VARIABLE RECORD DEPENDING ON ITEM?
	JUMPN	TE,WRTM0B	;YES, THEN ITS VARIABLE FORMAT
	HLRZ	TE,CURDAT	;NO, CHECK FOR DEPENDING ITEM
	HRRZM	TE,ETABLA##	; SO WE CAN DO A VARIABLE LENGTH WRITE
	PUSHJ	PP,DEPTSA##	;SKIP IF WE HAVE ONE
	 JRST	WRTM0A		;NO
	HRRZ	TE,ETABLA	; YES--SAVE LINK
WRTM0B:	HRRZM	TE,WDPITM	;SAVE 0,,LINK

WRTM0A:	TLNN	W1,FROM
	 JRST	WRTM1		;NO "FROM"

	MOVE	TC,OPERND	;GET RECORD TABLE-LINK
	MOVEI	TA,2(TC)	;GET "FROM" DATA-NAME
	MOVEM	TA,CUREOP
	SETOM	EDEBDA##	;SEE IF DEBUGGING WANTED
	PUSHJ	PP,MOVGN.	;GENERATE MOVE TO RECORD AREA
	PUSHJ	PP,GDEBA##	;GENERATE DEBUGING CODE IF REQUIRED

WRTM1:
	SETZM	ADVPR1##	;INITIALIZE FIELDS TO CARRY ADVANCING PARMS
	SETZM	ADVPR2##	;
	MOVE	TA,CURDAT	;GET RECORD NAME
	MOVEI	LN,EBASEA	;POINT TO "A" DATA BLOCK
	SETOM	EDEBDA##	;SEE IF DEBUGGING WANTED
	PUSHJ	PP,TSDEBA	; ...
	PUSHJ	PP,GDEBA##	;GENERATE DEBUGING CODE IF REQUIRED
	TLNN	W1,ADVANC!POSTNG	;ADVANCING / POSITIONING CLAUSE?
	 JRST	WRTM1X		;NO, OK

	SETZ	TC,	;ZERO OUT AC WHICH WILL COLLECT THE PARMS
	MOVE	TA,CURFIL	;GET ADDRESS OF CURRENT FILE'S TABLE
	LDB	TD,FI.ORG	;GET ITS ORGANIZATION
	JUMPN	TD,WRTM2	; NOT SEQUENTIAL
	LDB	TD,FI.ERM	;GET ITS EXTERNAL RECORDING MODE
	CAIE	TD,%RM.7B	;IS FILE ASCII?
	 JRST	WRTM1E		;NO, SIXBIT OR EBCDIC RMS NOT STREAM ORIENTED
	PUSHJ	PP,WRDVGN	;GO PICK UP ADV / POS PARMS
	JRST	WRTM2		; AND GO ON.

WRTM1E:
	MOVEI	DW,E.372	;** CHECK THIS **
	PJRST	OPFAT		;RETURN FROM WRITE

WRTM1X:				;SET UP DEFAULT PARAMS FOR WRITE ADVANCING
	HRLI	TE,40		;
	HRRI	TE,AS.CNB	;
	HRLI	TD,-1		;
	HRRI	TD,AS.CNB	;
	DMOVEM	TE,ADVPR1##	; AND SAVE ASIDE IN ADVPR1/2 FOR LIT POOL LATER

WRTM2:	PUSHJ	PP,CNVKYB	;CHECK IF GENERATE KEY CONVERSION ROUTINE
	PUSHJ	PP,RDGN10	;READ UP THRU NEXT OPERATOR
	CAIE	TE,SPIF.
	JRST	WRTM2A		;NOT SPECIAL "IF"

;"WRITE" OR "REWRITE"..<SPECIAL IF>
WRTM20:	TLNE	W1,INVKEY	;MUST BE "INVALID KEY"
	JRST	WRTM2O		;ALL OK

	MOVEI	DW,E.209	;"INVALID KEY" ASSUMED
	PUSHJ	PP,OPWRN
	JRST	WRTM2O		;AT LEAST THERE IS A "SPIF" OF SOME KIND

;NO SPIF AFTER WRITE OR REWRITE. THIS IS OK AS LONG AS
; THERE IS A USE PROCEDURE.
; IF SO, SET THE IOFLGS BIT, ELSE GIVE A FATAL ERROR.

WRTM2A:	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	LDB	TB,FI.ERR##	;SEE IF FILE-SPECIFIC USE PROCEDURE
	JUMPN	TB,WRTM2D	;YES, SET THE BIT
	SKIPN	USP.O##		;NO, GENERAL USE PROCEDURE?
	SKIPE	USP.IO##
	 JRST	WRTM2D		;YES, SET THE BIT
	LDB	TA,FI.ORG	;GET FILE'S ORGANIZATION
	JUMPE	TA,WRTM2Z	;IF SEQUENTIAL, GO TO HANDLE REC LENGTH

	MOVEI	DW,E.319	;"INVALID KEY" REQUIRED
	MOVE	TC,OPLINE
	LDB	CP,TCCP
	LDB	LN,TCLN
	PUSHJ	PP,FATAL
	JRST	GO2NXT		;GO TO NEXT OPERATOR ACTION

;NO SPIF, BUT THERE IS A USE PROCEDURE. SET THE IOFLGS BIT
WRTM2D:	MOVX	TE,WT%NIK
	IORM	TE,IOFLGS

;GET THE KEY BUFFER ADDRESS
WRTM2O:	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	LDB	TA,FI.RKY	;GET RECORD KEY DATANAME
	PUSHJ	PP,UKADR	;GET THE KEY ADDRESS, MOVE IT IF NECESSARY
	EQUIT;			;QUIT IF ERRORS

;IF FIXED-LENGTH WRITE, PUT ARG LIST IN %LIT
; IF VARIABLE-LENGTH WRITE, PUT ARG LIST IN %PARAM

WRTM2Z:
	;BEFORE WE DO THAT THOUGH, LET'S CHECK FOR ACCESS SEQUENTIAL AND
	; SET THE PROPER I-O FLAG IF SO.

	MOVX	TE,WT%SEQ	;SET SEQUENTIAL FLAG
	MOVE	TA,CURFIL	;GET FILE'S FILE TABLE ADDRESS
	LDB	TD,FI.FAM	;TEST ITS ACCESS MODE FOR SEQUENTIAL
	CAIN	TD,%FAM.S	;
	 IORM	TE,IOFLGS	; IF IT IS, TURN ON THE FLAG

	SKIPE	TE,WDPITM	;DEPENDING VARIABLE OPTION?
	TRNN	TE,-1		;ARE WE SURE?
	 JRST	WRTM2P		;NO, USE %LIT

;VARIABLE-LENGTH WRITE OR REWRITE. PUT ARG LIST IN %PARAM
;** FIRST: GET SIZE OF RECORD IN AC4.

	TLNE	TE,-1		;HAVE TO PRESERVE %PARAM+0?
	 SETOM	SAVPR0##	;YES, TELL SZDPVA
	HRRZM	TE,ETABLA	;IT LOOKS FOR LINK IN ETABLA
	HRRZ	TE,EOPLOC	;POINT TO THE RECORD OPERAND
	ADDI	TE,1		; IN CASE OF ERROR
	HRLM	TE,OPERND	;"A" OPERAND
	MOVEI	TE,4		;[1303] LOAD RUNTIME SIZE IN AC4
	PUSHJ	PP,SZDPVR	;GENERATE THE CODE..
	 JRST	[TYPE DPPEMS	;TYPE "UNEXPECTED ERROR" MESSAGE
		JRST WRTM2P]	;GO IGNORE DEPENDING VARIABLE

;FIRST WORD OF ARG LIST
	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTAS1##
	HLLZ	CH,IOFLGS	;FLAGS IN LH
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTAS1
	HLRZ	CH,CURFIL	;FILE-TABLE-ADDR IN RH
	IORI	CH,AS.FIL
	PUSHJ	PP,PUTAS1

;SECOND WORD OF ARG LIST
;FORMAT:	XWD	RECLEN,,KEY-BUFFER-ADDRESS
;NOTE: MAX REC LEN IS NOT PRESERVED HERE BECAUSE IT IS AVAILABLE IN THE
; RUN-TIME FILE TABLE AT WORD 8, BITS 9 - 17.

	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTAS1
	SETZ	CH,		;REC SIZE: TO BE FILLED IN
	PUSHJ	PP,PUTAS1
	MOVE	CH,KEYADR	;GET KEY ADDRESS
	PUSHJ	PP,PUTAS1	;FINISH THE XWD

;THIRD WORD OF ARG LIST -- FOR WRITE WITH ADVANCING / POSITIONING.
;CALL TO WRDVGN AT WRTM1: + A FEW PICKED UP THIS INFO EARLIER AND PUT
; IT INTO ADVPR1 AND ADVPR2 WITH THE PROPER CODES SET UP IN THE RIGHT
; HALVES OF THE WORDS.
;ONLY WT.MIS FOR SEQUENTIAL ASCII STREAM FILES WILL KNOW HOW TO USE IT.

;FORMAT:	XWD	APV/POS FLAGS , COUNT/ADDRESS

	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTAS1
	MOVE	CH,ADVPR1##	;GET ADV/POS FLAGS IN LH
	PUSHJ	PP,PUTAS1
	MOVE	CH,ADVPR2##	;GET COUNT/ADDRESS IN RH
	PUSHJ	PP,PUTAS1

;STORE ACTUAL RECORD SIZE IN %PARAM WORD
	PUSHJ	PP,PUTASA	;HRLM IN 2ND CODE SET
	MOVE	CH,[HRLM.##+AC4+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,EAS1PC##
	ADDI	CH,1		;IN 2ND WORD
	IORI	CH,AS.PAR##
	PUSHJ	PP,PUTASN

;GENERATE MOVEI 16,%PARAM
	MOVE	CH,[MOVEI.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,EAS1PC
	IORI	CH,AS.PAR
	PUSHJ	PP,PUTASN

;UPDATE EAS1PC
	MOVEI	TE,3		;WE JUST GENERATED THREE WORDS
	ADDM	TE,EAS1PC
	JRST	WRTM2H		;GO GENERATE THE "PUSHJ"

;HERE FOR NORMAL CASE OF WRITE/REWRITE. PUT ARG LIST IN %LIT
WRTM2P:	PUSH	PP,ELITPC	;SAVE LITERAL PC NOW
REPEAT 0,<
;THIS CODE PUTS OUT A TWO-WORD ARG BLOCK, AND IS REPLACED BY THE FOLLOWING
; CODE WHICH PUTS OUT A THREE-WORD ARG BLOCK FOR THE RMS WRITE CALL.
; NOTE: ONLY RMS WRITE WITH ADVANCING WILL KNOW ABOUT THE THIRD WORD.
	PUSHJ	PP,STDW1	;PUT OUT STD. FIRST WORD OF ARG LIST
	AOS	ELITPC		;BUMP LITERAL PC

;PUT OUT 2ND WORD OF ARG LIST:
;	XWD RECLEN,,KEY-BUFFER-ADDRESS
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHP
> ; END REPEAT 0

;THE FOLLOWING CODE IS INTENDED TO REPLACE THE ABOVE FOUR LINES
;	PUSHJ	PP,STDW1		THRU
;	PUSHJ	PP,STASHP
;WE ARE GENERATING A THREE-WORD LITERAL (SIX HALF-WORDS) FOR THE RMS WRITE
; CALL AT RUN TIME. FIRST -- FILE FLAGS,,FILE NAME ; SECOND -- REC LEN,,0 ,
; THIRD -- ADV/POS FLAGS,, PARMS
;THE EXISTING V12B CODE ALWAYS GENERATES A TWO-WORD LITERAL, AND THE THIRD
; WORD IS ONLY NECESSARY FOR THE ADVANCING / POSITIONING. SO WE SHOULD
; DECIDE IF WE WANT TO KEEP THE V12B CODE FOR MOST CASES AND SPECIAL-CASE
; THIS CODE FOR RMS ASCII STREAM FILE WRITES ONLY.

	MOVE	TA,[XWDLIT,,6]	;SET UP HEADER FOR 6 HALF-WORDS
	PUSHJ	PP,STASHP		;PUT HEADER IN TEMP LITAB
	HLLZ	TA,IOFLGS		;GET FILE IO FLAGS
	HRRI	TA,AS.CNB		;FLAG FOR LARGE NUMBER
	PUSHJ	PP,STASHQ		;PUT IN LITAB
	HLRZ	TA,CURFIL		;GET CUR FILE'S NUMBER
	IORI	TA,AS.FIL		;FLAG AS A FILE IDENTIFIER
	PUSHJ	PP,STASHQ		;PUT IN LITAB
	HRLZ	TA,ERECSZ	;GET REC SIZE
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	MOVE	TA,KEYADR	;GET KEY ADDRESS
;PUT OUT THE FOURTH HALF-WORD TO THE LITAB AND GENERATE THE FIFTH AND SIXTH
	PUSHJ	PP,STASHQ	;PUT FOURTH WORD IN LITAB
	MOVE	TA,ADVPR1##	;GET ADV/POS PARMS
	PUSHJ	PP,STASHQ	   ;AND PUT FIFTH HALF-WORD IN LITAB
	MOVE	TA,ADVPR2##	;GET ADV/POS COUNT/ADDRESS

	PUSHJ	PP,POOLIT	;PUT LAST HALF-WORD IN TEMP LITAB AND POOL
			; THE ENTIRE LITERAL.

WRTM2G:	MOVE	CH,[MOVEI.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY	;START MOVEI OF ARG LIST INST.
	POP	PP,CH		;GET OLD LITERAL PC

REPEAT 0,< ;TO PULL OUT OLD CODE TO UPDATE LITERAL PC FOR TWO WORDS
	SKIPN	PLITPC		;DID WE POOL?
	AOSA	ELITPC		;NO, BUMP LITERAL PC
	 ;ONLY ADD 1 HERE BECAUSE 1 WAS ADDED AT WRTM2P + 2 IN V12B CODE.
	MOVEM	CH,ELITPC	;YES, RESTORE ORIGINAL
	SKIPE	PLITPC		;SKIP IF WE DIDN'T
	MOVE	CH,PLITPC	;GET THE POOLED VALUE
> ; END REPEAT 0 FOR OLD LITERAL PC

;THIS PIECE OF CODE REPLACES THE FIVE LINES ABOVE AND UPDATES THE LITERAL
; PC FOR THREE WORDS
;THIS CODE IS A LITTLE RAIN DANCE TO UPDATE THE LITERAL PC IF THE OLD ONE
; MUST BE BUMPED BY THREE. A MORE GENERALIZED PROCEDURE SHOULD BE DEVELOPED.

	SKIPE	CH,PLITPC		;DID WE POOL?
	 JRST	WRT2G1		; YES, DON'T NEED TO UPDATE.
	MOVE	CH,ELITPC		;GET OLD LITERAL PC
	ADDI	CH,3		;BUMP UP THREE
	EXCH	CH,ELITPC		;SWAP THEM, INCL. TO SET UP FOR ARG
				; GENERATION BELOW.
WRT2G1:

	IORI	CH,AS.LIT	; MAKE IT LOOK LIKE A LITERAL
	PUSHJ	PP,PUTASN	;FINISH ARG

;GENERATE PUSHJ TO APPROPRIATE ROUTINE
WRTM2H:	SETZ	TD,		;TD=0 MEANS USE RANDOM ACCESS ROUTINE
	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	LDB	TB,FI.FAM##	;SEE IF SEQ. ACCESS MODE
	CAIN	TB,%FAM.S
	 SETO	TD,		;YES, TURN ON FLAG
	MOVE	TE,EIOOP
	CAIN	TE,WRITE
	 JRST	WRTM2I		;A "WRITE" ROUTINE

;A "REWRITE" ROUTINE
	MOVEI	CH,RW.MIR##
	SKIPE	TD		;SKIP IF RANDOM ACCESS
	MOVEI	CH,RW.MIS##	;NO, USE OTHER ROUTINE
	JRST	WRTM2J

WRTM2I:	MOVEI	CH,WT.MIR##
	SKIPN	TD		;SKIP IF NOT RANDOM ACCESS
	 JRST	WRTM2J		; VARIABLE LENGTH IS ONLY FOR SEQ. WRITE
	MOVEI	CH,WT.MIS##	;NO, USE OTHER ROUTINE
	SKIPE	TE,WDPITM##	;VARIABLE LENGTH WRITE?
	 TRNN	TE,-1		;IS IT REALLY?
	  JRST	WRTM2J		;NOPE
	MOVEI	CH,WT.MSV##	;YES, SEPARATE ENTRY POINT IN RMSIO.

WRTM2J:	PUSHJ	PP,PUT.PJ	;"PUSHJ PP,ROUTINE"
	PUSHJ	PP,CNVKYA	;CHECK IF GENERATE KEY CONVERSION ROUTINES

WRTM2K:	LDB	TE,FI.FAM	;GET FILE'S ACCESS MODE
	CAIN	TE,%FAM.S	;IF SEQUENTIAL
	 JRST	GO2NXT		;THE VERB IS FINISHED
	MOVE	TE,IOFLGS	;GET IO FLAGS
	TXNN	TE,WT%NIK	;SKIP IF NO INVALID KEY CLAUSE WAS GIVEN
				;NOTE: THIS MUST BE THE SAME BIT FOR
				;	DELETE,WRITE, AND REWRITE
	JRST	SPIFGC		; GO GEN "SPECIAL IF" STUFF

;NO "INVALID KEY" CLAUSE. GENERATE CALL TO "USE" PROCEDURE
	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	LDB	TA,FI.ERR##	;SEE IF FILE SPECIFIC ERROR PROCEDURE
	JUMPE	TA,[SKIPN TA,USP.O## ;NO, SEE IF GENERAL USE PROCEDURE
		SKIPE	TA,USP.IO##	;OR FOR I-O
		JRST	WRTM8A	;OK, USE IT
		HALT	.]	;** IMPOSSIBLE, WE CHECKED EARLIER
	LDB	TB,LNKCOD
	CAIE	TB,CD.PRO
	JRST	RITGN8		;"INVALID KEY REQUIRED"
	PUSHJ	PP,LNKSET	;GET PROTAB ADDRESS
	LDB	TA,PR.SFI##	;GET TAG
WRTM8A:	MOVE	CH,[JRST.+ASINC,,AS.MSC##]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.DOT##+2
	PUSHJ	PP,PUTASN	;"JRST .+2"
	MOVE	CH,TA		;GET TAG
	HRLI	CH,EPJPP
	PUSHJ	PP,PUTASY	;GENERATE "PUSHJ PP,ERROR.ROUTINE"
	JRST	GO2NXT
;GENERATE CODE FOR "WRITE"  (WITH ADVANCING) FOR RMS SEQ ASCII STREAM FILES

WRDVGN:	HRRZ	EACC,EOPLOC	; [163] LOCATION OF 2ND OPERATOR WORD
	HLRZ	TA,2(EACC)	; [163] PICK UP NO. OF SUBSCRIPTS OF RECORD
	IMULI	TA,2		; [163] SKIP TO NEXT  ITEM-2ND WORD
	ADDI	EACC,4(TA)	; [163]
	TLNN	W1,FROM		; [166] SEE IF ANY FROM OPERAND
	JRST	WRDVGA		; [166] NO WE ARE AT ADVANCING ITEM
	HLRZ	TA,(EACC)	; [166] SEE IF FROM OPERAND SUBSCRIPTED
	IMULI	TA,2		; [166] SKIP AROUND ANY FROM SUBSCRIPTS
	ADDI	EACC,2(TA)	; [166] NOW WE ARE AT ADVANCING ITEM-2N WRD
WRDVGA:	HRRZM	EACC,CUREOP	; [166] [163] SAVE ADVANCING ITEM
	SOS	CUREOP		; [163] POINT BACK TO 1ST WORD OF ADV ITEM
	SKIPN	TA,0(EACC)	;GET TABLE-LINK FOR "ADVANCING" OPERAND
	JRST	[MOVE	TC,-1(EACC)	;MIGHT BE "ZERO"
		TLNN	TC,GNFIGC+GNFCZ	;IS IT?
		JRST	BADLIN		;NO, GIVE ERROR
		SETZ	TC,		;YES
		JRST	WRDG2B]		;AND CONTINUE

	CAIN	TA,PAGE.	;'ADVANCING PAGE'
	 JRST	WRDG2P		;YES, PUT OUT CHANNEL 1

	PUSHJ	PP,LNKSET

	MOVE	TC,-1(EACC)
	TLNN	TC,GNLIT	;IS IT A LITERAL?
	JRST	WRDVG4		;NO

	TLNN	TC,GNNUM	;YES--IS IT NUMERIC?
	JRST	BADLIN		;NO--ERROR

	HRLI	TA,(POINT 7,0,13)	;YES--CREATE AN ILDB BYTE POINTER TO LITERAL IN VALTAB
	LDB	TD,VA.SIZ	;GET SIZE
	JUMPE	TD,BADLIN	;IF ZERO--ERROR

	MOVEI	TC,0		;SET RESULT TO ZERO

WRDVG2:	ILDB	TE,TA		;GET A DIGIT
	CAIG	TE,"9"		;IS IT REALLY A DIGIT?
	CAIGE	TE,"0"
	JRST	BADLIN		;NO--ERROR
	ADDI	TC,-"0"(TE)	;YES--ADD INTO RESULT

	CAILE	TC,^D66		;TOO BIG?
	JRST	BADLIN		;YES--ERROR

	SOJLE	TD,WRDG2B	;NO--ANY MORE DIGITS?

	IMULI	TC,^D10		;YES
	JRST	WRDVG2
WRDG2B:
	TLNN	W1,	POSTNG		;POSITIONING?
	JRST		WRDVG3		;NO, GO DO ADVANCING.
	JUMPN	TC,	WRDG2D		;DOES HE WANT A FORM FEED?
WRDG2P:					;[ANS74] ADVANCING PAGE
	MOVE	TC,	[XWD	1,1]	;YES, PUT OUT CHANNEL 1.
	JRST		WRDVG5

WRDG2D:	CAILE	TC,	3		;ONLY ALLOW UP TO TRIPLE SPACING
	JRST		BADPNU		; FOR POSITIONING.

WRDVG3:	HRRZI	TC,(TC)		;SET CHANNEL TO 8 MOD 8.
	JRST	WRDVG5

WRDVG4:	LDB	TE,[POINT 3,0(EACC),20]	;GET TYPE OF OPERAND
	CAIE	TE,TB.MNE
	JRST	WRDVG6

	MOVE	TC,1(TA)
	TLNN	TC,MTCHAN
	JRST	BADLIN

	LDB	TC,CHANUM
	MOVSS	TC
	HRRI	TC,1
;GENERATE CODE FOR "WRITE ADVANCING" (CONT'D)

WRDVG5:

;FINISH OFF ADVANCING/POSITIONING WITH A LITERAL

	TLNN	W1,AFTER	;AFTER ADV/POS?
	 TLO	TC,1B31		; NO, BEFORE

;PUT LITAB PARMS INTO ADVPR1 AND ADVPR2

	HRL	TB,TC		;SPLIT UP THE TWO HALVES INTO TWO LEFT-HALVES
	HRRI	TC,AS.CNB	;FLAG EACH AS A LARGE NUMBER
	HRRI	TB,AS.CNB	;
	DMOVEM	TC,ADVPR1##	;AND SAVE THEM ASIDE IN ADVPR1/2

	 POPJ	PP,	; AND RETURN TO RMS WRITE CODE.
;ADVANCING <DATA-NAME> LINES

WRDVG6:	CAIE	TE,TB.DAT
	JRST	BADLIN

	LDB	TE,DA.DEF	;IF ITEM IS
	JUMPE	TE,UNDEFD	;  UNDEFINED, TROUBLE

	TLNE	W1,POSTNG	;WRITE POSITIONING?
	JRST	WRPSGN		;YES GO WORRY OVER IT.

	LDB	TE,DA.CLA	;IS THIS NUMERIC?
	CAIE	TE,2
	JRST	NOTINT

	LDB	TE,DA.NDP
	JUMPN	TE,NOTINT
	LDB	TE,DA.USG
	CAIE	TE,%US.1C	; [166] ITEM 1-WORD COMP
	JRST	WRDVGB		; [166] NO NEED MOVE TO TEMP
	MOVE	TA,CUREOP	; [166] SEE IF COMP  ADV ITEM SUBSCRIPTED
	HLRZ	EACC,1(TA)	; [166] IF SO NEED TO MOVE TO TEMP
	JUMPN	EACC,WADVGB	; [166] SUBSCRIPTED ADV ITEM MUST MOVE TO TEMP
	HRRZ	EACC,1(TA)	; [166] NOT SUBSCRIPTED SAVE NO MOVE NEEDED
	JRST	WRDVG8		; [166] GET ADV ITEM ADDRESS AND GO
;CHECK POSITIONING ITEM OUT.  IT MUST BE AN ITEM DESCRIBED BY "PIC X".

WRPSGN:	LDB	TC,DA.EDT##	;IF IT'S EDITED
	JUMPN	TC,BADPSN	; COMPLAIN.
	LDB	TC,DA.USG##	;IF IT'S A ONE
	LDB	TD,DA.EXS##	; CHARACTER DISPLAY
	CAIG	TC,%US.DS	; ITEM,
	SOJE	TD,WRPSND	; GO ON.
	JRST	BADPSN		;IT ISN'T, COMPLAIN.

WRPSND:	MOVEI	TE,1		;GET A TEMP.
	PUSHJ	PP,GETEMP

	MOVEM	EACC,EINCRB##	;SAVE ITS ADDRESS.
	MOVSM	EACC,ESAVAC##

	SETZM	EDPLB		;SET UP A ONE
	MOVEI	TE,1		; CHARACTER
	MOVEM	TE,ESIZEB	; RIGHT JUSTIFIED
	MOVE	TE,[XWD	7,AS.MSC]
	MOVEM	TE,EBASEB	; DISPLAY-7 DATA
	MOVEI	TE,D7MODE	; ITEM IN THE
	MOVEM	TE,EMODEB	; TEMP.
	SWOFF	FBNUM!FBSUB;

	MOVEI	LN,EBASEA	;SET UP THE SOURCE
	HRRZ	TC,CUREOP
	HRLZM	TC,OPERND
	PUSHJ	PP,SETOPN

	TSWF	FANUM;		;IF IT'S NUMERIC,
	JRST	BADPSN		; GO COMPLAIN.

	PUSHJ	PP,MXX.		;GO DO THE MOVE.
	JRST	WRDV7D		;GO PUT OUT THE WADV.
;GENERATE CODE FOR "WRITE ADVANCING"  (CONT'D)
;ADVANCING <DATA-NAME> LINES (CONT'D)

;<DATA-NAME> IS NOT A 1-WORD COMP--CONVERT AND STASH IN TEMP
WRDVGB:	MOVEI	TE,1		; [166] GET A SINGLE TEMP WORD
	PUSHJ	PP,GETEMP
	MOVEM	EACC,EINCRB
	MOVSM	EACC,ESAVAC

	SETZM	EDPLB
	MOVEI	TE,^D10
	MOVEM	TE,ESIZEB
	MOVE	TE,[XWD ^D36,AS.MSC]
	MOVEM	TE,EBASEB
	MOVEI	TE,D1MODE
	MOVEM	TE,EMODEB

	MOVEI	LN,EBASEA
	HRRZ	TC,CUREOP	; [163] GET BACK ADV ITEM ADDRESS
	HRLZM	TC,OPERND	; [163] GET ADDRESS OF ADV ITEM
	PUSHJ	PP,SETOPN
	TSWF	FERROR		;[1331] DOES ADV ITEM HAVE AN ERROR?
	JRST	BADADV		;[1331] YES, GIVE ERROR MESSAGE HERE ALSO
	SWOFF	FASIGN;		;SET "A" IS UNSIGNED
	SWON	FBSIGN		;SET "B" IS SIGNED
	PUSHJ	PP,MXX.		;GENERATE A MOVE TO TEMPORARY

WRDV7D:
	MOVE	EACC,ESAVAC
	HRRI	EACC,AS.MSC

WRDVG8:
	MOVE	CH,[EXP 1B12+AS.CNB]	;SET UP AS TYPE 40
	TLNN	W1,AFTER		;AFTER ADVANCING/POSITIONING?
	TLO	CH,1B31			; NO, BEFORE
	TLNE	W1,POSTNG	;WRITE POSITIONING?
	TLO	CH,(1B14)	;YES, SET THE FLAG.
	MOVEM	CH,ADVPR1##	;SAVE ADV/POS FLAGS ASIDE
	MOVEM	EACC,ADVPR2##	;SAVE LITERAL / ADDRESS ALSO

	POPJ PP,		; AND RETURN TO RMS WRITE GENERATION
;SETUP AC FOR VARIABLE LENGTH READ AND WRITE
;IF NOT VARIABLE LENGTH SYNTAX "RECORD IS VARYING IN SIZE ..." GO TO SZDPVA AS BEFORE
;IF IT IS USE SIMILAR CODE AS SZDPVA BUT CHECK BOTH BOUND

;ROUTINE TO SETUP AC = SIZE OF VARIABLE, WHERE VARIABLE HAS A DEPENDING ITEM
;CALLED BY:
;	MOVEI	TE,WHICH AC TO USE (0-16)
;	SAVPR0/ 0 (NORMAL CASE) OR -1 (%PARAM+0 MUST BE PRESERVED)
;	PUSHJ	PP,SZDPVR
;	 <RETURN HERE IF NO DEPENDING VARIABLE OR ERRORS, DEPVB/ -1, FERROR SET>
;	<RETURN HERE IF SIZE SETUP IN AC SPECIFIED, DEPVB / RUNTIME AC USED>
;	ALL RUNTIME AC'S MAY BE SMASHED!!

SZDPVR:	MOVE	TA,CURFIL
	LDB	TA,FI.DEP##	;IS THERE A DEPENDING VARIABLE?
	JUMPE	TA,SZDPVA##	;NO, USE OLD CODE
	MOVEI	LN,EBASEA	;REMEMBER WE'RE DOING 'A'
	MOVEM	TE,DEPVB##	;SAVE RUNTIME AC TO USE
	MOVE	TB,TA		;COPY DEPENDING VARIABLE
	MOVEM	TA,DPLNK##
	MOVEM	TB,DPITM##
	PUSHJ	PP,LNKSET	;LOOK AT ITEM
	LDB	CH,DA.LKS	;IN LINKAGE SECTION?
	JUMPN	CH,GTBDP0	;YES, DO HARD WAY
	LDB	CH,DA.USG	;GET USAGE
	CAIE	CH,%US.1C	;IF 1-WORD COMP
	CAIN	CH,%US.IN	;OR INDEX IT OK
	JRST	GTBDP1		;SINCE NO CONVERSION REQUIRED

;SET UP FAKE "A" OPERAND TO POINT TO DEPENDING ITEM. GET IT INTO SPECIFIED ACC.
GTBDP0:	PUSH	PP,W1		;SAVE W1
	PUSH	PP,W2		; AND W2.
	PUSH	PP,OPERND##	;SAVE OPERND TOO. (IN CASE IT'S IN THE LINKAGE SECTION.)
	MOVSI	W1,(1B0)	;SET THE OPERAND FLAG.
	MOVE	W2,DPITM	;GET DEP ITEM LINK
	LDB	TD,DA.SYL##	;SET THE SYNC FLAGS.
	DPB	TD,[POINT 1,W1,5]
	LDB	TD,DA.SYR##
	DPB	TD,[POINT 1,W1,6]
	LDB	TD,DA.CLA##	;SET THE NUMERIC FLAG.
	CAIN	TD,%CL.NU
	TLO	W1,(1B7)
	LDB	TD,DA.JST##	;SET THE JUSTIFIED FLAG.
	DPB	TD,[POINT 1,W1,8]
	LDB	TD,DA.LKS##	;SET THE LINKAGE SECTION FLAG.
	DPB	TD,[POINT 1,W1,9]
	LDB	TD,DA.USG##	;SET THE USAGE.
	DPB	TD,[POINT 4,W1,13]
	PUSHJ	PP,PUSH12##	;STASH THE INFO IN EOPTAB.
	HRRZI	TC,-1(EACA)	;POINT AT THE EOPTAB ENTRY.
	MOVEM	TC,CUREOP	;MAKE IT THE CURRENT ENTRY.
	HRRZM	TC,OPERND##	;MAKE IT THE CURRENT OPERAND TOO.
	MOVEI	LN,EBASEA	;POINT TO "A"
	PUSHJ	PP,SETOPN	;SET UP "A" OPERAND
	PUSH	PP,EAC		;SAVE CURRENT NEXT FREE ACC
	MOVE	TD,DEPVB
	MOVEM	TD,EAC		;WHICH ONE TO USE (TEST LATER FOR DP)
	TSWT	FERROR		;DON'T TRY TO STORE IF ERROR FOUND
	PUSHJ	PP,MXAC.##	;GET DEPENDING ITEM
	POP	PP,EAC		;RESTORE FREE ACC
	POP	PP,OPERND##	;RESTORE OPERAND
	POP	PP,W2		;RESTORE W2
	POP	PP,W1		; AND W1.
	MOVE	EACA,EOPNXT##	;RESET EOPTAB.
	POP	EACA,(EACA)
	POP	EACA,(EACA)
	MOVE	TA,CURFIL
	JRST	GTBDP5		;GENERATE COMPARES

GTBDP1:	MOVE	CH,DPITM	;PUT ITEM IN CH

GTBDP4:	MOVE	TA,CURFIL
	LDB	TE,FI.LRS##	;GET LOWER BOUND
	JUMPE	TE,GTBDP6	;ZERO, OR NOT SETUP
	HRLI	CH,MOV		;NORMAL COMP ITEM..
	HRRZ	TE,DEPVB	;GET AC AGAIN
	LSH	TE,5
	TLO	CH,(TE)
	PUSHJ	PP,PUTASY	;"MOVE AC,DEPENDING VARIABLE"
GTBDP5:	LDB	CH,FI.LRS	;GET LOWER BOUND TO TEST
	HRLI	CH,CAIL.##
	HRRZ	TE,DEPVB	;GET AC AGAIN
	LSH	TE,5
	TLO	CH,(TE)
	PUSHJ	PP,PUTASY	;"CAIL AC,LOWER.BOUND"
	JRST	GTBDP3

GTBDP6:	HRLI	CH,SKPLE.##	;NORMAL COMP ITEM..
	HRRZ	TE,DEPVB	;GET AC AGAIN
	LSH	TE,5
	TLO	CH,(TE)
	PUSHJ	PP,PUTASY	;"SKIPLE AC,DEPENDING VARIABLE"
;HERE TO DO UPPER BOUND TEST
;SKIPLE AC, DEPENDING.VARIABLE   JUST PUT OUT
; NOW GENERATE:
;CAILE AC,UPPER.BOUND.FOR.DEPENDING.VARIABLE

GTBDP3:	MOVE	TA,CURFIL
	SETZM	SAVPR0##	;CLEAR FLAG
	LDB	CH,FI.MRS##	;GET UPPER BOUND
	HRLI	CH,CAILE.##
	HRRZ	TE,DEPVB
	LSH	TE,5
	TLO	CH,(TE)
	PUSHJ	PP,PUTASY	;"CAILE AC,UPPER.BOUND"
	MOVEI	CH,SUBE2.##
	AOS	(PP)		;SKIP RETURN
	JRST	PUT.PJ		;"PUSHJ PP,SUBE2." - OUT OF RANGE

QITDPV:	SETOM	DEPVB		;SET DEPVB TO -1 TO INDICATE ERROR
	SETZM	SAVPR0##	;CLEAR FLAG
	SWON	FERROR		;SET "ERROR" BIT
	POPJ	PP,
SUBTTL	START

STRTGN:	SETZM	EIOOP		;CLEAR LAST I/O OPERATOR
	PUSHJ	PP,SETOP
	  EQUIT;
	LDB	TE,FI.ORG	;IF FILE IS SEQUENTIAL
	JUMPE	TE,NOTRAN	;  ERROR
	LDB	TE,FI.RMS	;IF FILE IS AN RMS FILE,
	JUMPN	TE,STRTM	; GO GEN THE "START"
	PUSHJ	PP,CNVKYB	;CONVERT KEY IF NEEDED
	MOVE	TA,[XWDLIT,,2]	;DO IT BY HAND
	PUSHJ	PP,STASHP	; SINCE NO MORE UUOS LEFT
	LDB	TA,[POINT 2,W1,10]	;GET LESS AND GREATER
	LSH	TA,4		;BITS 12 AND 13
	TLNE	W1,(1B12)	;APPROX KEY?
	TRO	TA,(STA%AP)	;YES, SET FLAG
	PUSHJ	PP,STASHQ
	HLRZ	TA,CURFIL	;GET FILE ADDRESS
	ANDI	TA,LMASKB
	IORI	TA,AS.FIL
REPEAT 0,<
	PUSHJ	PP,STASHQ
	TLNN	W1,(1B12)	;APPROX KEY?
	JRST	STRTG2		;NO, LITERAL DONE
	MOVE	TA,OPERND
	MOVEM	TA,CUREOP
	PUSHJ	PP,BMPEOP	;GET SIZE OF KEY
	  JRST	STRTG2		;ERROR
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHP
	SETZ	TA,
	PUSHJ	PP,STASHQ
	HRRZ	TA,CUREOP	;LOOK AT NEW OPERAND
	HLRZ	TA,1(TA)	;GET SIZE
	PUSHJ	PP,STASHQ
STRTG2:	PUSHJ	PP,POOL
>;END REPEAT 0
REPEAT 1,<
	PUSHJ	PP,POOLIT
>
	MOVE	CH,[MOV##+ASINC+AC16,,AS.MSC]
	PUSHJ	PP,PUTASY
REPEAT 0,<
	MOVEI	TE,1		;ASSUME 1 WORD LITERAL
	TLNE	W1,(1B12)	;APPROX KEY?
	ADDI	TE,1		;YES, NEEDS TWO WORDS
>
	SKIPN	CH,PLITPC
	HRRZ	CH,ELITPC
	SKIPN	PLITPC
REPEAT 0,<
	ADDM	TE,ELITPC	;NOW ACCOUNT FOR IT
>
REPEAT 1,<
	AOS	ELITPC
>
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN
REPEAT 1,<
	TLNN	W1,(1B12)	;APPROX KEY?
	JRST	STRTG3		;NO, LITERAL DONE
	MOVE	TA,OPERND
	MOVEM	TA,CUREOP
	PUSHJ	PP,BMPEOP	;GET SIZE OF KEY
	  JRST	STRTG3		;ERROR
	HRRZ	CH,CUREOP	;LOOK AT NEW OPERAND
	HLRZ	CH,1(CH)	;GET SIZE
	HRLI	CH,MOVEI.+AC1	;PUT SIZE IN AC1
	PUSHJ	PP,PUTASY
STRTG3:>
	MOVEI	CH,C.STRT##
	PUSHJ	PP,PUT.PJ
	PUSHJ	PP,CNVKYA	;CONVERT BACK
	PUSHJ	PP,RDGN10	;READ UP THRU NEXT OPERATOR
	CAIE	TE,SPIF.
	JRST	[PUSHJ	PP,RDGN6	;CHECK FOR USE PROCEDURE
		JRST	STRTG1]		;CHECK FOR DEBUGGING REQUIRED
	TLNN	W1,ATINVK	;ONLY INVALID KEY LEGAL
	JRST	RDGN6A		;GIVE ERROR MESSAGE
	PUSHJ	PP,SPIF74	;OK, GENERATE CODE
STRTG1:	MOVE	TA,CURFIL	;POINT TO FILE AGAIN
	LDB	CH,FI.DEB	;DEBUGGING ON THIS FILE
	JUMPN	CH,OPNGN4	;OUTPUT DEBUG STUFF
	POPJ	PP,		;NO
SUBTTL	START RMS FILE

;ARG-LIST IS:
;	STDW1
;	KEY OF REF,,ADDR OF KEY BUFFER
;	[LENGTH OF APPROXIMATE KEY]

STRTM:	MOVEI	TE,V%STRT	;THIS IS A START
	DPB	TE,O.BOPR	;TELL LIBOL

	LDB	TE,[POINT 2,W1,10] ;GET CONDITION CODE
	HRRZ	CH,[ST.MEQ##
		  ST.MGT##
		  ST.MNL##](TE)	;GET APPROPRIATE ROUTINE
	MOVEM	CH,ROUCAL	;SAVE ROUTINE TO CALL
	MOVE	TE,[0		;STA%EQ SET TO 0
		STA%GT
		STA%NL](TE)	;GET IO FLAG TO SET
	IORM	TE,IOFLGS	;SET IO FLAGS DEPENDING ON CONDITION
	SETOM	KEYREF		;SET TO -1 TO INDICATE "NO KEY GIVEN"
	MOVE	TA,OPERND
	MOVEM	TA,CUREOP	;PREPARE TO CALL BMPEOP
	PUSHJ	PP,BMPEOP	;SEE IF "KEY IS".. SPECIFIED
	 JRST	STRTM0		;NO "STA%EQ" EQUAL TO 0, GO ON
	HRRZ	TD,CUREOP	;LOOK AT THIS OPERAND
	MOVE	TA,1(TD)	;TA= SIZE,,KEY#
	HLRZM	TA,KEYRLN##	;LENGTH OF KEY OF REFERENCE
	HRRZM	TA,KEYREF##	;KEY#
	MOVX	TD,STA%AK	;PREPARE TO SET "APPROX KEY" BIT
	TLNE	TA,-1		;SKIP IF SIZE IS ZERO
	IORM	TD,IOFLGS	;SET BIT

;CHECK "INVALID KEY" CLAUSE
STRTM0:
	PUSHJ	PP,CNVKYB	;CHECK IF GENERATE KEY CONVERSION ROUTINE
	PUSHJ	PP,RDGN10	;READ THRU TO NEXT OPERATOR
	CAIE	TE,SPIF.
	 JRST	NOSMSP		;NO "SPECIAL IF"
	TLNE	W1,ATINVK	;ONLY INVALID KEY LEGAL
	 JRST	STRTM1		;OK
NOSMSE:	MOVEI	DW,E.319	;"INVALID KEY REQUIRED"
	JRST	RDGN7		;GIVE FATAL ERROR

;NO INVALID KEY SPECIFIED.. LOOK FOR A "USE" PROCEDURE
NOSMSP:	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	LDB	TE,FI.ERR##	;ERROR USE GIVEN
	JUMPE	TE,NOSMSE	;NO, GIVE ERROR

;USE PROCEDURE IS OK.. SET THE IOFLGS BIT
	MOVX	TE,STA%NI	;GET BIT
	IORM	TE,IOFLGS	;SET IT

;SET UP "KEY BUFFER ADDRESS"
STRTM1:	SKIPG	TE,KEYREF	;DO WE HAVE A KEY OF REFERENCE?
	 JRST	STRM1A		;NO, USE PRIMARY KEY'S ADDRESS
	CAIN	TE,1		;PRIMARY KEY?
	 JRST	STRM1A		;YES

;ALTERNATE KEY - FIND A KEY BUFFER ADDRESS
	LDB	TA,FI.ALK##	;FIND POINTER TO FIRST ALTERNATE KEY
	ADD	TA,AKTLOC	;GET ABS POINTER
	SUBI	TE,2		;TE= OFFSET INTO AKTTAB
	IMULI	TE,SZ.AKT	; * SIZE OF ENTRY = OFFSET TO FIRST WORD
	ADD	TA,TE		;TA POINTS TO ENTRY NOW
	LDB	TA,AK.DLK	;GET DATANAME LINK
	PUSHJ	PP,UKADR	; GET KEY ADDRESS
	JRST	STRM1B		;AND GO USE IT

;PRIMARY KEY - FIND A KEY BUFFER ADDRESS
STRM1A:	LDB	TA,FI.RKY	;GET RECORD KEY DATANAME
	PUSHJ	PP,UKADR	; GET KEY ADDRESS

STRM1B:	EQUIT;			;QUIT IF ERRORS SO FAR
	PUSH	PP,ELITPC	;SAVE LITERAL PC
	PUSHJ	PP,STDW1	;STD 1ST WORD OF ARG LIST
	AOS	ELITPC		;BUMP LITERAL PC

;WRITE KEY OF REF,,ADDR OF KEY
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHP
	SKIPG	TA,KEYREF	;KEY OF REFERENCE GIVEN?
	TDZA	TA,TA		;NO, PRETEND HE SAID PRIMARY-KEY
	SUBI	TA,1		;MAKE PRIMARY=0, 1ST ALTERNATE=1, ETC.
	PUSHJ	PP,STASHQ	;XWD KEYREF,
	MOVE	TA,KEYADR##	;GET KEY ADDRESS
	PUSHJ	PP,STASHQ	;WRITE THAT

	SKIPN	KEYRLN		;SKIP IF APPROX. KEY
	 JRST	STRTM2		;NO
	AOS	ELITPC		;BUMP LITERAL PC

	MOVE	TA,[OCTLIT,,1]	;WRITE LENGTH OF APPROX. KEY
	PUSHJ	PP,STASHP	; HEADER
	HRRZ	TA,KEYRLN	;GET LENGTH
	PUSHJ	PP,STASHQ	;WRITE IT OUT

STRTM2:	PUSHJ	PP,POOL		;POOL THE LITERAL IF WE CAN
	POP	PP,CH		;RESTORE LITERAL BASE
	SKIPN	PLITPC		;DID WE POOL?
	 AOSA	ELITPC		;NO, FIX ELITPC AND SKIP
	MOVEM	CH,ELITPC	; POOLED, RESTORE ORIGINAL
	SKIPE	PLITPC		;SKIP IF WE DIDN'T POOL
	MOVE	CH,PLITPC	;YES, GET BASE ADDR OF ARG LIST
	IORI	CH,AS.LIT	;MAKE IT LOOK LIKE A LITERAL
	PUSH	PP,CH
	MOVE	CH,[MOVEI.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	POP	PP,CH
	PUSHJ	PP,PUTASN	;FINISH MOVEI

	HRRZ	CH,ROUCAL	;GET SAVED ROUTINE TO CALL
	PUSHJ	PP,PUT.PJ	;GENERATE THE PUSHJ
	PUSHJ	PP,CNVKYA	;CHECK IF GENERATE KEY CONVERSION ROUTINES

;IF THERE WAS AN "INVALID KEY" CLAUSE GIVEN, GENERATE THE SPIF CODE,
; ELSE DO THE "USE" PROCEDURE STUFF
	MOVE	TE,IOFLGS
	TXNN	TE,STA%NI	;WAS "INVALID KEY" CLAUSE GIVEN?
	 JRST	SPIFGC		;YES, GO DO "SPECIAL IF" STUFF

;GET A USE PROCEDURE
	HLRZ	TA,CURFIL
	ADD	TA,FILLOC	;POINT TO FILTAB ENTRY
	LDB	TA,FI.ERR##	;ERROR USE GIVEN
	JUMPN	TA,RDGN5B	;YES, USE IT
	HALT	.		;??WE CHECKED EARLIER
SUBTTL	DELETE

DELGEN:	PUSHJ	PP,SETOP	;SET UP OPERAND
	EQUIT;			;QUIT IF ERRORS
	MOVEI	CH,DELETE##
	MOVEM	CH,EIOOP
	LDB	TE,[POINT 3,CURFIL,2]
	CAIE	TE,CD.FIL	;MAKE SURE ITS A FILE TABLE
	POPJ	PP,		;NO, GIVE UP BEFORE HARM IS DONE
	MOVE	TA,CURFIL
	LDB	TE,FI.RMS	;CHECK FOR RMS DELETE
	JUMPN	TE,DELM		;YES, GO DO IT
	PUSHJ	PP,RDGN0	;DON'T GENERATE XWD TO FOLLOW
	JRST	STRTG1		;GENERATE DEBUGGING CODE IF REQUIRED


;GENERATE CODE FOR 'NO-OP'

NOOPGN::PUSHJ	PP,PUTASA##
	MOVSI	CH,JFCL.##
	JRST	PUTASY
SUBTTL	DELETE RMS RECORD

;GENERATE AN RMS DELETE
;LH (CURFIL) POINTS TO THE FILE TABLE.

;ARG-LIST:
;	STDW1
;	[ADDRESS OF KEY BUFFER]  ;RANDOM DELETES ONLY

DELM:	MOVEI	TE,V%DELT	;TELL LIBOL THIS IS A DELETE
	DPB	TE,O.BOPR	; . .

	PUSHJ	PP,CNVKYB	;CHECK IF GENERATE KEY CONVERSION ROUTINE
	PUSHJ	PP,RDGN10	;READ UP THRU NEXT OPERATOR
	CAIN	TE,SPIF.	; INVALID KEY GIVEN?
	TLNN	W1,ATINVK	;SKIP IF TRUE
	JRST	DELM2		;NO

;NOTE: IF USER SAID "AT END" INSTEAD OF "INVALID KEY",
; COBOLD SAID "STATEMENT EXPECTED" AND PASSED "NOOP".
;DELM2 MAY NOW POINT TO "DELETE" AND SAY "INVALID KEY
; REQUIRED".

;"INVALID KEY CLAUSE GIVEN.. MAKE SURE FILE IS NOT SEQ. ACCESS.
	HLRZ	TA,CURFIL
	ADD	TA,FILLOC
	LDB	TE,FI.FAM
	CAIN	TE,%FAM.S	;SEQ ACCESS MODE?
	 JRST	BADIKY		;YES, COMPLAIN
	JRST	DELM3		;INVALID KEY GIVEN, AND IS OK

;HERE IF "INVALID KEY" CLAUSE NOT SUPPLIED FOR "DELETE".
; IF FILE IS SEQ. ACCESS, OR THERE IS A USE PROCEDURE, THIS IS OK.
DELM2:	HLRZ	TA,CURFIL	;MAKE TA POINT TO FILTAB ENTRY
	ADD	TA,FILLOC
	LDB	TE,FI.FAM
	CAIE	TE,%FAM.S	;SEQUENTIAL ACCESS?
	 JRST	DELM2B		;NO, GO LOOK FOR USE PROC
	LDB	TE,FI.ORG	;GET FILE ORGANIZATION
	JUMPN	TE,DELM3	;SEQUENTIAL?
	MOVEI	DW,E.729	;YES, DELETE NOT ALLOWED FOR ORG SEQ.
	JRST	RDGN7		;GO REPORT FATAL DIAG.

;THERE BETTER BE A USE PROCEDURE
DELM2B:	LDB	TA,FI.ERR	;CHECK FOR FILE-SPECIFIC ERROR PROC.
	JUMPN	TA,DELM2A	;YES, SET BIT
	SKIPE	USP.IO##	;BETTER BE A GENERAL I-O USE PROCEDURE
	 JRST	DELM2A		;OK, SET BIT

	MOVEI	DW,E.319	;"INVALID KEY REQUIRED"
	JRST	RDGN7

;USE PROCEDURE WAS GIVEN.. SET IOFLGS BIT
DELM2A:	MOVX	TE,DL%NIK	;"NO INVALID KEY GIVEN"
	IORM	TE,IOFLGS	;SET THE BIT

DELM3:
	;FIGURE OUT IF WE HAVE SEQUENTIAL ACCESS, AND IF SO SET THE BIT

	MOVX	TE,DL%SEQ	;SET UP THE SEQUENTIAL ACCESS BIT
	MOVE	TA,CURFIL	;GET FILE'S FILE TABLE ADDRESS
	LDB	TD,FI.FAM	;GET ITS ACCESS AND TEST FOR SEQUENTIAL
	CAIN	TD,%FAM.S	;
	 IORM	TE,IOFLGS	; IS SEQUENTIAL SO TURN ON THE BIT

;GET A ROUTINE, DEPENDING ON THE FILE ACCESS MODE

	MOVEI	CH,DL.MIR##	;ASSUME RANDOM
	HLRZ	TA,CURFIL
	ADD	TA,FILLOC	;POINT TO FILTAB ENTRY
	LDB	TD,FI.FAM	;IF ACCESS IS
	CAIN	TD,%FAM.S	; SEQUENTIAL,
	MOVEI	CH,DL.MIS##	; USE "SEQ. DELETE"
	MOVEM	CH,ROUCAL	;SAVE ROUTINE TO CALL

;IF THIS IS A RANDOM DELETE, GET THE KEY BUFFER ADDRESS
	CAIN	TD,%FAM.S	;SEQUENTIAL ACCESS?
	 JRST	[PUSHJ PP,STDAGL ;YES, JUST DO STD. ARG LIST
		JRST DELM4]	;AND LEAVE
	LDB	TA,FI.RKY	;GET PTR TO RECORD KEY
	PUSHJ	PP,UKADR	;SET UP KEYADR
	EQUIT;			;QUIT IF ERRORS
	PUSH	PP,ELITPC	;SAVE LIT PC
	PUSHJ	PP,STDW1	;STD. FIRST WORD
	AOS	ELITPC		;BUMP LITERAL PC

;WRITE 0,,ADDR-OF-KEY
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHP
	SETZ	TA,		;0
	PUSHJ	PP,STASHQ
	MOVE	TA,KEYADR	;GET KEY ADDRESS
	PUSHJ	PP,POOLIT	;FINISH XWD, AND LITERAL POOL

	MOVE	CH,[MOVEI.+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY	;START MOVEI OR ARG LIST.
	POP	PP,CH		;GET OLD LITERAL PC
	SKIPN	PLITPC		;DID WE POOL?
	AOSA	ELITPC		;NO, BUMP LITERAL PC
	MOVEM	CH,ELITPC	;YES, RESTORE ORIGINAL
	SKIPE	PLITPC		;SKIP IF WE DIDN'T
	MOVE	CH,PLITPC	;GET THE POOLED VALUE
	IORI	CH,AS.LIT	; MAKE IT LOOK LIKE A LITERAL
	PUSHJ	PP,PUTASN	;FINISH ARG

DELM4:	MOVE	CH,ROUCAL	;GET ROUTINE TO CALL
	PUSHJ	PP,PUT.PJ	;GENERATE THE CALL
	PUSHJ	PP,CNVKYA	;CHECK IF GENERATE KEY CONVERSION ROUTINES

;SEE IF INVALID KEY CLAUSE WAS SUPPLIED, AND GO TO "SPIFGC" IF SO.
	HRRZ	TE,W2		;GET OPERATOR CODE FOR NEXT OPERATOR
	CAIN	TE,SPIF.	;WAS IF "SPECIAL IF"?
	 JRST	SPIFGC		;GO GEN THE CODE

;NO INVALID KEY CLAUSE. IF USE PROCEDURE, GEN CALL TO THAT,
; ELSE GEN "NOOP".  THEN GO ON TO NEXT OPERATOR ACTION.
	HRRZ	TA,CURFIL	;[1536] RESET AC16
	LDB	TE,FI.FAM	;GET ACCESS MODE
	CAIN	TE,%FAM.S	;IS SEQENTIAL,
	 JRST	NODUSE		; JUST GENERATE "NOOP"
	LDB	TA,FI.ERR	;CHECK FOR FILE-SPECIFIC ERROR PROCEDURE
	JUMPE	TA,[SKIPE TB,USP.IO##	;NO, SEE IF A GENERAL USE PROCEDURE
		JRST	DLMG5C		;OK, USE IT
		JRST	NODUSE]		;NO, GENERATE "NOOP"
DLMG5A:	LDB	TB,LNKCOD
	CAIE	TB,CD.PRO
	JRST	DLMG6A		;NOT A PROTAB LINK
	PUSHJ	PP,LNKSET
	MOVE	TB,PR.DUP##(TA)	;GET PR.SFI AND PR.DEB
DLMG5C:	MOVE	CH,[JRST.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZI	CH,AS.DOT+2	;"JRST .+2"
	TLNE	TB,-1		;DEBUGGING ON PROCEDURE NAME
	ADDI	CH,3		;NEED MORE SPACE
	PUSHJ	PP,PUTASN	;"OK" RETURN
	TLNN	TB,-1		;IF NOT DEBUGGING..
	 JRST	DLMG5D		;DON'T GENERATE SPECIAL CODE

;GENERATE:	SKIPA 16,.+1
;		XWD DPB%UP,LINE #
;		MOVEM 16,%PARAM+N
;
	PUSHJ	PP,IODBU	;GENERATE THE CODE..

DLMG5D:	MOVE	CH,TB		;GET TAG
	HRLI	CH,EPJPP	;PUSHJ PP,
	PUSHJ	PP,PUTASY	;EOF RETURN
	PUSHJ	PP,CRHLD	;CREATE HLDTAB ENTRY
	JRST	ENDIFR##	;??? NOT SURE..

DLMG6A:	MOVEI	DW,E.319	;"INVALID KEY REQUIRED"
	JRST	RDGN7		;GO GIVE ERROR


NODUSE:	PUSHJ	PP,NOOPGN	;GENERATE NOOP, SINCE
				;NO "INVALID KEY" RETURN IS USED FOR
				;SEQ. ACCESS FILES
	JRST	GO2NXT		;AND GO TO NEXT OPERATOR ACTION

BADIKY:	MOVEI	DW,E.735	;"INVALID KEY" ILLEGAL WHEN FILE IS SEQ ACCESS
	MOVE	TC,OPLINE
	LDB	CP,TCCP
	LDB	LN,TCLN
	PJRST	FATAL##		;MAKE THIS A DIAG
SUBTTL	DISPLAY

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

	TLNE	W1,CONSOL	;"UPON" OPTION USED ?
	PUSHJ	PP,EDUPON	;YES--CHECK IT OUT

FSTRY:	MOVEM	EACA,EOPNXT	;POSITION OF LAST OPERAND SEEN INTO EOPNXT

	MOVE	EACA,EOPLOC	;GET POINTER TO BEGINNING OF TABLE
				;NOT TO 1ST USED SLOT
	HRRZM	EACA,CUREOP	;CURRENT ENTRY BEING USED IN EOPTAB
				;IS ONE HELD IN CUREOP.

	AOSA	EACA,CUREOP	;NOW WE POINT TO 1ST USED ENTRY, 1ST WORD...

GOTMOR:	HRRZ	EACA,CUREOP	;GET NEXT DEEPEST ENTRY
	MOVSM	EACA,OPERND	;  IN OPERAND TABLE
	MOVE	EACB,(EACA)	;GET 1ST WORD OF NEXT OPERAND
	MOVEI	EACA,1(EACA)	;BUMP EACA TO POINT TO SECOND WORD
	TLNE	EACB,GNLIT	;IS IT A LITERAL ?
	JRST	DISLIT		;YEP !


;OK, IT'S NOT A LITERAL:
;EITHER IT REQUIRES CONVERSION (& MXTMP. WILL WORRY ABOUT SUBSCRIPTING, ETC,)
;OR IT'S DISPLAY-7 OR DISPLAY-6, IN WHICH CASE YOU WORRY ABOUT SUBSCRIPTING.

	SETOM	EDEBDA##	;SIGNAL WE MIGHT WANT TO DEBUG
	SOS	EDEBDA		; BUT ONLY IF "ON ALL REF".
	MOVE	TA,(EACA)	;GET OPERAND TABLE-LINK
	MOVSM	TA,CURDAT	;  AND SAVE IT
	PUSHJ	PP,LNKSET	;CONVERT TO ADDRESS
	HRRM	TA,CURDAT	;  AND SAVE THAT
	LDB	TC,[POINT 3,CURDAT,2]	;GET TABLE TYPE
	CAIN	TC,CD.MNE	;IS IT A MNEMONIC
	JRST	DISSYC		;YES, MUST BE A SYMBOLIC CHARACTER
	LDB	TC,DA.USG	;GET USAGE OF OPERAND
	JRST	@DISPDO(TC)	;DO WHAT TABLE SENDS YOU TO DO

DISPDO:	EXP	ENDTST		; _ 0	TYPE NO YET ASSIGNED
	EXP	DISPD6		; _ 1	DISPLAY-6
	EXP	DISPD7		; _ 2	DISPLAY-7
	EXP	STNDRD		; _ 3	DISPLAY-9
	EXP	STNDRD		; _ 4	1 WORD COMP
	EXP	STNDRD		; _ 5	2 WORD COMP
	EXP	DISPFP		; _ 6	COMP-1
	EXP	STNDRD		; _ 7	INDEX
	EXP	STNDRD		; _ 10	COMP-3
	EXP	DISPF2		; - 11	COMP-2
;"DISPLAY" GENERATOR (CONT'D).

;NOW CALL ON THE MOVE GENERATOR FOR A LITTLE HELP


STNDRD:	HRRZ	TC,CUREOP
	PUSHJ	PP,MXTMP.	;MOVE X TO A TEMP., GENERATING CONVERSION
	TSWF	FERROR		;ANY TROUBLE?
	JRST	ENDTST		;YES--IGNORE THIS OPERAND

	MOVE	EACD,TA		;SAVE CALL PARAMETERS
	MOVE	EACC,TB

STND1:	TLNE	W1,NOADV	;IS IT 'WITH NO ADVANCING'?
	JRST	STND2		;YES--DON'T WORRY ABOUT 'END-OF-LINE' FLAG

	MOVE	TC,CUREOP	;SAVE ADDRESS OF THIS OPERAND
	PUSHJ	PP,BMPEOP	;ANY MORE OPERANDS?
	TLO	EACC,1B<^D18+7>	;NO--SET "END-OF-LINE" FLAG
	MOVEM	TC,CUREOP	;RESET ADDRESS OF CURRENT OPERAND

STND2:	PUSHJ	PP,DEPTSA	;[1636] See if A is depending
	 JRST	STND2A		;[1636] No
	AOS	EAC		;[1636] Allocate register 1
 	MOVEI	TE,1		;[1636]
        PUSHJ	PP,SZDPVA	;[1636] Set AC1 to size of A
         JFCL			;[1636]
	MOVE	CH,[XWD MOV+AC16,1];[1636] get size into 16
	PUSHJ	PP,PUTASY	;[1636]		MOVE 16,1
	MOVEI	CH,DSPLY%##	;[1636]	CALL display routine
	PUSHJ	PP,GNPSX.##	;[1636]		PUSHJ PP,DSPLY.
	POPJ	PP,		;[1636]

STND2A:	MOVE	TA,[XWD XWDLIT,2]	;[1636]
	PUSHJ	PP,STASHP
	MOVE	TA,EACC
	MOVE	TE,ESIZEA	;GET SIZE OF OPERAND
	CAIG	TE,1777		;WILL IT FIT IN 10 BITS?
	JRST	STND3		;YES
	TLZ	TA,1B<^D18+7>	;NO--TURN OF 'END-OF-LINE'
	MOVEI	TE,^D1020	;CHANGE SIZE TO 1000
STND3:	TLZ	TA,1777		;USE SIZE IN 'TE'
	TLO	TA,(TE)
	MOVNS	TE
	ADDM	TE,ESIZEA
	PUSHJ	PP,STASHQ
	MOVE	TA,EACD
	PUSHJ	PP,POOLIT

	HRRZ	TE,EMODEB 	;MODE OF ITEM IS IN 'B'
	CAIE	TE,D6MODE	;SIXBIT IS SPECIAL
	SKIPA	CH,[XWD DSPLY.+ASINC,AS.MSC]
;	MOVE	CH,[MOVEI.##+AC16+ASINC,,AS.MSC]
	MOVE	CH,[DSPL.6##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	SKIPN	CH,PLITPC
	HRRZ	CH,ELITPC
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN
	SKIPN	PLITPC
	AOS	ELITPC
;	HRRZ	TE,EMODEB
;	MOVEI	CH,DSPL.6##
;	CAIN	TE,D6MODE
;	PUSHJ	PP,PUT.PJ	;FINISH OFF SIXBIT

	SKIPN	ESIZEA		;IS OPERAND COMPLETELY OUT?
	JRST	ENDTST		;YES--LOOK FOR NEXT ONE

	MOVE	TA,EMODEA	;NO
	CAIN	TA,D6MODE
	SKIPA	TA,[EXP ^D1020/6]
	MOVEI	TA,^D1020/5
	HRLZ	TA,TA
	ADD	EACD,TA		;BUMP ADDRESS
	JRST	STND1
;ITEM TO BE DISPLAYED IS ASCII

DISPD6:
DISPD7:	MOVE	TC,CUREOP	;SET UP PARAMETERS IN "A"
	MOVEI	LN,EBASEA
	PUSHJ	PP,SETOPN
	TSWF	FERROR		;ANY TROUBLE?
	JRST	ENDTST		;YES--FORGET THIS OPERAND

	TSWT	FANUM		;NUMERIC?
	TSWT	FASUB		;NO--SUBSCRIPTED?
	JRST	STNDRD		;EITHER NUMERIC OR NOT SUBSCRIPTED

;NON-NUMERIC AND SUBSCRIPTED -- USE "SUBSC." UUO

	MOVE	TA,CURDAT
	HRRZ	TB,ESIZEA	;USE INTERNAL SIZE UNLESS
	LDB	TE,DA.EDT	;  ITEM IS
	SKIPE	TE		;  EDITED,
	LDB	TB,DA.EXS	;  IN WHICH CASE USE EXTERNAL SIZE
	HRRM	TB,ESIZEA
	CAILE	TB,1777		;BIG DISPLAY?
	 JRST	DISP7C		;YES-- GO DO IT IN 2 OR MORE STEPS

	MOVEI	DT,ESAVES
	PUSHJ	PP,BMPEOP
;	TLNN	W1,NOADV	; [345] IF NO ADVANCING SKIP OVER LINE END SETTING
	SKIPA			; [366] NO MORE ITEMS TO DISPLAY FINISH.
	JRST	DISP7A		; [366] MORE ITEMS TO DISPLAY
	TLNN	W1,NOADV	; [366] IF NO ADVANCING, SKIP OVER
				; [366] LINE END SETTING
	IORI	TB,1B<^D18+7>
DISP7A:	MOVEM	TB,SUBCON
	MOVS	TC,OPERND
	MOVEM	TC,CUREOP
	PUSHJ	PP,SUBSCR
	JRST	DISP7B		;ALL SUBSCRIPTS WERE NUMERIC LITERALS

	HRRZ	TE,EMODEA
	CAIN	TE,D6MODE	;SIXBIT IS SPECIAL
	SKIPA	CH,[DSPL.6,,SXR]
	MOVE	CH,[XWD DSPLY.,SXR]
	PUSHJ	PP,PUTASY
	JRST	ENDTST

DISP7B:	MOVE	EACC,TE
	HRRI	EACC,AS.CNB
	MOVS	EACD,TE
	HRR	EACD,EBASEA
	MOVE	TE,EMODEA	;SINCE CODE AFTER STND2 USES
	MOVEM	TE,EMODEB	;EMODEB TO CHECK FOR ASCII ITEM
	JRST	STND2

DISP7C:	SUBI	TB,^D1020	;FIRST WE WILL DO 1020 CHARACTERS
	HRRZM	TB,ESIZEZ	;ESIZEZ = CHARS LEFT TO MOVE
	MOVEI	TE,^D1020
	MOVEM	TE,SUBCON	;SET SUBCON TO 1020 CHARS - NO ADVANCING!
	MOVS	TC,OPERND
	MOVEM	TC,CUREOP
	MOVEI	DT,ESAVES
	PUSHJ	PP,SUBSCR	;CALL SUBSCRIPT ROUTINE
	 JRST	DISP7B		; ALL WERE NUMERIC LITERALS

DISP7D:	HRRZ	TE,EMODEA
	CAIN	TE,D6MODE	;SIXBIT IS SPECIAL
	SKIPA	CH,[DSPL.6,,SXR]
	MOVE	CH,[XWD DSPLY.,SXR]
	PUSHJ	PP,PUTASY

	SKIPN	ESIZEZ		;MORE CHARS TO MOVE?
	 JRST	ENDTST		;NO, DONE WITH THIS DISPLAY

	CAIN	TE,D6MODE
	SKIPA	CH,[^D1020/6]
	MOVEI	CH,^D1020/5	;NUMBER OF WORDS TO BUMP SAC
	HRLI	CH,ADDI.+SAC	;GENERATE "ADDI SAC,#WORDS ALREADY DISPLAYED"
	PUSHJ	PP,PUTASY

	HRRZ	TE,ESIZEZ	;GET CHARS LEFT TO MOVE
	CAILE	TE,1777		;STILL BIG?
	 JRST	DISP7E		;YES--DO ANOTHER ^D1020

;DO THE LAST OF 'EM, SETUP "EOL" FLAG IN AC12 IF NECESSARY
;HAVE TO CHANGE THE SIZE IN LH (AC12) IF DIFFERENT FROM 1020

	PUSH	PP,CUREOP	;SAVE TO RESTORE AFTER "BMPEOP"
	SETZ	TC,		;TC= 0 IF WE DON'T WANT EOL AT END
	PUSHJ	PP,BMPEOP
	SKIPA			;NO MORE ITEMS TO DISPLAY
	JRST	DISP7F		;FINISH UP
	TLNE	W1,NOADV	;NO ADVANCING?
	 JRST	DISP7F		;YES, DON'T SET EOL FLAG
	HRRI	TC,1B<^D18+7>	;EOL BIT IN TD
DISP7F:	POP	PP,CUREOP	;RESTORE CUREOP (THIS OPERAND)
	MOVE	CH,[TLZ.+SAC,,3777]
	PUSHJ	PP,PUTASY	;"TLZ SAC,3777" TO CLEAR OLD PARAMETERS
	HRLI	CH,TLO.+SAC
	HRR	CH,ESIZEZ	;SIZE LEFT TO DO
	IOR	CH,TC		;POSSIBLY SET EOF BIT
	PUSHJ	PP,PUTASY	;"TLO SAC,NEW.PARAMETERS"
	SETZM	ESIZEZ		;NO MORE CHARS TO MOVE!
	JRST	DISP7D		; GO DO ANOTHER DSP. UUO

;DO ANOTHER ^D1020 CHARACTER DISPLAY -- SAME PARAMS IN SAC
DISP7E:	MOVEI	TE,^D1020
	MOVN	TD,TE		;-CHARS TO MOVE THIS TIME
	ADDM	TD,ESIZEZ	; HOPEFULLY GET TO LESS THAN 1777 SOMETIME
	JRST	DISP7D		;GO DO ANOTHER UUO
;DISPLAY A COMP-1 FIELD

DISPFP:	MOVE	TC,CUREOP
	MOVEI	LN,EBASEA
	PUSHJ	PP,SETOPN
	TSWF	FERROR;
	JRST	ENDTST
	SETZM	EAC
	PUSHJ	PP,MXAC.
	MOVEI	CH,DSP.FP
DISPF3:	PUSHJ	PP,PUT.PJ
	MOVE	TC,CUREOP
	PUSHJ	PP,BMPEOP
	  JRST	DISFP1
	SETZM	ETEMPC
	JRST	GOTMOR

DISFP1:	MOVEM	TC,CUREOP
	PUSHJ	PP,ASRJ.
	MOVSI	EACC,446001
	HRRI	EACC,AS.CNB
	MOVS	EACD,EASRJ
	HRRI	EACD,AS.MSC
	MOVEI	TE,1
	MOVEM	TE,ESIZEA
	MOVEI	TE,D7MODE	;MAKE B'S MODE DISPLAY-7.
	MOVEM	TE,EMODEB	;BECAUSE STND2 THINKS ORIGINAL MODE OF "A" IS IN "B"
	JRST	STND2

;DISPLAY A COMP-2 FIELD

DISPF2:	MOVE	TC,CUREOP
	MOVEI	LN,EBASEA
	PUSHJ	PP,SETOPN
	TSWF	FERROR;
	JRST	ENDTST
	SETZM	EAC
	PUSHJ	PP,MXAC.
	MOVEI	CH,DSP.F2##
	JRST	DISPF3		;JOIN COMMON CODE
;"DISPLAY" GENERATOR (CONT'D)

;DISPLAY A LITERAL

DISLIT:	TLNE	EACB,GNFIGC	;IS IT A FIG. CONST.?
	JRST	DISFC		;YES

	MOVEI	LN,EBASEA	;NO--SET UP PARAMETERS
	HRRZ	TC,CUREOP
	PUSHJ	PP,SETOPN
	TSWF	FERROR		;ANY TROUBLE?
	JRST	ENDTST		;YES--FORGET THIS ONE

	MOVE	TE,[XWD EBASEA,EBASEB]	;MAKE "B" LOOK LIKE "A"
	BLT	TE,EBASBX
	MOVEI	TE,D7MODE	;MAKE B'S MODE DISPLAY-7.
	MOVEM	TE,EMODEB

	MOVEI	TE,2
	MOVEM	TE,ADCRLF##	;SEE IF WE NEED CR-LF OF JUST NULL
	TLNE	W1,NOADV	;IS IT 'WITH NO ADVANCING'?
	JRST	DISLT1		;YES--DON'T WORRY ABOUT 'END-OF-LINE' FLAG
	MOVE	TC,CUREOP	;SAVE ADDRESS OF THIS OPERAND
	PUSHJ	PP,BMPEOP	;ANY MORE OPERANDS?
	  AOSA	ADCRLF		;NO, ADD CR-LF
DISLT1:	SOS	ADCRLF		;YES, JUST NULL REQUIRED
	MOVEM	TC,CUREOP	;RESET ADDRESS OF CURRENT OPERAND
	PUSHJ	PP,LITD.
	SETZM	ADCRLF
REPEAT 0,<
	MOVS	EACD,EINCRA
	HRRI	EACD,AS.MSC
	MOVE	EACC,[EXP ^D36B5+AS.CNB]
	MOVE	TE,ESIZEA
	DPB	TE,[POINT 7,EACC,17]

	JRST	STND1
>
	MOVE	CH,[DSPL.7##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,EINCRA
	ANDI	CH,077777
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN
	JRST	ENDTST		;SEE IF MORE
;"DISPLAY" GENERATOR (CONT'D)

;DISPLAY A FIGURATIVE CONSTANT

DISFC:	TLNE	EACB,GNTIME	;"DATE", "DAY", "TIME"
	JRST	STNDRD		;YES--USE STANDARD ROUTINE

	TLNE	EACB,GNFCS	;SPACE?
	JRST	FIGC1
	TLNE	EACB,GNFCZ	;ZERO
	JRST	FIGC2
	TLNE	EACB,GNFCQ	;QUOTE?
	JRST	FIGC3
	TLNE	EACB,GNFCHV	;HIGH-VALUE
	JRST	FIGC4
	TLNE	EACB,GNFCLV	;LOW-VALUE
	JRST	FIGC5

	MOVEI	DW,E.184	;NONE OF THE ABOVE
	PUSHJ	PP,OPNFAT
	JRST	ENDTST

FIGC1:	MOVSI	TA,(BYTE(7)" ")	; A SPACE
	JRST	FIGC6

FIGC2:	MOVSI	TA,(BYTE(7)"0") ; A ZERO
	JRST	FIGC6

FIGC3:	MOVSI	TA,(BYTE(7)"""") ; A QUOTE
	JRST	FIGC6

FIGC4:	MOVSI	TA,(BYTE(7)177)	; A NORMAL HIGH-VALUE
	SKIPG	COLSEQ##	;PROGRAM COLLATING SEQUENCE?
	JRST	FIGC6		;NO
	HRRZ	TA,COHVLV##+1	;YES, GET ASCII HIGH-VALUE CHAR.
	JRST	FIGC7		;LEFT JUSTIFY

FIGC5:	MOVSI	TA,(BYTE(7)0)	; A NORMAL LOW-VALUE
	SKIPG	COLSEQ		;PROGRAM COLLATING SEQUENCE?
	JRST	FIGC6		;NO
	HRRZ	TA,COHVLV+4	;YES, GET ASCII LOW-VALUE CHAR.
FIGC7:	ROT	TA,-7		;LEFT JUSTIFY

FIGC6:	PUSH	PP,TA		;SAVE LITERAL WE WANT
	MOVE	TA,[XWD ASCLIT##,1]
	PUSHJ	PP,STASHP
	POP	PP,TA		;GET LITERAL WE WANT
	MOVE	TC,CUREOP
	PUSHJ	PP,BMPEOP	;ANY MORE OPERANDS?
	  TLNE	W1,NOADV	;NO MORE, BUT IS NO ADVANCING SET?
	JRST	FIGC8		;MORE TO FOLLOW, LEAVE AS IS
	SKIPE	TA		;IS IT A NUL?
	TDOA	TA,[BYTE(7)0,15,12,0,0] ;NO, APPEND <CRLF>
	MOVSI	TA,(BYTE(7)15,12) ;YES, CONVERT TO <CRLF>
FIGC8:	MOVEM	TC,CUREOP
	PUSHJ	PP,POOLIT
	SKIPN	EACC,PLITPC
	MOVE	EACC,ELITPC
	SKIPN	PLITPC
	AOS	ELITPC
	MOVE	CH,[DSPL.7##+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVE	CH,EACC
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN
	JRST	ENDTST

;Enter here with a MNETAB entry. TA contains table address, also in CURDAT.
;This should point to a symbolic character.

DISSYC:	LDB	TB,MN.SYC##	;MAKE SURE IT REALY IS A SYMBOLIC CHARACTER
	JUMPE	TB,FIGC6	;NO, OUTPUT A NUL
	LDB	TB,MN.ESC##	;SEE IF EBCDIC
	LDB	TA,MN.SCV##	;GET CHARACTER
	JUMPE	TB,FIGC7	;OK ITS ASCII
	MOVE	TE,TA		;GET READY TO CONVERT TO ASCII
	PUSHJ	PP,VLIT9A##	;CONVERT TO ASCII IN TE
	MOVE	TA,TE
	JRST	FIGC7		;LEFT JUSTIFY AND OUTPUT IT
;"DISPLAY" GENERATOR  (CONT'D).

ENDTST:	PUSHJ	PP,CDEBA##	;COPY LAST INDENTIFIER TO DEBUG LIST
	PUSHJ	PP,BMPEOP	;ANY MORE OPERANDS?
	  PJRST	GDEBV##		;NO, DUMP THE DEBUG LIST AND RETURN
	SETZM	ETEMPC		;YES--RESET %TEMP BASE
	JRST	GOTMOR		;CONTINUE PROCESSING


EDUPON:	HRRZ	TA,(EACA)	;GET TABLE ENTRY FOR "UPON" OPERAND
	CAIL	TA,700001
	CAILE	TA,777777	;BETWEEN COARSE LIMITS OF MNEMONIC TABLE?
	JRST	BADNEW		;BAD NEWS, NOT A MNEM TABLE LINK


	PUSHJ	PP,LNKSET	;CONVERT TO REAL ADDRESS
	MOVE	EACB,1(TA)	;GET MNEMONIC TABLE ENTRY
	TLNE	EACB,1B21	;CONSOLE FLAG UP ?
	JRST	REPOS		;YES   HE'S AOK
				;REPOSITION POINTER TO LOOK AT LAST
				;"WRIT-ABLE" ITEM.


BADNEW:	MOVEI	DW,E.102
	PUSHJ	PP,EWARN

REPOS:	SUB	EACA,[XWD 2,2]	;BACK OFF EACA
	CAMN	EACA,EOPLOC	;WAS THAT THE ONLY OPERAND?
	JRST	BADEOP		;YES--TROUBLE
	POPJ	PP,		;NO--RETURN
SUBTTL	ACCEPT

ACCGEN:	MOVEM	W1,OPLINE	;SAVE LN&CP OF OPERATOR
	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;ANY OPERANDS?
	JRST	BADEOP		;NO--TROUBLE
	MOVE	TA,-1(EACA)	;GET 2ND OPERAND
	TLNE	TA,GNFIGC	;FIG. CONST?
	JRST	ACCTDY		;YES

	TLNE	W1,CONSOL
	PUSHJ	PP,EDUPON
	MOVEM	EACA,EOPNXT	;SAVE UDPATED EOPNXT

	HRRZ	TC,EOPLOC
	ADDI	TC,1
	MOVEM	TC,CUREOP

	SWOFF	FASUB!FALWY0	;AC'S NOT SUBSCRIPTED AND NOT ZERO

ACEPT1:	MOVEM	TC,OPERND
	SETOM	EDEBDB##	;SIGNAL WE MIGHT WANT TO DEBUG
	MOVEI	LN,EBASEB
	PUSHJ	PP,SETOPN

	TSWF	FERROR		; [430] ANY ERRORS?
	JRST	ACEPT6		; [430] YES--DON'T BOTHER WITH THE REST

	MOVE	TE,[XWD EBASEB,EBASEA]	;SET "A" EQUAL TO "B"
	BLT	TE,EBASAX

	MOVE	TA,CUREOP	;IS "B" EDITED?
	MOVE	TA,1(TA)
	PUSHJ	PP,LNKSET
	LDB	TE,DA.EDT
	JUMPE	TE,ACEPT2
	MOVEI	TD,EDMODE	;YES--RESET MODE TO
	HRRM	TD,EMODEB	;  'EDITED'

ACEPT2:	HRLZ	TC,ESIZEB
	PUSHJ	PP,BMPEOP
	TLO	TC,1B<^D18+7>
	MOVSM	TC,SUBCON

	MOVE	TC,OPERND
	MOVEM	TC,CUREOP

	MOVE	TE,0(TC)
	TLNE	TE,GNOPNM
	JRST	ACEP15
;"ACCEPT" GENERATOR  (CONT'D).

;FIELD IS ALPHANUMERIC

	HRRZ	TE,EMODEB
	CAIE	TE,D7MODE
	JRST	ACEP10

	HRRZ	TE,EMODEB
	CAIN	TE,EDMODE
	JRST	ACEP10

	TSWT	FBSUB;
	JRST	ACEPT5

	MOVEI	DT,ESAVSB
	PUSHJ	PP,SUBSCR
	JRST	ACEPT4

	MOVE	CH,[XWD ACEPT.,SXR]
	PUSHJ	PP,PUTASY
	JRST	ACEPT6

ACEPT4:	HRRZM	TE,EINCRA
	LSH	TE,-14
	HLLM	TE,ERESA

ACEPT5:	PUSHJ	PP,ACEP20

ACEPT6:	PUSHJ	PP,CDEBB##	;COPY LAST INDENTIFIER TO DEBUG LIST
	PUSHJ	PP,BMPEOP	;ANY MORE OPERANDS?
	  PJRST	GDEBV##		;NO, DUMP THE DEBUG LIST AND RETURN

	MOVE	TC,CUREOP	;YES--LOOP BACK FOR MORE
	JRST	ACEPT1
;"ACCEPT" GENERATOR (CONT'D).

;FIELD IS EITHER ALPHA-EDITED, OR NON-ASCII ALPHANUMERIC

ACEP10:	MOVE	TE,[XWD ^D36,AS.MSC]
	MOVEM	TE,EBASEA

	MOVE	TE,ESIZEA
	IDIVI	TE,5
	SKIPE	TD
	ADDI	TE,1
	PUSHJ	PP,GETEMP
	HRRZM	EACC,EINCRA
	MOVEI	TE,D7MODE
	MOVEM	TE,EMODEA

	PUSHJ	PP,ACEP20

	SWOFF	FASIGN!FANUM;
	PUSHJ	PP,MXX.
	JRST	ACEPT6


;FIELD IS NUMERIC OR NUMERIC EDITED

ACEP15:	PUSHJ	PP,ACEP25

	SETZM	EAC
	SWON	FASIGN!FANUM
	HRRZ	TE,EMODEA
	CAIE	TE,FPMODE	;SKIP IF IT'S GOING TO RETURN A FLOATING NUMBER
	CAIN	TE,F2MODE	;OR COMP-2
	TRNA			;YES
	MOVEI	TE,D2MODE	;NO, A 2-WORD COMP
	MOVEM	TE,EMODEA

	PUSHJ	PP,MACX.	;GEN CODE TO STORE VALUE IN THE ITEM
	JRST	ACEPT6		;AND GO ON TO NEXT OPERAND
;"ACCEPT" GENERATOR  (CONT'D).

;CREATE LITERAL AND CALL FOR ALPHANUMERIC

ACEP20:	MOVE	TA,[XWD XWDLIT,2]
	PUSHJ	PP,STASHP
	HRRZ	TA,ESIZEB	;[447] # OF CHARACTERS TO ACCEPT
	CAIL	TA,2000		;[447] # .GT. 1023. ?
	PUSHJ	PP,SUBWRN	;[447] YES, GIVE WARNING AND SET TO 1023.
	  HRLZ	TA,SUBCON
	LSH	TA,6
	HLR	TA,ERESA
	ROT	TA,-6
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	MOVE	TA,EBASEA
	HRL	TA,EINCRA
ACEP21:	PUSHJ	PP,POOLIT
	MOVSI	CH,ACEPT.
	PUSHJ	PP,PUT.LD
	SKIPN	PLITPC
	AOS	ELITPC
	POPJ	PP,


;[447] AREA GREATER THAN 1023 CHARACTERS. GIVE WARNING AND SET TO 1023.
SUBWRN:	MOVEI	DW,E.590	;[447] DIAGNOSTIC NUMBER
	PUSHJ	PP,EWARN	;[447]
	HRLZI	TA,^D1023	;[447] 'ACCEPT' ONLY 1023. CHARACTERS
	JRST	CPOPJ1		;[447] SKIP RETURN

;CREATE LITERAL AND CALL FOR NUMERIC

ACEP25:	MOVE	TA,[XWD XWDLIT,2]
	PUSHJ	PP,STASHP
	MOVS	TA,SUBCON
	TLO	TA,1B<^D18+6>
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	HRRZ	TA,EMODEA	;ACCEPT FLOATING POINT NUMBER?
	CAIE	TA,FPMODE
	CAIN	TA,F2MODE
	JRST	[MOVSI	TA,1B19		;YES, SET BIT 19 FOR ACEPT.
		JRST	ACEP26]
	HRLZ	TA,EDPLA
	JUMPGE	TA,ACEP26
	MOVMS	TA
	TLO	TA,40
	JRST	ACEP27
ACEP26:	HRRZ	TB,ESIZEA	;CHECK FOR PPPP...9999
	SUB	TB,EDPLA
	SKIPGE	TB		;NOPE
	TLO	TA,1B18		;YES- SET BIT 18 (SAVE ONLY FIELD-SIZE DIGITS)
ACEP27:	HRRI	TA,AS.CNB
	JRST	ACEP21
;ACCEPT XXX FROM DATE, DAY, OR TIME.

;[1053] TA CONTAINS THE FIRST WORD OF THE TWO-WORD OPERAND
;[1053]  FOR "DATE" OR "DAY" OR "TIME".
;[1053] THE TWO OPERANDS ARE SWAPPED SO IT LOOKS LIKE A "MOVE"
;[1053]  FROM THE FIGURATIVE CONSTANT TO THE ITEM.
;[1053] THEN MOVGEN IS CALLED TO GENERATE THE CODE.

ACCTDY:	TLNN	TA,GNTODY	;ONE OF DATE, DAY, OR TIME?
	JRST	BADEOP		;WELL IT SHOULD BE

	PUSH	PP,TA		;[1053] SAVE 1ST WORD OF F.C.
	PUSH	PP,0(EACA)	;[1053] AND 2ND.

;[1053] MOVE THE ITEM DOWN TO MAKE ROOM FOR THE 2ND OPERAND TO GO FIRST.
	HRRZ	TB,EOPNXT	;[1053] END OF EOPTAB
	HRRZ	TA,EOPLOC	;[1053] START OF EOPTAB
	SUBI	TB,2(TA)	;[1053] CALCULATE NO. WORDS IN 1ST OPERAND.
	HRROI	TA,-2(EACA)	;[1053] FIRST WORD TO COPY, MAKE A PD-PTR.
	POP	TA,2(TA)	;[1053] REVERSE BLT
	SOJG	TB,.-1		;[1053] ONE WORD AT A TIME

;[1053] STORE FIG. CONST. OPERAND IN THE TWO WORDS WE JUST FREED UP.
	HRRZ	TB,EOPLOC	;[1053] PLACE TO START
	POP	PP,2(TB)	;[1053] ..SECOND WORD..
	POP	PP,1(TB)	;[1053] .. AND FIRST WORD.
	JRST	MOVGEN##	;AND TREAT AS IF A MOVE
SUBTTL	IO GENERATOR SUBROUTINES

;SETOP: SETUP POINTERS TO OPERANDS
;[12B] SET IOFLGS TO 0

SETOP:	MOVEM	W1,OPLINE	;SAVE OPERATOR'S LN&CP
	SWOFF	FEOFF1		;CLEAR MOST FLAGS
	MOVE	EACA,EOPNXT
	CAME	EACA,EOPLOC	;ANY OPERANDS?
	JRST	SETOP1		;YES

	SWON	FERROR		;NO--SET FLAG SO NO CODE GENERATED
	JRST	BADEOP

SETOP1:	HRRZ	TA,EOPLOC	;SET TA TO FIRST ONE
	ADDI	TA,1
	MOVEM	TA,OPERND	;SAVE

	MOVE	TA,1(TA)	;RESOLVE INTO ACTUAL ADDRESS
	MOVSM	TA,CURFIL
	PUSHJ	PP,LNKSET
	HRRM	TA,CURFIL
	SETZM	IOFLGS##	;CLEAR IO FLAGS
	POPJ	PP,


;SET UP AND WRITE OPERATOR

PUTOP:	HLR	CH,CURFIL
	AND	CH,[XWD -1,LMASKB]
	IORI	CH,AS.FIL
	JRST	PUTASY
;CONVERT RELATIVE KEY TO COMP IF REQUIRED

;CNVKYB - CONVERT KEY BEFORE I/O, NON-SKIP RETURN
;SET LH(WDPITM) = -1 IF KEY IS NOW STORED IN %PARAM+0

CNVKYB:	PUSH	PP,TA		;SAVE  TA
	MOVE	TA,CURFIL	;RELOAD IT
	PUSH	PP,CH		;SAVE CURRENT OPERATOR
	LDB	CH,FI.CKB##	;NEED TO CONVERT KEY
	JUMPE	CH,CNVKYR	;NO
	HRLI	CH,EPJPP	;
	PUSHJ	PP,PUTASY
	HRROS	WDPITM##	;[750] SET LH(WDPITM) TO -1
CNVKYR:	POP	PP,CH
	POP	PP,TA
	POPJ	PP,

;CNVKYA - CONVERT KEY BACK AFTER I/O, SKIP RETURN ALWAYS

CNVKYA:	PUSH	PP,TA		;SAVE  TA
	MOVE	TA,CURFIL	;RELOAD IT
	PUSH	PP,CH		;SAVE CURRENT OPERATOR
	LDB	CH,FI.CKA##	;NEED TO CONVERT KEY
	JUMPE	CH,CNVKYR	;NO
	PUSHJ	PP,PUTASA	;USE SKIP TYPE PUSHJ
	LDB	CH,FI.CKA
	HRLI	CH,XPSHJ.##+AC17
	PUSH	PP,CH
	PUSHJ	PP,PUTASY
	PUSHJ	PP,PUTASA
	POP	PP,CH
	PUSHJ	PP,PUTASY
	JRST	CNVKYR		;RETURN

;CNVCKC - CONVERT KEY BACK AFTER I/O, NON-SKIP RETURN

CNVKYC:	PUSH	PP,TA		;SAVE  TA
	MOVE	TA,CURFIL	;RELOAD IT
	PUSH	PP,CH		;SAVE CURRENT OPERATOR
	LDB	CH,FI.CKA##	;NEED TO CONVERT KEY
	JUMPE	CH,CNVKYR	;NO
	ADDI	CH,1		;GET NEXT TAG
	HRLI	CH,EPJPP
	PUSHJ	PP,PUTASY
	JRST	CNVKYR		;RETURN
;GET FILTAB ENTRY CORRESPONDING TO THE SPECIFIED OUTPUT RECORD

GTFATH:	LDB	CH,[POINT 3,(TA),2]	;IS THIS A DATA-NAME?
	CAIE	CH,TB.DAT
	JRST	NOTREC		;NO--ERROR
	LDB	TE,DA.DEF	;IS IT DEFINED?
	JUMPE	TE,NOTREC	;IF NOT, ERROR

GTFAT1:	MOVE	CH,TA
	LDB	TA,DA.BRO
	JUMPE	TA,NOTREC

	LDB	TE,LNKCOD	;IS FATHER/BROTHER LINK TO DATAB?
	CAIE	TE,TB.DAT
	JRST	GTFAT2		;NO

	PUSHJ	PP,LNKSET	;YES--CONVERT TO ADDRESS
	JRST	GTFAT1		;LOOP TO NEXT

GTFAT2:	CAIE	TE,TB.FIL	;IS FATHER/BROTHER A FILE?
	JRST	NOTREC		;NO--ERROR

	MOVSM	TA,CURFIL	;YES--SAVE LINK
	PUSHJ	PP,LNKSET	;CONVERT TO ADDRESS
	HRRM	TA,CURFIL	;  AND SAVE THAT

	POPJ	PP,
;FIND LARGEST DATAB RECORD FOR THIS FILTAB--PUT OPERAND FOR IT INTO "EINTO"

LARGE:	PUSHJ	PP,LARGER	; [245] FIND LARGEST RECORD
	MOVEM	CH,EINTO	; [245] STORE INTO EINTO FOR READ OR RETURN
	MOVE	TB,EINTR+1	; [245] FINISH FOR
	MOVEM	TB,EINTO+1	; [245] 2ND WORD
	POPJ	PP,		; [245]

LARGER:	MOVE	TA,CURFIL	; [245]  REPORT WRITER ENTRY GET LINK TO
	LDB	TA,FI.DRL	; FIRST DATA RECORD

	HRRZI	TD,0		;CLEAR SIZE OF LARGEST

LARGE1:	MOVE	CH,TA		;SAVE DATAB LINK
	JUMPE	TA,LARGE4	;MUST BE AN ERROR CASE, NONE THERE
	PUSHJ	PP,LNKSET

	LDB	TC,DA.EXS	;GET SIZE OF THAT RECORD
	JUMPE	TC,LARGE5	;[474] IF SIZE ZERO TROUBLE
	CAIG	TC,(TD)		;IS THIS LARGEST SO FAR?
	JRST	LARGE2		;NO

	MOVE	TD,TC		;YES
	HRRZM	CH,EINTR+1	; [245] SAVE LARGEST
	MOVEM	TA,EINTR	; [245] RECORD

LARGE2:	LDB	TC,DA.FAL	;IF THERE IS NO
	JUMPN	TC,LARGE3	;  BROTHER, WE ARE DONE

	LDB	TA,DA.BRO	;GET BROTHER LINK
	JRST	LARGE1		;LOOP

LARGE5:	MOVEI	DW,E.340	;[474] GET SIZE ERROR MESSAGE
	LDB	CP,W1CP		;[474] GET CHARACTER POSITION
	LDB	LN,W1LN		;[474] GET LINE NUMBER
	PUSHJ	PP,WARN		;[474] PUT OUT MESSAGE AND CONTINUE
LARGE4:	MOVEI	TA,<CD.DAT>B20+1	;AIM AT DUMMY
	MOVEM	TA,EINTR+1	; [357] KEEP DUMMY DATAB LINK
	PUSHJ	PP,LNKSET	;  & GO ON (ERROR MSG FROM ELSEWHERE)
	MOVEM	TA,EINTR	; [357] SAVE DUMMY DATAB ADDRESS
LARGE3:	MOVE	TA,EINTR	; [245] GET ADR OF RECORD
	LDB	CH,DA.LNC	; [245] GET LN&CP OF LARGEST RECORD
	MOVEM	CH,EINTR	; [245] SAVE IT
	POPJ	PP,
;Similar to LARGE
;In ANS-8x INTO is only allowed if there is only 1 data-record or
;all data records plus INTO item are either group items or elementary alphanumeric items.

INTOCK:	SKIPG	AS7482##	;OK IN COBOL-74
	POPJ	PP,		;SO BYPASS ALL THIS TESTING
	MOVE	TA,CURFIL	;Copy routine LARGE
	LDB	TA,FI.DRL##	; FIRST DATA RECORD
	JUMPE	TA,CPOPJ	;MUST BE AN ERROR CASE, NONE THERE
	PUSHJ	PP,LNKSET
	LDB	CH,DA.FAL	;IF THERE IS NO BROTHER
	JUMPN	CH,CPOPJ	;THEN ONLY 1 DATA RECORD, AND TEST PASSES
INTCK1:	LDB	CH,DA.SON##	;IS IT A GROUP ITEM?
	JUMPN	CH,INTCK2	;YES, SO THIS ONE IS OK
	LDB	CH,DA.CLA##	;ELEMENTARY, SO GET CLASS
	CAIE	CH,%CL.AN	;IS IT ALPHANUMERIC?
	JRST	INTCK4		;NO, SO TEST FAILED
INTCK2:	LDB	TC,DA.FAL	;IF THERE IS NO
	JUMPN	TC,INTCK3	;  BROTHER, WE ARE DONE
	LDB	TA,DA.BRO	;GET BROTHER LINK
	JUMPE	TA,CPOPJ
	PUSHJ	PP,LNKSET
	JRST	INTCK1		;LOOP

INTCK3:	HRRZ	TA,EINTO+3	;GET INTO DATAB
	PUSHJ	PP,LNKSET
	LDB	CH,DA.SON	;IS IT A GROUP ITEM?
	JUMPN	CH,CPOPJ	;YES, SO THIS IS OK
	LDB	CH,DA.CLA	;ELEMENTARY, SO GET CLASS
	CAIN	CH,%CL.AN	;IS IT ALPHANUMERIC?
	POPJ	PP,		;YES, SO TEST PASSED

INTCK4:	MOVEI	DW,E.828	;ERROR, WARN USER
	MOVE	TC,OPLINE	;POINT TO DATA ITEM
	PJRST	ANYWRN##
;[605] SEE IF THIS IS A VARIABLE LENGTH READ IN WHICH THE DEPENDING ITEM
;[605] IS NOT CONTAINED IN THE RECORD ITSELF
;OR IF ITS "RECORD IS VARYING IN SIZE DEPENDING ON ..." SYNTAX

	INTERN	VLTST,VLTSTN	;[605] SO IT CAN BE CALLED FROM IFGEN

VLTST:	SETZM	EDEPFT##	;[605] CLEAR THE FLAG WORD
	MOVE	TA,CURFIL	;[605] GET LINK TO CURRENT FILE TABLE
	LDB	TB,FI.DEP##	;DEPENDING VARIABLE?
	JUMPE	TB,VLTST0	;NO, TEST ALL THE DATA RECORDS FOR VARIABLE CASE
	HLRZM	TA,EDEPFT	;YES, SAVE FILTAB LINK FOR AFTER READ
	POPJ	PP,

VLTST0:	LDB	TA,FI.DRL	;[605] GET FIRST DATA RECORD
VLTST1:	JUMPE	TA,CPOPJ	;[605] MUST BE AN ERROR CASE, NONE THERE
	HRRZ	CH,TA		;[605] SAVE DATAB LINK
	PUSHJ	PP,LNKSET	;[605]
	LDB	TC,DA.DLL##	;[605] DEPENDING ITEM AT LOWER LEVEL?
	JUMPE	TC,VLTST9	;[605] NO, TRY NEXT RECORD
	LDB	TB,DA.SON##	;[605] FIND THE DEPENDING ITEM
VLTST2:	PUSHJ	PP,FNDBRO##	;[605] THIS CODE COPIED FROM MOVGEN CODE
	  SKIPA	TA,TB		;[605] FOUND LAST BROTHER
	JRST	VLTST2		;[605] NO, LOOP
	HRL	CH,TA		;[605] SAVE OCCURS ITEM FOR IFGEN
	PUSHJ	PP,LNKSET	;[605]
	LDB	TB,DA.DLL	;[1375] [1030] IS THE DEPENDING VARIABLE AT THIS LEVEL?
	JUMPE	TB,VLTST3	;[1375] [1030] YES
	LDB	TB,DA.SON	;[605] ARE WE AT THE ELEMENTARY ITEM
	JUMPN	TB,VLTST2	;[605] THIS ISN'T IT, GO DOWN DEEPER
	LDB	TB,DA.DEP##	;[605] IS THIS THE DEPENDING VARIABLE?
	JUMPE	TB,VLTST8	;[605] ?ERROR--SHOULD HAVE FOUND DEPENDING ITEM!
VLTST3:	PUSH	PP,TB		;[605] INCASE ALREADY AT THE TOP LEVEL
	PUSHJ	PP,FNDPOP##	;[605] FIND THE TOP LEVEL
	  JRST	 VLTST5		;[605] MUST BE ALREADY AT TOP LEVEL
	POP	PP,(PP)		;[605] CLEANUP THE STACK
VLTST4:	PUSHJ	PP,FNDBRO##	;[605] GET LAST BROTHER
	  JRST	VLTST3		;[605] NOW LOOK FOR ITS FATHER
	JRST	VLTST4		;[605] NO, LOOP

VLTST5:	POP	PP,TB		;[605] GET BACK THE TOP ITEM
	HLRZ	TA,CURFIL	;[605] GET TABLE ENTRY FOR CURRENT FILE
	CAMN	TA,TB		;[605] IS THE DEPENDING ITEM PART OF THE RECORD
	JRST	VLTST8		;[605] YES, IGNORE THIS CASE
	MOVEM	TA,EDEPFT	;[605] SAVE IT FOR AFTER READ
	POPJ	PP,		;[605]

VLTST8:	HRRZ	TA,CH		;[605] RELOAD
VLTSTN:	PUSHJ	PP,LNKSET	;[605] ENTRY FROM IFGEN FOR NEXT BROTHER
VLTST9:	LDB	TC,DA.FAL	;[605] IF THERE IS NO
	JUMPN	TC,CPOPJ	;[605]  BROTHER, WE ARE DONE
	LDB	TA,DA.BRO	;[605] GET BROTHER LINK
	JRST	VLTST1		;[605] LOOP
;DIAGNOSTIC ROUTINES

;FILE IS NOT RANDOM

NOTRAN:	MOVEI	DW,E.205
	JRST	OPFAT


;[1331] IMPROPER "ADVANCING N LINES"

BADADV:	MOVEI	DW,E.288	;[1331] DATA-NAME HAS ERROR BIT ON
	JRST	ADVERA		;[1331]

;IMPROPER "ADVANCING N LINES"

BADLIN:	MOVEI	DW,E.98
	JRST	ADVERA


;ADVANCING <DATA-NAME> HAD DECIMAL PLACES

NOTINT:	MOVEI	DW,E.207

ADVERA:	HRRZ	TE,EOPNXT
	MOVEI	TE,-1(TE)
	MOVEM	TE,CUREOP
	PUSHJ	PP,OPNFAT
	MOVE	TA,CURFIL	;FIND OUT IF WE ARE DOING AN RMS FILE,
	LDB	TE,FI.RMS	; AND IF SO, GO BACK TO CODE WHICH IS
	JUMPN	TE,WRTM2K	; GENERATING THE RMS WRITE VERB.
	JRST	RITGN3

;NOT WRITING A RECORD

NOTREC:	MOVEI	DW,E.206
	MOVE	TE,OPERND
	HRRZM	TE,CUREOP
	JRST	OPNFAT

;UNDEFINED DATA-NAME IN "ADVANCING"

UNDEFD:	MOVEI	DW,E.104
	JRST	ADVERA
;MISCELLANEOUS CONSTANTS

	ADVANC==1B27	;"ADVANCING" IN GENFIL OPERATOR
	AFTER==1B28	;"AFTER ADVANCING" IN GENFIL OPERATOR
	FROM==1B29	;"WRITE FROM" IN GENFIL OPERATOR
	INTO==1B27	;"READ INTO" IN GENFIL OPERATOR
	POSTNG==(1B12)	;"POSITIONING" IN GENFIL OPERATOR
	CONSOL==1B27	;"UPON" FOR DISPLAY, "FROM" FOR ACCEPT
	DELETF==1B30	;"WITH DELETE" IN GENFIL OPERATOR
	NOADV==1B28	;"WITH NO ADVANCING" IN 'DISPLAY' OPERATOR





CHANUM:	POINT 3,1(TA),35	;CHANNEL NUMBER IN MNETAB


EXTERNAL CURDAT,EIOOP,LMASKB
EXTERNAL EINTO,EINTR,OPERND,ESAVAC,EAC,W1LN,W1CP,EPJPP,PUT.PJ
EXTERNAL EASRJ,EAZRJ,EAQRJ,ERECSZ
EXTERNAL EOPLOC,EOPNXT,CURFIL,CUREOP,OPLINE
EXTERNAL ETEMPC,ELITPC,ESAVAC
EXTERNAL LITLOC,BYTE.W
EXTERNAL SUBCON,DSP.FP

EXTERNAL EBASEB,EMODEB,EDPLB,EINCRB,ESIZEB,ERESB,ETABLB,EFLAGB
EXTERNAL EBASEA,EMODEA,EDPLA,EINCRA,ESIZEA,ERESA,EBASAX,EBASBX
EXTERNAL ESAVES, ESAVSB
EXTERNAL JRST.,ACEPT.,DSPLY.,RERIT.,WADV.,PURGE.
EXTERNAL AS.FIL,AS.TAG,AS.CNB,AS.MSC,AS.LIT,XWDLIT
EXTERNAL AS.XWD,D1MODE,D2MODE,D6MODE,D7MODE,EDMODE
EXTERNAL ATINVK,ATEND,INVKEY,SPIF.,TCCP,TCLN,GO2NXT

EXTERNAL LNKCOD,TB.DAT,TB.FIL,TB.MNE
EXTERNAL DA.LNC,DA.DEF,DA.USG,DA.NDP,DA.EXS,DA.BRO,DA.CLA,DA.EDT,DA.FAL
EXTERNAL DA.LN,DA.CP
EXTERNAL FI.ORG,FI.ERM,FI.DRL,FI.RKY,FI.SKY
EXTERN	CPOPJ,CPOPJ1
EXTERN	ROUCAL
SUBTTL	SIMULTANEOUS ACCESS CODE GENERATION ROUTINES.


	ENTRY	FENQGN,EFENQG,FUNAVG,EFUNAV
	ENTRY	ERENQG,RDEQGN
	ENTRY	ERUNAV,ENRGEN,RENQGN,ERDEQG

	EXTERN	AS.EXT,AS.LIT,AS.MSC,AS.TAG,COMEBK,CUREOP
	EXTERN	AS.CNB,AS.FIL,OCTLIT
	EXTERN	ELITPC,EOPNXT,ESAVW1,ESUCNT,ESUCT2
	EXTERN	ESUFN1,ESUFN2,ESUTAG,ESUTC,GETTAG
	EXTERN	JRST.,XJRST.,MOVEI.,XWDLIT,PUSH12,PUSHJ.,PUTASN
	EXTERN	PUTASY,PUTASA,PUT.EX,PUT.PJ,PUTTAG,REFTAG,SARG,XWDLIT,ARG
	EXTERN	EUNSPT,EUNSTK
	EXTERN	LFENQ.,LRENQ.,LRDEQ.,CNTAI.
	EXTERN	STASHI,STASHL,STASHP,STASHQ,POOLIT,PLITPC
	EXTERN	FILLOC,LPCSAV
	EXTERN	DA.RES
	EXTERN	FI.ORG,FI.FAM
;FILE ENQUEUE - RECORD ENQUEUE

FENQGN:

;SINCE APPLY BASIC-LOCKING IS A FORM OF SIMULTANEOUS UPDATE, IT SEEMED
;REASONABLE TO HAVE COBOLD CREATE A GENFIL OPERATOR FOR FENQ (143).
;HOWEVER, AT THIS POINT, THE OPEN UNDER APPLY BASIC-LOCKING MUST BE
;TREATED AS THE OPEN FOR A SINGLE FILE. THIS IS WHY WE SHUNT IT OVER
;TO OPENGN AT THIS POINT.

	SKIPE	ABSEEN##	;APPLY BASIC-LOCKING SEEN?
	 JRST	OPENGN		; YES

;I FOUND OUT THE HARD WAY THAT RDEQGN COMES THRU HERE TOO.

RENQGN:	PUSHJ	PP,PUSH12	;SAVE OPERATOR ON OPERAND STACK
	AOS	ESUCNT		;INCREMENT COUNT OF OPERATORS STACKED
	AOJA	EACC,COMEBK	;GO BACK FOR MORE

;FILE UNAVAILABLE

FUNAVG:	PUSHJ	PP,GETTAG	;GET A LABEL
	AOS	TA,EUNSPT
	CAILE	TA,20
	JRST	KILL##		;CHECK IF UNAVAILABLE STACK OVERFLOW
	MOVEM	CH,EUNSTK-1(TA)	;STORE LABEL ON STACK IF NO OVERFLOW
	IOR	CH,[JRST.,,AS.TAG]
	PUSHJ	PP,PUTASY	;GENERATE JRST TAG
	MOVE	TA,EUNSTK-1(TA)
	PUSHJ	PP,REFTAG	;REFERENCE TAG
	SKIPE	CH,ESUTAG	;IF ESUTAG IS NON-ZERO
	PUSHJ	PP,PUTTAG	;DEFINE LABEL USED BY EFENQG
	JRST	COMEBK		;ALL DONE; UNAVAILABLE CODE GENERATED NEXT
;END FILE ENQUEUE

EFENQG:

	MOVEM	W1,ESAVW1	;SAVE FLAG IN W1 FOR USE LATER
	MOVE	TA,ESUCNT
	MOVEM	TA,ESUCT2	;SAVE N FOR DECREMENTING
	AOJ	TA,
	LSH	TA,1
	HRLI	TA,XWDLIT	;CREATE HEADER WORD FOR LITERAL
	PUSHJ	PP,STASHI	;STASH AWAY HEADER WORD
	LSH	W1,-8
	TLZ	W1,777776
	HLL	TA,W1		;MOVE UNAVAILABLE BIT TO LH OF TA
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHL	;STASH UNAVAILABLE FLAG IN LIT TAB
	HRL	TA,ESUCNT
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHL	;STASH AWAY N IN LIT TABLE
EFENQ1:	SOSGE	ESUCT2		;IS THERE ANOTHER FILE ARGUMENT ?
	JRST	EFENQ2		;NO
	MOVE	EACA,EOPNXT	;YES, GET POINTER TO TOP OF STACK
	POP	EACA,W2
	POP	EACA,TA		;POP OFF OPERATOR
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHL	;STASH AWAY FLAGS
	POP	EACA,TA
	ANDI	TA,77777
	ORI	TA,AS.FIL
	PUSHJ	PP,STASHL	;STASH AWAY FILE TABLE ADDRESS
	POP	EACA,W1		;POP OFF OPERAND
	MOVEM	EACA,EOPNXT	;UPDATE POINTER TO TOP OF STACK
	SUBI	EACC,2		;DECREMENT COUNT OF OPERANDS ON STACK
	JRST	EFENQ1		;GO BACK FOR THE NEXT ONE
EFENQ2:	MOVE	CH,[MOVEI.+ASINC+AC16,,AS.MSC]
	PUSHJ	PP,PUTASY	;GENERATE MOVEI 16,LIT-TABLE-ENTRY
	HRRZ	CH,ELITPC
	TRO	CH,AS.LIT
	PUSHJ	PP,PUTASN	;(IT REQUIRES 2 WORDS IN THE AS FILE)

	MOVEI	CH,LFENQ.
	PUSHJ	PP,PUT.PJ	;GENERATE PUSHJ PP,LFENQ

	AOS	TA,ESUCNT
	ADDM	TA,ELITPC	;INCREMENT ELITPC BY N+1
	SETZM	ESUCNT		;ZERO COUNT OF OPERANDS
	MOVE	TA,ESAVW1
	TLNN	TA,000400	;USER SUPPLIED UNAVAILABLE STATEMENT?
	JRST	COMEBK		;NO, WE'RE ALL DONE
	PUSHJ	PP,PUTASA	;IN SECOND SET
	PUSHJ	PP,GETTAG	;GET A LABEL
	MOVEM	CH,ESUTAG	;SAVE FOR LATER USE BY FUNAVG
	IOR	CH,[XJRST.,,AS.TAG]
	PUSHJ	PP,PUTASY	;GENERATE JRST TAG
	MOVE	TA,ESUTAG	;GET TAG
	PUSHJ	PP,REFTAG	;REFERENCE IT
	JRST	COMEBK		;ALL DONE
;END FILE UNAVAILABLE - END RECORD UNAVAILABLE
;END NOT RETAINED

EFUNAV:ERUNAV:
ENRGEN:	SOSGE	TA,EUNSPT	;CHECK FOR STACK UNDERFLOW
	JRST	KILL
	MOVE	CH,EUNSTK(TA)	;GET LABEL FROM TOP OF UNAVAILABLE STACK
	PUSHJ	PP,PUTTAG	;DEFINE IT

;END RECORD ENQUEUE - END RECORD DEQUEUE

ERENQG:
ERDEQG:	MOVE	TA,ESUCNT	;GET COUNT OF RENQ OR RDEQ OPERATORS ON STACK
	JUMPE	TA,COMEBK	;ZERO COUNT MEANS USER SYNTAX ERROR - NO CODE GENERATED
	MOVE	TC,EOPNXT
	MOVEM	W1,ESAVW1	;SAVE ERENQ OR ERDEQ FLAGS
	SETZM	ERFFLG##	;INIT FLAG FOR RETAIN / FREE VERB

ERENQ1:	POP	TC,W2		;LOCATE 1ST RENQ OR RDEQ OPERATOR ON STACK
	POP	TC,W1
	JUMPL	W1,ERENQ1	;JUMP IF OPERAND
	CAIN	W2,147
	JRST	ERENQ0		;JUMP IF RENQ
	CAIE	W2,152
	JRST	ERENQ1		;JUMP IF NOT RDEQ
	MOVEM	W1,ERFFLG##	;SAVE OPERATOR FLAG WORD TO INDICATE FREE VERB
ERENQ0:	SOJG	TA,ERENQ1	;JUMP IF NOT 1ST RENQ OR RDEQ
	CAIE	W2,152		;[1450] DOING DEQUEUE?
	JRST	ERENQ2		;[1450] NO.
	TLNE	W1,DQ%EVR+DQ%KEY+DQ%ALR	;[1450] [1474] ANY ONE OF THE TRHEE?
	JRST	ERENQ2		;[1450] YES.
	MOVEI	DW,E.759	;[1450] MUST HAVE ONE OF THEM,
	PUSH	PP,TC		;[1450] OR IT IS A FATAL
	PUSHJ	PP,OPFAT	;[1450] [1464] ERROR.
	POP	PP,TC		;[1450] RESTORE AC WE BORROWED.

ERENQ2:	POP	TC,W2		;LOCATE FILE-NAME OPERAND FOR 1ST RENQ OR RDEQ
	POP	TC,W1
	JUMPGE	W1,ERENQ2	;JUMP IF OPERATOR (SHOULDN'T BE ANY, THOUGH)
	TLNE	W1,200000
	JRST	ERENQ2		;JUMP IF LITERAL
	LDB	TE,[POINT 3,W2,20]
	JUMPN	TE,ERENQ2	;JUMP IF NOT FILE-NAME
	AOJ	TC,		;ADJUST TC TO POINT AT 1ST WORD OF FILE-NAME
	MOVEM	TC,ESUFN1	;SAVE POINTER TO 1ST WORD OF FILE-NAME
	SETZM	ESUCVT##	;HAVEN'T CONVERTED ANY KEYS YET.
	PUSHJ	PP,ERENSF	;SETUP CURFIL; GENERATE CODE TO CONVERT KEY

	MOVE	TA,ERFFLG##	;[1643] GET FLAGS FOR FREE VERB
	TLNE	TA,DQ%EVR!DQ%ALR	;[1643] DOING FREE RECORD?
	 JRST	ERNQ2A		;[1643] YES, DON'T CHECK FILE ORGANIZATION
	MOVE	TA,CURFIL	;GET FILE'S FILE TABLE ADDRESS
	LDB	TB,FI.ORG##	;GET FILE'S ORGANIZATION
	CAIN	TB,%ACC.S	;IF IT IS SEQUENTIAL
	 JRST	[LDB LN,[POINT 13,2(TC),28]
		 LDB CP,[POINT 7,2(TC),35]
		 MOVEI DW,E.659
		 PUSHJ PP,FATAL##	;IT IS DISALLOWED
		 JRST ERNQ2A]
ERNQ2A:
	MOVE	TA,CURFIL	;GET FILE'S FILE TABLE ADDRESS AGAIN
	LDB	TB,FI.RMS##	; THE KEY BEING EXPLICITLY SPECIFIED FOR
	CAIE	TB,1		;  A RETAIN BY KEY.
	 JRST	ERENQ4		;NOT RMS FILE
	HRRZI	TB,0		;ZERO OUT A TEMP AC TO TEST
	CAMN	TB,ERFFLG##	; IF RETAIN / FREE FLAG ZERO
	 JRST	ERNQ2B		; DOING RETAIN
	MOVE	TD,ERFFLG##	;ELSE DOING FREE - GET OPERATOR WITH FLAGS
	TXNE	TD,1B9!1B10!1B14	;TEST FOR A FLAG SET FOR EVERY,
				; FILE-NAME EVERY, OR FILE-NAME KEY
				; OR FILE-NAME NEXT
	 JRST	ERENQ4			;  ONE OF THESE FLAGS IS SET
	LDB	LN,[POINT 13,2(TC),28]	;NONE ARE, GIVE FATAL DIAG
	LDB	CP,[POINT 7,2(TC),35]	;
	MOVEI	DW,E.663		;
	PUSHJ	PP,FATAL##		;
	JRST	ERENQ4		; BYPASS TEST FOR EXPLICIT KEY DATA NAME

	;AT THIS POINT WE ARE CHECKING OVER A RETAIN. IT MAY ON KEY OR
	; NEXT. IF KEY, WORD 2(TC) IS A DATA-NAME OPERAND. IF NEXT,
	; WORD 2(TC) HAS THE 147 OPCODE IN BITS 0 - 8.
ERNQ2B:
	LDB	TB,[POINT 9,2(TC),8]	;GET OPCODE PORTION OF WORD
	CAIE	TB,147			;RETAIN OPCODE?
	 JRST	ERNQ2C			; NO, HAS TO BE OPERAND
	LDB	TB,[POINT 1,2(TC),15]	;YES, HAS TO BE FOR NEXT
	CAIE	TB,1			; IS NEXT BIT TURNED ON?
	 JRST	ERENQF			;  NO, FATAL ERROR
	  JRST	ERENQ4			;   YES, GO ON
ERNQ2C:			;CHECK OUT DATA-NAME OPERAND
	LDB	TB,[POINT 3,2(TC),2]	;GET OPERAND'S TYPE CODE
	CAIE	TB,4		;TEST FOR A 4 FOR DATA NAME
	 JRST	ERENQF		; IS NOT -- FATAL
	LDB	TB,[POINT 3,3(TC),20]	;GET OPERAND'S TABLE CODE AND RE-CHECK
	CAIN	TB,1		; DATAB ENTRY HAS A 1 IN THAT BYTE
	 JRST	ERENQ4		;IS DATAB ENTRY

;ERROR MESSAGE ROUTINE FOR FAILURE ON NAMING KEY

ERENQF:
	LDB	LN,[POINT 13,2(TC),28]	;GET LINE NO. AND
	LDB	CP,[POINT 7,2(TC),35]	; CHARACTER POSITION
	MOVEI	DW,E.662		;THE DIAG MSG NO.
	PUSHJ	PP,	FATAL##		;FLAG IT AND ON TO NEXT OPERAND
;FOR ANYONE WHO ASKS, THIS CODE FLOWS IN SEQUENCE FROM THE ERROR REPORTING
; PROCEDURE TO THE NEXT STEP OF NORMAL PROCESSING BECAUSE THAT'S THE WAY
; IT WORKS. SOMEHOW, THIS PROCEDURE SEEMS TO KEEP THE STACK OF GENFIL OPERANDS
; STRAIGHT WHICH IS POINTED TO BY TC.


ERENQ3:	ADDI	TC,2		;POINT TO NEXT ITEM

ERENQ4:	HRRZ	TE,EOPNXT	;ARE WE LOOKING AT THE TOP OF THE STACK?
	CAIN	TE,-1(TC)
	JRST	ERENQ5		;YES, JUMP (ALL SUBSCRIPTS HAVE BEEN HANDLED)
	SKIPL	TE,0(TC)	;ARE WE LOOKING AT AN OPERAND?
	JRST	ERENQ3		;NO, IGNORE ITEM
	TLNE	TE,200000
	JRST	ERENR0		;JUMP IF LITERAL OR FIG CONSTANT
	LDB	TE,[POINT 3,1(TC),20]
	JUMPE	TE,ERENR1	;JUMP IF WE ARE LOOKING AT A FILE-NAME
ERENR0:	MOVEM	TC,CUREOP	;SET CUREOP FOR SARG
	PUSHJ	PP,SARG		;GENERATE CODE FOR SUBSCRIPTS, IF ANY
	MOVEM	TC,ESUTC	;SAVE RETURNED TC
	MOVE	TC,CUREOP	;RESTORE TC THAT POINTS TO ARGUMENT
	PUSHJ	PP,ARG		;SET ARG LIST FOR LATER OUTPUT
	MOVE	TC,ESUTC	;RESTORE RETURNED TC

	HRRZ	TA,CURFIL		;GET THE CURRENT FILE POINTER TO SEE
	LDB	TA,FI.RMS##	; IF IT IS AN RMS INDEXED FILE
	JUMPE	TA,ERENQ3		;NOT RMS
	HRRZ	TA,CURFIL		;GET THE CURRENT FILE POINTER TO SEE
	LDB	TA,FI.ORG		;IF ITS ORGANIZATION IS INDEXED
	CAIE	TA,%ACC.I		;INDEXED?
	 JRST	ERENQ3		; NO
	MOVE	TA,[XWDLIT,,2]	;CREATE THIRD WORD OF LITERAL
	PUSHJ	PP,STASHI		;
	HRLZ	TA,KEYREF##	;GET CURRENT RMS INDEX KEY POSITION
	HRRI	TA,AS.CNB	; IS CONSTANT
	PUSHJ	PP,STASHL		; AND PUT IT IN LITERAL
	MOVE	TA,KEYADR##	;GET ADDRESS FROM UKADR CALL
				; IT IS ALL SET UP TO STASH.
	PUSHJ	PP,STASHL	; AND STASH IT.
	AOS	ELITPC		;ADVANCE COUNT OF LITERAL POINTER
	JRST	ERENQ4

ERENR1:	PUSHJ	PP,ERENS1	;GENERATE CODE TO CONVERT KEY, IF NECESSARY
	SKIPL	TA,2(TC)
	 JRST	ERNR1A		;JUMP IF NO OPERAND FOLLOWING FILE NAME
	MOVEM	TC,CUREOP	;SAVE TC
	TLNN	TA,GNLIT	;SKIP IF OPERAND A LITERAL OR FIGURATIVE CONSTANT
	JRST	ERENR2
	TLNN	TA,GNFIGC
	TLNN	TA,GNNUM
	JRST	ERENR8		;JUMP IF FIGURATIVE CONSTANT OR NON-NUMERIC LITERAL
	MOVE	TA,3(TC)
	PUSHJ	PP,LNKSET##
	LDB	TA,[POINT 7,0(TA),6]
	CAILE	TA,^D10
	JRST	ERENR8		;JUMP IF MORE THAN 10 CHARACTERS IN LITERAL
	MOVEM	TA,ESIZEA
	MOVEI	TA,D1MODE##
	MOVEM	TA,EMODEA##	;SET EMODEA TO COMP
	MOVE	TC,CUREOP
	ADDI	TC,2
	JRST	ERENR7

; NO OPERAND FOLLOWING FILE NAME
;(NO KEY WAS GIVEN). IF CBL74,
;IF ORGANIZATION IS SEQUENTIAL OR RELATIVE, (NOT INDEXED),
;  AND ACCESS MODE = SEQUENTIAL,  THEN SET "NEXT" BIT.

ERNR1A:	MOVE	TA,1(TC)	;POINT TO FILE TABLE
	PUSHJ	PP,LNKSET
	LDB	TB,FI.ORG	;ORGANIZATION
	CAIN	TB,%ACC.I	; IF INDEXED, DON'T SET "NEXT" BIT
	 JRST	ERENQ3
	LDB	TB,FI.FAM	;FILE ACCESS MODE
	CAIE	TB,%FAM.S	;SEQUENTIAL?
	 JRST	ERENQ3		;NO, DON'T SET "NEXT" BIT.

	MOVSI	TB,(1B15)	;NICE SYMBOLIC CONSTANT, HA HA
	IORM	TB,2(TC)	;SET "NEXT" BIT FOR CONVENIENCE OF LSU
	JRST	ERENQ3		;

ERENR8:	LDB	LN,[POINT 13,2(TC),28]
	LDB	CP,[POINT 7,2(TC),35]
	MOVEI	DW,E.570
	PUSHJ	PP,FATAL##	;GENERATE ERROR MESSAGE
				;(LITERAL OR FIGURATIVE CONSTANT NOT ALLOWED)

ERENR9:	MOVE	TC,CUREOP	;RESTORE TC
	JRST	ERENQ3		;RETURN TO MAIN STREAM

ERENR2:	MOVEI	LN,EBASEA##
	ADDI	TC,2
	PUSHJ	PP,SETOPN##	;GET DESCRIPTION OF DATA NAME
ERENR7:	MOVE	TA,-1(TC)
	PUSHJ	PP,LNKSET##	;GET POINTER TO FILE TABLE
	LDB	TB,FI.ORG
	CAIN	TB,%ACC.I
	JRST	ERENR3		;JUMP IF FILE INDEXED
	MOVE	TB,EMODEA##
	CAIN	TB,D1MODE##
	JRST	ERENR9		;JUMP IF 1 WORD COMP
	MOVE	TC,CUREOP
	LDB	LN,[POINT 13,2(TC),28]
	LDB	CP,[POINT 7,2(TC),35]
	MOVEI	DW,E.571
	PUSHJ	PP,FATAL##	;GENERATE ERROR MESSAGE
				;(KEY FOR SEQUENTIAL OR RELATIVE MUST BE COMP)
	JRST	ERENR9
;CHECK OUT AVAILABLE RECORD KEYS AGAINST RETAIN'S KEY OPERAND.
; IF THE FILE IS AN RMS FILE, WE CAN GO THROUGH ANY ALTERNATE KEYS TO SEE
; IF THEY AGREE WITH THE "A" OPERAND WHICH WE ARE TESTING.
; ALSO, WE INITIALIZE THE COUNT OF KEYS. THIS COUNT WILL BE INCREMENTED FOR
; EACH RMS INDEX KEY TESTED. IF WE GET A MATCH, THIS IS THE NUMBER OF THE
; KEY IN THE %N TABLE, AND THIS NUMBER WILL BE PUT INTO %LIT00 AS THE THIRD
; ARGUMENT FOR THE KEY TO BE RETAINED IN LSU. KEYREF = 0 POINTS AT THE
; PRIMARY KEY.
;
;IN THE FIRST INSTANCE, WE WILL CHECK TO SEE IF THE USER HAS SUPPLIED A
; REAL PRIMARY OR ALTERNATE KEY FIELD. IF SO, WE CAN DO A RETAINUSING
; THAT EXACT FIELD IN THE RECORD. OTHERWISE WE GO BACK THROUGH PRESUMING
; THAT THE FIELD IS SOME OTHER UNRELATED FIELD, AS IN WORKING-STORAGE.
; AT THIS POINT, WE LOOK FOR A MATCH ON THE KEY SIZE AND USAGE. THE USER
; WINS THE FIRST MATCH WHETHER IT IS THE ONE HE WANTS OR NOT. IT WOULD
; TAKE ADDITIONAL SYNTAX TO MAKE THIS OTHERWISE CASE MORE PRECISE.


ERENR3:
	LDB	TA,FI.RKY##	;SET UP EMODEB, ESIZEB FOR RECORD KEY
	JUMPE	TA,ERENR9	;ERROR, SYMBOLIC KEY NOT DEFINED

	SETZM	KEYREF##		;INIT THE COUNT OF KEYS

	HRRZ	TB,1(TC)	;GET GENFIL DATA FIELD OPERAND
	CAME	TB,TA		; DOES IT REFERENCE THE PRIMARY KEY?
	 JRST	ERNR3J		;NO
	PUSHJ	PP,UKADR	;MAKE SURE KEY IS WORD-ALIGNED
	MOVE	TA,CURFIL	;GET CURRENT FILE AGAIN
	LDB	TA,FI.RKY	;GET IT AGAIN
	PUSHJ	PP,LNKSET	;LOOK UP DATAB ENTRY
	LDB	TB,DA.RES	;GET DATA ITEM'S BYTE RESIDUE
	CAIN	TB,^D36		;WORD ALIGNED?
	 SETZM	KEYADR##	; YES, DON'T PICK UP FILE KEY DATA ITEM
				;  FOR LITERAL TABLE
	MOVE	TC,CUREOP	;RESTORE POINTER TO CURRENT GENFIL OPERAND
	JRST	ERENQ3		; AND GO TO GOOD RETURN

ERNR3J:
	HRRZ	TA,CURFIL		;GET FILE'S ABSOLUTE TABLE ADDR IN CORE
	LDB	TA,FI.RMS##		;IS IT AN RMS FILE?
	JUMPE	TA,ERNR3M		; NO
	HRRZ	TA,CURFIL		;GET IT AGAIN
	LDB	TA,FI.ALK##	;GET RELATIVE PTR TO FIRST ALT KEY IN AKTTAB
	JUMPE	TA,ERNR3M		; THERE IS NONE
	ADD	TA,AKTLOC##		;ADD IN CURRENT BASE ADDR OF TABLE
	HRRZ	TA,TA			; AND CLEAR THE LH SIDE
	MOVEM	TA,AKTHLD##		; AND SAVE IT ASIDE FOR TESTING BELOW
	HLRZ	TD,CURFIL		;GET FILE TABLE LINK FROM CURFIL

; NEXT, CHECK THE "A" OPERAND AGAINST THE ALTERNATE KEYS FOR THIS FILE

ERNR3K:
	AOS	KEYREF##		;INCREMENT THE COUNT OF RMS INDEX KEYS
	LDB	TE,AK.FLK##		;GET ENTRY'S FILE TABLE LINK
	CAIE	TE,(TD)			;SAME FILE?
	 JRST	ERNR3L			; NO - ERROR

	LDB	TA,AK.DLK##	;GET ALTERNATE KEY'S DATA LINK FROM AKTTAB
	HRRZ	TB,1(TC)	; GET GENFIL OPERAND FOR DATA FIELD
	CAME	TB,TA		;SAME?
	 JRST	ERNR3L		; NO, GO TRY THE NEXT ONE.
	PUSHJ	PP,UKADR	;MAKE SURE KEY IS WORD-ALIGNED
	HRRZ	TA,AKTHLD##	;GET BACK ADDR OF AKT DATAB ENTRY
	LDB	TA,AK.DLK##	;GET AKTTAB ENTRY'S DATA LINK
	PUSHJ	PP,LNKSET	;LOOK UP DATAB ENTRY
	LDB	TB,DA.RES	;GET DATA ITEM'S BYTE RESIDUE
	CAIN	TB,^D36		;WORD ALIGNED?
	 SETZM	KEYADR##	; YES, DON'T PICK UP FILE KEY DATA ITEM
				;  FOR LITERAL TABLE
	MOVE	TC,CUREOP	;RESTORE PTR TO CURR GENFIL OPERAND
	JRST	ERENQ3		; AND GO TO GOOD RETURN


ERNR3L:
	MOVE	TA,AKTHLD##	;GET ADDR OF CURRENT AKTTAB ENTRY
	ADDI	TA,SZ.AKT		;POINT TO NEXT ENTRY IN AKTTAB
	MOVEM	TA,AKTHLD##	;SAVE NEXT ENT ADDR FOR NEXT TIME AROUND
	HRRZ	TB,AKTNXT##	;GET ADDR OF FIRST FREE WORD OF AKTTAB
	CAML	TA,TB		;ARE WE INTO FREE AREA?
	 JRST	ERNR3M		; YES - RETAIN KEY MUST BE DEFINED OUTSIDE THE RECORD
	JRST	ERNR3K		;NOT OK, GO TRY NEXT ENTRY

ERNR3M:

	MOVE	TA,CURFIL	;GET BACK FILE'S FILE TABLE
	LDB	TA,FI.RKY##	;SET UP EMODEB, ESIZEB FOR RECORD KEY
	JUMPE	TA,ERENR9	;ERROR, SYMBOLIC KEY NOT DEFINED

	SETZM	KEYREF##		;INIT THE COUNT OF KEYS
	PUSHJ	PP,ERNR3X		;GET REC KEY'S ADDR + CHECK KEY OUT
	 JRST	ERENQ3			;OK, THIS KEY AGREES


	HRRZ	TA,CURFIL		;GET FILE'S ABSOLUTE TABLE ADDR IN CORE
	LDB	TA,FI.RMS##	;IS IT AN RMS FILE?
	JUMPE	TA,ERENR4		; NO
	HRRZ	TA,CURFIL		;GET IT AGAIN
	LDB	TA,FI.ALK##	;GET RELATIVE PTR TO FIRST ALT KEY IN AKTTAB
	JUMPE	TA,ERENR4		; THERE IS NONE
	ADD	TA,AKTLOC##	;ADD IN CURRENT BASE ADDR OF TABLE
	HRRZ	TA,TA		; AND CLEAR THE LH SIDE
	MOVEM	TA,AKTHLD##	; AND SAVE IT ASIDE FOR TESTING BELOW
	HLRZ	TD,CURFIL		;GET FILE TABLE LINK FROM CURFIL

; NEXT, CHECK THE "A" OPERAND AGAINST THE ALTERNATE KEYS FOR THIS FILE

ERNR3A:
	AOS	KEYREF##		;INCREMENT THE COUNT OF RMS INDEX KEYS
	LDB	TE,AK.FLK##	;GET ENTRY'S FILE TABLE LINK
	CAIE	TE,(TD)		;SAME FILE?
	 JRST	ERENR4		; NO - ERROR
	LDB	TA,AK.DLK##	;GET AKTTAB ENTRY'S DATA LINK
	PUSHJ	PP,ERNR3X		;GO CHECK OUT DATA LINK
	 JRST	ERENQ3			; OK - THIS KEY AGREES
	MOVE	TA,AKTHLD##	;GET ADDR OF CURRENT AKTTAB ENTRY
	ADDI	TA,SZ.AKT		;POINT TO NEXT ENTRY IN AKTTAB
	MOVEM	TA,AKTHLD##	;SAVE NEXT ENT ADDR FOR NEXT TIME AROUND
	HRRZ	TB,AKTNXT##	;GET ADDR OF FIRST FREE WORD OF AKTTAB
	CAML	TA,TB		;ARE WE INTO FREE AREA?
	 JRST	ERENR4		; YES - ERROR
	JRST	ERNR3A		;NOT OK, GO TRY NEXT ENTRY

ERENR4:	LDB	LN,[POINT 13,2(TC),28]
	LDB	CP,[POINT 7,2(TC),35]
	MOVEI	DW,E.572
	PUSHJ	PP,FATAL##	;GENERATE ERROR MESSAGE
				;(KEYS DON'T AGREE IN USAGE AND SIZE)
	JRST	ERENR9

ERENQ5:	MOVE	CH,[MOVEI.+ASINC+AC16,,AS.MSC]
	PUSHJ	PP,PUTASY	;GENERATE MOVEI 16,LIT-TABLE-ENTRY
	HRRZ	CH,ELITPC
	TRO	CH,AS.LIT
	PUSHJ	PP,PUTASN	;(IT TAKES 2 WORDS)
	MOVE	TA,[OCTLIT,,1]	;CREATE HEADER WORD FOR LITERAL
	PUSHJ	PP,STASHI
	HLL	TA,ESAVW1	;GET ERENQ OR ERDEQ FLAGS
	TLZ	TA,777377	;ZERO ALL BITS EXCEPT UNAVAILABLE
	LSH	TA,-8		;NORMALIZE IN LH
	HRR	TA,ESUCNT	;SET RH TO N
	PUSHJ	PP,STASHL	;STASH AWAY
	AOS	ELITPC
	LDB	W1,[POINT 9,ESAVW1,8]
	MOVEI	CH,LRDEQ.
	CAIN	W1,000153
	JRST	ERNQ5A
	MOVE	TA,ESAVW1	;GEN COMPOUND RETAIN FLAG
	MOVEI	CH,LRENQ.	;PRESUME NOT COMPOUND
	TLNE	TA,200
	MOVEI	CH,CNTAI.
ERNQ5A:	PUSHJ	PP,PUT.PJ	;GENERATE PUSHJ PP,LRENQ (OR LRDEQ)

	SKIPA	TE,ESUFN1
ERENQ6:	MOVE	TE,ESUFN2	;GET POINTER TO FILE-NAME IN CUREOP
	MOVEM	TE,CUREOP
ERENQ7:	ADDI	TE,2		;GET POINTER TO CORRESPONDING RENQ OR RDEQ IN TE
	LDB	TA,[POINT 9,0(TE),8]
	CAIN	TA,000147
	JRST	ERENQ9
	CAIE	TA,000152
	JRST	ERENQ7
ERENQ9:	HLLZ	W1,0(TE)	;SET UP RENQ OR RDEQ & FLAGS IN LH
	HRR	W1,CUREOP
	HRR	W1,1(W1)
	ORI	W1,AS.FIL
	CAMN	W1,[152400,,0]	;IF FREE EVERY RECORD, THEN
	ORI	W1,AS.CNB	;SET FILE TABLE TO NULL
	ADDI	TE,2
	MOVEM	TE,ESUFN2	;SAVE POINTER TO NEXT FILE NAME (IF ANY)
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHI
	MOVE	TA,W1
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHL
	HRRZ	TA,W1
	PUSHJ	PP,STASHL	;STASH AWAY FILE ARGUMENT
	AOS	ELITPC
	MOVE	TC,CUREOP
	LDB	CH,[POINT 9, 2(TC), 8]
	CAIE	CH,000147
	CAIN	CH,000152
	JRST	ERENQ8		;JUMP IF OPERATOR
	MOVE	TA,[XWDLIT,,2]
	PUSHJ	PP,STASHI
	HLRZ	TA,2(TC)
	ANDI	TA,740		;EXTRACT AC FIELD OF OPERAND
	CAIN	TA,2B30		;CONVERT TO NEW TYPE CODES
	MOVEI	TA,4B30
	CAIN	TA,0B30
	MOVEI	TA,2B30
	CAIN	TA,10B30
	MOVEI	TA,15B30
	CAIN	TA,17B30
	MOVEI	TA,7B30
	MOVE	CH,2(TC)
	TLNE	CH,20
	TRO	TA,20
	PUSHJ	PP,STASHL
	HRRZ	TA,2(TC)
	HRL	TA,3(TC)
	PUSHJ	PP,STASHL	;GENERATE XWD (IT TAKES 3 STASHL'S)
	AOS	ELITPC
ERENQ8:	HRRZ	TA,ESUFN2	;HAVE WE GENERATED LAST ITEM?
	HRRZ	TE,EOPNXT
	SUB	TA,TE
	SOJN	TA,ERENQ6	;NO, GO BACK AND DO NEXT ITEM
	HRRZ	TA,ESUFN1	;YES
	SOJ	TA,
	SUBB	TE,TA
	LSH	TE,-1
	SUB	EACC,TE		;ADJUST EACC
	HRL	TA,TA
	MOVN	TA,TA
	ADDB	TA,EOPNXT	;ADJUST EOPNXT
	MOVEM	TA,EACA		;ADJUST EACA
	SETZM	ESUCNT
	MOVE	TA,ESAVW1	;GET UNAVAILABLE FLAG
	TLNN	TA,000400
	JRST	COMEBK		;ALL DONE IF NO UNAVAILABLE STATEMENT
	SETZM	ESUTAG		;OTHERWISE GENERATE JRST AROUND UNAVAILABLE STATEMENT
	JRST	FUNAVG

;ROUTINE TO CHECK OVER RETAINED KEY AGAINST AN AVAILABLE RMS INDEXED FILE KEY
; IT CHECKS THE USAGE AND THE SIZE OF EACH, THEN RESTORES POINTER TO THE
; OPERAND IN CASE WE HAVE SUCCESS AND GO BACK TO ERENQ3.

ERNR3X:
	MOVEM	TA,SVKYDT##	;SAVE ASIDE KEY'S DATAB ENTRY
	PUSHJ	PP,LNKSET##	;GET ADDR OF DATA FIELD'S TABLE IN TA
	LDB	TB,DA.USG##	;GET ITS USAGE
	SUBI	TB,1		; AND ADJUST IT TO CORRESPOND TO WHAT
				; WAS DONE TO THE "A" OPERAND.
	MOVEM	TB,EMODEB##	; AND SAVE IT
	LDB	TB,DA.INS##	;GET ITS SIZE
	MOVEM	TB,ESIZEB##	; AND SAVE IT

;NOW DO THE COMPARISONS

	MOVE	TB,EMODEB##	;GET FILE KEY'S USAGE
	CAME	TB,EMODEA##	; SAME AS RETAIN KEY'S?
	 JRST	ERNRE1		;JUMP IF USAGE DOESN'T MATCH
	MOVE	TA,ESIZEA##	;GET FILE KEY'S SIZE
	CAMN	TA,ESIZEB##	; SAME AS RETAIN KEY'S?
	 JRST	ERNRUK		;JUMP IF SIZE MATCHES
	CAIE	TB,D1MODE##	;ONE-WORD DECIMAL?
	 JRST	ERNRE1		; NO - NOT A MATCH
	CAMG	TA,ESIZEB	;FOR ONE-WORD DECIMAL, FILE KEY CAN BE
				;SHORTER THAN SIZE OF LITERAL
				;OR DATA NAME IF BOTH ARE COMP
	 JRST	ERNRE1		;GO TO ERROR RETURN
ERNRUK:
	MOVE	TA,SVKYDT##	;GET BACK DATAB ENTRY
	PUSHJ	PP,UKADR	;MAKE SURE KEY IS WORD-ALIGNED
	MOVE	TA,SVKYDT##	;GET IT AGAIN
	JUMPE	TA,ERNRE1	;IS ERROR IF HAPPENS, SHOULDN'T IF IT GOT
				; HERE ORIGINALLY
	PUSHJ	PP,LNKSET	;LOOK UP DATAB ENTRY
	LDB	TB,DA.RES	;GET DATA ITEM'S BYTE RESIDUE
	CAIN	TB,^D36		;WORD ALIGNED?
	 SETZM	KEYADR##	; YES, DON'T PICK UP FILE KEY DATA ITEM
				;  FOR LITERAL TABLE
	JRST	ERNREX		; AND GO TO GOOD RETURN
ERNRE1:				;COME HERE IF RETAIN KEY NOT OK
	AOS	0(PP)		;FAILURE RETURNS + 2
ERNREX:				;SUCCESS RETURNS + 1
	MOVE	TC,CUREOP	;RESTORE ARG POINTER TO TC
	POPJ	PP,		; AND RETURN
;ERENSF AND ERENS1
;ROUTINES TO SETUP CURFIL AND GENERATE KEY CONVERSION CODE,
; IF NECESSARY.

;ERENSF IS CALLED TO SETUP CURFIL AND GENERATE THE CONVERSION CODE
; FOR THE FIRST FILE.
ERENSF:	LDB	TA,[POINT 15,1(TC),35]	;GET FILTAB OFFSET
	HRLM	TA,CURFIL	;SETUP CURFIL
	ADD	TA,FILLOC
	HRRM	TA,CURFIL	;. .
	LDB	TD,FI.CKB##	;NEED TO CONVERT KEY?
	JUMPE	TD,CPOPJ	;NO
	SKIPN	ESUCVT##	;DID WE ALREADY HAVE TO CONVERT A KEY?
	 JRST	ERENSN		;NO
	HLRZ	TD,CURFIL	;DID WE ALREADY CONVERT THIS FILE?
	CAMN	TD,ESUCVT##	;WAS IT THIS FILE?
	 POPJ	PP,		;YES, CONVERSION DONE.
	JRST	ERENS2		;NO, ERROR

ERENSN:	HLRZ	TD,CURFIL	;SET ESUCVT = F.T. ADDRESS OF THE FILE
	HRRZM	TD,ESUCVT##	; REMEMBER WHICH FILE WE CONVERTED A KEY FOR.
	PUSH	PP,TC		;SAVE TC
	PUSHJ	PP,CNVKYB	;CONVERT KEY BEFORE I/O
	POP	PP,TC		;RESTORE TC
	POPJ	PP,		;RETURN

;GIVE ERROR BECAUSE DMN MADE ALL CONVERTED KEYS POINT TO %PARAM+0.
;; SO YOU CAN'T GENERATE CODE TO CONVERT A KEY FOR MORE THAN ONE
; FILE AT A TIME!
;THIS IS GENERALLY NOT NECESSARY BUT "RETAIN" AND "FREE" STATEMENTS
; MAY REFERENCE MORE THAN ONE FILE.
ERENS2:	MOVEI	DW,E.738	;"Can't have more than 1 file with
				; converted key".
	LDB	LN,[POINT 13,(TC),28]
	LDB	CP,[POINT 7,(TC),35]
	PUSHJ	PP,FATAL	;POINT TO THIS FILENAME
	POPJ	PP,		;AND RETURN

;ERENS1 IS CALLED FOR ALL OTHER FILES. IF THE FILENAME IS THE SAME,
; NO CODE IS GENERATED, ELSE IT STORES THE NEW CURFIL AND GENERATES
; CODE IF NECESSARY.
ERENS1:	LDB	TA,[POINT 15,1(TC),35] ;GET FILTAB OFFSET
	HLRZ	TD,CURFIL	;SAME FILE AS LAST TIME?
	CAMN	TA,TD
	 POPJ	PP,		;YES, NOTHING TO DO, RETURN
	JRST	ERENSF		;GO GENERATE CODE IF NECESSARY
;RECORD DEQUEUE

RDEQGN:	TLNN	W1,000400
	JRST	RENQGN
	MOVEM	W1,ESAVW1
	HRLZI	W1,400000
	HRRZI	W2,000001
	PUSHJ	PP,PUSH12	;IF FREE EVERY RECORD, PUT DUMMY FILE NAME ON OPERAND STACK
	MOVE	W1,ESAVW1
	HRRZI	W2,000152
	AOJA	EACC,RENQGN
SUBTTL	KYPTR -- RMS ROUTINE TO GET PTR TO RECORD KEYS

REPEAT 0,<
;;; ALL THIS CODE HAS BEEN SNARFED INTO CLEANC.

		;WHOLE BUNCH OF CODE IN ANS74
;THIS ROUTINE GENERATES THE KEY INFORMATION IN %LIT00
;;  (UNLESS IT IS THERE ALREADY).
;; AND RETURNS EACA = PTR TO %LIT.
;RETURNS .+1 IF ERRORS, SKIP IF NO ERRORS

KYPTR:	MOVE	TA,CURFIL
	LDB	EACA,FI.KYE##	;DID WE HAVE ERRORS BEFORE?
	JUMPN	EACA,CPOPJ	;YES, RETURN .+1

;PUT THE FOLLOWING KEY INFORMATION IN LITTAB:
;
;	EXP	NUMBER OF KEYS
;	2-WORD-KEY-DESCRIPTORS
;
; EACH KEY-DESCRIPTOR HAS THE FOLLOWING FORMAT:
;	XWD	STARTING BYTE POSITION,,KEY SIZE
;	XWD	FLAGS,,DATATYPE
; FLAGS ARE:
;	1B0	DUPLICATES ALLOWED
; DATATYPE VALUES ARE:
;	0	SIXBIT
;	1	ASCII
;	2	EBCDIC

;FIRST, FIND NUMBER OF KEYS
	LDB	TA,FI.ALK##	;GET PTR TO FIRST ALTERNATE KEY
	MOVEI	TE,1		;1 KEY SO FAR (THE PRIMARY KEY)
	JUMPE	TA,KYPTR1	; JUMP IF THAT'S ALL

;LINK THRU AKTTAB TO COUNT ALTERNATE KEYS
;PTR TO FIRST ENTRY IS IN EACA
	ADD	TA,AKTLOC##	;TA= ABS ADDR OF ENTRY
	HRRZ	TA,TA		;CLEAR LEFT HALF
	HRRZ	TB,AKTNXT##	;TB= PTR TO "NEXT" ENTRY
				; (TO TELL WHEN OFF TABLE)
	LDB	TD,AK.FLK##	;TD= WHICH FILE
KYPTR0:	ADDI	TE,1		;COUNT ANOTHER KEY
	ADDI	TA,SZ.AKT	;LOOK AT NEXT ENTRY
	CAML	TA,TB		;PAST END OF TABLE?
	 JRST	KYPTR1		;YES, THAT'S ALL THE KEYS
	LDB	TC,AK.FLK##	;GET WHICH FILE THIS ENTRY POINTS TO
	CAIN	TC,(TD)		;SKIP IF LOOKING AT A DIFFERENT FILE NOW
	 JRST	KYPTR0		;SAME FILE, KEEP COUNTING

;FALL TO NEXT PAGE WHEN TE = NUMBER OF KEYS
;HERE WITH NUMBER OF KEYS IN TE
KYPTR1:	MOVEM	TE,NMAKYS##	;SAVE NUMBER OF ALTERNATE KEYS + 1
	MOVE	TE,ELITPC	;SAVE CURRENT LITERAL PC, INCASE WE POOL
	MOVEM	TE,LPCSAV##
	MOVE	TA,[OCTLIT,,1]
	PUSHJ	PP,STASHP
	MOVE	TA,NMAKYS	;WRITE OUT NUMBER OF KEYS
	PUSHJ	PP,STASHQ	; AS "OCT N"
	AOS	ELITPC		;BUMP LITERAL PC

;WRITE OUT KEY INFORMATION
;FIRST FOR THE PRIMARY RECORD KEY
	HLRZ	TA,CURFIL	;FIND PTR TO CURRENT FILE AGAIN
	ADD	TA,FILLOC
	LDB	TA,FI.RKY	;GET RECORD KEY PTR
	SETZM	EFLAGB		;CLEAR FLAGS
	PUSHJ	PP,KYINFO	;CREATE THE INFO BLOCK
	 JRST	KYIER		;ERROR

	MOVE	TD,NMAKYS##	;NUMBER OF ALTERNATE KEYS
	SOJ	TD,		;IN TD
	JUMPE	TD,KYPTR6	;JUMP IF NONE TO DO

	HLRZ	TA,CURFIL	;POINT TO CURRENT FILE
	ADD	TA,FILLOC
	LDB	TA,FI.ALK	;GET PTR TO ALTERNATE KEYS
	ADD	TA,AKTLOC	;[1370] GET ABS PTR
	MOVEM	TA,CURAKT##	;[1370] SAVE REL. ADDR - no. abs addr

;HERE WITH TA= ABS ADDR OF ENTRY, TD= # ENTRIES LEFT TO DO
KYPTR2:	LDB	TB,AK.DUP##	;GET "DUPLICATES" FLAG
	TRNE	TB,1		;IS IT SET?
	MOVX	TB,1B0		;YES, TURN ON BIT
	MOVEM	TB,EFLAGB	;SETUP FOR "FLAGS"
	LDB	TA,AK.DLK##	;GET DATAB LINK
	PUSHJ	PP,KYINFO	;CREATE THE INFO BLOCK
	 JRST	KYIER		;ERROR
	SOJLE	TD,KYPTR6	;JUMP IF NO MORE TO DO
	MOVEI	TA,SZ.AKT	;BUMP TO NEW ENTRY
	ADDB	TA,CURAKT	;FETCH AND UPDATE REL. LOC
	JRST	KYPTR2		;GO BACK FOR MORE KEYS
;HERE IF AN ERROR IF FOUND IN KYINFO. SET FI.KYE TO -1
; TO INDICATE ERROR, AND LEAVE LITERALS IN A GOOD STATE
KYIER:	HLRZ	TA,CURFIL
	ADD	TA,FILLOC##	;GET ABS ADDR
	SETO	TB,		;SET FIELD TO -1
	DPB	TB,FI.KYE##	;THE NEXT TIME, DON'T TRY TO GEN CODE
;FALL INTO KYPTR6, AS IF WE HAD FINISHED GENERATING ALL THE KEYS

;HERE WHEN DONE PUTTING ALL KEY INFO IN LITTAB
KYPTR6:	PUSHJ	PP,POOL		;POOL THE BLOCK OF LITERALS
	MOVE	TE,LPCSAV	;IF WE POOLED, RESTORE LITERAL PC
	SKIPE	PLITPC
	 MOVEM	TE,ELITPC
	SKIPN	EACA,PLITPC	;GET PC IF POOLED
	 MOVE	EACA,LPCSAV	;NOT POOLED, GET STARTING PC
	IORI	EACA,AS.LIT	;TURN ON "LIT" BIT
	JRST	CPOPJ1		;RETURN WITH PTR TO KEY INFO IN EACA
SUBTTL	KYINFO -- WRITE KEY BLOCK FOR EACH KEY
;
;;CALL:	TA/ PTR TO KEY DATANAME
;	EFLAGB/	LH = FLAGS TO PASS
;
;	PUSHJ	PP,KYINFO
;	  <RETURN HERE IF ERRORS>
;	<RETURN HERE IF OK>
;
; THIS ROUTINE CHECKS THE RMS RESTRICTIONS ON KEYS
; PRESERVES TD

KYINFO:	JUMPE	TA,CPOPJ	;ERROR IF NO LINK
	PUSH	PP,TD		;PRESERVE AC

	MOVEM	TA,ETABLB	;USE "B" LOCATIONS FOR TEMP STORAGE
	PUSHJ	PP,LNKSET	;LOOK AT DATAB ENTRY

	LDB	TE,DA.ERR##	;ERROR BIT ON?
	JUMPN	TE,KYINF9	;YES, RETURN ERROR

;CHECK FOR KEY MODE OF "DISPLAY", AND SAVE MODE IN EMODEB
	LDB	TE,DA.USG
	SUBI	TE,1
	CAILE	TE,DSMODE
	 JRST	KYINF8		;GIVE ERROR
	MOVEM	TE,EMODEB	;SAVE IT

;CHECK FOR KEY SIZE TOO LARGE FOR RMS TO HANDLE
	LDB	TE,DA.INS##	;GET SIZE OF ITEM
	CAILE	TE,^D256	;CHECK RMS LIMIT
	 JRST	KYINF7		;?TOO BIG, GIVE ERROR
	MOVEM	TE,ESIZEB	;SAVE SIZE

	LDB	TE,DA.RES##	;BYTE RESIDUE
	HRLM	TE,ERESB	;SAVE

;OK, EVERYTHING IS FINE.
; COMPUTE KEY OFFSET (BYTES) AND PUT IN EINCRB
	LDB	TE,DA.LOC##	;GET START OF THIS KEY
	MOVE	TD,EMODEB	;GET MODE OF THE DATA ITEM
	MOVE	TC,BYTE.W(TD)	;TC= BYTES PER WORD
	IMUL	TE,TC		;START COMPUTING OFFSET
	HLRZ	TB,ERESB	;FIND BYTE OFFSET IN WORD..
	MOVEI	TC,^D36
	SUB	TC,TB		; (# BITS IN..)
	IDIV	TC,BYTE.S##(TD)	;DIVIDE BY BYTE SIZE
	ADD	TE,TC		;ADD IN BYTE OFFSET WITHIN WORD
	MOVEM	TE,EINCRB	;SAVE BYTE OFFSET INTO THE RECORD
;GENERATE THE TWO-WORD BLOCK
	MOVE	TA,[XWDLIT,,2]	;GENERATE 1ST XWD
	PUSHJ	PP,STASHP
	HRLZ	TA,EINCRB	;POSITION OF KEY IN THE RECORD
	HRRI	TA,AS.CNB	; A CONSTANT
	PUSHJ	PP,STASHQ
	HRLZ	TA,ESIZEB	;KEY SIZE
	HRRI	TA,AS.CNB	; A CONSTANT
	PUSHJ	PP,STASHQ
	AOS	ELITPC		;BUMP LITERAL PC

	MOVE	TA,[XWDLIT,,2]	;NEXT XWD
	PUSHJ	PP,STASHP
	HLLZ	TA,EFLAGB	;FLAGS
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	HRLZ	TA,EMODEB	;DATATYPE (0=SIXBIT, 1=ASCII, 2=EBCDIC)
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	AOS	ELITPC		;BUMP LITERAL PC

	POP	PP,TD		;RESTORE AC
	JRST	CPOPJ1		;GOOD RETURN
;ERROR ROUTINES

;SIZE OF KEY TOO LARGE
KYINF7:	MOVEI	DW,E.628	;KEY LARGER THAN 256
	JRST	KYIN8A

;KEY NOT DISPLAY MODE
KYINF8:	MOVEI	DW,E.627	;MODE NOT DISPLAY
KYIN8A:	LDB	LN,DA.LN	;POINT TO DATANAME DEFINITION FOR THIS ERROR
	LDB	CP,DA.CP	; (IT WILL ONLY HAPPEN ONCE)
	PUSHJ	PP,FATAL
	JRST	KYINF9

;HERE IF ERRORS OCCUR IN KYINFO ROUTINE
KYINF9:	POP	PP,TD		;RESTORE AC
	POPJ	PP,		;ERROR RETURN

> ; END REPEAT 0
;UKADR - FIND ADDRESS OF ITEM IN TB, STORE IN "KEYADR".
; IF THE ITEM IS NOT WORD ALIGNED, GENERATE A MOVE TO A %TEMP
; THAT IS WORD ALIGNED, AND STORE THE ADDRESS OF THE %TEMP.

;CALL:	TA/ DATAB LINK OF KEY
;	PUSHJ	PP,UKADR
;	<RETURN HERE, KEYADR SET UP, POSSIBLY CODE GENERATED>

UKADR:	PUSH	PP,TA		;MAYBE IT IS WORD ALIGNED
	JUMPE	TA,UKADRY	;GIVE UP IF IN ERROR
	PUSHJ	PP,LNKSET	; LOOK AT DATAB ENTRY
	LDB	TB,DA.RES	;BYTE RESIDUE..
	CAIN	TB,^D36		;OH PLEASE!
	 JRST	UKADRY		;YES! NOTHING DIFFICULT

;ITEM IS NOT ALIGNED.
; GENERATE A MOVE TO A %TEMP, SO IT CAN BE ALIGNED.

;CALL SETOPN WITH A FAKE 2-WORD OPERAND
; TO PUT THE ITEM IN "A"
	HRRZ	TB,(PP)		;GET ITEM
	PUSH	PP,[0]		;ON THE STACK, FIRST WORD IS 0
	PUSH	PP,TB		;2ND WORD = DATAB ADDR.
	MOVEI	TC,-1(PP)	;POINT TO THE "OPERAND"
	MOVEI	LN,EBASEA	;PUT IN "A"
	PUSHJ	PP,SETOPN##
	POP	PP,(PP)		;THROW AWAY THE 'OPERAND'
	POP	PP,(PP)
	POP	PP,(PP)		;ITEM IS NOW IN "EBASEA"
	EQUIT;			;QUIT IF ERRORS

;SET UP A %TEMP TO LOOK LIKE THAT, EXCEPT IT IS WORD ALIGNED.
	MOVE	TE,[XWD EBASEA,EBASEB] ;SET "B" = "A"
	BLT	TE,EBASBX
	MOVE	TE,[XWD ^D36,AS.MSC] ;EXCEPT "B" WILL BE IN %TEMP
	MOVEM	TE,EBASEB

;GO GET SOME SPACE IN %TEMP
	MOVE	TE,ESIZEB	;TO FIND SIZE OF B IN WORDS
	HRRZ	TC,EMODEB
	MOVE	TC,BYTE.W(TC)	;GET BYTES PER WORD
	ADDI	TE,-1(TC)
	IDIVI	TE,(TC)		;TE= # FULL WORDS NEEDED
	PUSHJ	PP,GETEMP	;GO GET SOME %TEMP
	MOVEM	EACC,EINCRB

	HRLZ	EACC,EACC	;SHIFT TO LH
	HRRI	EACC,AS.MSC	; MISC. IN RH
	MOVEM	EACC,KEYADR##	;STORE KEY ADDRESS
	SWOFF	FBSUB!FASIGN	;CLEAR SOME FLAGS
	PUSHJ	PP,MXX.##	;GO GENERATE THE MOVE
	POPJ	PP,		;RETURN

UKADRY:	POP	PP,KEYADR##	;STORE KEY ADDRESS
	POPJ	PP,		;RETURN
;IODBU - GENERATE SOME DEBUGGING CODE AFTER A READ OR DELETE

IODBU:	MOVE	CH,[SKIPA.##+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVEI	CH,AS.DOT+1
	PUSHJ	PP,PUTASN	;SKIPA 16,.+1
	MOVE	CH,[AS.XWD,,1]
	PUSHJ	PP,PUTASN
	MOVEI	CH,DBP%UP	;USE PROCEDURE CODE
	PUSHJ	PP,PUTASN	;IN LHS
	LDB	CH,[POINT 13,PREVW1,28] ;GET LINE # OF PREVIOUS OPERATOR
	PUSHJ	PP,PUTASY
	MOVE	CH,[MOVEM.##+AC16+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVE	CH,DBPARM##
	IORI	CH,AS.PAR##
	PJRST	PUTASN		;MOVEM 16,%PARAM+N

;SEE IF WE NEED DEBUGGING ON "A" OPERAND FOR WRITE

TSDEBA:	SKIPL	TE,EDEBDA##	;DID USER WANT DEBUGGING?
	POPJ	PP,		;NO
	SKIPE	INDCLR##	;ARE WE STILL IN DECLARATIVES?
	TDZA	TD,TD		;YES, SO NO DEBUGGING ALLOWED
	LDB	TD,DA.DEB##	;DEBUGING ON THIS DATA-NAME ALLOWED?
	SKIPE	TD		;NO
	HLRZ	TD,TA		;YES, GET BASE ADDRESS
	MOVEM	TD,EDEBDA	;SIGNAL DEBUGGING REQUIRED (OR NOT)
	JUMPE	TD,CPOPJ	;DONE IF NOT DEBUGGING
	HRRZM	TE,EDEBGA##	;SAVE AS FLAG FOR "ARO" TEST
	MOVE	TD,EDEBDA##	;GET BASE
	PJRST	TSTARO##	;SET UP VARIOUS PARAMETERS AND RETURN

	END