Google
 

Trailing-Edge - PDP-10 Archives - BB-H580C-SB_1981 - iogen.mac
There are 22 other files named iogen.mac in the archive. Click here to see a list.
; UPD ID= 3576 on 6/9/81 at 7:59 PM by NIXON                            
TITLE	IOGEN FOR COBOL V12B
SUBTTL	I/O GENERATORS		AL BLACKINGTON/SIP/CAM



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION


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

;EDITS

;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.
TWOSEG
RELOC	400000
SALL

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

O.BOPR:	O%BOPR

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

;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%NIK==1B9		;NO INVALID KEY CLAUSE GIVEN

;DELETE FLAG BITS
	DL%NIK==1B9		;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


;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
IFN ANS68,<
ENTRY SEEKGN	;"SEEK" GENERATOR
>
IFN ANS74,<
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

INTERNAL LARGE,LARGER	;FIND LARGEST RECORD FOR A FILE [245]


SUBTTL	OPEN

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

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

OPENG0:
IFN ANS74,<
	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
>;END IFN ANS74
	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]
IFN ANS68,<
	JRST	PUTOP
>
IFN ANS74,<
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

IFN ANS74,<

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

; SET IOFLGS FOR TYPE OF OPEN
	MOVX	TD,OPN%IN	;INPUT
	TXNE	W1,1B10		;"INPUT"
	IORM	TD,IOFLGS##	;SET IN IO FLAGS

	MOVX	TD,OPN%OU
	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

;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

	PUSH	PP,EACA		;SAVE ADDR OF KEY-INFO
	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
	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
	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

>;END IFN ANS74

;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;
IFN ANS74,<
	LDB	TE,FI.RMS##	;CHECK FOR RMS FILE
	JUMPN	TE,CLOM		; GO GENERATE THE RMS CLOSE
>;END IFN ANS74
	MOVSI	CH,CLOS##
IFN ANS74,<
	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'
IFN ANS68,<
	JRST	PUTOP
>
IFN ANS74,<
	JRST	OPNGN3		;SEE IF KEY NEEDS CONVERTING
>
SUBTTL	RMS CLOSE

IFN ANS74,<

CLOM:	MOVEI	TE,V%CLOS	;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
>;END IFN ANS74
SUBTTL	STDAGL - WRITE A STANDARD ARG LIST AND MOVEI 16,ADDR

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

READGN:	PUSHJ	PP,SETOP	;SET UP OPERAND
	EQUIT;			;QUIT IF ERRORS
IFN ANS74,<
	LDB	TE,FI.RMS	;RMS FILE?
	JUMPN	TE,READM	;YES
>;END IFN ANS74
	MOVEI	CH,READ##
IFN ANS74,<
	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

RDGN1:
IFN ANS68,<
	MOVS	CH,EIOOP
	PUSHJ	PP,PUTOP	;SET UP  AND WRITE OPERATOR
>
IFN ANS74,<
;17-AUG-79 /DAW	DON'T ALLOW DELETE FOR SEQ. FILE
	HRRZ	CH,EIOOP
	CAIE	CH,DELETE##
	JRST	RDGN1A		;NOT DELETE, OK

	MOVE	TA,CURFIL	;FIND ACCESS MODE FOR FILE
	LDB	TD,FI.ACC
	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

IFN ANS68,<
	LDB	TE,FI.ACC	;IS FILE
	JUMPN	TE,RDGN3	;  SEQUENTIAL?
>
IFN ANS74,<
	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:
IFN ANS74,<
	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

RDGN6:
IFN ANS74,<
;CHECK FOR USE ERROR PROCEDURE AND IF GIVEN USE IT
	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.ACC	;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
IFN ANS74,<
	CAIN	W2,NOOP.	;IF NOOP.,
	  POPJ	PP,		; SKIP IT
>;END IFN ANS74
	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:
IFN ANS68,<
	JRST	SPIFGC
>
IFN ANS74,<
	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

IFN ANS74,<

READM:	MOVEI	TE,V%READ	;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
	TLNN	W1,INTO		;"INTO" OPTION FOR THIS READ?
	 JRST	RDM1		;NO

	PUSHJ	PP,LARGE	;YES--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 RDM1]	;OK
	PUSHJ	PP,INTOOK	; SEE IF "INTO" IS OK
	 JRST	RDGN9		;NO, COMPLAIN

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

;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:	PUSHJ	PP,PUT.PJ	;GENERATE CALL

	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
>;END IFN ANS74
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:
IFN ANS74,<
	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:
>;END IFN ANS74
	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
IFN ANS74,<
	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
	HLRZ	TE,CURDAT	;CHECK FOR DEPENDING VARIABLES
	HRRZM	TE,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
	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
IFN ANS74,<
	PUSH	PP,CURDAT	;SAVE CURRENT DATAB 
	SETOM	EDEBDA##	;SEE IF DEBUGGING WANTED
>
	PUSHJ	PP,MOVGN.	;GENERATE MOVE
IFN ANS74,<
	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:
IFN ANS74,<
	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.ACC
	MOVE	TE,EIOOP	;GET VERB BACK
IFN ANS68,<
	CAIE	TD,%ACC.I	;IF FILE IS INDEXED
	CAIN	TE,WRITE	;  OR THIS IS A 'WRITE'
	JRST	RITG1A		;  ALL IS WELL

	MOVEI	DW,E.371	;'NOT LEGAL UNLESS ISAM'
	PUSHJ	PP,OPFAT
>

RITG1A:	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
IFN ANS74,<
	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
IFN ANS74,<
	TLO	W1,AFTER	;"AFTER"
>
	JRST	WADVG5
;"WRITE" GENERATOR  (CONT'D).

; NO ADVANCING

RITGN2:
IFN ANS68,<
	MOVE	TE,EIOOP	;IF THIS IS
	CAIN	TE,DELETE##	;  A 'DELETE',
	JRST	RITG2B		;  SKIP SOME CODE

	LDB	TE,FI.ACC	;IS IT
	CAIE	TE,%ACC.I	;  INDEXED FILE?
	JRST	RITG2B		;NO

;GENERATE MOVE OF SYMBOLIC KEY TO RECORD KEY

	MOVE	EACA,EOPLOC
	MOVEM	W1,1(EACA)
	MOVEM	W1,3(EACA)
	PUSH	PP,TA		;SAVE TA
	LDB	TA,FI.SKY	;GET POINTER TO SYBOLIC KEY
	JUMPN	TA,RITG2A	; SEE IF OKAY [252]
	POP	PP,TA		; [252] NO
	JRST	RITG2B		; [252] DON'T MOVE
RITG2A:	PUSHJ	PP,LNKSET	; [252]
	LDB	TB,DA.LKS##	; SYMBOLIC KEY IN LINKAGE SECTION?
	POP	PP,TA		;RESTORE TA
	LDB	TE,FI.SKY	;PICK UP POINTER TO SYMBOLIC KEY
	JUMPE	TB,.+3		;IN LINKAGE SECTION?
	MOVSI	TB,(LKSFLG)	;YES, SET THE LINKAGE SECT. FLAG
	IORM	TB,1(EACA)	;IN FIRST WORD OF EOPTAB ENTRY
	MOVEM	TE,2(EACA)
	LDB	TE,FI.RKY
	JUMPE	TE,RITG2B
	MOVEM	TE,4(EACA)
	ADD	EACA,[XWD 4,4]
	MOVEM	EACA,EOPNXT
	PUSHJ	PP,MOVGEN
>

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

RITG2B:	HRLZ	CH,EIOOP	;GET OP-CODE
IFN ANS74,<
	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,SZDPVA##
	 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
IFN ANS74,<
	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
IFN ANS74,<
;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.ACC	;UNLESS IT'S INDEXED
	CAIE	TE,%ACC.I
	 JRST	RITGN6		;RELATIVE--"Invalid key not allowed"
RITGN4:
>;END IFN ANS74
	LDB	TE,FI.ACC
	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:
IFN ANS68,<
	JUMPE	TE,RITGN6	;IF FILE IS SEQ,
>
IFN ANS74,<
	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:
IFN ANS74,<
	MOVE	TE,EIOOP	;IS THIS A REWRITE?
	CAIE	TE,RERIT.
	 JRST	RTGN5A		;NO
	LDB	TE,FI.ACC	;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.ACC		;GET ORGANIZATION MODE
	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.ACC	;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,350700	;YES--CREATE A BYTE POINTER TO LITERAL IN VALTAB
	LDB	TD,TA		;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
IFN ANS74,<
	PUSHJ	PP,CNVKYB	;SEE IF KEY NEEDS CONVERTING
>
	SKIPN	TE,WDPITM##	;DEPENDING ITEM?
	 JRST	WADV5A		;NO, SKIP THIS
	TRNN	TE,-1		;ARE WE SURE?
	 JRST	WADV5A		;NO
	PUSH	PP,TC		;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,SZDPVA##
	 JRST	[POP PP,TC	;RESTORE TC
		JRST DPPER2]	; AND 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
	JRST	OVRPUT		;JUMP OVER PUTOP

;THIS SHOULD NEVER HAPPEN.  IF IT DOES, THE PROGRAM SHOULD STILL WORK ANYWAY.
DPPER2:	OUTSTR	DPPEMS	;REPORT PROBLEM WITH DEPENDING VARIABLE
;	JRST	WADV5A		; 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,D1MODE+1	; [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

	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.
IFN ANS74,<
	PUSHJ	PP,CNVKYB	;SEE IF KEY NEEDS CONVERTING
>
	PUSHJ	PP,PUTOP

	MOVE	CH,[XWD AS.XWD,1]
	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
IFN ANS68,<
	JRST	RITGN3
>
IFN ANS74,<
	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
IFN ANS74,<

;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
	HLRZ	TE,CURDAT	;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
	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:	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	;ADVANCING CLAUSE?
	 JRST	WRTM2		;NO, OK

	MOVEI	DW,E.372	;** CHECK THIS **
	PUSHJ	PP,OPFAT
	POPJ	PP,		;RETURN FROM WRITE

WRTM2:	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	TA,FI.ERR##	;SEE IF FILE-SPECIFIC USE PROCEDURE
	JUMPN	TA,WRTM2D	;YES, SET THE BIT
	SKIPN	USP.O##		;NO, GENERAL USE PROCEDURE?
	SKIPE	USP.IO##
	 JRST	WRTM2D		;YES, SET THE BIT

	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

	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.
;NOTE FOR MAINTAINERS:
;  THERE IS NO REAL REASON FOR CHOOSING AC4 RATHER THAN ANOTHER AC ;
	TLNE	TE,-1		;HAVE TO PRESERVE %PARAM+0?
	 SETOM	SAVPR0##	;YES, TELL SZDPVA
	HRRZM	TE,ETABLA	;IT LOOKS FOR LINK IN ETABLA
	MOVEI	TE,4		; LOAD RUNTIME SIZE IN AC4
	HRRZ	TE,EOPLOC	;POINT TO THE RECORD OPERAND
	ADDI	TE,1		; IN CASE OF ERROR
	HRLM	TE,OPERND	;"A" OPERAND
	PUSHJ	PP,SZDPVA##	;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
	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

;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,2		;WE JUST GENERATED TWO 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
	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
	HRLZ	TA,ERECSZ	;GET REC SIZE
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	MOVE	TA,KEYADR	;GET KEY ADDRESS
	PUSHJ	PP,POOLIT
WRTM2G:	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

;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##
	SKIPE	TD		;SKIP IF RANDOM ACCESS
	MOVEI	CH,WT.MIS##	;NO, USE OTHER ROUTINE

WRTM2J:	PUSHJ	PP,PUT.PJ	;"PUSHJ PP,ROUTINE"

WRTM2K:	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
>;END IFN ANS74			;GO DO NEXT OPERATOR
SUBTTL	SEEK

IFN ANS68,<
SEEKGN:	PUSHJ	PP,SETOP
	EQUIT;

	LDB	TE,FI.ACC	;IF FILE IS  NOT RANDOM,
	SOJN	TE,NOTRAN	;  ERROR

	MOVSI	CH,SEEK##
	JRST	PUTOP
>

SUBTTL	START
IFN ANS74,<
STRTGN:	SETZM	EIOOP		;CLEAR LAST I/O OPERATOR
	PUSHJ	PP,SETOP
	  EQUIT;
	LDB	TE,FI.ACC	;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,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

;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

>;END IFN ANS74

SUBTTL	DELETE

DELGEN:	PUSHJ	PP,SETOP	;SET UP OPERAND
	EQUIT;			;QUIT IF ERRORS
	MOVEI	CH,DELETE##
IFN ANS68,<
;FOR ANS68, DELETE'S ARGUMENT IS A RECORD, NOT A FILESPEC.
	JRST	RITGN0
>
IFN ANS74,<
	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'

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

IFN ANS74,<
;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,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
	CAIN	TE,%FAM.S
	 JRST	DELM3		;OK

;THERE BETTER BE A USE PROCEDURE
	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

;GET A ROUTINE, DEPENDING ON THE FILE ACCESS MODE
DELM3:	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

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

IFN ANS74,<
	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,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
;"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:	MOVE	TA,[XWD XWDLIT,2]
	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

IFN ANS68,<
	HRRZ	TE,EMODEA
	TSWT	FANUM		;NUMERIC IS ALWAYS CONVERTED TO ASCII
>; END IFN ANS68
IFN ANS74,<
	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

	MOVEI	TE,5
	MOVEM	TE,EAC
	PUSHJ	PP,MXAC.

	MOVEI	CH,DSP.FP
	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" 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:
IFN ANS68,<
	TLNE	EACB,GNTALY!GNTODY	;"TALLY" OR "TODAY"?
>
IFN ANS74,<
	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
IFN ANS74,<
	SKIPG	COLSEQ##	;PROGRAM COLLATING SEQUENCE?
	JRST	FIGC6		;NO
	HRRZ	TA,COHVLV##+1	;YES, GET ASCII HIGH-VALUE CHAR.
	ROT	TA,-7		;LEFT JUSTIFY
>
	JRST	FIGC6

FIGC5:	MOVSI	TA,(BYTE(7)0)	; A NORMAL LOW-VALUE
IFN ANS74,<
	SKIPG	COLSEQ		;PROGRAM COLLATING SEQUENCE?
	JRST	FIGC6		;NO
	HRRZ	TA,COHVLV+4	;YES, GET ASCII LOW-VALUE CHAR.
	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?
	TRNA			;MORE TO FOLLOW, LEAVE AS IS
	IOR	TA,[BYTE(7)" ",15,12,0,0] ;NO, APPEND <CRLF>
	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
;"DISPLAY" GENERATOR  (CONT'D).

ENDTST:
IFN ANS74,<
	PUSHJ	PP,CDEBA##	;COPY LAST INDENTIFIER TO DEBUG LIST
>
	PUSHJ	PP,BMPEOP	;ANY MORE OPERANDS?
IFN ANS68,<
	  POPJ	PP,		;NO--QUIT
>
IFN ANS74,<
	  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
IFN ANS74,<
	MOVE	TA,-1(EACA)	;GET 2ND OPERAND
	TLNN	TA,GNFIGC	;FIG. CONST?
	 JRST	ACCGN1		;NO
	TLNE	TA,GNTODY	;ONE OF DATE, DAY, OR TIME?
	JRST	ACCTDY		;YES
	JRST	BADEOP		;WELL IT SHOULD BE
ACCGN1:>

	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
IFN ANS74,<
	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)
IFN ANS68,<
	CAIN	TA,TALLY.##
	JRST	ACEPT2
>
	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)
IFN ANS68,<
	HRRZ	TD,1(TC)	; GET OPERAND ADDRESS [176]
	CAIE	TD,TALLY.##	; IF TALLY TREAT AS NUMERIC [176]
>
	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:
IFN ANS74,<
	PUSHJ	PP,CDEBB##	;COPY LAST INDENTIFIER TO DEBUG LIST
>
	PUSHJ	PP,BMPEOP	;ANY MORE OPERANDS?
IFN ANS68,<
	  POPJ	PP,		;NO--QUIT
>
IFN ANS74,<
	  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.

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

IFN ANS74,<
;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,
;[605] SEE IF THIS IS A VARIABLE LENGTH READ IN WHICH THE DEPENDING ITEM
;[605] IS NOT CONTAINED IN THE RECORD ITSELF

	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	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.DEP	;[1030] IS THE DEPENDING VARIABLE AT THIS LEVEL?
	JUMPN	TB,VLTST3	;[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


;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
	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.ACC,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
 IFN ANS74, EXTERN	FI.ORG,FI.FAM
 IFN ANS68, EXTERN	FI.ACC
;FILE ENQUEUE - RECORD ENQUEUE

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

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
ERENQ0:	SOJG	TA,ERENQ1	;JUMP IF NOT 1ST RENQ OR RDEQ

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
IFN ANS74,<
	SETZM	ESUCVT##	;HAVEN'T CONVERTED ANY KEYS YET.
	PUSHJ	PP,ERENSF	;SETUP CURFIL; GENERATE CODE TO CONVERT KEY
>;END IFN ANS74			;IF NECESSARY
	SKIPA

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

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

>;END IFN ANS74
	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
IFN ANS68,	LDB	TB,FI.ACC
IFN ANS74,	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

ERENR3:	LDB	TA,FI.SKY##	;SET UP EMODEB, ESIZEB FOR SYMBOLIC KEY
	JUMPE	TA,ERENR9	;ERROR, SYMBOLIC KEY NOT DEFINED
	PUSHJ	PP,LNKSET##
	LDB	TB,DA.USG##
	SUBI	TB,1
	MOVEM	TB,EMODEB##
	LDB	TB,DA.INS##
	MOVEM	TB,ESIZEB##

	MOVE	TC,CUREOP
	MOVE	TB,EMODEB##
	CAME	TB,EMODEA##
	JRST	ERENR4		;JUMP IF USAGE DOESN'T MATCH
	MOVE	TA,ESIZEA##
	CAMN	TA,ESIZEB##
	JRST	ERENQ3		;JUMP IF SIZE MATCHES
	CAIE	TB,D1MODE##
	JRST	ERENR4
	CAMG	TA,ESIZEB
	JRST	ERENQ3		;JUMP IF SIZE OF SYMBOLIC KEY
				;GREATER THAN SIZE OF LITERAL
				;OR DATA NAME IF BOTH ARE COMP

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

RDEQGN:	TLNN	W1,000400
	JRST	FENQGN
	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,FENQGN

SUBTTL	KYPTR -- RMS ROUTINE TO GET PTR TO RECORD KEYS

IFN ANS74,<		;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
	MOVEM	TA,CURAKT##	;SAVE REL. ADDR
	ADD	TA,AKTLOC	;GET ABS PTR

;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
	ADD	TA,AKTLOC	;GET ABS LOC IN ALTERNATE KEY TABLE
	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
;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
	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 IFN ANS74

	END