Google
 

Trailing-Edge - PDP-10 Archives - BB-H506E-SM - cobol/source/cblio.mac
There are 23 other files named cblio.mac in the archive. Click here to see a list.
; UPD ID= 3578 on 6/10/81 at 2:36 PM by MAYBERRY                        

TITLE	CBLIO FOR LIBOL V12C

	SEARCH COPYRT
	SALL

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;EDIT HISTORY
;***** V12B *****
;WHO	DATE	COMMENT
;KWS	11-SEP-84 [1130] Add conversion factor so OPEN I-O will work properly
;JEH	21-MAY-84 [1126] New feature test switch and code to print blank
;				ascii text lines
;JEH	10-APR-84 [1115] TOPS-10 system-labeled tapes - 7.02 sets DV.DIR
;				bit now, causes wrong path to be followed
;JSM	02-APR-84 [1114] Eliminate extra <CRLF> on Rewrite of ASCII Record
;RLF	22-MAR-84 [1113] Make use procedure works with filename-1 OPEN
;JEH	19-MAR-84 [1112] No <CR> at end of std-ascii tape
;JBB	21-DEC-83 [1105] Put a '?' in front of warning to make it FATAL.
;JBB	20-DEC-83 [1104] Remove SETEOF warning message and set max byte count
;JSM	09-NOV-83 [1103] On Fake Read for SMU Retain on TOPS-10, check for
;			 EOF Return and don't cause program failure if so.
;JEH	08-NOV-83 [1102] Determine TOPS-20 monitor level and if < 5.0,
;			     skip all read unrestricted code - not implemented
;JM/RF	25-OCT-83 [1100] SMU with relative file gets race condition,
;				record not written to disk but gets
;				invalid key error.
;JEH	24-OCT-83 [1077] If dynamic access and REWRITE, update pointers
;				so READ NEXT can work
;JBB	22-AUG-83 [1075] Prevent multi-level ISAM file from missing records
;			 when using START, READ NEXT sequences
;RLF/JM	21-APR-83 [1065] Make FREE RECORD KEY work for SMU after RETAIN NEXT
;JSM	08-APR-83 [1064] GET CHECKPOINTING AND RERUN IN FRONT OF IMPLICIT FREE
;                        FOR SIMULTANEOUS UPDATE
;JSM	08-APR-83 [1063] IF FILE OPENED FOR SMU DOES NOT HAVE MAX BYTE
;			 COUNT IN FDB GIVE WARNING MESSAGE
;JEH	07-APR-83 [1062] If program's blocking factor differs from ISAM's
;			  blocking factor, give error
;SMI	31-MAR-83 [1061] Fix bytesize on open of MAGTAPE with RECORDING MODE
;			  SIXBIT
;RLF	16-MAR-83 [1057] Set correct value for files status and error number.
;JEH	24-FEB-83 [1055] Extend sixbit w/ logical blk > physical blk fails
;			 if re-opened at logical block boundary
;JEH	10-FEB-83 [1052] Extend blocked sixbit files correctly
;JEH	25-JAN-83 [1050] Set last blk nbr (D.LBN) for random input file
;SMI	13-SEP-82 [1043] Process end-of-file errors.
;SMI	30-AUG-82 [1042] Pop stack if error on blocked file open.
;RLF	26-JUL-82 [1037] Change error message to "for OUTPUT only".
;RLF	21-JUL-82 [1036] Zero out right half of UOUT. after checkpointing
;RLF	20-JUL-82 [1035] READ NEXT after DELETE get correct record
;JEH	15-JUL-82 [1034] Zero out end of data block after deleting a record
;SMI    06-JUL-82 [1033] Do abort close on labeled tapes during fatal error
;                        processing
;LEM	07-JUN-82 [1031] FIX RECORDS MISSING WHEN READING AN ASCII FILE SEQUENTIALLY
;RJD	08-JUN-82 [1030] Check for use of ersatz device when opening a SMU
;			 file from a SFD
;JEH	04-JUN-82 [1027] Zero buffer address to force FAKE READ to get block
;				number for a RETAIN of a LOW-VALUE key
;JEH	01-JUN-82 [1026] APPEND FILOP. doesn't reset buffer ptr if file ended
;			 on a block boundary
;RJD	14-MAY-82 [1024] USE COUNT ON LAST BLOCK TO CHECK FOR END OF RECORD
;RLF	07-MAY-82 [1023] UPDATE POINTER FOR READ AFTER REWRITE
;LEM	27-MAR-82 [1021] make READ NEXT return correct record as ANSI standard states
;RJD	17-MAR-82 [1016] TEST FOR ISAM FILES CHECKPOINTING EVERY n RECORDS
;LEM	02-MAR-82 [1015] ALLOW COMPT. UUO TO RETURN CORRECT FILE STATUS ERROR NO
;LEM	16-FEB-82 [1014] ALLOW ASCII FILE ON MTA TO HAVE EXTRA <CR>
;WTK	20-JAN-82 [1013] SEQ REL ASCII FILE: NULL REC IN BLK CAUSES
;			 REST OF BLOCK TO BE SKIPPED
;JSM	22-OCT-81 [1011] FIX CLOSE WITH DELETE FOR NON-SMU OUTPUT
;JEH/JM	13-OCT-81 [1010] LOOKUP ERROR MSG IS INCORRECT
;DMN	09-OCT-81 [1007] TURN ON TOPS2X SWITCH FOR TOPS-20 VERSION 5
;WTK/JM 6-OCT-81 [1006] CAN'T REWRITE A NON-NULL EBCDIC RECORD
;JEH/JM	6-OCT-81 [1005] SMU CLOSE W/DELETE FAILS UNDER TOPS-10 7.01
;DMN/JM 3-SEP-81 [1003] FIE INCORRECTLY CLOSED WITH DELETE
;HAM/JM 9-SEP-81 [1001] RESET ISAM INDEX AND DATA POINTERS AFTER DEL/REWRITE
;
	SUBTTL	PICK UP UNIVERSALS AND SET UP JOBDAT.

	SEARCH	LBLPRM,COBVER		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
	SEARCH COMUNI
	%%COMU==:%%COMU
	INFIX%
	ISAM==:ISAM
	EBCMP.==:EBCMP.
	SEARCH	FTDEFS			;FILE-TABLE DEFINITIONS
	%%FTDF==:%%FTDF
IFN LSTATS,<
	SEARCH	METUNV
>

	SEARCH	UUOSYM
IFN	TOPS20,<	SEARCH	MONSYM, MACSYM>
IFE	TOPS20,<	SEARCH	MACTEN>
IFN	TOPS20,<OF%RDU==1B23		;[667] READ UNRESTRICTED>
IFE	TOPS20,<UU.RRC==1B6		;UNTIL 7.01 IS RELEASED>


	.COPYRIGHT			;Put standard copyright statement in REL file

	LOC	124			;.JBREN
	EXP	RENDP			;TO FORCE A DUMP.

	LOC	137			;.JBVER
	EXP	LBLVER

	IFNDEF	SIRUS,<SIRUS==0>	; [403] SPECIAL CODE FOR SIRUS
	IFNDEF	SUPPTB,<SUPPTB==0>	; [403] SUPPRESS TRAILING BLANKS ON OUTPUT ASCII FILES.
	IFNDEF	ISTKS,<ISTKS==0>	;TYPE  # OF IN'S AND OUT'S

	SUPP==SIRUS!SUPPTB		; [403] SUPPRESS TRALING BLANKS FOR SIRUS

	IFNDEF EBCMP.,<EBCMP.==0>



	HISEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

	SALL
	MLON
SUBTTL CONSTANTS

;AC ASSIGNMENTS
FLG=7
C=11
I12=12
LVL=13
FLG1=14
I16=16

BUFLOC==4000	;BUFFER LOCATION HAS BEEN ASSIGNED, LEFT-HALF OF F.WDNM(I16)

	; FLAG BITS IN D.RFLG RIGHT HALF

SASCII==1	; REQUEST FOR STANDARD ASCII, IN D.RFLG
RDDREV==2	; OPEN REVERSED ACTIVE 
FSTIDX==4	;[605] FIRST ISAM READ IS SEQ, FOR IBS SCAN CODE
RDRVBK==10	; READ REV BLOCKED GTR 10
RDLAST==20	; = 1 IF LAST ISAM IO OPERATION WAS READ
SAVNXT==40	; = 1 IF LAST I-O WAS DELETE OR REWRITE (NXT REC SAVED)
EXTOPN==100	; =1 IF FILE WAS OPENED EXTEND
AFTADV==200	; =1 IF LAST WRITE WAS AFTER-ADVANCING ("CR" BEFORE BFR-ADV)
;RPW BIT FOR TERMINATE HAS BEEN DONE ==400
INDASC==1000	; =1 IF MTA STD ASCII NEEDS INDUSTRY-COMP MODE (TM03 TROUBLE)
		; DON'T CLEAR AT CLOSE TIME
RF1CLR==376	; BITS TO CLEAR AT CLOSE TIME

;RMSIO BITS:  (DEFINED IN LBLPRM IN THE FUTURE)
LF%INP==1B33		;FILE IS OPEN FOR INPUT
LF%OUT==1B34		;FILE IS OPEN FOR OUTPUT

	; USE PROCEDURE TABLE OFFSET VALUES

USESEC==5	; USE PROCEDURE TABLE SECTION SIZE	
EXTUSE==^D15	; OFFSET TO EXTEND ERROR USE PRODECURE
		



	;VALUES FOR FILE STATUS CODE
FSNRCF==23		;NO RECORD FOUND ON READ,REWRITE,DELETE

	;VALUES FOR FILE ACCESS MODE
%FAM.S==0		;SEQUENTIAL
%FAM.R==1		;RANDOM
%FAM.D==2		;DYNAMIC

	;[566] LOOKUP BLK OFFSETS
LKPSIZ==3	;[566] OFFSET TO FILE SIZE RETURNED IN LOOKUP BLOCK

	;MTOPR CONSTANTS
MTOSIZ==15	;SIZE OF TEMP TABLE USED BY .MORLI MTOPR FUNCTION

	;COMPT. UUO FUNCTIONS
IFN TOPS20,<
CMP.1==1	;SIMULATE LOOKUP OR ENTER
CMP.3==3	;TRANSLATE PPN TO STRING
CMP.10==10	;GET JFN FROM CHANNEL NUMBER
>

	;MTA CONSTANTS
IFNDEF .TFKD2,<.TFKD2==6>	; [645] DX20 CONTROLLER CODE FOR TAPOP.
MXTPRC==20000	;MAX. MTA REC SIZE (IN WORDS)
MINMTA==4	;MINIMUM MTA OUTPUT SIZE
	; OFFSETS INTO LABEL INFORMATION BLOCK 
LABTYP==1	; TO LABEL TYP
IFN TOPS20,<
	LABFOR==4	; LABEL FORMAT CHARACTER
>
IFE TOPS20,<
	LABFOR==.TPREC	; LABEL FORMAT CODE
	LABFMS==0	; FORMS CONTROL HERE
>

	; BIT DEFINITIONS FOR LABELED TAPE FORMAT

FRMATU==10		; "U" FORMAT
FRMATS==4			; "S" FORMAT
FRMATD==2			; "D" FORMAT
FRMATF==1			; "F" FORMAT

	;DEF SYMBOLS FOR DISK BLOCK SIZE
DSKBSZ==200	;SIZE OF A DISK BLOCK (BUFFER)
DSKMSK==177	;MASK FOR BITS TO RIGHT OF DSKBSZ
DFLTBF==2	; DEFAULT NUMBER OF SEQ (RING) BUFFERS
BYTCTW==12	;BYTE COUNT WORD IN FILE'S FDB

;CONSTANTS FOR CONSTRUCTION OF ERROR NUMBERS
E.VOPE==^D100000000	;COBOL VERB OPEN
E.VCLO==^D200000000	;	CLOSE
E.VWRI==^D300000000	;	WRITE
E.VREW==^D400000000	;	REWRITE
E.VDEL==^D500000000	;	DELETE
E.VREA==^D600000000	;	READ
E.VRET==^D700000000	;	RETAIN
E.VEXT==^D800000000	;	OPEN EXTEND
E.VSTR==^D900000000	;	START

E.MINP==^D1000000	;MONITOR INPUT ERROR
E.MOUT==^D2000000	;	OUTPUT
E.MLOO==^D3000000	;	LOOKUP
E.MENT==^D4000000	;	ENTER
E.MREN==^D5000000	;	RENAME
E.MOPE==^D6000000	;	OPEN
E.MFOP==^D7000000	;	FILOP
E.MTAP==^D8000000	;	TAPOP.

E.FIDX==^D10000		;ISAM INDEX FILE
E.FIDA==^D20000		;ISAM DATA FILE
E.FSEQ==^D30000		;SEQUENTIAL FILE
E.FRAN==^D40000		;RANDOM FILE
E.FMTA==^D50000		; LABEL PROCESSING ERROR (MTA FILE)


E.BSTS==^D1000		;ISAM STATISTICS BLOCK
E.BSAT==^D2000		;ISAM SAT BLOCK
E.BIDX==^D3000		;ISAM INDEX BLOCK
E.BDAT==^D4000		;ISAM DATA BLOCK
		;FLAGS IN LEFT SIDE OF "FLG" & F.WFLG(I16) AFTER RESET.
	; **WARNING** DO NOT DISTURB DDM??? OR CDM???
DDMASC==400000	;DEVICE DATA MODE IS ASCII
DDMSIX==200000	;DEVICE DATA MODE IS SIXBIT
DDMEBC==100000	;DEVICE DATA MODE IS EBCDIC
DDMBIN==40000	;DEVICE DATA MODE IS BINARY
OPNIN==20000	;FILE IS OPEN FOR INPUT
OPNOUT==10000	;FILE IS OPEN FOR OUTPUT
OPNIO==30000	;[622] FILE IS OPEN FOR I-O
IOFIL==4000	;[622] FILE IS AN INPUT/OUTPUT FILE
ATEND==2000	;AN "EOF" WAS SEEN
CONNEC==1000	;DEVICE & CORE DATA MODES DIFFER
NOTPRS==400	;OPTIONAL FILE NOT PRESENT
RRUNER==200	;RERUN DUMP AT END-OF-REEL
RRUNRC==100	;RERUN DUMP VIA RECORD-COUNT
CDMASC==40	;CORE DATA MODE IS ASCII
CDMSIX==20	;CORE DATA MODE IS SIXBIT
CDMEBC==10	;CORE DATA MODE IS EBCDIC
IDXFIL==4	;ACCESS MODE IS INDEX-SEQUENTIAL
SEQFIL==2	;ACCESS MODE IS SEQUENTIAL
RANFIL==1	;ACCESS MODE IS RANDOM

	;FLAGS IN LEFT SIDE OF FLG1 & D.F1(I16) AFTER RESET.

VLREBC==400000	;VARIABLE LENGTH EBCDIC RECORDS
FILOPT==200000	;FILE IS OPTIONAL
NONSTD==100000	;LABELS ARE NON-STANDARD
STNDRD==40000	;LABELS ARE STANDARD
MSTNDR==20000	;STANDARD BUT MONITOR DOES LABEL PROCESSING
MTNOLB==10000	;MOUNTR HANDLING LABELS,BUT NO LABELING

IFN TOPS20,<
F1CLR==7777	; THESE FLAGS ARE CLEARED AT CLOSE TIME
>

IFE TOPS20,<
F1CLR==37777	; THESE FLAGS ARE CLEARED AT CLOSE TIME
>

	; BITS IN LEFT HALF OF AC15 DURING WADV.

WDVADR==40	; BIT18-35 IS THE ADDRESS OF THE ADVANCING COUNT
WDVBFR==20	; =1 IF BEFORE ADVANCING
WDVPOS==10	; POSITIONING




FOPERR==2	; FILOP.UUO FAILED

IFN ISAM,<
KEYSIZ==7777	; MASK TO GET KEY SIZE FIELD OF ISAM KEY DESCRIPTOR
NOTEST==2000	;[276] SKIPE THE CONVERSION TEST AT ADJKEY
WSTB==1000	;WRITE THE STATISTICS BLOCK
IIAB==400	;INSERTION IS IN AUX BUFFER
TRYAGN==200	;MAKE A SECOND PASS AT ALC01 OR DON'T AT VNDE
BVN==100	;BUMP-VERSION-NUMBER SPLITTING A BLOCK
WSB==40		;WRITE THE SAT BLOCK
BLK2==20	;REQ FOR 2ND DATA BLOCK
SEQ==10		;SEQUENTIAL READ
VERR==4		;VERSION NUMBER DISCREPANCY BTWEEN INDEX LEVELS
WIVK==2		;WRITE INVALID-KEY
FOPIDX==2	;FILOP OF NAME.IDX IN PROGRESS
RIVK==1		;READ, RERIT OR DELET INVALID-KEY
EIX==1		;ENTER OF NAME.IDX IN PROGRESS
>
SUBTTL	EXTERNALS.


	ENTRY	C.RSET			;MAKE SURE WE GET LOADED.
	ENTRY	DSPL.6,DSPL.7,DSPLY.	;FOR OVERLAYS
	ENTRY	METER.

IFN LSTATS,<
;ROUTINES IN METIO
EXTERN	MRLSET,MRDMPT,MRDMP

;LOWSEG LOCATIONS
EXTERN	MBTIM.,MRTMB.,MRTDBP
EXTERN	MRBKO.,MRBLKO,MRBNUM
EXTERN	MRFPGT,MRKILL,MROPTT,MRPSTM,MRRERN
>;END IFN LSTATS

EXTERNAL LIBIMP	;CAUSES LIBREL ( LIBOL.LOW) TO BE LOADED FOR /R
; [440] REMOVE EXTERNAL SYMBOL FOR EDIT 414
EXTERNAL IIN,IOUT,ISETI,ISETO,ICLOS,IRELE,IGETS,IWAIT,IRNAM
EXTERNAL MWAIT.,MREW.,MREWU.,MBSPR.,MBSPF.,MADVR.,MADVF.,MWEOF.,MTIND.
EXTERNAL MERAS.				;[470]
EXTERNAL SOBOT.,SZBOT.,SZEOF.,SZEOT.

EXTERNAL UOPEN.,UENTR.,ULKUP.,UOBUF.,UIBUF.,UCLOS.,URELE.,USETI.
EXTERNAL USETO.,UOUT.,UIN.,USETS.,UGETS.,UWAIT.,URNAM.

EXTERNAL UOCAL.,OPNCH.,UOBLK.,NRSAV.,AUTOLB,TMP.BK

EXTERNAL UEBLK.,ULBLK.,TTOBP.,TTOBC.,TTOBF.,STDLB.
EXTERNAL REDMP.,TEMP.,TEMP.1,JSARR.,TEMP.2,SEGNO.,AINFO.,OVRBF.,FLDCT.,OVRIX.
EXTERNAL SHRDX.	;[556]

EXTERNAL NOCR.,PRGFLG,TTYOPN,ACSAV0,MXIE,IESAVE,MXBUF,AUXBUF,AUXIOW,AUXBNO,CMDLST,NEWBK1
EXTERNAL NEWBK2,OLDBK,MXBF,DRTAB,LRWA
EXTERNAL FS.ZRO,FS.FS,FS.EN,FS.BN,FS.RN,FS.UPD,FS.IGE,FS.IF,ISETS,FS.IEC
EXTERNAL MOVE.,PD6.,PD7.,C.D6D7,C.D7D6
IFN EBCMP. <
EXTERNAL PD9.,C.D9D6,C.D9D7,C.D6D9,C.D7D9
>

EXTERNAL FRSTIC,LASTIC,PFRST.,UFRST.,ULAST.,IFRST.,ILAST.

EXTERNAL RELEN.		;[332]
EXTERN TODAY.,TODA1.
EXTERNAL RN.PPN, RUN.TM, RN.DEV, RN.NAM	;[333]
EXTERNAL PUSHL.,CB.DDT,LEVEL.,%F.PTR,COBSW.,SBPSA.

EXTERNAL SU.RBP,SU.CL,SU.WR,SU.RD,SU.DL,SU.RW	;SIMULTANEOUS UPDATE
EXTERN	FOP.BK,FOP.IS,FOP.DN,FOP.LB		;SIMULTANEOUS UPDATE
EXTERN	SU.T1			;[1065] SMU, CARRY RRT ENTRY ADDR HERE
EXTERN	SU.FRF			;FAKE READ FLAG
EXTERN	.JBSA,.JBFF,.JBREL,.JBAPR,.JBTPC,.JBCNI,.JBDA,.JBOPC,.JBREN

IFN ISAM,<INTERN GDPSK>	;[447]SIMULTANEOUS UPDATE
INTERN	CHTAB	;[455] SIMULTANEOUS UPDATE
INTERN	SEQFIL	;[455] SIMULTANEOUS UPDATE
IFN ANS74,<INTERN  F.BFAM, SAVNXT>	;FOR SIM. UPDATE
INTERN	FAKER.,IGSS,RANFIL,E.VRET

INTERN	C.CLOS,DOPFS.,C.END,GETCH.,DSPL1.,MSOUT.,C.OPEN,OUTCH.
INTERN	OUT6B.,OUTBF.,READ.,RSTAB.,STOPR.,C.STOP,TRAP.,WRITE.,WADV.,WRPW.
INTERN	WADVV.,WRITV.
INTERN	GOTO.,KILL.,PPOUT.,PPOT4.,SAVAC.,RSTAC.
INTERN	KPROG.		;NO UNCONDITIONAL TRANSFER AT END OF PROGRAM
INTERN	KDECL.		;NO UNCONDITIONAL TRANSFER AFTER DECLARATIVES
INTERN	ILLC.		;RECURSIVE CALL
INTERN	SEEK.
EXTERN	USEEK.
INTERN	C.STRT,RDNXT.

EXTERNAL RET.1,RET.2,RET.3

INTERN	DELET.,RERIT.,PURGE.

EXTERNAL HLOVL.	;[346] XWD	HIGHEST OVERLAY LOC , LOWEST LOC

IFN ISAM,<EXTERNAL GD6.,GD7.,GD9.,GC3.,PD6.,PD7.,PD9.,PC3.,KEYCV.>	;[370]
IFN ISAM,<INTERN USOBJ,LVTST,LV2SK.,FOPIDX,NNTRY>

EXTERNAL FILES.,USES.,OVRFN.,TRAC1.

EXTERN	FUSIA.,FUSOA.,FUSCP.	;[523] FILOP. ARG-BLOCK

INTERN	LIBVR.,LIBSW.

IFN LSTATS,<		;EXTERNALIZE LIBOL METERING ROUTINES
	INTERN	LMETR.,MRACDP
	IFN TOPS20,<
		INTERN	MRTM.S,MRTM.E
	>
>
IFN ISAM,<
ADR==0
DEFINE	TABADR(N,L) <
N==ADR
ADR==ADR+L
>

TABADR	STAHDR,1	;SIZE OF STATISTICS BLOCK IN SIXBIT BYTES
TABADR	DDEVNM,1	;DATA FILE'S DEVICE NAME
TABADR	DFILNM,1	;DATA FILE'S FILE NAME
TABADR	DEXT,1		;DATA FILE'S EXTENSION
TABADR	DCDATE,1	;DATA FILE'S CREATION DATE
TABADR	DADATE,1	;DATA FILE'S ACCESS DATE
TABADR	MXLVL,1		;NUMBER OF LEVELS IN INDEX FILE
TABADR	DBF,1		;DATA FILE BLOCKING FACTOR
TABADR	DMTREC,1	;NUMBER OF EMPTY RECORDS PER DATA BLOCK
TABADR	EPIB,^D20	;TWO WORDS PER INDEX LEVEL
			;FIRST WORD:  NUMBER OF ENTRIES PER INDEX BLOCK
			;SECOND WORD:  NUMBER OF EMPTY ENTRIES
TABADR	DMXBLK,1	;TOTAL BLOCKS IN DATA FILE
TABADR	DMTBLK,1	;EMPTY BLOCKS IN DATA FILE
TABADR	IMXSCT,1	;TOTAL SECTORS IN INDEX FILE
TABADR	IMTSCT,1	;EMPTY SECTORS IN INDEX FILE
TABADR	FMTSCT,1	;FIRST EMPTY SECTOR IN INDEX FILE
TABADR	DMXREC,1	;MAXIMUM DATA RECORD SIZE IN WORDS
TABADR	DBPRK,1		;BYTE POINTER TO RECORD KEY RELATIVE TO DATA RECORD
TABADR	RWRSTA,1	;NUMBER OF READ, WRITE, REWRITE STATEMENTS SINCE INITIALIZATION
TABADR	IOUUOS,1	;NUMBER OF IN'S AND OUT'S SINCE INITIALIZATION
TABADR	SBLOC,1		;RELATIVE ADR OF FIRST SAT BLOCK
TABADR	SBTOT,1		;TOTAL SAT BLOCKS
TABADR	ISPB,1		;INDEX FILE, SECTORS PER LOGICAL BLOCK
TABADR	FILSIZ,1	;MAXIMUM POSSIBLE NUMBER OF DATA BLOCKS IN FILE
TABADR	KEYTYP,0	;KEY-TYPE IN LEFT HALF
TABADR	KEYDES,1	;DESCRIPTION OF RECORD KEY
TABADR	IESIZ,1		;INDEX ENTRY SIZE IN WORDS
TABADR	TOPIBN,1	;TOP INDEX BLOCK NUMBER
TABADR	%DAT,1		;% OF DATA FILE EMPTY
TABADR	%IDX,1		;% OF INDEX FILE EMPTY
TABADR	RECBYT,1	;SIZE OF LARGEST DATA BLOCK IN BYTES
TABADR	MAXSAT,1	;MAX # OF RECORDS FILE CAN BECOME
TABADR	ISAVER,1	;"ISAM" VERSION NUMBER
TABADR	PAGBUF,1	;I/O SW..	0 = SECTOR MULTIPLES, NONZERO = PAGES

STABL==ADR	;EQUALS SIZE OF STATISTICS BLOCK

TABADR	IOWRD,14+1	;TABLE OF DUMP MODE IOWD'S FOR EACH INDEX LEVEL
			;0 DATA BLOCK
			;1-12 INDEX BLOCKS
			;13 SAT BLOCK
			;14 STATISTICS BLOCK
TABADR	OMXLVL,1	;ORIGINAL MAX NUMBER OF LEVELS IN INDEX FILE
TABADR	OKEYDS,1	;[515] KEY DESCRIPTOR AT RESET TIME
TABADR	ORCBYT,1	;[515] RECORD SIZE AT RESET TIME
TABADR	OEPIB,1		;[515] ENTRIES PER INDEX BLOCK AT RESET TIME
TABADR	CORE0,1		;LAST,,FIRST -  CORE AREA CLEARED AT CLOSE
TABADR	ICHAN,1		;CHANNEL NUMBER FOR INDEX DEVICE
TABADR	USOBJ,14+1	;USETI/O OBJECT: DATA, 10 INDEX, SAT & STA
	INTERN	CNTRY	;[650] MAKE INTERNAL FOR LSU
TABADR	CNTRY,14+1	;CURRENT INDEX ENTRY
TABADR	NNTRY,14+1	;FLAG, CNTRY POINTS TO NEXT ENTRY NOT CURRENT
TABADR	LIVE,1		;(-1) IF DATA NOT YET OUTPUT
TABADR	BRISK,1		;IF -1 OUTPUT ONLY WHEN INPUT IS EMINENT
TABADR	CLVL,1		;CURRENT LEVEL
IFN ANS74,<
TABADR	RWDLKY,1	; NNTRY,,ADDR OF CNTRY KEY COPYS FOR RWT/DEL
TABADR	RCARSZ,1	; ReCord ARea SiZe in words
TABADR	RWDLRT,1	; NNTRY,,Addr of RWDLKY during RETAIN
TABADR	SVNXRT,1	; Saves D.RFLG during RETAIN, when none zero flags that
			;  RWDLKY points to RETAINS del/rewrt key save area,
			;  that RWDLKY must be restored at the end of RETAIN
>
TABADR	IAKBP,1		;INDEX ADJUSTED SYMBOLIC KEY BYTE-POINTER
TABADR	IAKBP1,1	;POINTER TO SECOND KEY WORD
TABADR	DAKBP,1		;DATA ADJUSTED SYMBOLIC KEY BP
TABADR	DAKBP1,1	;POINTER TO THE SECOND KEY WORD
TABADR	SINC,1		;BINARY SEARCH INCREMENT
TABADR	IBLEN,1		;INDEX BLOCK LENGTH NOT COUNTING HEADERS
TABADR	IKWCNT,1		;INDEX, NUMBER OF WORDS IN THE KEY
TABADR	DKWCNT,1		;DATA, NUMBER OF WORDS IN KEY
TABADR	FWMASK,1		;MASK FOR FIRST WORD OF DATA KEY
TABADR	LWMASK,1	;MASK FOR LAST WORD OF DATA KEY
TABADR	ICMP,1		;HOLDS ADR OF THE INDEX COMPARE ROUTINE
TABADR	DCMP,1		;HOLDS ADR OF DATA COMPARE OR CONVERT ROUTINE
TABADR	DCMP1,1		;HOLDS ADR OF DATA COMPARE ROUTINE IF KEY IS NUMERIC DISPLAY
TABADR	GDX.I,1		; ADR OF CONVERT ROUTINE -- SK VS INDEX-ENTRY
TABADR	GDX.D,1		; ADR OF CONVERT ROUTINE -- SK VS DATA FILE KEY
TABADR	GDPSK,1		;PARAMETER FOR SYM-KEY CONVERSION
TABADR	GDPRK,1		;PARAMETER FOR REC-KEY CONVERSION
TABADR	GDPRK1,1	;
TABADR	GETSET,1	;DISPATCH LOC: ADJKEY OR GD67 OR FPORFP
TABADR	RECBP,1		;RECORD AREA BYTE-POINTER
TABADR	RSBP,1		;BYTE POINTER TO RECORD SIZE IN BUFFER
TABADR	RSBP1,1		;ANOTHER BP TO RECORD SIZE
TABADR	LRW,1		;FIRST FREE RECORD WORD, USED BY SETLRW
IFN ISTKS,<
	TABADR	INSSS0,1	;EXP (LVL)INSSSS
	TABADR	OUTSS0,1	;EXP (LVL)OUTSSS
	TABADR	INSSSS,16	;NUMBER OF INS/LEVEL
	TABADR	OUTSSS,16	;NUMBER OF OUTS/LEVEL
>
TABADR	IOWRD0,1	;POINTS TO CURRENT IOWRD
TABADR	USOBJ0,1	;POINTS TO CURRENT USOBJ
TABADR	CNTRY0,1	;POINTS TO CURRENT CNTRY
TABADR	NNTRY0,1	;FLAG, CNTRY POINTS TO NEXT ENTRY
TABADR	BPSB,1		;NUMBER OF BITS PER SAT BLOCK
ITABL==ADR-STABL	;INDEX TABLE LEN 
TABADR	BA,0		;START OF BUFFER AREA
ISCLR1==IOWRD		;[432] [377] START OF ISAM SHARED BUFFER AREA TO SAVE
ISCLR2==ICHAN-1	; [377] END OF ISAM SHARED BUFFER TO SAVE
ISMCLR==ISCLR2-ISCLR1	; [377] DIFFERENCE OR SIZE OF AREA LESS 1 TO SAVE
> ;END OF 'IFN ISAM'
SUBTTL	RESET

	;RESET IS CALLED WITH A JSP 14,C.RSET

	$COPYRIGHT		;Put standard copyright statement in EXE file
LIBVR.:	EXP	LBLVER		;LIBOL VERSION NUMBER
LIBSW.:	EXP	SWSET%		;LIBOL ASSEMBLY SWITCHES
SRTVR.:	EXP	V%SORT##	;SORT VERSION NUMBER

C.RSET:	JRST	.+2		;ENTRY FOR 'C.RSET'
	JRST	STOPR.		;ENTRY FOR 'STOP RUN'
	CALLI			;RESET
	MOVE	AC1,(AC14)	; GET ADDRESS OF ENTRY POINT
	MOVEM	AC1,%F.PTR	; (%F.PTR)+1 IS ADR OF FILES.
	RUNTIM	AC11,		;[346]GET THE RUNTIME.
	MOVEM	AC11,RUN.TM	;[346]SAVE IT.
IFN LSTATS,<			;(LSTATS) SAVE STARTING RUNTIME
IFE TOPS20,<
	MOVEM	AC11,MRPSTM	;SAVE RUNTIME AT START
	>
IFN TOPS20,<
	MTRJS%			;GET STARTING TICKS
	ERJMP	.+2		;MOVE ZER0 IF NO CLOCK
	DMOVEM	AC1,MRPSTM	;SAVE VALUE
	>
>;END IFN LSTATS
IFN DBMS,<
	MOVE	AC1,DBSTP%##	;GET FROM VISIBLE, BUT NOT SAFE PLACE
	MOVEM	AC1,DBSTP.##	;PUT IN INVISIBLE (FROM USER) BUT SAFE PLACE
	SETZM	DBSTP%		;CLEAN UP (ITS REALLY LEVEL.)
>
;;12B HACK - IN V13, THE FOLLOWING THREE LINES SHOULD BE DELETED
	MOVE	AC1,OVFLO.##	;COPY OVFLO. TO SLRSW.
	MOVEM	AC1,SLRSW.##
	SETZM	OVFLO.		;CLEAN UP
	HRRZ	AC1,.JBSA	;[START.]
	MOVEM	AC1,JSARR.	;SAVE FOR RRDMP
	HRRZ	AC1,.JBFF	;TO-1
	CAMG	AC1,.JBREL	;SKIP ILL-MEM-REF
	SETZM	(AC1)		;ZERO WORD
	HRL	AC1,AC1		;FROM,,TO-1
	ADDI	AC1,1		;FROM,,TO
	HRRZ	AC2,.JBREL	;UNTIL
	CAIL	AC2,(AC1)	;SKIP ILL-MEM-REF IF .JBFF = .JBREL
	BLT	AC1,(AC2)	;ZERO FREE COR
RESET1:	MOVEI	AC0,[OUTSTR [ASCIZ/?COBOL programs may only be started through
use of "GET and ST" or "RUN" monitor commands./]
		EXIT]		;[1105] CONSIDER THIS FATAL
	HRRM	AC0,.JBSA
	MOVE	PP,[XWD PFRST.,IFRST.]
	TLNE	PP,777777	;NO BLT IF PFRST. = 0 - LOW SEG WAS LOADED
	BLT	PP,ILAST.	;THE IO UUO'S

	MOVEI	AC10,MEMRY.##	;SET UP MEMRY. POINTER
	MOVEM	AC10,MEMRY%##
IFN TOPS20, <
	MOVEI 	AC1,.SCOUNT	;[1102]
	GETAB			;[1102] SEE WHICH VERSION WE'RE RUNNING UNDER
	 ERJMP	[ CAIN AC1,GTABX1	;[1102] DOES THIS TABLE EXIST
		  SKIPA AC2,[-1]	;[1102] NO - SAY VERSION 4.1
		  SETZM AC2		;[1102] SAY V 5
		  MOVEM AC2,MNTR5##	;[1102] STORE IT
		  JRST .+1]		;[1102]
>; END TOPS20
	HRRZ	AC10,(AC14)	;GET THE PROGRAM'S ENTRY POINT.
	HRRZ	AC10,1(AC10)	;GET THE ADDRESS OF %FILES.
	SKIPN	AC10,%PUSHL(AC10) ;GET THE PDL SIZE.
	MOVEI	AC10,200	;THIS IS FOR CSORT
	MOVNI	PP,(AC10)	;0,,-LENGTH
	HRL	PP,.JBFF	;START-LOC,,-LENGTH
	MOVSS	PP,PP		;POINTER IS SET UP.

	MOVEI	AC10,20(AC10)	;[660] LENGTH+20
	ADDB	AC10,.JBFF	;ADJUST .JBFF
	IORI	AC10,1777	;MOVE UP TO THE NEXT K BOUNDARY
	CAMG	AC10,.JBREL	;ARE WE BEYOND .JBREL?
	JRST	RESET2		;NO, GO ON.
	CORE	AC10,		;YES, GO ASK FOR MORE CORE.
	  JRST	GETSPK		;CAN'T HAVE ANY MORE, ERROR.

	;SET FLAGS TO TRAP ON
RESET2:	MOVEI	AC0,TRAP.	;[312] INTERUPT ROUTINE ADR
	MOVEM	AC0,.JBAPR	;[312]
	MOVEI	AC0,AP.POV!AP.ILM!AP.NXM	;[312] PDLOV - MPVIO - NXM
	APRENB	AC0,		;[312] APRENB UUO
	PUSH	PP,AC14		;SO WE CAN PRINT PC ON ERRORS
	PUSHJ	PP,RSAREN	;[312] INIT .JBSA AND .JBREN
	PUSHJ	PP,OUTBF1	;SETUP TTY BYTE-POINTER AND BYTE-COUNT
	PUSHJ	PP,RSTLNK	;LINK ALL SUB-PROGRAM'S FILE-TABLES
	PUSHJ	PP,SUSPC	;COMPUTE SPACE REQUIRED FOR SIMULTANEOUS
				;UPDATE, AND GET IT

	SKIPE	AC1,OVRFN.	;DOES OVERLAY FILE HAVE TO BE OPENED?
	PUSHJ	PP,SETOVR	;YES, SET UP OVERLAY FILE
	SETZM	RMFLG.##	;CLEAR "RMS NEEDED" FLAG
	PUSHJ	PP,RSTAB.	;ASSIGN THE  BUFFER AREA
				; THIS WILL SET "RMFLG." TO -1 IF ANY RMS
				; FILES ARE DEFINED IN THE PROGRAM
IFE TOPS20,<
	PUSHJ	PP,SETALB	;SET AUTOLB IF AUTO MTA LABEL PROCESSING
>
	POP	PP,(PP)		;CLEAN UP STACK
IFN CSTATS,<
	SKIPE	METR.##		;METER--ING SETUP?
	 PUSHJ	PP,SETMTR	;YES, SET UP FOR IT
>
IFN LSTATS,<
	PUSHJ	PP,MRLSET	;SETUP FOR LSTATS FILE WRITING
>
IFN ANS74,<
	SKIPE	RMFLG.##	;SKIP IF RMS NOT USED
	 PUSHJ	PP,RMSGET##	; ** GO GET RMS **
>
	SETOM	OSHOOT##	;[530] SET END OF RESET FLAG
	HRRZ	AC10,COBSW.	;GET COMPILER ASSEMBLY SWITCHES
	HRRZ	AC3,LIBSW.	;GET LIBOL ASS-SWITCHES
	CAME	AC10,AC3	;THE SAME?
	OUTSTR	[ASCIZ /%Compiler-OTS assembly switches mismatched.
/]
	HLRZ	AC10,COBVR.##	;GET COMPILER VERSION NUMBER
	HLRZ	AC3,LIBVR.	;GET OTS VERSION NUMBER
	TRZ	AC10,700000	;GET RID OF CUSTOMER BITS
	TRZ	AC3,700000	;...
	CAMGE	AC3,AC10	;OTS THE SAME OR NEWER?
	OUTSTR	[ASCIZ /%Compiler-OTS version number mismatch.
/]
IFE TOPS20,<
	MOVE	AC10,[%CNVER]	;CONFIG TABLE
	GETTAB	AC10,
	  SETZ	AC10,		;MUST BE VERY OLD
	LDB	AC10,[POINT 5,AC10,23]	;MONITOR VERSION NO.
	CAIN	AC10,7		;TEST FOR 7.00 SERIES MONITOR
	SETOM	M7.00##		;SET FLAG IF TRUE
>
	JRST	1(AC14)		;RETURN
	;HERE TO CHAIN FILE-TABLES OF ALL SUBPROGRAMS TOGETHER
	;POINTERS ARE AS FOLLOWS
	;AC14/	ADR OF SP1	;ADR OF ADR OF "MAIN" PROGRAM 
	;THE FOLLOWING ARE THE SAME FOR ALL SUBPROGRAMS
	;SP1+1/	LST,,FILES.	;FILES. HAS ADR OF FIRST FILE-TABLE
	;LST/	SP2		;ADR OF SUBPROGRAMS CALLED BY SP1
	;LST+1/	SP4		;  .
	;LST+N/	0		;TERMINATES WITH A ZERO

RSTLNK:	MOVEI	AC3,AC3		;THWART THE FIRST LINK
	HRR	AC1,(AC14)	;ADDRESS OF "MAIN" PRG + 1
	HRL	AC2,1(AC1)	;SETUP THE
	HRRI	AC2,FILES.	;    FIXED
	HRRZI	AC4,FILES.	;    PARAMETERS
	BLT	AC2,FIXNUM-1(AC4); %FILES THRU %PR
	SETZM	OVRFN.		;CLEAR THE OVR FILE PTR TO START
RSTL10:	HRRZ	AC5,(AC1)	;[346] CHECK TO SEE IF THIS SUBROUTINE
	JUMPN	AC5,RSTLNX	;[471] IS IN A LINK-10 OVERLAY AREA.
				; ((AC1)) = SKIPA 0,0 ==> IT ISN'T
				; ((AC1)) = JSP 1,MUMBLE ==> IT IS.
	MOVE	AC1,1(AC1)	;ADDRESS OF [LIST ,, FILES.]
	HLRZ	AC2,AC1		;ADR OF LIST OF CALLED SUBPROGRAMS
	SKIPGE	AC4,(AC1)	;HAVE WE BEEN HERE BEFORE?
	POPJ	PP,		;YES,  -1 IN LEFT HALF
	MOVEI	AC10,%OVRFN(AC1) ;[453] GET OVRFN ADDR
	MOVE	AC10,(AC10)	;[453] GET OVR FILE NAME
	JUMPE	AC10,RSTL13	;[453] JUMP IF NO OVR FILE
	SKIPE	OVRFN.		;[453] ALREADY SEEN ONE?
	JRST	RSOVE1		;[453] YES--ERROR
	MOVEM	AC10,OVRFN.	;[453] SAVE OVR FILE NAME
RSTL13:	JUMPE	AC4,RSTL12	;[453] JUMP IF SUBPRG HAS NO FILE-TABLES 
	SKIPN	FILES.		;HAS FILES. BEEN SETUP YET?
	HRRM	AC4,FILES.	;NO - SO DOIT
	HRRM	AC4,(AC3)	;LINK THIS FILE-TABLE GROUP TO LAST GROUP
RSTL11:	HRRZI	AC3,F.RNFT(AC4)	;GET ADR OF LINK TO NEXT TABLE
	HRRZ	AC4,(AC3)	;GET THE LINK TO NEXT TABLE
	JUMPN	AC4,RSTL11	;LOOP IF NOT THE LAST TABLE
RSTL12:	HRROS	(AC1)		;MARK THIS FILE-TABLE GROUP DONE

RSTL20:	SKIPN	AC1,(AC2)	;ANY SUBPRGMS?
	POPJ	PP,		;NO -- BACK TO THE LAST SUBPRG OR EXIT
	PUSH	PP,AC2		;SAVE POINTER TO SUBPROGRAM LIST
	PUSHJ	PP,RSTL10	;GO LINK THE FILE-TABLES
	POP	PP,AC2		;RETREIVE LIST POINTER
	SKIPE	1(AC2)		;ANY MORE SUBPRGMS?
	AOJA	AC2,RSTL20	;INCREMENT POINTER AND TRY AGAIN
RSTLNX:	POPJ	PP,		;[312];NO--DONE.

RSOVE1:	OUTSTR	[ASCIZ /?Only one module in a COBOL run-unit may have segmentation.
/]				;[453]
	JRST	KILL		;[453]
	;ASSIGN THE BUFFER AREA.   ***POPJ***

RSTAB.:	PUSHJ	PP,GCHAN	;FIND A FREE CHANNEL
	PUSHJ	PP,SETC1.	;  ASSIGN TO IO UUOS
	SETOM	FS.IF		;IDX FILE
	SETZM	TEMP.1		;ZERO THE ERROR COUNT
	SETZM	SHRDX.		;[556] CLEAR SHARED ISAM BUF AREA FLAG
	HRRZ	AC16,FILES.	;FIRST FILE TABLE
	JUMPE	AC16,RET.1	;THERE ARE NO FILES
RSTIFI:	SETZM	TEMP.		;MAX SIZE OF BUF AREA
RSTIF1:	MOVE	AC15,F.WDNM(I16);IF THIS IS FIRST
	TLNN	AC15,BUFLOC	 ;[316] TIME THROUGH TABLE,
	PUSHJ	PP,RSTFLG	;REORGANIZE THE FLAGS
	LDB	AC5,[POINT 4,UFRST.,12]	; GET CHAN FROM UUO
	DPB	AC5,DTCN.	;SAVE IT
	MOVE	FLG,F.WFLG(I16)	;GET THE FLAGS
	HRLOI	AC15,4077	;[316] #OF DEVICES,,LOC OF FIRST ONE
	AND	AC15,F.WDNM(I16)	;
	TLZE	AC15,BUFLOC	;IS BUFLOC SET?
	JRST	RSTNFL		; [377A] YES-NEXT FILE
IFN ANS74,<
	LDB	AC1,F.BRMS	; GET RMS FLAG BIT
	JUMPE	AC1,RSTIF2	; JUMP IF NOT AN RMS FILE
	SETOM	RMFLG.##	;SET FLAG SAYING RMS IS NEEDED
	MOVSI	AC15,BUFLOC	; NOTE WE ARE DONE
	IORM	AC15,F.WDNM(I16) ; WITH THIS FILE TABLE
	JRST	RSTNFL		; AND GET NEXT FILE

RSTIF2:>
	MOVEM	AC15,AC13	;
	TLC	AC13,777777	;MAKE
	AOBJP	AC13, .+1	;KIND OF
	HRR	AC13,AC15	;AN IOWD
	MOVEM	AC13,D.ICD(I16)	;%-<#OF DEVS>,,LOC OF FIRST DEVNAM
RSTDEV:	MOVE	AC3,(AC13)	;SIXBIT /DEVICE NAME/
IFN SIRUS,<MOVE	AC1,AC3		; [403] KEEP DEVICE >
	DEVCHR	AC3,		;DEVCHR UUO
	TXNN	AC3,DV.CDR!DV.LPT!DV.PTP!DV.PTR!DV.TTY	;SKIP IF A LPT,TTY,PTP,PTR,CDP, OR CDR
	JRST	RSTDE0		;
	TXC	AC3,DV.DSK!DV.CDR	;[506] IF A DSK AND A CDR ...
	TXCE	AC3,DV.DSK!DV.CDR	;[506] THEN IT'S DEVICE NUL:
	JRST	RSTDV1		;[506] NOT NUL:, CONTINUE
	TXZ	AC3,DV.MTA!DV.TTY	;[506] NUL:, SO NOT MTA OR TTY
	LDB	AC12,[POINT 3,FLG,14]	;[506] CORE DATA MODE
	DPB	AC12,[POINT 3,FLG,2]	;[506] MAKE DEV DATA MODE SAME
	MOVEM	FLG,F.WFLG(I16)		;[506] SAVE IT
	JRST	RSTDE0		;[506] CONTINUE

RSTDV1:	TLO	FLG,DDMASC	;FORCE ASCII MODE
	TLZ	FLG,DDMBIN!DDMSIX!DDMEBC	;  FOR THE ABOVE DEVICES
	MOVEM	FLG,F.WFLG(I16)	;
RSTDE0:	JUMPN	AC3,RSTDE2	;
IFN SIRUS,<
	MOVE	AC3,(AC13)		; [403]  GET DEVICE NAME
	CAME	AC3,SIRDEV		; [403] IS IT SIRUS DEVICE?
	JRST	RSTDE1			; [403] NO-ERROR
	MOVSI	AC3,'NUL'		; [403] YES-MAKE IT NULL DEVICE
	JRST	RSTDEV+1		; [403] TRY AGAIN
>; END OF IFN SIRUS
RSTDE1:	MOVE	AC2,[BYTE(5)25,4,20,13,23,15,14];"NOT A DEVICE OR
	PUSHJ	PP,MSOUT.	;NOT AVAILABLE TO THIS JOB
	AOS	TEMP.1		;COUNT THE ERRORS
	JRST	RSTLOO		;
RSTDE2:	SETZM	UOBLK.		;[411] MAKE SURE WE DONT GET ILLEGAL MODE IF ASCII DEV
	MOVE	AC12,.JBFF
	SKIPN	SHRDX.		;[556] IF ISAM SHARED BUF, D.BL ALREADY SET
	HRLM	AC12,D.BL(I16)	;SET BUFFER LOCATION
IFN SIRUS,<	MOVE AC12,AC1	; [403] GET BACK DEVICE >
IFE SIRUS,<	MOVE	AC12,(AC13)	;SIXBIT /DEVNAM/>
	MOVEM	AC12,UOBLK.+1	;FOR THE INIT BLOCK
	HRLZI	AC12,D.OBH(I16)	;LOC OF OBUF HDR
	TLNE	FLG,IOFIL	;[622] SKIP IF NOT IO
	HRRI	AC12,D.IBH(I16)	;LOC OF IBUF HDR
	MOVEM	AC12,UOBLK.+2	;INIT BLOCK
IFN ISAM,<
	MOVEI	AC1,.IODMP	;DUMP MODE
	TLNE	FLG,IDXFIL	;INDEX-FILE?
	HRRZM	AC1,UOBLK.	;YES
>
IFN TOPS20,<
	TLNE	FLG,IDXFIL	;ISAM FILE?
	JRST	RSTD21		;YES
>
	XCT	UOPEN.		;********************
	  JRST	RSTDE1		;INIT FAILED, ERROR RETURN
RSTD21:	PUSH	PP,.JBFF	;
	TLNE	FLG,IDXFIL	;
	JRST	RSTIDX		;SETUP FOR AN INDEX FILE
SUBTTL LABELED TAPE RESET CODE


	TXNN	AC3,DV.MTA	; SKIP IF MTA
	JRST	MTOXX0		; ELSE GO ON
	MOVE	AC12,AC3	;SAVE AC3, CLOBERED LATER

IFN TOPS20,<

;		THIS IS STUFF FOR VERSION 4 OF TOPS20, TO TAKE
;		CARE OF TAPE HANDLING BY MOUNTR , INCLUDING LABEL
;		PROCESSING.


	HLLZ	AC6,D.F1(I16)	; GET SECOND FLAG WORD

	; NOW CHECK FOR MONITOR LABEL PROCESSING

	PUSHJ	PP,MTALAB	; GET MTA LABEL INFO
	  JRST	MTOXXY		; NON SYS-LABELING, CONT
	LDB	AC2,F.BLBT	; GET LABEL TYPE FROM FILTAB
	SOSE	AC2		; SKIP IF NO LABELING, TYP=1 IF NO LABELING
	TLOA	AC6,MSTNDR	;INDICATE MONITOR IS LABELING
	TLOA	AC6,MTNOLB	;SET MOUNTR WITH NO LABELING FLAG
	TLZ	AC6,STNDRD!NONSTD ;CLEAR LABEL BITS IN D.F1
	HLLM	AC6,D.F1(I16)	;RESET IN FILTAB

> ;END IFN TOPS20

	JRST	MTOXXY		; CONT WITH OTHER CHECKS

; GTDFLT	ROUTINE TO GET DEFAULT DATA MODE SETTING
;
; RETURNS	AC3=DEFAULT MODE
; USES 		AC1-AC3
;

GTDFLT:

IFN TOPS20,<

	SETO	AC1,		; AC1=-1, THIS JOB
	HRROI	AC2,3		; DATA MODE AT AC3
	MOVEI	AC3,.JIDM	; START BLOCK AT THE DEFAULT DATA MODE WORD
	GETJI%			; GET THE DATA MODE
	 JRST	KILL.		; ASSUME IT WORKS, SHOULD ALWAYS
	POPJ	PP,		; RET

>; END IFN TOPS20

IFE TOPS20,<

	MOVE 	AC3,[2,,1]	; 2 ARGS START AT AC1
	MOVEI	AC1,.TFMOD	; DATA MOD FUNCTION
	MOVE	AC2,UOBLK.+1	; DEVICE NAME
	TAPOP.	AC3,		; GET DEFAULT DEVICE DATA MODE
	 JRST	[MOVE	AC2,AC3	; ERROR, PUT ERROR CODE INTO AC2
		 JRST	OMTA93 ] ; AND GIVE ERROR
	POPJ	PP,		; OK, RET

>; END IFE TOPS20


IFN TOPS20,<

; GETJFN	ROUTINE TO GET JFN FROM PA1050 USING COMPT. UUO
;
; ARGS		AC2=CHAN NUMBER
;
; RETURNS	NON-SKIP	ERROR RETURN
;		SKIP		OK, AC1=JFN
;
; USES		AC1,AC2
;

GETJFN:	HRLZ	AC2,AC2		;GET CHAN NUM IN LEFT,AS ARG TO COMPT.
	HRRI	AC2,CMP.10	;SET COMPT. FUNCTION NUM FOR CHAN TO JFN
	MOVE	AC1,[1,,2]	;INDICATE 1 ARG IN ADDR 2
	COMPT.	AC1,		;GET JFN ************* 
	  POPJ	PP,		; ERROR RETURN
	JRST	RET.2		; OK, RETURN

>;END IFN TOPS20
; MTALAB	A ROUTINE TO READ MTA LABEL INFO
;		
; USES		AC1-AC3, TEMP AREA (SIZE MTOSIZ+1) ON STACK
;
; RETURNS	NON-SKIP 	IF LAB-BYPASS (NO MOUNTR CONTROL)
;		SKIP		IF LABELED, LABEL INFORMATION IS LOCATED
;				AT TMP.BK

MTALAB:

IFN TOPS20,<

	LDB	AC2,UUOCHN	;GET CHANNEL NUM
	PUSHJ	PP,GETJFN	; GET JFN IN AC1
	 JRST	[OUTSTR	[ASCIZ/RESET get JFN /]	;ERROR, ISSUE MESSAGE
		JRST	OCPERR ]	;MORE MESS AND KILL

		;GET AND CLEAR A TEMP TABLE AREA FOR MTOPR
		;PUT TABLE LENGTH IN FIRST WORD,AS MTOPR WANTS
	
	MOVE	AC3,AC1		; SAVE JFN IN CASE OF OPEN ERROR
	GTSTS%			; GET FILE STATUS
	HRR	AC2,AC3		; SAV JFN HERE
	PUSH	PP,AC2		; SAV STATUS,,JFN
	JUMPL	AC2,MTLAB1	; JUMP IF ALREADY OPEN
	MOVE	AC2,[440000,,OF%RD] ;INDICATE SIMPLE 36 BIT BYTE,INPUT
	OPENF%			;OPEN THE JFN***************
	 ERCAL	OPNFER		;ERROR?, THEN GO CHECK IT (RETURNS IF OK)
MTLAB1:	MOVEI	AC3,TMP.BK	; INDICATE THAT THE TEMP AREA WILL BE TMP.BK
	MOVEI	AC2,1(AC3)	;GET TEMP TAB ADDR
	SETZM	(AC3)		;ZERO FIRST WORD
	HRLI	AC2,-1(AC2)	;MAKE BLT PTR
	BLT	AC2,MTOSIZ-1(AC3) ;ZERO TEMP AREA,TO MAKE SURE NO INFO FROM 
				;MTOPR WILL BE STUCK IN A BAD PLACE
	MOVEI	AC2,MTOSIZ	;GET MTOPR SIZE
	MOVEM	AC2,(AC3)	;INITIALIZE TAB LENGTH
	MOVEI	AC2,.MORLI	;SET MTOPR FUNCTION CODE FOR READING LABELS
	MTOPR%			;GET LABEL INFO ***************
	 ERJMP	MTOPER		;ERROR, CHECK FOR ILLEGAL FUNCTION
				;INDICATING MOUNTR NOT AROUND
	MOVE	AC5,TMP.BK+LABFOR ; GET LABEL FORMAT CHAR
	PUSHJ	PP,SETFMT	; SET LABEL FORMAT BITS
	MOVE	AC2,TMP.BK+LABTYP ; GET LABEL TYPE
	DPB	AC2,F.BLBT	; SET LABEL TYPE INTO FILTAB
	CAIE	AC2,.LTEBC	; IS LABEL TYPE EBCDIC?
	JRST	MTLAB2		; NO, CONT

	; IF EBCDIC LABELS, SET NO TRANSLATE

	HRRZ	AC1,(PP)	; GET JFN FROM SAVED POSITION ON STACK
	MOVEI	AC2,.MONTR	; INDICATE NO TRANSLATE
	SETO	AC3,		; TO BE SET
	MTOPR%			; DO IT
	 ERJMP	MTOERR		; ERROR, ISSUE MESSAGE AND QUIT

MTLAB2:	POP	PP,AC3		; RESTORE INITIAL FILE STATUS
	JUMPL	AC3,RET.2	; RETURN IF OPEN AT START
	HRRZ	AC1,AC3		; GET JFN
	TXO	AC1,CO%NRJ	; DON'T RELEASE IT
	CLOSF%			; CLOSE THE FILE
	 JRST	CLSERR		; ERROR, MESSAGE AND QUIT
	JRST	RET.2		; OK, LABELING OF SOME KIND, GIVE SKIP RETURN

	; ERROR ON GET-LABEL-INFO MTOPR, CHECK FOR ILLEGAL OPERATION, 
	; INDICATING NO MOUNTR, OR LABELS-BYPASS

MTOPER:	POP	PP,AC3		; RESTORE GTSTS CODE
	MOVEI	AC1,.FHSLF	;INDICATE CURRENT PROCESS
	GETER%			;GET LAST ERROR NUM IN AC2 (RT HALF)
	CAME	AC2,[.FHSLF,,MTOX1] ; AN INVALID FUNCTION ERROR (VER. 4)?
	JRST	MTOERR		; NO, MTOPR ERROR, ISSUE MESSAGE AND QUIT
				; YES,THEN THIS INDICATES THAT NO MOUNTR 
	JUMPL	AC3,RET.1	; RETURN, NON-SKIP IF FILE WAS OPEN
	HRRZ	AC1,AC3		; ELSE,GET JFN
	TXO	AC1,CO%NRJ	; DON'T RELEASE IT
	CLOSF%			; CLOSE THE FILE
	 JRST	CLSERR		; ERROR, MESSAGE AND QUIT
	POPJ	PP,		; GIVE NON-SKIP RETURN

>;END IFN TOPS20

IFE TOPS20,<

	; FOR TOPS10 NEED TO DO A COUPLE OF UUOS TO GET INFO

	; IF PULSAR LABEL PROCESSOR IS UP AND WE'RE NOT BYPASSING
	; LABELS THEN LET PULSAR DO THE LABELING. IF BYPASS LABELS
	; IS ON THEN LIBOL WILL DO LABELING AS ALWAYS.

	SKIPN	AUTOLB		; DO WE HAVE AUTO LABEL PROCESSING?
	POPJ	PP, 		; NO, GIVE NO-LABELS RETURN
				; YES 

	MOVEI	AC3,TMP.BK	; INDICATE THAT THE TEMP AREA WILL BE TMP.BK
	MOVEI	AC2,1(AC3)	;GET TEMP TAB ADDR
	SETZM	(AC3)		;ZERO FIRST WORD
	HRLI	AC2,-1(AC2)	;MAKE BLT PTR
	BLT	AC2,MTOSIZ-1(AC3) ;ZERO TEMP AREA

	HRLZI	AC3,2		; LENGTH ,, ADDRESS
	MOVEI	AC0,.TFLBL	; FUNCT - LABEL PROCESSING
	MOVE	AC1,UOBLK.+1	; SIXBIT /DEVICE NAME/
	MOVEM	AC1,TMP.BK+1	; ALSO SET IN ARG BLK FOR LABEL INFO
	TAPOP.	AC3,		; GET TYPE OF LABEL PROCESSING
	 JRST	OMTA96		; OOPS - COMPLAIN
	CAIN	AC3,.TFLNV	; WAS THAT "USER EOV , UNLABELED"?
	MOVEI	AC3,.TFLNL	; YES, INDICATE UNLABELED
	DPB	AC3,F.BLBT	; SET LABEL TYPE IN FILTAB
	CAIN	AC3,.TFLBP	; LABEL-BYPASS?
	POPJ	PP,		; YES,GIVE NON-LABELING RETURN IF BYPASS 

	; NOW GET OTHER LABEL INFO

	MOVE	AC2,[XWD .TPLEN,TMP.BK] ; INDICATE SIZE AND POSITION OF ARGBLK
	MOVEI	AC1,.TFLPR	; INDICATE GET LABEL INFORMATION 
	MOVEM	AC1,TMP.BK	; 
	TAPOP.	AC2,		; GET LABEL INFORMATION 
	 JRST	LBTPER		; ERROR, COMPLAIN
	MOVEM	AC3,TMP.BK+LABTYP ; SET LABEL TYPE
	MOVE	AC1,TMP.BK+.TPREC ; GET FORMAT AND FORMS CONTROL INFO
	HLRZM	AC1,TMP.BK+LABFMS ; RESET FORMS CONTROL WORD
	HRRZM	AC1,TMP.BK+LABFOR ; AND FORMAT WORD
	TLZ	AC1,-1		; CLEAR LEFT HALF
	MOVEI	AC2,1		; SET A BIT
	SOJLE	AC1,.+2		; IF "F" (OR DEFAULT) USE 1
	LSH	AC2,(AC1)	; SHIFT BIT TO INDICATE FORMAT
	DPB	AC2,F.BFMT	; SET LABEL FORMAT BITS
	JRST	RET.2		; GIVE LABELED RETURN

	; HERE IF LABELED TAPOP. ERROR
	;   ASSUMES THAT AC2 HAS ERROR CODE

LBTPER: JUMPN	AC2,OMTA96	; GO GIVE ERROR IF REAL ONE

	; HERE FOR UNIMPLEMENTED FEATURE ERROR

	MOVEI	AC3,.TFLNL	; SET UNLABELED
	DPB	AC3,F.BLBT	; SET LABEL TYPE IN FILTAB
	JRST	RET.2		; GIVE LABELED RETURN

>;END IFE TOPS20
; TM03AS	ROUTINE TO CHECK FOR ANSI-ASCI SUPPORT ON TAPE
;
;		IF STD-ASCII NOT SUPPORTED, INDASC FLAG SET TO 
;		INDICATE THAT STD-ASCII MUST BE DONE WITH INDUSTRY
;		COMPATIBLE MODE TAPE SETTING
;
; RETURNS	CALL +1 ALWAYS
;

TM03AS:

IFN TOPS20,<

	PUSHJ	PP,MTASTS	; GET MTA STATUS INTO TMP.BK
	 JRST	TM03AY		; ERROR, ASSUME NO STD-ASCII SUPPORT
	MOVE	AC2,TMP.BK+.MODDM ; GET DATA MODES WORD
	TXNE	AC2,SJ%CMA	; IS STD-ASCII SUPPORTED?
TM03X:	POPJ	PP,		; YES,RETURN NOW

>;END IFN TOPS20

IFE TOPS20,<

	HRLZI	AC3,2		; LENGTH ,, ADDR
	MOVEI	AC0,.TFKTP	; FUNCTION
	MOVE	AC1,UOBLK.+1	; GET DEVICE NAME
	TAPOP.	AC3,		; GET CONTROLER TYPE
	 JRST	TM03AY		; ERROR, ASSUME NOT SUPPORTED
	CAIE	AC3,.TFKTX	; TX01 CONTROLLER (TU70/TU71)?
	CAIN	AC3,.TFKD2	; SKIP IF DX20/TX02 CONTROLLER (OK TOO)
	 POPJ	PP,		; YES, RETURN, STDASC IS SUPPORTED
				; NO, NOT SUPPORTED FOR SURE
>; END IFE TOPS20

	; NOT SUPPORTED,SET INDASC FLAG, INDUSTRY-COMPT. NEEDED

TM03AY:	HRRZ	AC2,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRO	AC2,INDASC	; SET IT
	HRRM	AC2,D.RFLG(I16)	; AND PUT IT BACK
	POPJ	PP,		; RETURN NOW
MTOXXY:	
	; CHECK TO SEE IF AN ASCII TAPE IS TO BE WRITTEN TO
	; A DRIVE WITH STANDARD-ASCII DATA MODE SET. IFSO, SET STD-ASCII
	; RECORDING MODE.

	HRRZ	AC1,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNE	AC1,SASCII	; IS IT?
	JRST	MTALB0		; YES, ALL OK 


	; NO ATTRIBUTES SET, HOW ABOUT DEFAULT DATA MODE?

MTLB0D:	PUSHJ	PP,GTDFLT	; GET DEFAULT DATA MODE IN AC3
IFN TOPS20,<
	CAIE	AC3,.SJDMA	; IS DATA MODE ANSI-ASCII?
>
IFE TOPS20,<
	CAIE	AC3,.TFM7B	; IS DATA MODE ANSI-ASCII?
>
	JRST	MTLB0F		; NO, SKIP THIS
MTLB0E:	JUMPGE	FLG,MTLB0A	; JUMP IF NOT AN ASCII DEVICE MODE

MTLB0C:	HRRZ	AC3,D.RFLG(I16)	; GET SOME RUNTIME FLAGS
	TRO	AC3,SASCII	; SET STD-ASCII BIT
	HRRM	AC3,D.RFLG(I16)	; AND PUT IT BACK
				; THIS WILL INDICATE THAT DEFAULT
				; ADVANCING WILL BE 0 ADVANCING

	; CHECK FOR BLK-FTR = 0 CASE, HERE IF STD-ASCII 

MTALB0:
IFN TOPS20,<
	TLNN	AC6,MSTNDR	; WAS THAT A LABELED TAPE?
>				; TOPS20 DOES PROPER MAP TO 7-BIT
				; NO NEED TO CHECK (CAN'T SET HARDWARE MODE 
				; IF WE WANTED TO )
	PUSHJ	PP,TM03AS	; NO, CHECK FOR TM03: (MAYBE SET INDASC BIT)

MTAB0A:	LDB	AC5,F.BBKF	; GET BLOCKING FACTOR
	JUMPN	AC5,MTOXXX	; CONTINUE IF BLK-FTR NOT 0
	MOVEI	AC2,1		; ELSE BLK-FTR DEFAULTS TO 1
	MOVE	AC3,AC12	; GET DEVICE CHAR AGAIN
	DPB	AC2,F.BBKF	;
	PUSHJ	PP,RSTBPB	; CALC BUFFS PER BLOCK
	JRST	MTOXXX		; CONT

	; HERE IF STD-ASCI TAP FORMAT, BUT NOT ASCII RECORDING MODE
	; IF RECORDING MODE IS DEFAULT, THEN SET TO ASCII
	; IN THOSE CASES THAT MAKE SENSE

MTLB0A:	LDB	AC3,F.BDRM	; GET DEFAULT DDM MODE FLAG
	JUMPE	AC3,MTOXXX	; IS DEV-DATA-MODE DEFAULT?
				; NO, JUMP ASSUMING HE KNOWS WHAT HES DOING
	TLCN	FLG,DDMSIX	; SKIP IF MODE SIXBIT
	TLCA	FLG,DDMSIX	; NO, CLEAR IT , ERROR CONDITION, SKIP
	JRST	MTLB0B		; YES, ITS CLEARED, GO SET ASCII

	; HERE IF NOT SIXBIT DEFAULT RECORDING MODE, ASSUMES ITS AN ERROR
	; CONDITION TO TRY WRITING OTHER DATA MODES ON STD-ASCII TAPE

	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Tape data mode mismatchs file default recording mode./]
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.	;DOESN'T RETURN

MTLB0B:	TLO	FLG,DDMASC	; SET ASCII RECORDING MODE
	MOVEM	FLG,F.WFLG(I16)	; AND UPDATE FLAG WORD
	JRST	MTLB0C		; AND GO BACK AS IF ASCII RECORDING MODE SET
MTLB0F:

	; HERE IF NOT STD-ASCII HARD MODE

	TLNN	AC6,MSTNDR	; WAS THAT A LABELED TAPE?
	JRST	MTOXXX		; NO, CONT


IFE TOPS20,<

	; IF ANSI LABELED TAPE WITH ASCII DDM, MAKE
	; SURE HE WILL WRITE COMPATIBLE TAPE MODE (ANSI-ASC OR IND-CMP)

	JUMPGE	FLG,MTOXXX	; CONT IF NOT ASCII RECORDING MODE
	PUSHJ	PP,MTALAB	; GET LABEL INFO (SETS AC3)
	  JRST	MTOXXX		; UNLABELED,CONT
	LDB	AC3,F.BLBT	; GET LABEL TYPE FROM FILTAB
	CAIE	AC3,.TFLAL	; IS THE LABEL TYPE ANSI
	CAIN	AC3,.TFLAU	; OR ANSI WITH USER LABELS?
	JRST	MTALB0		; YES, CHECK BLOCKING AND HARD MODE
	JRST	MTOXXX		; NO, CONT

>; END IFE TOPS20


IFN TOPS20,<

	;  IF ASCII WITH F OR D ATTRIBUTE
	;  THEN CHANGE UNBLOCKED TO BLOCK 1

	JUMPGE	FLG,MTOXXX	; CONT IF NOT ASCII
	LDB	AC1,F.BLBT	; GET LABEL TYPE
	CAIE	AC1,.LTEBC	; SKIP IF EBCDIC LABEL
	PUSHJ	PP,GETATB	; GET FILE FORMAT ATTRIBUTES
	JRST	MTOXXX		; NONE SET, DO OTHER CHECK
	CAIE	AC5,"F"		; IS FORMAT "F"?
	CAIN	AC5,"D"		; IS FORMAT "D"?
	JRST	MTAB0A		; YES, CHECK BLOCKING
	JRST	MTOXXX		; NO, CONT


>; END IFN TOPS20

MTOXXX:	MOVE	AC3,AC12	; RESTORE AC3

MTOXX0:
SUBTTL MORE RESET

	TXNN	AC3,DV.MTA	;SKIP IF A MTA
	TLNE	FLG,RANFIL+IOFIL ;[622] SKIP IF  NOT RANDOM OR IO
	JRST	RSTDE4		;SETUP FOR NON-STD OR DUMP MODE BUFFERS

RSTDE7:	LDB	AC6,F.BNAB	;NUMBER OF BUFFERS
	CAIN	AC6,77		; [414] REALLY WANTS ONE?
	SETOI	AC6,		; [414] YES ONE BUFFER.
	XCT	UOBUF.		;ALLOCATE **************
	TLNE	FLG,IOFIL	;[622] THE
	XCT	UIBUF.		;BUFFERS **************
	HLLZ	AC6,D.F1(I16)	; GET SECOND FLAG WORD

	; CALC THE BUFFS/BLOCK FOR BLOCKED CASES

	LDB	AC5,F.BBKF	; GET BLOCKING FACTOR
	JUMPE	AC5,RSTDE5	; GO ON IF UNBLOCKED
	PUSHJ	PP,RSTBPB	; CALC BUFFS PER BLOCK


RSTDE5:
	HLRZ	AC12,D.BL(I16)	;CALCULATE
	SUB	AC12,.JBFF	;THE SIZE
	POP	PP,.JBFF	;
	MOVNS	AC12		;OF THE
RSTDE3:	CAML	AC12,TEMP.	;BUFFER AREA
	MOVEM	AC12,TEMP.	;SAVE SIZE OF LARGER
			;LOOP AGAIN
RSTLOO:
IFN ISAM,<TLNN	FLG,IDXFIL	>
	AOBJN	AC13,RSTDEV	;JUMP IF MORE DEV/FILTAB
RSTLO1:	MOVSI	AC15,BUFLOC	;[316];NOTE WE ARE DONE
	IORM	AC15,F.WDNM(I16);WITH THIS FILE TABLE
	HLRZ	AC1,F.LSBA(I16)	;SEE IF ANY SHARING OF BUFFERS
	JUMPE	AC1,RSTNFL	;GET THE NEXT FILE TABLE
	MOVEM	AC1,AC16	;
	JRST	RSTIF1		;SHARES THE SAME BUFFER AREA
RSTNFL:	MOVE	AC12,TEMP.	;INCREASE .JBFF BY
	ADDM	AC12,.JBFF	;THE BUFFER AREA SIZE
	SETZM	SHRDX.		;[556] CLEAR ISAM SHARED BUF FLAG
	HRRZ	AC16,F.RNFT(I16);LOCATE THE NEXT FILE TABLE
	JUMPN	AC16,RSTIFI	;AND JUMP IF THERE IS ONE.
	SKIPE	TEMP.1		;ANY ERRORS ?
	JRST	KILL		;YES
	XCT	URELE.		;RELEASE THE CHANNEL

IFN ISAM,<
	;GRAB SPACE FOR THE AUX BLOCK
	SKIPE	MXBUF		;EXIT IF NO INDEXED FILES
	SKIPE	KEYCV.		;SKIP IF RESET UUO
	JRST	RSTXIT		;EXIT - ITS A SORT CALL
	MOVE	AC0,MXBUF	;SIZE OF AUX BLOCK
	MOVE	AC1,.JBFF	;
	HRRZM	AC1,AUXBUF	;LOCATION OF AUX BLK
	PUSHJ	PP,GETSPC	;
	 JRST	GETSPK		;ERROR RETURN

	;SPACE FOR DATA-RECORD-TABLE FOR SPLITTING BLOCKS
	MOVE	AC0,MXBF	;MAX-BLOCKING FACTOR OF ALL IDXFIL'S
	ADDI	AC0,1		;TERMINATOR
	MOVE	AC1,.JBFF	;
	HRRZM	AC1,DRTAB	;
	PUSHJ	PP,GETSPC	;
	 JRST	GETSPK		;ERROR RETURN

	;SPACE FOR INDEX ENTRY WHEN SPLITTING TOP INDEX BLOCK
	MOVE	AC0,MXIE	;SIZE OF LARGEST INDEX ENTRY
	MOVE	AC1,.JBFF	;
	HRRZM	AC1,IESAVE	;LOC OF SAVE AREA
	PUSHJ	PP,GETSPC	;
	 JRST	GETSPK
>
RSTXIT:	LDB	AC2,[POINT 4,UOPEN.,12]	;FREE THE CHANNEL
	PUSHJ	PP,FRECH2	;  AND POPJ
	HRLZI	AC0,577774	;[342]TURN OFF CHAN 1
	SKIPN	TEMP.2		;ANY RERUNS?
	POPJ	PP,		;NO
	ANDM	AC0,OPNCH.	;YES, DOIT
	SETOM	RRFLG.##	;REMEMBER
	POPJ	PP,
	; CALCULATE THE NUMBER OF BUFFERS PER LOGICAL BLOCK

RSTBPB:	PUSH	PP,AC13		; SAVE AC13,OPNWPB ASSUMES DEVICE CHAR IN AC13
	MOVE	AC13,AC3	; GET DEVICE CHAR
	PUSHJ	PP,OPNWPB	; AC10= WORDS PER LOGICAL BLOCK
	PUSH	PP,AC10		; SAVE AC10 FOR CALLER
	MOVEI	AC0,DSKBSZ	;DSK BUFFER SIZE
	TLNE	FLG,IOFIL!RANFIL!IDXFIL ;[622] SKIP IF NOT RANDOM OR IO
	JRST	RSTBP3		;
	TXNN	AC13,DV.MTA	;SKIP IF A MTA
	JRST	RSTBP1		;JUMP, NOT A MTA
	JUMPE	AC5,RSTBP1	;JUMP IF BLK-FTR IS ZERO (AC5)
	MOVEI	AC10,1		;ONE BUFFER PER LOGICAL BLOCK
	JRST	RSTBP2		;
RSTBP1:	HRRZ	AC11,D.OBH(I16)	; RESET ASSUMES USE OF AT LEAST OUTBUF
	HLRZ	AC0,(AC11)	;BUFFER SIZE + 1 IN WORDS
	SUBI	AC0,1		;SIZE
RSTBP3:	IDIV	AC10,AC0	;/BUF-SIZE
	SKIPE	AC10+1		;ROUND UP
	ADDI	AC10,1		;AC10=BUFFERS PER LOGICAL BLOCK
;BL;	2 LINES INSERTED AT RSTBP3+3 TO FIX ISAM/RANDOM SHARED BUFFR BUG
	TLNE	FLG,IDXFIL	;ISAM FILE?
	SKIPN	PAGBUF(I12)	;YES, & PAGE I/O TOO?
	JRST	RSTBP2		; NO
	ADDI	AC10,3		; YES, ADD 3 SECTORS
	LSH	AC10,-2		; AND
	LSH	AC10,2		;  ROUND OFF
RSTBP2:	MOVEM	AC10,D.BPL(I16)	;BUFBLK
	POP	PP,AC10		; RESTORE AC10, WDS/LOG-BLK
	POP	PP,AC13		; RESTORE AC13	
	POPJ	PP,		; ALL DONE RETURN

	;SETUP FOR NONSTD BUFFERS OR DUMP MODE
RSTDE4:	LDB	AC5,F.BBKF	;BLOCKING FACTOR
	JUMPN	AC5,RSTD40	; IF BLK-FTR = 0
	TLNE	FLG,DDMEBC	; AND DEVICE DATA MODE IS EBCDIC
	TXNN	AC3,DV.MTA	; AND DEVICE IS A MTA
	JRST	RSTD40		;
	MOVEI	AC5,1		; THEN BLK-FTR DEFAULTS TO 1
	DPB	AC5,F.BBKF	;
RSTD40:	JUMPE	AC5,RSTDE7	;JUMP IF BLOCKING FACTOR IS 0
	PUSHJ	PP,RSTBPB	; CALC BUFFS PER LOG-BLK,AC10=WDS PER LOG-BLK
	TXNN	AC3,DV.MTA	;SKIP IF A MTA
	JRST	RSTDE6		;JUMP ITS NOT A MTA
	CAIL	AC10,MXTPRC	;SKIP IF LOG. BLK NOT TOO LARGE
	JRST	MXTPER		;JUMP IF TOO LONG
	ADDI	AC10,3		;   PLUS 3 FOR BOOKEEPING WORDS
	HLLZ	AC6,D.F1(I16)	;SECOND FLAG REG
	TLNN	AC6,STNDRD	;SKIP IF STANDARD LABELS
	JRST	RSTD41		;MTA W/NONSTD OR OMITTED LABELS
	CAIGE	AC10,^D16+4	;SKIP IF RECORD IS GE THE LABEL RECORD
	MOVEI	AC10,^D16+4	;ENSURE LABEL REC WILL FIT IN REC AREA
RSTD41:	TLNN	FLG,DDMEBC	;SKIP IF EBCDIC
	JRST	RSTDE8		;ITS NOT
	SKIPGE	D.F1(I16)	; VARIABLE LENGTH EBCDIC?
	ADDI	AC10,1		; YES - ADD IN ONE FOR BLOCK DESCRIPTOR WORD
RSTD42:	TLNN	AC6,STNDRD	; LABELS STANDARD?
	JRST	RSTDE8		;NO - MUST BE OMITTED
	CAIGE	AC10,^D20+4	;
	MOVEI	AC10,^D20+4	;LABEL RECORD IS THE LARGEST RECORD
RSTDE8:	TLNN	AC6,NONSTD	;SKIP IF NON-STANDARD LABELS
	JRST	RSTDE9		;
	HLRZ	AC1,F.LNLS(I16)	;NONSTD LABEL SIZE
	JUMPGE	FLG,RSTD10	;JUMP IF NOT ASCII
	ADDI	AC1,2		;ADD IN "CR-LF" CHARS
	IDIVI	AC1,5		;
RSTD10:	TLNN	FLG,DDMASC	;SKIP IF ASCII
	IDIVI	AC1,6		;
	SKIPE	AC2		;
	ADDI	AC1,1		;CONVERT CHARS TO WORDS
	CAIGE	AC10,3(AC1)	;
	MOVEI	AC10,3(AC1)	;ENSURE LABEL REC WILL FIT IN REC AREA
RSTDE9:	MOVEI	AC1,-3(AC10)	;
	HRRM	AC1,D.LRS(I16)	;SAVE IT FOR OPNNSB
	LDB	AC12,F.BNAB	;NUMBER OF ALTERNATES
	CAIN	I12,77		; [414] REALLY WANTS ONE?
	JRST	RSTD11		; YES, DON'T MULTIPLY
IFN ANS68,<
	IMULI	AC10,DFLTBF(I12) ; NO,REC TIMES NUMBER OF ALTERNATE BUFFERS
>
IFN ANS74,<
 REPEAT 0,<			;V13 INCOMPATIBLE CODE - NEEDS COMPILER CHANGE
	JUMPN	AC12,.+2	; SKIP IF NOT ZERO RESERVED
	MOVEI	AC12,DFLTBF	; 0 MEANS DEFAULT NUMBER
	IMULI	AC10,(I12)	; NO,REC TIMES NUMBER OF BUFFERS
 >
 REPEAT 1,<			;COMPATIBLE WITH 12A
	IMULI	AC10,DFLTBF(I12) ; NO,REC TIMES NUMBER OF ALTERNATE BUFFERS
>>
	JRST	RSTD11		; OK, NOW GET MEM
RSTDE6:	TXNN	AC3,DV.DSK	;SKIP IF DEV IS A DSK
	JRST	RSTER0		;COMPLAIN
	TRZE	AC10,DSKMSK	;ALLOCATE FULL DISK BLKS
	ADDI	AC10,DSKBSZ	;ROUND UP TO NEXT DISK BLK
IFN ANS68,<
	ADDI	AC10,12		;3+7=12 FLAG WORDS REQD FOR RANDOM OR IO
>
IFN ANS74,<
	ADDI	AC10,13		;3+8=13 FLAG WORDS REQD FOR RANDOM OR IO
>
RSTD11:	MOVE	AC0,AC10	;SETUP AC0 FOR GETSPC
	PUSHJ	PP,GETSPC	;CLAIM THE BUFFER AREA
	 JRST	GETSPK		;NO MORE CORE
	JRST	RSTDE5		;RETURN

RSTER0:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Only DSK may be used for RANDOM, I-O or INDEX-SEQUENTIAL processing./]
RSTERR:	MOVE	AC2,[BYTE (5)10,31,20]
	PUSHJ	PP,MSOUT.

MXTPER:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Mag tape logical block size too large./]
	MOVE	AC2,[BYTE (5) 25,4,10,31,20] ;INDICATE WHICH FILE AND
				;WHICH DEVICE HAS TROUBLE
	PUSHJ	PP,MSOUT.	;THEN QUIT
IFE ISAM,<
RERIT.:	OUTSTR	[ASCIZ /REWRITE ?/]
	SKIPA
DELET.:	OUTSTR	[ASCIZ /DELETE ?/]
RSTIDX:	OUTSTR	[ASCIZ /
To process ISAM files CBLIO must be reassembled with the conditional
assembly switch,ISAM, equal to a non-zero value./]
	JRST	KILL
>
IFN ISAM,<
;SETUP FOR AN INDEX FILE

RSTIDX:	; IF THERE ARE ANY FILES THAT SHARE THE SAME BUFFER AREA
	; THEN ALLOCATE THE SPACE FOR THE "SAVE" AREAS NOW.
	; THE "SAVE" AREAS, ONE PER FILE, ARE LOCATED DIRECTLY
	; BEFORE THE SHARED BUFFER AREA AND ARE POINTED TO BY D.IBL.

	HLRZ	AC12,F.LSBA(I16); [377A] GET LINK TO FILE TBL THAT SHARES
	JUMPE	AC12,RSTI05	; [377A] [556] JUMP IF NONE
	HRRZ	AC6,D.IBL(I16)	; [377A] GET ADR OF "SAVE" AREA
	JUMPN	AC6,RSTI05	; [377A] [556] JUMP IF ALREADY DONE
	SETOM	SHRDX.		;[556] SET SHARED ISAM BUF FLAG,INDICATING THAT
				;[556] ALL FILES IN THIS SHARE CHAIN WILL HAVE
				;[556] THEIR D.BL LOCATIONS SET BELOW AT RSTI04
	MOVE	AC12,I16	; [377A] GET FIRST LINK
	HLRZ	AC4,D.BL(I16)	; [377A] ADR OF SBA (SHARED BUFFER AREA)

RSTI01:	MOVEI	AC0,ISMCLR+1	; [377A] GET SIZE OF "SAVE" AREA
	PUSHJ	PP,GETSPC	; [377A] GET THE CORE SPACE
	 JRST	GETSPK		; [377A] OOPS
	HRRM	AC4,D.IBL(AC12)	; [377A] SAVE ADR OF "SAVE" AREA
	HRLZI	AC6,ISMCLR+1	; [377A] SIZE OF "SAVE" AREA
	ADDM	AC6,D.BL(I16)	; [377A] MOVE SBA TO OTHER SIDE OF "SAVE" AREA
	MOVEI	AC6,ISMCLR+1	; [377A] SIZE OF "SAVE" AREA
	ADDM	AC6,(PP)	; [377A] UPDATE SAVED .JBFF

RSTI02:	HLRZ	AC12,F.LSBA(AC12);[377A] GET LINK TO NEXT FILE TBL
	CAMN	AC12,I16	; [377A] HAVE WE CIRCLED THE CHAIN?
	JRST	RSTI03		; [377A] YES - THEN DONE
	LDB	AC0,[POINT 2,F.WFLG(AC12),17]; [377A] GET ACCESS MODE
	CAIE	AC0,2		; [377A] IS THIS AN ISAM FILE?
	JRST	RSTI02		; [377A] NO - TRY NEXT LINK
	HRRZ	AC4,.JBFF	; [377A] GET ADR OF NEXT FREE LOC
	JRST	RSTI01		; [377A] LOOP
;[556]	NOW UPDATE BUF LOCATIONS FOR ALL THAT SHARE WITH THIS
;[556]	INDEX FILE,SINCE ALLOCATION OF SAVE AREAS HAS MOVED IT
;[556]	DOWN AT LEAST ONCE.
;	[556] THIS CROCK UPDATES MORE THAN NECESSARY,SINCE THOSE IN
;	[556] CHAIN FOLLOWING THE FIRST ISAM FILE WILL BE UPDATED
;	[556] AT RSTDE2+2.  THIS IS EASIEST WAY TO GET AT ALL
;	[556] THAT MAY HAVE COME BEFORE THE FIRST ISAM FILE.

RSTI03:	MOVE	AC0,D.BL(I16)	;[556] GET NEW BUF LOC FOR ALL THIS SHARE CHAIN
RSTI04:	HLRZ	AC12,F.LSBA(AC12) ;[556] GET FILTAB OF NEXT FILE THAT SHARES
	CAMN	AC12,I16	;[556] ALL WHO SHARE UPDATED?
	JRST	RSTI05		;[556] YES,CONT.
	HLLM	AC0,D.BL(I12)	;[556] NO,UPDATE BUF LOC OF NEXT THAT SHARES
	JRST	RSTI04		;[556] CONT. AROUND CHAIN


RSTI05:				;[556]
	PUSHJ	PP,OPNLIX	;IDXFIL FILENAME
IFE TOPS20,<
	XCT	ULKUP.		;***************
	JRST	RSTID1		;
>
IFN TOPS20,<
	PUSH	PP,.JBFF	;SAVE IT
	MOVEI	AC0,ICHAN	;MAKE SURE WE HAVE CORE
	PUSHJ	PP,GETSPC	;GO SEE
	 JRST	GETSPK		;NO CORE RETURN SO COMPLAIN
	POP	PP,.JBFF	;RESTORE JOBFF
	PUSH	PP,AC13		;SAVE AC13
	HLRZ	I12,D.BL(I16)	;GET BUFFER LOCATION
	LDB	AC0,[POINT 4,UFRST.,12]	;[467] USE ALREADY ALLOCD CHAN
	MOVEM	AC0,ICHAN(I12)	;SAVE IT AWAY
	PUSHJ	PP,OCPT		;USE TOPS20 COMPT. UUO
	 JRST	[CAIE	AC1,600130	;INVALID SMU ACCESS?
		JRST	[OUTSTR	[ASCIZ /RESET time /]
			JRST	OCPERR	]
		HRRZI	AC0,OF%THW	;YES - SO TRY A VALID ACCESS
		ANDCAM	AC0,CP.BK3	;TURN OFF THAWED (ON FROZEN)
		MOVE	AC1,[10,,CP.BLK];COUNT,,ADR OF ARG-BLK
		COMPT.	AC1,		;OPEN FILE IN FROZEN MODE
		 JRST	[OUTSTR	[ASCIZ /RESET time /]
			JRST	OCPERR	]
		JRST	.+1]
	POP	PP,AC13		;RESTORE AC13
	MOVE	AC3,(AC13)	;GET DEVICE NAME
	DEVCHR	AC3,		;RESTORE DEVICE CHARACTERISTICS
>
	MOVEI	AC0,ITABL	;
	HRR	AC1,.JBFF	;
	PUSHJ	PP,GETSPC	;
	 JRST	GETSPK		;ERROR RETURN
	HRLI	AC1,-STABL	;
	SUBI	AC1,1		;DUMP MODE IOWD
	SETZ	AC2,		;TERMINATOR
	MOVEI	AC6,1		;LOCATION OF
	HRRM	AC6,UIN.	;  IOWD
	XCT	UIN.		;READ IN STATISTICS BLOCK
	SKIPA	AC2,1+MXLVL(AC1);[442] GET ORIGINAL # OF IDX LEVELS
	JRST	RSTIER		;
	HLRZ	I12,D.BL(I16)	;[442] GET BUFFER LOCATION
	MOVNM	AC2,OMXLVL(I12)	;[442] SAVE FOR OPNI22
	MOVE	AC12,1+ISPB(AC1);[442] INDEX SECTORS / BLK
	HLRZ	AC2,1(AC1)	;GET FILE FORMAT CODE
	CAIN	AC2,401		;COMPLAIN IF NOT 401
	JRST	RSTID7		;OK
	PUSHJ	PP,MSVID	;OUTPUT VALUE-OF-ID
	OUTSTR	[ASCIZ/ is not the index for ISAM,/]
	PUSHJ	PP,MSFIL.	;OUTPUT FILE NAME AND VID
	PUSHJ	PP,KILL		;KILL NEVER RETURNS

	;HERE IF LOOKUP FAILURE
RSTID1:	HLLZ	AC1,D.F1(I16)	;[377] GET FLG1 PARMS
	TLNN	AC1,FILOPT	;[374] OPTIONAL FILE?
	JRST	RSTID8		;[323] NO, FATAL
	HRRZ	AC1,ULBLK.+1	;GET THE ERROR CODE
	TRZ	AC1,777740	;WAS IT FILE NOT FOUND?
	JUMPN	AC1,LUPERR	;EXIT HERE IF OTHER
	POP	PP,.JBFF	;RESTORE THE STACK
	SETOM	D.OPT(I16)	;FILE NOT FOUND - REMEMBER THAT
	JRST	RSTLOO		;  AND SHOOT HIM DOWN AT OPEN TIME
RSTID8:	PUSHJ	PP,MSFIL.	; [323]OUTPUT FILE NAME
	OUTSTR	[ASCIZ/ not found at reset time./]
	PUSHJ	PP,KILL		;[323] FATAL ERROR

RSTID7:	HLLZS	UIN.		;CLEAR IOWD POINTER
	IMULI	AC12,200	;WRDS / SECTOR
	CAMLE	AC12,MXBUF	;LARGER THAN LARGEST?
	MOVEM	AC12,MXBUF	;YES, SAVE AS NEW LARGEST
	MOVE	AC6,1+MXLVL(AC1)		;NUMBER OF INDEX LEVELS
	ADDI	AC6,2		;PLUS ONE FOR SAT BLK & ONE FOR SPLITING TOP-LEVEL
	IMUL	AC12,AC6	;

	;FIND THE LARGEST INDEX ENTRY SIZE
	MOVE	AC2,1+IESIZ(AC1)
	CAMLE	AC2,MXIE	;
	MOVEM	AC2,MXIE	;

	;FIND THE MAX BLOCKING-FACTOR
	MOVE	AC2,DBF+1(AC1)	;
	LDB	AC6,F.BBKF	;[515] BLOCKING FACTOR IN PROGRAM
	CAME	AC2,AC6		;[535] [515] [1062] IF NOT EQUAL, ERROR
	JRST	RSTER1		;[515] TELL USER AND GET OUT
	CAMLE	AC2,MXBF	;
	MOVEM	AC2,MXBF	;

	MOVE	AC4,KEYDES+1(AC1)	;[515] GET ISAM KEY DESCRIPTION
	MOVEM	AC4,OKEYDS+1(AC1)	;[515] SAVE KEY FOR OPEN CHECKING
	MOVE	AC4,RECBYT+1(AC1)	;[515] GET SIZE OF DATA BLOCK IN BYTES
	MOVEM	AC4,ORCBYT+1(AC1)	;[515] SAVE IT FOR CHECKING AT OPEN
	MOVE	AC4,EPIB+1(AC1)		;[515] GET NUM OF ENTRIES/INDEX BLOCK
	MOVEM	AC4,OEPIB+1(AC1)	;[515] SAVE IT FOR CHECKING AT OPEN

	LDB	AC6,KY.TP	; GET KEY TYPE
	JUMPN	AC6,RSTID2	;BRANCH IF NON-NUMERIC-DISPLAY
	MOVE	AC4,1+IESIZ(AC1)	;INDEX ENTRY BLOCK SIZE
	SUBI	AC4,1		;-2 HDR WRDS, +1 WRD FOR WRAP-AROUND
IFN ANS68,<
	IMULI	AC4,3		;RESERVE 3 KEY AREAS
>
IFN ANS74,<
	IMULI	AC4,7		;RESERVE 7 KEY AREAS (2 FOR DEL/RWT CNTRY )
>
	JRST	RSTID3		;

RSTER1:	OUTSTR	[ASCIZ/ Reset blocking factor for/]		;[515]
	PUSHJ	PP,MSFIL.	;[515] OUTPUT FILE NAME
	OUTSTR	[ASCIZ/ differs from user's program ./]		;[515]
	PUSHJ	PP,KILL		;[515] FATAL ERROR

RSTER2:	PUSH	PP,AC1		;[515] SAVE IT FOR LATER
	PUSH	PP,AC4		;[515] SAVE IT FOR LATER
	OUTSTR	[ASCIZ/ Reset key descriptor for/]		;[515]
	PUSHJ	PP,MSFIL.	;[515] GIVE HIM FILE NAME
	OUTSTR	[ASCIZ/ differs from program key descriptor.
/]
	POP	PP,AC4		;[515] GET AC4 BACK
	POP	PP,AC1		;[515] GET AC1 BACK
	POPJ	PP,		;[515] PROCEED AT YOUR OWN RISK
RSTID2:
IFN ANS68,<
	MOVEI	AC4,6		;(1+1)*3
	TRNN	AC6,1		;ODD = 1 WRD,  EVEN = 2 WRDS
	MOVEI	AC4,9		;(2+1)*3
>
IFN ANS74,<
	MOVEI	AC4,12		; (1+1)*5
	TRNN	AC6,1		; ODD = 1, EVEN = 2
	MOVEI	AC4,17		; (2+1)*5
>

RSTID3:
IFN ANS68,<
	ADDI	AC12,2(AC4)	;NUMBER OF WORDS ALLOCATED
>
IFN ANS74,<
	ADDI	AC12,4(AC4)	;NUMBER OF WORDS ALLOCATED
>
	MOVE	AC2,F.WDNM(I16)
	MOVE	AC2,1(AC2)	;DATA FILE DEVICE NAME
	MOVEM	AC2,UOBLK.+1	;
	XCT	UOPEN.		;**************
	JRST	RSTDE1		;ERROR
	DEVCHR	AC2,		;DEVCHR
	TXNE	AC2,DV.DSK	;DATA FILE
	TXNN	AC3,DV.DSK	;IDX FILE
	JRST	RSTER0		;MUST BE A DSK 

	LDB	AC5,KY.MD	; GET DATA MODE FROM STS-BLOCK
	XCT	RSTID4(AC5)	; SAME AS FILE TABLE DATA MODE?
	JRST	RSTID5		; YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Data-mode discrepancy/]
	MOVE	AC2,[BYTE (5)10,31,20,4]
	JRST	MSOUT1

RSTID4:	TLNE	FLG,DDMSIX	; SKIP IF NOT SIXBIT
	TLNE	FLG,DDMEBC	; EBCDIC
	TLNE	FLG,DDMASC	; ASCII
	Z			;
RSTID5:	PUSH	PP,AC12		; [375] SAV REG 12
	MOVEI	AC12,1(AC1)	; [375]  SET UP TO GET ISAM REC SIZE
	PUSHJ	PP,OPNWPB	;RETURNS WRDS/LOGICAL BLOCK IN AC10
IFN ANS74,<
	; make sure that the internal record area will fit in AUXBUF

	LDB	AC5,F.BMRS	; Get record size
	LDB	AC4,[POINT 2,FLG,14] ; Get internal mode
	HRRZ	AC4,RBPTBL(AC4)	; Get bytes per internal record word
	IDIVI	AC5,(AC4)	; Get words in record area
	SKIPE	AC6		; Skip if no round up
	ADDI	AC5,1		; Round up
	CAIGE	AC10,(AC5)	; Is record area larger than aux buf?
	MOVE	AC10,AC5	; Yes, reset so it will hold record area
>; END IFN ANS74

;BL;	2 LINES INSERTED AT RSTID5 + 3 TO FIX ISAM/RANDOM SHARED BUFFR BUG
	TLNE	FLG,IDXFIL	;ISAM FILE?
	SKIPN	,PAGBUF(I12)	;YES, & PAGE I/O TOO?
	JRST	RSTID6		; NO
	ADDI	AC10,777	; YES, AT LEAST 512 WD/PG
	LSH	AC10,-9		; ROUND
	LSH	AC10,9		; OFF
RSTID6:	POP	PP,AC12		; [375]RESTORE AC12
	CAMLE	AC10,MXBUF	;
	MOVEM	AC10,MXBUF	;SAVE AS LARGEST AUX BUF
	ADD	AC12,AC10	;
	ADDI	AC12,ITABL	;INDEX TABLE LEN
	MOVE	AC0,AC12	;
	MOVEM	AC0,D.OBH(I16)	;SAVE AMOUNT OF CORE REQUIRED
	PUSHJ	PP,GETSPC	;GRAB SOME CORE AREA
	 JRST	GETSPK		;ERROR RETURN
IFN ANS74,<
	HLRZ	AC4,D.BL(I16)	; Reget buffer location
	MOVEM	AC5,RCARSZ(AC4)	; Save record area length  for START checks
>

	SETZM	UOBLK.		;

	;NOW SAVE INITIAL CONDITIONS FOR OPEN LOGIC
	HRRZ	AC4,D.IBL(I16)	; [377A] GET ADR OF "SAVE" AREA
	HRLI	AC4,ISCLR1+1(AC1); [377A] ADR OF AREA TO BE SAVED
	MOVEI	AC2,ISMCLR(AC4)	; [377A] END OF AREA TO BE SAVED
	TRNE	AC4,-1		; [377A] SKIP IF NOTHING TO SAVE
	BLT	AC4,(AC2)	; [377A] DOIT
	PUSH	PP,AC12		; SAV REG 12
	MOVEI	AC12,1(AC1)	; POINT AT STAT BLOCK
	PUSHJ	PP,RSTBPB	; CALC BUFFS PER LOG-BLK
	POP	PP,AC12		; RESTORE AC12
	JRST	RSTDE5		;RETURN


RSTIER:	XCT	UGETS.		;INPUT ERROR DURING RESET UUO
	TXNE	AC2,IO.EOF	;[376] EOF?
	OUTSTR	[ASCIZ / Unexpected EOF on ISAM index file./]		;[376]
	PUSHJ	PP,IOERM1	;
	MOVE	AC2,[BYTE (5)35,4,10,31,20,2]
	JRST	KILL		;&KILL
>
	;GET CORE SPECIFIED BY (AC0)
GETSPC:	PUSH	PP,.JBFF	;INCASE THE CORE UUO FAILS
	ADDB	AC0,.JBFF	;ASSUME WE'LL GET IT
	CAMG	AC0,.JBREL	;IS THERE ENOUGH IN FREE CORE
	JRST	GETSP1		;YEP
	CORE	AC0,		;NO, GET SOME MORE CORE
	 JRST	GETSP2		;ERROR RETURN
GETSP1:	POP	PP,(PP)		;.JBFF IS GOOD
	JRST	RET.2		;NORMAL EXIT
GETSP2:	POP	PP,.JBFF	;RESTORE .JBFF, CORE UUO FAILED
	POPJ	PP,

GETSP9:	OUTSTR	[ASCIZ/Insuficient core for buffer requirements./]
	POPJ	PP,

GETSPK:	PUSHJ	PP,GETSP9
	JRST	KILL

IFE TOPS20,<

;SEE IF MONITOR HAS AUTO LABELING FACILITY.
;SET SUTOLB TO NON-ZERO IF IT DOES.

SETALB:	SETZM	AUTOLB		; INIT TO NO AUTO FACILITY
	MOVE	AC1,[%SITLP]
	GETTAB	AC1,
	  SETZ	AC1,		; ERROR SO OLD STYLE PROCESSING
	SKIPE	AC1		; WHAT IS IT?
	SETOM	AUTOLB		; AUTO FACILITY!
	POPJ	PP,
>
;SUBROUTINE TO SET UP OVERLAY FILE
;ENTER WITH AC1 = FILE NAME

SETOVR:	HRLZI	AC0,577774	;[342]TURN OFF CHAN 1
	ANDM	AC0,OPNCH.	;DOIT
	SETO	AC0,		;DSK = -1
	SKIPN	AC3,RN.DEV	;[333]IF DEVICE SPECIFIED, GET IT
	HRLZI	AC3,'DSK'
SETOV1:	MOVEI	AC2,IO.SYN+.IOBIN	;SET UP DEVICE
	HRRZI	AC4,OVRBF.	;
	OPEN	1,AC2		;[342]INIT 
	  JRST	SETOV4		;
	MOVSI	AC2,'OVR'
	SETZB	AC3,AC4		;
	SKIPE	AC0		;[333]IF NOT TRYING SYS
	MOVE	AC4,RN.PPN	;[333]GET OVERLAY PPN
	LOOKUP	1,AC1		;[342]
	  JRST	SETOV5		;LOOKUP FAILED
	INBUF	1,2		;GET 2 BUFFERS
	MOVE	AC1,.JBFF	;GET NEXT FREE WORD
	MOVEM	AC1,OVRIX.	;WHERE INDEX BLOCK WILL BE
	MOVEI	AC0,400		;SIZE WE NEED
	PUSHJ	PP,GETSPC	;GET IT
	  JRST	GETSPK		;FAILED
	MOVE	AC1,OVRIX.	;
	PUSHJ	PP,SETOV2	;
	MOVE	AC1,OVRIX.
	ADDI	AC1,200

SETOV2:	IN	1,		;[342]
	  SKIPA	AC2,OVRBF.	;
	JRST	SETOV6		;
	MOVSI	AC2,2(AC2)	;
	HRR	AC2,AC1		;
	BLT	AC2,177(AC1)	;
	POPJ	PP,

SETOV4:	OUTSTR	[ASCIZ "Cannot initialize overlay."]	;[536]
	JRST	SETOV7			;[536]

SETOV5:	HRLZI	AC3,'SYS'		;[536]TRY SYS IF DSK FAILS
	AOJE	SETOV1
	OUTSTR	[ASCIZ "Cannot find overlay file ."]
	SKIPN	AC3,RN.DEV		;[536]
	MOVSI	AC3,'DSK'		;[536]
	PUSHJ	PP,MSDEV1		;[536] PRINT DEVICE PART
	PUSHJ	PP,COLON		;[536] PRINT ":"
	MOVE	AC3,OVRFN.		;[536] FILE NAME
	PUSHJ	PP,MSDEV1		;[536] PRINT IT
	OUTSTR	[ASCIZ /.OVR/]		;[536] EXT
	SKIPE	AC3,RN.PPN		;[536] ANY PPN?
	PUSHJ	PP,MSDIR.		;[536] YES, PRINT IT
	JRST	KILL

SETOV6:	OUTSTR	[ASCIZ "INPUT error on overlay."]
SETOV7:	SKIPN	AC3,RN.DEV		;[536]
	MOVSI	AC3,'DSK'		;[536]
	MOVEI	AC1,AC3			;[536] POINT TO WHERE IT IS
	PUSHJ	PP,MSDEVA		;[536] PRINT DEVICE PART
	JRST	KILL
			;ROUTINE TO REORGANIZE THE FLAGS
RSTFLG:	MOVE	FLG,F.WFLG(I16)		;GET FLAGS
	MOVX	AC15,BR%IO!BR%RER!BR%RRC
	AND	AC15,FLG		;RRUNER & RRUNRC
	LDB	AC1,[POINT 3,FLG,9]
	HLLZ	AC2,FLGTAB(AC1)		;DEVICE DATA MODE
	TLZ	AC2,037777		;
	IOR	AC15,AC2		;
	MOVEI	AC0,SASCII		; GET STANDARD ASCII FLAG
	CAIN	AC1,4			; AND SET IT IF REQUESTED
	IORM	AC0,D.RFLG(I16)		; DOIT
	LDB	AC1,[POINT 2,FLG,15]
	HLLZ	AC2,FLGTAB(AC1)		;CORE DATA MODE
	TLZ	AC2,777707		;
	IOR	AC15,AC2		;
	LDB	AC1,[POINT 2,FLG,17]
	HLLZ	AC2,FLGTAB(AC1)		;ACCESS MODE
	TLZ	AC2,777770		;
	IOR	AC15,AC2		;

	TXNE	FLG,BR%OPF	;FILOPT?
	TRO	AC15,FILOPT	;
	TXNE	FLG,BR%NSL	;NONSTD?
	TRO	AC15,NONSTD	;
	TXNE	FLG,BR%STL	;STNDRD?
	TRO	AC15,STNDRD	;
	TLNN	AC15,DDMEBC	;ONLY EBCDIC HAS VAR-LEN RECORDS
	JRST	RSTFL1		;
	TXNE	FLG,BR%VLE	;VARIABLE LENGTH EBCDIC RECORDS?
	TRO	AC15,VLREBC	;
RSTFL1:	HLLM	AC15,F.WFLG(I16);SAVE IT
	HRLM	AC15,D.F1(I16)	;FLG1
	TLNE	FLG,RRUNER!RRUNRC	;RERUNING?
	SETOM	TEMP.2		;YES, REMEMBER TO TURN OFF CHAN 17
	POPJ	PP,		;

	;BITS  0-3	DEVICE DATA MODE
	;     12-14	CORE DATA MODE
	;     15-17	ACCESS MODE
FLGTAB:	200022,,0
	040001,,0
	400044,,0
	100010,,0
	400000,,0	; STANDARD ASCII
	Z
	Z
	Z
;TRAP INTERUPT ROUTINE

TRAP.:
IFE TOPS20,<
	PORTAL	.+1		; SET EXECUTE ONLY ENTRY POINT
>
	SKIPE	INTRAP##	;ARE WE ALREADY IN A TRAP?
	 EXIT			;YES, JUST QUIT
	SETOM	INTRAP##	;SET THE FLAG TO PREVENT LOOPING
	MOVE	AC0,.JBCNI	; APR STATUS
	TXNE	AC0,AP.ILM
	OUTSTR	[ASCIZ/Memory protection violation at user loc /]
	TXNE	AC0,AP.NXM
	OUTSTR	[ASCIZ/Non-ex-mem request at user loc /]
	TXNE	AC0,AP.POV
	JRST	TRAP1		;PDLOV
TRAP0:	PUSHJ	PP,OUTBF1	;REINIT THE TTY BUFFER
	HRLO	AC12,.JBTPC	;THE GUILTY LOCATION
	PUSHJ	PP,PPOUT4	;OUTPUT THE LOC
	HRRZ	AC0,.JBTPC	;[312] SEE IF ERROR IS
	CAIL	AC0,RSTLNK	;[312]  IN RSTLNK
	CAIL	AC0,RSTLNX	;[312]  ROUTINE.
	JRST	KILL		;[312] NO
	OUTSTR	[ASCIZ /$Failing routine is RSTLNK in CBLIO
MACRO routine loaded in place of COBOL subroutine?/] 
	JRST	KILL		;AND KILL

TRAP1:	OUTSTR	[ASCIZ/?LBLPDL Push-down-list overflow at /]
	JRST	TRAP0

KPROG.:	TTCALL	3,[ASCIZ "?LBLADP Attempt to drop off end of program."]
	JRST	KILL.

KDECL.:	TTCALL	3,[ASCIZ "?LBLADD Attempt to drop off end of DECLARATIVES."]
	JRST	KILL.

ILLC.:	TTCALL	3,[ASCIZ "?LBLRCL Recursive call."]
	JRST	KILL.

;GOTO IS THE ERROR EXIT FOR UNALTERED "GOTO"
;STATEMENTS WHICH DID NOT PROVIDE AN OBJECT PARAGRAPH NAME.

GOTO.:	OUTSTR	[ASCIZ /?LBLEUG Encountered an unaltered GOTO with no destination.
/]
				;FALL THRU
;KILL TYPES OUT THE LOCATION OF THE LAST COBOL VERB,
;STOPS ALL IO AND EXITS TO THE MONITOR.

KILL:	PUSHJ	PP,TYPSTS	;TYPE ERROR-NUMBER, BLOCK # + REC #
KILL.:
IFN LSTATS, SETOM MRKILL	;NOTE PROGRAM WAS ABORTED
	PUSHJ	PP,VEROUT	;TYPE THE VERSION NUMBER
	OUTSTR	[ASCIZ /
?/]
	SKIPE	TRAC1.		;[270] IS THIS A PRODUCTION PROGRAM (I.E. /P)?
	PUSHJ	PP,@TRAC1.	;NO, CALL BTRAC. IN TRACE ROUTINE
	PUSHJ	PP,PPOUT.	;TYPE THE LOCATION OF LAST COBOL VERB
	HRRZ	AC16,FILES.		;[444] GET START OF FILE TABLES
	JUMPE	AC16,STOPR2		;[444] NO FILES, DON'T BOTHER
KILL1:	MOVE	FLG,F.WFLG(I16)		;[444] GET FLAGS FOR THIS FILE
	TLNE	FLG,OPNOUT		;[622][444] OPEN FOR OUTPUT
	TLNE	FLG,OPNIN		;[622][444] YES, OPEN FOR OUTPUT ONLY
	SKIPA				;[1033] SKIP IF INPUT FILE
	JRST	KILL1A			;[1033] JUMP IF OUTPUT ONLY
	MOVE	AC13,D.DC(I16)		;[1033] GET DEV CHARACTERISTICS
	TXNE	AC13,DV.MTA		;[1033] MAG TAPE?
	JRST	KILL2A			;[1033] YES, DO ABORT CLOSE
	JRST	KILL4			;[444] NO, CHECK NEXT ONE
KILL1A:	MOVE	AC13,D.DC(I16)		;[1033][444] GET DEV CHARACTERISTICS
	TXNN	AC13,DV.DSK		;[444] DISK?
	JRST	KILL4			;[444] NO, TRY NEXT FILE
	SETZB	AC2,AC3			;[444]
	MOVE	AC10,[POINT 6,2]	;[444] SET UP TO PUT VID IN 2 AND 3
	MOVE	AC5,F.WVID(I16)		;[444] GET PTR TO VALUE OF ID
	PUSHJ	PP,OPNVID		;[444] GET IT INTO AC2 AN AC3
	HRRZ	AC1,FILES.		;[444] SET UP FOR SUB-LOOP
KILL2:	CAIN	AC16,(AC1)		;[444] COMPARING AGAINST ITSELF
	JRST	KILL3			;[444] YES, DON'T BOTHER
	MOVE	AC13,D.DC(AC1)		;[444] GET DEV CHARS
	TXNN	AC13,DV.DSK		;[444] IS IT A DISK?
	JRST	KILL3			;[444] NO, IGNORE
	MOVE	FLG,F.WFLG(AC1)		;[444] GET FLAGS
	TLNN	FLG,OPNIN		;[444] IS IT OPEN FOR INPUT
	JRST	KILL3			;[444] NO, CAN'T BE SUPERSEDING
	SETZB	AC14,AC15		;[444]
	MOVE	AC10,[POINT 6,14]	;[444] PUT VID IN 14 AND 15
	MOVE	AC5,F.WVID(AC1)		;[444] BYTE PTR TO VALUE OF ID
	PUSHJ	PP,OPNVID		;[444] GET IT
	CAMN	AC2,AC14		;[444] FILENAMES EQUAL?
	CAME	AC3,AC15		;[444] YES, EXTENSIONS EQUAL?
	JRST	KILL3			;[444] NO, FORGET IT
KILL2A:	LDB	AC4,DTCN.		;[1033][444] GET CHANNEL NUMBER
	LSH	AC4,27			;[444] POSITION IT
	MOVE	AC5,[CLOSE CL.RST]	;[444] SET UP A CLOSE
	ADD	AC5,AC4			;[444] ADD CHANNEL
	XCT	AC5			;[444] CLOSE FILE, DELETING NEW
					;[444] FILE, LEAVING OLD INPUT
	JRST	KILL4			;[444] GO CHECK ANOTHER ONE

KILL3:	HRRZ	AC1,F.RNFT(AC1)		;[444] GET ANOTHER FILE FOR SUB-LOOP
	JUMPN	AC1,KILL2		;[444] GO CHECK, IF ANY LEFT
KILL4:	HRRZ	AC16,F.RNFT(AC16)	;[444] GET ANOTHER FILE TO CHECK
	JUMPN	AC16,KILL1		;[444] GO CHECK IF ANY LEFT
	JRST	STOPR2
	;TYPE OUT SOME ERROR INFORMATION

TYPSTS:	OUTSTR	[ASCIZ /
$ Error-number = /]
TYPST1:	MOVE	AC0,FS.EN	;ERROR-NUMBER
	PUSHJ	PP,PUTDEC	;TYPE IT
	MOVE	AC0,FS.BN	;BLOCK-NUMBER
	JUMPE	AC0,TYPST2	;
	OUTSTR	[ASCIZ /   Block-number = /]
	PUSHJ	PP,PUTDEC	;
TYPST2:	MOVE	AC0,FS.RN	;RECORD-NUMBER
	JUMPE	AC0,RET.1	;
	OUTSTR	[ASCIZ /   Record-number = /]
	JRST	PUTDEC		;RETURN

	;STOPR. IS CALLED WITH A "PUSHJ PP,STOPR."  ALL FILES ARE
	;CLOSED VIA COBOL CLOSE UUOS AND A CALLI EXIT IS EXECUTED.

STOPR.:	HRRZ	AC16,FILES.	;LOOP THROUGH THE FILE TABLES
	JUMPE	AC16,STOPR2	;DONE
STOPR1:	HRLI	AC16,001040	;STANDARD CLOSE UUO
	MOVE	FLG,F.WFLG(I16)	;GET THE FLAGS
IFN ANS68,<
	TLNE	FLG,OPNIN+OPNOUT;  IF THE FILE IS OPEN
	PUSHJ	PP,C.CLOS	;  CLOSE IT
>;END IFN ANS68
IFN ANS74,<
	LDB	AC1,F.BRMS	; Get RMS flag bit
	JUMPN	AC1,STOP1C	;Jump if this is an RMS file.
	TLNE	FLG,OPNIN+OPNOUT;  Skip if the file is not open
	PUSHJ	PP,C.CLOS	;Close file
	JRST	STOPRA		;and continue

;Check RMS file to see if it is open
STOP1C:	HRRZ	AC1,D.F1(I16)	;Get flag bits
	TXNN	AC1,LF%INP!LF%OUT ;Is file open?
	 JRST	STOPRA		;No

	PUSH	PP,AC16		;SAVE AC16
	HRRZ	AC1,I16		;NO FLAG BITS,,FILTAB
	PUSH	PP,AC1		;STORE ARGLIST ON THE STACK
	MOVEI	AC16,(PP)	;POINT TO THE STACK ARG LIST
	PUSHJ	PP,CL.MIX##	;CALL RMS CLOSE
	POP	PP,(PP)		;THROW AWAY ARGLIST
	POP	PP,AC16		;RESTORE AC16
STOPRA:>;END IFN ANS74
	HRRZ	AC16,F.RNFT(I16);NEXT FILE
	JUMPN	AC16,STOPR1	;LOOP
STOPR2:	MOVE	AC0,FS.IEC	; NUMBER OF IGNORED ERRORS
	JUMPE	AC0,STOPR3	; NONE IGNORED
	OUTSTR	[ASCIZ /%LBLIGN /]	;
	CAIE	AC0,1		; ONLY ONE?
	JRST	STPR2A		; NO
	OUTSTR	[ASCIZ/ 1 error ignored./]
	JRST	STOPR3		; CONT
STPR2A:	PUSHJ	PP,PUTDEC	; TYPE NUMBER
	OUTSTR	[ASCIZ/ errors ignored./]

STOPR3:	PUSHJ	PP,@HPRT.##	; PRINT HISTORY REPORT IF ANY
IFN CSTATS,<
	SKIPE	METR.##		;WERE METER POINTS ENABLED?
	 PUSHJ	PP,WRTMET	;YES, WRITE THE FILE
>
IFN LSTATS,<
	PUSHJ	PP,MRDMPT	;DUMP ALL LSTATS DATA
>
IFN DBMS,<
	SKIPE	DBSTP.		;IGNORE IF BEFORE VERSION 12A
	PUSHJ	PP,@DBSTP.	;CLEANUP DBMS
>
	EXIT			;CALLI EXIT
	JRST	.-1		;For TOPS20: Stay stopped.

	; C.STOP IS CALLED WITH A "PUSHJ PP,C.STOP"  AFTER THE OPERATOR
	; TYPES "CONTINUE" IT RETURNS TO THE CALLING ROUTINE

C.STOP:	OUTSTR	[ASCIZ /
$ type CONTINUE to proceed .../]
	EXIT	1,		; WAIT FOR CONT
	POPJ	PP,		; 
	;TYPE THE VERSION NUMBER OF COBOL, LIBOL, SORT, DBMS, RMS, etc.
VEROUT:	PUSHJ	PP,OUTBF.	;DUMP THE CURRENT BUFFER TO SYNC WITH TTCALLS
IFN ANS68,<
	OUTSTR	[ASCIZ /
COBOL-68 /]
>
IFN ANS74,<
	OUTSTR	[ASCIZ /
COBOL-74 /]
>
	MOVE	AC12,COBVR.	;GET COBOL VERSION NUMBER
	PUSHJ	PP,VEROU0	;TYPE VERSION NUMBER IN STANDARD FORMAT
IFN ANS68,<
	OUTSTR	[ASCIZ /, LIBOL /]
>
IFN ANS74,<
	OUTSTR	[ASCIZ /, C74OTS /]
>
	MOVE	AC12,LIBVR.	;GET VERSION NUMBER
	PUSHJ	PP,VEROU0	;TYPE THE VERSION NUMBER IN STANDARD FORMAT
	SKIPE	AC12,SRTVR.	;GET SORT VERSION NUMBER
	PUSHJ	PP,[OUTSTR [ASCIZ /, SORT /]
		JRST	VEROU0]		;TYPE THE VERSION NUMBE IN STANDARD FORM
IFN DBMS,<
	SKIPE	AC12,DBMVR.##	;GET DBMS VERSION NUMBER
	PUSHJ	PP,[OUTSTR [ASCIZ /, DBMS /]
		JRST	VEROU0]		;TYPE THE VERSION NUMBER IN STANDARD FORM
>
IFN ANS74,<
	SKIPE	AC12,RMSVR.##	;GET RMS VERSION NUMBER
	PUSHJ	PP,[OUTSTR [ASCIZ /, RMS /]
		JRST	VEROU0]		;TYPE THE VERSION NUMBER IN STANDARD FORM
>
	JRST	DSPL1.		;"CRLF" AND EXIT
VEROU0:	ROT	AC12,3		;GET WHO FIELD OUT OF THE WAY
	MOVEI	AC0,3		;
	PUSHJ	PP,NUMOUT	;THE VERSION NUMBER
	LDB	AC1,[POINT 6,AC12,5] ;GET MINOR VERSION
	SOJL	AC1,VEROU2	;DON'T OUTPUT IF NULL
	IDIVI	AC1,^D26	;^D26="Z", ^D27="AA"
	JUMPE	AC1,VEROU1	; DON'T OUTPUT FIRST IF NULL
	PUSH	PP,AC2		;SAVE 2ND
	MOVEI	C,100(AC1)	;GET 1ST LETTER
	PUSHJ	PP,OUTCH.	;OUTPUT IT
	POP	PP,AC2
VEROU1:	MOVEI	C,101(AC2)	;GET 2ND LETTER
	PUSHJ	PP,OUTCH.	;OUTPUT IT
VEROU2:	MOVEI	AC0,6		;
	LSH	AC12,6		;SHIFT EDIT # INTO LEFT HALF
	TLNN	AC12,-1
	JRST	VEROU3		;DONE IF NO EDIT NUMBER
	MOVEI	C,"("		;
	PUSHJ	PP,OUTCH.	;
	PUSHJ	PP,NUMOUT	;THE EDIT NUMBER
	MOVEI	C,")"		;
	PUSHJ	PP,OUTCH.	;
VEROU3:	ROT	AC12,3		;GET WHO FIELD BACK IN RHS
	JUMPE	AC12,OUTBF.	;DON'T OUTPUT IF NULL
	MOVEI	C,"-"		;SEPARATE BY HYPHEN
	PUSHJ	PP,OUTCH.
	MOVEI	C,"0"(AC12)	;TURN INTO ASCII
	PUSHJ	PP,OUTCH.	;STORE
	JRST	OUTBF.		;OUTPUT AND RETURN

NUMOUT:	MOVEI	C,6		;HALF AN ASCII ZERO
	LSHC	C,3
	TRNN	C,7		;SKIP LEADING ZEROES
	SOJG	AC0,NUMOUT
	JUMPL	AC0,RET.1
	PUSHJ	PP,OUTCH.
	MOVEI	C,6
	LSHC	C,3
	SOJG	AC0,.-3
	LSHC	C,-3		;RESTORE LAST DIGIT
	POPJ	PP,
	; TYPES OUT THE LISTING'S LOCATION OF "PUSHJ PP,VERB"
	; OR THE PUSHJ'S RETURN ADR IF NO PUSHJ IS FOUND
	; (SBPSA.) NON-ZERO IF A SUBPROGRAM CALL IS ACTIVE
	;  LH IS (RH(17)) I.E. PUSH DOWN STACK
	;  RH IS ENTRY POINT'S ADDRESS
	;   ENTRY-1	SIXBIT /NAME-OF-ENTRY-POINT/
	;   ENTRY-2	LH: FIRST LOCATION OF CURRENT (SUB)PROGRAM
	;		RH: SIXBIT /SUBPROGRAM-NAME/


PPOUT.:	OUTSTR	[ASCIZ /Last COBOL verb called from /]
	HLRO	AC12,PP		; FIND THE BEG OF THE STACK
	ADD	AC12,PUSHL.	;  --
	SUBI	AC12,(PP)	;  --
	MOVNS	AC12		;  --
	SKIPE	AC11,SBPSA.	; THIS A SUBPROGRAM OR OVERLAY?
	HLRZ	AC12,AC11	; YES - GET FIRST ENTRY FROM HERE
	ADDI	12,1		; 12 HAS POINTER TO FIRST ENTRY ON STACK
	MOVEI	AC1,0		; ASSUME NO COBDDT
	SKIPE	CB.DDT		; ANY COBDDT?
	MOVEI	AC1,2		; YES - THERE ARE 2 ENTRIES ON LIST
	MOVE	AC2,LIBSW.	; GET MULTIPLE PERFORM FLAG
	TRNE	AC2,MPWC.S	; MULTIPLE-PERFORMS?
	ADDI	AC1,1		; YES - ANOTHER ENTRY ON PDLIST
	IMUL	AC1,LEVEL.	; ENTRIES PER LEVEL.
	ADD	AC12,AC1	; SKIP OVER COBDDT+PERF. STUFF
	HRRZ	AC12,(AC12)	; GET RETURN ADR MINUS ONE
	MOVEI	AC2,5		; LOOK BACK 5 LOCS FOR A PUSHJ
	MOVEI	AC1,-1(AC12)	; START AT THE RETURN ADR-1
PPOUT1:	HLRZ	AC3,(AC1)	; GET THE PUSHJ TO THE RIGHT HALF
	SUBI	AC1,1		; SET UP FOR NEXT COMPARE
	CAIE	AC3,(PUSHJ PP,)	; WHAT IS IT?
	SOJG	AC2,PPOUT1	; NOT A PUSHJ SO LOOP
	JUMPE	AC2,PPOUT2	; NOT THERE SO GIVE RET ADR-1
	HRRI	AC12,1(AC1)	; THE PUSHJ'S ADR
PPOUT2:	SKIPN	AC11,SBPSA.	; IF SUBPROGRAM
	MOVE	AC11,%F.PTR	; NO - MAIN PROGRAM
	HLRZ	AC11,-2(AC11)	; GET START ADR
	TRZ	AC11,400000	; TURN OFF BIT18 IF ON
	SUB	AC12,AC11	; GET OFFSET FROM HERE
	HRLOI	AC12,(AC12)	; XWD ADR,,-1
PPOUT4:	MOVEI	C,6		; HALF OF AN ASCII ZERO-60
	LSHC	C,3		; APPEND THE OCTAL NUMBER
	PUSHJ	PP,OUTCH.	; DEPOSIT IT IN THE TTY BUFFER
	TRNE	AC12,-1		; HAVE WE SEEN SIX NUMBERS?
	JRST	PPOUT4		; NO, LOOP
	PUSHJ	PP,OUTBF.	; DUMP IT NOW
PPOT4.:	OUTSTR	[ASCIZ/ in program /]

	SKIPN	AC3,SBPSA.	; SKIP IF ANY SUBPRGMS
	JRST	PPOUT6		; NONE
PPOUT5:	OUTSTR	[ASCIZ /
	/]
	HRRI	AC1,(AC3)	; GET ADR OF SUBPRG NAME
	HRL	AC1,-2(AC1)	;
	TLNE	AC1,-1		;
	HLRZS	AC1		; IF IT'S ZERO
	SUBI	AC1,1		; ITS SAME AS ENTRY POINT
	HRLI	AC1,(POINT 6)	; MAKE A BYTE-PTR
	MOVEI	AC4,6		; ONLY 6 CHARS PER NAME
	PUSHJ	PP,MSVID4	; TYPE IT
	OUTSTR	[ASCIZ / entry /]
	HRRI	AC1,-1(AC3)	; MAKE BYTE-PTR TO ENTRY POINT
	HRLI	AC1,(POINT 6)	; FINISH BYTE-POINTER
	MOVEI	AC4,6		; 6 IS MAX
	PUSHJ	PP,MSVID4	; TYPE IT
	OUTSTR	[ASCIZ / called from/]
	MOVS	AC3,AC3		; ANY MORE SUBPRGMS?
	SKIPE	AC3,(AC3)	; SKIP IF NOT
	JRST	PPOUT5		; THERE ARE
PPOUT6:	MOVE	AC1,%F.PTR	; GET THE PROGRAM NAME
	MOVEI	AC1,-1(AC1)	; THIS IS IT
	HRLI	AC1,(POINT 6)	; MAKE BYTE POINTER
	MOVEI	AC4,6		; NAME HAS 6 CHARS
	PUSHJ	PP,MSVID4	; DUMP THE NAME
	JRST	DSPL1.		; APPEND "CRLF", THEN EXIT
;	SUSPC: A SUBROUTINE THAT DETERMINES THE AMOUNT OF SPACE REQUIRED
;	FOR SIMULTANEOUS UPDATE, AND GETS IT. IT ALSO INITIALIZES THE
;	GLOBAL VARIABLES SU.RRT, SU.EQT, SU.DQT, SU.MQT,
;	AND SU.FBT TO POINT TO THE RETAINED RECORDS TABLE, THE ENQUEUE
;	TABLE, THE DEQUEUE TABLE, THE MODIFY TABLE, AND THE FILL/FLUSH
;	BUFFER TABLE.
;
;	ARGUMENTS:
;
;		AC14 CONTAINS THE ADDRESS OF A WORD CONTAINING THE
;		STARTING ADDRESS OF THE MAIN PROGRAM.
;
;	CHANGES:
;
;		AC0
;		AC1
;		AC2
;		AC3
;		WHATEVER GETSPC CHANGES
;
;	CALLS:
;
;		SUSPC1
;		GETSPC
;
;	ERRORS:
;
;		NOT ENOUGH SPACE AVAILABLE FOR SIMULTANEOUS UPDATE
;		REQUIREMENTS. IF THIS OCCURS, A MESSAGE IS SENT
;		TO TTY AND A JRST KILL. IS EXECUTED.

	EXTERN	SU.RRT, SU.EQT, SU.FBT, SU.DQT, SU.MQT

SUSPC:	HRRZ	AC1,0(AC14)	;GET STARTING ADDRESS OF MAIN PROGRAM

	SETZM	SU.RRT		;INITIALIZE GLOBAL VARIABLES
	SETZM	SU.EQT
	SETZM	SU.FBT
	PUSHJ	PP,SUSPC1	;EXAMINE THE MAIN PROGRAM AND ALL ITS
				;SUBPROGRAMS TO DETERMINE THE MAXIMUM
				;REQUIREMENTS FOR SIMULTANEOUS UPDATE
				;SPACE
	MOVE	AC0,SU.EQT	;[437]
	IMULI	AC0,4		;[437]
	ADD	AC0,SU.RRT	;[437] (THERE ARE FOUR ENQ/DEQ TABLES)
	ADD	AC0,SU.FBT
	JUMPE	AC0,RET.1	;RETURN IF NO SPACE REQUIRED

	PUSH	PP,.JBFF	;SAVE .JBFF ON THE STACK

	PUSHJ	PP,GETSPC	;GET THE SPACE, IF POSSIBLE

	JRST	SUERR		;JUMP IF NOT POSSIBLE
	POP	PP,AC1
	MOVE	AC2,AC1
	ADD	AC2,SU.RRT
	MOVEM	AC1,SU.RRT	;PUT RETAINED RECORDS TABLE AT ADDRESS
				;OF FORMER .JBFF

	MOVE	AC1,AC2		;PUT ENQ/DEQ TABLES AT END OF THE
				;RETAINED RECORDS TABLE
	ADD	AC2,SU.EQT
	MOVEM	AC2,SU.DQT
	ADD	AC2,SU.EQT
	MOVEM	AC2,SU.MQT
	ADD	AC2,SU.EQT
	MOVEM	AC1,SU.EQT
	MOVEM	AC2,SU.FBT	;PUT THE FILL/FLUSH BUFFER TABLE AT THE
				;END OF THE ENQ/DEQ TABLES

	POPJ	PP,		;WE'RE ALL DONE

SUERR:	OUTSTR	[ASCIZ"Not enough space available to meet the requirements of simultaneous update. Please relink to provide more space."]

	JRST	KILL.

;	SUSPC1: A SUBOUTINE TO DETERMINE THE MAXIMUM REQUIREMENT FOR SIMULTANEOUS
;	UPDATE SPACE OF A PROGRAM AND ITS SUBPROGRAMS
;
;	ARGUMENTS:
;
;		AC1: THE STARTING ADDRESS OF THE PROGRAM
;
;		IN THE %FILES AREA OF THE PROGRAMS THERE ARE THESE QUANTITIES:
;
;			%SURRT: THE SPACE REQUIRED BY THE PROGRAM FOR
;				THE RETAINED RECORDS TABLE
;
;			%SUEQT: THE SPACE REQUIRED BY THE PROGRAM FOR
;				EACH OF THE ENQ/DEQ TABLES
;
;			%SUFBT: THE SPACE REQUIRED BY THE PROGRAM FOR
;				THE FILL/FLUSH BUFFER TABLE
;
;	RESULTS:
;
;		SU.RRT IS SET TO THE MAX OF SU.RRT AND %SURRT IN THE
;			PROGRAM AND EACH OF ITS SUBPROGRAMS
;
;		SU.EQT IS SET TO THE MAX OF SU.EQT AND %SUEQT IN THE
;			PROGRAM AND EACH OF ITS SUBPROGRAMS
;
;		SU.FBT IS SET TO THE MAX OF SU.FBT AND %SUFBT IN THE
;			PROGRAM AND EACH OF ITS SUBPROGRAMS
;
;	CHANGES:
;
;		AC1
;		AC2
;		AC3
;
;	ASSUMPTIONS:
;
;		SU.RRT, SU.EQT, SU.FBT ARE INITIALIZED BEFORE THIS
;		ROUTINE IS CALLED THE FIRST TIME
;
;	NOTES:
;
;		THE ROUTINE CALLS ITSELF RECURSIVELY.

SUSPC1:	HRRZ	AC2,(AC1)	;CHECK TO SEE IF THIS SUBROUTINE IS IN
	JUMPN	AC2,RET.1	; A LINK-10 OVERLAY AREA.
				; ((AC1)) = SKIPA 0,0 <==> IT ISN'T
				; ((AC1)) = JSP 1,MUMBLE <==> IT IS.
	HRRZ	AC2,1(AC1)	;ADDRESS OF %FILES TO AC2
	HLRZ	AC3,(AC2)	;HAVE WE BEEN HERE BEFORE?
	JUMPE	AC3,RET.1	;YES, LEAVE.

	MOVE	AC3,%SURRT(AC2)	;SET SU.RRT TO MAX OF SU.RRT AND %SURRT
	CAMLE	AC3,SU.RRT
	MOVEM	AC3,SU.RRT
	MOVE	AC3,%SUEQT(AC2)	;SET SU.EQT TO MAX OF SU.EQT AND %SUEQT
	CAMLE	AC3,SU.EQT
	MOVEM	AC3,SU.EQT
	MOVE	AC3,%SUFBT(AC2)	;SET SU.FBT TO MAX OF SU.FBT AND %SUFBT
	CAMLE	AC3,SU.FBT
	MOVEM	AC3,SU.FBT
	HRRZS	(AC2)		;MARK THIS SUBPROGRAM AS DONE.
	HLRZ	AC2,1(AC1)	;GET ADDRESS OF SUBPROGRAM LIST

SUSPCX:	SKIPN	AC1,0(AC2)
	POPJ	PP,		;RETURN IF NO MORE SUBPROGRAMS

	PUSH	PP,AC2		;SAVE AC2 ON STACK

	PUSHJ	PP,SUSPC1	;CALL OURSELVES TO PROCESS SUBPROGRAM

	POP	PP,AC2		;RESTORE AC2
	AOJA	AC2,SUSPCX	;POINT TO NEXT SUBPROGRAM
SUBTTL	SEEK VERB

;A SEEK VERB LOOKS LIKE:
;FLAGS,,ADR	ADR = FILE TABLE ADDRESS
;CALL+1:	;POPJ RETURN

SEEK.:
IFN ANS68,<
	MOVE	FLG,F.WFLG(I16)	;FLAG REGISTER
	TLNE	FLG,RANFIL	;SKIP IF NOT A RANDOM FILE
	TLNN	FLG,OPNIN!OPNOUT ;SKIP IF RANDOM FILE IS OPEN
	POPJ	PP,		;EXIT TO ***ACP***
	HLRZ	I12,D.BL(I16)	;SET UP FOR FLIMIT
	PUSHJ	PP,FLIMIT	;CHECK THE FILE LIMITS
				;INVALID KEY RETURNS TO ***ACP***
	MOVE	AC1,AC4		;ACTUAL KEY
	PUSHJ	PP,SETCN.	;SET UP CHANNEL NUMBER
	XCT	USETI.		;
	XCT	USEEK.		;SEEK UUO
>
	POPJ	PP,		;EXIT TO  ***ACP***


	;FORCE A CALL TO RRDMP
RENDP:	SETOM	REDMP.		;
	JRSTF	@.JBOPC		;CONTINUE

	;RESTORE .JBSA, .JBREN - DESTROYED BY RERUN'S GETSEG

RSAREN:	HRR	AC2,RESET1
	HRRM	AC2,.JBSA
	MOVEI	AC2,RENDP
	MOVEM	AC2,.JBREN
	POPJ	PP,
SUBTTL	DISPLAY VERB

;CALLING SEQUENCE IS PUSHJ PP,DSPLY. WITH THE CALLING ARG-LIST IN AC 16.
;THE AC16'S EFFECTIVE ADDRESS CONTAINS A MODIFIED BYTE POINTER TO THE
;ASCII CHARACTER STRING.  MODIFICATIONS FOLLOW:
;	IF BIT 6 IS SET LEADING SPACES AND HOR-TABS ARE SUPPRESSED.
;	IF BIT 7 IS SET A "CRLF" IS APPENDED TO THE CHARACTER STRING.
;	BITS 8-17 CONTAIN THE NUMBER OF CHARACTERS TO BE DISPLAYED.
;THE ONLY ERROR EXIT IS A CALL TO C.STOP CAUSED BY "TELETYPE OUTPUT
;ERROR".  A NORMAL RETURN IS A POPJ PP,.
;MODIFIED ACS ARE: 15,11,7,6,AND 1.

;AC16=		;THE CALLING ARG-LIST
;AC15=		;BYTE POINTER
;AC6=		;CHARACTER COUNT
;AC1=		;TOPS-20 ONLY (LSTATS ALSO)
;AC2=		;LSTATS ARG REGISTER
;AC4=		;BLANK COUNTER (TO SUPPRESS TRAILING BLANKS)
;AC12		;MUST NOT BE USED

DOPFS.:	POINT	10,(I16),17	;DISPLAY OPERAND FIELD SIZE

DSPLY.:
IFN LSTATS,<
	MOVEI	AC2,MB.DSP	;INDICATE DISPLAY METER POINT
	PUSHJ	PP,MRACDP	;SET METER POINT (CLEARS AC2)
>
	SKIPE	TTYOPN		;IS THERE A TTY FILE OPEN?
	PUSHJ	PP,DSPTO	;YES, DUMP THE BUFFER BEFORE DISPLAYING
	MOVE	AC15,(I16)	;GET DISPLAY OPERAND
	MOVE	FLG,AC15	;SAVE IT FOR THE FLAGS
	LDB	AC6,DOPFS.	;NUMBER OF CHARS. TO BE DISPLAYED
	TLZ	AC15,7777	;
	TLO	AC15,700	;(AC15) IS BYTE POINTER TO CHARS.
	SETZ	AC4,		;CLEAR BLANK COUNTER
	TXNN	FLG,DIS%NM	;NUMERIC?, SUPPRESS LEADING SPACES AND TABS
	JRST	DSPL4		;NO
DSPL2:	ILDB	C,AC15		;GET A CHARACTER.
	JUMPE	C,DSPL3		;DON'T PASS NULLS BUT COUNT THEM
	CAIE	C," "		;SPACE
	CAIN	C,"	"	;OR TAB?
	JRST	DSPL3		;YES
	JRST	DSPL5		;NO, FIRST OUTPUT CHAR FOUND
DSPL3:	SOJG	AC6,DSPL2	;LOOP
	JRST	DSPL7		;END OF INPUT

DSPL4:	ILDB	C,AC15		;GET A CHARACTER
	JUMPE	C,DSPL6		;COUNT NULLS BUT DON'T OUTPUT THEM
	CAIN	C," "		;BLANK?
	AOJA	AC4,DSPL6	; YES, DON'T OUTPUT IF TRAILING BLANK
	JUMPE	AC4,DSPL5	;JUMP IF NO ACCUMULATED BLANKS
	PUSH	PP,C		; SAVE THIS NON-BLANK
	MOVEI	C," "		;THE BLANKS WE SAW WERE NOT TRAILING BLANKS
	PUSHJ	PP,OUTCH.	;  SO OUTPUT THEM
	SOJG	AC4,.-1		;[673]  REPLACE EDIT 651 
	POP	PP,C		;RESTORE THE CHARACTER AFTER THE BLANKS
DSPL5:	IDPB	C,TTOBP.	;DEPOSIT CHARACTER IN BUFFER
	SOSG	TTOBC.		;BUFFER FULL?
	PUSHJ	PP,OUTBF.	;YES
DSPL6:	SOJG	AC6,DSPL4	;LOOP
DSPL7:	TXNN	FLG,DIS%LF	;LAST FIELD?, APPEND CR-LF AT END?
	JRST	DSPL8		;[533] NO, JUST OUTPUT WHAT WE HAVE
DSPL1.:	MOVEI	C,$CR		;APPEND CR-LF
	PUSHJ	PP,OUTCH.	;	.
	MOVEI	C,$LF		;	.
	PUSHJ	PP,OUTCH.	;	.
	PUSHJ	PP,OUTBF.	;DUMP BUFFER
IFN LSTATS,<
	MRTME.	(AC1)		;END METER TIMING
>
	POPJ	PP,		; AND EXIT.

DSPL8:	JUMPE	AC4,DSPL8A	;[533] IF NO MORE TRAILING SPACES, EXIT
	MOVEI	C," "		;[533] GET ONE
	PUSHJ	PP,OUTCH.	;[533] AND OUTPUT IT
	SOJG	AC4,.-1		;[533] LOOP BACK FOR ALL SPACES
DSPL8A:	PUSHJ	PP,OUTBF.	; OUTPUT BUFFER AND EXIT
IFN LSTATS,<
	MRTME.	(AC1)		;END METER TIMING
>
	POPJ	PP,
;HERE FOR DISPLAY OF SIXBIT DATA

DSPL.6:
IFN LSTATS,<
	MOVEI	AC2,MB.DSP	;INDICATE DISPLAY METER POINT
	PUSHJ	PP,MRACDP	;SET METER POINT (CLEARS AC2)
>
	SKIPE	TTYOPN		;IS THERE A TTY FILE OPEN?
	PUSHJ	PP,DSPTO	;YES, DUMP THE BUFFER BEFORE DISPLAYING
	MOVE	AC15,(I16)	;GET DISPLAY OPERAND
	MOVE	FLG,AC15	;SAVE IT FOR THE FLAGS
	LDB	AC6,DOPFS.	;NUMBER OF CHARS. TO BE DISPLAYED
	TLZ	AC15,7777	;
	TLO	AC15,600	;(AC15) IS BYTE POINTER TO CHARS.
	SETZ	AC4,		;CLEAR BLANK COUNTER
	TXNN	FLG,DIS%NM	;NUMERIC?, SUPPRESS LEADING SPACES AND TABS
	JRST	DSPL64		;NO
DSPL62:	ILDB	C,AC15		;GET A CHARACTER.
	JUMPN	C,DSPL65	;OUTPUT FIRST NON-SPACE
	SOJG	AC6,DSPL62	;LOOP
	JRST	DSPL7		;END OF INPUT

DSPL64:	ILDB	C,AC15		;GET A CHARACTER
DSPL65:	ADDI	C," "		;CONVERT TO ASCII
	CAIN	C," "		;A BLANK?
	AOJA	AC4,DSPL67	; YES, DON'T OUTPUT TRAILING BLANKS
	JUMPE	AC4,DSPL66	;CHECK FOR BLANKS FOLLOWED BY NON-BLANKS
	PUSH	PP,C		; (YUP) OUTPUT BLANKS IN THE MIDDLE
	MOVEI	C," "
	PUSHJ	PP,OUTCH.
	SOJG	AC4,.-1		;[673] REPLACE 664 LEAVE AS IT WAS BEFORE
	POP	PP,C		;GET THE NON-BLANK CHAR BACK
DSPL66:	IDPB	C,TTOBP.	;DEPOSIT CHARACTER IN BUFFER
	SOSG	TTOBC.		;BUFFER FULL?
	PUSHJ	PP,OUTBF.	;YES
DSPL67:	SOJG	AC6,DSPL64	;LOOP
	JRST	DSPL7		;SEE IF CR-LF NEEDED

;HERE FOR ASCIZ TEXT

DSPL.7:
IFN LSTATS,<
	MOVEI	AC2,MB.DSP	;INDICATE DISPLAY METER POINT
	PUSHJ	PP,MRACDP	;SET METER POINT (CLEARS AC2)
>
	SKIPE	TTYOPN		;IS THERE A TTY FILE OPEN?
	PUSHJ	PP,DSPTO	;YES, DUMP THE BUFFER BEFORE DISPLAYING
;IFE TOPS20,<
	OUTSTR	(I16)		;OUTPUT THE TEXT STRING
;>
REPEAT 0,<			;ALTMODE COMES OUT AS DOLLAR SIGN
IFN TOPS20,<
	MOVEI	1,(I16)
	HRLI	1,(POINT 7,)	;BUILD BYTE PTR
	PSOUT%			;OUTPUT THE STRING
>;END IFN TOPS20
>;END REPEAT 0
	MRTME.	(AC1)		;END METER TIMING
	POPJ	PP,
DSPTO:	PUSH	PP,AC16		;SAVE AC16
	MOVE	AC16,TTYOPN	;GET FILE-TABLE ADR FOR ERROR ROUTINES
	PUSHJ	PP,SETCN.	;SETUP IO CHANNEL
	PUSHJ	PP,WRTOUT	;DUMP THE BUFFER
	POP	PP,AC16		;RESTORE
	POPJ	PP,		;EXIT

OUT6B.:	ADDI	C," "		;CONVERT A SIXBIT CHAR
OUTCH.:	IDPB	C,TTOBP.	;DEPOSIT CHAR. IN BUFFER.
	SOSLE	TTOBC.		;DUMP THE BUFFER?
	POPJ	PP,		; NO.

	;OUTPUT A TTY BUFFER.  ***POPJ***
OUTBF.: PUSH	PP,C		;[673] SAVE C
	SETZ	C,		;ASCIZ TERMINATOR
	IDPB	C,TTOBP.	;
	OUTSTR	TTOBF.		;DUMP THE BUFFER
REPEAT 0,<			;*** FIX DURING FIELD TEST ***
IFN TOPS20,<
	PUSH	PP,1
	MOVE	1,[POINT 7,TTOBF.]
	PSOUT%			;DUMP THE BUFFER
	POP	PP,1
>
>;END REPEAT 0
	TRNA			;WE HAVE C SAVED ALREADY
OUTBF1:	PUSH	PP, C		;SAVE C
	MOVE	C,[POINT 7,TTOBF.]
	MOVEM	C,TTOBP.	;INITIALIZE THE BYTE-POINTER
	MOVEI	C,^D132		;A 132 CHAR BUFFER
	MOVEM	C,TTOBC.	;INITIALIZE THE BYTE-COUNT
	POP	PP,C		;[673] RESTORE C
	POPJ	PP,		;

	;RETURN A CHARACTER IN C
	;IGNORE "CARRIAGE-RETURN"
	;SKIP EXIT IF NOT AN END-OF-LINE CHAR
	;POPJ IF EOL, EOL = LF, VT, FF OR ALT-MODE
GETCH.:	INCHWL	C		;[267] INPUT A LINE, FIRST CHAR TO C
	CAIN	C,$CR
	JRST	GETCH.
	CAIN	C,$ALT
	JRST	GETCH1
	CAIG	C,$FF
	CAIGE	C,$LF
	AOSA	(PP)
GETCH1:	MOVEI	C,$LF
	POPJ	PP,
SUBTTL	OPEN VERB

	;AN OPEN VERB LOOKS LIKE:
	;FLAGS,,ADR	WHERE ADR = FILE TABLE ADDRESS
	;OPN%OU 	OPEN FOR OUTPUT
	;OPN%IN		OPEN FOR INPUT
	;OPN%NR		DON'T REWIND
	;OPN%EX		[74] OPEN EXTENDED (APPEND FILOP.)
	;OPN%RV		[74] OPEN REVERSED
	;CALL+1:	POPJ RETURN


	;MAKE PRELIMINARY CHECKS:  ALREADY OPEN, OPTIONAL FILE PRESENT,
	;ANOTHER FILE USING SHARED BUFFER AREA  ***OPNDEV***

C.OPEN:

IFN LSTATS,<			;LIBOL METER TIMING
	SKIPE	F.WSMU(I16)	;SKIP TIME START IF SIM. UPDATE
	JRST	C.OMRX		;SKIP
	MRTMS.	(AC1)		;START OPEN TIMING
C.OMRX:>;END IFN LSTATS

	TXO	AC16,V%OPEN	;OPEN VERB
	MOVE	AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
	BLT	AC0,FS.IF	;   STATUS WORDS.
	SETOM	FS.IF		;IDX FILE IS DEFAULT

	MOVE	FLG,F.WFLG(I16)
	HLLZ	FLG1,D.F1(I16)	;MORE FLAGS
	HRRZ	AC0,D.RFLG(I16)	; GET FLAGS
; BL/10/27/80	TRO	AC0,AFTADV	; SET SO BFR-ADV WILL WRITE "CR" FIRST
	TRZ	AC0,AFTADV	;RESET SO BFR-ADV WILL NOT WRITE 'CR' FIRST ;BL
	HRRM	AC0,D.RFLG(I16)	; RESET IT
	LDB	AC0,F.BBLC	;[346] CHECK FLAG TO SEE IF THIS
	JUMPE	AC0,OOVLER	; FILE TABLE HAS BEEN LINKED TO THE CHAIN.
	TLNE	FLG,OPNIN+OPNOUT ;IS THE FILE OPEN?
	JRST	OPNFAO		;YES, ERROR
	SETZM	D.RP(I16)	;INITIALIZE THE RECORD SEQUENCE NUMBER
	SETZM	D.EXOF(I16)	; INITIALIZE THE RES SEQ OFFSET FOR SIXBIT
	LDB	AC5,F.BLF	;IS THE FILE IS LOCKED?
	JUMPN	AC5,OPNFAL	;YES, ERROR
	TXNE	AC16,OPN%OU	;SKIP IF NOT OUTPUT
	TLO	FLG,OPNOUT	;
	TXNE	AC16,OPN%IN	;SKIP IF NOT INPUT
	TLO	FLG,OPNIN	;
	TLNE	FLG1,FILOPT	;IS FILE OPTIONAL?
	JRST	OPNOP		;YES. RETURNS ONLY IF PRESENT
OPNSBA:	PUSHJ	PP,DEVIOW	;RESET THE DEVICE IOWD
IFN ANS68,<
	TLNE	FLG,RANFIL	;SKMFILE
	PUSHJ	PP,OPNSFL	;STORE THE FILE LIMITS SO HE CAN'T DIDDLE
>
	HLRZ	AC4,F.LSBA(I16)	;FILTAB THAT SHARES THE SAME BUFFER
OPNSB1:	JUMPE	AC4,OPNDEV	;JUMP IF NO ONE SHARES
	CAIN	AC4,(I16)	;HAVE WE CHECKED ALL "SBA" FILTAB'S
	JRST	OPNDEV		;YES

	LDB	AC1,[POINT 1,F.RMS(AC4),7] ;RMS BIT FOR THIS FILE
	JUMPN	AC1,OPNSB3	; JUMP IF THIS SBA FILE IS AN RMS FILE

; NON-RMS, V12B FILES:
	HLL	AC4,F.WFLG(AC4)	;GET THE FLAGS
	TLNE	AC4,OPNIN!OPNOUT	;SKIP IF ANY FILES ARE NOT OPEN
	JRST	OPNSB2		;GIVE AN ERROR MESSAGE
	JRST	OPNSB4		;OK FOR THIS FILE

; RMS FILES ONLY FOR V12B,
OPNSB3:	HRR	AC1,D.F1(AC4)	;GET V13 STYLE FLAGS FOR THIS FILE
	TXNE	AC1,LF%INP!LF%OUT	;IS THIS FILE OPEN?
	 JRST	OPNSB2		;YES, GIVE AN ERROR MESSAGE

OPNSB4:	HLRZ	AC4,F.LSBA(AC4)	;GET NEXT "SBA FILTAB"
	JRST	OPNSB1		;+LOOP

OPNSB2: MOVEI	AC0,^D12	;ERROR NUMBER
	PUSHJ	PP,OXITP	;DOESN'T RETURN IF IGNORING ERRORS
	MOVE	AC5,AC4		;MSOUT. USES AC4
	MOVE	AC2,[BYTE (5)10,31,20,2,1,14]
	PUSHJ	PP,MSOUT.
	HRLZI	AC2,(BYTE (5)10,31,20)
	HRR	AC16,AC5
	JRST	MSOUT.		;SOME OTHER FILE IS USING OUR BUFFER AREA

OOVLER: HRRZ	AC0,HLOVL.	;[346] GET START OF OVERLAY AREA
	CAIG	AC0,(I16)	;[346] IF FILE-TABLE IN OVL AREA
	JUMPN	AC0,OOVLE1	;[346] COMPLAIN
	MOVEI	AC0,^D30	;ERROR NUMBER
	PUSHJ	PP,OXITP	;POPJ TO MAIN LINE IF IGNORING ERRORS
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ "Attempt to do I/O from a subroutine called by a non resident subroutine."]	;[346]
	JRST	OOVLE2		;[346]

OOVLE1:	MOVEI	AC0,^D31	;ERROR NUMBER
	PUSHJ	PP,OXITP	;POPJ IF IGNORING ERRORS
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /IO cannot be done from an overlay./]	;[346]
OOVLE2:	HRLZI	AC2,(BYTE (5)10,2)	;[346] GO COMPLAIN
	PUSHJ	PP,MSOUT.	;[346] DOESN'T RETURN
OPNOP:	TLNE	FLG,OPNOUT	;SKIP IF NOT OUTPUT
	JRST	OPNSBA		;OUTPUT FILES ARE NOT OPTIONAL
	PUSHJ	PP,$SIGN	;[277] OUTPUT "$" FOR .OPERATOR
	OUTSTR	[ASCIZ /Is /]	;OPTIONAL FILE PRESENT?
	PUSHJ	PP,MSFIL.
	OUTSTR	[ASCIZ / present? .../]
	PUSHJ	PP,YES.NO	;SKIP RETURN IF "NO" ANSWER
	JRST	OPNOP1		;YES
	TLO	FLG,NOTPRS	;NO, "NOT PRESENT"
	TLZ	FLG,OPNIN	;NOTE THAT IT'S NOT OPEN
	MOVEM	FLG,F.WFLG(I16)	;%SAVE THE FLAG WORD
	POPJ	PP,		;RETURN TO MAIN LINE *EXIT************

OPNOP1:	TLNN	FLG,IDXFIL	;ISAM FILE?
	JRST	OPNSBA		;NO
	MOVE	AC1,D.OPT(I16)	;WERE THE BUFFERS SETUP AT RESET TIME?
	AOJN	AC1,OPNSBA	;EXIT HERE IF THEY WERE
	MOVEI	AC0,^D29	;ERROR NUMBER
	PUSHJ	PP,OXITP	;DOESN'T RETURN IF IGNORING ERRORS
	OUTSTR	[ASCIZ /Either the ISAM file does not exist or
 the VALUE OF ID changed during the program./] ;[374]
	PUSHJ	PP,KILL		;AND DONT RETURN

YESNO:	CLRBFI			;CLEAR THE BUFFER
	OUTSTR	[ASCIZ /$ Type YES or NO.
/]
YES.NO:	MOVE	AC5,[POINT 7,[ASCIZ /ES/],]
	PUSHJ	PP,GETCH.
	  JRST	.-1

	CAIE	C,"Y"
	CAIN	C,"Y"+40	;ALLOW LOWERCASE
	 CAIA			;LOOKS LIKE "YES" SO FAR..
	JRST	YESNO2		;DIDN'T START WITH "Y", TRY "NO"
YESNO1:	PUSHJ	PP,GETCH.
	  POPJ	PP,		;IS THE "YES" RETURN
	ILDB	AC4,AC5
	JUMPE	AC4,YSNOFN	;[564] [V10] YES FOUND, EAT INPUT UNTIL EOL
	CAIE	C,(AC4)		;IS THIS A "YES" CHARACTER?
	CAIN	C,40(AC4)	; CHECK LOWER-CASE CHARACTER TOO
	 JRST	YESNO1		;YES, KEEP CHECKING AS LONG
				; AS HE SPELLED IT OUT
	JRST	YESNO		;NO, GO ASK AGAIN

YESNO2:	MOVE	AC5,[POINT 7,[ASCIZ /NO/],]
YESNO3:	ILDB	AC4,AC5
	JUMPN	AC4,YESNO4	;[564] [V10] CHECK NEXT 'NO' CHAR,IF GOT ONE
	AOS	(PP)		;[564] ELSE, GIVE SKIP RETURN
YSNOFN:	PUSHJ	PP,GETCH.	;[564] GET ANOTHER CHAR
	 POPJ	PP,		;[564] GOT EOL, RETURN
	JRST	YSNOFN		;[564] EAT CHARS UNTIL EOL

YESNO4:	CAIE	C,(AC4)		;SKIP IF A "NO" CHARACTER
	CAIN	C,40(AC4)	; CHECK LOWERCASE ALSO
	 CAIA			;SO FAR, SO GOOD
	JRST	YESNO		;?BAD INPUT, GO PROMPT AGAIN
	PUSHJ	PP,GETCH.
	  JRST	RET.2		;THE NO RETURN
	JRST	YESNO3
	;SETUP DEVICE IOWD
DEVIOW:	HRLOI	AC0,77		;
	AND	AC0,F.WDNM(I16)	;
	TLC	AC0,-1		;
	AOBJP	AC0,.+1		;
	HRR	AC0,F.WDNM(I16)	;
IFN ISAM,<
	TLNE	FLG,IDXFIL	;IF INDEX FILE
	AOBJP	AC0,.+1		;  POINT AT DATA DEVICE
>
	MOVEM	AC0,D.ICD(I16)	;
	POPJ	PP,		;

IFN ANS68,<
	;SET THE FILE LIMIT CLAUSES IN THE FILE-TABLE.  ***POPJ***

OPNSFL:	LDB	AC5,F.BNFL	;NUMBER OF FILE LIMIT CLAUSES
	JUMPE	AC5,RET.1	;RETURN IF NONE
	MOVNS	AC5		;
	HRL	AC1,AC5		;
	HRRI	AC1,F.WLHL(I16)	;IOWD NUMBER OF,, FILE LIMIT
	HLR	I12,D.BL(I16)	;PICK UP THE BUFFER LOCATION
	MOVEM	AC1,R.FLMT(I12)	;

OPNSF1:	MOVE	AC5,(AC1)	;LIMIT,,LIMIT
	MOVE	AC6,(AC5)	;
	MOVSS	AC5		;
	MOVE	AC4,(AC5)	;
	CAMLE	AC4,AC6		;SKIP IF AC4 IS THE LOW LIMIT
	EXCH	AC4,AC6	;
	MOVEM	AC4,1(AC1)	;LOW LIMIT
	MOVEM	AC6,2(AC1)	;HIGH LIMIT
	ADDI	AC1,2		;ACCOUNT FOR TWO WORDS
	AOBJN	AC1,OPNSF1	;GO AGAIN IF YOU CAN
	POPJ	PP,		;
>
	;GET DEVICE CHARACTERISTICS AND CHECK IF DEVICE CAN DO
	;REQUESTED IO FUNCTIONS  ***OPNCHN***
	;ENTRY POINT FOR READ GENERATED CLOSE GENERATED OPEN.  ***READEF+N***

OPNDEV:	SETZM	D.OE(I16)	;CLEAR NUMBER OF OUTPUTS
	SETZM	D.IE(I16)	;  NUMBER OF INPUTS
	PUSHJ	PP,DEVCHR	;GET THE DEVICE CHAR.
	TXNN	AC13,DV.AVL	;SKIP IF AVAILABLE TO JOB
	JRST	OPNDNA
	TXNN	AC13,DV.DSK	;SKIP IF A DSK
	TRNN	AC13,DV.ASP	;SKIP IF DEV IS INITED
	JRST	OPNDE5
	MOVE	AC2,[BYTE (5)10,2,4,20,16]	;FCBO,DIATAF.
	MOVEI	AC0,^D14	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

OPNDE5:
	TXNN	AC16,OPN%EX	; OPEN EXTEND?
	JRST	OPNDE6		; NO
	TLNN	FLG,IOFIL	; DUMP MODE FILE?
	JRST	OPDE5A		; NO, CONT

	; YES, ERROR, RESET TIME BUFFER ALLOCATION CAUSES TROUBLE
	; HERE, WANTS BOTH DUMP MODE AND RING BUFFERS

	MOVEI	AC0,^D55	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Program may not have OPEN I-O and OPEN EXTEND for same file FD./]
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.	;DOESN'T RETURN

OPDE5A:	HRRZ	AC0,D.RFLG(I16)	; YES,GET RUN FLAGS
	TRO	AC0,EXTOPN	; SET OPEN WAS EXTEND
	HRRM	AC0,D.RFLG(I16)	; AND PUT IT BACK
	TXNE	AC13,DV.MTA	;MTA?
	TLZ	FLG1,STNDRD!NONSTD	;YES, DON'T CREATE A NEW LABEL

OPNDE6:	TLNE	FLG,IOFIL	;[622] SKIP UNLESS IO TYPE FILE (DUMP MODE)
	JRST	OPNDE7		;IO REQUESTED

OPND6A:	TXNN	AC16,OPN%EX	; OPEN EXTEND?
	TLNE	FLG,OPNIN	; OR INPUT ?
	TXNE	AC13,DV.IN	; YES,SKIP IF DEVICE CANNOT DO INPUT
	JRST	OPNDE8		;NEXTEST
	MOVE	AC2,[BYTE (5)10,2,4,20,21]
	MOVEI	AC0,^D16	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

OPNDE8:
	TXNN	AC16,OPN%EX	; OPEN EXTEND
	TLNE	FLG,OPNOUT	; OR OUTPUT?
	TXNE	AC13,DV.OUT	; YES,SKIP IF DEVICE CANNOT DO OUTPUT
	JRST	OPNCHN		; OK,FIND A FREE CHAN
	MOVE	AC2,[BYTE (5)10,2,4,20,22]
	MOVEI	AC0,^D17	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

OPNDE7:	TXNE	AC13,DV.DSK	;SKIP IF DEVICE IS NOT A DSK
	JRST	OPNCHN		;FIND A FREE CHANNEL
	MOVE	AC2,[BYTE (5)10,2,4,20,17]
	MOVEI	AC0,^D15	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN
DEVCHR:	MOVE	AC13,D.ICD(I16)	;ADR OF DEV. NAME
	MOVE	AC13,(AC13)	;SIXBIT/DEVICE NAME/
	MOVEM	AC13,UOBLK.+1	;FOR OPEN
	DEVCHR	AC13,		;DEVCHR UUO
	TXC	AC13,DV.DSK!DV.CDR	;[330] IF A DSK AND A CDR
	TXCN	AC13,DV.DSK!DV.CDR	;[330] THEN ITS DEVICE 'NUL'
	TXZ	AC13,DV.MTA!DV.TTY	;[506] SO ITS NOT A MTA OR TTY
DEVCH1:	MOVEM	AC13,D.DC(I16)	;[330] SAVE THE CHARACTERISTICS
	JUMPN	AC13,RET.1
	MOVE	AC2,[BYTE (5)10,2,4,20,13]	;FCBO,DINAD.
	POP	PP,(PP)		;POP OFF THE RETURN
	MOVEI	AC0,^D18	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN
	;FIND A FREE DEVICE CHANNEL AND SETUP THE BUFFERS
	;XCT OPEN, INBUF AND/OR OUTBUF  ***OPNBSI***

OPNCHN:	PUSHJ	PP,GCHAN	;LOAD AC5 WITH A CHANNEL NUMBER
	DPB	AC5,DTCN.	;SAVE IT
IFN ISAM,<
	TLNN	FLG,IDXFIL	;INDEX FILE ?
	JRST	OPNCH1		;NO
	PUSHJ	PP,GCHAN	;
	HLRZ	I12,D.BL(I16)	;
	HRRZM	AC5,ICHAN(I12)	;SAVE INDEX FILE CHAN NO.
>
OPNCH1:	PUSHJ	PP,SETC1.	;DISTRIBUTE THE CHANNEL NUMBER
	TLNE	FLG,DDMASC	;SKIP IF NOT ASCII
	TDZA	AC6,AC6		;ASCII MODE AND SKIP
	MOVEI	AC6,.IOBIN	;PERHAPS BINARY
	TLNE	FLG,RANFIL!IOFIL!IDXFIL ;[622] SKIP IF BUFFERED IO
	MOVEI	AC6,.IODMP	;DUMP MODE
	HRRM	AC6,UOBLK.	;UOBLK.+1 SET AT DEVCHR
IFE TOPS20,<
	PUSHJ	PP,OPNCKP	;SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE
>
	HRLI	AC6,D.OBH(I16)	;OUTPUT BUFFER HEADER
	HRRI	AC6,D.IBH(I16)	;INPUT BUF HDR
	MOVEM	AC6,UOBLK.+2
IFN ISAM,<
	TLNN	FLG,IDXFIL	;ISAM ?
	JRST	OPNCH3		;NO
	MOVE	AC1,F.WDNM(I16)	;ADR
	MOVE	AC1,(AC1)	;IDX DEVICE NAME
	MOVEM	AC1,UOBLK.+1	;
OPNCH3:>

	TXNN	AC16,OPN%EX	;OPEN EXTENDED?
	JRST	OPNC3A		; NO

OPNC3B:	PUSHJ	PP,OPNFOP	; [431] YES OPEN FILE VIA FILOP
	 JRST	OFERRI		; [576] [431] ERROR RETURN
	JRST	OPNC41		; CONT NORMALLY

OPNC3A:				;[1066]
IFN TOPS20,<			;[1066]
	TXNE	AC13,DV.MTA	;[1066] IS IT AN MTA
	TLNN	FLG1,MSTNDR	;[1066]  AND MONITOR IS LABELING?
	SKIPA			;[1066]  NO
	JRST	OPNC3C		;[1066]  YES, OPEN FILE USING FILOP
>				;[1066]
	SKIPN	F.WSMU(I16)	;[1066] SKIP IF SIMULTANEOUS UPDATE
	 JRST	OPNC31		; NO, CONT
IFE TOPS20,<
	JRST	OPNC3B		; OPEN VIA FILOP
>
IFN TOPS20,<
OPNC3C:	PUSHJ	PP,OCPT		; [431] OPEN FILE VIA DEC-SYS-20 COMPT.
IFN ANS74,<
	  JRST	OCPER		; ERROR FOR 74,FNF IS ALSO ERROR
>
IFN ANS68,<
	  TRNA			;ERROR, CHECK FOR FNF
>
	JRST	OPNC41		; CONT NORMALLY, ALL OK

IFN ANS68,<
	TLNE	FLG,IDXFIL	;IS IT AN ISAM FILE
	JRST	OCPER		;YES, GIVE THE ERROR
	CAIG	AC1,GJFX21	;IS IT ONE OF FILE NOT FOUND
	CAIGE	AC1,GJFX17
	CAIN	AC1,GJFX24
	JRST	OPNFNF		;YES FNF!!
	CAIE	AC1,GJFX32	;STILL MORE FNF POSSIBILITIES
	CAIN	AC1,OPNX2	;LAST ONE TO CHECK FOR
	JRST	OCPER		;NOT FNF, SCREW IT

OPNFNF:	MOVX	AC1,GJ%SHT	;DO FILE CREATE OPEN
	MOVEM	AC1,CP.BK1
	MOVE	AC1,[10,,CP.BLK]
	COMPT.	AC1,		;DO IT
	 JRST	OCPER		;FAILED AGAIN, SCREW IT
	JRST	OPNC41		;GOOD CONTINUE WITH NEW FILE
  >;END IFN ANS68
>;END IFN TOPS20
OPNC31:
IFN TOPS20, <
	SKIPGE	MNTR5##		;[1102] IF NOT AT LEAST V5.0 OF MONITOR,
	JRST	OPNC40		;[1102] NO UNRESTRICTED READ
	TLNN	FLG,OPNOUT	;[667] IF INPUT (READ) ONLY
	TXNN	AC13,DV.DSK	;[667] FOR A DSK FILE
	TRNA			;[667] NO
	JRST	OPNC3C		;[667] YES, USE COMPT. WITH OF%RDU ON
OPNC40:				;[1102] 
>; END TOPS20			;[1102]
IFE TOPS20,<
	TXNN	AC13,DV.MTA	; SKIP IF A MTA
	JRST	OPC31X		; ELSE CONT

	; IF PULSAR LABEL PROCESSOR IS UP AND WE'RE NOT BYPASSING
	; LABELS THEN LET PULSAR DO THE LABELING. IF BYPASS LABELS
	; IS ON THEN LIBOL WILL DO LABELING AS ALWAYS.

	SKIPN	AUTOLB		; DO WE HAVE AUTO LABEL PROCESSING?
	JRST	OPC31X		; NO
	PUSHJ	PP,MTALAB	; GET LABEL INFORMATION (AC3 GETS LABEL TYPE)
	  JRST	OPC31X		; NO SYS LABELS,LEAVE IT AS IT IS, 
	LDB	AC3,F.BLBT	; GET LABEL TYPE
	CAIE	AC3,.TFLNL	; UNLABELED?
	JRST	OPC31L		; NO, SYS-LABELS, CLEAR COBOL LABELING
	TLO	FLG1,MTNOLB	; YES, SET IT TO INDICATE SO
	HLLM	FLG1,D.F1(I16)	; SAVE IT FOREVER
	JRST	OPC31X		; CONT
OPC31L:	TLZ	FLG1,STNDRD!NONSTD ; SYS LABELS,THEN LET PULSAR DO LABELS
	CAIE	AC3,.TFLNS	; "NON-STANDARD"?
	TLO	FLG1,MSTNDR	; NO, SET MONITOR DOING LABELING
	HLLM	FLG1,D.F1(I16)	; SAVE IT FOREVER
	TLNN	FLG1,MSTNDR	; WAS THAT SYS-LABELS?
	JRST	OPC31X		; NO, CONT WITHOUT CHECKS
	TLNE	FLG,OPNOUT	; AND OPEN OUTPUT?
	JRST	OPC31X		; YES, CONT
				; NO,CHECK INPUT LABEL

	; HERE FOR OPEN INPUT

OPC31F:	LDB	AC1,F.BFMT	; GET LABEL FORMAT BITS
	TXNE	AC1,FRMATU	; "U" FORMAT?
	JRST	OPC31J		; YES, NO CHECKS NECESSARY
	CAIE	AC3,.TFLAL	; IS THE LABEL TYPE ANSI
	CAIN	AC3,.TFLAU	; OR ANSI WITH USER LABELS?
	JRST	OPC31H		; YES,JUMP

	; ASSUME IBM LABELS HERE

	TXNE	AC1,FRMATS	; IS IT "S" FORMAT?
	JRST	RERE6		; YES, ERROR SPANNED EBCDIC NOT SUPPORTED
	TXNN	AC1,FRMATD	; IS IT "D" FORMAT?
	JRST	OPC31I		; NO,CONT
	JUMPL	FLG1,OPC31X	; JUMP IF VARIABLE EBCDIC, OK
	JRST	OMTA0E		; ERROR, WRONG FORMAT FOR RECORDING MODE
	; HERE IF "F" FORMAT, DDM MUST MATCH

OPC31I:	JUMPL	FLG1,OMTA0E	; IF VARIABLE EBCDIC, ERROR
	JRST	OPC31X		; ELSE OK,CONT

	; HERE FOR ANSI LABELED INPUT, CHECK FORMATS

OPC31H:	TXNE	AC1,FRMATS+FRMATD ; IS IT "D" OR "S" FORMAT?
	JRST	OPC31K		; YES,ERROR JUMP

	; OPEN INPUT ANSI-LABELED "F FORMAT"
	; MAKE SURE COMPATIBLE DATA MODE IS SET

	JUMPGE	FLG,OMTA0E	; ERROR IF NOT ASCII RECORDING MODE
	PUSHJ	PP,CMPASC	; NO,MAKE SURE WE GET COMPATIBLE ASCII
	JRST	OPC31X		; CONT

; CMPASC	ROUTINE TO MAKE SURE COMPATIBLE ASCII WILL BE WRITTEN
;		FOR ANSI LABELED TAPES ON TOPS 10 (F FORMAT)
; RETURNS	+1 ALWAYS

CMPASC:	PUSHJ	PP,TM03AS	; ENSURE COMPATIBLE DATA MODE
	HRRZ	AC0,D.RFLG(I16)	; GET RUNTIME FLAGS
	TRNE	AC0,INDASC	; IND-ASC?
	POPJ	PP,		; YES, RETURN, IND-CMP MODE SET LATER
	PUSHJ	PP,STDASC	; NO, SET ANSI ASCII MODE
	TROA	AC0,INDASC	; ERROR SET INDASC MODE AND SKIP
	POPJ	PP,		; OK, RETURN
	HRRM	AC0,D.RFLG(I16)	; RESET (IF CHANGED)
	POPJ	PP,		; RETURN

OPC31K:	MOVE	AC0,[E.MTAP+^D54] ; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /ANSI labeled "S" and "D" format mag tape not supported./]
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.	;DOESN'T RETURN

	; HERE IF OPEN INP ANSI LABELED "U FORMAT"

OPC31J:	HRRZ	AC0,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNN	AC0,SASCII	; DOES HE WANT IT?
	TRZ	AC0,INDASC	; NO, CLEAR ANY INDASC SETTING DONE AT RESET 
	HRRM	AC0,D.RFLG(I16)	; PUT IT BACK
	JRST	OPC31X		; CONT
OPC31X:

> ;END OF IFE TOPS20

	PUSHJ	PP,SETBM	;SET BYTE MODE IF REQUIRED
	XCT	UOPEN.		;OPEN THE DEVICE ***************
	  JRST	OERRIF		;OPEN FAILED
OPNC41:	PUSHJ	PP,OPNWPB	;RETS LOGICAL BLOCK SIZE IN AC10, BLKFTR IN AC5
	LDB	AC6,F.BNAB	;NUMBER OF ALTERNATE BUFFERS (FOR INBUF X,2(AC6))
IFE TOPS20,<			;[561]
	TXNE	AC13,DV.MTA	;SKIP IF NOT A MTA
>				;[561]
IFN TOPS20,<
	TXNE	AC13,DV.MTA	;[561][1066] MTA??
	TLNE	FLG1,MSTNDR	;[1066]  MTA IS UNLABELED TAPE?
	JRST	OPNC4X		;[561] NO,SKIP FOLLOWING ENTER/LOOKUP
	TXNE	AC16,OPN%EX	; OPEN EXTEND?
	JRST	OPNC4D		; YES,SKIP THIS
	PUSH	PP,AC5		;[561] YES,SAVE REGS
	PUSH	PP,AC6		;[561] 
	PUSH	PP,AC10		;[561] 
	TLNN	FLG,OPNIN	;[561] OPEN FOR INPUT?
	JRST	OPNC4A		;[561] NO
	PUSHJ	PP,OPNLID	;[561] YES,SET UP FOR LOOKUP
	XCT	ULKUP.		;[561] LOOKUP
	  JRST	OLERR		;[561] ERROR IN LOOKUP
	JRST	OPNC4F		;[561] RESTORE AND CONT

OPNC4A:	PUSHJ	PP,OPNEID	;[561] SET UP FOR ENTER
	XCT	UENTR.		;[561] ENTER
	  JRST	OEERR		;[561] ERROR IN ENTER
OPNC4F:	POP	PP,AC10		;[561] RESTORE AC'S
	POP	PP,AC6		;[561] 
	POP	PP,AC5		;[561] 
OPNC4D:
>;END IFN TOPS20
	JUMPN	AC5,OPNNSB	;[561] NON STANDARD BUFFER SETUP
OPNC4X:				;[561]
IFN ISAM,<
	TLNE	FLG,IDXFIL	;ISAM ?
	JRST	OPNIDX		;YES
>
	TLNE	FLG,IOFIL+RANFIL ;[622] IOFIL=IOFILE
	JRST	OPNRIO		;RANDOM OR IO DUMP MODE BUFFERS
	PUSH	PP,.JBFF
	HLRZ	AC11,D.BL(I16)	;BUFFER LOCATION
	MOVEM	AC11,.JBFF
	CAIN	AC6,77		; [414] REALLY WANTS ONE?
	SETOI	AC6,		; [414] YES, ONE BUFFER.
	TXNE	AC16,OPN%EX	;APPEND?
	JRST	OPNC45		;YES, DO FILOP NOW
	TLNE	FLG,OPNIN	;INPUT?
	XCT	UIBUF.		;**********
	TLNE	FLG,OPNOUT	;OUTPUT?
	XCT	UOBUF.		;**********
	JRST	OPNC46

OPNC45:	MOVEI	AC1,2(AC6)	;GET NO. OF BUFFERS
	HRLZM	AC1,FOP.BN##	;SET FOR OUTPUT
	PUSHJ	PP,OPNEXT	; DO THE APPEND OPEN
	LDB	AC0,F.BBKF	; GET BLOCKING FACTOR
	JUMPE	AC0,OPNC46	; CONTINUE IF NOT BLOCKED
	MOVEM	AC0,D.RCL(I16)	; SET NUMBER RECORDS IN LOG BLOCK	
	MOVE	AC1,ARGBK.+.RBSIZ ; GET FILE SIZE RETURNED BY FILOP
	MOVE	AC3,D.BPL(I16)	; GET NUMBER OF BUFFERS PER LOG-BLK
	IMULI	AC3,DSKBSZ	; CALC NUMBER WORDS PER LOG-BLK (FULL BLKS)
	IDIVI	AC1,(AC3)	; CALC NUMBER OF LOG-BLKS, LEAVING REMAINDER IN
				; AC2 INDICATING THE NUMBER OF WORDS IN THE
				; CURRENT LOG-BLK.
	JUMPGE	FLG1,OPC45A	; CONT IF NOT VARIABLE LENGTH EBCDIC
	MOVEI	AC3,-2(AC2)	; NUMBER OF WORDS WRITTEN IN LOG-BLK
				; TAKE CARE OF POSSIBLE LAST PARTIAL WORD (-1)
				; AND THE BDW (-2)
	IMULI	AC3,4		; CALC NUMBER OF CHARS IN LOG-BLK
	SUB	AC3,D.TCPL(I16)	; CALC NUMBER OF FREE CHARS
	MOVNM	AC3,D.FCPL(I16)	; SET NUMBER OF CHARS LEFT IN LOG-BLK
OPC45A:	IDIVI	AC2,DSKBSZ	; CALC NUMBER OF FULL BUFFERS IN THIS LOG BLK
				; THAT HAVE ALREADY BEEN WRITTEN (IN AC2)
	MOVE	AC3,D.BPL(I16)	; CALC NUMBER OF BUFFS LEFT
	SUBI	AC3,(AC2)	; IN THE CURRENT LOG-BLK
	MOVEM	AC3,D.BCL(I16)	; AND RESET
	JUMPL	FLG1,OPNC46	; VAR LENGTH EBCDIC ENDS NOW

	IMULI	AC2,DSKBSZ	; CALC NUMBER OF WORDS OF FULL BUFFERS WRITTEN
	TLNE	FLG,DDMEBC!DDMASC ; IF ASCII OR IF EBCDIC
	JRST	OPC45B		; WE WANT THE CHARACTER CASE
	MOVE	AC1,D.WPR(I16)	; FOR SIXBIT AND BINARY
	JRST	OPC45C		; USE WORDS PER RECORD

OPC45B:	MOVE	AC1,D.CPR(I16)	; GET CHARS  PER RECORD (INCLUDING OVERHEAD)
				; ***NOTE***
				; THIS WILL ASSUME THAT NOT VARIABLE LENGTH
				; RECORDS IN THE BUFFERS PERVIOUS TO THIS ONE
	IMUL	AC2,D.BPW(I16)	; CALC CHARS IN FULL BUFFERS


OPC45C:	IDIVI	AC2,(AC1)	; CALC RECORDS IN FULL BUFS OF LOG-BLK
		
	SUB	AC2,D.RCL(I16)	; RESET THE
	MOVNM	AC2,D.RCL(I16)	; NUMBER OF RECORDS LEFT IN LOG-BLK

	PUSHJ	PP,EXTSCN	; SCAN THE CURRENT BUFFER TO CALC
				; NUMBER OF RECORDS LEFT IN LOG-BLK

	JRST	OPNC46		; AND CONTINUE


	; OPNEXT ASSUMES FOP.BK SET FOR BUFFER NUMBER
	; IT SETS UP AND EXECUTES THE APPEND FILOP, AND ADJUSTS
	; THE BYTE COUNT FOR THE BUFFER READ IN, TO REFLECT 
	; THE CURRENT BYTE SIZE.

OPNEXT:
	TXNN	AC13,DV.MTA	; SKIP IF MAG TAPE
	JRST	OPNEX0		; ELSE CONT

	; HERE WE MUST CHECK FOR PROPER DENSITY, PARITY AND DATA MODE FOR
	; THE APPEND FILOP.

	LDB	AC0,F.BPAR	; GET THE PARITY INDICATED IN THE PROGRAM
	DPB	AC0,[POINT 1,FOP.IS,26] ; SET IT IN THE FILOP. STATUS FIELD

	LDB	AC0,F.BDNS	; GET DENISTY INDICATED BY PROGRAM

IFN TOPS20,<
	; FOR THE 20 GET DEFAULT TAPE SETTINGS AND CHECK AGAINST REQUESTED

	PUSHJ	PP,GTDFLT	; GET DEFAULT DATA MODE IN AC3
	MOVE	AC4,AC3		; SAVE DATA MODE
	SETO	AC1,		; AC1=-1, THIS JOB
	HRROI	AC2,3		; DENSITY AT AC3
	MOVEI	AC3,.JIDEN	; START BLOCK AT THE DEFAULT DEN WORD
	GETJI%			; GET THE DENSITY
	 JRST	KILL.		; ASSUME IT WORKS, SHOULD ALWAYS

	CAIGE	AC0,.TFD16	; IS REQUESTED DEN 1600 OR GTR ?
	JRST	EXTMT0		; NO, SET IN STATUS FIELD

	CAIN	AC0,(AC3)	; IS DEFAULT SAME AS REQUESTED?
	JRST	EXTMT1		; YES, GO CHECK DATA MODE

>;END IFN TOPS20

IFE TOPS20,<

	; FOR THE 10 CHECK FOR CONTROLLERS THAT READ DENISTY. IF NOT
	; THEN CHECK DEFAULT SETTING

	CAIGE	AC0,.TFD16	; IS REQUESTED DEN 1600 OR GTR ?
	JRST	EXTMT0		; NO, SET IN STATUS FIELD

	MOVE	AC1,[2,,2]	; 2 ARGS START AT AC2
	MOVEI	AC2,.TFKTP	; GET CONTROLLER TYPE
	MOVE	AC3,UOBLK.+1	; GET DEVICE NAME
	TAPOP.	AC1,		; GET CONTROLLER TYPE INTO AC1
	 JRST	EXTPER		; ERROR IN TAPOP.

	CAIE	AC1,.TFKTX	; TX01
	CAIN	AC1,.TFKD2	; OR DX20/TX02?
	JRST	EXTMT1		; YES, DENSITY IS READ FROM TAPE
	
	; NO,CHECK DEFAULT DENISTY SETTING

	MOVE	AC1,[3,,2]	; 3 ARGS START AT AC2
	MOVEI	AC2,.TFDEN+.TFSET ; SET TAPE DENSITY
	SETZ	AC4,		; SET TO UNIT DEFAULT
	TAPOP.	AC1,		; SET THE DENSITY
	 JRST	EXTPER		; FILOP ERROR

	MOVE	AC1,[2,,2]	; 2 ARGS START AT AC2
	MOVEI	AC2,.TFDEN	; DENSITY AGAIN
	TAPOP.	AC1,		; GET THE UNIT DEFAULT
	 JRST	EXTPER		; TAPOP. ERROR
	CAIN	AC0,(AC1)	; IS DEFAULT THE REQUESTED?
	JRST	EXTMT1		; YES, GO CHECK DATA MODE

>;END IFE TOPS20

	; HERE IF DENSITY CAN'T BE SET FOR THE APPEND FILOP.

	POP	PP,(PP)		; DISCARD OPNEXT POPJ
	LDB	AC0,F.BBKF	; GET BLOCKING FACTOR
	JUMPN	AC0,.+2		; SKIP IF BLOCKED
	POP	PP,(PP)		; DISCARD .JBFF SAV
	MOVEI	AC0,^D49	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Unable to set requested density for OPEN EXTEND./]
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.	;DOESN'T RETURN

IFE TOPS20,<
		
	; HERE WITH TAPOP. ERROR

EXTPER:
	POP	PP,(PP)		; DISCARD OPNEXT POPJ
	LDB	AC0,F.BBKF	; GET BLOCKING FACTOR
	JUMPN	AC0,.+2		; SKIP IF BLOCKED
	POP	PP,(PP)		; DISCARD .JBFF SAV
	MOVE	AC0,[E.MTAP+^D50] ; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /TAPOP. error processing OPEN EXTEND for mag tape./]
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.	;DOESN'T RETURN

>;END IFE TOPS20

	; HERE TO SET DENSITY IN STATUS FIELD

EXTMT0:	DPB	AC0,[POINT 2,FOP.IS,28] ; DENSITY IN STATUS BITS

	; HERE TO CHECK THAT DATA MODE IS PROPER

EXTMT1:

IFE TOPS20,<

	PUSH	PP,D.OBH(I16)	; SAVE OUT BUFF HEADER
	PUSH	PP,D.OBB(I16)	; SAVE OUT BUFF PTR

	XCT	UOPEN.		; OPEN THE DEVICE
	 JRST	[ POP	PP,AC0	; THROW OUT BUFF
		POP	PP,AC0	; HEADER AND PTR
		JRST	OERRIF]	; ERROR
	MOVE 	AC1,[2,,2]	; 2 ARGS START AT AC2
	MOVEI	AC2,.TFMOD	; DATA MOD FUNCTION
	MOVE	AC3,UOBLK.+1	; DEVICE NAME
	TAPOP.	AC1,		; GET DEFAULT DEVICE DATA MODE
	 JRST	[ POP	PP,AC0	; THROW OUT BUFF
		POP	PP,AC0	; HEADER AND PTR
		JRST	EXTPER]	; TAPOP. ERROR
	XCT	UCLOS.		; CLOSE IT FOR APPEND FILOP.
	XCT	URELE.		; RELEASE IT TOO  (WACHS SAYS SO)
	POP	PP,D.OBB(I16)	; RESTORE BUFF PTR
	POP	PP,D.OBH(I16)	; AND HEADER


>;END IFE TOPS20


	TLNN	FLG,DDMEBC	; SKIP IF DEVICE MODE EBCDIC
	JRST	EXTMT2		; ELSE GO ON

IFE TOPS20,<
	CAIE	AC1,.TFM8B	; IS DEFAULT MODE INDUSTRY COMPATIBLE
	JRST	EXTDER		; NO, ERROR
	JRST	OPNEX0		; YES, ALL OK, GO DO FILOP. 
>;END IFE TOPS20	

IFN TOPS20,<
	CAIE	AC4,.SJDM8	; IS DEFAULT MODE INDUSTRY COMPATIBLE?
	JRST	EXTDER		; NO, ERROR
	JRST	OPNEX0		; YES, ALL OK, GO DO FILOP. 
>;END IFN TOPS20

	; NOT EBCDIC IS IT ANSI ACSII ?

EXTMT2:	HRRZ	AC0,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNN	AC0,SASCII	; DOES HE WANT IT?
	JRST	OPNEX0		; NO, ALL OK GO DO FILOP.


IFE TOPS20,<

	CAIE	AC1,.TFM7B	; IS DEFAULT MODE ANSI ASCII ?
	JRST	EXTDER		; NO, ERROR
	JRST	OPNEX0		; YES, ALL OK CONT

>; END IFE TOPS20


IFN TOPS20,<	

	CAIE	AC4,.SJDMA	; IS DEFAULT MODE ANSI ASCII ?
	JRST	EXTDER		; NO, ERROR
	JRST	OPNEX0		; YES, ALL OK CONT
	
>; END IFN TOPS20

	; HERE IF DATA MODE CAN'T BE SET 


EXTDER:	POP	PP,(PP)		; DISCARD OPNEXT POPJ
	LDB	AC0,F.BBKF	; GET BLOCKING FACTOR
	JUMPN	AC0,.+2		; SKIP IF BLOCKED
	POP	PP,(PP)		; DISCARD .JBFF SAV
	MOVEI	AC0,^D51	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Unable to set requested data mode for OPEN EXTEND./]
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.	;DOESN'T RETURN
		

OPNEX0:	MOVE	AC1,UOBLK.+2	;GET BUFFER HEADERS
	MOVEM	AC1,FOP.BH##	;STORE IN FILOP. BLOCK
	SETZM	D.OBB(I16)	;[1026] ZERO BUFFER POINTER
	MOVE	AC1,[7,,FOP.BK]
	FILOP.	AC1,
	  JRST	[ POP	PP,(PP)		; DISCARD OPNEXT RETURN
		  LDB	AC0,F.BBKF	; GET BLOCKING FACTOR
		  SKIPE	AC0		;[1042] JUMP IF NOT BLOCKED
		  TLNN	FLG,IOFIL+RANFIL+IDXFIL	;[1042] SEQUENTIAL FILE?
		  POP	PP,(PP)		;[1042] YES, DISCARD .JBFF SAV
		  JRST	OFERR	]	; FAILED
	JUMPL	FLG,OPNEX1	;JUMP IF ASCII
	TLNE	FLG,DDMBIN
	POPJ	PP,		;DON'T CHANGE IF BINARY
	HLRZ	AC6,FOP.BH	;GET OUTPUT BUFFER HEADER
	TLNN	FLG,DDMEBC
	JRST	OPNEXS		; SIXBIT, CONTINUE
	MOVEI	AC1,9		; EBCDIC
	TXNE	AC13,DV.MTA	; SKIP IF NOT MTA
IFN TOPS20,<
	MOVEI	AC1,8		; ELSE IT IS INDUSTRY COMPATIBLE
>
IFE TOPS20,<
	JRST	EX10ER		; EBCIDC TAPE EXTEND NOT SUPPORTED ON 10
>
	DPB	AC1,[POINT 6,1(AC6),11] ; RESET BYTE SIZE
	MOVEI	AC1,4		;
	IMULM	AC1,2(AC6)	;ADJUST BYTE COUNT

IFE TOPS20,<
EX10ER:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR [ASCIZ /OPEN EXTEND for EBCDIC tapes currently not supported./]

	MOVE	AC2,[BYTE (5)10,31,20,2] ; FILENAME AND DEVICE MESSAGE AND KILL
	PUSHJ	PP,MSOUT.
>
		; RESET THE BYTE PTR TO FIRST FREE CHAR
OPNEX1:	
;BL;	INSERTED AT OPNEX1 TO FIX OPEN-EXTEND BUG
	HRRZ	AC4,D.OBB(I16)	;GOOD DEST ADDR IN BPTR?
	JUMPE	AC4,OPNEXX	; NO, WAIT FOR DUMMYOUT
	SOS	AC1,D.OBB(I16)	; GET BUF BYT PTR
	HRRZ	AC2,D.OBH(I16)	; GET ADDR OF BUF HEADER
	CAIE	AC2,(AC1)	; BYT PTR AT BUF BEGINING?
	JRST	OPNX1A		; NO
	AOS	D.OBB(I16)	; YES, RESET BYT PTR
OPNEXX:	POPJ	PP,		; , THEN ALL SET, RETURN

OPNX1A:	HRRZ	AC2,D.BPW(I16)	; GET BYTS PER WORD
	ADDI	AC2,1		; SET BYT COUNT RIGHT FOR LOOP

	; SCAN THRU LAST DATA WORD FOR FIRST NULL CHAR

OPNEX2:	MOVE	AC3,AC1		; SAVE CURRENT POSITION
	SOJE	AC2,OPNEX3	; END SCAN IF NO CHARS LEFT
	ILDB	AC0,AC1		; GET CHAR
	JUMPN	AC0,OPNEX2	; END SCAN IF NULL FOUND
	MOVE	AC1,AC3		; RESET PTR TO WRITE OVER NULL FOUND
OPNEX3:	ADDM	AC2,D.OBC(I16)	; ADD PARTIAL WORDS CHARS TO AVAILABLE COUNT
	MOVEM	AC1,D.OBB(I16)	; RESET OUT BUF BYT PTR (IF NO NULL,UNCHANGED)
	POPJ	PP,		; RETURN, ALL DONE

	; THE SIXBIT CASE

OPNEXS:	MOVEI	AC1,6		;ASSUME SIXBIT
	DPB	AC1,[POINT 6,1(AC6),11]	;RESET BYTE SIZE
	IMULM	AC1,2(AC6)	;ADJUST BYTE COUNT
	POPJ	PP,		; END NOW,SIXBIT IS WORD ALLIGNED


OPNC46:
	HLRZ	AC2,F.LSBA(I16)	;[507] FILTAB THAT SHARES SAME BUFFER
	JUMPN	AC2,ZROBUF	;[507] CLEAR ANY POSSIBLE PREVIOUS JUNK
	POP	PP,.JBFF	;RESTORE .JBFF
OPNCH2:
IFN ANS74,<
	TLNN	FLG,IDXFIL!RANFIL!OPNIN ;[622]
	TLNN	FLG,OPNOUT	;TEST FOR SEQ. OUTPUT
	JRST	OPNC21		;NO
	SKIPN	F.LCP(I16)	;LINAGE-COUNTER?
	JRST	OPNC21		;NO
	MOVEI	AC6,1
	MOVEM	AC6,F.LCP(I16)	;YES, SET TO 1
OPNC21:>
	TXNE	AC13,DV.DIR	;SKIP IF NON-DIRECTORY DEVICE
	TLNE	FLG1,STNDRD!MSTNDR   ;[1115] SKIP IF NOT STD OR MONITOR LABELS
	JRST	OPNBSI		;SET THE BYTE SIZE
	TXNE	AC13,DV.CDR	;[531] IF DIRECTORY AND CDR
	JRST	OPNBSI		; THEN ITS NUL: WHICH IS OK
	PUSHJ	PP,RCHAN	;RELEASE DEVICE AND CHANNEL
	MOVEI	AC0,^D19	;ERROR NUMBER
	PUSHJ	PP,OXITP	;RETURN TO CBL-PRG IF IGNORING ERRORS
	MOVE	AC2,[BYTE (5)10,2,4,26] ;FCBO,DDMHSL
	JRST	MSOUT.

	;[507] ZERO BUFFERED I/O BUFFER AREA.
ZROBUF:	HLRZ	AC3,D.BL(I16)	;[507] ORIGINAL BUFFER LOCATION
	MOVE	AC1,AC3		;[507] SET UP FOR LOOP
ZRBUF2:	SETZM	(AC1)		;[507] INITIALIZE FILE STATUS
	HLRZ	AC2,1(AC1)	;[507] SIZE OF DATA BUFFER ( +1 )
	HRRZ	AC4,1(AC1)	;[507] ADDR 2ND WORD NEXT BUFFER
	HRRZI	AC1,2(AC1)	;[507] 3RD WORD OF HEADER
	SETZM	(AC1)		;[507] THE ZERO
	ADDI	AC2,-1(AC1)	;[507] UNTIL...
	HRLS	AC1		;[507] FROM...
	ADDI	AC1,1		;[507] TO...
	BLT	AC1,(AC2)	;[507] CLEAR THE BUFFER
	HRRZI	AC1,-1(AC4)	;[507] TOP OF NEXT BUFFER
	CAME	AC3,AC1		;[507] AT BEGINNING OF RING?
	JRST	ZRBUF2		;[507] NO, LOOP
	POP	PP,.JBFF	;[507] RESTORE
	JRST	OPNCH2		;[507] CONTINUE
	;SET UP NON-STD MTA BUFFERS (SIZE OF LOGICAL BLOCK).  ***OPNCH2***

OPNNSB:	CAIN	AC6,77		;[477] REALLY WANTS ONE BUFFER?
	SETO	AC6,		;[477] YES, SET TO DEFAULT TO 1
	ADDI	AC6,2		;ALTERNATE PLUS 2 DEFAULT BUFFERS
	TLNE	FLG1,STNDRD+NONSTD ;SKIP IF OMITTED LABELS
	HRRZ	AC10,D.LRS(I16)	;IN CASE LABEL IS GE TO REC AREA
	HLRZ	AC4,D.BL(I16)	;BUFFER LOCATION
	ADDI	AC4,1		;BUF1+1
	HRLI	AC4,(BF.VBR)	;   AND NEVER WAS REFERENCED
	MOVEM	AC4,D.IBH(I16)	;INPUT HEADER
	MOVEM	AC4,D.OBH(I16)	;OUTPUT HEADER
	HRR	AC2,AC4		;BUF1+1
	HRLI	AC2,1(AC10)	;SIZE+1,,BUF1+1
	SKIPA	AC3,AC4		;BUF1+1
OPNNS1:	ADDI	AC3,3(AC10)	;LOCATION OF NEXT LINK
	ADDI	AC2,3(AC10)	;SIZE+2,,<BUF1+1+SIZE+3>
	MOVEM	AC2,(AC3)	;SIZE+2,,BUF2+1
	SOJG	AC6,OPNNS1	;LOOP IF ANY MORE BUFFERS
	HRRM	AC4,(AC3)	;LAST BUFFER CLOSES THE RING (BUF1+1)
	ADDI	AC4,1		;BUF1+2
	HRRM	AC4,D.IBB(I16)	;INPUT HEADER BYTE POINTER
	HRRM	AC4,D.OBB(I16)	;OUTPUT H...
	TXNN	AC16,OPN%EX	;APPEND?
	JRST	OPNCH2		;NO
	SETZM	FOP.BN		;DON'T CHANGE BUFFER ALLOCATION
	PUSHJ	PP,OPNEXT	; GO OPEN VIA APPEND FILOP

	LDB	AC0,F.BBKF	; GET BLOCKING FACTOR
	MOVEM	AC0,D.RCL(I16)	; SET NUMBER RECORDS IN LOG BLOCK
	MOVE	AC3,D.BPL(I16)	; GET NUMBER OF BUFFS PER LOG-BLK
	MOVEM	AC3,D.BCL(I16)	; AND RESET IT
	PUSHJ	PP,EXTSCN	; SCAN THE CURRENT BLOCK TO CALC THE NUMBER OF 
				; RECORDS LEFT IN THE LOGICAL BLOCK
	JRST	OPNCH2		; CONTINUE AT MAIN LINE

	; NOW MUST SCAN FROM BEGINING OF BLOCK TO CALC HOW
	; MANY RECORDS HAVE BEEN WRITTEN SO FAR.
	; THE NUMBER OF RECORDS LEFT IN THE LOGICAL BLOCK (D.RCL) HAS
	; BEEN RESET TO INDICATE THE NUMBER OF RECORDS LEFT AT THE BEGINING
	; OF THE CURRENT BLOCK.




EXTSCN:	HRRZ	AC1,D.OBB(I16)	; GET ADDR NEW WRITE POSITION
	HRRZ	AC2,D.OBH(I16)	; CALC ADDR OF START
	ADDI	AC2,1		; OF DATA
	SUB	AC1,AC2		; CALC NUMBER OF WORDS OF DATA IN BUFFER	
	JUMPLE	AC1,OPNNXX	; EXIT IF BUFFER EMPTY
	JUMPGE	FLG,OPNNXS	; JUMP IF NOT ASCII
	HRLI	AC2,000700	; SET UP 7-BIT BYTE PTR
				; AC2 ADDR SET TO WORD BEFORE DATA ABOVE
OPNXA1:	SOJLE	AC1,OPNNXX	; JUMP IF SCAN COMPLETE
	ILDB	AC3,AC2		; GET A CHAR
	CAIL	AC3,40		; SKIP IF NOT "REAL" DATA CHAR
	JRST	OPNXA2		; ELSE WE HAVE FOUND THE START OF A RECORD
	MOVE	AC3,CHTAB(AC3)	; GET CONVERSION TABLE ENTRY (NEG IF IGNORE CHR)
	JUMPLE	AC3,OPNXA1	; JUMP IF CHAR TO BE IGNORED

OPNXA2:	SOS	D.RCL(I16)	; NOW DECREMENT AVAILABLE RECORDS IN BLOCK COUNT

	; SCAN TO END OF RECORD

OPNXA3:	SOJE	AC1,OPNNXX	; JUMP IF REACHED NEW WRITE POSITION
	ILDB	AC3,AC2		; GET CHAR
	CAIL	AC3,40		; SKIP IF NOT "REAL" DATA CHAR
	JRST	OPNXA3		; ELSE CONTINUE WITH RECORD SCAN
	MOVE	AC3,CHTAB(AC3)	; GET CONVERSION TABLE ENTRY (NEG IF IGNORE CHR)
	JUMPGE	AC3,OPNXA1	; JUMP IF CHAR IS PART OF RECORD
	JRST	OPNXA1		; CONTINUE SCAN THRU BLOCK


	; HERE FOR NON-ASCII CASES

OPNNXS:	TLNE	FLG,DDMSIX	; SKIP IF DEVICE MODE SIXBIT
	TXNN	AC13,DV.MTA	; AND IF A MTA
	JRST	OPNNXE		; ELSE CHECK FOR EBCDIC OR BINARY



	AOS	AC1,AC2		; AC2 WAS SET TO WORD BEFORE DATA ABOVE
				; ADDRESS FIRST DATA WORD
	HRRZ	AC0,D.OBB(I16)	; GET ADDR LAST DATA WORD
	CAIG	AC0,(AC1)	; SKIP IF NOT EMPTY BUFFER
	JRST	OPNNXX		; ELSE NOTHING TO UPDATE

	; SCAN DOWN SIXBIT RECORD COUNTING RECORDS 

OPNXS1:	CAIL	AC0,(AC1)	; SKIP IF MORE TO SCAN
	JRST	OPNNXX		; ELSE DONE
	SOS	D.RCL(I16)	; DECREMENT RECORDS LEFT IN BLOCK
	HLRZ	AC2,(AC1)	; GET RECORD SEQ NUMBER
	MOVEM	AC2,D.RP(I16)	; RESET REC SEQ NUMBER FOR WRITING
	HRRZ	AC2,(AC1)	; GET RECORD SIZE

	JUMPN	AC2,.+2		; SKIP IF NOT NULL RECORD
	AOJA	AC1,OPNXS1	; ELSE ADVANCE, NULL 6-BIT IS ONE WORD
				; IN THE RANDOM FORMAT
				; THIS WILL NOT WORK CORRECTLY FOR THE SEQ CASE
	IDIVI	AC2,6		; CALC NUMBER WORDS
	JUMPE	AC3,.+2		; IN THE
	ADDI	AC2,1		; RECORD
	ADDI	AC1,(AC2)	; ADVANCE TO NEXT RECORD
	JRST	OPNXS1		; CONTINUE TO SCAN BLOCK

	; HERE FOR EBCDIC AND BINARY CASES

OPNNXE:	JUMPL	FLG1,OPNNXV	; JUMP IF VARIABLE LENGTH EBCDIC

	; HERE IF DSK SIXBIT AND, DSK OR MTA
	; BINARY OR FIXED LENGTH EBCDIC, CALCULATE NUMBER
	; OF RECORDS TO CURRENT POSITION

	TLNE	FLG,DDMBIN!DDMSIX	;[1052]IS DEVICE MODE BINARY or SIXBIT?
	JRST	OPNNXB		; YES, SET UP FOR WORDS

	IMUL	AC1,D.BPW(I16)	; CALC NUMBER OF BYTES DATA ON BUFFER
	LDB	AC2,F.BMRS	; GET MAX RECORD SIZE


OPNXE2:	IDIVI	AC1,(AC2)	; CALC NUMER OF MAX RECORDS IN BUFFER
	JUMPE	AC2,OPNXE1	; SOME LEFT OVER ?
	TXNN	AC13,DV.MTA	; YES, MTA??
	ADDI	AC1,1		; NO, ROUND UP FOR PARTIAL RECORD
OPNXE1:	SUB	AC1,D.RCL(I16)	; AC1=-(NUMBER RECORDS LEFT IN BUFFER)
	MOVNM	AC1,D.RCL(I16)	; RESET NUMBER OF RECORDS LEFT IN BUFFER
	JRST	OPNNXX		; ALL FINISHED CONTINUE
	
	; BINARY CASE MUST BE DONE USING THE WORD NUMBERS

OPNNXB:	HRRZ	AC2,D.WPR(I16)	; GET REC SIZE IN WORDS
	JRST	OPNXE2		; GO DO CALC WITH AC1 AND AC2 WORDS




	; FOR VARIABLE LENGTH EBCIDC WE MUST CHAIN DOWN THE RDWS
	; COUNTING THE RECORDS SEEN
	
OPNNXV:	MOVE	AC1,D.OBC(I16)	; GET NUMBER AVAILABLE CHARS
	MOVEM	AC1,D.FCPL(I16)	; RESET NUMBER FREE CHARS IN LOG-BLK
	POPJ	PP,		; RETURN, ALL DONE




	; ALL DONE WITH BUFFER SCAN, IF BUFFER FULL, WRITE IT OUT
	; AND SET UP FOR NEXT ONE


OPNNXX:	SKIPE	D.RP(I16)	; SKIP IF NO SIXBIT REC SEQ NUMBER SET
	AOS	D.RP(I16)	; ELSE SET SO IT WILL START ONE GTR THAN LAST
	SKIPLE	D.RCL(I16)	; SKIP IF NO RECORDS LEFT IN BLOCK
	POPJ	PP,		; ELSE BACK TO MAIN LINE, ALL DONE HERE
	PUSHJ	PP,WRTOUT	; ADVANCE BUFFERS
	LDB	AC0,F.BBKF	; GET BLOCKING FACTOR
	MOVEM	AC0,D.RCL(I16)	; RESET NUMBER RECORDS IN LOG BLOCK
	MOVE	AC0,D.BPL(I16)	;[1055] GET # OF BUFFERS PER LOGICAL BLOCK
	MOVEM	AC0,D.BCL(I16)	;[1055] RESET # OF BUFFERS TO FILL CURR LOG BLK

	POPJ	PP,		;RETURN TO MAIN LINE

	;AC10 = WORDS PER LOGICAL BLOCK
	;INITIALIZE DUMP MODE BUFFERS FOR RANDOM AND IO.  ***OPNCON***

OPNRIO:	HLRZ	I12,D.BL(I16)	;BUFFER LOCATION
	MOVE	AC6,AC10	;GET WDS/LBLK
	TRZE	AC6,DSKMSK	;FILL TO DISK BLK SIZE,
	ADDI	AC6,DSKBSZ	;ROUNDING UP IF NECESSARY
	MOVN	AC6,AC6		;GET 0,,-N
IFN ANS68,<
	HRLI	AC6,R.FLMT(I12)	;LOC-1,,-N
>
IFN ANS74,<
	HRLI	AC6,R.DLRW(I12)	;LOC-1,,-N
>
	MOVSM	AC6,R.IOWD(I12)	;-N,,LOC-1
	SETZM	R.TERM(I12)	;IOWD TERMINATOR
	SETZM	R.DATA(I12)	;NO ACTIVE DATA IN BUFFER
	SETZM	R.BPLR(I12)	;NO INPUTS DONE FOR THIS FILE
	SETOM	R.WRIT(I12)	;LAST UUO WAS A WRITE
	LDB	AC6,[POINT 2,FLG,2] ; GET DEVICE DATA MODE
	HLL	AC6,RBPTB1(AC6)	;   AND BYTE-POINTER
IFN ANS68,<
	HRRI	AC6,1+R.FLMT(I12);FIRST DATA WORD
>
IFN ANS74,<
	SETZM	R.DLRW(I12)	; CLEAR DEL/RWT SAVE BLK NUM
	HRRI	AC6,1+R.DLRW(I12);FIRST DATA WORD
>
	TLNE	FLG1,VLREBC	; IF VAR-LEN EBCDIC RECORDS
	ADDI	AC6,1		; SKIP OVER THE BLOCK-DESCRIPTOR-WORD
	MOVEM	AC6,R.BPNR(I12)	; NEXT RECORD
	MOVEM	AC6,R.BPFR(I12)	;BYTE POINTER TO THE FIRST RECORD
	HLRZ	AC2,F.LSBA(I16)	;[507] FILTAB THAT SHARES SAME BUFFER
	SKIPE	AC2		;[507] SHARES BUFFER?
	PUSHJ	PP,ZDMBUF	;[507] YES, CLEAR IT
	JRST	OPNCON		;RET
IFN ISAM,<
	;SETUP INDEX FILE BUFFER AND TABLE AREAS

OPNIDX:	SETZM	USOBJ(I12)	;[377] CLEAR THE FIRST WORD OF INDEX TABLE
	HRRI	AC0,USOBJ+1(I12);TO
	HRLI	AC0,USOBJ(I12)	;FROM,,TO
	HRRZI	AC1,ITABL-15+ICHAN(I12)  ;UNTIL
	BLT	AC0,(AC1)	;CLEAR REST OF INDEX TABLE
	HRLZ	AC0,D.IBL(I16)	; [377] SEE IF WE HAVE A SAVE AREA
	JUMPE	AC0,OPNIX1	; [377] NO- GO ON
	HRRI	AC0,ISCLR1(I12)	; [377] SET UP TO
	HRRZI	AC1,ISCLR2(I12)	; [377] MOVE ISAM SAVE AREA TO
	BLT	AC0,(AC1)	; [377] TO SHARED BUFFER AREA
OPNIX1:	PUSHJ	PP,OPNLIX	;INDEX FILE-NAME TO LOOKUP BLOCK
IFN TOPS20,<
	SKIPL	MNTR5		;[1102] NO UNRESTRICTED READ
	TLNE	FLG,OPNOUT	;[1007][667] IF OPEN READ ONLY OR
>; END TOPS20			;[1102]
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNIX2		; YES
;IFN TOPS20,<			;[570]
;	TLNE	FLG,IOFIL!OPNOUT ;[570] OPEN READ ONLY?
;	JRST	ONIX1A		;[570] NO, DO LOOKUP
;	PUSHJ	PP,OCPT		;[570] YES, OPEN IN THAWED MODE
;	 JRST	OCPER		;[570] ERROR IN THAWED OPEN
;	JRST	OPNIX2		;[570] OK,CONT
;ONIX1A:	>;[570] END IFN TOPS20
	XCT	ULKUP.		;LOOKUP
	 JRST	OLERRI		;LOOKUP AND(OR) COMPT. FAILED
OPNIX2:	TLNN	FLG,OPNOUT	;OPEN FOR UPDATING?
	JRST	OPNI01		;NO
OPNI00:	TLO	FLG1,EIX	;ENTER OF .IDX FILE IN PROGRESS
	PUSHJ	PP,OPNEIX	;INDEX FILE-NAME TO ENTER BLOCK
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNIX3		; YES
	XCT	UENTR.		;ENTER, FOR UPDATING
	 JRST	OEERRI		;ENTER FAILED
OPNIX3:	TLZ	FLG1,EIX	;FREE THIS BIT FOR "RIVK" FLAG
OPNI01:	HRLZI	AC1,STABL	;STATISTICS BLOCK LEN
	MOVNS	AC1		;
	HRR	AC1,I12		;
	SUBI	AC1,1		;DUMP MODE IOWD
	MOVEM	AC1,IOWRD+14(I12)	;SAVE IN IOWRD TABLE
	SETZ	AC2,		;TERMINATOR
	MOVEI	AC0,1		;
	HRRM	AC0,UIN.	;
IFN ISTKS,<AOS INSSSS+14(I12)>
	XCT	UIN.		;READ THE STATISTICS BLOCK
	 JRST	OPNI02		;
	MOVE	AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER
	PUSHJ	PP,IGMIR		;IGNORE THE ERROR?
	 JRST	RCHAN			;YES - RELEASE THE IO CHANNELS
	OUTSTR	[ASCIZ /OPEN failed - cannot read statistics block./]
	PUSHJ	PP,SETIC		;SET UP IGETS CHANNEL NO.
	JRST	IINER
	;OPEN THE DATA FILE
OPNI02:	HLLZS	UIN.		;CLEAR THE IOWR POINTER
	MOVEI	AC0,.IODMP	;DUMP MODE
	HRRM	AC0,UOBLK.	;SETUP OPEN BLOCK
IFE TOPS20,<
	PUSHJ	PP,OPNCKP	;SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE
>
	MOVE	AC1,F.WDNM(I16)	;
	MOVE	AC1,1(AC1)	;[522] GET STRUCTURE
	MOVEM	AC1,UOBLK.+1	;
	SETZM	UOBLK.+2	;
	PUSHJ	PP,SETCN.	;SET DATA FILE CHANNEL
IFN TOPS20,<
	SKIPL	MNTR5		;[1102] IF (AT LEAST V5.0
	TLNE	FLG,OPNOUT	;[1102]  AND READ ONLY) OR
	SKIPE	F.WSMU(I16)	;[1102]  SIMULTANEOUS UPDATE
	TRNA			;[1102] THEN SKIP
	JRST	OPNI21		;[1102]  ELSE ON TO OPNI21
>; END TOPS20
IFE TOPS20,<
	SKIPN	F.WSMU(I16)	;[1102] SIMULTANEOUS UPDATE?
	JRST	OPNI21		;[1102] NO
	PUSHJ	PP,OPNFPD	; [431] OPEN FILE VIA FILOP UUO
	 JRST	OFERR		; [576] [431] ERROR RETURN
>; [431] END IFE TOPS20
IFN TOPS20,<
	PUSHJ	PP,OCPTD	; [431] OPEN FILE VIA DEC-SYS-20 COMPT.
	 JRST	OCPERI		; [431] ERROR RETURN
>; [431]END IFN TOPS20
	JRST	OPNI22		; SKIP THE OPEN UUO

OPNI21:	XCT	UOPEN.		;OPEN THE DATA FILE
	 JRST	OERRDF		;ERROR RETURN
	;SETUP IOWRD TABLE
OPNI22:
IFN ANS74,<
	; Set record area length for START

	LDB	AC1,F.BMRS	; Get record size
	LDB	AC3,[POINT 2,FLG,14] ; Get internal mode
	HRRZ	AC3,RBPTBL(AC3)	; Get bytes per internal record word
	IDIVI	AC1,(AC3)	; Get words in record area
	SKIPE	AC2		; Skip if no round up
	ADDI	AC1,1		; Round up
	MOVEM	AC1,RCARSZ(I12)	; Save for START checks
>; end ifn ans74

	MOVEI	AC3,BA(I12)	;
	MOVE	AC1,ISPB(I12)	;SECTORS PER BLOCK
	IMULI	AC1,200		;WORDS PER SECTOR
	MOVN	AC2,AC1		;-LEN
	HRLZS	AC2		;-LEN,,0
	HRRI	AC2,-1(AC3)	;IOWD, -LEN,,LOC-1
	MOVE	AC4,OMXLVL(I12)	;[442] USE ORIGINAL # OF INDEX LEVELS
;[V10]	SKIPN	CORE0(I12)	; SKIP IF NOT FIRST OPEN FOR THIS FILE
	SUBI	AC4,1		;PLUS ONE FOR SPLITTING THE TOP LEVEL
	HRLZS	AC4		;
	HRRI	AC4,IOWRD+1(I12)	;
	SKIPN	(AC4)		;IF IOWRD'S ALREADY SETUP
	MOVEM	AC2,(AC4)	;
	ADD	AC2,AC1		;
	AOBJN	AC4,.-3		;LOOP

	MOVN	AC5,MXLVL(I12)	;SEE IF ANY NEW INDEX LEVELS WERE
	SUB	AC5,OMXLVL(I12)	;  CREATED SINCE LAST TIME FILE WAS OPEN
	JUMPGE	AC5,OPNI06	;[504] SKIP THE FOLLOWING IF NOT
	HRL	AC4,AC5		;NEW LEVEL(S)
	HRRZ	AC5,ISPB(I12)	;[306] SECTORS PER BLOCK
	IMULI	AC5,200		;[306] WORDS PER SECTOR
	MOVN	AC6,AC5		;[306] NEGATE THE LENGTH
	HRLZS	AC6		;[306] -LENGTH,,0
	HRR	AC6,.JBFF	;  SO MAKE
	SUBI	AC6,1		;  ANOTHER IOWD
OPNI03:	SKIPE	(AC4)		;USE ONLY IF
	JRST	OPNI04		;  ANOTHER JOB MADE THE NEW LEVEL
	SKIPE	KEYCV.		;ARE WE SORTING?
	JRST	OPNIR0		;YES - CANT HANDLE THAT
	HRRZ	AC0,AC5		;[306] SET UP AC0
	PUSHJ	PP,GETSPC	;GET MORE CORE
	  JRST	OPNIR1		;TOO BAD
	HRRZ	AC0,HLOVL.	;DOES THE SPACE WE GOT
	CAMGE	AC0,.JBFF	; EXTEND INTO THE OVL-AREA?
	JUMPN	AC0,WOVLR1	;GO COMPLAIN IF IT DOES
	MOVEM	AC6,(AC4)	;USE IT
	ADD	AC6,AC1		;SET UP FOR NEXT IOWD
OPNI04:	AOBJN	AC4,OPNI03	;LOOP IF YOU MUST
OPNI06:	SKIPN	IOWRD+13(I12)	; SKIP IF ALREADY DONE
	MOVEM	AC2,IOWRD+13(I12);SAT BLOCK
	ADD	AC2,AC1		;
	;IOWRD0, USOBJ0, CNTRY0, NNTRY0  - SET TO INDEX ON LVL
	HRLZI	AC0,LVL		;HOLDS CURRENT LEVEL OF INDEX
	HRRI	AC0,IOWRD(I12)	;
	MOVEM	AC0,IOWRD0(I12)	;
	HRRI	AC0,USOBJ(I12)	;
	MOVEM	AC0,USOBJ0(I12)	;
	HRRI	AC0,CNTRY(I12)	;
	MOVEM	AC0,CNTRY0(I12)	;
	HRRI	AC0,NNTRY(I12)	;
	MOVEM	AC0,NNTRY0(I12)	;
	;SET BRISK FLAG   OUTPUT ONLY WHEN YOU MUST
	LDB	AC5,F.BDIO	;GET DEFERRED ISAM OUTPUT FLAG
	JUMPE	AC5,OPNI61	; 0 = NO DEFERRED OUTPUTS
	SKIPN	F.WSMU(I16)	; NO DEFERRED OUTS IF SIMU-UPDATE
	SETOM	BRISK(I12)

	;CHECK FILTAB BLKFTR VS STAT-BLK BLKFTR
OPNI61:	LDB	AC0,F.BMRS	;[371] GET PROGRAMS MAX REC SIZE
	CAMN	AC0,RECBYT(I12)	;[371] SEE IF SAME AS ISAM PARM
	JRST	OPNI07		;[371] IT DOES- OF
	CAML	AC0,RECBYT(I12)	; [375]  WHICH WAY IS FD DIFFERENT?
	JRST	OPNGR		; [375] FD GT ISAM
	TLNN	FLG,OPNIN	;[622] [375]  FD LT IDX-FILE, OPN OUTPUT ONLY?
	JRST	OPNI07		; [375] YES OKAY
	JRST	OPNER1		; [375] NO-INPUT OR I/O ERROR
OPNGR:	TLNN	FLG,OPNOUT	; [622][375]  FD GT IDXFIL -  OPN FOR INPUT ?
	JRST OPNI07		; [375] YES OKAY
OPNER1:				; [375]
	OUTSTR	[ASCIZ /Users maximum record size /] ; [371]
	PUSHJ	PP,PUTDEC	;[371] TYPE IT
	OUTSTR	[ASCIZ / differs from ISAM parameter ./]	;[371]
	MOVE	AC0,RECBYT(I12)	;[371] GET ISAM MAX REC SIZE
	PUSHJ	PP,PUTDEC	;[371] TYPE IT
	JRST	OPNERX		;[371] FINISH UP MSG AND STOP RUN
OPNI07:				;[371]
	MOVE	AC6,ORCBYT(I12)	;[515] GET BLOCKFTR AT RESET
	CAMGE	AC6,RECBYT(I12)	;[535] [515] MUST = OR LESS THAN FILE OPENED
	JRST	OPNER2		;[515] NOT THE SAME  TROUBLE
	MOVE	AC6,F.WIKD(I16)	;[535] [515] GET KEY DESC. FROM PROG
	CAMN	AC6,KEYDES(I12)	;[515] MUST BE THE SAME AS FILE OPENED
	JRST	OPNI7A		; ELSE CONT NEXT TEST
	LDB	AC10,KY.TYP	; GET KEY TYPE IN AC10
	CAIL	AC10,3		; CHECK FOR VARIOUS FLAVORS OF COMP KEYS;
	CAILE	AC10,5		; 3= 1WD COMP, 4=2WD COMP, 5=COMP-1
	JRST	OPNI7D		; NOT COMP, GIVE WARNING

	; COMP, CHECK WITHOUT SIZE FIELD

	TRZ	AC6,KEYSIZ	; CLEAR SIZE FIELD
	MOVE	AC10,KEYDES(I12) ; GET ISAM DESCP.
	TRZ	AC10,KEYSIZ	; CLEAR SIZE HERE TOO
	CAIN	AC6,(AC10)	; OK NOW?
	JRST	OPNI7A		; YES, CONT

OPNI7D:	OUTSTR	[ASCIZ / [Key descriptor of /]
	PUSHJ	PP,MSFIL.	; PRINT FILE NAME
	OUTSTR	[ASCIZ /  differs from program]
/]				;[535] YOUR ON YOUR OWN AFTER THIS
OPNI7A:	MOVE	AC6,F.WBRK(I16)	;[574] GET PROGRAM KEY POINTER
	CAMN	AC6,DBPRK(I12)	;[574] MUST BE SAME AS FILE OPENED
	JRST	OPNI7B		; ELSE CONT 

	;[617]  BYTE PTRS ARE NOT THE SAME, MAY BE BECAUSE OF MODE TRANSLATION
	;[617] CALC BYTE OFFSET TO THE BEGINING OF THE KEY AND COMPARE THIS

	;[617] CHECK FOR THE SPECIAL CASE OF COMP

	LDB	AC10,KY.TYP	;[617] GET KEY TYPE IN AC10
	CAIL	AC10,3		;CHECK FOR VARIOUS FLAVORS OF COMP KEYS;
	CAILE	AC10,5		;3= 1WD COMP, 4=2WD COMP, 5=COMP-1
	 JRST	OPNI7C		;[617] NOT COMP, JUMP TO BYTE POS CHECK

; 4/28/80: EDIT 617 ENHANCED TO ALSO CHECK FOR COMP-1.
;   THE COMPILER GENERATES A 9-BIT BYTE PTR FOR COMP THINGS,
;; AND ISAM DOES NOT. SOMEDAY THE COMPILER COULD BE FIXED SO
;; THIS CODE IS UNNECESSARY.

	HRRZ	AC10,F.WBRK(I16) ;[617] PUT WORD OFFSET OF KEY IN AC10
	HRRZ	AC6,DBPRK(I12)	;[617] PUT ISAM-GENERATED WORD OFFSET IN AC6
	CAMN	AC10,AC6	;[617] IF THEY MATCH, SKIP PRINTING
	JRST	OPNI7B		;[617]    OF ERROR MESSAGE


	; ELSE ERROR, RESET WORD OFFSET TO BYTE OFFSET FOR MESSAGES

	LDB	AC3,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC3,RBPTBL(AC3)	; AND THEN CHARS PER WORD
	IMULI	AC10,(AC3)	; RESET PRG OFFSET TO BYTES
	IMULI	AC6,(AC3)	; RESET ISAM OFFSET TO BYTES
	JRST	OPNERR		; ERROR

	;[617] FIRST CALC BYTE OFFSET FOR THE IDX STAT DESCRIPTION

OPNI7C:	LDB	AC3,KY.MOD	;[617] GET MODE OF KEY
	HRRZ	AC3,RBPTB1(AC3)	;[617] GET BYTES PER WORD
	LDB	AC0,[POINT 6,DBPRK(I12),5] ;[617] GET BIT OFFSET FOR IDX STAT
	LDB	AC1,[POINT 6,DBPRK(I12),11] ;[617] GET BITS PER BYTE
	IDIV	AC0,AC1		;[617] CALC NUMBER BYTES IN FIRST WORD OF KEY
	MOVE	AC1,AC3		;[617] GET BYTES PER WORD
	SUB	AC1,AC0		;[617] CALC NUMBER OF BYTES BFR KEY IN FIRST WD
	HRRZ	AC6,DBPRK(I12)	;[617] GET NUM FULL WORDS TO KEY
	IMULI	AC6,(AC3)	;[617] CALC NUMBER BYTES TO KEY (FULL WDS)
	ADD	AC6,AC1		;[617] PLUS PARTIAL = BYTES TO KEY FOR IDX STAT

	;[617] CALC NUMBER OF BYTES TO BEGIN OF KEY IN INTERNAL RECORD FORMAT

	LDB	AC3,[POINT 2,FLG,14] ;[617] GET CORE DATA MODE
	HRRZ	AC3,RBPTBL(AC3)	;[617] AND THEN CHARS PER WORD
	LDB	AC0,[POINT 6,F.WBRK(I16),5] ;[617] GET BIT OFFSET FOR IDX STAT
	LDB	AC1,[POINT 6,F.WBRK(I16),11] ;[617] GET BITS PER BYTE
	IDIV	AC0,AC1		;[617] CALC NUMBER BYTES IN FIRST WORD OF KEY
	MOVE	AC1,AC3		;[617] GET BYTES PER WORD
	SUB	AC1,AC0		;[617] CALC NUMBER OF BYTES BFR KEY IN FIRST WD
	HRRZ	AC10,F.WBRK(I16) ;[617] GET NUM FULL WORDS TO KEY
	IMULI	AC10,(AC3)	;[617] CALC NUMBER BYTES TO KEY (FULL WDS)
	ADD	AC10,AC1	;[617] PLUS PARTIAL = BYTES TO KEY FOR PROGRAM
	CAIN	AC6,(AC10)	;[617] IS THE BYTE OFFSET TO THE KEY THE SAME??
	JRST	OPNI7B		;[617] YES,  CONT 

	;[617] NO, TOO BAD

OPNERR:	OUTSTR	[ASCIZ /?Key pointer of /]
	PUSHJ	PP,MSFIL.	;[617] PRINT FILE NAME
	OUTSTR	[ASCIZ / differs from program ./] ;[617][574]
	OUTSTR	[ASCIZ /
	Program key starts at byte /]
	MOVE	AC0,AC10	; GET OFFSET TO PROGRAM KEY
	PUSHJ	PP,PUTDEC	; PRINT IT
	OUTSTR	[ASCIZ /
	ISAM file key starts at byte /]
	MOVE	AC0,AC6		; GET ISAM KEY START POSITION
	PUSHJ	PP,PUTDEC	; PRINT IT
	JRST	OPNERX		; ERROR MESS AND KILL

OPNI7B:	PUSHJ	PP,OPNWPB	;AC5 = BLKFTR, AC10 = WPB
;BL;	2 LINES INSERTED AT OPN17B + 1 TO FIX ISAM/RANDOM SHARED BUFFR BUG
	TLNE	FLG,IDXFIL	;ISAM FILE?
	SKIPN	PAGBUF(I12)	;YES, & PAGE I/O TOO?
	JRST	OPNI7E		; NO
	ADDI	AC10,777	; YES, AT LEAST 512 WD/PG
	LSH	AC10,-9		; ROUND
	LSH	AC10,9		;  OFF
OPNI7E:	MOVE	AC6,DBF(I12)	;DATA FILE BLOCKING FACTOR VIA STA BLOCK
	CAMN	AC5,AC6		;AC5 = BLKFTR VIA FILE TABLE
	JRST	OPNI05		;OK
	MOVE	AC0,[E.FIDX+^D9]	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE THE ERROR?
	 JRST	RCHAN		;YES - RELEASE IO CHANS
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Users blocking factor /]	; [371]
	MOVE	AC0,AC5		;[371] GET USER BF
	PUSHJ	PP,PUTDEC	;[371] TYPE IT
	OUTSTR	[ASCIZ / differs from ISAM parameter /]	;[371]
	MOVE	AC0,AC6		;[371] GET ISAM BF
	PUSHJ	PP,PUTDEC	;[371] TYPE IT
OPNERX:	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.

OPNER2:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /RESET maximum record size /]	;[515]
	MOVE	AC0,AC6		;[515] GIVE HIM RESET VALUE
	PUSHJ	PP,PUTDEC	;[515] TYPE IT
	OUTSTR	[ASCIZ / differs from OPEN maximum size /]	;[515]
	MOVE	AC0,RECBYT(I12)	;[515] GET OPEN VALUE
	PUSHJ	PP,PUTDEC	;[515] TYPE IT
	JRST	OPNERX		;[515] FINISH UP AND GET OUT

OPNER4:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Entries per index block at OPEN /]
	PUSHJ	PP,PUTDEC	;[515] TYPE OPEN VALUE
	OUTSTR	[ASCIZ / differs from RESET value /] 
	MOVE	AC0,OEPIB(I12)	;[515] GET RESET VALUE
	PUSHJ	PP,PUTDEC	;[515] TYPE VALUE
	JRST	OPNERX		;[515] AND GET OUT
	;IOWRD(I12) - SET DATA BLOCK IOWD POINTER
OPNI05:	MOVN	AC5,AC10	;
	HRL	AC2,AC5		;
	SKIPN	IOWRD(I12)	;SKIP IF ALREADY SETUP BY PREVIOUS OPEN
	MOVEM	AC2,IOWRD(I12)	;DATA BLOCK
	ADDI	AC2,1(AC10)	;AC2 POINT AT NEXT FREE AREA 

	;IBLEN - LEN OF INDEX BLOCK FOR BINARY SEARCH
	MOVE	AC0,EPIB(I12)	;
	CAMLE	AC0,OEPIB(I12)	;[535] [515] IS IT THE SAME AS RESET?
	JRST	OPNER4		;[515] NO  TROUBLE
	IMUL	AC0,IESIZ(I12)	;NO. OF WRDS IN IDX BLK
	MOVEM	AC0,IBLEN(I12)	;IDX BLK LEN

	;SINC - SEARCH INCREMENT FOR BINARY SEARCH
	MOVE	AC1,IESIZ(I12)	;THE INCREMENT TO BE
	IMULI	AC1,2		;
	CAMG	AC1,AC0		;INC GT INDEX LENGTH?
	JRST	.-2		;NO
	MOVEM	AC1,SINC(I12)	;SAVE THE SEARCH INCREMENT

	;DAKBP - BYTE POINTER TO DATA ADJUSTED KEY
	MOVE	AC1,DBPRK(I12)	;START WITH RELATIVE DATA KEY BP
	HRRI	AC1,(AC2)	;
	MOVEM	AC1,DAKBP(I12)	;DATA ADJUSTED KEY BYTE POINTER
	SETZM	(AC1)		;ZERO THE FIRST DATA REC-KEY WRD
	ADDI	AC1,1		;
	MOVEM	AC1,DAKBP1(I12)	;POINTER TO SECOND REC-KEY WRD
	ADD	AC1,IESIZ(I12)	;KEY SIZE PLUS 2 WRD HDR
	SUBI	AC1,2		;PERMIT 1 EXTRA WRD FOR WRAP-AROUND
	SETZM	-1(AC1)		;ZERO LAST DATA REC-KEY WRD

	;RESERVE AREA FOR INDEX ENTRY
	ADDI	AC1,2		;LOC FOR BLOCK # AND VERSION #
IFN ISTKS,<
	MOVE	AC0,[INSSSS(LVL)]
	ADD	AC0,I12
	MOVEM	AC0,INSSS0(I12)
	MOVE	AC0,[OUTSSS(LVL)]
	ADD	AC0,I12
	MOVEM	AC0,OUTSS0(I12)
>
	;IAKBP - BYTE POINTER TO INDEX ADJUSTED KEY
	TLZ	AC1,770000	;
	TLO	AC1,440000	;
	MOVEM	AC1,IAKBP(I12)	;INDEX ADJUSTED KEY BP
	ADDI	AC1,1		;
	MOVEM	AC1,IAKBP1(I12)	;POINTER TO SECOND IDX-KEY WRD
	ADD	AC1,IESIZ(I12)	;
	SUBI	AC1,2		;
	SETZM	-1(AC1)		;ZERO LAST IDX-KEY WRD

	; FOR ANS74 RESERVE ANOTHER COPY OF THE KEY FOR REWRT/DEL
	; SAVE OF CNTRY KEY VALUE, THE INDEXED ADJ VERSION OF THE KEY
	; (LEFT JUSTIFIED) WILL BE KEPT

IFN ANS74,<
	MOVEM	AC1,RWDLKY(I12)	; SAVE ADDR OF KEY SAV AREA
	MOVE	AC2,IESIZ(I12)	; RESERVE ROOM FOR
	SUBI	AC2,1		; COPIES OF IAK AND DAK KEYS
	LSH	AC2,1		; MULTIPLE BY 2
	ADDI	AC1,2(AC2)	; AND ADD IN EXTRA 2 WORDS ALLOWED FOR 
				; IN OPNI05 FRO INDEX HDR WDS
	MOVEM	AC1,RWDLRT(I12)	; And a save area for RETAIN too
	ADDI	AC1,2(AC2)	; 
>
	;AC1 POINTS TO NEXT FREE AREA

	HRLI	AC1,-1(AC1)	;UNTIL
	HRRI	AC1,ICHAN(I12)	;UNTIL,,FROM
	SKIPN	CORE0(I12)	; SKIP IF NOT THE FIRST OPEN
	MOVEM	AC1,CORE0(I12)	;CLOSE CLEARS THIS CORE AREA

	;AUXIOW - SETUP THE IOWD
	MOVN	AC0,MXBUF	;MAX BUFFER SIZE
	HRL	AC0,AC0		;
	HRR	AC0,AUXBUF	;
	SUBI	AC0,1		;LOC-1
	MOVEM	AC0,AUXIOW	;SAVE IT

	;KWCNT - NUMBER OF WORDS IN THE KEY
	MOVE	AC1,IESIZ(I12)	;SETUP KWCNT
	SUBI	AC1,2		;
	;HRRM	AC1,IKWCNT(I12)	;
	;HRRM	AC1,DKWCNT(I12)	;
	MOVNS	AC1		;
	HRLM	AC1,IKWCNT(I12)	;-CNT,,CNT

	;FWMASK, LWMASK - CREATE 2 MASK WORDS FOR FIRST AND LAST DATA-KEY WORDS
	LDB	AC0,KY.TYP	; GET KEY TYPE
	JUMPN	AC0,OPNBPS	; JUMP IF NOT NON-NUMERIC DISPLAY
	LDB	AC1,KY.SIZ	; GET KEY SIZE
	MOVN	AC2,AC1		;
	HRLZS	AC2		;
	MOVE	AC3,DBPRK(I12)	;RELATIVE DATA-RECORD-KEY POINTER
OPNMSK:	IBP	AC3
	AOBJN	AC2,.+1
	TLNE	AC3,760000	;STAY WITH IN THE FIRST WORD
	JUMPL	AC2,OPNMSK	;UNLESS WE RUN OUT OF BYTES

	LDB	AC4,[POINT 6,DBPRK(I12),5]
	SETZ	AC5,		;
	SETO	AC6,		;
	LSHC	AC5,(AC4)	;
	MOVEM	AC5,FWMASK(I12)	;007777 FIRST WORD MASK
	TLNN	AC3,760000	;
	JRST	OPNMS1		;
	LDB	AC4,[POINT 6,AC3,5]  ;THE KEY IS LESS THAN ONE WORD
	MOVNS	AC4		;
	LSH	AC5,(AC4)	;
	MOVNS	AC4		;
	LSH	AC5,(AC4)	;
	JRST	.+2		;007700 AC5 HAS MASK

OPNMS1:	JUMPL	AC2,OPNMS2	;IS KEY GREATER THAN ONE WRD?
	SETZM	FWMASK(I12)	;NO, ONE WRD OR LESS
	MOVEM	AC5,LWMASK(I12)	;
	JRST	OPNBPS		;DONE

OPNMS2:	LDB	AC4,KY.MOD	; GET MODE OF KEY
	HRRZ	AC4,RBPTB1(AC4)	; GET BYTES PER WORD
	HLRES	AC2		;
	MOVMS	AC2		;MAKE IT POSITIVE
	IDIV	AC2,AC4		;
	SKIPN	AC3		;REMAINDER?
	SKIPA	AC3,AC4		;NO--BYTES PER WORD
	ADDI	AC2,1		;YES
	LDB	AC4,[POINT 6,DBPRK(I12),11]; GET BITS PER BYTE
	MOVNS	AC2		;
	HRLM	AC2,DKWCNT(I12)	;NUMBER OF REC-WRDS -1 THAT CONTAIN THE KEY
	IMUL	AC3,AC4		;
	SETO	AC6,		;
	SETZ	AC5,		;
	MOVNS	AC3
	ROTC	AC5,(AC3)	;
	MOVEM	AC5,LWMASK(I12)	;MASK FOR THE LAST REC-DATA-KEY WRD

	;BPSB - NUMBER OF BITS PER SAT BLOCK
OPNBPS:	MOVE	AC0,FILSIZ(I12)	;TOTAL NUMBER OF DATA BLOCKS IN FILE
	IDIV	AC0,SBTOT(I12)	;  WILL GIVE NUMBER PER SAT BLOCK
	MOVEM	AC0,BPSB(I12)	;SAVIT
	;ICMP, DCMP - SETUP DISPATCH ADR FOR COMPARE ROUTINES
	;0 = DCDNN, 1 = DC1S/U, 2 = DC2S/U
OPNDSP:	LDB	AC2,KY.TYP	; GET KEY TYPE
	JUMPE	AC2,OPNDS1	; ZERO STAYS A ZERO
	TRNE	AC2,1		;
	TRZA	AC2,-2		; ODD BECOMES 1
	HRRZI	AC2,2		; EVEN BECOMES 2
OPNDS1:	HRRZ	AC0,KEYDES(I12)	; GET KEY SIGN

	TRNE	AC0,100000	;
	SKIPA	AC3,ICTAB(AC2)	;UNSIGNED
	MOVS	AC3,ICTAB(AC2)	;SIGNED
	HRRZM	AC3,ICMP(I12)	;INDEX COMPARE ROUTINE

	TRNE	AC0,100000	;
	SKIPA	AC3,DCTAB(AC2)	;
	MOVS	AC3,DCTAB(AC2)	;
	HRRZM	AC3,DCMP(I12)	;DATA COMPARE ROUTINE

	LDB	AC5,KY.TYP	; GET KEY TYPE
	CAIGE	AC5,3		; 0 THRU 8
	JUMPN	AC5,OPNDS2	; 0, 1, 2
	CAIGE	AC5,7		; 0, 3, 4, 5, 6, 7, 8
	JRST	OPNRSB		; 0, 3, 4, 5, 6

	;HERE IF NUMERIC DISPLAY OR COMP-3
	;SETUP CONVERT TO BINARY ROUTINES
OPNDS2:	HLLZ	AC1,F.WBRK(I16)	;POSITION IN DATA-REC
	TRNE	AC0,100000	;
	TLZA	AC1,4000	;UNSIGNED
	TLO	AC1,4000	;SIGNED				???
	LDB	AC2,KY.SIZ	; GET KEY SIZE
	DPB	AC2,[POINT 11,AC1,17]  ;
	MOVEM	AC1,GDPRK(I12)	;GD PARAMETER FOR REC-KEY
	HRR	AC1,F.WBSK(I16)	;ADR OF SYMKEY
	TLZ	AC1,770000	;MASK
	HLLZ	AC2,F.WBSK(I16)	;
	TLZ	AC2,7777	;
	IOR	AC1,AC2		;SYM-KEY BYTE RESIDUE
	MOVEM	AC1,GDPSK(I12)	;GD PARAMETER FOR SYM-KEY
	LDB	AC2,[POINT 2,FLG,14]	; GET KEY MODE
	HRRZ	AC1,GDTBL(AC2)	; GET CONVERSION ROUTINE
	CAIL	AC5,7		; IF COMP-3
	HRRZI	AC1,GC3.	; USE THIS ROUTINE
	MOVEM	AC1,GDX.I(I12)	; SYM-KEY VS INDEX ENTRY

	LDB	AC2,KY.MOD	; GET KEY MODE
	HLRZ	AC1,GDTBL(AC2)	; GET CONVERSION ROUTINE
	CAIL	AC5,7		; IF COMP-3
	HRRZI	AC1,GC3.	; USE THIS ROUTINE
	MOVEM	AC1,GDX.D(I12)	; SYM-KEY VS DATA FILE KEY

	;DCMP,DCMP1 - SETUP TO CONVERT THEN COMPARE
	HRRZM	AC3,DCMP1(I12)	;COMPARE ROUTINE
	HRRZI	AC3,DGD67	;CONVERSION ROUTINE
	MOVEM	AC3,DCMP(I12)	;CONVERT THEN COMPARE

	;RSBP - BR TO SIXBIT/ASCII RECORD SIZE
OPNRSB:	MOVE	AC1,[POINT 12,-1(AC4),35]
	TLNN	FLG,DDMSIX!DDMEBC;
	MOVE	AC1,[POINT 12,-1(AC4),34]
	MOVEM	AC1,RSBP(I12)
	SUBI	AC1,-1
	MOVEM	AC1,RSBP1(I12)
	;GETSET - SETUP KEY FOR SEARCH ROUTINES
OPNGST:	LDB	AC1,KY.TYP	; GET KEY TYPE
	JUMPN	AC1,.+2		;
	MOVEI	AC2,ADJKEY	;DNN
	CAIE	AC1,1		;
	CAIN	AC1,2		;
	MOVEI	AC2,GD67	;DN
	CAIL	AC1,3		;
	MOVEI	AC2,FPORFP	;FP
	CAIE	AC1,7		; COMP-3?
	CAIN	AC1,10		; ?
	MOVEI	AC2,GD67	; YES
	MOVEM	AC2,GETSET(I12)	;DISPATCH FOR SEARCH INITIALIZING

	;RECBP - SETUP REC AREA BYTE-POINTER
	LDB	AC2,[POINT 2,FLG,14]; GET MODE OF RECORD AREA
	HLL	AC2,RBPTB1(AC2)	; GET A BYTE-PTR
	HRR	AC2,FLG		;ADR OF REC
	MOVEM	AC2,RECBP(I12)	;

	;NOW CLEAR SOME IDX BUFFER AREAS
	MOVEI	AC6,IOWRD+2(I12); START WITH SECOND IDX LEVEL
OPNZBF:	SKIPN	AC2,(AC6)	; GET THE IOWRD TO AC2
	JRST	OPNZB1		; THERE IS NONE FOR THIS LEVEL
	HRLI	AC1,1(AC2)	; THE "FROM" ADDR
	HRRI	AC1,2(AC2)	; THE "TO" ADDR
	SETZM	-1(AC1)		; ZERO FIRST WORD
	HLRO	AC2,AC2		; GET THE LENGTH
	HRRZI	AC3,-2(AC1)	; GET "FROM"-1
	SUB	AC3,AC2		; GET "UNTIL" ADDR
	BLT	AC1,(AC3)	; SMEAR THE ZERO
OPNZB1:	CAIE	AC6,IOWRD+13(I12);SKIP WHEN DONE
	AOJA	AC6,OPNZBF	; ELSE LOOP
	JRST	OPNCH2		;

OPNIR0:	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	MOVE	AC0,[E.FIDX+^D7]	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	RCHAN		;YES - RELEASE IO CHANNELS
	OUTSTR	[ASCIZ /Cannot expand core while SORT is in progress./]
	JRST	OMTA99

OPNIR1:	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	MOVE	AC0,[E.FIDX+^D8]	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	RCHAN		;YES - RELEASE IO CHANS
	PUSHJ	PP,GETSP9	;CORE UUO FAILED
	JRST	OMTA99

	;DISPATCH FOR INDEX COMPARE ROUTINES
ICTAB:	XWD	ICDNN,	ICDNN	;DISPLAY NON-NUMERIC
	XWD	IC1S,	IC1U	;ONE WRD SIGNED / UNSIGNED
	XWD	IC2S,	IC2U	;TWO WRD SIGNED / UNSIGNED

	;DISPATCH FOR DATA COMPARE ROUTINES
DCTAB:	XWD	DCDNN,	DCDNN	;DISPLAY NON-NUMERIC
	XWD	DC1S,	DC1U	;ONE WRD SIGNED / UNSIGNED
	XWD	DC2S,	DC2U	;TWO WRD SIGNED / UNSIGNED

	;DISPATCH FOR DATA CONVERSION ROUTINES
PDTBL:	PD6.,,GD6.		; SIXBIT TO BINARY
	PD9.,,GD9.		; EBCDIC
	PD7.,,GD7.		; ASCII

	;INDEX TO LEFT HALF IS KY.MOD FOR DSRCH
	;INDEX TO RIGHT-HF IS CORE-DATA-MODE FOR IBS
GDTBL:	GD6.,,GD7.
	GD9.,,GD9.
	GD7.,,GD6.
>
	;RETURNS IN AC10 NUMBER OF WORDS PER LOGICAL BLOCK
	;AND BLOCKING FACTOR IN AC5.  ***POPJ***

OPNWPB:	LDB	AC5,F.BBKF	;BLOCKING FACTOR
	MOVEM	AC5,D.RCL(I16)	;
	LDB	AC10,F.BMRS	;MAX RECORD SIZE
IFN ISAM,<
	TLNE	FLG,IDXFIL	; [375]  IS THIS AN ISAM FILE?
	MOVE	AC10,RECBYT(I12); [375] YES-USE ISAM PARAM 
>
	TLNE	FLG,DDMBIN	;IF MODE IS BINARY,
	JRST	OPNWP3		;  CONVERT SIZE TO WORDS

	JUMPL	FLG,OPNWP1	;JUMP IF ASCII

OPWPB0:	LDB	AC6,[POINT 2,FLG,2] ; GET DEVICE DATA MODE
	HRRZ	AC6,RBPTBL(AC6)	; AND THEN CHARS PER WORD
OPWPB1:	HRRZM	AC6,D.BPW(I16)	; CHARS PER WORD

	TLNE	FLG,DDMEBC	; SKIP IF NOT EDCBIC
	JRST	OPNWP4		; EBCDIC!
OPNWP5:	ADD	AC10,AC6	; ACCOUNT FOR THE HEADER WORD
OPNWP2:	ADDI	AC10,-1(AC6)	;ROUND UP
	IDIV	AC10,AC6	;RECSIZ/CPW
	HRRZM	AC10,D.WPR(I16)	; SAVE WRDS-PER-RECORD
	IMUL	AC10,AC5	;WORDS PER LOGBLK
	JUMPE	AC5,.+2		; SKIP IF 0 BLK-FACTOR
	TXNN	AC13,DV.MTA	; SKIP IF MTA
	POPJ	PP,		; ELSE CONTINUE
	CAIGE	AC10,MINMTA	; SKIP IF LOG BLK NOT TOO SMALL
	MOVEI	AC10,MINMTA	; ELSE USE MINIMUM MTA SIZE
	IMUL	AC6,AC10	; CALC CHARS/LOG-BLK
	MOVEM	AC6,D.TCPL(I16)	; SAVE CHARS PER LOG-BLK
	POPJ	PP,		;

OPNWP4:	SKIPGE	D.F1(I16)	; IF VARIABLE LEN EBCDIC RECORDS
	ADDI	AC10,(AC6)	; INCLUDE RDW WITH REC-SIZE
	JRST	OPNWP6		;

OPNWP1:	HRRZ	AC6,D.RFLG(I16)	; GET RUNTIME FLAGS
	TRNN	AC6,SASCII	; STANDARD ASCII?
	ADDI	AC10,2		; NO, ACCOUNT FOR CRLF
	TRNE	AC6,INDASC	; IS IT INDUSTRY-COMP ASCII?
	TXNN	AC13,DV.MTA	; YES,IS DEVICE A MTA?
	JRST	OPWP6B		; NO,CONT

	; HERE FOR ASCII WITH INDUSTRY COMPAT. MODE

	MOVEI	AC6,4		; FOUR CHARS PER WORD FOR IND-ASCII TAP
	TDNA			; SKIP

OPWP6B:	MOVEI	AC6,5		; FIVE CHARS PER ASCII WORD
	HRRZM	AC6,D.BPW(I16)	; CHARS PER WORD


OPNWP6:
IFN ISAM,<
	TLNE	FLG,IDXFIL	;[372] INDEX FILE?
	JRST	OPNWP5		;[372]  YES USE DIFFERENT CALC
>
	TLNE	FLG,RANFIL 	; SKIP IF NOT DUMP MODE RANDOM IO
	TLNN	FLG,DDMASC!DDMEBC ; SKIP IF ASCII OR EBCDIC FILE
	JRST	OPWP6A		; ELSE GO ON 
				; EBCDIC AND ASCII RAN/IO RECS ARE WORD BLOCKED
	ADDI	AC10,-1(AC6)	; ROUND UP
	IDIVI	AC10,(AC6)	; GET WRDS PER REC
	HRRZM	AC10,D.WPR(I16)	; SAVE WRDS-PER-RECORD
	IMUL	AC10,AC5	; GET WRDS PER BLOCK
	MOVEM	AC10,AC6	; SETUP AC6
	JRST	OPNWP8		; NOW GO ON


OPWP6A:	MOVEM	AC10,D.CPR(I16)	; SAVE CHARS PER RECORD FOR NON RANDOM FILES
	IMUL	AC10,AC5	;[372] NO. OF CHARS IN LOGIGAL BLOCK
	PUSH	PP,AC10		; SAVE CPL
	ADDI	AC10,-1(AC6)	;[372] ROUND UP
	IDIVI	AC10,(AC6)	;[372] NO. OF WORDS PER LOGICAL BLOCK
	POP	PP,AC6		; RESTORE CHARS-PER-LOGI-BLK
OPNWP8:	MOVEM	AC6,D.TCPL(I16)	; TOTAL CHARS/LOG-BLOCK
	TLNE	FLG,OPNIN	; D.FCPL MUST BE ZERO FOR
	SETZ	AC6,		; THE FIRST READ UUO
	MOVEM	AC6,D.FCPL(I16)	; FREE CHARS/LOG-BLOCK
	TLNE	FLG1,VLREBC	;[431] VAR-LEN EBCDIC FILE?
	ADDI	AC10,1		; YES - ADD 1 FOR BDW
	JUMPE	AC5,.+2		; SKIP IF 0 BLK-FACTOR
	TXNN	AC13,DV.MTA	; SKIP IF MTA
	POPJ	PP,		; ELSE CONTINUE
	CAIGE	AC10,MINMTA	; SKIP IF LOG BLK NOT TOO SMALL
	MOVEI	AC10,MINMTA	; ELSE USE MINIMUM MTA SIZE
	POPJ	PP,		; [372]

;RECORDING MODE IS BINARY--CONVERT SIZE TO WORDS

OPNWP3:	MOVEI	AC6,1		; BINARY FILES
	MOVEM	AC6,D.BPW(I16)	; HAVE ONE BYTE PER WORD
	LDB	AC6,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC6,RBPTBL(AC6)	; AND THEN CHARS PER WORD
	JRST	OPNWP2
	;SET DEVICE TABLE BUFFER HEADER BYTE SIZE
	;SETUP CONVERSION FLG  ***OPNLO***

OPNBSI:
	HRRZ	AC1,D.RFLG(I16)	; GET RUNTIME FLAGS
	TRNN	AC1,INDASC	; IS IT INDUSTRY-COMP ASCII?
	JRST	OPNBS0		; NO,CONT

	; HERE FOR STD-ASCII WITH INDUSTRY COMPAT. MODE

	MOVEI	AC6,^D8		; SET 8 BIT BYTES
	JRST	OPNBS2		; AND INDUSRTY COMPAT-MODE

OPNBS0:	JUMPGE	FLG,OPNBS3	;JUMP IF DEVICE IS NOT ASCII
	MOVEI	AC6,7		; ASCII GETS 7 BITS
	JRST	OPNBS1		; GO SET IT, NEEDED FOR BYTE MODE CASES
OPNBS3:	TLNE	FLG,DDMBIN	;IF MODE IS BINARY,
	JRST	OPNBPB		;  DON'T TOUCH BYTE POINTER
	MOVEI	AC6,6		;SIXBIT BYTE SIZE
	TLNN	FLG,DDMEBC	; SKIP IF EBCDIC
	JRST	OPNBS1		; NOT EBCDIC
	MOVEI	AC6,^D9		; EBCDIC IS 9 BITS WIDE
	TXNN	AC13,DV.MTA	; IS DEVICE A MTA?
	JRST	OPNBS1		; NO
	HRRZ	AC1,F.WDNM(I16)	; HOW MANY TRACKS ON THIS DRIVE?
	MOVE	AC1,(AC1)	; SIXBIT DEVICE NAME FOR
	MTCHR.	AC1,		; GET CHARACTERISTICS
	 SETZ	AC1,		;[431] ERROR RET - ASSUME ITS OK (IE 9TRK)
	TRNE	AC1,MT.7TR	; 9 CHANNEL?
	JRST	OPNBS1		; 7 CHANNEL.
	MOVEI	AC6,^D8		; 9TRK SO 8 BITS WIDE
OPNBS2:	XCT	MTIND.		; AND INDUSTRY COMPATIBLE MODE
OPNBS1:	DPB	AC6,DTIBS.	;INPUT HEADER BYTE-POINTER
	DPB	AC6,DTOBS.	;OUTPUT H...

OPNCON:	LDB	AC0,[POINT 3,FLG,2]	; GET DEVICE DATA MODE
	LDB	AC1,[POINT 3,FLG,14]	; GET CORE DATA MODE
	CAME	AC0,AC1		; EQUAL?
	TLO	FLG,CONNEC	; NO, SET THE CONVERSION FLAG
	;PRESUMES AC10 HAS WRDS/LOGICAL BLOCK
	;SETUP BUFFERS PER LOGICAL BLOCK AND
	;NUMBER OF RECORDS TO A RERUN DUMP
	;AND THE CONVERSION INSTRUCTION.

OPNBPB:	LDB	AC1,[POINT 2,FLG,2]	; GET DEVICE DATA MODE
	LDB	AC2,[POINT 2,FLG,14]	; AND CORE DATA MODE
	MOVE	AC3,@RCTBL(AC1)		; GET CONVERSION INSTRUCTION
	TLNE	FLG,DDMBIN		; IF A BINARY DEVICE
	MOVSI	AC3,(TRN)		; NO CONVERSION
	MOVEM	AC3,D.RCNV(I16)		; SAVE FOR LATER - READ
	MOVE	AC3,@WCTBL(AC2)		; GET CONVERSION INSTRUCTION
	TLNE	FLG,DDMBIN		; IF A BINARY DEVICE
	MOVSI	AC3,(TRN)		; NO CONVERSION
	MOVEM	AC3,D.WCNV(I16)		; SAVE FOR LATER - WRITE

	HRR	AC10,F.RRRC(I16);GET RERUN RECORD COUNT
	HRRZM	AC10,D.RRD(I16)	;NUMBER OF RECORDS TO A RERUN DUMP
	LDB	AC10,F.BCRC	; GET CHK-PNT REC COUNT
	JUMPE	AC10,.+2	; SKIP IF NONE SET (D.CRC MAY NOT BE THERE)
	MOVEM	AC10,D.CRC(I16)	; ELSE,INITIALIZE IT 
	TXNE	AC16,OPN%EX	; SKIP IF NOT OPEN EXTEND
	JRST	OPNBP4		; ELSE,CONT D.BCL ALREADY SET
	MOVE	AC10,D.BPL(I16)	; GET BUFFS PER LOG-BLK
	TLNE	FLG1,VLREBC	; IF EBCDIC VARIABLE LEN-RECS INIT
	SETZ	AC10,		; D.BCL TO ZERO FOR FIRST READ UUO
	MOVEM	AC10,D.BCL(I16)	;CURRENT BUFBLK

OPNBP4:	TXNE	AC13,DV.MTA	;SKIP IF NOT A MAGTAPE
	JRST	OPNMTA		;SET DENSITY, PARITY & POSITION THE MAGTAPE
	;DO A LOOKUP OR READ A LABEL.  SETUP DEVICE TABLE REEL
	;NUMBER AND NUMBER OF FIRST BLOCK OF FILE.  ***OPNBBF***

OPNLO:	TXNN	AC16,V%OPEN	;OPEN UUO SKIPS
	JRST	OPNLO1		;
	MOVEI	AC0,' 01'	;SIXBIT REEL NUMBER '01'
	TXNN	AC16,CLS%RO	;SKIP IF A CLOSE REEL GENERATED OPEN
	DPB	AC0,DTRN.	;INITIALIZE THE REEL NUMBER
OPNLO1:	TLNN	FLG,OPNIN!RANFIL!IDXFIL ;SKIP IF INPUT/IO
	JRST	OPNBBF		;OUTPUT. BBF USE PRO.
OPNLUP:	PUSHJ	PP,OPNLID	;SETUP LOOKUP BLOCK WITH ID
	TLNE	FLG1,MSTNDR	;[1115] IS MONITOR PROCESSING LABELS?
	JRST	OPNBBF		;[1115] YES, THEN SKIP THIS
	TXNN	AC13,DV.DIR	;SKIP IF DIRECTORY DEVICE
	JRST	OPNRLB		;READ LABEL INTO RECORD AREA
IFN TOPS20, <
	SKIPGE	MNTR5		;[1102] IF MONITOR NOT AT LEAST V5.0,
	JRST	OPNLO2		;[1102]  DIDN'T DO THE LOOKUP
	TLNN	FLG,OPNOUT	;[667] IF INPUT (READ) ONLY FOR A DISK FILE
	TXNN	AC13,DV.DSK	;[667]  WE HAVE ALREADY DONE THE LOOKUP VIA COMPT. UUO
	TRNA			;[1007] NOT
;[1050]	JRST	OPNLU3		;[1007] YES IT IS, ULBLK. IS CORRECT
	JRST	[TLNE	FLG,RANFIL	;[1050] IF RANDOM FILE,
		 PUSHJ	PP,OPNEL2	;[1050]  SET D.LBN, LAST BLK NBR
		 JRST	OPNLU3]		;[1050]  (USE EXTENDED LKUP BLK)
OPNLO2:				;[1102] 
>; END TOPS20
	SKIPE	F.WSMU(I16)	;OR SIMULTANEOUS UPDATE?
	JRST	OPNLU2		;[565] YES, DON'T DO LOOKUP
IFN ANS74,<
	TLNN	FLG,OPNIN!IDXFIL; SKIP IF ISAM OR INPUT FILE
	PUSHJ	PP,OPNENT	; SUPERSEDE THE EXISTING FILE
>
;IFN TOPS20,<			;[570]
;	TLNE	FLG,IOFIL!OPNOUT ;[570] OPEN READ ONLY?
;	JRST	ONCLPA		;[570] NO, DO LOOKUP
;	LDB	AC1,DTIBS.	;[570] GET I-O BYTE SIZE
;	PUSH	PP,AC1		;[570] SAVE IT
;				;[570] THIS IS NECESSARY BECAUSE
;***	IF THIS IS EVER USED AGAIN,THE INPUT BUFFER CONTROL
;***	BLOCK (D.IBH,D.IBB,D.IBC) MUST BE SAVED HERE
;***	AND LATER RESTORED.
;				;[570] THE COMPT. UUO CRUNCHES IT
;	PUSHJ	PP,OCPTNW	;[570] YES, OPEN IN THAWED MODE
;	 JRST	[POP	PP,(PP)	;[570] GET RID OF BYTE SIZE
;		JRST	OCPER]	;[570] ERROR IN THAWED OPEN
;	POP	PP,AC1		;[570] GET I-O BYTE SIZE
;	DPB	AC1,DTIBS.	;[570] RESTORE INPUT BYTE SIZE
;	DPB	AC1,DTOBS.	;[570] RESTORE OUTPUT BYTE SIZE
;	JRST	OPNLU2		;[570] CONT WITHOUT LOOKUP
;ONCLPA:	>;[570] END IFN TOPS20

	XCT	ULKUP.		;*** LOOKUP ***************
 	 JRST	OPNLER		;ERROR RETURN FOR LOOKUP AND COMP.

OPNLU1:	TLNE	FLG,IOFIL!RANFIL	;[622][475] IF DUMP MODE I-O
	PUSHJ	PP,OPNEL1	;[565] CALC D.LBN

;IF METERING STORE SIZE OF FILE RETURNED BY LOOKUP
IFN LSTATS,<
	TLNE	FLG,OPNOUT 	;[622] OPEN READ ONLY?
	JRST	OPNLU3		; NO, GO ON
	LDB	AC1,DTCN.	; YES,GET CHANNEL NUMBER
	MOVE	AC1,MROPTT(AC1)	; GET FILE BLOCK ADDRESS
	HLRE	AC2,ULBLK.+LKPSIZ ; GET FILE SIZE RETURNED BY LOOKUP
	MOVEM	AC2,MB.FSZ(AC1)	; SAVE LOOKUP TIME FILE SIZE
>;END IFN LSTATS

	JRST	OPNLU3		;[565] AND-OR CONT

OPNLU2: LDB	AC0,F.QOPN	;[565] GET SMU OPEN FLAG
	JUMPN	AC0,OPNLU3	;[565] JUMP IF OPEN AFTER LFENQ. OPEN
	PUSHJ	PP,OPNEL2	;[565] NO SMU OR SMU WITH LFENQ. OPEN,
				;[565] SET D.LBN

IFN BIS,<
	DMOVE	AC0,ARGBK.+.RBEXT	;[612] GET EXTENSION, DATE AND PROTECTION BITS
	DMOVEM	AC0,ULBLK.+1		;[612] INTO SHORT LOOKUP BLOCK.
>
IFE BIS,<
	MOVE	AC0,ARGBK.+.RBEXT	;[612] GET EXTENSION AND DATE BITS
	MOVEM	AC0,ULBLK.+1		;[612] INTO SHORT LOOKUP BLOCK.
	MOVE	AC0,ARGBK.+.RBPRV	;[612] ALSO PROTECTION AND BITS
	MOVEM	AC0,ULBLK.+2		;[612] INTO SHORT BLOCK.
>
OPNLU3:				;[565]


	SETZM	D.CBN(I16)	;THE FIRST BLOCK OF ALL
	TLNN	FLG,RANFIL	;  BUT RANDOM FILES
	AOS	D.CBN(I16)	;  IS ONE.

	PUSHJ	PP,ZROSLA	;ZERO THE STD LABEL AREA
IFN BIS,<
	DMOVE	AC0,ULBLK.	;FILE NAME & EXTENSION
>
IFE BIS,<
	MOVE	AC0,ULBLK.	;FILE NAME
	MOVE	AC1,ULBLK.+1	;EXTENSION
>
IFE TOPS20,<
	TXNE	AC13,DV.DTA	;SKIP IF NOT A DTA
	HRRM	AC1,D.CBN(I16)	;SAVE AS THE FIRST BLOCK NUMBER
>
	TRZ	AC1,-1		;THEN ZERO IT
	ROTC	AC0,14		;
	MOVEM	AC0,STDLB.+1	;
	HLLM	AC1,STDLB.+2	;
	HRLI	AC1,'HDR'	;LABEL TYPE
	IORI	AC1,'1  '
	MOVEM	AC1,STDLB.	;
	LDB	AC4,[POINT 12,ULBLK.+2,35]	;GET LOW ORDER CREA DATE
	LDB	AC1,[POINT 3,ULBLK.+1,20]	;[274] GET HIGH ORDER
	DPB	AC1,[POINT 3,AC4,23]		;[274] MERGE THE ORDERS
	PUSHJ	PP,TODA1.	;CREATION DATE
	SETZ	AC1,		;
	ROTC	AC0,6		;
	MOVEM	AC0,STDLB.+7	;DATE
	MOVEM	AC1,STDLB.+6	;DATE
	PUSHJ	PP,OPNCA1	;MOVE STD-LABEL AREA TO RECORD AREA
	JRST	OPNBBF
	;THIS ROUTINE FINDS THE NUMBER OF THE FIRST SECTOR OF THE LAST
	;LOGICAL BLOCK OF THE  SEQIO FILE


OPNEL1:	HLRE	AC5,ULBLK.+LKPSIZ	;[565] GET FILE SIZE RETURNED

;IF METERING STORE SIZE OF FILE RETURNED BY LOOKUP
IFN LSTATS,<
	LDB	AC1,DTCN.	;GET CHANNEL NUMBER
	MOVE	AC1,MROPTT(AC1)	;GET FILE BLOCK ADDRESS
	MOVEM	AC5,MB.FSZ(AC1)	;PUT SIZE INTO FILE BLOCK BUCKET
>;END IFN LSTATS

	JUMPGE	AC5,OPNEL4		;[565] SKIP AHEAD IF LOOKUP RETURNS BLKS
	MOVNS	AC5			;[565] NEGATE LOOKUP NUMBER OF WRDS
	ADDI	AC5,177			;[565] DIVIDE WORDS WRITTEN BY
	IDIVI	AC5,200			;[565] WRDS/BLK AND ROUND UP
	JRST	OPNEL4			;[565] CONT CALC.

OPNEL2:	MOVE	AC5,ARGBK.+.RBSIZ	; GET LAST BLOCK OF FILE

;IF METERING STORE SIZE OF FILE RETURNED BY EXTENDED LOOKUP
IFN LSTATS,<
	LDB	AC1,DTCN.	;GET CHANNEL NUMBER
	MOVE	AC1,MROPTT(AC1)	;GET FILE BLOCK ADDRESS
	MOVNM	AC5,MB.FSZ(AC1)	;PUT SIZE INTO FILE BLOCK BUCKET
				;MAKE NEGATIVE TO SHOW ITS WORDS
>;END IFN LSTATS

	ADDI	AC5,177			; DIVIDE WORDS WRITTEN BY
	IDIVI	AC5,200			; WRDS/BLK AND ROUND UP

OPNEL4:	MOVE	AC6,D.BPL(I16)		;[565] GET NUMBER OF FIRST
	IDIV	AC5,AC6			; LOGICAL BLOCK
	IMUL	AC5,D.BPL(I16)		;[475] SIZE IN PHYSICAL BLOCKS
	SKIPE	AC6			;[475] IF REMAINDER WE HAVE
	AOJA	AC5,OPNL2A		;[475] PART LAST BLOCK 
	MOVE	AC6,D.BPL(I16)		;[475] LAST BLOCK FULL
	SUBI	AC6,1			;[475] CALC FIRST PHYSICAL BLOCK
	SUB	AC5,AC6			;[475] OF LAST LOGICAL BLOCK
	SKIPG	AC5			;[475] IF FILE DOESN'T EXIST
	MOVEI	AC5,1			; ONE IS THE FIRST BLOCK
OPNL2A:	MOVEM	AC5,D.LBN(I16)		; SAVE IT FOR SEQIO
	POPJ	PP,			;

OPNLER:	MOVEI	AC2,^D30	;PREPARE TO SET FILE STATUS TO "PERMANENT ERROR"
	MOVEM	AC2,FS.FS	; FOR ALL TYPES OF LOOKUP ERRORS
	HRRZ	AC2,ULBLK.+1	;
	TRNE	AC2,37		;IS IT FILE-NOT-FOUND?
	JRST	OLERR		;NO, OTHER
	TLNN	FLG,IDXFIL	;DONT MAKE FILE IF ISAM FILE
	TLNE	FLG,OPNOUT	; OR IF AN INPUT FILE
	TLNN	FLG,RANFIL!IOFIL ;[622] RANDOM OR IO OUTPUT FILE?
	JRST	OLERR		;NO

IFN ANS74,<

;28-MAY-80: IF THE FILE IS BEING OPENED FOR I/O,
;	IT DOESN'T MAKE SENSE TO CREATE A NEW FILE IN COBOL-74,
;	BECAUSE HE IS NOT ALLOWED TO USE THE "WRITE" VERB

	TLNE	FLG,OPNIN	;WE KNOW OUTPUT FLAG IS ON, IS INPUT FLAG
				; ON ALSO?
	 JRST	OLERR		;YES, GO GIVE ERROR

>;END IFN ANS74

;THIS IS A RANDOM OR SEQ. FILE, BEING OPENED FOR I/O OR OUTPUT.
;THE FILE WAS NOT THERE.

	SETZM	FS.FS		; NOT AN ERROR, CLEAR FILE STATUS
	PUSHJ	PP,OPNENT	; SO MAKE A NULL FILE
	JRST	OPNLUP		; OK TRY THE LOOKUP AGAIN

	;HERE TO CREATE A NULL FILE FOR USER
OPNENT:	PUSHJ	PP,OPNEID	;SETUP FOR AN ENTER
	XCT	UENTR.		;CREATE A NULL FILE
	 JRST	OEERR		;ERROR RETURN
	XCT	UCLOS.
	POPJ	PP,
	; THIS ROUTINE OPENS A FILE VIA THE "FILOP." UUO
OPNFOP:	MOVE	AC0,UOBLK.	;SET THE DATA MODE
	MOVEM	AC0,FOP.IS
IFN ISAM,<
	TLNN	FLG,IDXFIL	; ISAM FILE?
	JRST	OPNFPD		; NO
	TLO	FLG1,FOPIDX	; ENTRY FOR ".IDX" FILE
	PUSHJ	PP,OPNLIX	; GET VID TO LOOKUP BLOCK
	MOVE	AC0,ICHAN(I12)	; CHANNEL FOR .IDX FILE
	JRST	OPNFP2
OPNFPD:	>;END IFN ISAM
	PUSHJ	PP,OPNLID	; GET VID TO LOOKUP BLOCK
	LDB	AC0,DTCN.	;[576] GET CHANNEL NUMBER
OPNFP2:	HRRZ	AC5,F.RPPN(I16)		;[576] GET POINTER TO PPN
IFN TOPS20,<				;[644]
	SKIPE	AC5			;[576] USE DEFAULT PPN IF NONE
>
IFE TOPS20,<
	JUMPN	AC5,OPNFP3	;[644] JUMP IF A PPN GIVEN

	;[644] HERE IF NO PPN, SETUP DEFAULT PATH

	MOVEI	AC1,.PTFRD	;[644] SET READ DEFAULT PATH FUNCTION
	MOVEM	AC1,PTH.BK##	;[644] INTO ARG BLOCK
	MOVE	AC1,[XWD .PTMAX,PTH.BK]	;[644] INDICATE PATH ARG BLOCK LOC
	PATH.	AC1,		;[644] GET DEFAULT PATH
	 POPJ	PP,		;[644] ERROR RETURN
	MOVEI	AC5,PTH.BK	;[644] INDICATE PATH BLOCK FOR PPN FIELD
	MOVE	AC1,UOBLK.+1	;[1030] GET SIXBIT NAME
	DEVNAM	AC1,		;[1030] IS DEVICE AN ERSATZ?
	 JRST	OPNF2A		;[1030] NO CONTINUE
	CAME	AC1,UOBLK.+1	;[1030] SAME NAME?
	JRST	OPNF2A		;[1030] NO, CONTINUE
	DEVPPN	AC1,		;[1030] GET PPN
	 JRST	OPNF2A		;[1030] CONTINUE
	CAME	AC1,PTH.BK+2	;[1030] SAME PPN?
	SETZM	PTH.BK+3	;[1030] NO, MUST BE ERSATZ SO CLEAR SFD
OPNF2A:				;[1030] 
	TDNA			;[644] SKIP

OPNFP3:	> ;[644] END IFE TOPS20

	MOVE	AC5,(AC5)		;[576] GET THE PPN
	MOVEM	AC5,ARGBK.##+.RBPPN	;[576] SET PPN OR PATH LOC
	MOVE	AC5,[ULBLK.,,ARGBK.+.RBNAM];[576] GET FILE NAME
	BLT	AC5,ARGBK.+.RBEXT	;[576] AND EXTENSION
	HLLZS	ARGBK.+.RBEXT		;[576] ZERO DATE FIELD
	SETZM	ARGBK.+.RBPRV		;[576] AND PRIVILIGE FIELD
	SETZM	ARGBK.+.RBSIZ		;[576] AND SIZE FIELD
	HRLI	AC0,.FORED	;[576] DO EXTENDED LOOKUP TO SEE IF THERE
	TXNE	AC16,OPN%EX	; OR OPEN EXTENDED
	HRLI	AC0,.FOAPP	; APPEND
	IORI	AC0,(FO.PRV)	;[656] SET BIT 0 ON IN WORD 0 OF FILOP ARG BLK
	MOVSM	AC0,FOP.BK	; SAVE IN FILOP BLOCK
	MOVE	AC0,UOBLK.+1	; GET DEVICE NAME
	MOVEM	AC0,FOP.DN	;
	MOVEI	AC0,ARGBK.	;[576] GET ADR OF LOOKUP BLOCK
	MOVEM	AC0,FOP.LB	; 
	TXNE	AC16,OPN%EX	; IF APPEND
	JRST	RET.2		; DELAY UNTIL BUFFERS SET UP
	SETZM	FOP.BH		;[662] CLEAR BUFFER HDR ADDR WHEN USING DUMP MODE
	SETZM	FOP.BN		;[662] ..
	MOVE	AC1,[7,,FOP.BK]	; SET UP FILOP'S AC
	FILOP.	AC1,		;[576] DO THE LOOKUP
IFN ANS74,<
	POPJ	PP,		; ERROR RETURN FOR 74
>
IFN ANS68,<
	 JRST	[SKIPN	AC1		;[576]SKIP IF ERROR CODE NON-0
		 TLNE	FLG,IDXFIL	;[576]FILE NOT FOUND,SKIP IF NOT ISAM
		 POPJ	PP,		;[576] GIVE ERROR RETURN
		 MOVE	AC1,[7,,FOP.BK]	;[576]RESTORE FILOP ARG
		 JRST	.+1	]	;[576]NON ISAM FILE NOT FOUND,WILL CREATE ONE
>;END IFN ANS68
IFN ISAM,<TLZ	FLG1,FOPIDX>	;[576] CLEAR FLAG
;	HRRZ	AC5,F.RPPN(I16)	; [644] GET POINTER TO PPN
;	SKIPE	AC5		; [644] USE DEFAULT PPN IF NONE
;	MOVE	AC5,(AC5)	; [644] GET THE PPN
;	MOVEM	AC5,ARGBK.+.RBPPN ; [644] RESET PPN IN LKP/ENTR BLK
	MOVEI	AC0,.FOMAU	;[576] NOW SET FOR 
	HRRM	AC0,FOP.BK	;[576] SIMULTANEOUS UPDATE
	FILOP.	AC1,		;[576] DO IT *************
	 POPJ	PP,		;[576] ERROR RETURN
	JRST	RET.2		;[576] ALL OK,EXIT


	; FILOP ERROR
	; AC1 CONTAINS THE ERROR CODE RETURNED BY THE FILOP

OFERR:	SETZM	FS.IF		; IDA-FILE FLAG
IFE ISAM,<TLO	FLG1,FOPERR>	; FILOP. FAILED
IFN ISAM,<
OFERRI:	MOVEI	AC0,^D30	;GET FILE-STATUS CODE = PERM. ERROR
	MOVEM	AC0,FS.FS	;SET IT UP
	MOVE	AC0,[E.MFOP+E.FIDX] ;MAKE AN ERROR NUMBER
	TLON	FLG1,FOPIDX	; REMEMBER IT'S A FILOP ERROR
	MOVE	AC0,[E.MFOP+E.FIDA]
	TLNN	FLG,IDXFIL	; ISAM FILE?
>;END IFN ISAM
	MOVE	AC0,[E.MFOP]	; NO
	MOVEM	AC1,ULBLK.+1	; [636] STORE ERROR CODE
	PUSHJ	PP,ERCDF	; IGNORE ERROR?
	 JRST	RCHAN		; YES
	JRST	LUPERR		; NO
SUBTTL	OPEN VERB	TOPS-20 COMPT. UUO

IFN TOPS20,<

EXTERN CP.BLK,CP.BK1,CP.BK2,CP.BK3,CP.BK4,CP.BK5,CP.BK6,CP.BK7,FID.PT
EXTERN FID.BK,TMP.BK,TMP.PT
	E.MCPT==^D3000000	; [431] [1015] [1057] MONITOR COMPT. UUO ERROR

; [431]HERE IF THIS IS A DECSYSTEM-20 TO OPEN FILE FOR SIMULTANEOUS UPDATING

; [431]INIT THE CMPT. JSYS ARG BLOCK
OCPT:	TLNN	FLG,IDXFIL		; [431] ISAM FILE?
	JRST	OCPTD			; [431] NO
	PUSHJ	PP,OPNLIX		; [431] YES, GET VID TO LOOKUP BLOCK
	TLOA	FLG1,FOPIDX		; [431] AN IDX FILE
OCPTD:	; [431]ENTRY POINT FOR ISAM.IDA FILES
	PUSHJ	PP,OPNLID		; [431] NO, GET VID...
OCPTNW:	;[570] ENTRY POINT FOR THAWED ACCESS FOR READ ONLY
	SETZM	CP.BK1			; [431] AC1 GTJFN BITS
	
;BUILD A TOPS20 FILE-DESCRIPTOR STRING - AC2 GTJFN BITS
;FIRST JUST MOVE THE DEVICE NAME
	MOVE	AC1,[FID.BK,,FID.BK+1]	; CLEAR ALL STUFF
	SETZM	FID.BK
	BLT	AC1,FID.BK+14
	MOVE	AC1,[TMP.BK,,TMP.BK+1]
	SETZM	TMP.BK
	BLT	AC1,TMP.BK+14
	MOVE	AC5,TMP.PT		; GET POINTER TO TEMP FILE-DESCRIPTOR
	MOVEM	AC5,CP.BK2		; INIT COMPT. ARG BLOCK
	MOVE	AC0,UOBLK.+1		; GET THE DEVICE NAME
	MOVEM	AC0,CP.BK3		; SET UP FOR COMPT. FUNCT 3--MAYBE
;CONVERT PPN TO <DIRECTORY>
	HRRZ	AC1,F.RPPN(I16)		; GET ADR OF PPN
	JUMPE	AC1,OCPT4		; JUMP IF YOU HAVN'T GOT ONE
	SKIPN	@AC1			; [463] SKIP IF YOU REALLY GOT ONE
	JRST	OCPT4			; [463] PPN PROVIDED WAS [0,0]
	MOVE	AC1,(AC1)		; GET PPN FROM ADR
	MOVEM	AC1,CP.BK1		; PPN TO THE ARG-BLOCK
	MOVEI	AC0,CMP.3		; FUNCTION 3
	MOVEM	AC0,CP.BLK		;
	MOVE	AC0,[4,,CP.BLK]		; SETUP FOR COMPT.
	COMPT.	AC0,			; MOVE DIR # TO STRING
	  POPJ	PP,			;
;SETUP THE CP.BK? ARGUMENT BLOCK FOR COMPT. UUO
OCPT4:	MOVE	AC5,TMP.PT		; GET STRING PTR BACK
	MOVEI	AC1,7			; CHECK FOR STR RETURNED
OCPT1:	ILDB	C,AC5			; VER 1B RETURNED ONLY THE DIRECTORY
					; VER 2 RETURNS STR:<DIR>
	JUMPE	C,OCPT1X		; NO COMPT. DONE, GET DEV NAME
	CAIN	C,":"			; IT IS ALSO POSSIBLE THAT WHEN
	JRST	OCPT2A			; HERE WE DID NOTHING AND NOW
	SOJG	AC1,OCPT1		; NEED TO INSERT DEVICE NAME FOR OPENF.
OCPT1X:	MOVE	AC0,[POINT 6,UOBLK.+1]	; WE DIDN'T DO COMPT. OR IT WAS A VER 1B
	MOVEI	AC1,6			; SO WE MUST NOW PUT IN STR:
	MOVE	AC5,FID.PT		; GET REAL STRING PTR
OCPT1A:	ILDB	C,AC0
	JUMPE	C,OCPT2			; GO SEE IF <DIRECTORY> IS NEEDED
	ADDI	C,40			; PA1050 WANTS IT IN ASCII
	IDPB	C,AC5
	SOJG	AC1,OCPT1A
OCPT2:	MOVEI	C,":"
	IDPB	C,AC5
	HRRZ	AC1,F.RPPN(I16)		; DID USER SUPPLY A PPN?
	JUMPE	AC1,OCPTV2		; NO, WE'RE FINALLY DONE
	SKIPN	@AC1			; HE GAVE ONE, BUT IS IT REALLY 0
	JRST	OCPTV2			; IT WAS 0, SO WE'RE DONE
	MOVEI	C,"<"			; MOVE IT FROM TEMP STRING TO
	IDPB	C,AC5			; REAL STRING
	MOVE	AC0,TMP.PT
OCPT1B:	ILDB	C,AC0
	JUMPE	C,OCPT1C
	IDPB	C,AC5
	JRST	OCPT1B
OCPT1C:	MOVEI	C,">"
	IDPB	C,AC5
	JRST	OCPTV2			; WE NOW HAVE A COMPLETE STRING OF THE FORM
					; STR:<DIRECTORY>
OCPT2A:	MOVE	AC5,FID.PT		; VER 2 SUPPLIED THE <DIR>
	MOVE	AC1,TMP.PT		; SO WE NEED TO MOVE IT TO THE
	MOVEI	AC0,^D90		; REAL STRING AREA AND GET AC5 CORRECT
OCPT2B:	ILDB	C,AC1			; MOVE FROM TMP.BK TO FID.BK
	JUMPE	C,OCPTV2
	IDPB	C,AC5
	SOJG	AC0,OCPT2B
OCPTV2:
	MOVX	AC0,GJ%OLD+GJ%SHT	; SPECIFY THE SHORT FORM OF
	MOVEM	AC0,CP.BK1		; [431]  GTJFN JSYS
	MOVE	AC0,FID.PT		; [431] GET POINTER TO FILE DESCRIPTOR STRING
	MOVEM	AC0,CP.BK2		; [431]  FOR OPENF ARGUMENT

; [431]MOVE VALUE OF ID TO F-D STRING
	TLNE	FLG,IDXFIL		; [431] SKIP IF NOT ISAM FILE
	TLNE	FLG1,FOPIDX		; [431] SKIP IF ISAM .IDA FILE
	SKIPA	AC4,F.WVID(I16)		; [431] BYTE-PTR TO VALUE OF ID
	MOVE	AC4,[POINT 6,DFILNM(I12)]; [431] .IDA - SO VALUE-ID IS HERE
	MOVEI	AC0,11			; [431] MAX OF 11 CHARS
OCPT5:	ILDB	C,AC4			; [431] GET A CHAR
	TLNN	AC4,600			; [431] IS VID IN EBCDIC?
	LDB	C,PTR.97##		; [616] [431] YES - CONVERT IT TO ASCII
	TLNN	AC4,100			; [431] HOW ABOUT SIXBIT?
	ADDI	C,40			; [431] YES, CONVERT IT TO ASCII
	CAIE	C," "			; [431] SPACES ARE IGNORED IN FILENAME
	IDPB	C,AC5			; [431] STUFF IT AWAY
	CAIE	AC0,4			; [431] IS IT TIME FOR A "."?
	SOJN	AC0,OCPT5		; [431] NO - LOOP TILL DONE
	JUMPE	AC0,OCPT6		; [431] JUMP IF DONE
	MOVEI	C,"."			; [431] TERMINATE THE FILENAME
	IDPB	C,AC5			; [431]
	SOJN	OCPT5			; [431] BACK FOR THE EXTENSION
OCPT6:	SETZB	C,AC0			; [431] A NULL
	IDPB	C,AC5			; [431] TERMINATE THE STRING
	
; [431]INIT AC2 OPENF BITS
	TLNE	FLG,DDMASC		; [431] DEVICE DATA MODE ASCII?
	TLO	AC0,(7B5)		; [431] YES
	TLNE	FLG,DDMSIX		; [431] SIXBIT?
	TLO	AC0,(6B5)		; [431] YES
	TLNE	FLG,DDMBIN		; [431] BINARY?
	TLO	AC0,(44B5)		; [431] YES
	TLNN	FLG,DDMEBC		; [431] EBCDIC?
	JRST	OCPT10			; [431] NO
	TLO	AC0,(10B5)		; [431] ASSUME DEVICE IS A MAG-TAPE
	TXNN	AC13,DV.MTA		; [431] DEVICE A MTA?
	TLO	AC0,(11B5)		; [431] NO, ITSA DSK
	
OCPT10:	TLNE	FLG,IOFIL!RANFIL!IDXFIL	; [622] [431] RANDOM,INDEXED OR IO FILES
	TLO	AC0,(17B9)		; [431]  ARE DUMP MODE
	TLNE	FLG,RANFIL!IDXFIL!OPNIN ; [622] [431] OPEN FOR INPUT?
	TRO	AC0,OF%RD		; [431] YES
	TLNE	FLG,OPNOUT		; [431] OPEN FOR OUTPUT?
	TRO	AC0,OF%WR		; [431] YES
	SKIPL	MNTR5			;[1102] IF NOT AT LEAST V5.0,
	JRST	OCPT11			;[1102]  NO UNRESTRICTED READ DEFINED
	TRO	AC0,OF%THW		; [431] THAWED I.E. SIMULTANEOUS UPDATE
	JRST	OCPT12			;[1102]
OCPT11:	SKIPN	F.WSMU(I16)		;[1102][667] SIMULTANEOUS UPDATE?
	TRZA	AC0,OF%THW		;[667] NO, CLEAR THAWED BIT
	TROA	AC0,OF%THW		;[667] [431] THAWED I.E. SIMULTANEOUS UPDATE
	TXO	AC0,OF%RDU		;[667] TURN ON READ UNRESTRICTED ALSO
OCPT12:	MOVEM	AC0,CP.BK3		; [1102] [431] INIT AC2 OPENF BITS
	
; [431]INITIALIZE TO TOPS-10 OPEN MODE
	TLNE	FLG,DDMASC		; [431] DATA-MODE ASCII?
	TDZA	AC0,AC0			; YES
	MOVEI	AC0,.IOBIN		; [431] NOT ASCII
	TLNE	FLG,RANFIL!IDXFIL!IOFIL	; [622] [431] THESE FILES NOT BUFFERED
	MOVEI	AC0,.IODMP		; [431] DUMP MODE
	MOVEM	AC0,CP.BK4		; [431] OPEN MODE
	
; [431]LOCATE THE BUFFER HEADERS AND EXTENDED LOOKUP BLOCK
	MOVEI	AC0,D.IBH(I16)		; [431]
	MOVEM	AC0,CP.BK5		; [431] INPUT BUFFER HEADER
	MOVEI	AC0,D.OBH(I16)		; [431]
	MOVEM	AC0,CP.BK6		; [431] OUTPUT BUFFER HEADER
	MOVEI	AC0,ARGBK.		; [431]
	MOVEM	AC0,CP.BK7		; [431] ADR OF EXTENDED LOOKUP BLOCK

; [431]SET UP EXTENDED LOOKUP BLOCK
	HRRZ	AC1,F.RPPN(I16)		; [431] GET ADR OF PPN
	SKIPE	AC1			; [431] USE DEFAULT PPN IF ZERO
	MOVE	AC1,(AC1)		; [431] GET PPN
	MOVEM	AC1,ARGBK.##+.RBPPN	; [431] SETUP PPN
	MOVE	AC1,[ULBLK.,,ARGBK.+.RBNAM]; [431] COPY FILE-NAME.EXT
	BLT	AC1,ARGBK.+.RBEXT	; [431] FROM LOOKUP BLOCK
	HLLZS	ARGBK.+.RBEXT		; [431] CLEAR RIGHT HALF
	SETZM	ARGBK.+.RBPRV		; [431]   AND PRIV
	SETZM	ARGBK.+.RBSIZ		; [431]   AND SIZE
	TLNE	FLG1,FOPIDX		; [431] IF AN ISAM.IDX FILE GET CHAN #
	SKIPA	AC1,ICHAN(I12)		; [431]   FROM HERE
	LDB	AC1,DTCN.		; [431] ELSE FROM HERE
	HRLI	AC1,CMP.1		; [431] THE FUNCTION
	MOVSM	AC1,CP.BLK		; [431] ARG ,, FUNCTION
	MOVE	AC1,[10,,CP.BLK]	; [431] COUNT,,ADR FOR ARG-BLOCK
	TXNE	AC13,DV.MTA		; [1066] IS IT A LABELED MTA?
	PUSHJ	PP,OCP1A		; [1066]  YES, GO SET UP ATTR. BLOCK
	COMPT.	AC1,			; [431] OPEN FILE FOR SIMULTANEOUS UPDATE
	 POPJ	PP,			; [431] ERROR RETURN
IFN ISAM,<TLZE	FLG1,FOPIDX>		;[M1063] [431] CLEAR FLAG

;THE FOLLOWING CHUNK OF CODE CHECKS FOR RELATIVE FILES OPENED UNDER SMU.
; IF A FILE DOES NOT HAVE THE MAXIMUM BYTE COUNT IN ITS FDB A WARNING
; MESSAGE IS ISSUED TO THE USER'S TERMINAL.

	SKIPA	AC2,ICHAN(I12)		;[1063]  GET CHAN # FROM HERE
	LDB	AC2,DTCN.		;[1063]  ELSE FROM HERE
	PUSHJ	PP,GETJFN		;[1063] GET THE JFN
	 SETZ	AC1,			;[1063]  FAILED, CANNOT HAPPEN
	TLNE	FLG,RANFIL		;[1063] IS IT A RELATIVE FILE?
	TLNN	FLG,OPNIO		;[1063]  AND BEING OPENED FOR I-O?
	 JRST	RET.2			;[1063] NO
	SKIPN	F.WSMU(I16)		;[1063]  UNDER SIMULTANEOUS UPDATE?
	 JRST	RET.2			;[1063] NO
	HRRZS	AC1,AC1			;[1063] MAKE SURE ONLY JFN IN AC1
	HRLI	AC2,1			;[1063]  WANT ONLY 1 WORD FROM FDB
	HRRI	AC2,.FBSIZ		;[1063]  THE FILE BYTE COUNT
	HRRZI	AC3,AC0			;[1063]   PUT IT IN AC0
	GTFDB				;[1063] GET THE FDB INFO
	 ERJMP	[POPJ PP,]		;[1063]  SHOULDN'T HAPPEN, TAKE THE ERROR RETURN
	HRLOI	AC2,377777		;[1063] PUT MAX NO. OF BYTES IN AC2
	CAMN	AC0,AC2			;[1063]  SAME AS IN FDB?
	 JRST	RET.2			;[1063]   YES
	MOVE	AC3,AC2			;[1104] NO, PUT MAX BYTES IN AC3
	HRLI	AC1,BYTCTW		;[1104] BYTE COUNT WORD IN FILE'S FDB
	SETO	AC2,			;[1104] MASK FOR FULL WORD
	CHFDB				;[1104] CHANGE FDB
	 ERJMP	[POPJ PP,]		;[1104] TAKE ERROR RETURN
;[1104]	PUSHJ	PP,DSPL1.		;[1063] PUT OUT MESSAGE
;[1104]	OUTSTR	[ASCIZ /% /]
;[1104]	MOVE	AC2,[BYTE (5)10,31,20,14]
;[1104]	PUSHJ	PP,MSOUT1
;[1104]	OUTSTR	[ASCIZ / does not have the maximum file size
;[1104]in its FDB. Run SETEOF before updating to insure no loss of data under SMU.
;[1104] /]
	JRST	RET.2			; [431] NORMAL RETURN

IFN TOPS20,<				;[1066]
;[1066] This routine is used to set up the attribute block for the GTJFN jsys.
;[1066] The GTJFN call uses the attribute block when opening system labeled
;[1066] tapes. The format is set to D if the RECORDING MODE IS ASCII or
;[1066] if the RECORDING MODE IS STANDARD-ASCII.
OCPTFO:	ASCIZ/FORMAT:D/			;[1066]

OCP1A:	PUSH	PP,AC0			;[1066]
	HRRZ	AC0,D.RFLG(I16)		;[1066] Get information flag
	TXNN	AC0,SASCII		;[1066] Recording mode ASCII ?
	JRST	OCP1B			;[1066]  No, exit
	HRRI	AC0,.GJATR-.GJJFN	;[1066] Get number of words
	HRRM	AC0,GJ.BLK##+.GJF2	;[1066] Set up number of extra
					;[1066]  words in GTJFN block
	TXO	AC0,GJ%XTN+GJ%FOU	;[1066] Set GJ%XTN in GTJFN block
	TXZ	AC0,GJ%SHT		;[1066]
	MOVEM	AC0,GJ.BLK+.GJGEN	;[1066]
	HRROI	AC0,GJ.ATR##		;[1066]
	MOVEM	AC0,GJ.BLK+.GJATR	;[1066] GTJFN points to attribute block
	MOVEI	AC0,2			;[1066]
	HRRM	AC0,GJ.ATR		;[1066] Set number of words in attr.
	MOVE	AC0,[POINT 7,OCPTFO]	;[1066] Setup byte pointer in attribute
	MOVEM	AC0,GJ.ATR+1		;[1066]  block
	MOVE	AC0,[.NULIO,,.NULIO]	;[1066]
	MOVEM	AC0,GJ.BLK+.GJSRC	;[1066]
	HRRZI	AC0,GJ.BLK		;[1066]
	MOVEM	AC0,CP.BLK+1		;[1066]
OCP1B:	POP	PP,AC0			;[1066]
	POPJ	PP,			;[1066]
>;END IFN TOPS20			;[1066]

OCPER:	SETZM	FS.IF			; CLEAR .IDA FILE FLAG
	MOVEI	AC0,^D30		; [1057] IT IS A
	MOVEM	AC0,FS.FS		; [1057] PERMANENT ERROR
IFN ISAM,<
OCPERI:	MOVE	AC0,[E.MCPT+E.FIDX]	; MAKE AN ERROR NUMBER
	TLZN	FLG1,FOPIDX		; IDX OR IDA?
	MOVE	AC0,[E.MCPT+E.FIDA]	; IDA!
	TLNN	FLG,IDXFIL		; SKIP IF AN ISAM FILE
>; END IFN ISAM
	MOVE	AC0,[E.MCPT]		; [431]
	PUSHJ	PP,IGCVR		; [431] IGNORE ERROR?
	 JRST	RCHAN			; [431] YES
OCPERR:	OUTSTR	[ASCIZ /COMPT. UUO/]
	JRST	JSYSER			;PRINT REST OF MESSAGE
JFNSER: OUTSTR	[ASCIZ /JFNS/]
	JRST	JSYSER			;PRINT REST OF MESSAGE
MTOERR:	OUTSTR	[ASCIZ /MTOPR/]
	JRST	JSYSER			;PRINT REST OF MESSAGE
CLSERR:	OUTSTR	[ASCIZ /CLOSF/]
	JRST	JSYSER			;PRINT REST OF MESSAGE
RLDERR:	OUTSTR	[ASCIZ /RELD/]
	JRST	JSYSER			;PRINT REST OF MESSAGE
OJFERR:	OUTSTR	[ASCIZ /OPENF/]
	JRST	JSYSER			;PRINT REST OF MESSAGE
STDERR:	OUTSTR	[ASCIZ /STDEV/]
JSYSER:	OUTSTR	[ASCIZ / failed /]
	MOVEI	AC1,.PRIIN		;
	CFIBF%				; CLEAR TYPE AHEAD
	MOVEI	AC1,.PRIOU		;
	DOBE%				;WAIT FOR PREVIOUS OUTPUT TO FINISH
	HRROI	AC1,[ASCIZ /
? JSYS error: /]
	PSOUT%
	MOVEI	AC1,.PRIOU		;
	HRLOI	AC2,.FHSLF		; THIS FORK ,, LAST ERROR
	SETZ	AC3,			;
	ERSTR%				; TYPE THE ERROR
	 JFCL
	 JFCL
;	HRROI	AC1,[ASCIZ /
;/]
;	PSOUT%				; APPEND CRLF
	MOVE	AC2,[BYTE (5) 10,2,31,20,4]
	JRST	MSOUT.			; [431] FATAL ERROR MESSAGE

>; [431]END OF IFN TOPS20
	;READ A LABEL FROM A NON DIRECTORY DEVICE.  ***OPNBBF***

OPNRLB:	TXNN	AC13,DV.LPT!DV.TTY!DV.PTR!DV.PTP!DV.CDR ;[575]SKIP IF DEVICE IS ONE OF THESE
	TLNN	FLG1,NONSTD+STNDRD ;SKIP IF LABELS ARE PRESENT
	JRST	OPNBBF		;
OPNRL2:	TXNE	AC16,OPN%RV	; OPEN INPUT REVERSED?
	JRST 	OPNBBF		; YES, SKIP CHECK
	PUSHJ	PP,READSY	;READ A LABEL INTO THE BUFFER AREA
	 JRST	OPNRL1		;NORMAL RETURN
	JRST	OPNFW4		;TRY AGAIN RETURN
OPNRL1:	PUSHJ	PP,BUFREC	;MOVE THE LABEL FROM THE BUFFER TO RECORD AREA

	;DO BEFORE BEGINNING FILE USE PROCEDURE.  PERFORM STANDARD
	;LABEL CHECKS OR CREATE A LABEL.  ***OPNABF***

OPNBBF:	TLNE	FLG,IOFIL!RANFIL!IDXFIL ;[622] SKIP IF NOT DUMP MODE
	JRST	OPNBB1		;
	TXNN	AC16,OPN%EX	;OPEN EXTEND?
;BL;	INSERTED AT OPNBBF+3 TO FIX OPEN-EXTEND BUG
	 JRST	OPNBB3		; NO, SKIP NULL-FILE TEST
	HRRZ	AC4,D.OBB(I16)	;NULL DESTINATION ADDR?
	JUMPN	AC4,OPNBB1	; NO, DON'T NEED DUMMYOUT
OPNBB3:
	TLNN	FLG,OPNOUT	;[301] SKIP IF OUTPUT
	JRST	OPNBB1		;[301] NOT OUTPUT,SKIP ENTER
IFN TOPS20,<			;[561]
	TXNN	AC13,DV.MTA	;[561] SKIP IF MTA, ENTER DONE AT OPNC4A
>				;[561]
	TXNE	AC13,DV.DIR	;[315] DIRECTORY DEVICE?
	JRST	OPNBB2		;[315] YES, SKIP ENTER
	PUSHJ	PP,OPNEID	;[301] SET UP ID FOR ENTER
	XCT	UENTR.		;[301] DO AN ENTER
	 JRST	OEERR		;[301] ERROR RETURN
OPNBB2:	XCT	UOUT.		;[315] DUMMY OUTPUT*******************
OPNBB1:
IFN ANS68,<			; ONLY IN ANS68 COBOL
	MOVEI	AC1,1		;2 WORD CALL,
	PUSHJ	PP,USEPRO	;TO GET THE USE PRO. ADDRESS
>;END IFN ANS68
	TXNN	AC13,DV.LPT!DV.PTR!DV.PTP!DV.TTY	;NO LABELS - NO CHECKS
	TLNN	FLG1,STNDRD	;SKIP IF LABELS ARE STANDARD
	JRST	OPNABF		;AFTER BEG FILE
	TLNE	FLG,OPNIN	;SKIP IF NOT INPUT / IO
	JRST	OPNCSL		;STANDARD LABEL CHECK
	PUSHJ	PP,OPNCAL	;CREATE A LABEL
	;DO AFTER BEGINNING FILE LABEL PROCEDURE
	;AND WRITE OUT THE LABEL.  ***OPNENR***

OPNABF:
IFN ANS68,<
	MOVEI	AC1,2		;TWO WORD CALL
	PUSHJ	PP,USEPRO	;TO GET USE PRO. ADR.
>;END IFN ANS68
	TLNN	FLG,OPNOUT	;OUTPUT SKIPS
	JRST	OPNDVC
	TLNE	FLG1,MSTNDR	;[1115] IS THE MONITOR HANDLING THE LABELS?
	JRST	OPNDVC		;[1115] YES, THEN SKIP THE PROCESSING BELOW
	TXNE	AC13,DV.DIR	;SKIP IF NOT DIR. DEV.
	JRST	OPNENR
	TXNN	AC13,DV.LPT!DV.PTP!DV.PTR!DV.TTY!DV.DIR	;SKIP IF LPT,TTY,PTR,PTP,OR DTA,DSK.
	TLNN	FLG1,NONSTD+STNDRD ;SKIP IF ANY LABELS
	JRST	OPNDVC		;NO LABELS
	PUSHJ	PP,RECBUF	;MOVE THE LABEL INTO THE BUFFER
	JUMPGE	FLG,OPNAB1	;JUMP IF DEVICE IS NOT ASCII
	PUSHJ	PP,WRTCR	;
	PUSHJ	PP,WRTLF	;
OPNAB1:	PUSHJ	PP,WRTOUT	;WRITE THE LABEL

	JRST	OPNDVC
	;DO AN ENTER AND SAVE THE FLAG REGISTER.  ***EXIT TO THE ACP***

OPNENR:	PUSHJ	PP,OPNEID	;SETUP UEBLK. (DUMP-MODE)
	TXNN	AC16,OPN%EX	; APPEND MODE
IFE TOPS20,<
	JRST	OPNEN0		;[672] NO, GO ON
	HLRZ	AC13,UOBLK.+2	;[672] IF THE APPEND FILOP
	SKIPG	2(AC13)		;[672]   DIDN'T SET UP BUFFER (NEW FILE)
	JRST	OPNEN1		;[672]   DO IT NOW
	JRST	OPNDVC		;[672]  ELSE SKIP THE DUMMY OUT
OPNEN0:				;[672]
>
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNDVC		; [626]YES,SKIP THE ENTER AND THE DUMMY OUTPUT
	XCT	UENTR.		;ENTER - DIRECTORY DEVICE**********
	 JRST	OEERR		;ERROR RETURN
OPNEN1:	TLNN	FLG,RANFIL!IOFIL!IDXFIL ;[622] DUMP MODE HAS NO DUMMY OUTPUTS
	XCT	UOUT.		;DUMMY OUTPUT*****ENTER VOIDS PREVIOUS DUMMY OUTPUTS.
OPNDVC:	MOVE	AC13,UOBLK.+1
	DEVCHR	AC13,		;THE FINAL DEVCHR
	TXC	AC13,DV.DSK!DV.CDR	;[330] IF A DSK AND A CDR
	TXCN	AC13,DV.DSK!DV.CDR	;[330] THEN ITS DEVICE 'NUL'
	TXZ	AC13,DV.MTA!DV.TTY	;[506] SO ITS NOT A MTA OR TTY
OPNDV1:	MOVEM	AC13,D.DC(I16)		;[330]
	MOVEM	FLG,F.WFLG(I16)	;UPDATE THE FLAGS
	TXNE	AC13,DV.TTY	;IS THIS A TTY FILE?
	 TXNN	AC16,OPN%OU	;[642] AND OPEN FOR OUTPUT?
	 CAIA			;[642] NO, DON'T SET FLAG
	HRRZM	AC16,TTYOPN	;YES, REMEMBER THAT
	TLNE	FLG1,STNDRD!NONSTD	;SKIP IF LABELS ARE OMITTED
	PUSHJ	PP,ZROREC	;CLEAR THE RECORD AREA I.E.LABEL
	PUSHJ	PP,CLRSTS	;[601] CLEAR FILE STATUS WORD
IFN ANS74,<
	TLNN	FLG,IDXFIL!RANFIL!OPNIN ;[622]
	TLNN	FLG,OPNOUT	;TEST FOR SEQ. OUTPUT
	JRST	OPNDV3		;NO
	SKIPN	F.LCP(I16)	;LINAGE STUFF?
	JRST	OPNDV3		;NO
	HLRZ	AC6,F.LAT(I16)	;LINES AT TOP?
	JUMPE	AC6,OPNDV3	;ZERO
	PUSHJ	PP,WRTCR	;THERE ARE SOME
	PUSHJ	PP,WRTLF
	SOJG	AC6,.-2		;LOOP
OPNDV3:>;END IFN ANS74

	TXNN	AC16,FL%WRC	;RESTORE THE REC-AREA IF A WRITE REEL CHANGE
	JRST	OPNDVR		;RETURN TO CBL-PRG
	POP	PP,AC2		;FROM,,TO
	POP	PP,AC1		;LENGTH
	HRRZM	AC2,.JBFF	;RESTORE FREE CORE
	MOVSS	AC2		;THE OTHER WAY
	ADDI	AC1,(AC2)	;UNTIL
	BLT	AC2,(AC1)	;SLURP
OPNDVR:
IFN ANS74,<
	TXNE	AC16,OPN%RV	;WANT READ BACKWARDS
	TXNN	AC13,DV.MTA	; AND HAVE A MTA
	JRST	OPNDVX		;NO, EXIT

	; CHECK FOR MONITOR LABELS, ERROR IF SO
	
	TLNN	FLG1,MSTNDR	; IS MONITOR LABELING?
	JRST	OPDVRD		; NO CONT

	; READ REVERSED NOT SUPPORTED WITH MONITOR LABELS

	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ/$ OPEN REVERSED is not supported with monitor labels./]
	MOVE	AC2,[BYTE (5)10,2,7,31,20,4]
	PUSHJ	PP,MSOUT.	; MESS OUT AND KILL.

	; CHECK BLOCKING
OPDVRD:	LDB	AC1,F.BBKF	; FILE BLOCKED
	SOJG	AC1,OPDVRA	; GTR THAN 1?, IF SO JUMP
	JUMPE	AC1,OPDVRB	; JUMP IF BLOCKED 1 OK

	; ERROR CASE, UNBLOCKED MTA READ REV

	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ/$ OPEN REVERSED is not supported for unblocked MTA./]
	MOVE	AC2,[BYTE (5)10,2,7,31,20,4]
	PUSHJ	PP,MSOUT.	; MESS OUT AND KILL.

OPDVRA:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ/$ OPEN REVERSED not currently supported for blocking greater than 1 record./]
	MOVE	AC2,[BYTE (5)10,2,7,31,20,4]
	PUSHJ	PP,MSOUT.	; MESS OUT AND KILL.




	; SET FLAG INDICATING READ REVERSED ACTIVE

OPDVRB:	HRRZ	AC1,D.RFLG(I16)	; GET SOME FLAGS
	TRO	AC1,RDDREV	; SET READ REVERSE OPEN ACTIVE
OPDVRC:	HRRM	AC1,D.RFLG(I16)	; AND PUT IT BACK

	; IF POSITIONED FOR MULTI FILE TAPE, SKIP AHEAD TO EOF.

	LDB	AC1,F.BPMT	;POINT 6,6(I16),17 ... FILE POSITION ON REEL
	JUMPE	AC1,OPDVR0	; JUMP IF NOT POSITIONED
OPDVR1:	XCT	MADVF.		; GO TO END OF FILE
	XCT	MWAIT.		; WAIT FOR COMPLETION
	XCT	MBSPF.		; BACKSPACE OVER EOF
	XCT	MWAIT.
	JRST	OPDVR9		; OK, NOW SET READ REVERSED

	; HERE IF NOT POSITIONED YET, IF BOT DO WHAT POSITIONED CASE DOES

OPDVR0:	XCT	MWAIT.
	XCT	SZBOT.		;STATZ BEG-OF-TAPE
	JRST	OPDVR1		; BOT,ACT AS IN POSITIONED CASE

	; NOT AT BOT,BACK ONE FILE, IF THEN NOT AT BOT, ASSUME OK


	XCT	MBSPF.		; BACKSPACE OVER EOF
	XCT	MWAIT.
	XCT	SZBOT.		; STATZ BEG-OF-TAPE
	JRST	OPDVR1		; AT BOT, TOO BAD, REPOSITION FROM START

	; NOW CHECK FOR LABELED CASE

	TLNN	FLG1,STNDRD+NONSTD ;SKIP IF LABELS
	JRST	OPDVR9		; NOP, ALL SET
	XCT	MBSPF.		; BACKSPACE OVER EOF, BETWEEN LABEL AND DATA
	XCT	MWAIT.
	XCT	SZBOT.		; STATZ BEG-OF-TAPE
	JRST	OPDVR1		; AT BOT, TOO BAD, REPOSITION FROM START


	; OK, WE SHOULD BE POSITIONED AT EOF , JUST BEFORE TAPE MARK

OPDVR9:	MOVSI	AC3,3		; LENGTH,,ADDRESS
	MOVEI	AC0,.TFSET+.TFRDB ;FUNCTION
	MOVE	AC1,UOBLK.+1	; DEVICE NAME
	MOVEI	AC2,1		; INDICATE SET READ BACK
	TAPOP.	AC3,
	  JRST	OMTA97		; ERROR 

OPNDVX: >; END IFN ANS74


IFN LSTATS,<
	LDB	AC1,DTCN.	;GET CHAN #
	MOVE	AC5,AC1		;SAVE IN AC5
	PUSHJ	PP,MRDMP	;WRITE OUT ANY EXISTING BUCKETS
	MOVE	AC0,MROPTT(AC5)	;GET BASE ADDR OF BKT BLK
	MOVE	AC1,AC0		;SAVE IN AC1
	ADDI	AC0,MB.BAS	;ADD OFFSET TO HEADER START
	HRLI	AC0,-1(AC16)	;AC0= FILTAB-1,,BKT BLK
	BLT	AC0,MB.FTB(AC1)	;BLT FILTAB BLK TO BUCKET AREA
	HRRI	AC0,MB.VID(AC1)	;ADDR "VALUE OF ID" IN BKT BLK
	HRL	AC0,F.WVID(I16)	;ADDR OF "VAL OF ID"
	BLT	AC0,MB.FG1-1(AC1) ;BLT TO BUCKET BLOCK
	HLL	AC5,FLG1	;GET FLG1 FLAGS
	MOVEM	AC5,MB.FG1(AC1)	;SAVE FLG1 AND CHAN #
	HLLM	AC16,MB.OCF(AC1) ;SAVE AC16 OPEN FLAG BITS
	MOVEI	AC1,MB.OTM(AC1)	;GET ADDR OPEN TIME BUCKET
	MOVEM	AC1,MRTMB.	;SAVE FOR TIMING
	SETZM	(AC1)		;CLEAR OPEN TIME BUCKET
	SKIPE	F.WSMU(I16)	;SKIP TIMING STOP IF SMU
	JRST	OPMRXX		;SMU SKIP
	MRTME.	(AC1)		;END TIMING

OPMRXX:>;END IFN LSTATS
	POPJ	PP,		; NOW EXIT TO CBL-PRG
; THE FOLLOWING TABLES ARE USED TO SETUP THE CONVERSION INSTRUCTION

RCTBL:	RCASC(AC2)	; ASCII TO ?
	RCEBC(AC2)	; EBCDIC TO ?
	RCSIX(AC2)	; SIXBIT TO ?

RCASC:	MOVE	C,CHTAB(C)	; ASCII TO	ASCII
	PUSHJ	PP,RCAEC	;[542]		EBCDIC
	MOVS	C,CHTAB(C)	;		SIXBIT

RCEBC:	LDB	C,PTR.97##	; EBCDIC TO	ASCII
	TRN			;		EBCDIC
	LDB	C,PTR.96##	;		SIXBIT


RCSIX:	ADDI	C,40		; SIXBIT TO	ASCII
	LDB	C,PTR.69##	; 		EBCDIC
	TRN			;		SIXBIT

WCTBL:	WCASC(AC1)		; ASCII TO  ?
	RCEBC(AC1)		; EBCDIC TO ?
	RCSIX(AC1)		; SIXBIT TO ?

WCASC:	TRN			; ASCII TO	ASCII
	LDB	C,PTR.79##	;		EBCDIC
	MOVS	C,CHTAB(C)	;		SIXBIT

;[542] FOR ASCII TO EBCDIC WE NEED TO RETURN 1B0 FOR E-O-L CHARACTERS

RCAEC:	SKIPGE	CHTAB(C)	;[542] CHECK FOR E-O-L CHARACTER
	JRST	[LDB	C,PTR.79	;[542] YES, GET CONVERSION
		TLO	C,(1B0)		;[542] SET SIGN BIT
		POPJ	PP,]		;[542] RETURN
	LDB	C,PTR.79##	;[542] NORMAL, JUST GET CONVERSION
	POPJ	PP,		;[542] AND RETURN
	;STANDARD LABELS AND INPUT OR IO
	;CHECK THE VALUE OF ID.  ***OPNABF***

OPNCSL:	TXNE	AC16,OPN%RV	; OPEN INPUT REVERSED?
	JRST 	OPNABF		; YES, SKIP CHECK
	PUSHJ	PP,RECSLB	;MOVE RECORD AREA TO STD-LABEL AREA
	PUSHJ	PP,OPNLID	;VALUE OF ID TO ULBLK.

	;CHECK FOR LABEL TYPE 'HDR1'
	MOVE	AC0,STDLB.	;LABEL TYPE
	TRZ	AC0,7777	;
	CAMN	AC0,[SIXBIT /HDR1/]	;SKIP INTO ERROR MESSAGE
	JRST	OPNCID		;CHECK VALUE OF ID

	;MISSING OR WRONG LABEL TYPE
	OUTSTR	[ASCIZ/$ The beginning file label is missing./]
	PUSHJ	PP,SAVAC.
	MOVE	AC2,[BYTE(5)10,2,31,20,4,14]
	PUSHJ	PP,MSOUT.
	JRST	OPNFW4		;TRY AGAIN
OPNCID:	HRR	AC0,STDLB.	;
	MOVE	AC1,STDLB.+1	;
	HLL	AC0,STDLB.+2	;
	ROTC	AC0,30		;JUSTIFY THE FILENAME
	CAME	AC0,ULBLK.	;CHECK FILE NAMES
	JRST	OPNIDE		;ID ERROR
	HLLZ	AC0,ULBLK.+1	;
	TRZ	AC1,-1		;CLEAR THE LABEL NUMBER
	CAMN	AC0,AC1		;CHECK EXTENSIONS
	JRST	OPNCDW		;CHECK DATE WRITTEN

	;ID ERROR.
OPNIDE:	PUSHJ	PP,SAVAC.	;
	MOVE	AC2,[BYTE (5)10,2,31,20,4,14]
	PUSHJ	PP,MSOUT.	;
	OUTSTR	[ASCIZ/$ The VALUE OF ID does not match the label ID./]
	JRST	OPNFW4

	;CHECK DATE WRITTEN
OPNCDW:	SKIPN	AC6,F.WVDW(I16)	;VALUE OF DATE WRITTEN
	JRST	OPNCRN		;CHECK REEL NUMBER
	MOVE	AC0,[POINT 6,STDLB.+6,29]
	MOVEI	AC2,6		;CHECK ONLY FIRST 6 CHARS.
OPNCD1:	ILDB	AC1,AC0		;ONE FROM THE LABEL AND
	ILDB	AC5,AC6		;ONE FROM THE FILE TABLE
	TLNE	AC6,100		;SKIP IF SIXBIT OR EBCDIC
	LDB	AC5,PTR76.##	;MAKE ASCII INTO SIXBIT
	TLNN	AC6,600		; EBCDIC?
	LDB	AC5,PTR96.##	; YES
	CAME	AC5,AC1		;SKIP IF EQUAL
	JRST	OPNCD2		;WRONG DATE MESSAGE
	SOJN	AC2,OPNCD1	;LOOP 6 TIMES
	JRST	OPNCRN		; OK SO CHECK THE REEL NUMBER
	;WRONG DATE
OPNCD2:	MOVE	AC2,[BYTE (5)10,31,20,2,4,14]
	PUSHJ	PP,MSOUT.
	OUTSTR	[ASCIZ /The file table date differs from the file label date./]
	JRST	KILL

	;CHECK THE REEL NUMBER IF THE DEVICE IS A MAGTAPE
OPNCRN:	TXNN	AC13,DV.MTA	;MAGTAPE?
	JRST	OPNABF		;NO
	HRL	AC0,STDLB.+4	;THE
	HLR	AC0,STDLB.+5	;  REAL
	ROT	AC0,-14		;  REEL
	ANDI	AC0,7777	;  NUMBER
	LDB	AC1,DTRN.	;AND WHAT IT OUGHT TO BE
	CAMN	AC0,AC1		;SKIP IF UNEQUAL
	JRST	OPNCR1		;MATCH
	LDB	AC2,F.BPMT	;
	JUMPN	AC2,OPNCR1	;JUMP ITSA MULTI-FILE-REEL
	PUSHJ	PP,SAVAC.	;
	OUTSTR	[ASCIZ /
$/]
	MOVE	AC2,[BYTE(5)10,31,20,2,4,34,14] ;FODC.R#
	PUSHJ	PP,MSOUT.	;
	OUTSTR	[ASCIZ/ was mounted, please mount /]
	PUSHJ	PP,MSDTRN
	OUTSTR	[ASCIZ /
then/]
	JRST	OPNF04		;TRY AGAIN
OPNCR1:
	JRST	OPNABF
	;CREATE A STANDARD LABEL.  ***@POPJ***

OPNCAL:	PUSHJ	PP,OPNEID	;LOAD FILENM.EXT INTO ENTER BLOCK
	PUSHJ	PP,ZROSLA	;ZERO THE STD LABEL AREA
	MOVE	AC0,UEBLK.	;FILENAME
	HLLZ	AC1,UEBLK.+1	;EXT
	ROTC	AC0,14		;12 PLACES TO THE LEFT - MARCH.
	TRO	AC1,'1  '	;FIRST LABEL
	MOVEM	AC0,STDLB.+1	;FILE
	HLLM	AC1,STDLB.+2	;DESCRIPTOR
	TXNE	AC16,V%OPEN!CLS%BV
	HRLI	AC1,'HDR'	;BEGINNING FILE LABEL
	TXNE	AC16,CLS%EF
	HRLI	AC1,'EOF'	;END OF FILE LABEL
	TXNE	AC16,CLS%EV
	HRLI	AC1,'EOV'	;END OF VOLUME LABEL
	MOVEM	AC1,STDLB.	;
	PUSHJ	PP,TODAY.	;GET TODAY'S DATE (YYMMDD)
	SETZ	AC1,		;
	ROTC	AC0,6		;
	MOVEM	AC1,STDLB.+6	;CREATION
	MOVEM	AC0,STDLB.+7	;DATE
OPNCA1:	SETZ	AC2,
	LDB	AC0,F.BPMT	;FILTAB FILE POSITION ON MAGTAPE
	ROT	AC2,6		;
	IDIVI	AC0,^D10	;
	ADDM	AC1,AC2		;
	JUMPN	AC0,.-3		;CONVERTED TO DECIMAL
	ADD	AC2,['0000']	;SIXBITIZED

	LDB	AC1,DTRN.	;DEVTAB MAG-TAPE REEL NUMBER
	ROT	AC2,14		;
	ROTC	AC1,-6		;
	ADDI	AC1,'00 '	;
	MOVEM	AC1,STDLB.+4	;REEL NUMBER AND
	MOVEM	AC2,STDLB.+5	;FILE POSITION

	SETZ	AC1,		;
	MOVE	AC0,[SIXBIT /PDP10 /]
	MOVEM	AC0,STDLB.+12
	HRLZ	AC0,LIBVR.
	ROTC	AC0,14
	ROT	AC1,3
	ROTC	AC0,3
	ROT	AC1,3
	ROTC	AC0,3
	ADDI	AC1,'000'
	HRLZM	AC1,STDLB.+13	;PDP10 VER
	JRST	SLBREC		;MOVE STD-LABEL TO RECORD AREA AND EXIT
OPNMTA:

	;SET MAGTAPE DENSITY & PARITY
	;POSITION MAGTAPE VIA FILE TABLE FILE POSITION.	***OPNLO***

	; FIRST SET PARITY

	XCT	UGETS.		; GET STATUS INTO AC2
	LDB	AC5,F.BPAR	; GET REQUESTED PARITY
	DPB	AC5,[POINT 1,AC2,26]; SET PARITY
	XCT	USETS.		; SET STATUS

IFN ANS74,<

	; IN 74 CHECK FOR READ REVERSED SUPPORT

	TXNN	AC16,OPN%RV	; READ BACKWARDS?
	JRST	OMTA01		; NO
	HRLZI	AC3,2		; LENGTH ,, ADDR
	MOVEI	AC0,.TFKTP	; FUNCTION
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC3,		; GET CONTROLER TYPE
	 JRST	OMTA97		; ERROR
	CAIE	AC3,.TFKTX	;  NEED TX01(TU70/TU71)
	CAIN	AC3,.TFKTM	; OR TM02(TU16/TU45)
	JRST	OMTA01		; OK
	CAIE	AC3,.TFKD2	; SKIP IF DX20/TX02 CONTROLLER (OK TOO)
	JRST	OMTA97		; NO

OMTA01:	>;END IFN ANS74

	; NOW SET DENSITY AND HARDWARE DATA MODE 

IFN TOPS20,<

	PUSHJ	PP,MTASTS	; GET MTA STATUS INFO INTO TMP.BK
	 JRST	OMTA91		; ERROR RETURN
>
	PUSHJ	PP,SETDEN	; SET TAPE DENSITY 
	 JRST	OMTA95		; ERROR, CAN'T SET DENISTY
IFN TOPS20,<
	TLNE	FLG1,MSTNDR	; IS MONITOR LABELING?
	JRST	OPNPMT		; YES, NO HARDWARE MODE SET ON TOPS20
				; NOW GO SET TAPE POSITION
>
	PUSHJ	PP,SETHRD	; SET PROPER HARDWARE DATA MODE
	 JRST	OMTA93		; ERROR, CAN'T SET DATA MODE
	JRST	OPNPMT		; NOW GO SET TAPE POSITION
; SETHRD	ROUTINE TO SET HARDWARE DATA MODE
;
; ARG		AC16 ADDRESSES FILTAB, ASSUMES MTASTS HAS LEFT STATUS INFO
;		IN TMP.BK FOR TOPS20
;
; RETURNS	+1 IF ERROR
;		+2 IF OK
; USES		AC0-AC3

SETHRD:	HRRZ	AC1,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNE	AC1,INDASC	; IND-ASCII?
	JRST	STHRD2		; YES
	TRNN	AC1,SASCII	; STD-ASCII REQUEST?
	JRST	STHRD1		; NO
	PUSHJ	PP,STDASC	; YES,SET STD-ASCII
	 POPJ	PP,		; ERROR, BAD RETURN
	JRST	RET.2		; OK, GOOD RETURN

	; CHECK FOR EBCDIC TAPE

STHRD1:	TLNN	FLG,DDMEBC	; RECORDING MODE EBCDIC?
	JRST	DEFMOD		;[1061] SET MODE TO CORE DUMP

	TLNE	FLG1,NONSTD!STNDRD ; LABELS OMITTED?
	JRST	OMTA98		; NO - ERROR

STHRD2:	PUSHJ	PP,INDCMP	; YES, SET INDUSTRY COMPATIBLE MODE
	 POPJ	PP,		; ERROR, BAD RETURN
	JRST	RET.2		; OK, GOOD RETURN

;[1061] HERE TO SET INDUSTRY COMPATIBLE CORE DUMP MODE
DEFMOD:	HRLZI	AC3,2		;[1061] LENGTH ,, ADDR
	MOVEI	AC2,.TFMID	;[1061] INDUSTRY-COMPATIBLE CORE DUMP MODE
	JRST	TAPMOD		;[1061] GO SET IT

	; HERE TO SET INDUSTRY COMPATIBLE MODE

INDCMP:	; FIRST CHECK FOR PROPER MODE SUPPORT
	; ON TOPS20 CHECK MODE SUPPORT IN STATUS BLOCK

IFN TOPS20,<
	MOVE	AC2,TMP.BK+.MODDM ; GET DATA MODES WORD (SET IN SETDEN)
	TXNN	AC2,SJ%CM8	; IS IND-COMPT SUPPORTED?
	 POPJ	PP,		; NO,ERROR RETURN
>; END IFN TOPS20

	; ON TOPS10 CHECK FOR 9 TRACK TAPE

IFE TOPS20,<
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	MTCHR.	AC1,		; GET CHARACTERISTICS
	 SETZ	AC1,		; ERROR RET - ASSUME 9TRK
	TRNE	AC1,MT.7TR	; 9 TRACKS?
	JRST	RET.2		; NO, 7 TRACK, ALLOW DEFAULT-NON-IND-CMPT
>; END IFE TOPS20
	; OK, SET INDUSTRY COMPATIBLE MODE

	HRLZI	AC3,2		; LENGTH ,, ADDR
	MOVEI	AC2,.TFM8B	; INDUSTRY-COMPATIBLE MODE
	PUSHJ	PP,TAPMOD	; GO SET IT
	 POPJ	PP,		; ERROR, BAD RETURN
	JRST	RET.2		; OK, GOOD RETURN

	; SET STD-ASCII HARDWARE DATA MODE

STDASC:	MOVEI	AC2,.TFM7B	; STANDARD ASCII MODE
	PUSHJ	PP,TAPMOD	; GO SET IT
	 POPJ	PP,		; ERROR, BAD RETURN
	JRST	RET.2		; OK, GOOD RETURN


; TAPMOD	ROUTINE TO SET TAPE HARDWARE DATA MODE
;
; ARG		AC2=DAT-MODE CODE TO BE SET
; USES		AC0-AC3
; RETURNS	+1	ERROR
;		+2	OK

TAPMOD:	HRLZI	AC3,3		; LENGTH ,, ADDR
	MOVEI	AC0,.TFSET+.TFMOD	; FUNCTION
	MOVE	AC1,UOBLK.+1	; GET DEVICE NAME
	TAPOP.	AC3,		; CHANGE MODE
	 POPJ	PP,		; ERROR - RETURN +1
	JRST	RET.2		; OK, SKIP RETURN


; SETDEN	ROUTINE TO CHECK AND SET TAPE DENSITY
;
; ARG		AC16 ADDRESSES FILTAB, ASSUMES MTASTS HAS LEFT STATUS INFO
;		IN TMP.BK FOR TOPS20
;
; RETURNS:	+1 IF ERROR
;		+2 IF OK, DENSITY IS SET
; USES		AC0-AC3

SETDEN:	LDB	AC3,F.BDNS	; GET DENSITY REQUESTED
	JUMPE	AC3,RET.2	; CORRECT RETURN IF DEFAULT USED

IFE TOPS20,<

	; DO TAPOP TO CHECK POSSIBLE TAPE DENSITIES
	HRLZI	AC2,2		; 2 ARGS START AT AC0
	MOVEI	AC0,.TFPDN	; FUNCTION TO READ POSSIBLE DENSITY
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC2,		; READ POSSIBLE DENSITY
	 POPJ	PP,		; ERROR, GIVE ERROR RETURN

>;END IFE TOPS20

IFN TOPS20,<

	MOVE	AC2,TMP.BK+.MODDN ; GET DENSITY CODES
	LDB	AC3,F.BDNS	; GET DENSITY REQUESTED

>;END IFN TOPS20
	
	XCT	DENTAB-1(AC3)	; TEST PROPER BIT
	 POPJ	PP,		; ERROR, DENSITY NOT POSSIBLE
				; SKIP RETURN, DENSITY POSSIBLE

	; HERE IF DENSITY IS POSSIBLE, SET IT

	MOVE	AC2,AC3		; REQUESTED DENSITY
	HRLZI	AC3,3		; LENGTH,,ADR
	MOVEI	AC0,.TFSET+.TFDEN	; SET DENSITY FUNCTION
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC3,		; SET IT
	 POPJ	PP,		; ERROR, RETURN SUCH

	;NOW GET/CHECK DENSITY
	HRLZI	AC3,2		; LEN,,ADR
	MOVEI	AC0,.TFDEN	; GET DENSITY FUNCTION
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC3,		; GET DENSITY
	 POPJ	PP,		; ERROR, RETURN SUCH
	CAME	AC2,AC3		; CHECK IT
	 POPJ	PP,		; ERROR, RETURN SUCH
	JRST	RET.2		; OK, ITS SET RIGHT GIVE OK RETURN

IFE TOPS20,<

	; TABLE TO TEST RESULTS OF .TFPDN TAPOP

DENTAB:	TXNN	AC2,TF.DN1	; TEST IF 200 BPI
	TXNN	AC2,TF.DN2	; 	  556 BPI
	TXNN	AC2,TF.DN3	; 	  800 BPI
	TXNN	AC2,TF.DN4	; 	 1600 BPI
	TXNN	AC2,TF.DN5	; 	 6250 BPI

>;END IFE TOPS20

IFN TOPS20,<

	; DENTAB IS TABLE OF TESTS FOR .MOSTA MTOPR (AC0 HAS CODE RETURNED)

DENTAB:	TXNN	AC2,SJ%CP2	; TEST IF 200 BPI
	TXNN	AC2,SJ%CP5	; 	  556 BPI
	TXNN	AC2,SJ%CP8	; 	  800 BPI
	TXNN	AC2,SJ%C16	; 	 1600 BPI
	TXNN	AC2,SJ%C62	; 	 6250 BPI
; MTASTS	ROUTINE TO READ MTA STATUS INTO TMP.BK ON TOPS20
;
; ARG		AC16 ADDRESSES MTA FILE TAB
;
; RETURNS	+1 IF ERROR
;		+2 IF OK, STATUS INFO IN TMP.BK
; USES		AC0-AC3,TMP.BK


MTASTS:	LDB	AC2,UUOCHN	;GET CHANNEL NUM
	PUSHJ	PP,GETJFN	; GET JFN IN AC1
	 POPJ	PP,		; ERROR RETURN
	MOVEI	AC2,.MODDM+1	; LENGTH OF ARG BLOCK
	MOVEM	AC2,TMP.BK	; SET BLOCK LENGTH
	SOJE	AC2,MTSTSA	; LOOP ILL ARG BLOCK CLEAR
	SETZM	TMP.BK(AC2)	; CLEAR ARG WORD
	JRST	.-2		; LOOP
MTSTSA:	MOVEI	AC2,.MOSTA	; GET TAPE STATUS FUNCTION
	MOVEI	AC3,TMP.BK	; ADDR OF ARG BLOCK
	MTOPR%			; DO IT
	 ERJMP	RET.1		; IF ERROR EXIT ASSUMING IND-ASC
	JRST	RET.2		; GOOD RETURN , STATUS IN TMP.BK

	; HERE IF CAN'T GET MTA STATUS INFO 

OMTA91:	MOVE	AC0,[E.MTAP+^D46] ; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	OUTSTR	[ASCIZ /
? Unable to get mag tape status information./]
	JRST	OMTA99

>;END IFN TOPS20



	;TAPOP. FAILED TO SET HARDWARE DATA MODE
OMTA93:	MOVE	AC0,[E.MTAP+^D45] ; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	OUTSTR	[ASCIZ / TAPOP. failed - unable to set HARDWARE DATA MODE./]
	JRST	OMTA99

	;TAPOP. FAILED OR "SET" DOESN'T MATCH "GET" DENSITY
OMTA95:	MOVEI	AC0,^D47	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	OUTSTR	[ASCIZ / Cannot set the requested density./]
	JRST	OMTA99

IFE TOPS20,<
	;TAPOP. FAILED, CAN'T GET LABEL TYPE
OMTA96:	MOVE	AC0,[E.MTAP+^D48] ;ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE?
	  JRST	RCHAN		; YES
	OUTSTR	[ASCIZ /
?TAPOP. failed - unable to get-set label type-information ./]
	JRST	OMTA99


VSWERR:	MOVE	AC0,[E.MTAP+^D56] ;ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE?
	  JRST	RCHAN		; YES
	OUTSTR	[ASCIZ /
?TAPOP. failed - unable to switch mag tape reels ./]
	JRST	OMTA99

> ;END OF IFE TOPS20

IFN ANS74,<
	;HERE IF READ BACKWARDS NOT SUPPORTED ON SPECIFIED MTA
OMTA97:	MOVEI	AC0,^D57	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	OUTSTR	[ASCIZ "
? Unable to set READ REVERSED ."]
	JRST	OMTA99
>

	;FOR NOW EBCDIC FILES MUST HAVE OMITTED LABELS
OMTA98:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /EBCDIC MTA files must have omitted labels./]
OMTA99:	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.	;DOESN'T RETURN


OMTA9A:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Internal error, MTA density code past 6250./]
	JRST	OMTA99		; FINISH IT
	; HERE TO POSITION MAG TAPE

OPNPMT:	MOVEI	AC3,2		; 2 EOF'S PER FILE IF NOT EBCDIC
	TLNE	FLG,DDMEBC	; DEVICE DATA MODE EBCDIC?
	MOVEI	AC3,3		; YES, 3 EOF/FILE.
	TLNN	FLG1,NONSTD!STNDRD ; LABELS OMITTED?
	MOVEI	AC3,1		; YES, 1 EOF/FILE.
	MOVX	AC5,DB.HF	;"HEAD UNDER THIS FILE" FLAG
	LDB	AC11,F.BPMT	;POINT 6,6(I16),17 ... FILE POSITION ON REEL
	JUMPE	AC11,OPNF00	;JUMP IF MULTI REEL FILE WAS OPNREW
	MOVE	AC10,AC16	;CURRENT FILE TABLE FIRST
OPNHUF:	TDNE	AC5,D.HF(AC10)	;SKIP IF NOT "HUF"
	JRST	OPNFND		;FOUND THE FILE
	HRRZ	AC10,11(AC10)	;NEXT FILE TABLE THAT SHARES THIS REEL
	CAIE	AC10,(I16)	;SKIP IF WE'VE MADE A COMPLETE LOOP
	JUMPN	AC10,OPNHUF	;ZERO=REEL NOT SHARED
				;FALL THRU IF REEL NEVER POSITIONED
OPNREW:
IFN TOPS20,<
	TXNN	AC16,CLS%RO	;SKIP IF A CLOSE REEL GENERATED OPEN
	TLNN	FLG1,MTNOLB	;SKIP IF MOUNTR WITH NO LABELING
	JRST	OPNRWA		;OTHERWISE, GO ON
	PUSH	PP,AC3		;SAVE SOME REGS
	PUSH	PP,AC5		;
	SETZ	AC4,		;INDICATE GET FIRST REEL
	PUSHJ	PP,VOLSWT	;MAKE SURE FIRST REEL UP
	POP	PP,AC5		;RESTORE SOME REGS
	POP	PP,AC3		;
OPNRWA:	>;END IFN TOPS20

	PUSHJ	PP,OPNRWD	;REWIND
	SUBI	AC11,1		;SUB 1 FOR THIS REWIND
	IMUL	AC11,AC3	; SEE HOW MANY EOF'S TO PASS
	JUMPG	AC11,OPNFWD
	JRST	OPNFW1

OPNRWD:	XCT	MWAIT.
	XCT	SOBOT.		;STATO BEG-OF-TAPE
	XCT	MREW.		;ELSE REWIND
	POPJ	PP,


SETBM:	LDB	AC5,F.BBM	;GET BYTE MODE FLAG
IFE TOPS20,<
	TLNE	FLG1,MSTNDR	; IF LABELED TOPS10 TAPE AND
	TLNN	FLG,DDMASC+DDMEBC ; IF ASCII OR EBCDIC THEN SET IT
>
	JUMPE	AC5,RET.1	;NOT WANTED
IFE TOPS20,<
SETBM1:	TRNN	AC13,DV.M3	;CAN IT SUPPORT MODE 3?
	JRST	SETBME		;NO
	MOVEI	AC5,.IOBYT	;YES
	DPB	AC5,[POINT 4,UOBLK.,35]	;[541] RESET MODE
	POPJ	PP,		;SUCCESSFUL RETURN

SETBME:
	TLNE	FLG1,MSTNDR	; IS IT LABELED TAPE?
	POPJ	PP,		; YES, NO MESSAGE NOW

	MOVE	AC2,[BYTE (5) 20,14]	;NO
	PUSHJ	PP,MSOUT.	;DEVICE
	OUTSTR	[ASCIZ	/ does not support BYTE MODE.
/]
	POPJ	PP,		;IGNORE 
>
IFN TOPS20,<
	OUTSTR	[ASCIZ	/
TOPS-20 does not support BYTE MODE.
/]
	POPJ	PP,
>
OPNFND:	ANDCAM	AC5,D.HF(AC10)	;CLEAR THE HUF FLAG
	TLNN	AC16,100	;REWIND REQ?
	JRST	OPNREW		;YES
	LDB	AC10,[POINT 6,6(AC10),17] ;FIGURE OUT WHERE TO GO
	SUB	AC11,AC10	;DIRECTION + MAGNITUDE
	IMUL	AC11,AC3	; SEE HOW MANY EOF'S TO PASS
	JUMPE	AC11,OPNBOF	;GO TO THE BEG OF FILE
	JUMPG	AC11,OPNFWD	;SPACE FORWARD

OPNREV:	XCT	MWAIT.		;[336] MAKE SURE WE WAIT
	XCT	MBSPF.		;[336] BACKSPACE A FILE
	XCT	MWAIT.		;WAIT FOR COMPLETION
	XCT	SZBOT.		;STATZ BOT
	JRST	OPNRE1		;PREMATURE BEG-OF-TAPE ERROR
	AOJL	AC11,OPNREV	;LOOP TILL (AC11)=0

OPNBOF:
IFN TOPS20,<
	TLNE	FLG1,MSTNDR	;SKIP IF NOT MONITOR LABELS
	JRST	OPNFW1		;ELSE, SKIP THIS POSITIONING
>
	XCT	MBSPF.		;MOVE TO BEG OF CURRENT FILE
	XCT	MWAIT.
	XCT	SOBOT.		;SKIP, BIT=BOF
	XCT	MADVF.		;MOVE TO OTHER SIDE OF EOF MARK
	JRST	OPNFW1
OPNFWD:	XCT	MWAIT.		;AVOID POSITIONING ERRORS
	XCT	SZEOT.		;STATZ EOT
	JRST	OPNFW2		;END OF TAPE ERROR
	XCT	MADVF.		;ADVANCE A FILE
	SOJG	AC11,OPNFWD
OPNFW1:	XCT	MWAIT.		;[336] WAIT ON MTA
	ORM	AC5,D.HF(I16)	;[336] NOTE CURRENT FILE OVER HEAD

	TLNN	FLG1,MSTNDR	; SYSTEM LABELS?
IFN TOPS20,<
	JRST	OMTA6E		; NO, CONT
>
IFE TOPS20,<
	JRST	OPNLO		; NO,CONT, NO FURTHER TESTS NEEDED
>
	PUSHJ	PP,MTALAB	; YES,GET LABEL INFO
	  JRST	[ OUTSTR [ASCIZ /
?Internal error, MTALAB returned improperly./]
		JRST	OMTA99	]	; FINISH IT
	; HERE IF SYS-LABELED

IFE TOPS20,<

	TLNN	FLG,OPNOUT	; OPEN OUTPUT?
	JRST	OMTAIN		; NO, CONT OTHER CHECKS

	; HERE FOR OPEN OUTPUT LABELED TOPS10
	; SET LABEL INFO

	PUSHJ	PP,LBINFO	; WRITE TAPE LABEL INFO BLOCK
	JRST	OPNLO		; CONT


	; LBINFO SETS LABEL INFORMATION BLOCK FOR PULSAR.
	; FIRST IO DONE WILL CAUSE TAPE TO BE POSITIONED TO THE
	; FILE INDICATED BY THIS INFO, FOR OUTPUT THIS INFO WILL
	; BE WRITTEN INTO THE LABEL. COULD BE USED TO POSITION
	; FOR READ ALSO, SKIPPING THE ABOVE OPNPMT POSITIONING
	; CODE, THOUGH IT DOESN'T NOW.
	; FIRST RESET THE ARG BLOCK TAPOP. WORKS, RESET BY MTALAB

LBINFO:	LDB	AC3,F.BLBT	; GET LABEL TYPE
	MOVEI	AC1,.TFLPR+.TFSET ; INDICATE FUNCTION "SET LABEL INFORMATION "
	MOVEM	AC1,TMP.BK+.TPFUN ; 
	MOVE	AC1,UOBLK.+1	; GET DEVICE NAME
	MOVEM	AC1,TMP.BK+.TPDEV ; SET IT
	CAIE	AC3,.TFLAL	; IS THE LABEL TYPE ANSI
	CAIN	AC3,.TFLAU	; OR ANSI WITH USER LABELS?
	JRST	OPC31B		; YES,JUMP

	; NOT ANSI, ASSUME IBM
	
	MOVE	AC10,[POINT 8,TMP.BK+.TPFNM] ; GET BYT-PTR FOR FILNAM
	TLNN	FLG,DDMEBC	; IS DEVICE MODE EBCDIC?
	JRST	OPC31D		; NO, SET "U" FORMAT
	MOVEI	AC1,.TRFFX	; ASSUME FIXED FORMAT
	JUMPGE	FLG1,.+2	; IS IT REALLY "V"
	MOVEI	AC1,.TRFVR	; YES, SET VARIABLE FORMAT CODE
	MOVEM	AC1,TMP.BK+.TPREC ; SET FORMAT INTO ARG-BLK
IFE TOPS20,<
	PUSHJ	PP,TPBTMD	; CHECK FOR BYTE MODE SET
>
	JRST	OPC31G		; NOW TRANSFER NAME TO ARG-BLK

	; HERE TO SET "U" FORMAT, SINCE DDM DOES NOT CORRESPOND TO LABEL TYPE

OC31DA:	HRRZ	AC0,D.RFLG(I16)	; GET RUNTIME FLAGS
	TRZ	AC0,INDASC	; CLEAR ANY INDASC SETTING DONE AT RESET 
	HRRM	AC0,D.RFLG(I16)	; PUT IT BACK
OPC31D:	MOVEI	AC1,.TRFUN	; GET "U" FORMAT CODE
	MOVEM	AC1,TMP.BK+.TPREC ; SET IT IN ARG BLOCK
	JRST	OPC31G		; GO WRITE FILNAME

	; TPBTMD	A ROUTINE TO CHECK BYTE MODE SETTING

IFE TOPS20,<

TPBTMD:	TRNE	AC13,DV.M3	;CAN IT SUPPORT MODE 3?
	POPJ	PP,		; SUPPORT OK, RETURN

	; HERE IF NOT SUPPORTED CHECK FOR EVEN RECORD CASE

	MOVEI	AC1,4		; ASSUME 4 BYTES/WRD
	MOVE	AC0,D.RFLG(I16); GET RUNTIME FLAGS
	TRNE	AC0,INDASC	; IND-ASCII?
	ADDI	AC1,1		; YES, MAKE THAT 5 BYTES/WRD
	MOVE	AC0,D.TCPL(I16)	; GET NUMBER BYTES IN LOGICAL BLOCK
	IDIVI	AC0,(AC1)	; SEE IF REMAINDER
	JUMPE	AC1,RET.1	; NONE, SO OK, RETURN

	; HERE IF MAY BE PADDING, ISSUE WARNING

	MOVE	AC2,[BYTE (5) 20,14]	;NO
	PUSHJ	PP,MSOUT.	;DEVICE
	OUTSTR	[ASCIZ	/ does not support BYTE MODE.
Tape may have records padded with nulls.
/]
	POPJ	PP,		;IGNORE 

>; END IFE TOPS20

	; HERE IF ANSI LABELS, OPEN OUTPUT

OPC31B:	MOVE	AC10,[POINT 7,TMP.BK+.TPFNM] ;GET PTR TO ARG-BLK
	JUMPGE	FLG,OC31DA	; JUMP IF DEVICE DATA MODE NOT ASCII
IFE TOPS20,<
	PUSHJ	PP,TPBTMD	; CHECK FOR BYTE MODE SET
>
	MOVEI	AC1,.TRFFX	; GET FIXED FORMAT CODE
	HRLI	AC1,.TFCAM	; ASSUME CRLF IN ASCII
	HRRZ	AC0,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNE	AC0,SASCII	; DOES HE WANT IT?
	HRLI	AC1,.TFCNO	; YES, THEN INDICATE NO CRLF
	MOVEM	AC1,TMP.BK+.TPREC ; SET FIXED FORMAT, AND FORMS CONTROL
	TRNN	AC0,SASCII	; WAS THAT STD-ASCII?
	PUSHJ	PP,CMPASC	; NO,MAKE SURE WE GET COMPATIBLE ASCII
	LDB	AC3,F.BLBT	; GET LABEL TYPE, LOST IN CMPASC

	; HERE TO PUT VALUE-OF-ID INTO ARG-BLK
	; AC10 HAS DESTINATION BYTE-PTR, AC3 HAS THE LABEL TYPE

OPC31G:	PUSH	PP,AC3		; SAVE LABEL TYPE
	PUSH	PP,AC10		; SAVE DESTINATION PTR
	PUSHJ	PP,OPNEID	; GET VALUE-OF-ID TO ENTER BLOCK
	POP	PP,AC10		; RESTORE DESTINATION PTR
	POP	PP,AC3		; RESTORE LABEL TYPE
	MOVE	AC5,[POINT 6,UEBLK.] ; GET BYT-PTR TO NAME

	; CLEAR FILE NAME FIELD

	MOVEI	AC1,TMP.BK+.TPFNM+1 ; START OF NAME FIELD, + 1L
	HRLI	AC1,-1(AC1)	; FIRST WORD
	SETZM	-1(AC1)		; CLEAR FIRSTWORD		
	BLT	AC1,.TPGEN+TMP.BK-1 ; CLEAR NAME FIELD

	MOVEI	AC1,6		; START LOOP TO WRITE FILENAME
	SETZ	AC2,		; INDICATE THAT FILNAM FIRST
OPC31E:	ILDB	C,AC5		; GET FILNAM CHAR
	JUMPE	C,OPC31C	; SKIP DEPOSIT IF SPACE SEEN
	ADDI	C,40		; CONVERT TO ASCII
	CAIL	AC3,.TFLIL	; SKIP IF NOT EBCDIC
	LDB	C,PTR.79##	; ELSE, CONVERT TO EBCDIC
	IDPB	C,AC10		; WRITE INTO ARG-BLK
OPC31C:	SOJG	AC1,OPC31E	; LOOP TILL FILNAM WRITTEN
	JUMPL	AC2,OPC31A	; JUMP IF FINISHED WITH EXTENSION
	MOVEI	AC1,3		; SET FOR THREE EXTENSION CHARS
	MOVEI	C,"."		; GET DOT FOR EXTENSION
	CAIL	AC3,.TFLIL	; SKIP IF NOT EBCDIC
	MOVEI	C,113		; ELSE, GET EBCDIC "."
	IDPB	C,AC10		; WRITE IT
	SETO	AC2,		; INDICATE EXTENSION NOW
	JRST	OPC31E		; GO WRITE EXTENSION

	; OK, NOW GO WRITE THE LABEL
	
OPC31A:	LDB	AC2,F.BMRS	; GET MAX RECORD SIZE
	MOVEM	AC2,TMP.BK+.TPRSZ ; SET LABEL RECORD SIZE
	MOVE	AC2,D.TCPL(I16)	; GET SIZE OF LOGICAL BLOCK
	MOVEM	AC2,TMP.BK+.TPBSZ ; SET LABEL BLOCK SIZE
	MOVE	AC1,[XWD .TPLEN,TMP.BK] ; INDICATE ARG-BLK
	TAPOP.	AC1,		; DO IT
	 JRST	[ POP	PP,(PP)	; POP RETURN
		 JRST	OMTA96 ] ; AND GIVE ERROR SETTING LABEL INFORMATION 
	POPJ	PP,		; RETURN

OMTAIN:
>; END IFE TOPS20
	; HERE FOR SYS-LABELED CHECKS

	JUMPL	FLG,OMTA02	; GO CHECK ASCII LABELED CASES

	TLNN	FLG,DDMEBC	; RECORDING MODE EBCDIC?
	JRST	OMTA06		; NO

	; SYSTEM LABELS, MUST BE EBCDIC, OR
	; ELSE FOR INPUT THE FORMAT MUST BE "U" AND FOR OUTPUT
	; THE FORMAT MUST BE SET TO "U"

	LDB	AC1,F.BLBT	; GET LABEL TYPE
IFN TOPS20,<
	CAIN	AC1,.LTEBC	; IS IT EBCDIC LABELS
>
IFE TOPS20,<
	CAIE	AC1,.TFLIL	; IS IT IBM?
	CAIN	AC1,.TFLIU	; OR IBM AND USER LABLES?
>
	JRST	OPNLO		; YES, ALL OK ,CONT

	; LABEL TYPE DOES NOT MATCH RECORDING MODE, CHECK IT 

IFN TOPS20,<
	TLNN	FLG,OPNIN	; OPEN FOR INPUT?
	JRST	OMTA0B		; NO, CHECK OUTPUT CASE
>

	; OPEN INPUT, CHECK FORMAT IN LABEL
	
	LDB	AC1,F.BFMT	; GET LABEL FORMAT BITS
	TXNE	AC1,FRMATU	; "U" FORMAT?
	JRST	OPNLO		; YES, ALL OK, CONT

	; ERROR, WRONG LABEL FORMAT 

OMTA0E:	MOVEI	AC0,^D52	; INDICATE SEQ-OPEN ERROR
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	OPNLO		; YES, CONT ON, HE GETS WHAT HE WANTS
	OUTSTR	[ASCIZ/
?Improper tape label format for indicated recording mode./]
	JRST	OMTA99		; GIVE REST OF MESSAGE AND KILL
	; HERE TO CHECK ASCII RECORDING MODE MATCHES LABEL

OMTA02:
IFN TOPS20,<
	TLNE	FLG,OPNIN	; OPEN INPUT?
	JRST	OMTA03		; NO,CHECK OUTPUT STATUS
>
	LDB	AC1,F.BLBT	; GET LABEL TYPE
IFN TOPS20,<
	CAIE	AC1,.LTANS	; IS IT ANSI LABELS
	CAIN	AC1,.LTT20	; OR TOPS20 LABELS?
>
IFE TOPS20,<
	CAIE	AC1,.TFLAL	; IS IT ANSI?
	CAIN	AC1,.TFLAU	; OR ANSI AND USER LABLES?
>
	JRST	OPNLO		; YES, ALL OK ,CONT
	LDB	AC1,F.BFMT	; NO,GET LABEL FORMAT BITS
	TXNE	AC1,FRMATU	; "U" FORMAT?
	JRST	OPNLO		; YES, CONT
	JRST	OMTA0E		; NO,ERROR

	; HERE TO CHECK OUTPUT ANSI-LAB ASCII

OMTA03:
IFN TOPS20,<
	LDB	AC1,F.BLBT	; GET LABEL TYPE
	CAIE	AC1,.LTANS	; IS IT ANSI LABELS
	CAIN	AC1,.LTT20	; OR TOPS20 LABELS?
	TDNA			; YES, SKIP
	JRST	OPNLO		; NO, CONT
	PUSHJ	PP,GETATB	; GET FILE ATTRIBUTES (IF ANY)
	JRST	OMTA04		; NONE SET, CHECK FOR STD-ASCII
OMTA05:	PUSHJ	PP,SETFMT	; SET FORMAT FIELD
	JRST	OPNLO		; AND CONT
; SETFMT	ROUTINE TO SET LABEL FORMAT BITS IN FILATB
; 
; ARG		AC5=FORMAT CHAR
; RETURNS	+1 ALWAYS,AC1 HAS FORMAT BITS SET IN FILTAB
;
; USES		AC1,AC5

SETFMT:	SETZ	AC1,		; CLEAR FORMAT BITS
	CAIN	AC5,"F"		; IS FORMAT "F"?
	TRO	AC1,FRMATF	; YES, SET IT
	CAIN	AC5,"U"		; IS FORMAT "U"?
	TRO	AC1,FRMATU	; YES, SET IT
	CAIN	AC5,"S"		; IS FORMAT "S"?
	TRO	AC1,FRMATS	; YES, SET IT
	CAIN	AC5,"D"		; IS FORMAT "D"?
	TRO	AC1,FRMATD	; YES, SET IT
	DPB	AC1,F.BFMT	; SET LABEL FORMAT BITS
	POPJ	PP,		; RETURN

	; HERE IF NO ATTRIBUTE SET, CHECK FOR STD-ASCII

OMTA04:	HRRZ	AC0,D.RFLG(I16)	;  GET FLAG
	TRNN	AC0,SASCII	; SKIP IF STD-ASCII
	SKIPA	AC5,["U"]	; ELSE ITS U FORMAT
	MOVEI	AC5,"D"		; ITS D FORMAT (SYS DEFAULT)
	JRST	OMTA05		; GO SET FORMAT

>;END IFN TOPS20

	; HERE FOR LABELED SIXBIT OR BINARY

OMTA06:
IFN TOPS20,<
	TLNN	FLG,OPNIN	; OPEN FOR INPUT?
	JRST	OMTA6A		; NO, CHECK OUTPUT CASE
>
	; OPEN INPUT, CHECK FOR VALID LABEL TYPE (U)

	LDB	AC1,F.BFMT	; GET LABEL FORMAT BITS
	TRNN	AC1,FRMATU	; "U" FORMAT ?
	JRST	OMTA0E		; NO, ERROR BAD FORMAT
IFE TOPS20,<
	JRST	OPNLO		; YES, CONT
>
IFN TOPS20,<

	JRST	OMTA6B		; YES, CHECK DEFAULT DATA MODE FOR TROUBLE
	; HERE FOR SIXBIT,BINARY OUTPUT
	; CHECK THAT DEFAULT DATA MODE IS OK, CHANGE TO CORE DUMP IF NOT


OMTA6A:
	PUSHJ	PP,GETATB	; GET SET ATTRIBUTES
	JRST	OMTA6B		; NONE SET,CONT
	PUSHJ	PP,SETFMT	; SET FORMAT FIELD
	TRNN	AC1,FRMATU	; IS IT U FORMAT?
	JRST	OMTA0E		; NO,ERROR
	JRST	OPNLO		; YES, CONT

OMTA6B:	PUSHJ	PP,GTDFLT	; GET DEFAULT DATA MODE SETTING
	CAIE	AC3,.SJDMA	; IS IT ANSI-ASCII?
	CAIN	AC3,.SJDM8	; OR INDUSTRY COMPATIBLE?
	JRST	OMTA6D		; YES,SKIP
	JRST	OPNLO		; ALL DONE, CONT

	; HERE IF DEFAULT DATA-MODE WILL CAUSE PA1050 TO USE BAD BYTE SIZE

OMTA6D:	MOVEI	AC2,.TFMDD	; INDICATE SET CORE DUMP MODE
	PUSHJ	PP,TAPMOD	; GO SET IT
	 JRST	OMTA93		; ERROR, GO INDICATE SO
	JRST	OPNLO		; ALL DONE, CONT

	; HERE IF TOPS20 UNLABELED

OMTA6E:	TLNE	FLG,OPNOUT	; OPEN OUTPUT?
	TLNN	FLG,DDMBIN+DDMSIX ; AND SIXBIT OR BINARY DEVICE MODE?
	JRST	OPNLO		; NO, ALL OK

	; HERE IF UNLABELED OUTPUT SIXBIT-BINARY

	PUSHJ	PP,GTDFLT	; GET DEFAULT DATA MODE SETTING
	CAIE	AC3,.SJDM8	; INDUSTRY COMPATIBLE DEFAULT?
	JRST	OPNLO		; NO, ALL OK
	JRST	OMTA6D		; YES, GO SET CORE DUMP MODE
; GETATB	ROUTINE TO GET FILE FORMAT ATTRIBUTE THAT MIGHT BE SET
;
; RETURNS	NON-SKIP	IF NONE SET
;		SKIP		IF ATTRIBUTE SET, AC5=ATTRIBUTE CHAR
;					(RIGHT JUSTIFIED)
; USES		AC1-AC5
;


GETATB:	LDB	AC2,UUOCHN	; GET CHAN NUMBER FROM OPEN UUO XCT WRD
	PUSHJ	PP,GETJFN	; GET JFN IN AC1
	 JRST	[OUTSTR	[ASCIZ/
?OPEN MTA get JFN /]			;ERROR, ISSUE MESSAGE
		JRST	OCPERR]		;MORE MESSAGE AND KILL
	MOVEI	AC2,(AC1)	; GET JFN TO AC2
	HRROI	AC1,AC5		; INDICATE WANT RESULTS IN AC5
	MOVEI	AC3,JS%AT1	; INDICATE SINGLE ATTRIBUTE,AC4 HAS IT
	MOVE	AC4,[POINT 7,[ASCIZ /FORMAT/]] ;INDICATE WANT FORMAT VALUE
	SETZ	AC5,		; CLEAR DESTINATION
	JFNS%			; RETURN ANY FORMAT ATTRIBUTE SET
	 ERJMP	RET.1		; ERROR, ASSUME IT IS NONE SET, RETURN
	ROT	AC5,^D7		; ROTATE CHAR TO RIGHT POSITION
	JRST	RET.2		; ELSE, GOT ONE IN AC5, GIVE GOOD RETURN


	; HERE TO CHECK FOR ;FORMAT ATTRIBUTE "U" (TOPS20)

OMTA0B: PUSHJ	PP,GETATB	; GET FILE FORMAT ATTRIBUTE
	 JRST	OMTA0E		; NONE SET, GIVE ERROR
	CAIE	AC5,"U"		; IS FORMAT "U"?
	JRST	OMTA0E		; NO, GIVE ERROR
	JRST	OPNLO		; YES, OK, CONT

>;END IFN TOPS20

OPNF00:	TXNE	AC16,OPN%NR	;REWIND REQ ?
	JRST	OPNFW1		;NO
	JRST	OPNREW		;YES

OPNRE1:	OUTSTR	[ASCIZ /$ Unexpected BOT marker/]	;[277]
	SKIPA
OPNFW2:	OUTSTR	[ASCIZ /$ Unexpected EOT marker/]	;[277]
	PUSHJ	PP,SAVAC.
	OUTSTR	[ASCIZ /$ encountered while positioning /]
	MOVE	AC2,[BYTE (5)10,31,20,14]  ;FILE ON DEVICE.
	PUSHJ	PP,MSOUT.
OPNFW4:	TXNN	AC13,DV.DTA!DV.MTA	;SKIP IF A REEL DEVICE
	JRST	KILL		;
	OUTSTR	[ASCIZ /
If wrong reel please mount correct reel then /]
OPNF04:	PUSHJ	PP,C.STOP	;TYPE CONTINUE TO RETRY
	PUSHJ	PP,RSTAC.
	MOVX	AC5,DB.HF	;ANOTHER TAPE WAS MOUNTED
	ANDCAM	AC5,D.HF(I16)	;CLEAR THE "HEAD-UNDER-FILE" FLAG
	JRST	OPNBP4		;TRY AGAIN
	;PLACE VALUE OF ID IN LOOKUP/ENTER BLOCK

OPNLID:	SKIPA	AC10,[POINT 6,ULBLK.]	;LOOKUP SETUP
OPNEID:	MOVE	AC10,[POINT 6,UEBLK.]	;ENTER SETUP
IFN ISAM,<
	TLNE	FLG,IDXFIL	;ISAM ?
	SKIPA	AC5,[POINT 6,DFILNM(I12)]
>
	MOVE	AC5,F.WVID(I16)	;BYTE POINTER TO VALUE OF ID
	JUMPE	AC5,[HRROI C,.GTPRG	;MONITOR TABLE FOR PROGRAM NAME
		GETTAB	C,
		  MOVE	C,RN.NAM	;USE PROGRAM NAME INSTEAD
		MOVEM	C,UEBLK.	;FOR ENTER
		SETZM	ULBLK.		;0 FOR LOOKUP
		JRST	OPNEI2]
	PUSHJ	PP,OPNVID	;[447]
OPNEI2:	SETZM	ULBLK.+3	;P,,P
	SETZM	UEBLK.+3	;PROJ,,PROG
	HLLZS	ULBLK.+1	;ZERO RIGHT HALF OF EXTENSION WORD
	HLLZS	UEBLK.+1	;   IN LOOKUP AND ENTER BLOCK
IFN SIRUS,<
	MOVSI	AC5,015000	; [403] SET PROTECTION CODE TO ALLOW
	MOVEM	AC5,UEBLK.+2	; [403] SIRUS PROJ USERS TO WRITE
	>
IFE SIRUS,<
	SETZM	UEBLK.+2	;CLEAR PROTECTION AND DATE
	>
OPNPPN:	HRRZ	AC5,F.RPPN(I16)	;ADR OF PROJ,,PROG
	JUMPE	AC5,RET.1	;USE DEFAULT
	MOVE	AC5,(AC5)	;PROJECT,,PROGRAMER
IFE TOPS20,<
	TLNE	AC5,-1		;[544] PROJECT#
	TRNN	AC5,-1		;[544] OR PROGRAMMER # ZERO?
	SKIPN	AC5		;[560] BUT NOT BOTH
	JRST	OPNPP1		;[560] NO, DON'T DEFAULT
	PUSH	PP,AC5		;[544] SAVE THIS PPN
	GETPPN	AC5,		;[544] GET DEFAULT
	  TRN			;[544] INCASE OF .JACCT
	EXCH	AC5,0(PP)	;[544] GET BACK THE USER NUMBER GIVEN
	TLNN	AC5,-1		;[544] ZERO PROJ#?
	HLL	AC5,0(PP)	;[544] YES, FILL IN DEFAULT
	TRNN	AC5,-1		;[544] ZERO PROG#?
	HRR	AC5,0(PP)	;[544] YES, FILL IN DEFAULT
	POP	PP,(PP)		;[544] FIXUP STACK
OPNPP1:>
	MOVEM	AC5,ULBLK.+3
	MOVEM	AC5,UEBLK.+3
	POPJ	PP,		;AND RETURN

OPNVID:	MOVEI	AC6,9		;[444] ID HAS 9 CHARACTERS MAX
	TLNN	AC5,600		; IS VID EBCDIC?
	JRST	OPNVIE		;YES
	TLNN	AC5,100		;IS VID ASCII?
	JRST	OPNVIS		;NO, MUST BE SIXBIT

OPNVIA:	ILDB	C,AC5		;PICK UP A CHAR
	LDB	C,PTR.76##	; CONVERT TO SIXBIT (TAKE CARE OF lower-case)
	IDPB	C,AC10		;STORE IN E BLOCK
	SOJN	AC6,OPNVIA	;LOOP 11 TIMES
	JRST	OPNEI1		;DONE

OPNVIE:	ILDB	C,AC5		;PICK UP A CHAR
	LDB	C,PTR.96##	; CONVERT TO SIXBIT
	IDPB	C,AC10		;STORE IN E BLOCK
	SOJN	AC6,OPNVIE	;LOOP 11 TIMES
	JRST	OPNEI1		;DONE

OPNVIS:	ILDB	C,AC5		;PICK UP A CHAR
	IDPB	C,AC10		;STORE IN E BLOCK
	SOJN	AC6,OPNVIS	;LOOP 11 TIMES

OPNEI1:	HLLZ	AC6,-1(AC10)	;[563] GET LHS OF FILE NAME
	JUMPN	AC6,RET.1	;[563] IF ZERO IT COULD BE CONFUSED WITH EXTENDED ENTER/LOOKUP ON TOPS-10
	PUSHJ	PP,DSPL1.	;[563] DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /?Illegal VALUE OF ID for/]	;[563]
	MOVSI	AC2,(BYTE (5) 10)	;[563] PRINT FILE NAME
	PUSHJ	PP,MSOUT1	;[563] NEVER RETURNS

IFN ISAM,<
OPNLIX:	MOVEI	AC10,OPNLID
	TRNA
OPNEIX:	MOVEI	AC10,OPNEID
	TLC	FLG,IDXFIL
	PUSHJ	PP,(AC10)
	TLC	FLG,IDXFIL
	POPJ	PP,
>
SUBTTL	OPEN VERB	USE procedure
	;PERFORM A USE PROCEDURE
	;CALLED WITH AN INDEX IN AC1,   ***POPJ***

USEPRO:	JUMPE	AC1,USEPR0	;JUMP IF ERROR USEPRO
	TLNN	FLG1,NONSTD!STNDRD
	POPJ	PP,		;EXIT, THERE ARE NO LABELS
USEPR0:	PUSHJ	PP,SAVAC.	;SAVE THE ACS
	PUSHJ	PP,USESUP	;GET USE-PRO ADDRESS INTO AC1 AND AC2
	TXNE	AC16,CLS%EV!CLS%BV ;SKIP IF NOT A REEL PRO
	JRST	USEPR1		;
	LDB	AC0,F.BPMT	;FILE POSITION ON MTA
	JUMPN	AC0,USEPR2	;JUMP IF MULTI FILE REEL
	TXNE	AC16,CLS%EF	;SKIP IF AN OPEN USEPRO
USEPR1:	PUSHJ	PP,USESWP	;SET FOR REEL PROCEDURE
USEPR2:	PUSHJ	PP,USEXCT	;EXECUTE A PRO
	MOVE	AC16,-16(PP)	;RESTORE AC16
	TXNN	AC16,CLS%EV!CLS%BV ;EXIT IF A REEL PRO
	SKIPN	-1(PP)		;OR AN ERROR PRO
	JRST	RSTAC1		;EXIT
	PUSHJ	PP,USESUP	;SETUP
	TXNN	AC16,CLS%EF	;SKIP IF A CLOSE TYPE USEPRO
	PUSHJ	PP,USESWP	;SET FOR REEL PROCEDURE
	LDB	AC0,F.BPMT	;FILE POSITION
	JUMPN	AC0,RSTAC1	;EXIT, NOT A MULTI-REEL-FILE
	PUSHJ	PP,USEXCT	;ELSE PERFORM THE USE-PRO
	JRST	RSTAC1		;@POPJ
	;	 GENERAL (NON-FILE-SPECIFIC) USE PROCEDURES ARE ADDRESSED
	; THROUGH A TABLE , WHOSE ADDRESS IS CONTAINED
	; IN USES., WHICH IS DIVIDED INTO SECTIONS
	; ACCORDING TO OPEN MODE. EACH SECTION IS 5 WORDS LONG
	; WITH THE FOLLOWING FORMAT
	;
	;	SECTION OFFSET		USE PROCEDURE ADDRESS
	;
	;		0		ERROR
	;		1		BEFORE BEGINNING
	;		2		AFTER BEGINNING 
	;		3		BEFORE ENDING
	;		4		AFTER ENDING
	;
	;	 EACH OF THE LABEL (68 ONLY) ENTRIES HAVE TWO ADDRESSES, THE 
	; REEL IN THE LEFT HALF AND THE FILE IN THE RIGHT 
	;					(REEL-ADDR,,FILE-ADDR)
	;
	;	THE SECTIONS ARE ORDERED INPUT,OUTPUT,I-O WITH EXTEND HAVING
	; THE LAST ENTRY.
	;
	;	FILE SPECIFIC USE PROCEDURE ADDRESSES ARE IN THE FILTAB, WITH
	; 68 LABEL ADDRESSES IN THE SAME FORMAT AS ABOVE



USESUP:	MOVE	AC1,-2(PP)	;INDEX FOR THE USE TABLES
	MOVEM	AC1,AC2		;
	ADDI	AC2,F.REUP(I16)	;ADR OF FILE USE PRO
	ADD	AC1,USES.	;ADR OF GENERAL USE PRO
	MOVE	FLG,-10(PP)	;RESTORE AC7
	TLNN	FLG,OPNOUT	;SKIP IF OUTPUT
	JRST	USESU1		;INPUT USE PRO
	HRRZ	AC3,D.RFLG(I16)	; GET RUN FLAGS
	TRNN	AC3,EXTOPN	; WAS THIS OPENED EXTEND?
	JRST	USESU0		; NO,CONT
	ADDI	AC1,EXTUSE	; SET EXTEND USE PROCEDURE OFFSET
	JRST	USESU1		; AND CONT

USESU0:	TLNE	FLG,OPNIN	;SKIP IF NOT INPUT
	ADDI	AC1,USESEC	;INPUT/OUTPUT USE PRO,SKIP A SECTION
	ADDI	AC1,USESEC	;OUTPUT USE PRO, SKIP A SECTION
USESU1:	MOVE	AC1,(AC1)
	MOVE	AC2,(AC2)
	SKIPN	USES.		;
	SETZ	AC1,		;FOR STAND ALONE SORTS
	POPJ	PP,		;

USESWP:	SKIPN	-2(PP)		;IF ERROR USEPRO
	POPJ	PP,		;  JUST RETURN
	HLRZ	AC1,AC1		;USE THE REEL ADDRESS
	HLRZ	AC2,AC2		;IN THE LEFT HALF
	POPJ	PP,		;

USEXCT:	MOVE	AC3,-2(PP)	;PP-2=AC1; USE TABLE INDEX
	TRNE	AC2,-1		; IS THERE A FILE SPECIFIC USEPRO?
	HRRZ	AC1,AC2		; YES,GET SPECIFIC FILTAB USEPRO
	JUMPN	AC1,USEXC1	; NO,DEFAULTS TO GENERAL,GO PERFORM USEPRO
	JUMPN	AC3,USEXC2	;IF NO LABEL USEPRO RETURN
	AOSA	-20(PP)		;IF NO ERROR USEPRO SKIP-EXIT
USEXC1:	PUSHJ	PP,(AC1)	;XCT THE USEPRO
USEXC2:	POPJ	PP,		;
	;RECSLB.. MOVE RECORD AREA TO SIXBIT STD-LABEL AREA
	;SLBREC.. MOVE SIXBIT STD-LABEL AREA TO RECORD AREA.   ***POPJ***

RECSLB:	TLOA	AC0,400000	;
SLBREC:	TLZ	AC0,400000	;
	MOVE	AC2,STDLBP	; SET UP TO/FROM POINTERS
	LDB	AC1,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HLLZ	AC1,RBPTBL(AC1)	; AND RECORD BYTE PTR
	SKIPL	AC0		; WHICH WAY?
	EXCH	AC1,AC2		; STD-LABEL TO RECORD AREA
	MOVEI	AC0,^D80-2	;
	TLNE	FLG,DDMEBC	; EBCDIC ALWAYS HAS
	MOVEI	AC0,^D80	; 80. CHARS
SLBRE1:	ILDB	C,AC1		;
	TLNE	AC1,1000	; EBCDIC TO SIXBIT?
	LDB	C,PTR.96##	; YES
	TLNE	AC2,1000	; SIXBIT TO EBCDIC?
	LDB	C,PTR.69##	; YES
	TLNN	FLG,CDMSIX!CDMEBC ;
	ADDI	C,40		; ASCII
	IDPB	C,AC2		;
	SOJG	AC0,SLBRE1	;
	POPJ	PP,		;;;;;

	;READ THE LABEL INTO THE RECORD AREA.   ***POPJ***

BUFREC:	PUSHJ	PP,BUFRE0	;SETUP
	MOVE	AC10,D.RCNV(I16)	;SETUP AC10
BUFRE1:	SOSGE	D.IBC(I16)		;
	PUSHJ	PP,READSY	;FILL THE BUFFER
	  JRST	BUFR01		;NORMAL RETURN
	JRST	CLSRL0		;EOF - COMPLAIN

BUFR01:	ILDB	C,D.IBB(I16)	;PICK UP A LABEL CHAR
	XCT	AC10		;CONVERT IF NECESSARY
	IDPB	C,AC3		;TO THE RECORD AREA
	SOJG	AC0,BUFRE1	;LOOP TILL LABEL IS IN THE RECORD AREA
	SETZM	D.IBC(I16)	;THE BUFFER IS EMPTY
	POPJ	PP,
	;WRITE OUT THE LABEL.   ***POPJ***

RECBUF:	PUSHJ	PP,BUFRE0	;SETUP
	MOVE	AC10,D.WCNV(I16)	;SETUP AC10
RECBU1:	SOSGE	D.OBC(I16)
	PUSHJ	PP,WRTOUT	;WRITE OUT THE BUFFER
	ILDB	C,AC3		;PICK UP A LABEL CHAR
	XCT	AC10		;CONVERT IF NECESSARY
	IDPB	C,D.OBB(I16)	;TO THE OUTPUT BUFFER
	SOJG	AC0,RECBU1	;LOOP TILL DONE
	POPJ	PP,

	;SET LABEL POINTER AND SIZE AND POPJ.
BUFRE0:	LDB	AC3,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HLLZ	AC3,RBPTBL(AC3)	; AND THEN RECORD BYTE-PTR
	MOVEI	AC0,^D80-2	;STD-LABEL SIZE
	TLNE	FLG,DDMEBC	; EBCDIC DEVICE?
	MOVEI	AC0,^D80	; LABEL SIZE
	TLNE	FLG1,NONSTD	;
	HLRZ	AC0,F.LNLS(I16)	;NON-STD-LABEL SIZE
	TLNN	FLG,DDMBIN	;IS FILE BINARY?
	POPJ	PP,		;NO
	HRLZI	AC3,(POINT 36,(FLG))	;MAKE ONE BYTE BE ONE WORD
	LDB	AC10,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC10,RBPTBL(AC10) ; GET CHARS PER WORD
	ADDI	AC0,-1(AC10)	;  -
	IDIV	AC0,AC10	;  TO WORD COUNT
	POPJ	PP,
	;ZERO THE STANDARD LABEL AREA.   ***POPJ***

ZROSLA:	SETZM	STDLB.		;
	MOVEI	AC1,STDLB.+1	;TO
	HRLI	AC1,STDLB.	;FROM,TO
	BLT	AC1,STDLB.+15	;ZERO 16 WORD STD LABEL AREA
	POPJ	PP,

	;MOVE SPACES TO THE RECORD AREA.   ***POPJ***

ZROREC:	LDB	AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE
	MOVE	AC2,SPCTBL(AC2)	; GET A WORD OF SPACES
	MOVEM	AC2,(FLG)	; TO THE RECORD AREA
	SETZ	AC2,		; INIT AC2
	TLNE	FLG1,STNDRD	; STANDARD LABELS?
	MOVEI	AC2,^D80	; YES
	TLNE	FLG1,NONSTD	; NON-STANDARD LABELS?
	HLRZ	AC2,F.LNLS(I16)	; YES
	LDB	AC1,F.BMRS	;MAX REC SIZ
	CAMGE	AC1,AC2		; USE THE LARGER SIZE
	MOVE	AC1,AC2		; LABEL LARGER.
	LDB	AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC2,RBPTBL(AC2)	; GET CRARS PER WORD
	ADDI	AC1,-1(AC2)	;CONVERT TO 
	IDIV	AC1,AC2		;  WORDS
	HRLI	AC2,(FLG)	;THE FROM ADR
	HRRI	AC2,1(FLG)	;THE TO ADR
	ADDI	AC1,-1(FLG)	;THE UNTIL ADR
	BLT	AC2,(AC1)	;ZRAPP!
	POPJ	PP,		;

SPCTBL:	ASCII /     /			; ASCII SPACES
	BYTE (9) 100,100,100,100	; EBCDIC
	SIXBIT /      /			; SIXBIT

SPCTB1:	40	; ONE ASCII SPACE RIGHT JUSTIFIED
	100	; EBCDIC
	0	; SIXBIT
	;SAVE THE ACS ON THE PUSH DOWN STACK.   ***"POPJ"***

SAVAC.:	POP	PP,TEMP.	;POP OFF THE RETURN
	PUSH	PP,AC16		;SAVE AC16 - AC0
	MOVEI	AC16,15		;
	PUSH	PP,(I16)	;
	SOJGE	AC16,.-1	;
	MOVE	AC16,-16(PP)	;
	JRST	@TEMP.		;LAST ENTRY IS AC0

	;RESTORE THE ACS.   ***"POPJ"***

	;RSTAC1 MUST -NOT- BE CALLED VIA PUSHJ
RSTAC1:	HRRZI	AC16,RET.1
	MOVEM	AC16,TEMP.
	TRNA
	;RSTAC. MUST BE CALLED VIA PUSHJ
RSTAC.:	POP	PP,TEMP.	;RESTORE AC0 - AC16
	HRLZI	AC16,-16	;
	POP	PP,(I16)	;
	AOBJN	AC16,.-1	;
	POP	PP,AC16		;
	JRST	@TEMP.		;

	;FREE THE IO CHANNEL.   ***POPJ***
IFN ISAM,<
FRECH1:	SKIPA	AC2,ICHAN(I12)	;IDX-DEV'S CHAN
>

FRECHN:	LDB	AC2,DTCN.	;CHANNEL NUMBER
FRECH2:	MOVNS	AC2		;SHIFT TO THE RIGHT
	HRLZI	AC0,400000	;MASK BIT
	LSH	AC0,(AC2)	;POSITION THE MASK
	ORM	AC0,OPNCH.	;MAKES THE CHANNEL AVAILABLE
	POPJ	PP,		;

	;DISTRIBUTE THE CHANNEL NUMBER THROUGH THE UUO TABLE.   ***POPJ***

SETCN.:	LDB	AC5,DTCN.	; CHANNEL NUMBER
SETC1.:	HRLZI	AC10,ULEN.##-1	; GET TABLE LENGTH
	MOVE	AC6,[POINT 4,UFRST.(AC10),12]
	DPB	AC5,AC6		; INSERT THE CHAN NUMBER
	AOBJN	AC10,.-1	; LOOP TILL THE LAST LOC
	POPJ	PP,
	;RETURN A FREE CHANNEL NUMBER IN AC5

GCHAN:	SKIPN	AC5,OPNCH.	;ANY CHANNELS AVAILABLE?
	SKIPA	AC2,[BYTE (5)10,2,4,5] ;FCBO,TMOF.
	SKIPA	AC6,OPNCBP	;YES, SKIP + GET BYTE POINTER
	JRST	MSOUT.		;ERROR MESSAGE + KILL
	HRRI	AC5,1		;[342] START WITH 1
	MOVEI	AC2,17		;[342] UPPER LIMIT
GCHAN2:	ILDB	AC11,AC6	;[342] GET FIRST CHAN FLAG
	SOJE	AC11,GCHAN1	;[342] JUMP IF IT WAS A ONE
	CAIG	AC2,(AC5)	;[342] IF TRIED ALL 17
	JRST	GCHAN0		;[342] THEN HAVE TO USE 0
	AOJA	AC5,GCHAN2	;[342] AC5 (RIGHT) HAS CHAN NUMBER
GCHAN1:	DPB	AC11,AC6	;[342] NOTE THAT CHAN UNAVAILABLE
	POPJ	PP,

GCHAN0:	SETZB	AC5,AC11	;[342] USE CHANNEL 0
	MOVE	AC6,OPNCBP	;[342] MARK CHAN 0 IN USE
	JRST	GCHAN1		;[342] AND EXIT


	;INCREMENT THE REEL NUMBER BY ONE.   ***POPJ***

INCRN.:	LDB	AC2,DTRN.	;SIXBIT ADD ONE TO CURRENT REEL NUMBER
	MOVE	AC0,AC2		;SO THE REEL NUMBER MAY BE RESTORED
	TRNE	AC2,10
	TRNN	AC2,1		;SKIP IF INC. WILL CAUSE A CARRY OUT
	AOJA	AC2,INCRN1	;INCREMENT THE REEL NUMBER
	TRNE	AC2,1000
	TRNN	AC2,100
	TRNA			;[327]
	JRST	INCRN2		;99 IS MAX
	ADDI	AC2,100		;[327] ADD 100
	TRZ	AC2,11		;THE INCREMENT
INCRN1:	DPB	AC2,DTRN.	;SAVE AS CURRENT REEL NUMBER
	POPJ	PP,

INCRN2:	MOVE	AC2,[BYTE (5)10,31,20,2,4,14]
	PUSHJ	PP,MSOUT.
	OUTSTR	[ASCIZ /99 is the maximum acceptable reel number./]
	JRST	KILL
	;OPEN FAILED - GIVE FATAL MESSAGE OR IGNORE IT
OERRDF:	MOVE	AC0,[E.MOPE+E.FIDA];ERROR NUMBER
	SETZM	FS.IF		;IDA FILE
	JRST	OERRI1		;

	;OPEN FAILED
OERRIF:	MOVE	AC0,[E.MOPE+E.FIDX];ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVE	AC0,[E.MOPE]	;NO
OERRI1:	PUSHJ	PP,IGCVR	;IGNORE?
	 JRST	RCHAN		;YES - NO MESSAGE BUT FILE IS NOT OPEN
	MOVE	AC2,[BYTE (5)25,4,20,13,23,15]
	JRST	MSOUT.		;DEVICE IS NOT A DEVICE OR NOT AVAILABLE

	;RENAME OF "IDX" FILE FAILED
ORERRI:	MOVE	AC0,[E.MREN+E.FIDX];MAKE AN ERROR NUMBER
	JRST	OEERR1		;

	;RENAME FAILED
ORERR:	SETZM	FS.IF		;IDA FILE
	MOVE	AC0,[E.MREN+E.FIDA];ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVE	AC0,[E.MREN]	;NO, ERROR NUMBER
	JRST	OEERR1		;

	;ENTER OF "IDX" FILE FAILED
OEERRI:	MOVE	AC0,[E.MENT+E.FIDX];ERROR NUMBER
	JRST	OEERR1		;

	;ENTER FAILED
OEERR:	MOVEI	AC0,^D30	;GET FILE-STATUS CODE = PERM. ERROR
	MOVEM	AC0,FS.FS	;SET IT UP
	SETZM	FS.IF		;IDA FILE
	MOVE	AC0,[E.MENT+E.FIDA];ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVE	AC0,[E.MENT]	;NO, ERROR NUMBER
OEERR1:	PUSHJ	PP,ERCDE	;IGNORE?
	 JRST	RCHAN		;YES
	JRST	ENRERR		;GIVE ERROR MESSAGE

	;LOOKUP OF "IDX" FILE FAILED
OLERRI:	MOVE	AC0,[E.MLOO+E.FIDX];ERROR NUMBER
	JRST	OLERR1		;



	;LOOKUP FAILED
OLERR:	SETZM	FS.IF		;IDA FILE
	MOVE	AC0,[E.MLOO+E.FIDA];ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVE	AC0,[E.MLOO]	;NO, ERROR NUMBER
OLERR1:	PUSHJ	PP,ERCDL	;IGNORE?
	 JRST	RCHAN		;YES
	JRST	LUPERR		;GIVE ERROR MESSAGE
	;GET THE LOOKUP/ENTER/RENAME/FILOP ERROR CODE INTO AC0
ERCDL:	SKIPA	AC1,ULBLK.+1	;GET ERROR CODE FROM LOOKUP BLOCK
ERCDE:	MOVE	AC1,UEBLK.+1	;  OR ENTER BLOCK
ERCDF:	ANDI	AC1,37		;GET ONLY THE ERROR BITS
	CAIL	AC1,10		;DON'T CONVERT TO
	ADDI	AC0,2		;  DECIMAL
	CAIL	AC1,20		;  GET RID
	ADDI	AC0,2		;  OF 8, 9
	CAIL	AC1,30		;  18, 19
	ADDI	AC0,2		;  28 AND 29
	ADD	AC0,AC1		;ADD IN THE ERROR CODE
	CAIE	AC1,6		;HARDWARE ERROR?
	JRST	IGCVR		;NO
	MOVEI	AC1,^D30	;YES
	MOVEM	AC1,FS.FS	;LOAD FILE-STATUS
	JRST	IGCVR		;FINISH UP

	;RELEASE THE IO CHANNEL AND NOTE THAT IT'S FREE
RCHAN:
IFN ISAM<
	TLNN	FLG,IDXFIL	;INDEXD FILE?
	JRST	RCHAN1		;NO
	HRRZ	AC5,ICHAN(I12)	;GET THE CHANNEL NUMBER
	PUSHJ	PP,SETC1.	;SET UP THE RELEASE UUO
	XCT	URELE.		;RELEASE IT
	PUSHJ	PP,FRECH1	;  AND FREE THE CHAN
	PUSHJ	PP,SETCN.	;SET UP FOR THE "IDA" FILE
>

RCHAN1:	XCT	URELE.		;RELEASE IT
	JRST	FRECHN		;FREE THE CHAN AND RET TO CBL-PRG

	;CALL VIA JRST
	;AC0 HAS ERROR NUMBER FOR IGCV - AC2 HAS ERROR MESSAGE FOR MSOUT.
PRGERR:	SETZM	PRGFLG		;[1003] IN CASE FILE WAS CLOSED WITH DELETE
OXITER:	TLNE	FLG,IDXFIL	;ISAM FILE?
	ADD	AC0,[E.FIDX]	;YES
	PUSHJ	PP,IGCV		;IGNORE ERROR?
	 JRST	MSOUT.		;NO
	POPJ	PP,		;YES, BACK TO MAIN LINE


	;CALL VIA PUSHJ -- AC0 HAS ERROR NUMBER

OXITP:	TLNE	FLG,IDXFIL	;ISAM FILE?
	ADD	AC0,[E.FIDX]	;YES
	PUSHJ	PP,IGCVR	;IGNORE ERROR ?
	 POP	PP,(PP)		;YES, POP OFF RETURN
	POPJ	PP,		; RETURN

	;FILE ALREADY OPEN

OPNFAO: HRLZI	AC2,(BYTE (5)10,2,3) ;FCBO,AO.
	MOVEI	AC0,^D10	;ERROR NUMBER
	JRST	OXITER		;ONLY CLOSED FILES MAY BE OPENED

	;FILE ALREADY LOCKED

OPNFAL: MOVEI	AC0,^D11	;ERROR NUMBER
	PUSHJ	PP,OXITP	;DOESN'T RETURN IF IGNORING ERRORS
	OUTSTR	[ASCIZ /LOCKED /]
	HRLZI	AC2,(BYTE(5)10,2,4)
	JRST	MSOUT.		;EXIT, THE FILE IS LOCKED

	;DEVICE NOT AVAILABLE TO JOB

OPNDNA:	MOVE	AC2,[BYTE (5)10,2,4,20,15]	;FCBO,DINATTJ.
	MOVEI	AC0,^D13	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

;IF CHECKPOINT MODE IS REQUIRED SET BIT IN OPEN BLOCK

IFE TOPS20,<
OPNCKP:
;	SKIPN	M7.00		;[1100] IS IT 7.00 OR LATER?
;	POPJ	PP,		;[1100] NO
	LDB	AC1,F.BCKP	;IS RIB UPDATE REQUIRED
	JUMPE	AC1,RET.1	;NO
	MOVX	AC1,UU.RRC	;OPEN RIB UPDATE FUNCTION
	IORM	AC1,UOBLK.	;YES, SET IT
	POPJ	PP,
>
SUBTTL	WRITE OUT THE BUFFER

	;ALL BUFFERED OUTPUTS ARE DONE HERE.  ***POPJ***

WRTOUT:	SKIPG	D.OE(I16)	;[470] FIRST OUTPUT?
	JRST	CHKLOK		;[470] YES, CHECK IF DEVICE WRITE-LOCKED
WRTOT1: AOS	D.OE(I16)	;BUMP OUTPUT COUNT
	XCT	UOUT.		;DO THE OUTPUT
	  PUSHJ	PP,CKFOD	;NORMAL RETURN, SEE IF CHECKPOINT REQUIRED
WRTWAI:	XCT	UWAIT.		;FOR ALL THE ERRORS
	XCT	UGETS.		;
	TXNE	AC2,IO.ERR	;ERRORS?
	JRST	WRTERR		;THERE ARE ERRORS.
WRTFIN:	MOVE	AC13,D.DC(I16)	; GET DEVICE CHARACTERISTICS
	TXNE	AC13,DV.MTA	;MTA?
	TXNN	AC2,IO.EOT	;EOT?
	JRST	WRTXIT		;NOT A MAGTAPE EOT
	TXNE	AC16,V%READ!CLS%EF!CLS%EV	;CLOSE OR READ?
	JRST	WRTXIT		;YES TYPE 'F' OR 'R' LABEL OR READ
	LDB	AC0,F.BPMT	;COULD BE WRITE, OPEN, OR CLOSE 'B'
	JUMPN	AC0,WRTMFR	;JUMP IF MFR
	TXO	AC16,FL%EOT	;EOT FLAG

	; CLEAR STATUS ONLY FOR 10

IFE TOPS20,<
	JRST	WRTXIT		;
>
IFN TOPS20,<
	POPJ	PP,		; 
>


WRTMFR:	MOVE	AC0,[E.MOUT]	;OUTPUT ERROR
	PUSHJ	PP,IGMDR	;IGNORE ERROR?
	 JRST	WRTXIT		;YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ/Encountered an "EOT" on a multi file reel while processing/]
	MOVE	AC2,[BYTE(5)10,31,20,36]
	JRST	MSOUT.		;/FILE ON DEVICE/ KILL

	;READ EOF GETS A SKIP EXIT
WRTRSX:	TLO	FLG,ATEND	;SET READ AN "EOF"
	TXNN	AC16,V%READ	;SKIP IF ITS A READ
	JRST	WRTRS1		;DON'T SET ERROR STATUS IF A WRITE
	PUSHJ	PP,ENDSTS	;SET FILE-STATUS IF REQUIRED
	  TRN

WRTRS1:	AOS	(PP)		;SKIP EXIT VIA WRITE EXIT

WRTXIT:	XCT	UGETS.		;GET STATUS
	TXNE	AC13,DV.MTA	;MAGTAPE?
	TXZA	AC2,IO.ERR!IO.EOF!IO.EOT	;MAGTAPE.
	TXZ	AC2,IO.ERR!IO.EOF	;OTHER.
	XCT	USETS.		;SET STATUS
	POPJ	PP,		;RETURN
;[470] HERE TO CHECK IF DEVICE IS WRITE-LOCKED ON FIRST OUTPUT

CHKLOK:	TXNN	AC13,DV.MTA	;[470] MTA?
	JRST	WRTOT1		;[470] NO
	XCT	MERAS.		;[470] TO DETERMINE IF TAPE IS WRITE-LOCKED
	XCT	MWAIT.		;[525] CHECK FOR WRITE LOCK ERROR
	XCT	UGETS.		;[470] GET STATUS
	TXNN	AC2,IO.IMP	;[470] WRITE-LOCKED?
	JRST	WRTOT1		;[470] NO, OK TO DO OUTPUT
WRTERR:	TXNE	AC13,DV.MTA	;MTA?
	TXNN	AC2,IO.IMP	;WRITE-LOCKED?
	JRST	WRTER1		;NO
	TXC	AC2,IO.ERR	;
	TXCN	AC2,IO.ERR	; IS THIS A MTA LABEL PROCESSING ERROR?
	JRST	WRTER1		; YES - CATCH IT AT IOERMS
	PUSHJ	PP,SAVAC.	;IT'S A WRITE-LOCKED MAGTAPE
	OUTSTR	[ASCIZ /$ /]
	MOVE	AC2,[BYTE(5)22,27,10,31,20,4,14]
	PUSHJ	PP,MSOUT.	;"CANNOT DO OUTPUT TO <DEVICE><FILE>
	OUTSTR	[ASCIZ/Is the device write enabled?/]
	PUSHJ	PP,C.STOP	;"TYPE CONTINUE TO PROCEDE"
	PUSHJ	PP,RSTAC.	;RESTORE THE ACS
	TXZ	AC2,IO.ERR!IO.EOF	;TURN OFF THE ERROR BITS
	XCT	USETS.		;SET STATUS
	JRST	WRTOUT		;[525] TXY AGAIN

WRTER1:	MOVE	AC0,[E.MOUT]	;OUTPUT ERROR
	PUSHJ	PP,IGMDR	;IGNORE ERROR?
	 JRST	WRTXIT		;YES
	MOVE	AC2,[BYTE(5)36,31,20,10,4,14]
	PUSHJ	PP,MSOUT.	;"OUTPUT ERROR ON <DEVICE><FILE>"
	PUSHJ	PP,IOERMS	;THE ERROR
	JRST	KILL		;

IOERMS:	XCT	UGETS.		;GET STATUS AC2*************
IOERM1:	TXC	AC2,IO.ERR	;
	TXCE	AC2,IO.ERR	; IS THIS A MTA LABEL PROCESSING ERROR?
	JRST	IOERM2		; NO

	HRLZI	AC3,2		; LENGTH ,, ADDRESS
	MOVEI	AC0,.DFRES	; FUNCT - EXTENDED IO ERRORS
	MOVE	AC1,D.ICD(I16)	; ADDRESS OF
	MOVE	AC1,(AC1)	; SIXBIT /DEVICE/
	DEVOP.	AC3,		; GET ERROR CODE
	 SETZ	AC3,		; "ERROR" GETTING ERROR CODE!
	OUTSTR	[ASCIZ / Monitor label processing failed ./]
	PUSHJ	PP,ERCODE	; OUTPUT ERROR STATUS
	MOVEI	C," "
	OUTCHR	C		; TYPE A SPACE
	CAIG	AC3,LTCLEN	; SKIP IF NO TEXT FOR THIS CODE
	JRST	IOERM3		;
	OUTSTR	[ASCIZ / There is no text for this error code./]
	POPJ	PP,
IOERM3:	OUTSTR	@LTCTBL(AC3)	; EXPLAIN THE CODE
	POPJ	PP,

IOERM2:	PUSHJ	PP,ERCODE	;OUTPUT ERROR STATUS
	TXNE	AC2,IO.IMP
	OUTSTR	[ASCIZ/ improper mode/]
	TXNE	AC2,IO.DER
	OUTSTR	[ASCIZ/ device error/]
	TXNE	AC2,IO.DTE
	OUTSTR	[ASCIZ/ data error/]
	TXNN	AC2,IO.BKT
	POPJ	PP,
	TXNE	AC13,DV.DSK	;DSK?
	OUTSTR	[ASCIZ / quota exceeded, file structure or rib full/]
IFE TOPS20,<
	TXNE	AC13,DV.DTA	;DTA?
	OUTSTR	[ASCIZ / block number too large or DEC-TAPE is full/]
>
	TXNN	AC13,DV.DSK!DV.DTA	;ONLY ONE MESSAGE
	OUTSTR	[ASCIZ/ block too large/]
	POPJ	PP,

	;OUTPUT CONTENTS OF AC2 BITS 18-35 (ERROR STATUS)
ERCODE:	MOVEI	C,"("		;
	OUTCHR	C		;OUTPUT (
	MOVEI	AC1,6		;SIX OCTAL NUMBERS
	MOVE	AC0,[POINT 3,2,17]
ERCOD1:	ILDB	C,AC0		;GET NUMBER
	ADDI	C,"0"		;ASCIZE IT
	OUTCHR	C		;OUTPUT IT
	SOJG	AC1,ERCOD1	;LOOP
	MOVEI	C,")"		;
	OUTCHR	C		;OUTPUT )
	POPJ	PP,

	; EXTENDED ERROR CODE/TEXT
LTCTBL:	[ASCIZ	/Devop. failed while getting error code!/]
	[ASCIZ	/The page limit was exceeded./]
	[ASCIZ	/VFU format error./]
	[ASCIZ	/Label type error./]
	[ASCIZ	/Header label error./]
	[ASCIZ	/Trailer label error./]
	[ASCIZ	/Volume label error./]
	[ASCIZ	/Hard device error./]
	[ASCIZ	/Parity error./]
	[ASCIZ	/Write locked./]
	[ASCIZ	/Illegal positioning attempt./]
	[ASCIZ	/Code 13/]
	[ASCIZ	/Code 14/]
LTCLEN==.-LTCTBL
SUBTTL	READ INTO THE BUFFER

	;ALL BUFFERED INPUTS ARE DONE HERE.  ***POPJ***

READIN:	AOS	D.IE(I16)	;BUMP INPUT COUNT
	XCT	UIN.		;***********************
	  POPJ	PP,		;NORMAL RETURN
				;SKIP RETURN IF OPEN/CLOSE/READ EOF
READCK:	XCT	UGETS.		; GET THE STATUS
	MOVE	AC13,D.DC(I16)	; AND DEVICE CHARACTERISTICS
	TXNN	AC13,DV.MTA	; MTA ?
	JRST	READC1		; NO
	TXNE	AC2,IO.EOT	;SKIP IF NOT AN "EOT"
	TXO	AC16,FL%EOT	;"EOT" FLAG FOR READEF+N
READC1:	TXNN	AC2,IO.ERR!IO.EOF	;SKIP IF ANY ERRORS IN THE CURRENT BUFFER
	JRST	WRTXIT		;CLEAR THE ERRORS AND POPJ
IFN ANS74,<
	MOVE	AC0,[E.MINP]	;INPUT ERROR
>

	TXNN	AC2,IO.EOF	;SKIP IF AN EOF
	JRST	REAERR		;REAL ERRORS!
	TXNN	AC16,V%OPEN!CLS%EF!CLS%EV!CLS%BV	;SKIP IF OPEN OR CLOSE
	JRST	WRTRSX		;JUMP, IT'S READ OR WRITE "EOF"
	JRST	WRTRS1		;EXIT BUT DONT SET ATEND

REAERR:
IFN ANS68,<
	MOVE	AC0,[E.MINP]	;INPUT ERROR
>
	PUSHJ	PP,IGMDR	;IGNORE ERROR?
	 JRST	WRTXIT		;YES
	MOVE	AC2,[BYTE (5) 35,31,20,10,4,14]
	PUSHJ	PP,MSOUT.
	PUSHJ	PP,IOERMS	;THE ERROR
	JRST	KILL		;

	;READ IN SYNCHRONOUS MODE
READSY:
IFE TOPS20,<
	PUSHJ	PP,CLSYNC	;SINGLE BUFFERS
	PUSHJ	PP,READIN	;GET A BUFFER
	 JRST	.+2		;NORMAL RET
	AOS	(PP)		;EOF RETURN
	JRST	CLSYNC		;BACK TO MULTI BUFFERS
>;END IFE TOPS20
IFN TOPS20,<
	PUSHJ	PP,READIN	;GET A BUFFER
	POPJ	PP,		;RETURN NORMALLY
	JRST	RET.2		;EOF RETURN
>;END IFN TOPS20
SUBTTL	ERROR MESSAGES	5-JAN-70

	;MOVE	AC2,[BYTE (5),1,2,3,4]	;CALLING
	;JRST	MSOUT.			;SEQUENCE

MSOUT.:	PUSH	PP,AC2			;INCASE DISPLAY DESTROYS IT
	PUSHJ	PP,DSPL1.		;OUTPUT BUFFER AND "CRLF"
	POP	PP,AC2
MSOUT1:	MOVE	AC0,[POINT 5,AC2]	;[563] POINT AT INDEX FROM AC0
	ILDB	AC1,AC0			;PLACE IT IN AC1
	XCT	MSAGE(AC1)		;EXECUTE THE TABLE ITEM
	JRST	.-2			;GO AGAIN

		;MSDEV OUTPUTS THE SIXBIT DEVICE NAME
MSDEV.:	SKIPN	OSHOOT			;[530] SKIP IF NOT RESET UUO
	SKIPA	AC1,AC13		;ELSE MAKE SURE U GET THE RIGHT DEV
	HRRZ	AC1,D.ICD(I16)		;GET THE CURRENT DEVICE
	MOVE	AC6,(AC1)		; [407] GET DEVICE NAME
	DEVNAM	AC6,			; [407] GET PHYSICAL NAME
	  JRST	MSDEVA			; [407] NO SUCH DEVICE- DO REGULAR PRINTOUT
	CAMN	AC6,(AC1)		; [407] IS PHYSICAL = LOGICAL?
	JRST	MSDEVA			; [407] YES- NO REASON TO SAY IT TWICE
	MOVE	AC4,(AC1)		; [407] DEVICE NAME
	DEVTYP	AC4,			; [407] GET DEVICE TYPE
	  JRST	MSDEVA			; [407] CANT
	TXNE	AC4,TY.SPL		; [407] IF SPOOLED FORGET IT
	JRST	MSDEVA
	OUTSTR	[ASCIZ / Logical device /]	;[536] [407]
	PUSHJ	PP,MSDVA0		;[536] TYPE LOGICAL DEVICE
	OUTSTR	[ASCIZ/; physical device /]	 ; [407]
	MOVE	AC3,AC6			; [407] PHYSICAL DEVICE
	PUSHJ	PP,MSDEV1		;[536] [407] TYPE AND RETURN
	JRST	COLON			;[536] PRINT ":"

MSDEVA:	OUTSTR	[ASCIZ/ Device /]
MSDVA0:	MOVE	AC3,(AC1)		;DEVICE NAME
	PUSHJ	PP,MSDEV1		;[536] PRINT IT
COLON:	MOVEI	C,":"			;[536] GET COLON
	OUTCHR	C			;[536] PUT IT OUT AT END
	POPJ	PP,			;[536] AND RETURN

MSDEV1:	MOVEI	AC4,6			;6 CHARS
	SKIPA	AC1,[POINT 6,AC3]	;POINT AT IT
MSFIL1:	PUSHJ	PP,OUT6B.		;ASCIZE IT AND PLACE IN BUFFER
MSFIL2:	ILDB	C,AC1			;PICKUP THE NEXT CHAR
	CAIE	C,0			;TERMINATE ON A SPACE
	SOJGE	AC4,MSFIL1		;  OR SATISFIED CHAR COUNT
	JRST	OUTBF.			;EXIT
		;MSFIL OUTPUTS THE SIXBIT FILE NAME
MSFIL.:	MOVEI	AC4,^D30		;30 CHARS
	OUTSTR	[ASCIZ / File /]
	MOVE	AC1,[POINT 6,(I16)]	;POINT AT A FILE NAME
	PUSHJ	PP,MSFIL2		;OUTPUT FILE NAME

	;OUTPUT THE VALUE-OF-ID AS [ FILE  EXT ]
MSVID:
IFN ISAM<
	TLNE	FLG,IDXFIL	;[323] IS THIS AN ISAM FILE?
	SKIPE	FS.IF		;[323] YES,IS ERROR IN DATA FILE?
	JRST	MSVID2		;[323] "NO" TO EITHER QUESTION
	MOVE	AC1,[POINT 6,DFILNM(I12)]	;[323] WANT DATA FILENAME
	TLNE	I16,-1		;[323] UNLESS IN RESET
	JRST	MSVID3		;[323] CONTINUE
>
MSVID2:	SKIPN	AC1,F.WVID(I16)	;[323] BP TO VALUE OF ID
	POPJ	PP,		;EXIT IF NO ID
MSVID3:	MOVEI	AC4,11		;9 CHARACTERS
MSVID4:	OUTSTR	[ASCIZ/ [/]	;[323]
MSVID1:	ILDB	C,AC1
	TLNN	AC1,100		;[304] SKIP IF ASCII
	ADDI	C,40		;[304] CONVERT SIXBIT TO ASCII
	TLNN	AC1,600		; EBCDIC?
	LDB	AC1,IPT971##	; [616] YES
	PUSHJ	PP,OUTCH.	;[304] OUTPUT TO BUFFER
	SOJG	AC4,MSVID1	;LOOP 9 TIMES
	PUSHJ	PP,OUTBF.	;DUMP THE BUFFER
	JRST	MSPPNE		;"]" AND EXIT

		;OUTPUT THE SIXBIT REEL NUMBER
MSDTRN:	LDB	AC3,DTRN.		;FROM THE DEVICE TABLE
	JRST	MSSLR1			;
MSSLRN:	HRL	AC3,STDLB.+4		;THE
	HLR	AC3,STDLB.+5		;  STANDARD
	ROT	AC3,-14			;  LABEL
	ANDI	AC3,7777		;  REEL NUMBER
MSSLR1:	OUTSTR	[ASCIZ/ reel /]
	ROT	AC3,-14
	JRST	MSDEV1

	;[277] ROUTINE TO PRECEDE MESSAGES TO TTY WITH "$"
$SIGN:	OUTSTR	[ASCIZ/
$ /]					;[277]
	POPJ	PP,			;[277]
;[536] TYPE OUT A DIRECTORY
MSDIR.:	OUTSTR	[ASCIZ	/[/]	;[536]

IFE TOPS20,<
	TLNE	AC3,-1		;[536] CHECK FOR SFD PATH
	JRST	MSPPN.		;[536] NO
	ADDI	AC3,2		;[536] POINT TO PPN
	HLRZ	AC0,(AC3)	;[536] LHS
	PUSHJ	PP,PUTOCT	;[536] TYPE OCTAL
	OUTSTR	[ASCIZ	/,/]	;[536]
	HRRZ	AC0,(AC3)	;[536] RHS
	PUSHJ	PP,PUTOCT	;[536] TYPE OCTAL
	AOS	AC6,AC3		;[536] ADVANCE TO SFD
	HRLI	AC6,-5		;[536] MAX LENGTH OF SFDS
MSSFD:	SKIPN	AC3,(AC6)	;[536] GET NEXT
	JRST	MSPPNE		;[536] AT END
	OUTSTR	[ASCIZ	/,/]	;[536]
	PUSHJ	PP,MSDEV1	;[536] OUTPUT IT
	AOBJN	AC6,MSSFD	;[536] LOOP
	JRST	MSPPNE		;[536] JUST IN CASE
>
MSPPN.:	JUMPL	AC3,[PUSHJ PP,MSDEV1	;[536] TYPE AS SIXBIT
		JRST	MSPPNE]		;[536]
	HLRZ	AC0,AC3		;[536] LHS
	PUSHJ	PP,PUTOCT	;[536] TYPE OCTAL
	OUTSTR	[ASCIZ	/,/]	;[536]
	HRRZ	AC0,AC3		;[536] RHS
	PUSHJ	PP,PUTOCT	;[536] TYPE OCTAL
MSPPNE:	OUTSTR	[ASCIZ	/]/]	;[536] CLOSE PPN
	POPJ	PP,		;[536] AND RETURN
;TYPE OUT A SIGNED DECIMAL NUMBER, REMOVING LEADING ZEROES [371]
PUTDEC:	JUMPGE	AC0,PUTDC1	;IF NEGATIVE, [371] 
	OUTSTR	[ASCIZ "-"]	;  TYPE SIGNED AND [371]
	MOVMS	AC0		;  GET MAGNITUDE [371]

PUTDC1:	IDIVI	AC0,^D10	; DIVIDE BY RADIX TO [371]
	HRLM	AC1,(PP)	; SAVE RADIX DIGIT [371]
	SKIPE	AC0		; DONE ?  [371]
	PUSHJ	PP,PUTDC1	; NO-- LOOP [371]

	HLRZ	C,(PP)		; GET SAVED DIGIT [371]
	ADDI	C,"0"		; CONVERT TO ASCII [371]
	OUTCHR	C		; TYPE DIGIT [371]
	POPJ	PP,		; [371]

; [536]  TYPE OUT AN OCTAL NUMBER

PUTOCT:	IDIVI	AC0,8		;[536] DIVIDE BY RADIX
	HRLM	AC1,(PP)	;[536] SAVE RADIX DIGIT
	SKIPE	AC0		;[536] DONE ? 
	PUSHJ	PP,PUTOCT	;[536] NO-- LOOP
	HLRZ	C,(PP)		;[536] GET SAVED DIGIT
	ADDI	C,"0"		;[536] CONVERT TO ASCII
	OUTCHR	C		;[536] TYPE DIGIT
	POPJ	PP,		;[536] AND RETURN
	;THE FOLLOWING 40 LOC TABLE IS "XCT"ED FROM MSOUT.

MSAGE:	JRST	KILL					;0
	OUTSTR	[ASCIZ/
 shares buffer area with /]				;1
	OUTSTR	[ASCIZ/ cannot be opened/]		;2
	OUTSTR	[ASCIZ/, already open/]			;3
	OUTSTR	[ASCIZ/
/]							;4
	OUTSTR	[ASCIZ/ Too many open files/]		;5
	OUTSTR	[ASCIZ/ is not open/]			;6
	OUTSTR	[ASCIZ/ for INPUT./]			;7
	PUSHJ	PP,MSFIL.				;10 - 30 CHARACTER FILENAME
	OUTSTR	[ASCIZ/ for OUTPUT only./]		;[1037] 11
	OUTSTR	[ASCIZ/ is AT END./]			;12
	OUTSTR	[ASCIZ/ is not a device./]		;13
	POPJ	PP,					;14 - RETURN
	OUTSTR	[ASCIZ/ is not available to this job./]	;15
	OUTSTR	[ASCIZ/ is assigned to another file./]	;16
	OUTSTR	[ASCIZ . cannot do INPUT/OUTPUT.]	;17
	PUSHJ	PP,MSDEV.				;20 - 6 CHARACTER DEVICE NAME
	OUTSTR	[ASCIZ/ cannot do INPUT./]		;21
	OUTSTR	[ASCIZ/ cannot do OUTPUT./]		;22
	OUTSTR	[ASCIZ/ or /]				;23
	PUSHJ	PP,C.STOP				;24
	OUTSTR	[ASCIZ/Init took the error return./]	;25
	OUTSTR	[ASCIZ/Directory devices must have standard labels./]	;26
	OUTSTR	[ASCIZ/ to/]				;27
	PUSHJ	PP,MSDTRN				;30 - DEVICE TABLE REEL NUMBER
	OUTSTR	[ASCIZ/ on/]				;31
IFE TOPS20,<
	OUTSTR	[ASCIZ/Labels may not be omitted from DTA or DSK files./]	;32
>
IFN TOPS20,<
	OUTSTR	[ASCIZ/Labels may not be omitted from DSK files./]	;32
>
	OUTSTR	[ASCIZ/ because it is not open./]	;33
	PUSHJ	PP,MSSLRN				;34 - STANDARD LABEL REEL NUMBER
	OUTSTR	[ASCIZ/ INPUT error/]			;35
	OUTSTR	[ASCIZ/ OUTPUT error/]			;36
	OUTSTR	[ASCIZ/ cannot be closed./]		;37
	;LOOKUP OR ENTER ERROR MESSAGES.   ***KILL OR OPNENR***

LUPERR:	MOVE	AC0,ULBLK.+1		;[1010] LOOKUP ERROR
	MOVEM	AC0,UEBLK.+1		;[1010] MOVE ERROR ARGUMENT
	TDZA				;[1010] TO ENTER BLOCK
ENRERR:	SETO				;ENTER ERROR
	PUSHJ	PP,SAVAC.
	LDB	AC1,F.BOUP		;GET THE OEUP FLAG
	HRRZ	AC2,UEBLK.+1		;GET THE ERROR CODE
	TRZ	AC2,777740		;  CLEAR THE REST
	CAIN	AC2,3			;IF ERROR IS FILE BEING MODIFIED
	JUMPN	AC1,ENRAGN		;YES, IF FLAG ON SEE IF USE PRO
ENRER2:	TXNN	AC16,V%OPEN		;OPEN OR CLOSE UUO
	SKIPA	AC2,[BYTE (5)10,37,31,20,4,14]	;CLOSE!
	MOVE	AC2,[BYTE (5)10,2,31,20,4,14]
	MOVE	AC13,D.ICD(I16)		;[277] DEVICE NAME
	DEVCHR	AC13,			;[277] DEVCHR UUO
	TXNE	AC13,DV.DTA!DV.MTA	;[277] A REEL DEVICE?
	PUSHJ	PP,$SIGN		;[277] YES, OUTPUT "$"
	PUSHJ	PP,MSOUT.		;<FILE> CANNOT BE OPENED ON <DEVICE>
	MOVEI	AC2,[ASCIZ/
LOOKUP /]
	SKIPE	(PP)			;SKIP IF LOOKUP UUO
	MOVEI	AC2,[ASCIZ/
ENTER /]
	SKIPE	PRGFLG			;RENAME FAILURE?
	MOVEI	AC2,[ASCIZ /
RENAME /]
	TLNE	FLG1,FOPERR		;FILOP FAILURE?
	MOVEI	AC2,[ASCIZ/
FILOP. /]
	OUTSTR	(AC2)			; LOOKUP, ENTER, RENAME OR FILOP
	OUTSTR	[ASCIZ /failed, /]
	HRRZ	AC2,ULBLK.+1
	SKIPE	(PP)			;SKIP IF LOOKUP UUO
	HRRZ	AC2,UEBLK.+1
	TRZ	AC2,777740		;SAVE ONLY THE ERROR BITS
	PUSHJ	PP,ERCODE	;OUTPUT THE ERROR CODE
	CAIL	AC2,LEMLEN	;A LEGAL ERROR CODE?
	HRRI	AC2,LEMLEN	;NO, GIVE CATCH-ALL
	JUMPN	AC2,ENRER1	;
	SKIPE	(PP)		;SKIP IF LOOPUP
	HRRI	AC2,LEMLEN+1	;ILL-FIL-NAME NOT FIL-NOT-FND
ENRER1:	OUTSTR	@LEMESS(AC2)		;TYPE A MESSAGE
	SKIPN	(PP)			;KILL IF ENTER
	TXNN	AC13,DV.DTA!DV.MTA	;A REEL DEVICE?
	JRST	KILL			;NO
	JUMPN	AC2,KILL		;KILL IF NOT UNFOUND FILE
	OUTSTR	[ASCIZ/ Wrong reel?  /]
	PUSHJ	PP,C.STOP		;WAIT FOR CONTINUE
	PUSHJ	PP,RSTAC.		;RESTORE THE ACS
	TLNN	AC16,-1			;SKIP IF NOT CALLED W/ A PUSHJ
	POPJ	PP,			;EXIT TO RRDMP
	JUMPE	AC0,OPNLUP		;TRY
	JRST	OPNENR			;AGAIN.

	;[1113]PERFORM USE PROCEDURE AND RETRY LOOKUP UUO
	;[1113]LOOP TILL LOOKUP WINS OR USER GIVES UP IN USE-PRO.
ENRAGN:	MOVEI	AC1,0			;PERFORM ERROR USE PRO
	SKIPN	FS.UPD			;SKIP IF ALREADY DONE
	PUSHJ	PP,USEPRO		;  ERROR USE PRO
	  JRST	.+2			;NORMAL RETURN
	JRST	ENRER2			;NO USE PRO - GIVE ERROR MESS. AND KILL
	SETZM	FS.UPD			;CLEAR THE USE-PRO-DONE FLAG
	PUSHJ	PP,RSTAC.		;RESTORE ACS
IFN ISAM,<
	TLNE	FLG1,EIX		;IF INDEX FOR ISAM FILE
	JRST	OPNI00			;  EXIT HERE
>
	JRST	OPNCH1			;[1113]TRY AGAIN
	;LOOKUP/ENTER ERROR MESSAGES

LEMESS:	[ASCIZ	\ file not found.\]
	[ASCIZ	\ UFD does not exist.\]
IFE TOPS20,<
	[ASCIZ	\ protection failure.\]
>
IFN TOPS20,<
	[ASCIZ	\ Protection failure or DTA directory full.\]
>
	[ASCIZ	\ File being modified.\]
	[ASCIZ	\ RENAME file already exists.\]
	[ASCIZ	\ Illegal sequence of UUOs.\]
	[ASCIZ	\ Device or UFD/RIB data error.\]
	[ASCIZ	\ Not a SAVed file.\]
	[ASCIZ	\ Not enough core.\]
	[ASCIZ	\ Device not available.\]
	[ASCIZ	\ No such device.\]
	[ASCIZ	\ FILOP. illegal monitor call.\]
	[ASCIZ	\ Quota exceeded or no room on file structure.\]
	[ASCIZ	\ WRITE locked file structure.\]
	[ASCIZ	\ Not enough monitor table space.\]
	[ASCIZ	\ Partial allocation only.\]
	[ASCIZ	\ Allocated block not free.\]
	[ASCIZ	\ Can't supersede (ENTER) an existing directory.\]
	[ASCIZ	\ can't delete (RENAME) a non-empty directory.\]
	[ASCIZ	\ SFD not found.\]
	[ASCIZ	\ SEARCH list empty.\]
	[ASCIZ	\ SFD nested too deeply.\]
	[ASCIZ	\ No-create on for specified SFD path.\]
	[ASCIZ	\ Segment not on swap space.\]
	[ASCIZ	\ Can't update file.\]
	[ASCIZ	\ LOW segment overlaps HIGH segment.\]
	[ASCIZ	\ User not logged in.\]
	[ASCIZ	\ File has outstanding locks set.\]
	[ASCIZ	\ Bad EXE directory.\]
	[ASCIZ	\ Bad EXE extersion.\]
	[ASCIZ	\ EXE directory too big.\]
	[ASCIZ	\ Network capacity exceeded.\]
	[ASCIZ	\ Task not available.\]
	[ASCIZ	\ Unknown network node specified.\]
	[ASCIZ	\ Rename-SFD is in use.\]
	[ASCIZ	\ Delete-file has an NDR block.\]
	[ASCIZ	\ Job count too high.\]
				
LELAST:	[ASCIZ \ LOOKUP, ENTER or RENAME error\]
LEMLEN==LELAST-LEMESS
	[ASCIZ \ illegal filename.\]
SUBTTL	CLOSE VERB

PURGE.:	TLZ	AC16,(Z 17,)
	TLO	AC16,(Z 1,)	;MAKE PURGE BE A CLOSE VERB
	SETOM	PRGFLG		;REMEMBER TO RENAME TO ZERO

	;A C.CLOS VERB LOOKS LIKE:
	;FLAGS,,ADR	WHERE ADR = FILE TABLE ADDRESS
	;BIT9  =0	CLOSE FILE
	;BIT9  =1	CLOSE REEL
	;BIT10 =1	LOCK,  LOCKED FILES MAY NOT BE REOPENED
	;BIT11 =1	DON'T REWIND
	;BIT12 =1	ALWAYS 1  (VS. 0 = OPEN)
	;BIT13 =1	UNLOAD
	;CALL+1:	POPJ RETURN

	;EXIT IF OPTIONAL FILE IS NOT PRESENT, ERROR MESSAGE IF IT'S NOT
	;OPEN OR IF IT'S A "CLOSE REEL" AND A MULTI-FILE REEL.
	;WRITE OUT ANY ACTIVE DATA REMAINING IN THE BUFFER FROM RANDOM
	;OR IO FILES.

C.CLOS:
IFN LSTATS,<
	MRTMS.	(AC1)		;START METER TIMING
	LDB	AC1,DTCN.	;GET CHANNEL NUMBER
	MOVE	AC1,MROPTT(AC1)	;GET FILE BLOCK ADDRESS
	HLRM	AC16,MB.OCF(AC1) ;SAV CLOSE AC16 FLAG BITS
>;END IFN LSTATS
	MOVE	AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
	BLT	AC0,FS.IF	;   STATUS WORDS.
	SETOM	FS.IF		;IDX FILE
	MOVE	FLG,F.WFLG(I16)	;PICK UP THE FLAGS
	HLLZ	FLG1,D.F1(I16)	;MORE FLAGS
	TLNN	FLG,NOTPRS	;SKIP IF FILE IS NOT PRESENT
	JRST	CLOS01		;  BUT IT IS
	SETZM	PRGFLG		;INCASE IT WAS CLOSE WITH DELETE
	TLZ	FLG,OPNIN!OPNOUT!ATEND!NOTPRS!CONNEC
	MOVEM	FLG,F.WFLG(I16)	;REINIT THE FLGS
	POPJ	PP,		;EXIT

CLOS01: MOVE	AC0,[E.VCLO+^D20];ERROR NUMBER
	TLNN	FLG,OPNIN+OPNOUT
	SKIPA	AC2,[BYTE(5)10,31,20,37,33]
	SKIPA	AC13,D.DC(I16)	;PICK UP DEVICE CHARACTERISTICS
;[D1003]	JRST	OXITER		;FILE WAS NOT OPEN.
	JRST	PRGERR		;[M1003] FILE WAS NOT OPEN.
	TXNN	AC13,DV.DIR	;A DIRECTORY DEVICE?
	SETZM	PRGFLG		;NO - SO WE CAN'T PURGE
	TXNE	AC13,DV.TTY	;A TTY FILE?
	SETZM	TTYOPN		;YES, NOTE THAT IT'S CLOSED
	LDB	AC5,F.BPMT	;FILE POSITION ON TAPE
	TXNN	AC16,CLS%CR	;SKIP IF CLOSE REEL
	JRST	[TXO	AC16,CLS%EF	;%CLOSE FILE
		JRST	CLOS00]		;GO DO IT
	TXNN	AC13,DV.MTA	;MTA?
	POPJ	PP,		; NO, IGNORE & CONTINUE
	TXO	AC16,CLS%EV	;% CLOSE REEL
	JUMPN	AC5,CLOSF5	;CLOSE "REEL" A MULTI-FILE-REEL - AN ERROR
CLOS02:	TXNE	AC16,CLS%EV	;CLOSE REEL?
	TXNE	AC13,DV.MTA	;CLOSE REEL AND NOT  MTA?
	JRST	CLOS00		;NO
	MOVEI	AC0,^D33	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	CLOS00		;YES
	OUTSTR	[ASCIZ /$ CLOSE REEL is legal only for MAG-tape.	
/]
	MOVE	AC2,[BYTE(5) 10,31,20,37,4,14]
	JRST	MSOUT.		;NON-FATAL CONTINUE WITH A POPJ

CLOS00:	PUSHJ	PP,SETCN.	;DISTRIBUTE THE CHAN NUMBER
	HLRZ	AC12,D.BL(I16)	;BUFFER LOCATION
IFN ISAM,<
	TLNE	FLG,IDXFIL	;INDEXED FILE?
	JRST	CLSISM		;YES
>
	TLNN	FLG,RANFIL+IOFIL ;[622] SKIP IF RANDOM OR IO
	JRST	CLOSE1		; NO LONGER PAD LOGICAL BLOCKS
	TLNE	FLG,RANFIL	;[657] SKIP IF IO-FILE
	JRST	CLOSE0		;
	TLC	FLG,OPNIN!OPNOUT!ATEND ;
	TLCE	FLG,OPNIN!OPNOUT!ATEND ;SKIP IF IO-FILE AND ATEND
	TLNN	FLG,OPNIN	;SKIP IF OPEN FOR INPUT
	PUSHJ	PP,CLSZBF	;IO-FILE AND ATEND OR OUTPUT FILE
CLOSE0:	SKIPE	R.DATA(I12)	;SKIP IF NO ACTIVE  DATA IN BUFFER
	PUSHJ	PP,RANOUT	;WRITE IT OUT
	HLLZS	UOUT.		;CLEAR IOWD POINTER
	JRST	CLOSE3		;
	;PAD THE LAST LOGICAL BLOCK IF NECESSARY.

	; THE PADDING AT THE END OF THE LOGICAL BLOCK HAS BEEN ELIMINATED
	; SO THAT OPEN APPEND WILL WORK CORRECTLY FOR BLOCKED DISK

CLOSE1:
; BL/10/27/80	TLNE	FLG,OPNOUT	; SKIP IF NOT AN OUTPUT FILE
	TLNN	FLG,OPNOUT	;SKIP IF OUTPUT FILE
	JRST	CLOSE3		; DON'T PAD
;	TXNE	AC13,DV.MTA	;[1014]MTA? allow mta to have extra 'CR'
;	JRST	CLOSE2		;[1014] YES, SKIP FUNNY EXTRA 'CR'
	HRRZ	AC4,D.RFLG(I16)	; NO, GET STD ASCII FLAG
	TRNE	AC4,SASCII	;[1112] IS IT STD ASCII?
	 JRST	CLOSE2		;[1112] YES, DON'T PUT OUT <CR>
	TRZE	AC4,AFTADV	;[1112] SKIP IF DON'T NEED 'CR' (write aft adv)
;If you don't want the extra <cr> at the end of the file
;replace the instruction at NOXCR. by a JFCL
;However that is contrary to the ANSI-74 standard as interpreted by the FCTC.
NOXCR.::PUSHJ	PP,WRTCR	; WRITE 'CR'
	HRRM	AC4,D.RFLG(I16)	; RESET FLAG
CLOSE2:	SKIPGE	D.OBB(I16)	; SKIP IF BUFFER MIGHT HAVE DATA(NOT 44S00,LOC)
	JRST	CLOSE3		; NO LONGER PAD LOGICAL BLOCKS
	HRRZ	AC1,D.OBH(I16)	; GET BUF HDR ADDR
	HRRZ	AC3,D.OBB(I16)	; GET BYTE PTR LOC ADDR
	CAIE	AC1,-1(AC3)	; SKIP IF AT BEGIN OF BUFFER	
	PUSHJ	PP,WRTBUF	; WRITE OUT LAST BUFFER
	;READ A LABEL, DO BEFORE ENDING FILE/REEL USE PROCEEDURE,
	;AND CHECK FOR "EOF/V" LABEL TYPE.

CLOSE3:	TLNN	FLG,OPNOUT!ATEND
	JRST	CLOSE8		;SKIP LABEL PROCESSING, READ AND NOT ATEND
	TLNE	FLG,OPNIN	;IF INPUT,
	JRST	CLOSE4		; NO, 
	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
	TRNE	AC0,RDDREV	; READ REVERSE OPEN ACTIVE?
	JRST	CLOSE4		; YES,SKIP LABEL READ
	PUSHJ	PP,CLSRL	; NO, READ A LABEL
	LDB	AC5,F.BPMT	;[341] SEE IF FILE POSITIONED
	JUMPN	AC5,CLOSE4	;[341] IF THERE IS, SKIP NEXT
	TLNN	FLG,OPNIN	;[341] OPEN FOR INPUT?
	JRST	CLOSE4		;[341] NO
	TLNE	FLG1,NONSTD!STNDRD	;[341] IF LABELLED
	XCT	MADVF.		;[341] SKIP OVER EOF AFTER LABEL REC.
CLOSE4:
IFN ANS68,<
	MOVEI	AC1,3		;
	PUSHJ	PP,USEPRO	;BEFORE ENDING FILE/REEL
>;END IFN ANS68
	TLNN	FLG,OPNIN	;SKIP IF INPUT
	JRST	CLOSE6		;JUMP IF OUTPUT
	TLNE	FLG1,STNDRD	;SKIP IF NOT STD LABELS
	TXNN	AC16,CLS%EV	;SKIP IF CLOSE REEL
	JRST	CLOSE7		;
	PUSHJ	PP,CLSEOV	;CHECK FOR EOV
	 JRST	CLOSE7		;
	OUTSTR	[ASCIZ /Standard END-OF-REEL labels must have "EOV" as the first three characters./]
	MOVE	AC2,[BYTE (5)10,31,20,37]
	JRST	MSOUT.		;TYPE IT OUT

	;CREATE A LABEL,DO AFTER ENDING FILE/REEL USE PROCEEDURE,
	;WRITE OUT THE LABEL AND LOCK THE FILE.

CLOSE6:	PUSHJ	PP,CLSCAL	;CREATE STD MTA ENDING LABEL
CLOSE7:
IFN ANS68,<
	MOVEI	AC1,4		;
	PUSHJ	PP,USEPRO	;AFTER ENDING FILE/REEL
>;END IFN ANS68
	TLNE	FLG,OPNOUT	;SKIP IF NOT OUTPUT
	PUSHJ	PP,CLSWEL	;WRITE ENDING LABEL MAYBE

CLOSE8:	HRRZ	AC1,D.RFLG(I16)	; GET SOME FLAGS
	TRZE	AC1,RDDREV	; READ REVERSE OPEN ACTIVE?
	HRRM	AC1,D.RFLG(I16)	; IF SO PUT IT BACK AFTER CLEARING IT
	TXNE	AC16,CLS%CR	;SKIP IF CLOSE FILE
	JRST	CLOSR1		;CLOSE REEL
	TXNN	AC16,CLS%LK	;LOCK THE FILE?
	JRST	CLOSF1		;NO
	SETO	AC0,		;SET THE LOCK FLAG
	DPB	AC0,F.BLF	;SAVE IT
	XCT	MREWU.		;REWIND AND UNLOAD**************
	JRST	CLOSF2
	;REWIND OR POSITION THE MTA, RESET THE FLAGS, RELEASE THE
	;DEVICE AND EXIT.  ***POPJ***ACP***

CLOSF1:	TXNE	AC16,CLS%NR	;REWIND REQUEST?
	JRST	CLOSF3		;NO
IFN TOPS20,<			;YES
	TLNN	FLG1,MTNOLB	;SKIP IF MOUNTR WITH NO LABELING
	JRST	CLSF1X		;ELSE GO ON
	SETZ	AC4,		;INDICATE GET FIRST REEL
	PUSHJ	PP,VOLSWT	;GET FIRST REEL IF MOUNTR AND NO LABELING
				;NOW WE WILL ALSO REWIND TO MAKE SURE
				;WE ARE AT BOT IF NO REEL SWITCH HAPPENED
CLSF1X:	>;END IFN TOPS20

	PUSHJ	PP,OPNRWD	;REWIND UUO
IFN ANS74,<
	TXNE	AC16,CLS%UN	;UNLOAD?
	XCT	MREWU.		;YES
>;END IFN ANS74
CLOSF2:	MOVX	AC0,DB.HF
	ANDCAM	AC0,D.HF(I16)	;CLEAR HUF FLAG
	JRST	CLOSF4		;

CLOSF3:	LDB	AC5,F.BPMT	;GET FILE POSITION
	JUMPE	AC5,CLOSF4	;DONT POSITION IF NONE IS SPECIFIED
	TLNN	FLG,OPNOUT	;OPEN FOR OUTPUT?
	JRST	CLOSF9		;NO
	TLNE	FLG1,NONSTD!STNDRD  ;LABELED FILE?
	XCT	MBSPF.		;YES, BACK INTO THE LABEL
CLOSF9:	TLNE	FLG,OPNOUT!ATEND  ;SKIP IF INPUT AND NOT "AT-END"
	XCT	MBSPF.		;BACK SPACE INTO THE FILE
IFN TOPS20,<
	TLNN	FLG1,MSTNDR	;SKIP IF MOUNTR DOING LABELING
>
	TLNE	FLG,OPNOUT!ATEND;[336] IF OUTPUT OR AT END
	JRST	CLOSF4		;[336] WE ARE DONE
	SKIPL	D.IBH(I16)	;[336] IF HAVE DONE ANY READS
	XCT	MBSPR.		;[336] BACKSPACE 1 RECORD
CLOSF4:				;[336]
	IFN ISAM,<
	TLNN	FLG,IDXFIL	;INDEX FILE?
	JRST	CLOSF7		;NO
	PUSHJ	PP,CLSIDX	;YES, CLOSE & RELEAS THE INDEX-FILE
	PUSHJ	PP,FRECH1	;MAKE CHAN AVAILABLE
	MOVE	AC1,CORE0(I12)	;UNTIL,,FROM
	SETZM	(AC1)		;ZERO FIRST WORD
	HLRZ	AC2,AC1		;UNTIL
	HRL	AC1,AC1		;FROM,,FROM
	ADDI	AC1,1		;FROM,,TO
	BLT	AC1,(AC2)	;ZERO
CLOSF7:>
	SKIPN	PRGFLG		;PURGE?
	JRST	CLOSF8		;NO
	TLNN	FLG,OPNIN!RANFIL!IDXFIL	;SUPERSEDING?
	JRST	CLOS75		;COULD BE - GO SEE
CLOS71:	PUSHJ	PP,OPNEID	;
	SETZM	UEBLK.		;ZERO THE FILE-NAME
	XCT	URNAM.		;DELET IT *******************
	 PUSHJ	PP,ORERRI	;ERROR RET
CLOS72:	SETZM	PRGFLG		;CLEAR THE FLG
CLOSF8:
IFN TOPS20,<			;IF MOUNTR WITH LABELS WE ARE
				;AT THE BEG OF THE NEXT FILE
				;,NOT IN THE CURRENT ONE
				;(BECAUSE THE MONITOR POSITIONS
				;TO THE BEGINING OF THE NEXT FILE
				;AFTER THE JFN IS CLOSED)
	TLNE	FLG1,MSTNDR	;IS MOUNTR DOING LABELING AND
	TLNE	FLG,OPNOUT!ATEND ;OPEN INPUT AND NOT ATEND ?
	JRST	CLSF8X		;NO,GO RELEASE
	MOVX	AC5,DB.HF	;YES, GET HEAD UNDER FLAG BIT
	TDNN	AC5,D.HF(I16)	;SKIP IF HEAD HERE
	JRST	CLSF8X		;IF NOT GO ON
	ANDCAM	AC5,D.HF(I16)	;CLEAR CURRENT HEAD POS
	LDB	AC1,F.BPMT	;GET CURRENT POSITION NUMBER
	MOVE	AC2,AC1		;GET HERE
	ADDI	AC2,1		;PLUS ONE FOR LOOP TEST
	MOVE	AC10,I16	;START SEARCH FOR NEXT FILE HERE
CLSF8B:	HRRZ	AC10,F.RFSD(AC10) ;GET NEXT FILTAB ADDR
	JUMPE	AC10,CLSF8X	;[632] CONT IF NO FILTAB SHARES DEVICE
	CAIN	AC10,(I16)	;ARE WE BACK AT START?
	JRST	CLSF8X		;YES,NO NEXT FILE, SO GO ON WITH HUF FLG OFF
	LDB	AC3,FLPS10	;GET FILE POSITION AT THIS FILE
	CAIE	AC3,(AC2)	;IS THIS THE NEXT FILE ON THE TAPE?
	JRST	CLSF8B		;NO, LOOP BACK
	ORM	AC5,D.HF(AC10)	;YES,SET HEAD UNDER THIS FILE
				;NOW GO RELEASE
CLSF8X:

>;END IFN TOPS20
	SETZM	D.DC(I16)	;DEVICE CHARACTERISTICS
	TLZ	FLG,OPNIN+OPNOUT+ATEND+NOTPRS+CONNEC
	MOVEM	FLG,F.WFLG(I16)	;REINITIALIZE THE FLAGS
	TLZ	FLG1,F1CLR	; CLEAR SOME FLAGS
	HLLM	FLG1,D.F1(I16)	;REINIT MORE FLAGS
	HRRZ	AC0,D.RFLG(I16)	; GET MORE FLAGS
	TRZ	AC0,RF1CLR	; CLEAR SOME
	HRRM	AC0,D.RFLG(I16)	; AND RESET THE WORD
	XCT	URELE.		;RELEASE THE DEVICE**************
	PUSHJ	PP,CLRSTS	;CLEAR FILE STATUS WORD

IFN LSTATS,<
	PUSHJ	PP,MTRCLS	;END CLOSE METERING
>
	JRST	FRECHN		;EXIT TO THE ***"ACP"***

IFN LSTATS,<
MTRCLS:	LDB	AC2,DTCN.	;GET CHAN NUMBER
	MOVE	AC2,MROPTT(AC2)	;GET METER BLOCK BASE ADDRESS

;NO. OF INPUTS & OUTPUTS EXECUTED
	MOVE	AC1,D.IE(I16)	;GET NO. OF INPUTS
	MOVEM	AC1,MB.NIN(AC2)	;PUT # INPUTS INTO FILE BLOCK
	MOVE	AC1,D.OE(I16)	;GET NO. OF OUTPUTS
	MOVEM	AC1,MB.NOU(AC2)	;PUT # OUTPUTS INTO FILE BLOCK

	MOVEI	AC2,MB.CTM(AC2)	;GET ADDRESS OF CLOSE BUCKET
	MOVEM	AC2,MRTMB.	;SAVE FOR TIMING
	SETZM	(AC2)		;CLEAR CLOSE TIME BUCKET
	MRTME.	(AC2)		;END METER TIMING

;CLEAR ENTRIES IN FILE/BLOCK TABLE  (SORT OF "FLUSHING THE CACHE")
	JRST	CLRFBT		;RETURN
>;END IFN LSTATS


CLOSF5:	MOVE	AC0,[E.FIDX+^D21];ERROR NUMBER
	TLNN	FLG,IDXFIL	;SKIP IF AN ISAM FILE
	MOVEI	AC0,^D21	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	CLOS02		;CONTINUE
	MOVE	AC2,[BYTE(5)10,31,20,37,14]
	PUSHJ	PP,MSOUT.
	OUTSTR	[ASCIZ/
The CLOSE "REEL" option may not be used with a multi-file-tape./]
	JRST	KILL

CLOS75:	LDB	AC1,DTCN.	;GET THE CHANNEL NUMBER
	TXNE	AC13,DV.DIR	;[373] DIRECTORY DEVICE ?
	TXNE	AC13,DV.DSK	;[373] DSK?  IF NO IT IS DTA DO RENAME
	RESDV.	AC1,		;RESET THIS CHANNEL IE DELETE
	  JRST	CLOS71		;FAILED SO RENAME TO ZERO
	JRST	CLOS72		;RETURN
	;CLOSE REEL, REWIND AND UNLOAD, RELEASE THE DEVICE, GENERATE
	;AN OPEN UUO AND GO DOIT.  ***OPNDEV***

CLOSR1:
	TLNN	FLG,RRUNER	;RERUN ON END OF REEL?
	JRST	CLOSR2		;NO
	SETZM	D.OE(I16)	;CLEAR THE NUMBER OF INS + OUTS SO
	SETZM	D.IE(I16)	;  RERUN DOESNT ROCK MAGTAPE
	PUSHJ	PP,RRDMP	;YES
	PUSHJ	PP,RSAREN	;RESTORE .JBSA, .JBREN
	PUSHJ	PP,SETCN.	;CHAN NUMBERS DISTURBED BY RRDMP CODE
	XCT	UCLOS.		;ELSE RELEASE TRYS TO DUMP "DUMMY BUFFER" CAUSED BY DUMMY OUT
				;  WHICH CAUSES REQUEST FOR OPR1 INTERVENTION!!?
CLOSR2:	TXZE	AC16,CLS%NR	; NO REWIND?
	JRST	CLSR2B		; YES, DON'T REWIND
IFN TOPS20,<
	TLNN	FLG1,MSTNDR	; SYS-LABELED?
	JRST	CLSR2C		; NO, UNLOAD
	XCT	MREW.		; YES JUST REWIND
	TDNA			; AND SKIP
>;END IFN TOPS20
CLSR2C:	XCT	MREWU.		;REWIND AND UNLOAD
CLSR2B:	TLZ	FLG,ATEND	; [604] TURN OFF THE EOF FLAG
	MOVEM	FLG,F.WFLG(I16)	; [604] ALSO IN THE FILE TABLE
	PUSHJ	PP,INCRN.	;INCREMENT THE DEVTAB REEL NUMBER
	LDB	AC0,F.BNDV	;GET NUMBER OF DEVICES SELECTED
	SOJE	AC0,CLSR2A	;JUMP IF ONLY ONE
	MOVE	AC0,D.ICD(I16)	;GET THE NEXT DEVICE
	AOBJN	AC0,.+2		;JUMP IF THERE IS ONE
	PUSHJ	PP,DEVIOW	;RESET DEVICE IOWD
	MOVEM	AC0,D.ICD(I16)	;SAVE AS CURRENT IF THERE IS
	JRST	CLOSR4		; GO ON

IFN TOPS20,<

;
;	VOLSWT IS A ROUTINE TO SWITCH MTA REELS WHEN UNDER
;	MOUNTR CONTROL,BUT WITH NO MONITOR LABELING.
;
;	ARG:	AC4=	0 IF MOUNT FIRST REEL
;			.VSMRV IF MOUNT NEXT REEL
;
;	USES:	AC1,AC2,AC3,AC4,AC5
;


VOLSWT:	LDB	AC2,DTCN.	;GET CHANNEL NUMBER
	PUSHJ	PP,GETJFN	; GET JFN IN AC1
	 JRST	[OUTSTR	[ASCIZ/Reel change get JFN ./]	;ERROR, ISSUE MESSAGE
		JRST	OCPERR ]	;MORE MESS AND KILL
	;NOW MUST DO OPENF TO MAKE SURE THE JFN IS OPEN

	MOVE	AC3,AC1		;SAVE JFN IN CASE OF OPENF ERROR
	MOVE	AC2,[440000,,200000] ;INDICATE SIMPLE 36 BIT BYTE,INPUT
	OPENF%			;OPEN THE JFN***************
	 ERCAL	OPNFER		;ERROR?, THEN GO CHECK IT (RETURNS IF OK)
VOLSW1:	MOVEI	AC2,.MOVLS	;INDICATE VOLUME SWITCH MTOPR
	JUMPE	AC4,VOLSW2	;JUMP IF GET FIRST REEL
	MOVEI	AC3,3		;INDICATE THAT THERE ARE 3 ARGS,BEGINING 
				;AT LOCATION 3.
	MOVEI	AC5,1		;INDICATE GET RELATIVE REEL 1 (NEXT)
	JRST	VOLSW3		;GO DO IT

VOLSW2:	MOVEI	AC4,2		;INDICATE 2 ARGS
	MOVEI	AC3,4		;INDICATE ARGS IN AC4,AC5
	MOVEI	AC5,.VSFST	;INDICATE GET FIRST REEL FUNCTION
VOLSW3:	MTOPR%			;DO SWITCH****************
	 ERJMP	MTOERR		;MTOPR ERROR, MESSAGE AND QUIT
	TLO	AC1,(CO%NRJ)	;INDICATE NOT TO RELEASE JFN
	CLOSF%			;CLOSE THE JFN
	 ERJMP	CLSERR		;ERROR GO DO IT
	POPJ	PP,		;RETURN

;	THIS ROUTINE CHECKS FOR OPENF ERROR WHERE FILE IS 
;	ALREADY OPEN. IT RETURNS IN THIS CASE.ALL OTHER OPEN
;	ERRORS DIE WITH ERROR MESSAGE. 
;	ASSUMES:	AC3 SAVES JFN
;			AC1 CONTAINS OPENF ERROR CODE
;			CALLED WITH ERCAL JSYS

OPNFER:	CAIE	AC1,OPNX1	;SKIP IF JFN ALREADY OPEN
	JRST	OJFERR		;OTHER ERROR,MESS AND QUIT
	MOVE	AC1,AC3		;RESTORE JFN
	POPJ	PP,		; RETURN TO CALLER WITH JFN RESTORED
	

>;END IFN TOPS20
IFE TOPS20,<

;
;	VOLSWT IS A ROUTINE TO SWITCH MTA REELS WHEN UNDER
;	PULSAR CONTROL,BUT WITH NO MONITOR LABELING.
;
;
;	USES:	AC1,AC2,AC3
;


VOLSWT:	MOVE	AC1,[2,,2]	; 2 ARGS START AT AC2
	MOVEI	AC2,.TFFEV	; DENSITY AGAIN
	LDB	AC3,DTCN.	; GET CHANNEL NUMBER
	TAPOP.	AC1,		; GET THE UNIT DEFAULT
	 JRST	[POP	PP,(PP)	; TAPOP. ERROR
		 JRST	VSWERR]	; GIVE IT
	POPJ	PP,		;RETURN

>;END IFE TOPS20

CLSR2A:	

IFE TOPS20,<
	TLNN	FLG1,MSTNDR+MTNOLB ; PULSAR LABEL PROCESSING?
	JRST	CLSR2X		; NO,CONT
	PUSHJ	PP,VOLSWT	; YES, CHANGE VOLUMES
>;END IFE TOPS20

IFN TOPS20,<
	TLNE	FLG1,MSTNDR	; SYS-LABELED?
	POPJ	PP,		; YES, NOOP FROM HERE, RETURN
	TLNN	FLG1,MTNOLB	;MOUNTR AND NO LABELING?
	JRST	CLSR2X		;NO, GO ON
	MOVEI	AC4,.VSMRV	;YES,INDICATE GET NEXT REEL
	PUSHJ	PP,VOLSWT	;SWITCH
>;END IFN TOPS20

	JRST	CLOSR4		;RELEASE AND REOPEN
CLSR2X:
	
	OUTSTR	[ASCIZ/
$ Mount/]
	TLNN	FLG,OPNIN	;SKIP IF INPUT
	JRST	CLOSR3		;JUMP IF OUTPUT
	PUSHJ	PP,MSDTRN	;"REEL N"
	OUTSTR	[ASCIZ/ of/]
	MOVE	AC2,[BYTE (5)10,31,20,24,14]
	PUSHJ	PP,MSOUT.	;"FILE ON DEV" STOP0
	JRST	CLOSR4		;OPEN THE NEXT REEL

CLOSR3:	OUTSTR	[ASCIZ/ scratch tape on/]
	PUSHJ	PP,MSDEV.	;DEVICE
IFN LSTATS,<
	PUSHJ	PP,MTRCLS	;END CLOSE TIMING
>
	PUSHJ	PP,C.STOP	;TYPE CONT TO PRO
CLOSR4:	TLZ	AC16,777675	;CLEAR ALL BUT REWIND & WRITE-REEL-CHANGE FLAGS
	TXO	AC16,V%OPEN!CLS%BV!CLS%RO ;OPEN WITH A REWIND + FLAG THE REEL CHANGE
	PUSHJ	PP,FRECHN	;NOTE THE CHAN IS FREE
	XCT	URELE.		;RELEASE THE DEVICE
	MRTMS.	(AC1)		;START OPEN TIMING
	JRST	OPNDEV		;OPEN THE NEXT REEL
	;READ A LABEL INTO THE RECORD AREA OR ZERO IT.  ***@POPJ***

CLSRL:	TLNN	FLG,ATEND	;SKIP IF AT END
	POPJ	PP,		;
	TXNE	AC13,DV.MTA	;SKIP IF NOT A MAGTAPE
	TLNN	FLG1,NONSTD+STNDRD ;SKIP IF NOT OMITTED LABELS
	POPJ	PP,		;ZERO THE RECORD AREA
IFE TOPS20,<			;[561]
	XCT	UCLOS.		;[561] CLEAR THE EOF
>				;[561]
	PUSHJ	PP,READSY	;READ A LABEL
	 JRST	BUFREC		;NORMAL RETURN
CLSRL0:	MOVEI	AC0,^D32	;ERROR NUMBER
	PUSHJ	PP,IGCV		;IGNORE ERROR?
	 JRST	CLSRL2		;NO
	TXNE	AC16,V%READ	;YES READ UUO?
	POPJ	PP,		;YES, JUST RETURN
	TXNN	AC16,V%OPEN	;OPEN UUO?
	JRST	CLSRL1		;NO MUST BE CLOSE
	XCT	URELE.		;RELEASE DEVICE
	POP	PP,(PP)		;DUMP RET TO BUFREC
	JRST	FRECHN		;RELEASE THE CHANNEL
				; AND BACK TO CBL-PRG

CLSRL1:	POP	PP,(PP)		;POP OFF RET TO CLSRLB
	TXO	AC16,CLS%NR	;REWIND CAUSE WE'RE LOST
	JRST	CLOSE8		;FINISH UP

CLSRL2:	OUTSTR	[ASCIZ/ Read an "EOF" instead of a label./] ;
	MOVE	AC2,[BYTE(5)30,10,31,20,37]	;CLOSE
	TXNE	AC16,V%OPEN			;OPEN?
	MOVE	AC2,[BYTE(5) 30,10,31,20,2]	;YES
	TXNE	AC16,V%READ			;READ?
	MOVE	AC2,[BYTE (5)35,31,20,10,4]	;YES
	JRST	MSOUT.				;GO COMPLAIN
	;CHECK FOR "EOV" AS FIRST THREE LABEL CRARACTERS

CLSEOV:	TLNE	FLG,CDMASC	;SKIP IF NOT ASCII RECORD AREA
	JRST	CLSEO1		;ASCII TEST
	HLRZ	C,(FLG)		;FIRST 3 CHARS
	CAIN	C,'EOV'
	POPJ	PP,		;OK EXIT
	JRST	RET.2		;ERROR SKIP RET

CLSEO1:	MOVE	C,(FLG)		;FIRST WORD
	TRZ	C,77777		;CLEAR EXTRANEOUS BITS
	CAMN	C,[ASCIZ /EOV/]
	POPJ	PP,		;OK EXIT
	JRST	RET.2		;ERROR SKIP EXIT

IFN ISAM,<
	;CLOSE & RELEASE THE INDEX FILE
CLSIDX:
IFN ISTKS,<	;TYPE OUT # OF IN'S AND OUT'S
	MOVEI	AC3,INSSSS(I12)
	MOVEI	AC2,OUTSSS(I12)
	OUTSTR	[ASCIZ /IN'S	OUT'S
/]
CLSID0:	MOVE	AC0,(AC3)
	SETZM	(AC3)
	PUSHJ	PP,PUTDEC
	MOVEI	C,"	"
	OUTCHR	C
	MOVE	AC0,(AC2)
	SETZM	(AC2)
	PUSHJ	PP,PUTDEC
	OUTSTR	[ASCIZ /
/]
	ADDI	AC3,1
	ADDI	AC2,1
	CAIE	AC3,INSSSS+15(I12)
	JRST	CLSID0
	OUTSTR	[ASCIZ /FAKER.:=/]
	MOVE	AC0,(AC2)
	PUSHJ	PP,PUTDEC
	SETZM	(AC2)
	OUTSTR	[ASCIZ /
FORCR.:=/]
	MOVE	AC0,(AC3)
	PUSHJ	PP,PUTDEC
	SETZM	(AC3)
	OUTSTR	[ASCIZ /
/]

>
	HRRZ	AC1,D.IBL(I16)	; [377] GET ISAM SAVE AREA 
	JUMPE	AC1,CLSID3	; [377] NONE GO ON
	HRLI	AC1,ISCLR1(I12)	; [377] SAVE SHARE BUFFER AREA
	MOVEI	AC2,ISMCLR(AC1)	; [377] IN ISAM FILE SAVE AREA
	BLT	AC1,(AC2)	; [377]
CLSID3:				; [377] NEW LABEL
	PUSHJ	PP,SETIC	;SET THE CHANNEL NUMBER
	SKIPE	PRGFLG		;DELETE THE FILE
	JRST	CLSID2		;YES SO GO DO IT
REPEAT 0,<
	TLNE	FLG,OPNOUT	;OPEN FOR OPTPUT?
JFCL;	PUSHJ	PP,WSTBK	;WRITE THE STATISTICS BLOCK
>
	XCT	ICLOS		;
	XCT	IWAIT		;WAIT FOR ERRORS
	XCT	IGETS		;GET STATUS
	TXNE	AC2,IO.ERR	;SKIP IF ANY ERRORS
	PUSHJ	PP,WIBK2	;CATCH ANY ERRORS NOW
	JRST	CLSID1		;
CLSID2:	PUSHJ	PP,OPNEIX	;
	SETZM	UEBLK.		;ZERO THE FILENAME
	XCT	IRNAM		;DELET
	 JRST	CLSID4		;ERROR RET
CLSID1:	XCT	IRELE		;
	POPJ	PP,

CLSID4:	PUSHJ	PP,ORERRI	;TRY FOR A USE PROCEDURE
	POP	PP,(PP)		;POP OFF CALL FROM CLOSF4+7
	JRST	CLOS72		;CLEAN UP AND EXIT

	;WRITE OUT ALL ACTIVE ISAM DATA STILL IN CORE
CLSISM:	PUSHJ	PP,SETIC	;SET INDEX FILE CHAANNEL NUMBER
	SKIPE	LIVE(I12)	;IF ANY ACTIVE DATA
	PUSHJ	PP,WWDBK	;  OUTPUT IT
	MOVE	AC13,D.DC(I16)	;RESTORE AC13 ALIAS LVL
	JRST	CLOSE4
>
	;CREATE A LABEL OR ZERO IT.  ***@POPJ***

CLSCAL:	TXNE	AC13,DV.MTA	;SKIP IF DEVICE IS NOT A MTA
	TLNN	FLG1,STNDRD	;SKIP IF STANDARD LABELS
	POPJ	PP,		;CLEAR RECORD AREA
	JRST	OPNCAL		;CREATE A LABEL FOR A MTA W/ STD LABELS

	;WRITE AN ENDING LABEL AND DO FINAL ERROR CHECKS.  ***@POPJ***

CLSWEL:	SKIPE	PRGFLG		;[576] SKIP IF NOT CLOSE WITH DELETE
IFN TOPS20, <			;[1005] TOPS10 MUST FREE RETAINED RECORDS
	JRST	CLSWL1		;[576] SKIP BUFFER SAVES,DELETE FOLLOWS
>;				;[1005]
IFE TOPS20,<
	JRST	CLSPRG		;[1005] JUMP TO FREE RETAINED RECORDS
	SKIPN	F.WSMU(I16)	;[576] SKIP IF RETAINED RECORDS
	JRST	CLSWLX		;[576] NOT RETAINED, GO ON
	LDB	AC0,DTCN.	;[576] GET CHANNEL NUMBER
	HRLM	AC0,FUSCP.	;[576] SET CHAN NUMBER IN ARG BLK
	MOVE	AC0,[1,,FUSCP.]	;[576] INDICATE CHECKPOINT ARG BLK
	FILOP.	AC0,		;[576] DO .FOURB CHECKPOINT FILOP,CLEARING OUT FILE
	 PUSHJ	PP,CKPTER	;[576] ERROR IN CHECK POINT FILOP
	PUSHJ	PP,CLWSMU	;[576] FREE ALL RETAINED BLOCKS
	TLNN	FLG,IDXFIL	;[576] SKIP IF INDEX FILE
	JRST	CLSWLX		;[576] NOT INDEX, GO ON
	MOVE	AC0,ICHAN(I12)	;[576] GET INDEX FILE CHAN NUMBER
	HRLM	AC0,FUSCP.	;[576] SET CHAN NUMBER
	MOVE	AC0,[1,,FUSCP.]	;[576] INDICATE ARG BLK
	FILOP.	AC0,		;[576] CHECKPOINT INDEX FILE
	 PUSHJ	PP,CKPTER	;[576] ERROR IN FILOP
	JRST	CLSWLX		;[576] CONTINUE

CKPTER:	MOVE	AC0,[E.VCLO+E.MFOP]	;[576] INDICATE CLOSE FILOP ERROR
	TLNN	FLG,IDXFIL	;[576] INDEX FILE?
	JRST	CKPTR1		;[576] NO, SKIP AHEAD
	PUSHJ	PP,IGMI		;[576] IGNORE ERROR?
	 JRST	CKPTR2		;[576] NO, GIVE ERROR MESS
	JRST	CLRIS		;[576] YES,CLEAR ERROR STATUS AND RETURN TO CALL

CKPTR1:	PUSHJ	PP,IGMD		;[576] NON-INDEX FILE ,IGNORE ERROR?
	 JRST	CKPTR2		;[576] NO
	JRST	CLRDS		;[576] YES, CLEAR ERROR STATUS AND CONTINUE

CKPTR2:	XCT	UWAIT.		;[576] WAIT ON ERRORS
	MOVE	LVL,D.DC(I16)	;[576] SET DEVICE CHARACTERISTICS
	PUSHJ	PP,IOERMS	;[576] SET ERROR CODES
	MOVE	AC2,[BYTE(5) 10,37,31,20,4]	;[576] INDICATE MESSAGE
	JRST	MSOUT.		;[576] MESSAGE AND KILL

CLSPRG:	SKIPN	F.WSMU(I16)	;[1005] SKIP IF RETAINED RECORDS
;[D1011] JRST	CLSWLX		;[1005]
	JRST	CLSWL1		;[1011]
	PUSHJ	PP,CLWSMU	;[1005] FREE ALL RETAINED RECORDS

CLSWLX:>;[576] END IFE TOPS20

	XCT	UCLOS.		;[576] DUMP ALL THE BUFFERS
CLSWL1:	PUSHJ	PP,WRTWAI	;[576] WAIT FOR ERROR CHECKING
IFN TOPS20,<
	SKIPN	F.WSMU(I16)	;[576] [571] ANY RETAINED RECORDS?
	JRST	CLSWLA		;[576] SKIP AHEAD IF NOT SMU
	PUSHJ	PP,CLWSMU	;[576] FREE RETAINED BLOCKS
>;[576] END IFN TOPS20

CLSWLA:	TXNE	AC13,DV.MTA	;[573] SKIP NOT A MAGTAPE
	TLNN	FLG1,NONSTD+STNDRD ;SKIP IF LABELS ARE NOT OMITTED
	POPJ	PP,		;
	XCT	UOUT.		;DUMMY OUTPUT
	PUSHJ	PP,RECBUF	;MOVE RECORD TO THE BUFFER AREA
	PUSHJ	PP,WRTOUT	;OUTPUT IT
	XCT	UCLOS.		;LEOT
	JRST	WRTWAI		;WAIT FOR ERROR CHECKING

	;[576] GO DEQUEUE AND RETAINED RECORDS AFTER SAVING FLG REGS

CLWSMU:	PUSH	PP,FLG		;[576] [573] SAVE FLG, SU.CL KILLS IT
	PUSH	PP,FLG1		;[576] [573] SAVE THIS TOO
	PUSHJ	PP,SU.CL	;[576] [571] YES, DEQUEUE THEM
	POP	PP,FLG1		;[576] [573] RESTORE FLG1 AND
	POP	PP,FLG		;[576] [573] NOW GET FLG BACK
	POPJ	PP,		;[576] RETURN

	;TO KEEP OUR MTA BUFFERS STRAIGHT.  ***POPJ***

IFE TOPS20,<
CLSYNC:	XCT	UGETS.		;SET OR CLEAR
	TRC	AC2,IO.SYN	;    THE SYNCHRONOUS
	XCT	USETS.		;    MODE STATUS BIT
	POPJ	PP,		;    FOR MAGTAPE
>;END IFE TOPS20

	;ZERO THE UNUSED AREA OF THE DUMP MODE BUFFER

CLSZBF:	TLNN	FLG,DDMEBC!DDMASC  ;[665] SKIP IF AN EBCDIC/ASCII FILE
	JRST	CLSZB2		; JUMP ITS NOT
	HLRZ	AC1,R.BPNR(I12)	; PAD THE LAST RECORD WORD
	LSH	AC1,-^D12	;[665] ISOLATE BIT COUNT
	CAIN	AC1,44		;[665] DID REC END ON A WORD BOUNDARY ?
	JRST	CLSZB2		; YES
	MOVE	AC1,R.BPNR(I12)	; GET BYTE-PTR
	TDZA	AC2,AC2		; THE PAD CHAR
	IDPB	AC2,AC1		;
	TLNE	AC1,760000	;[665] DONE?
	JRST	.-2		; LOOP
	AOS	R.BPNR(I12)	; RESTORE BYTE-PTR
CLSZB2:	HRRZ	AC1,R.BPNR(I12)	;LOC
	SUB	AC1,R.IOWD(I12)	;LOC - LOC-1
	HLRZ	AC2,AC1		;LENGTH
	SUBI	AC2,(AC1)	;LENGTH TO CLEAR
	JUMPE	AC2,RET.1	; EXIT IF NOTHING TO ZERO
	HRR	AC1,R.BPNR(I12)	;LOC
	HRL	AC1,AC1		;FROM
	HRRI	AC1,1(AC1)	;TO
	SETZM	-1(AC1)		;THE ZERO
	ADDI	AC2,-1(AC1)	;UNTIL
	CAIL	AC2,(AC1)	;JUST EXIT IF BUFFER IS FULL
	BLT	AC1,(AC2)	;DOIT
	POPJ	PP,
SUBTTL	WRITE VERB

;HERE FOR WRITE VARIABLE LENGTH RECORDS.
; ROUTINES WADVV. AND WRITV. CORRESPOND TO WADV. AND WRITE.
; EXCEPT THE RECORD SIZE IS GIVEN IN AC15

WADVV.:	TXOA	AC16,V%WADV	;WRITE ADVANCE
WRITV.:	MRTMS.	(AC1)		;START METER TIMING HERE
	TXO	AC16,V%WRITE	;WRITE
	PUSH	PP,AC15		;SAVE RECSIZE
	SETZM	NOCR.		;CLEAR NO CARRIAGE RET FLAG
	MOVE	AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
	BLT	AC0,FS.IF	;   STATUS WORDS.
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.WR	; YES
	HRRZ	AC15,-1(PP)	;OPERAND OR RETURN ADR	(UOCAL.)
	MOVE	AC15,(AC15)	;
	PUSHJ	PP,WRTSUP	;SETUP
	POP	PP,AC3
	DPB	AC3,WOPRS.	;PUT RECORD SIZE IN AC15
	JRST	WRTGT3		;GO JOIN REGULAR WRITE CODE
SUBTTL	WRITE VERB

	;A WRITE. VERB LOOKS LIKE:
	;FLAGS,,ADR	WHERE ADR = FILE TABLE ADDRESS
	;CALL+1:	0-11 RECORD SIZE IN CHARACTERS
	;		12-35 UNDEFINED
	;CALL+2:	NORMAL POPJ RETURN
	;CALL+3:	"INVALID-KEY" RETURN

	;A WADV. VERB LOOKS LIKE:
	;FLAGS,,ADR	WHERE ADR = FILE TABLE ADDRESS
	;CALL+1:	0-11 RECORD SIZE IN CHARACTERS
	;BIT12 =1	USE 18-35 AS AN ADDRESS
	;BIT13 =0	WRITE AFTER ADVANCING
	;BIT13 =1	WRITE BEFORE ADVANCING
	;BIT14		=1 IF POSITIONING
	;BIT15-17	ADVANCE VIA THIS LPT CHANNEL
	;BIT18-35	NUMBER OF TIMES TO ADVANCE
	;		
	;
	;		IF BIT12=1 (18-35 IS ADDR) AND 
	;		BIT18-35= -1 THEN ADVANCING IS DEFAULT

	;CALL+2:	NORMAL POPJ RETURN

	;SETUP AND INITIAL CHECKS.  ***WRTREC***RANDOM***
WRPW.:	TXO	AC16,V%WADV	; WRITE ADVANCE VERB
	SETOM	NOCR.		;REPORT-WRITER ENTRY
	JRST	WRITE1		;
WADV.:	TXOA	AC16,V%WADV	;WRITE ADVANCE
WRITE.:	TXO	AC16,V%WRITE	;WRITE
	SETZM	NOCR.		;CLEAR NO CARRIAGE RET FLAG
WRITE1:	MRTMS.	(AC1)		;START METER TIMING HERE
	MOVE	AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
	BLT	AC0,FS.IF	;   STATUS WORDS.
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.WR	; YES
	SKIPGE	NOCR.		;[QAR] IF THIS IS A REPORT WRITER CALL
	JRST	WRITE2		;[QAR] AC15 IS ALREADY SETUP
	HRRZ	AC15,(PP)	;OPERAND OR RETURN ADR	(UOCAL.)
	MOVE	AC15,(AC15)	;
WRITE2:	PUSHJ	PP,WRTSUP	;SETUP
	LDB	AC3,WOPRS.	;RECORD SIZE FROM AC15
WRTGT3:
IFN LSTATS,<
	MOVE	AC1,AC3		;GET RECORD LENGTH
	PUSHJ	PP,BUCREC	;SET AC2 TO REC BUCKET
	L.METR	(MB.WRT(AC2),I16) ;CNT WRT BUCKET
>;END IFN LSTATS
	TLNN	FLG,OPNOUT	;SKIP IF OPEN FOR OUTPUT
	JRST	ERROPN		;ERROR MESSAGE
IFN ISAM,<
	TLNE	FLG,IDXFIL	;
	JRST	IWRITE		;WRITE AN INDEX-FILE
>
IFN ANS68,<
	TLNE	FLG,RANFIL+IOFIL ;[622] SKIP IF NOT RANDOM OR I/O
	JRST	RANDOM		;RANDOM AND IO EXIT HERE
>
IFN ANS74,<	;SEQ AND REL/SEQ WRITE ALLOW OPN OUTPUT ONLY

	TLNN	FLG,RANFIL	;RANDOM FILE ?
	JRST	WRITE3		;NO, SEQ
	LDB	AC0,F.BFAM	;YES,GET ACCESS MODE
	SKIPN	AC0		;RANDOM OR DYNAMIC SKIPS
	TLNN	FLG,OPNIN	;[622] SEQ, OPEN FOR I-O?
	JRST	RANDOM		;NO, DO RANDOM OR I-O
	JRST	ERROPN		;YES, ERROR-WRITE OUTPUT ONLY
WRITE3:	TLNE	FLG,OPNIN	;[622] SEQ. ORGAN.,OPEN I-O?
	JRST	ERROPN		;YES, ERROR ALSO
	TLNE	FLG,IOFIL	;[622] SKIP IF NOT AN I-O DUMP MODE FILE
	JRST	RANDOM		;[622] ELSE DO DUMP MODE WRITE
>	
	JUMPL	FLG,WRTREC	;ASCII
	TLNE	FLG,DDMBIN	;IF BINARY,
	JRST	WRTR20		;  USE THIS ROUTINE
	TLNE	FLG,DDMEBC	;EBCDIC?
	JRST	WER		;YES - USE EBCDIC ROUTINE
	;CHECK AND WRITE OUT VARIABLE LENGTH RECORD SIZE
	PUSHJ	PP,WRTABP	;ADJUST THE BYTE-POINTER
	MOVE	AC4,D.RP(I16)	;GET RECORD SEQUENCE NUMBER
	TXNE	AC13,DV.MTA	;MTA?
	HRLM	AC4,(AC1)	;YES - STORE IN THE HEADER WORD
	HRRM	AC3,(AC1)	;MOVE RECSIZE TO THE BUFFER
	AOS	D.OBB(I16)	;SO REC-SIZE IS NOT OVERWRITTEN
	MOVN	AC4,D.BPW(I16)	;MAKE BYTE COUNT
	ADDB	AC4,D.OBC(I16)	; RIGHT
	JUMPN	AC4,WRTREC	;JUMP IF BUFFER IS NOT FULL
	TLNN	FLG,CONNEC	;SKIP IF CONVERSION IS NECESSARY
	SOS	D.OBB(I16)	;BACKUP THE BYTE-POINTER
	PUSHJ	PP,WRTBUF	;ADVANCE BUFFERS
	PUSHJ	PP,WRTABP	;ADJUST BYTE-POINTER

	;MOVE RECORD TO THE BUFFER, OUTPUT IF NECESSARY.
WRTREC:	TLNN	FLG,CONNEC	;SKIP IF CONVERSION IS NECESSARY
	JUMPGE	FLG,WRTRB	;NOT-ASCII, GO BLT RECORD
	MOVE	AC10,D.WCNV(I16) ;SETUP AC10
	TXNN	AC16,V%WADV	;SKIP IF WADV
	JRST	WRTRCA		; NO ADVANCING
	TLNE	AC15,WDVBFR	; ADV BEFORE?
	JRST	WTRC01		; YES, JUMP
	HRRZ	AC4,D.RFLG(I16)	; NO,GET AFT-ADV ASCII FLAG
	TRO	AC4,AFTADV	; SET IT
	HRRM	AC4,D.RFLG(I16)	; RESET IT
	JRST	WTRC00		; CONT

	; HERE IF BEFORE-ADV ,BEFORE WRITING THE RECORD WRITE "CR"?

WTRC01:	TXNE	AC13,DV.MTA	; IS THIS MTA?
	JRST	WTRC00		; YES, SKIP FUNNY EXTRA "CR"
	HRRZ	AC4,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRZE	AC4,AFTADV	; SKIP IF DON'T NEED "CR"
	PUSHJ	PP,WRTCR	; WRITE "CR" 
	HRRM	AC4,D.RFLG(I16)	; RESET IT

WTRC00:	PUSHJ	PP,WRTADV	;SEE IF NOW IS THE TIME TO ADVANCE


IFN ANS74,<
	  TRNA			;NORMAL RETURN
	AOS	(PP)		;COPY END OF PAGE SKIP RETURN
>
	JRST	WRTRCB		; CONT
WRTRCA:	

IFN ANS74,<
	JUMPGE	FLG,WRTRCB	; JUMP THIS IF NOT ASCII

	; IF STD-ASCII AND MTA, THEN NO CR-LF

	HRRZ	AC4,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRO	AC4,AFTADV	; SET AFT-ADV DONE
	HRRM	AC4,D.RFLG(I16)	; RESET
	TRNE	AC4,SASCII	; SKIP IF NOT STANDARD ASCII
	TXNN	AC13,DV.MTA	; STD-ASCII AND MTA?
	TDNA			; NO,THEN WRITE CR-LF
	JRST	WRTRCB		; YES,NO CRLF
	PUSHJ	PP,WRTCR	; ELSE, "CR" AND
	PUSHJ	PP,WRTLF	; "LF"
>
WRTRCB:
	JUMPE	AC3,WRTZRE	;TRYING TO WRITE A NULL REC?

;	SUPPRESS TRAILING BLANKS FOR ASCII OUTPUT FILES
 IFN	SUPP, <
	JUMPGE	FLG,WRTSIX	; [403] IF NOT ASCII DO REGULAR WRITE
	TXNE	AC13,DV.MTA	;[CCS1] Do regular write for MTA also
	 JRST	WRTSIX		;[CCS1]
	SETZB	AC4,AC5		; [403] SET UP SIXBIT BLANK AND BLANK CNT
	TLNN	FLG,CONNEC 	; [403] IF CONVERSION NOT NEEDED IT IS ASCII RECORD
	MOVEI	AC4," "		; [403] ASCII BLANK
WRTRA0:	ILDB	C,AC6		;[CCS-1]CHAR FROM THE RECORD AREA
	CAIE	C,(AC4)		; [403] IS IT BLANK?
	JRST	WRTRA1		; [403] NO
	AOS	AC5		; [403]	YES CNT NO OF THEM IN SUCCESSION
	SOJG	AC3,WRTRA0	;[CCS-1]  [403] GET NEXT CHAR
	LDB	AC4,WOPRS.	; [403] END OF RECORD- GET BACK RECORD SIZE
	SUB	AC4,AC5		; [403] GET NUMBER OF CONSECUTIVE BLANKS
	JUMPG	AC4,WRTRA3	; [403] WROTE AT LEAST ONE CHAR FINISH UP
	MOVEI	C," "		; [403] RECORD ALL BLANKS; MUST OUTPUT ONE
	JRST	WRTRAA		; [403] INSERT ONE BLANK AND FINISH
WRTRA1:	JUMPE	AC5,WRTRA2	; [403] NO INTERVENING BLANKS GO ON
	MOVEI	AC1," "		; [403] ASCII BLANK
BLKINS:	IDPB	AC1,D.OBB(I16)	; [403] Insert a blank
	SOSG	D.OBC(I16)	; [403] Is there is room in the buffer?
	PUSHJ	PP,WRTBUF	; [403] No, write it out
	SOJG	AC5,BLKINS	; [403] Write next blank
WRTRA2:	XCT	AC10		;CONVERT IF NECESSARY
WRTRAA:	IDPB	C,D.OBB(I16)	;CHAR TO THE BUFFER
	SOSG	D.OBC(I16)	;Skip if the buffer is not full
	PUSHJ	PP,WRTBUF	;Buffer full, write it out
	SOJG	AC3,WRTRA0	;LOOP TILL A COMPLETE RECORD IS PASSED
WRTRA3:				;[WADV] 
	JRST	WTRE2A		;[CCS-1] Rejoin main code

REPEAT 0,<			;[CCS-1] REMOVE THIS CODE
WRTRE3:	PUSHJ	PP,WRTADV	;WADV.
IFN ANS74,<
	  TRNA			;NORMAL RETURN
	AOS	(PP)		;COPY END OF PAGE SKIP RETURN
>
	JRST	WRTRE6		;

;	WRITE SIXBIT FILES HERE-NO TRAILING BLANK SUPPRESSION
WRTSIX:	ILDB	C,AC6		;CHAR FROM THE RECORD AREA
	XCT	AC10		;CONVERT IF NECESSARY
	IDPB	C,D.OBB(I16)	;CHAR TO THE BUFFER
	SOSG	D.OBC(I16)	;SKIP IF YOU CAN
	PUSHJ	PP,WRTBUF	;BUFFER FULL, WRITE IT OUT
	SOJG	AC3,WRTSIX	;LOOP TILL A COMPLETE RECORD IS PASSED

>;END OF REPEAT 0
>	; END OF IFN SUPP- BLANK SUPPRESS CODE

;[CCS-1] Include this code even if suppressing blanks
WRTSIX:	TLNE	FLG1,MSTNDR	; IS THIS LABELED TAPE?
	PUSHJ	PP,PADLAB	; YES,CHECK PADDING
;[R672]	WRTRE1:	SOSL	D.OBC(I16)	;[655][653]SKIP IF YOU CAN
;[R672]		JRST	WRTR1A		;[655] OVER THE PUSHJ
;[R672]		PUSHJ	PP,WRTBUF	;[653]BUFFER FULL, WRITE IT OUT
;[R672]		SOS	D.OBC(I16)	;[655]ADJUST COUNT FOR THIS BYTE
;[R672]	WRTR1A:	ILDB	C,AC6		;[655]CHAR FROM THE RECORD AREA
WRTRE1:	ILDB	C,AC6		;[672]CHAR FROM THE RECORD AREA
	XCT	AC10		;CONVERT IF NECESSARY
	IDPB	C,D.OBB(I16)	;CHAR TO THE BUFFER
	SOSG	D.OBC(I16)	;[672] SKIP IF YOU CAN
	PUSHJ	PP,WRTBUF	;[672] BUFFER FULL, WRITE IT OUT
	SOJG	AC3,WRTRE1	;LOOP TILL A COMPLETE RECORD IS PASSED
	JUMPGE	FLG,WRTRE4	;JUMP IF NOT ASCII
WRTRE2: TLNE	FLG1,MSTNDR	; LABELED TAPE?
	PUSHJ	PP,LABPAD	; YES, PAD OUT AS INDICATED BY STACK

WTRE2A:	TXNN	AC16,V%WADV	;SKIP IF WADV
	JRST	WTRE2C		; ELSE DO CR-LF
	PUSHJ	PP,WRTADV	;WADV.
IFN ANS74,<
	  TRNA			;NORMAL RETURN
	AOS	(PP)		;COPY END-OF-PAGE SKIP RETURN
>;END IFN ANS74
	JRST	WRTRE6		; CONT


; PADLAB	ROUTINE TO SAV PAD LENGTH FOR F FORMAT LABELED MTA
;		(AC3 CONTAINS THE WRITE RECORD LENGTH)
;
; USES		AC0,AC1,AC2
;
; RETURNS	+1 ALWAYS, PAD LENGTH PUSHED ONTO STACK

PADLAB:	LDB	AC1,F.BFMT	; GET FORMAT FIELD
	TRNN	AC1,FRMATF	; F FORMAT?
	JRST	PADLBX		; NO, GO ON,0 LEFT INDICATES 0 PAD
	LDB	AC0,F.BMRS	; GET MAX REC SIZE
	SUBI	AC0,(AC3)	; CALC PAD LENGTH
	HRR	AC1,AC0		; SET HERE
PADLBX:	POP	PP,AC2		; POP RETURN ADDRESS
	PUSH	PP,AC1		; AND SAVE PAD-LEN,,FRMAT-BITS
	JRST	(AC2)		; RETURN


; LABPAD	ROUTINE TO PAD OUT SYS-LABELED MTA REC WITH NULLS
;
; USES		AC1,C	PAD-LEN,,FRMAT-BITS (ON STACK) ARE POPPED
;
;

LABPAD:	POP	PP,AC2		; GET RETURN ADDR
	POP	PP,AC1		; RESTORE PAD-LEN,,FRMAT-BITS
	TLNN	AC1,-1		; SKIP IF SOME PADDING
	JRST	LABPDX		; NOP, CONT
	HLRZ	AC1,AC1		; GET PADDING COUNT
	SETZ	C,		; GET NULL
	IDPB	C,D.OBB(I16)	; CHAR TO THE BUFFER
	SOJG	AC1,.-1		; LOOP TILL PADDED, ASSUME 
				; F FORMAT MUST BE BLOCKED, 
LABPDX:	JRST	(AC2) 		; SO WILL FIT IN ONE BUFF




WTRE2C:
IFN ANS68,<

	; IF STD-ASCII AND MTA, THEN NO CR-LF

	HRRZ	AC4,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRZ	AC4,AFTADV	; CLEAR AFT-ADV DONE
	HRRM	AC4,D.RFLG(I16)	; RESET
	TRNE	AC4,SASCII	; SKIP IF NOT STANDARD ASCII
	TXNN	AC13,DV.MTA	; STD-ASCII AND MTA?
	TDNA			; NO,THEN WRITE CR-LF
	JRST	WRTRE6		; YES,NO CRLF
	PUSHJ	PP,WRTCR	; WRITE "CR"
	PUSHJ	PP,WRTLF	; WRITE "LF"
>;END IFN ANS68
	JRST	WRTRE6		;
;[CCS-1] Delete ">" for END IFE SUPP

	;ZERO FILL THE LAST PARTIAL WORD IF NECESSARY
WRTRE4:	SKIPN	AC2,D.OBC(I16)	;SKIP IF BUFFER IS NOT FULL
	JRST	WRTRE6		;JUMP FULL
WRTRE5:	MOVE	AC1,D.OBB(I16)	;OUTPUT BYTE POINTER
	TLNN	AC1,760000	;SKIP IF ZERO FILL IS NECESSARY
	JRST	WRTRE7		;
	IBP	D.OBB(I16)	;FILL IN A ZERO
	SOSLE	D.OBC(I16)	;ADJ THE BYTE COUNT
	JRST	WRTRE5		;LOOP
WRTRE6:	SKIPG	D.OBC(I16)	;BUFFER FULL?
	PUSHJ	PP,WRTBUF	;YES
	;STANDARD EXIT FOR READ AND WRITE.  ***POPJ***
	;MAY GENERATE A CLOSE UUO IF A MTA "EOT" AND A MULTI REEL FILE.

WRTRE7:
IFN ANS74,<
	SETZM	NRSAV.+4	; CLEAR SAVED ACTUAL KEY
>
	PUSHJ	PP,CLRSTS	;[601] CLEAR FILE STATUS WORD
	LDB	AC2,F.BBKF	;BLOCKING-FACTOR
	JUMPE	AC2,WRTR10	;DON'T PAD IF BLK-FTR IS ZERO
	TLNN	FLG,IOFIL+RANFIL ;[622] SKIP IF AN IO/RANDOM FILE
	SOSE	D.RCL(I16)	;DECREMENT THE RECORD/LOGICAL-BLOCK COUNT
	JRST	WRTR10		;
	MOVEM	AC2,D.RCL(I16)	;RECORDS/LOGIC BLOCK
	SETZM	D.IBC(I16)	;BE SURE THE NEXT READ GETS NEXT BUFFER
	SKIPLE	AC2,D.BCL(I16)	;BUFFERS/LOGICAL BLOCK
WRTRE9:	SOJGE	AC2,WRTR14	;PASS A BUFFER AND RETURN HERE
	MOVE	AC2,D.BPL(I16)	;RESTORE
	MOVEM	AC2,D.BCL(I16)	; BUFFERS PER LOGICAL BLOCK
WRTR10:
IFN LSTATS,<
	TXNE	AC16,V%STRT	;IS THIS START?
	JRST	WRTRWT		;YES,SO SKIP THIS MESS
	TXNN	AC16,V%READ	;SKIP IF READ
	JRST	WRTRWT		;WRITE JUMPS
	MOVE	AC1,D.CLRR(I16)	;GET CHAR LENGTH OF REC READ
	PUSHJ	PP,BUCREC	;SET AC2 TO REC BUCKET OFFSET
	TXNE	AC16,V%RNXT	;IS IT READ NEXT ?
	JRST	WRTRNX		;YES, JUMP
	L.METR	(MB.RDD(AC2),I16) ;NO, CNT BUCKET FOR READ
	JRST WRTRWT		;FINISH
WRTRNX:	L.METR	(MB.RNX(AC2),I16) ; METER READ NEXT BUCKET
WRTRWT:	MRTME.	(AC1)		;END TIMING, UPDATE TIME BUCKET
				;THIS ENDS TIMING FOR READ,READ NEXT,
				;WRITE AND START
>;END IFN LSTATS

	LDB	AC0,F.BCRC	; GET CHP=PNT REC CNT
	JUMPE	AC0,WTR10A	; SKIP IF NONE
	TXNE	AC16,V%DLT+V%RWRT+V%WRITE+V%WADV ; IS THIS DELET,RERIT,WRITE?
	PUSHJ	PP,CKPREC	; YES, DECR. COUNT AND CHKPNT IF TIME
WTR10A:	PUSHJ	PP,CHKRRN	; CHECK FOR RERUN OR FORCED DUMP
	SKIPN	F.WSMU(I16)	;[1064] DOING SIMULTANEOUS UPDATE?
	 JRST	WRTR11		;[1064] NO
	SKIPN	SU.FRF		;[1064] DOING FAKE READ FOR SMU?
	 PUSHJ	PP,LRDEQX##	;[1064]  NO
WRTR11:	TLNE	FLG,RANFIL	;DONT MESS WITH OLD KEY (D.RP) IF RANFIL
	JRST	WTR11A		; IN WHICH CASE FORGET IT
	HRRZ	AC1,D.RFLG(I16)	; GET SOME FLAGS
	TXNN	AC1,RDDREV	; READ REVERSE OPEN ACTIVE?
	JRST	WTR11B		; NO CONT
	SOS	D.RP(I16)	; YES, DECREMENT COUNT
	JRST	WTR11A		; AND CONT

WTR11B:	AOS	D.RP(I16)	;BUMP THE RECORD COUNT



WTR11A:
IFN ANS68,<
	TXNN	AC16,V%READ	;SKIP IF READ
>
IFN ANS74,<
	TXNN	AC16,V%READ!V%DLT	;SKIP IF READ OR DELETE
>
	AOS	(PP)		;
	TXNN	AC16,FL%EOT	;SKIP IF "EOT"
	POPJ	PP,		;EXIT TO THE ***"ACP"***

	HRLI	AC16,1440	;CLOSE REEL WITH REWIND
	SKIPA	AC1,FILES.	;THE FIRST FILE-TABLE
WRTR12:	HRRZ	AC1,F.RNFT(AC1)	;NEXT FILE-TABLE ADR
	JUMPE	AC1,C.CLOS	;NO MORE, EXIT TO THE ***ACP***
	CAIN	AC1,(I16)	;IS IT THE CURRENT FILE-TABLE?
	JRST	WRTR12		;YES, LOOP
	HRRZ	AC2,F.RREC(AC1)	;RECORD-AREA ADR
	CAIE	AC2,(FLG)	;SKIP IF "SAME RECORD-AREA"
	JRST	WRTR12		;ELSE LOOP

	;SAVE THE SHARED RECORD-AREA WHILE CHANGING REELS

	HLRZ	AC1,F.LNLS(I16)	;NONSTD LABEL SIZE IN CHARS
	LDB	AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC2,RBPTBL(AC2)	; GET CHARS PER WORD
	IDIV	AC1,AC2		;CONVERT TO WORDS/LABEL
	SKIPN	AC1+1		;
	SUBI	AC1,1		;ROUND DOWN
	HLLZ	FLG1,D.F1(I16)	;FLAGS
	TLNN	FLG1,NONSTD	;SKIP IF NONSTD LABELS
	MOVEI	AC1,15		;STD LABEL SIZE IN WORDS (-1)
	HRR	AC2,.JBFF	;"TO" ADR
	HRL	AC2,FLG		;"FROM,,TO" ADRS
	MOVE	AC0,AC1		;SETUP AC10 FOR GETSPC
	PUSHJ	PP,GETSPC	;GET SOME SPACE
	 JRST	WCORER		;NO CORE AVAILABLE
	PUSH	PP,AC1		;SAVE LENGTH	POPED @ OPNDV1
	PUSH	PP,AC2		;SAVE "FROM,,TO"
	HRRZ	AC0,HLOVL.	;GET START OF OVERLAY AREA
	CAMGE	AC0,.JBFF	;BLT INTO OVL AREA?
	JUMPN	AC0,WOVLER	;ERROR IF IT DOES
	MOVE	AC1,.JBFF	;"UNTIL"
	BLT	AC2,(AC1)	;SLURP!
WRTR13:	HRLI	AC16,(V%CLOS!CLS%RO!CLS%CR!FL%WRC)	;CLOSE REEL WITH REWIND AND FL%WRC FLAG SET
	JRST	C.CLOS		;DOIT!
	; CHKRRN CHECKS FOR RERUN COUNT AND UPDATES IT IF INDICATED.
	; WHEN IT HITS ZERO A RERUN DUMP WILL BE TAKEN BY CALLING RRDMP.
	; A CKECK IS ALSO MADE FOR A FORCED (CONTROL-C EXIT WITH REENTER)
	; DUMP.

CHKRRN:	SOSG	D.RRD(I16)	;SKIP IF IT'S NOT RERUN DUMP TIME
	TLNN	FLG,RRUNRC	;SKIP IF WE ARE RERUNNING
	JRST	CKRRN1		;
	HRRZ	AC2,F.RRRC(I16)	;RESTORE NUMBER OF RECORDS
	MOVEM	AC2,D.RRD(I16)	;  TO A RERUN DUMP
IFN LSTATS,<
	JFFO	AC2,.+1		;AC3=# ZEROS TO LEFT OF AC2'S LEFT 1
	MOVEI	AC1,RRBITS	;GET NUMBER OF INTERESTING BITS ON LEFT
	SUB	AC1,AC3		;CALC BUCKET PAIR POSITION
	CAILE	AC1,RR.NUM	;LS= UPPER BOUND?
	MOVEI	AC1,RR.NUM	;NO, MAKE IT UPPER BOUND
	JUMPGE	AC1,.+2		;SKIP IF GTR= ZERO
	SETZ	AC1,		;MAKE ZERO
	MRTMS.	(AC3)		;START RERUN TIMING
	LSH	AC1,1		;MULTILY BY 2 (COUNTING TIMING BKTS)
	L.METR	(MB.RRN(AC1),AC16) ;SET RERUN METER POINT
>;END IFN LSTATS
	JRST	CKRRN2

CKRRN1:	SKIPL	REDMP.		;SKIP IF A FORCED DUMP
	POPJ	PP,		; NEITHER DUMP RETURN NOW

CKRRN2:	PUSHJ	PP,RRDMP	;DUMP
	PUSHJ	PP,RSAREN	;RESTORE .JBSA, .JBREN
	MRTME.	(AC1)		;END RERUN METER TIMING
	POPJ	PP,		; ALL DONE, RETURN
WOVLER:	HRRZM	AC2,.JBFF	;GET JOBFF OUT OF OVL-AREA
	POP	PP,(PP)		;MAKE THE STACK RIGHT SO
	POP	PP,(PP)		;WE CAN RETURN TO CBL-PRG
	JRST	WOVLR2

WOVLR1:	EXCH	AC5,.JBFF	;MOVE JOBFF
	SUBM	AC5,.JBFF	;BACK OUT OF OVL-AREA
WOVLR2:	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	MOVEI	AC0,^D35	;ERROR-NUMBER
	PUSHJ	PP,OXITP	;RETURNS TO CBL-PRG IF IGNORING ERRORS
WOVLRX:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Not enough free core between .JBFF and overlay area./]
WOVLRY:	MOVE	AC2,[BYTE (5)10,31,20,21,4]
	TXNN	AC16,V%READ	;GET THE RIGHT MESSAGE
	MOVE	AC2,[BYTE (5)10,31,20,22,4]
	TXNE	AC16,V%OPEN	;OPEN VERB?
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	JRST	MSOUT.		;MESSAGE AND KILL

WCORER:	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	HRRZM	AC2,.JBFF	;BACK OUT OF OVERLAY AREA
	MOVEI	AC0,^D8		;ERROR NUMBER
	PUSHJ	PP,OXITP	;RETURNS FOR FATAL MESS
	PUSHJ	PP,GETSP9	;GIVE MESSAGE
	JRST	WOVLRY		;AND KILL
	;PAD THE LOGICAL BLOCK IF NECESSARY.
WRTR14:	PUSH	PP,AC2		;SAVE PAD BUFF COUNT
	TXNN	AC16,V%READ	;SKIP IF READ
	JRST	WRTR17		;A WRITE
	PUSHJ	PP,READBF	;INPUT A BUF AND SKIP EXIT
	SETZM	D.IBC(I16)	;REMEMBER THAT IT'S EMPTY
	JRST	WRTR18		;[343]

WRTR17:	TLNN	FLG,DDMBIN	;[343] IF BINNARY LET NXT WRITE/CLOSE OUTPUT IT
	PUSHJ	PP,WRTBUF	;[343] OUTPUT A BUF
WRTR18:	POP	PP,AC2		; RESTORE PAD BUFF COUNT
	TLZE	FLG,ATEND	;[343] EOF?
	JRST	WRTR10		;GIVE HIM THE REC AND LET NXT READ GET EOF
	JRST	WRTRE9		;RETURN

	;WRITE OUT A BINARY RECORD

WRTR20:	SKIPG	D.OBC(I16)	;IF BUFFER IS FULL,
	PUSHJ	PP,WRTBUF	;  WRITE IT OUT
	MOVE	AC11,AC3	;GET RECORD SIZE IN BYTES
	LDB	AC12,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC12,RBPTBL(AC12) ; GET CHARS PER WORD
	ADDI	AC11,-1(AC12)	;CONVERT SIZE TO WORDS AND
	IDIVI	AC11,(AC12)	;  ROUND UP

	HRL	AC5,FLG		;MOVING FROM RECORD AREA
WRTR21:	HRR	AC5,D.OBB(I16)	;MOVING TO BUFFER
	ADDI	AC5,1		;  PLUS ONE WORD
	MOVE	AC4,AC11	;IF NOT
	CAMLE	AC4,D.OBC(I16)	;  ENOUGH WORDS IN BUFFER,
	MOVE	AC4,D.OBC(I16)	;  WE WILL DO A PARTIAL MOVE NOW
	ADDM	AC4,D.OBB(I16)	;BUMP BUFFER WORD ADDRESS
	MOVN	AC12,AC4	;DECREMENT
	ADDM	AC12,D.OBC(I16)	;  BUFFER COUNT
	ADD	AC11,AC12	;  AND NUMBER RECORDS WORDS LEFT
	MOVS	AC12,AC5	;REMEMBER NEXT 'FROM',
	ADD	AC12,AC4	;  IT MAY BE NEEDED

	ADDI	AC4,(AC5)	;COMPUTE FINAL DESTINATION ADDRESS, PLUS 1
	BLT	AC5,-1(AC4)	;BLAT!!

	JUMPLE	AC11,WRTR22	;IF NO MORE TO DO, QUIT
	MOVSI	AC5,(AC12)	;NEW 'FROM' ADDRESS
	PUSHJ	PP,WRTBUF	;WRITE OUT THE BUFFER
	JRST	WRTR21		;LOOP FOR NEXT PIECE OF RECORD

WRTR22:	MOVE	AC2,D.RCL(I16)	;[343] IF THIS IS THE LAST RECORD
	CAIN	AC2,1		;[343]  IN THIS LOGICAL BLOCK
	SETZM	D.OBC(I16)	;[343]  NOTE THAT THE BUFFER IS FULL
	JRST	WRTRE7		;GO HOME
	; HERE TO WRITE OUT AN EBCDIC FILE

WER:	MOVE	AC10,D.WCNV(I16)	; GET CONVERSION INSTRUCTION
	LDB	AC3,WOPRS.		; GET RECORD SIZE
	SKIPL	D.F1(I16)		; VARIABLE LENGTH RECORDS?
	JRST	WEF1			; NO - FIXED LENGTH

	;WILL THE RECORD FIT IN THE CURRENT LOGICAL BLOCK?
	LDB	AC1,F.BBKF	; ONLY BLOCKED FILES HAVE A BDW
	JUMPE	AC1,WEV3	; JUMP IF UNBLOCKED FILE
	MOVE	AC1,D.FCPL(I16)	; GET NUMBER OF FREE BYTES LEFT
	CAIGE	AC1,4(AC3)	; WILL IT FIT?
	PUSHJ	PP,WELB		; NO - WRITE LAST BUFFER
	CAME	AC1,D.TCPL(I16)	; IS THIS FIRST RECORD IN LOG-BLK?
	TDZA	C,C		; NO
	SETO	C,		; YES
	SUBI	AC1,4(AC3)	; UPDATE THE CHAR-COUNT
	MOVEM	AC1,D.FCPL(I16)	; FREE CHARS PER LOG-BLOCK

	;UPDATE THE BLOCK-DESCRIPTOR-WORD (BDW)
	TXNN	AC13,DV.MTA	; SKIP IF A MTA
	JRST	WEV2		; JUMP IF NOT
	HRRZ	AC1,D.OBH(I16)	; POINTS TO CURRENT BUFFER
	HRLZI	AC2,4(AC3)	; GET THE RECORD SIZE + RDW
	JUMPE	C,WEV1		; JUMP IF NOT FIRST RECORD
	HRLZI	AC2,4+4(AC3)	; REC-SIZE +4 FOR RDW +4 FOR BDW
	MOVNI	AC0,4		; UPDATE THE BYTE-COUNT
	ADDM	AC0,D.OBC(I16)	; YES - DOIT
	AOSA	AC5,D.OBB(I16)	; UPDATE THE BYTE POINTER
WEV1:	MOVE	AC5,D.OBB(I16)	; DO WE HAVE 8 OR 9 BIT BYTES?
	TLNN	AC5,000100	; IF 8 BIT BYTES
	LSH	AC2,2		; MOVE BDW OVER 2 BITS
	ADDM	AC2,2(AC1)	; ADD THIS RECORD SIZE TO BDW
	JRST	WEV3		;

WEV2:	JUMPE	C,WEV3		; JUMP IF NOT FIRST REC IN BLOCK
	HRRZ	C,D.TCPL(I16)	; GET TOTAL CHARS PER LOG-BLK
	HRRZI	C,4(C)		; PLUS 4 FOR BDW
	PUSHJ	PP,WEDW		; MAKE A BDW

	;POINT AC5 AT RECORD-DESCRIPTOR-WORD (RDW)
	; PUT THE RDW INTO THE BUFFER
WEV3:	MOVEI	C,4(AC3)	; GET REC-SIZE TO C
	PUSHJ	PP,WEDW		; GO MAKE A RDW
	MOVE	AC5,D.OBB(I16)	; GET BYTE POINTER

	;NOW MOVE THE RECORD TO THE BUFFER
WEV4:	SOSGE	D.OBC(I16)	; BUFFER FULL?
	PUSHJ	PP,WEBF		; YES
	ILDB	C,AC6		; GET CHAR FROM RECORD AREA
	XCT	AC10		; CONVERT IF NECESSARY
	IDPB	C,AC5		; PUT IN BUFFER
	SOJG	AC3,WEV4	; LOOP TIL DONE

	MOVEM	AC5,D.OBB(I16)	; RESTORE BYTE POINTER
	JRST	WRTR10		; DONE

	; MOVE FIXED LENGTH RECORD TO BUFFER
WEF1:	TLNE	FLG1,MSTNDR	; LABELED TAPE?
	PUSHJ	PP,PADLAB	; YES,GO SET FOR PADDING
WEF1A:	ILDB	C,AC6		; GET CHAR FROM RECORD AREA
	XCT	AC10		; CONVERT IF NECESSARY
	IDPB	C,D.OBB(I16)	; PUT IN BUFFER
	SOSG	D.OBC(I16)	; BUFFER FULL?
	PUSHJ	PP,WRTBUF	; YES
	SOJG	AC3,WEF1A	; LOOP TIL DONE
	TLNE	FLG1,MSTNDR	; WAS THAT LABELED TAPE?
	PUSHJ	PP,LABPAD	; YES, DO ANY PADDING INDICATED BY STACK
	JRST	WRTRE7		; DONE


	; THE CURRENT RECORD WONT FIT SO FINISH OFF THIS LOGICAL BLOCK
WELB:	PUSHJ	PP,WRTOUT	; DUMP THE BUFFER
	SOSLE	D.BCL(I16)	; ANY EMPTY BUFFERS TO GO OUT?
	JRST	WELB		; YES
	MOVE	AC1,D.BPL(I16)	; GET BUFFERS PER LOG-BLOCK
	MOVEM	AC1,D.BCL(I16)	; BUFFERS PER CURRENT LOG-BLOCK
	MOVE	AC1,D.TCPL(I16)	; TOTAL CHARS PER LOG-BLOCK
	MOVEM	AC1,D.FCPL(I16)	; FREE CHARS PER LOG-BLOCK
	POPJ	PP,		;

	; WRITE OUT THE CURRENT BUFFER
WEBF:	MOVEM	AC5,D.OBB(I16)	; RESTORE THE BYTE-PTR
WEBF1:	PUSHJ	PP,WRTOUT	; WRITE IT
	MOVE	AC5,D.OBB(I16)	; GET BYTE-PTR
	SOS	D.BCL(I16)	; DECREMENT BUFFERS PER CURRENT LOG-BLOCK
	SOS	D.OBC(I16)	; DECREMENT CHAR-COUNT
	POPJ	PP,		;

	;WRITE A DESCRIPTOR WORD, BDW OR RDW
WEDW:	LDB	AC2,[POINT 6,D.OBB(I16),11] ; GET THE BYTE SIZE
	MOVN	AC1,AC2		; AC1 SHIFT RIGHT - AC2 .. LEFT
	ROT	C,(AC1)		; GET THE HI ORDER BITS
	PUSHJ	PP,WECH		; STOW IT
	ROT	C,(AC2)		; GET LO ORDER BITS
	PUSHJ	PP,WECH		; STOW IT
	SETZ	C,		; GET A NULL
	PUSHJ	PP,WECH		; STOW IT

	;WRITE AN EBCDIC CHARACTER
WECH:	SOSGE	D.OBC(I16)	; BUFFER FULL?
	PUSHJ	PP,WEBF1	; DUMP IT
	IDPB	C,D.OBB(I16)	; DUMP THE CHAR
	POPJ	PP,		; RETURN
	;WRITE AND READ SETUP.  ***POPJ***

WRTSUP:	MOVE	AC13,D.DC(I16)	;DEVICE CHARACTERISTICS
	MOVE	FLG,F.WFLG(I16)	;FLAGS,,RECORD LOCATION
	HLLZ	FLG1,D.F1(I16)	;MORE FLAGS
	PUSHJ	PP,SETCN.	;SET THE IO CHANNEL NUMBER
	LDB	AC3,F.BMRS	;FILE TABLE MAX REC SIZE
	LDB	AC6,[POINT 2,FLG,14]	; GET CORE DATA MODE
	MOVE	AC6,RBPTB1(AC6)	; GET BYTE-POINTER TO RECORD AREA
	HRR	AC6,FLG		; RECORD ADR
	POPJ	PP,		;

	;LEFT HALF IS BYTE-PTR TO RECORD AREA
	;RIGHT HALF IS CHARS PER WORD
RBPTBL:	POINT 7,5(FLG)		; ASCII
	POINT 9,4(FLG)		; EBCDIC
	POINT 6,6(FLG)		; SIXBIT

	;LEFT IS BYTE-PTR TO RECORD AREA
	;RIGHT IS BYTES PER WORD IN SYM-KEY
RBPTB1:	POINT 7,	6	; ASCII	SIXBIT
	POINT 9,	4	; EBCDIC	EBCDIC
	POINT 6,	5	; SIXBIT	ASCII

	;SETUP THE CONVERSION INST IN AC10 

WRTXCT:	JUMPL	FLG,WRTXC1		;JUMP IF ASCII DEV
	SKIPA	AC10,[MOVS C,CHTAB(C)]	;ASCII TO SIXBIT
WRTXC1:	MOVE	AC10,[ADDI C,40]	;SIXBIT TO ASCII
	TLNN	FLG,CONNEC		;
	HRLZI	AC10,(TRN)		;ASCII TO ASCII
	POPJ	PP,			;
	;ADVANCING IS DONE HERE.  ***POPJ***

WRTADV:	TLCE	AC15,WDVBFR	;WRTADV	OPERAND
	POPJ	PP,		; NOT THIS TIME, RETURN
	TLNE	AC15,WDVPOS	; POSITIONING?
	JRST	WAD1		; YES

	HRRZ	AC4,AC15	; GET CHAR CNT
	TLNN	AC15,WDVADR	; IS THIS REALLY AN ADR?
	JRST	WAD0X		; NO
	CAIE	AC4,-1		; YES, IS THIS REALLY THE DEFAULT
				; ADVANCING CASE????
	JRST	WAD0		; NO
	HRRZ	AC4,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNE	AC4,SASCII	; SKIP IF NOT STANDARD ASCII
 	POPJ	PP,		; IFSO, RETURN, DEFAULT STD-ASCII IS 0
	MOVEI	AC4,1		; ELSE , DEFAULT IS ADVANCING 1
	JRST	WAD0Y		; THEN CONTINUE TO ADVANCE


WAD0:	HRRZ	AC4,(AC15)	; GET COUNT FROM ADDRESS

WAD0X:	
WAD0Y:	LDB	C,WOPCN		; GET CHANNEL NUMBER
IFN ANS74,<
	JUMPN	C,WAD2		;GIVE UP IF NOT JUST LINE FEED
	SKIPE	F.LCP(I16)	;DO WE HAVE LINAGE STUFF?
	MOVEI	C,5		;YES, USE DC3 INSTEAD
>
	JRST	WAD2		;

WAD1:	MOVEI	AC4,1		; ASSUME ONE CHAR TO OUTPUT
	LDB	C,[POINT 7,(AC15),35]	;[500] ONLY TAKE NEEDED CHAR
	CAIL	C,"1"		; IS CHAR "1"
	CAILE	C,"8"		; THRU "8"
	JRST	.+3		; NO
	TRZ	C,777770	; CONVERT TO BINARY
	JRST	WAD2		;
	CAIN	C,"+"		;
	POPJ	PP,		; "+" = NO POSITIONING
	CAIN	C,"0"		;
	MOVEI	AC4,2		; "0" = TWO "LF"
	CAIN	C,"-"		;
	MOVEI	AC4,3		; "-" = THREE "LF"
	SETZ	C,		; GET A "LF"

WAD2:	TLNE	FLG,RANFIL+IOFIL ;[622] SKIP IF NOT A DUMP MODE FILE
	JRST	WAD3		;
	SKIPE	NOCR.		;[WADV] SKIP IF  WRITE CR
	JRST	WAD22A		;[WADV] ELSE DON'T
	PUSH	PP,C		; SAVE WADV CHANNEL
	PUSHJ	PP,WRTCR	;[WADV] OK,WRITE ONE
	POP	PP,C		; RESTORE WADV CHANNEL
	SETOM	NOCR.		;[WADV] INDICATE IT WAS DONE
WAD22A:				;[WADV]

	; IF ADVANCING 0, JUST WRITE CR

	JUMPE	AC4,RET.1	; IF CNT = 0 JUST RETURN

IFN ANS74,<
	SKIPN	F.LCP(I16)	;LINAGE-COUNTER?
	JRST	WAD2C		;NO
	CAIN	C,1		;YES, IS IT PAGE?
	JRST	WAD2P		;YES
	PUSH	PP,C
	PUSH	PP,AC4		;NEED 2 ACS
	ADDB	AC4,F.LCP(I16)	;INCREMENT BY NO. OF LINES
	HLRZ	C,F.LPP(I16)	;GET LINES PER PAGE
	CAIG	AC4,(C)		;OVERFLOW?
	JRST	WAD2A		;NO
	AOS	-2(PP)		;GIVE SKIP RETURN
WAD2D:	MOVEI	AC4,1		;YES
	MOVEM	AC4,F.LCP(I16)	; RESET IT TO 1
	HRRZ	AC4,F.LAB(I16)	;LINES AT BOTTOM?
	JUMPE	AC4,WAD2E	;NO
	PUSHJ	PP,WRTDC3	;YES
	SOJG	AC4,.-1		;LOOP
WAD2E:	MOVE	C,-1(PP)
	MOVE	AC4,0(PP)	;RESTORE ACCS, BUT LEAVE ON STACK
	PUSHJ	PP,WAD2C	;OUTPUT ADVANCING CHAR.
	HRRZ	AC4,F.LCI(I16)	;NEED TO INITIALIZE FOR NEXT PAGE
	JUMPE	AC4,WAD2F	;NO
	PUSHJ	PP,SAVAC.	;SAVE THE CURRENT ACCS
	PUSHJ	PP,(AC4)	;GO TO USER ROUTINE
	PUSHJ	PP,RSTAC.	;RESTORE STATE
WAD2F:	HLRZ	AC4,F.LAT(I16)	;LINES AT TOP?
	JUMPE	AC4,WAD2G	;NO
	PUSHJ	PP,WRTDC3	;YES
	SOJG	AC4,.-1		;LOOP
WAD2G:	POP	PP,AC4
	POP	PP,C
	POPJ	PP,

WAD2P:	HLRZ	AC4,F.LPP(I16)	;GET LINES PER PAGE
	SUB	AC4,F.LCP(I16)	;CURRENT COUNT
	ADDI	AC4,1		;ONE FOR THIS ADVANCING
	MOVEI	C,5		;DC3
	PUSH	PP,C
	PUSH	PP,AC4
	JRST	WAD2D		;OUTPUT SOME BLANK LINES + BOTTOM AND TOP OF PAGE

WAD2A:	HRRZ	C,F.WFA(I16)	;GET FOOTING LIMIT
	JUMPE	C,WAD2B		;NO LIMIT
	CAIL	AC4,(C)		;DID WE OVERFLOW INTO FOOTING?
	AOS	-2(PP)		;YES, GIVE ERROR RETURN (BUT DON'T RESET COUNT)
WAD2B:	POP	PP,AC4
	POP	PP,C
WAD2C:>
	MOVE	C,WADTBL(C)	; GET CHAR FROM TABLE
	PUSHJ	PP,WRTCH	;
	SOJG	AC4,.-1		;
	POPJ	PP,		;

WAD3:	SKIPE	NOCR.		;[WADV] SKIP IF MUST START WITH CR
	JRST	WAD3A		;[WADV] ELSE GO ON
	PUSH	PP,C		; SAV WADV CHANNEL
	PUSHJ	PP,RANCR	;[WADV] WRITE ONE
	POP	PP,C		; RESTORE WADV CHANNEL
	SETOM	NOCR.		;[WADV] INDICATE IT WAS WRITTEN
WAD3A:				;[WADV]
	MOVE	C,WADTBL(C)	; GET CHAR FROM TABLE
	IDPB	C,AC5		;AC5 BYTE-PTR. TO RANDOM BUFFER AREA
	SOJG	AC4,.-1		;
	POPJ	PP,		;

	;	CHAR		CHANNEL NUMBER
WADTBL:	EXP	$LF		;	8
	EXP	$FF		;	1
	EXP	$DLE		;	2
	EXP	$DC1		;	3
	EXP	$DC2		;	4
	EXP	$DC3		;	5
	EXP	$DC4		;	6
	EXP	$VT		;	7

IFN ANS74,<
WRTDC3:	PUSHJ	PP,WRTCR	;CR
	MOVEI	C,$DC3		;DC3
	JRST	WRTCH		;WRITE AND RETURN
>
WRTLF:	SKIPA	C,WADTBL	;"LF"
WRTCR:	MOVEI	C,$CR		;"CR"
;[R672]	WRTCH:	SOSL	D.OBC(I16)	;[655]SKIP IF YOU CAN
;[R672]		JRST	WRTCH1		;[655] OVER THE PUSHJ
;[R672]		PUSHJ	PP,WRTBUF	;[655]WRITE OUT THE BUFFER
;[R672]		SOS	D.OBC(I16)	;[655]ADJUST COUNT FOR THIS BYTE
;[R672]	WRTCH1:	IDPB	C,D.OBB(I16)	;[655]BYTE IN A CHARACTER
;[R672]		POPJ	PP,		;[655]AND RETURN
WRTCH:	IDPB	C,D.OBB(I16)	;[672] TO THE BUFFER
	SOSLE	D.OBC(I16)	;[672] SKIP IF FULL
	POPJ	PP,		;[672] OR RETURN
WRTBUF:	PUSHJ	PP,WRTOUT
	SOS	D.BCL(I16)	;BUFFER PER LOGICAL BLOCK
	POPJ	PP,

	;SEE IF ZERO LEN RECORD IS LEGAL
WRTZRE:	SKIPE	NOCR.		;
	JRST	WRTRE2		;A WAY TO GET ONLY PAPER-ADVANCING-CHARS
	MOVEI	AC0,^D23	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	WRTRE6		;YES
	OUTSTR	[ASCIZ /Zero length records are illegal.
/]
	MOVE	AC2,[BYTE (5)10,31,20,22,4]
	JRST	KILL
	;BLT RECORD AREA TO THE BUFFER/S

WRTRB:	HRLZ	AC5,FLG		;RECORD AREA I.E. "FROM"
WRTRB1:	MOVE	AC11,AC3	;SETUP FOR THE "UNTIL"
	SUB	AC3,D.OBC(I16)	;REC-SIZE MINUS BYTE-COUNT
	JUMPGE	AC3,WRTRB2	;JUMP, USE ALL OF CURRENT BUFFER
	MOVN	AC3,AC11	;SO WE CAN ADJ THE BYTE-COUNT
	JRST	WRTRB3		;PROCEED
WRTRB2:	MOVE	AC11,D.OBC(I16)	;BYTE-COUNT
	SETZM	D.OBC(I16)	;ZERO THE BYTE COUNT
WRTRB3:	IDIVI	AC11,6		;CONVERT TO WORDS
	MOVE	AC2,AC12	;SAVE FOR ZERO FILL
	JUMPE	AC12,WRTRB4	;CHECK THE REMAINDER
	ADDI	AC11,1		;ADJ IF THERE WAS ONE
	SUBI	AC12,6		;NEGATE TRAILING NULL BYTES
WRTRB4:	SKIPE	D.OBC(I16)	;SKIP IF BUFFER IS FULL
	ADD	AC12,AC3	;ADD IN THE REC-SIZE
	ADDM	AC12,D.OBC(I16)	;SUBTRACT FROM THE BYTE-COUNT
	HRR	AC5,D.OBB(I16)	;"TO" ADDRESS
	HRRZ	AC4,AC5		;
	ADDI	AC4,-1(AC11)	;"UNTIL" ADDRESS
	HLRZ	AC12,AC5	;SAVE ORIGIN
	ADDM	AC12,AC11	;NEXT ORIGIN
	BLT	AC5,(AC4)	;SHAZAM!
	HRL	AC5,AC11	;NEXT "FROM" ADR
	HRLI	AC4,600		;NO MORE BYTES THIS WORD
	MOVEM	AC4,D.OBB(I16)	;
	SKIPLE	D.OBC(I16)	;XIT IF U CAN
	JRST	WRTRB5		;EXIT
	PUSHJ	PP,WRTBUF	;ADVANCE TO NEXT BUFFER
	JUMPLE	AC3,WRTRB5	;EXIT IF DONE
	PUSHJ	PP,WRTABP	;ADJ THE BYTE-PTR
	JRST	WRTRB1		;LOOP TILL ALL IS BLT'ED

WRTRB5:	JUMPE	AC2,WRTRE7	;EXIT IF NO NO FILL REQUIRED
	IMULI	AC2,-6		;ZERO FILL THE LAST WORD
	SETO	AC0,		;--
	LSH	AC0,(AC2)	;--
	ANDCAM	AC0,(AC4)	;DOIT
	JRST	WRTRE7		;EXIT
	;ADJUST THE BYTE-POINTER TO POINT TO NON-EX BYTE LEFT OF NEXT WORD

WRTABP:	SKIPGE	AC1,D.OBB(I16)	;
	POPJ	PP,		;
	TLZ	AC1,770000	;
	ADD	AC1,[POINT ,1]	;
	MOVEM	AC1,D.OBB(I16)	;
	POPJ	PP,		;

ERROPN: AOS	(PP)		;REWRITE-WRITE-DELETE
	MOVEI	AC0,^D22	;THE "OUTPUT" MESSAGE
	TRNA
ERROP1: MOVEI	AC0,^D34	;THE "INPUT" MESS
	SETOM	FS.IF		;IDX FILE
	TLNE	FLG,IDXFIL	;ISAM FILE?
	ADD	AC0,[E.FIDX]	;YES
	SETZ	AC2,
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 POPJ	PP,		;YES, TAKE A NORMAL EXIT
	MOVE	AC2,[BYTE (5)10,31,20,6,14]
	PUSHJ	PP,MSOUT.	;"FILE IS NOT OPEN"
	HRLZI	AC2,(BYTE (5)7) ;"FOR INPUT"
	TXNN	AC16,V%READ	;SKIP IF ATTEMPT TO READ
	HRLZI	AC2,(BYTE (5)11);"FOR OUTPUT"
	PUSHJ	PP,MSOUT.

ERRMR0:	SKIPA	AC3,AC0		;ISAM FILE
ERRMR1:	MOVE	AC2,AC0		;IO OR RANDOM FILE
	TRNA
ERRMR2:	EXCH	AC3,AC4		;SEQUENTIAL FILE
	PUSH	PP,AC0		;SAVE MAX-REC-SIZE
	MOVEI	AC0,^D6		;THE ERROR NUMBER
	TLNE	FLG,IDXFIL	;ISAM FILE?
	ADD	AC0,[E.FIDA]	;YES
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	ERRMRX		;YES

ERRMRS:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /The maximum record size may not be exceeded./]
ERRMR:	TXNE	AC16,V%READ	;SKIP IF OUTPUT FILE
	SKIPA	AC2,[BYTE (5)10,31,20,21,4]
	MOVE	AC2,[BYTE (5)10,31,20,22,4]
	JRST	MSOUT.		;CANNOT DO OUTPUT (OR INPUT)

ERRMRX:	POP	PP,AC0		;RESTORE MAX-REC-SIZE
	POPJ	PP,
SUBTTL	READ VERB

	;A READ VERB LOOKS LIKE:
	;FLAGS,,ADR	WHERE ADR = FILE TABLE ADDRESS
	;CALL+1:	NORMAL RETURN
	;CALL+2:	"AT-END" OR "INVALID-KEY" RETURN

RDNXT.:	TXO	AC16,V%RNXT	;[-74] TURN ON READ NEXT FLAG
READ.:	MRTMS.			;START LIBOL METER TIMING
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.RD	; YES
IFN ISTKS,<JRST FAKER1>
FAKER.:
IFN ISTKS,<HLRZ I12,D.BL(I16)
	   AOS OUTSSS+15(I12)
FAKER1:>
	TXO	AC16,V%READ	; ENTRY POINT FOR FAKE READ
	HLRZ	AC12,D.BL(I16)
	MOVE	AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
	BLT	AC0,FS.IF	;   STATUS WORDS.
	PUSHJ	PP,WRTSUP	;SETUP
	TLNE	FLG,NOTPRS	;JUMP IF OPTIONAL AND NOT PRESENT
	JRST	RERE7		;
	TLNN	FLG,OPNIN	;SKIP IF OPEN FOR INPUT
	JRST	ERROP1		;
	TLNE	FLG,ATEND	;SKIP IF NOT "AT END"
	JRST	REAAEE		;"FILENM IS AT END" STOPR.
	MOVE	AC10,D.RCNV(I16);SETUP AC10
IFN ISAM,<
	TLNE	FLG,IDXFIL	;INDEX FILE?
	JRST	IREAD		;YES
>
	TLNE	FLG,RANFIL+IOFIL ;[622] SKIP IF NOT RANDOM OR I/O
	JRST	RANDOM		;RANDOM AND IO EXIT HERE
	TLNE	FLG,DDMEBC	;EBCDIC?
	JRST	RER		;  USE EBCDIC ROUTINE
	JUMPL	FLG,READ4	;JUMP IT'S ASCII

	TLNE	FLG,DDMBIN	;IF BINARY,
	JRST	READ10		;  USE THIS ROUTINE
	;PICKUP REC-SIZE (FIRST WORD) AND CHECK AGAINST MAX-REC-SIZE.

	MOVE	AC4,D.IBC(I16)	;INPUT BYTE COUNT
	CAILE	AC4,1		;SKIP IF THE BUFFER IS EMPTY
	JRST	READ3		;
READ2:	PUSHJ	PP,READBF	;  FILL IT.
	TLNE	FLG,CONNEC	;SKIP IF WE'RE BLT'ING THE RECORD
	AOS	D.IBC(I16)	;SO THE  BYTE COUNT WILL BE RIGHT
READ21:	LDB	AC3,F.BMRS	;RESTORE AC3
	TLNE	FLG,ATEND	;CHECK FOR END-OF-FILE
	JRST	READEF		;TAKE A SKIP EXIT TO THE "ACP"
READ3:	PUSHJ	PP,REAABP	;ADJUST THE BYTE-POINTER
	AOS	D.IBB(I16)	;DONT OVERWRITE REC-SIZE
	TXNN	AC13,DV.MTA	;MTA?
	JRST	READ31		;NO
	HLRZ	AC4,(AC1)	;GET RECORD SEQUENCE NUMBER
	JUMPE	AC4,READ31	;JUMP IF NO RSN
	HRRZ	AC0,D.RP(I16)	;GET RECORD COUNT
	CAME	AC4,AC0		;OK?
	JRST	REALR		;NO - LOST OR GAINED A RECORD
READ31:	HRRZ	AC4,(AC1)	;INCASE ITSA ASCII DATA WRD & NOT 6BIT CHR-CNT
	CAML	AC3,AC4		;[613] SKIP IF MAX RECORD SIZE IS EXCEEDED
	JRST	RED31A		;[613] ELSE OK, CONTINUE
	PUSHJ	PP,ERRMR2	;ERROR MESSAGE

	;[613] PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;[613] IS LARGER THAN FD MAXIMUM

	OUTSTR	[ASCIZ/%Record length field larger than FD maximum,assuming max.
/]
	; AC4 LOADED WITH MAX SIZE IN ERRMR2


RED31A:	MOVEM	AC4,RELEN.	;[613][332] FOR STAND ALONE SORT
	MOVEM	AC4,D.CLRR(I16)	;[545] SAVE THE CHARACTER COUNT
	HRRZ	AC3,AC4		;MOVE IT INTO AC3
	MOVN	AC4,D.BPW(I16)	;CPW
	ADDB	AC4,D.IBC(I16)	;SUB FROM THE BYTE COUNT
	JUMPE	AC3,READ32	;ZERO LENGTH RECORD
	TLNE	FLG,CONNEC	;SKIP IF CONVERSION IS NOT NECESSARY
	JRST	READ4		;NEED TO CONVERT
	JUMPN	AC4,REABR	;GO BLT
	PUSHJ	PP,READBF	;ADVANCE THE BUFFER FIRST
	PUSHJ	PP,REAABP	;ADJ THE BYTE-PTR
	TLNN	FLG,ATEND	;CHECK FOR EOF
	JRST	REABR		;THEN GO BLT
	JRST	REAAE1		;ERROR MESSAGE
	;HERE TO READ AHEAD TO FIND NEXT NON-0-LENGTH RECORD
	;IF NOT FOUND TAKE THE ATEND PATH

READ32:	LDB	AC4,F.BBKF	;SKIP THE FOLLOWING TEST IF
	JUMPE	AC4,READ34	;  BLOCKING-FACTOR IS ZERO
	SOSE	D.RCL(I16)	;  OR IF THERE ARE MORE RECORDS IN
	JRST	READ34		;  THIS LOGICAL-BLOCK
	MOVEM	AC4,D.RCL(I16)	;RESTORE # OF RECORDS IN CURRENT LOGICAL-BLOCK
	SKIPLE	AC4,D.BCL(I16)	;IGNORE ANY TRAILING BUFFERS IN THIS
READ33:	PUSHJ	PP,READBF	;  LOGICAL-BLOCK
	SETZM	D.IBC(I16)	;DECLARE HIS BUFFER EMPTY
	TLZN	FLG,ATEND	;LET THE NEXT RECORD GET THE "EOF"
	SOJG	AC4,READ33	;PASS ALL OF THIS LOGICAL-BLOCK
	MOVE	AC4,D.BPL(I16)	;RESTORE THE POINTERS
	MOVEM	AC4,D.BCL(I16)	;  BUFFERS PER CURRENT LOGICAL-BLOCK

READ34:	MOVE	AC4,D.IBC(I16)	;IF THE
	CAILE	AC4,1		;  BUFFER
	JRST	READ35		;  IS EMPTY
	PUSHJ	PP,READBF	;  FILL IT.
	TLNE	FLG,CONNEC	;MAKE THE BYTE-COUNT RIGHT IF
	AOS	D.IBC(I16)	;  RECORD IS TO BE BLT'ED
	TLNE	FLG,ATEND	;EOF MEANS TAKE
	JRST	READEF		;  ATEND PATH
READ35:	PUSHJ	PP,REAABP	;ADJUST THE BYTE-POINTER
	HRRZ	AC3,(AC1)	;GET THE RECORD SIZE
	JUMPN	AC3,READ21	;EXIT HERE IF N0N-0-LENGTH RECORD
	AOS	D.IBB(I16)	;ACCOUNT FOR THE
	MOVN	AC4,D.BPW(I16)	;  HEADER
	ADDM	AC4,D.IBC(I16)	;  WORD
	JRST	READ32		;LOOP TIL EOF OR N0N-0-LENGTH RECORD
	;PASS LEADING "EOL" CHARACTERS.
READ4:	SETZ	AC5,		; [577] CLEAR AC5, INDICATING NOT MTA EOR
READ4A:	SOSG	D.IBC(I16)	; SKIP IF CHAR IN BUFFER
	PUSHJ	PP,READBF	; ELSE GET ANOTHER BUFFER
	TLNE	FLG,ATEND	;SKIP IF NOT "EOF"
	JRST	READEF		;"AT-END" BUT DONT INC REC COUNT
	ILDB	C,D.IBB(I16)	; GET THE CHAR
IFN BLANKL, <
	CAIN	C,15		;[1126] Is it a carriage return?
	JRST	READ5A		;[1126] Yes, make a blank record
>; [1126]
	XCT	AC10		;CONVERT IF NECESSARY
IFE SIRUS, <	JUMPLE	C,READ4A	;JUMP IF EOL CHAR OR NULL>
	MOVE	AC5,AC3		;SAVE ACTUAL RECORD SIZE FOR ZERO FILL
	MOVEM	AC5,RELEN.	;[332] INITIAL RELEASE SIZE
	MOVEM	AC5,D.CLRR(I16)	;[545] SAVE THE CHARACTER COUNT INCASE TOO BIG
IFN SIRUS,<	JUMPL	C,READ5A	; [403] EMPTY RECORD-TREAT AS ALL BLANKS >

	;LOAD THE RECORD AREA FROM THE BUFFER.

READ5:	IDPB	C,AC6		;
	SOJE	AC3,READ51	;DECREMENT REC SIZE
	PUSHJ	PP,READCH	;
	TLNE	FLG,ATEND	;SKIP IF NOT "EOF"
	JRST	REAAE1		;MESS AND KILL
	XCT	AC10		;CONVERT IF NECESSARY
	JUMPGE	C,READ5		;JUMP IF NON EOL CHAR
READ5A:	EXCH	AC5,RELEN.	;[332]CORRECT RELEASE SIZE
	SUBI	AC5,(AC3)	;[332]
	MOVEM	AC5,D.CLRR(I16)	;[545] SAVE THE CHARACTER COUNT
	EXCH	AC5,RELEN.	;[332]
IFN SIRUS,<
	PUSHJ	PP,READ52	; [403] FILL OUT REST OF REC WITH SPACES
	JRST	READ8		; [403] FINISHED
>
READ52:	MOVEI	C," "		;ASCII SPACE
	TLNE	FLG,CDMSIX	; [640] SIXBIT?
	SETZ	C,		; [640] SIXBIT SPACE
	TLNE	FLG,CDMEBC	; [640]EBCDIC?
	MOVEI	C,100		; [640]EBCDIC SPACE
	IDPB	C,AC6		;TRAILING SPACES
	SOJG	AC3,.-1		;FILL OUT THE RECORD WITH SPACES
IFE SIRUS,<	JRST	READ8	; [403] >
IFN SIRUS,<	POPJ	PP,	; [403] FINISHED >

READ51:	LDB	AC3,F.BMRS	;GET MAX RECORD SIZE
	SUB	AC3,AC5		;NUMBER OF ZEROS TO FILL
IFE SIRUS,<	JUMPG	AC3,READ52	;DOIT >
IFN SIRUS,<	JUMPLE	AC3,READ6	; [403] GO LOOK FOR EOL
	PUSHJ	PP,READ52	; [403] FILL  BLANKS
>
	;RECORD IS FULL.  PASS CHAR TILL AN "EOL" CHAR IS ENCOUNTERED.

READ6:	JUMPGE	FLG,READ7	;JUMP SIXBIT HAS NO "EOL"
	HRRZ	AC0,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNE	AC0,SASCII	; SKIP IF NOT STANDARD ASCII
	JRST	READ8		; ELSE CONT, ASSUME NO CR-LF FOR 
				; STD-ASCII
	LDB	AC0,F.BBKF	; GET BLOCKING FACTOR
	JUMPE	AC0,READ6A	; JUMP IF NOT A BLOCKED FILE
	MOVE	AC0,D.RCL(I16)	; GET THE RECS LEFT IN LOG-BLK
	SOJLE	AC0,READ8	; AND QUIT IF THIS IS LAST 


READ6A:	SOSG	D.IBC(I16)	; DECREMENT BYTE COUNT,SKIP IF BUFFER EMPTY
;BL	JRST	READ8		; ALL DONE IN BUFFER, CONT
	PUSHJ	PP,READBF	;BL; GET ANOTHER BUFFER
	TLZE	FLG,ATEND	;BL;EOF?
	JRST	READ8A		; CHECK OUT
	ILDB	C,D.IBB(I16)	; RETURN A CHAR IN C
	JUMPE	C,READ6A	; SKIP NULL
	XCT	AC10		; CONVERT IF INDICATED
;	INSERTED AT READ6A+9
;BL	JUMPL	C,READ8		; END SCAN IF EOR CHAR
	JUMPL	C,READ7		; END SCAN & CHECK END OF WORD
	JRST	READ6A		; ELSE CONT SCAN FOR EOR CHAR

;BL	THIS IS TO COUNT UNUSED SIXBIT-BYTES AT END OF RECORD

READ7:	JUMPL	FLG,READ8	;JUMP IF ASCII DEV
READ7A:	MOVE	AC1,D.IBB(I16)	;INPUT BYTE POINTER
	TLNN	AC1,770000	;ANY BYTES LEFT?
	JRST	READ8		; NO
	IBP	D.IBB(I16)	; YES, STEP ALONG
	SOS	D.IBC(I16)	;  & COUNT DOWN
	JRST	READ7A		;   RETRY

	; HERE IF GOT EOF WHEN SCANNING AHEAD FOR EOR

READ8A:	TXNE	AC13,DV.MTA	; MTA?
	XCT	MBSPR.		; YES, BACK UP SO ANOTHER READ WILL GET IT

READ8:	PUSHJ	PP,WRTRE7	;UPDATE DEVTAB, RERUN DUMP, ETC
	  TRN			;
	MOVE	AC1,RELEN.	;[332] CONVERT RELEN. TO WRDS
	MOVEI	AC3,6		;[332] FOR SIXBIT
	TLNE	FLG,CDMASC	; [406] UNLESS INTERNAL RECORD IS ASCII.
	MOVEI	AC3,5		;[322] USE 5 CHARS/WD
	ADDI	AC1,-1(AC3)	;[322] FOR ROUNDING
	IDIVI	AC1,(AC3)	;[332]
	MOVEM	AC1,RELEN.	;[332] PUT IT AWAY
	MOVEM	FLG,F.WFLG(I16)	; 
	POPJ	PP,		; EXIT TO THE ***"ACP"***
	;READ A BINARY RECORD

READ10:	SKIPLE	AC4,D.IBC(I16)	;IF BUFFER NOT EMPTY
	JRST	READ11		;  DON'T NEED ANOTHER
	PUSHJ	PP,READBF	;GET ANOTHER BUFFER FULL
	TLNE	FLG,ATEND	;IF NO MORE,
	JRST	READEF		;  WE ARE AT END

READ11:	LDB	AC11,F.BMRS	;GET RECORD SIZE IN BYTES
	MOVEM	AC11,D.CLRR(I16) ;SAVE LENGTH OF REC READ
	MOVEI	AC12,6		;ASSUME DATA RECORD IS SIXBIT
	TLNE	FLG,CDMASC	;IS IT ACTUALLY ASCII?
	MOVEI	AC12,5		;YES--5 BYTES PER WORD
	TLNE	FLG,CDMEBC	;[555] IS IT EBCDIC?
	MOVEI	AC12,4		;[555] YES--4 BYTES PER WORD
	ADDI	AC11,-1(AC12)	;CONVERT TO
	IDIVI	AC11,(AC12)	;  WORDS AND ROUND UP

	HRR	AC5,FLG		;DESTINATION IS RECORD AREA
READ12:	MOVE	AC4,D.IBB(I16)	;MOVING FROM BUFFER WORD
	HRLI	AC5,1(AC4)	;  PLUS 1
	MOVE	AC4,AC11	;IF SIZE IS
	CAMLE	AC4,D.IBC(I16)	;  MORE THAN THAT LEFT IN BUFFER,
	MOVE	AC4,D.IBC(I16)	;  USE ALL WORDS IN BUFFER
	ADDM	AC4,D.IBB(I16)	;BUMP BUFFER WORD ADDRESS
	MOVN	AC12,AC4	;DECREMENT
	ADDM	AC12,D.IBC(I16)	;  BUFFER COUNT
	ADD	AC11,AC12	;  AND WORDS LEFT IN RECORD

	ADDI	AC4,(AC5)	;COMPUTE FINAL DESTINATION PLUS 1
	BLT	AC5,-1(AC4)	;BLAT!!

	JUMPLE	AC11,READ8	;IF ENTIRE RECORD MOVED, WE'RE DONE
	MOVEI	AC5,(AC4)	;NEW DESTINATION ADDRESS
	PUSHJ	PP,READBF	;GET ANOTHER BUFFER FULL
	TLZN	FLG,ATEND	;IF NOT AT END,
	JRST	READ12		;  LOOP

	SETZM	D.IBC(I16)	;FORCE READ NEXT TIME
READ13:	SETZM	(AC5)		;FILL
	SOJLE	AC11,READ8	;  REST OF RECORD
	AOJA	AC5,READ13	;  WITH ZEROES
	;READ AN EBCDIC RECORD
RER:	MOVE	AC4,AC3		; GET REC-SIZE FOR FIXED LEN-RECS
	HLLZ	FLG1,D.F1(I16)	; GET THE VLREBC FLAG

	; IF EBCDIC LABELED, NON-"U" FORMAT, GET A BUFFER FULL
	; IN THIS CASE EACH INPUT WILL GET ON LOG-RECORD

IFN TOPS20,<

	TLNN	FLG1,MSTNDR	; SKIP IF SYS-LABELED
	JRST	RER01		; ELSE CONT
	LDB	AC1,F.BLBU	; GET FORMAT FLAG BIT
	JUMPN	AC1,RER01	; IF "U" THEN CONT

	; HERE IF EBCDIC NON=U FORMAT SYSTEM-LABELED TAPE

	PUSHJ	PP,RER20	; DO AN INPUT, SHOULD READ ONE RECORD
	 JRST	READEF		; EOF RETURN
	JUMPGE	FLG1,RER7	; JUMP IF FIXED FORMAT
	MOVE	AC4,D.IBC(I16)	; FOR VAR-LEN RESET REC SIZE TO BE INPUT SIZE
	JRST	RER6		; CHECK REC LENGTH AND CONT


>;END IFN TOPS20

RER01:	LDB	AC1,F.BBKF	; GET THE BLOCKING FACTOR
	JUMPL	FLG1,RER1	; JUMP IF VARIABLE LEN-RECS
	JUMPE	AC1,RER7	; JUMP IF UNBLOCKED FIXED-LEN-RECS
	SOS	AC1,D.RCL(I16)	; ANY MORE FIXED-LEN-RECS IN THIS BLOCK?
	JUMPGE	AC1,RER7	; JUMP IF THERE ARE
	PUSHJ	PP,RER2		; GET ANOTHER LOG-BLK
	 JRST	READEF		; EOF RETURN
	JRST	RER7		; AND CONT

RER1:	JUMPE	AC1,RER3	; JUMP IF UNBLOCKED - NO BDW
	SKIPLE	AC1,D.FCPL(I16)	; ANY RECORDS IN THIS LOG-BLOCK?
	JRST	RER3		; COULD BE, GO SEE
RER10:	PUSHJ	PP,RER2		; NO, GET ANOTHER LOG-BLK
	 JRST	READEF		; EOF RETURN

	;NOW GET THE BLOCK-DESCRIPTOR-WORD
	PUSHJ	PP,REDW		; GET A BDW
	 JRST	READEF		; EOF RETURN
	SUBI	AC4,4		; IS LOGIGAL-BLOCK EMPTY?
	JUMPLE	AC4,RERE1	; YES - ERROR
	MOVEM	AC4,D.FCPL(I16)	; AND SAVE IT AWAY

	;NOW GET THE RECORD DESCRIPTOR WORD
RER3:	PUSHJ	PP,REDW		; GET A RDW
	 JRST	READEF		; EOF RETURN
	SUBI	AC4,4		; SUBTRACT OUT 4 FOR RDW

	;NOW SEE IF WE GOT A LEGAL RECORD
	LDB	AC1,F.BBKF	; IF BLOCKING-FACTOR IS 0,
	JUMPN	AC1,RER5	; JUMP IF A BLOCKED FILE

	;FILE IS UNBLOCKED
	JUMPG	AC4,RER6	; GET RECORD IF SIZE GT 0
	PUSHJ	PP,READBF	; NO RECORD - MUST BE EOF
	TLNN	FLG,ATEND	; IS IT?
	JRST	RERE2		; NO! - SO ERROR
	JRST	READEF		; YES - TAKE ATEND PATH

; RER2		ROUTINE TO GET NEXT LOG-BLK FOR EBCDIC SEQ FILE
;
; RETURNS	+1 IF EOF ENCOUNTERED
;		+2 IF OK, NEW LOG-BLK READ

	;PASS OVER CURRENT LOGICAL BLOCK AND GET NEXT

RER2:	SKIPLE	AC1,D.BCL(I16)	; ANY BUFFERS LEFT FOR THIS LOG-BLOCK?
RER21:	PUSHJ	PP,READBF	; PASS OVER THE EMTPY BUFFERS
	TLNE	FLG,ATEND	; END-OF-FILE?
	POPJ	PP,		; EOF,RETURN
	SOJG	AC1,RER21	; GET THEM ALL
	MOVE	AC1,D.BPL(I16)	; BUFFERS PER LOG-BLOCK
	MOVEM	AC1,D.BCL(I16)	; BUFFERS PER CURRENT LOG-BLOCK
RER20:	PUSHJ	PP,READBF	; NOW GET THE NEXT RECORD
	TLNE	FLG,ATEND	; END-OF-FILE?
	POPJ	PP,		; EOF,RETURN
	LDB	AC1,F.BBKF	; GET BLOCKING FACTOR
	SUBI	AC1,1		; DECREMENT IT FOR THE CURRENT RECORD
	MOVEM	AC1,D.RCL(I16)	; SAVE AS RECORDS/LOG-BLOCK
	MOVE	AC5,D.IBB(I16)	; SET BYTE-PTR TO AC5
	JRST	RET.2		; OK, SKIP RETURN

	;FILE IS BLOCKED
RER5:	JUMPLE	AC4,RER10	; IF LOG-BLOCK IS EMPTY GET NEXT ONE
	MOVNI	AC0,4(AC4)	; SUBTRACT RDW FROM
	ADDB	AC0,D.FCPL(I16)	; "FREE CHARS PER LOGICAL-BLOCK"
	JUMPL	AC0,RERE3	; ERROR IF REC GT SIZE OF LOG-BLOCK
RER6:	CAMG	AC4,AC3		;[613] WILL IT FIT IN RECORD AREA?
	JRST	RER7		;[613] YES, CONTINUE
	PUSHJ	PP,ERRMR2	; NO - COMPLAIN

	;[613] PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;[613] IS LARGER THAN FD MAXIMUM

	OUTSTR	[ASCIZ/%Record length field larger than FD maximum,assuming max.
/]
	; AC4 LOADED WITH MAX SIZE IN ERRMR2



	;MOVE THE RECORD INTO THE RECORD AREA
RER7:	SETZ	AC0,		; CLEAR NULL CHAR COUNT
	MOVEM	AC4,D.CLRR(I16)	;[545] SAVE THE CHARACTER COUNT
RER71:	SOSL	D.IBC(I16)	; ANY CHARS AVAILABLE?
	JRST	RER74		; YES
	PUSH	PP,AC0		; [607] NO, SAVE NULL CHAR COUNT
	PUSHJ	PP,READBF	; GET ANOTHER BUFFER
IFN TOPS20,<
	TLNN	FLG1,MSTNDR	; IS TAPE SYS-LABELED?
	JRST	RER71A		; NO,JUMP
	LDB	AC1,F.BLBU	; GET FORMAT FLAG BIT
	JUMPN	AC1,RER71A	; JUMP IF "U" 
	MOVE	AC4,D.IBC(I16)	; ELSE, RESET RECORD LENGTH
	MOVEM	AC4,D.CLRR(I16)	; HERE TOO
>;END IFN TOPS20

RER71A:	POP	PP,AC0		; [607] RESTORE NULL CHAR COUNT
	TLNN	FLG,ATEND	; END-OF-FILE?
	JRST	RER73		; NO
	JUMPGE	FLG1,READEF	; YEP - ITSA EOF
	JRST	RERE4		; VAR-LEN-REC, COULD BE AN ERROR
RER73:
;[607]	SETZ	AC0,		; CLEAR NULL CHAR COUNT
	SOS	D.IBC(I16)	; DECREMENT THE BYTE-COUNT
RER74:	ILDB	C,D.IBB(I16)	;[435] GET CHAR
	JUMPN	C,RER75		; EXIT IF NON-NULL
	ADDI	AC0,1		; COUNT THE NULLS
	SOJG	AC4,RER71	;[435] LOOP FOR A RECORD

	;GOT A NULL RECORD

	HRRZ	AC4,D.RFLG(I16)	; GET SOME FLAGS
	TXNN	AC4,RDDREV	; READ REVERSE OPEN ACTIVE?
	JRST	RER74A		; NO CONT
	SOS	D.RP(I16)	; DECREMENT REC COUNT	
	JRST	RER74B		; CONT

RER74A:	AOS	D.RP(I16)	; COUNT THE RECORD
RER74B:	LDB	AC4,F.BMRS	; RESTORE RECORD SIZE
	JRST	RER		; AND TRY FOR THE NEXT ONE

	;GOT A NON-NULL CHAR SO RESTORE THE NULLS IF ANY
RER75:	JUMPE	AC0,RER82	; EXIT HERE IF NO NULLS AT ALL
	SETZ	C,		; MAKE A NULL
	XCT	AC10		; CONVERT IT
	IDPB	C,AC6		; RESTORE IT
	SOJG	AC0,.-1		; LOOP
	LDB	C,D.IBB(I16)	;[435] REGET THE LAST CHAR.
	JRST	RER82		; OFF TO MAIN LOOP

RER8:	SOSL	D.IBC(I16)	; ANY CHARS LEFT?
	JRST	RER81		; YES
	PUSHJ	PP,READBF	; NO - GET ANOTHER BUFFER
	TLNE	FLG,ATEND	; END-OF-FILE?
	JRST	RERE4		; YEP - COULD BE AN ERROR
	SOS	D.IBC(I16)	; DECREMENT THE BYTE-COUNT
RER81:	ILDB	C,D.IBB(I16)	;[435] GET CHAR.
RER82:	XCT	AC10		; CONVERT
	IDPB	C,AC6		; PUT CHAR
	SOJG	AC4,RER8	; LOOP

	JRST	WRTR10		; GO HOME

	;GET A CHARACTER
RECH:	SOSL	D.IBC(I16)	; [435] BUFFER EMPTY?
	JRST	RECH1		; [435] NO.
	PUSHJ	PP,READBF	; [435] YES, GO FILL IT.
	SOS	D.IBC(I16)	; [435] KEEP THE CHAR COUNT RIGHT.
RECH1:	ILDB	C,D.IBB(I16)	; [435] GET CHAR
	TLNN	FLG,ATEND	; EOF?
	AOSA	(PP)		; NO - SKIP RETURN
	SETZ	C,		; YES - RETURN A NULL
	POPJ	PP,		;

	;READ A DISCRIPTOR WORD, BDW OR RDW
REDW:	MOVE	AC4,D.IBC(I16)	; IF BYTE-COUNT LE 3 AND
	CAILE	AC4,3		; THIS LAST BUFFER OF LOGICAL BLOCK
	JRST	REDW1		; THEN THE BYTE-CNT MAY REALLY
	LDB	AC4,F.BBKF	; BE A ZERO. THE MONITOR FORCES THE
	SKIPN	D.BCL(I16)	; BYTE-CNT FOR BINNARY MODE TO BE
	JUMPN	AC4,REDWX	; AN INTEGRAL NUMBER OF WORDS

REDW1:	PUSHJ	PP,RECH		; GET A CHAR
	 POPJ	PP,		; END-OF-FILE RETURN
	MOVE	AC4,C		; INTO AC4
	LDB	AC2,[POINT 6,D.IBB(I16),11] ; GET BYTE SIZE
	LSH	AC4,(AC2)	; MAKE ROOM FOR NEXT BYTE
	PUSHJ	PP,RECH		; GET CHAR
	 JUMPE	AC4,RET.1	; EOF RETURN
	IOR	AC4,C		; THE ?DW IS NOW IN AC4
	PUSHJ	PP,RECH		; SKIP OVER THE NEXT TWO CHARS
	 JUMPN	AC4,RERE0	; COMPLAIN IF EOF AND DATA
	TRNE	C,777677	;[476] IF NOT BLANK (100) OR ZERO (0)
	PUSHJ	PP,RERE6	; ERROR
	PUSHJ	PP,RECH		; SKIP LAST CHAR
	 JUMPN	AC4,RERE0	; COMPLAIN IF EOF AND DATA
	TRNE	C,777677	;[476] IF NOT BLANK (100) OR ZERO (0)
	PUSHJ	PP,RERE6	; ERROR
	JRST	RET.2		; NORMAL EXIT

	;HERE WHEN BYTE-CNT WAS WRONG, SHLD HAVE BEEN 0
REDWX:	SETZB	AC4,D.IBC(I16)	; ?DW IS 0 AND BUFFER IS EMPTY!
	JRST	RET.2		;

	;HERE IF GOT SOME DATA AND EOF INSTEAD OF ?DW
RERE0:	MOVEI	AC0,^D39	; YES GIVE AN ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 POPJ	PP,		; YES - EOF RETURN
	OUTSTR	[ASCIZ "Got an EOF in middle of block/record descriptor word."]
	JRST	ERRMR		; ERROR MESS AND KILL

	;ERROR BDW = 4 OR LESS
RERE1:	MOVEI	AC0,^D40	; GIVE AN ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	RER10		; YES - GET NEXT LOG-BLOCK
	OUTSTR	[ASCIZ /Block descriptor word byte count is less than five./]
	JRST	ERRMR		; ERROR MESSAGE AND KILL

	;ERROR - RDW LE 0 AND WE GOT ANOTHER BUFFER OF WHAT?
RERE2:	MOVEI	AC0,^D41	; GIVE AN ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	READEF		; YES - TAKE END-OF-FILE RETURN
	OUTSTR	[ASCIZ /Error - got another buffer instead of "EOF"./]
	JRST	ERRMR		; ERROR MESSAGE AND KILL

	;ERROR - RDW PUTS END OF RECORD BEYOND D.FCPL
RERE3:	MOVEI	AC0,^D42	; GIVE AN ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	RER6		; YES - GIVE HIM "RECORD" ANYHOW
 	OUTSTR	[ASCIZ /Error record extends beyond the end of the logical block./]
	JRST	ERRMR		; ERROR MESSAGE AND KILL

	;GOT AN EOF IN MIDDLE OF A RECORD
RERE4:	CAMN	AC3,AC4		; ANY NON-NULL CHARACTERS SEEN?
	JRST	READEF		; NO - GIVE ATEND RETURN
	JRST	REAAE1		; YEP - ERROR

	;BUFFER REC SIZE DIFFERS FROM THE ONE HE'S TRYING TO WRITE
RERE5:	MOVEI	AC1,4(AC3)	; IN CASE HE IGNORES THE ERROR
	MOVEI	AC0,^D43	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	RNER32		; YEP
	OUTSTR	[ASCIZ /It is illegal to change the record size of an EBCDIC IO record./]
	JRST	ERRMR		;

	;ONE OF THE TWO LOW ORDER B/RDW BYTES IS NON-ZERO (SPANNED RECORDS?)
RERE6:	MOVEI	AC0,^D44	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 POPJ	PP,		; YES
	OUTSTR	[ASCIZ "
?The two low order bytes of RDW/BDW must be zero, SPANNED EBCDIC not supported."]
	JRST	ERRMR		; NO, COMPLAIN

	;HERE IF FILE OPTIONAL AND NOT PRESENT

RERE7:	TLOE	FLG,ATEND	;SET "AT END" PATH TAKEN
	JRST	REAAEE		;FATAL THE SECOND TIME
	MOVEM	FLG,F.WFLG(I16)	;SAVE FLG
	PUSHJ	PP,ENDSTS	;SET FILE STATUS TO 10
	JRST	RET.2		;SKIP EXIT
RNULER:	SKIPE	AC0,D.LBN(I16)	; GET LAST BLK NUMBER,IF THERE IS ONE
	CAME	AC0,D.CBN(I16)	; SKIP IF LAST BLOCK
	JRST	RNRNUA		; NO(T) LAST BLOCK,ERROR
	SETZM	R.WRIT(I12)	; ZERO THE WRITE FLAG
	TLO	FLG,ATEND	; SET ATEND FLAG
	JRST	RANXI0		; TAKE ATEND RETURN

RNRNUA:	OUTSTR	[ASCIZ/Read null record within V format sequential file.
/]
	JRST	ERRMR		; EXIT WITH ERROR
	;READ AN "EOF".  TAKE "AT-END" PATH.  ***POPJ***

READEF:	PUSHJ	PP,ENDSTS	;[601]SET ATEND STATUS
	MOVEM	FLG,F.WFLG(I16)	;SAVE THE FLAG REGISTER
	LDB	AC5,F.BPMT	;FILE TABLE - FILE POSITION
	JUMPN	AC5,RET.2	;SKIP EXIT TO THE ***"ACP"***
	HLLZ	FLG1,D.F1(I16)	;FLAGS
	TXNE	AC13,DV.MTA	;SKIP IF  NOT A MTA,ETC.
	TLNN	FLG1,STNDRD	;SKIP IF STANDARD LABELS
	JRST	RET.2		;SKIP EXIT TO THE ***"ACP"***
	PUSHJ	PP,CLSRL	;READ IN THE LABEL
	XCT	MBSPR.		;BACK OVER THE LABEL
	PUSHJ	PP,CLSEOV	;CHECK FOR "EOV"
	  JRST	READE1		;OK
	JRST	RET.2		;SKIP EXIT TO ***ACP***

READE1:	PUSHJ	PP,CLRSTS	;[601]CLEAR FILE STATUS
	HRLI	AC16,440	;CLOSE REEL
	PUSHJ	PP,C.CLOS	;A READ GENERATED CLOSE
	HRLI	AC16,2100	;READ
	TLZ	FLG,ATEND	;TURN OFF THE EOF FLAG
	MOVEM	FLG,F.WFLG(I16)	;   ALSO IN THE FILE TABLE
	JRST	READ.		;TRY AGAIN

	;READ A CHARACTER.  IGNORE ASCII NULLS.  ***POPJ***

;[577]	HAM	7-JUN-79
;[577]	THE FOLLOWING KLUDGE CHECKS FOR THE NO CRFL AT END OF MTA
;[577]	RECORD. IN CASE WHEN THIS IS DETECTED, A SIMPLE RETURN TO CALLER 
;[577]	IS MADE. THIS ASSUMES THAT THIS CASE WILL ONLY OCCUR AFTER
;[577]	THE ACTUAL RECORD BODY HAS BEEN READ IN, AND THAT THE SEARCH FOR
;[577]	'EOL' CHARS IS ON. THUS ONLY AT THE RETURN FROM READCH AT READ7:
;[577]	IS THE CHECK FOR THIS CASE MADE.
;[577]	AC5 NEGATIVE INDICATES THE MTA EOR CASE

; [12-B] REMOVED MTA BLOCK-1 CASE, TAKEN CARE OF FOR GENERAL CASE


READCH:	SOSLE	D.IBC(I16)	;[577] DECREMENT BYTE COUNT,SKIP IF BUFFER EMPTY
	JRST	REDCHB		;[577] GO ON IF MORE DATA IN BUFFER

	; DON'T GET ANOTHER BUFFER IF ASCII END OF LOGICAL BLOCK

REDCHA:	JUMPGE	FLG,REDCHC	; CONTINUE IF NOT ASCII
	LDB	C,F.BBKF	; GET BLOCKING FACTOR
	JUMPE	C,REDCHC	; CONTINUE IF UNBLOCKED
	SKIPE	D.BCL(I16)	; SKIP IF NO BUFFERS IN CURRENT LOG-BLK
	JRST	REDCHC		; ELSE CONTINUE
	MOVEI	C,$CR		; INDICATE END OF RECORD
	POPJ	PP,		; AND RETURN

REDCHC:	PUSHJ	PP,READBF	;[577] INPUT IF YOU MUST
	TLNE	FLG,ATEND	;[577] SKIP IF NOT AT END  ("EOF") 
	POPJ	PP,		;
REDCHB:	ILDB	C,D.IBB(I16)	;RETURN WITH A CHAR IN C
IFE SIRUS,<
	SKIPN	C		;SKIP IF NOT A NULL CHAR
	JUMPL	FLG,READCH	;IGNORE IT IF IT IS A ASCII NULL
	POPJ	PP,		;
	>
IFN SIRUS,<
	JUMPGE	FLG,READCX	; [403] IF NOT ASCII FILE RETURN
	SKIPE	C		; [403] OTHER WISE SKIP NULLS
	CAIN	C,$CR		; [403] OR <CR>
	JRST READCH		; [403]
READCX:	POPJ	PP,		; [403] RETURN
	>

READBF:	PUSHJ	PP,READIN	;GET A BUFFER
	  TRN
	SOS	D.BCL(I16)	;DECREMENT BUF/LOGBU
	POPJ	PP,		;
	;BLT BUFFER/S TO THE RECORD AREA

REABR:	HRR	AC5,FLG		;RECORD AREA  I.E. "TO"
	MOVE	AC0,AC3		;SAVE ACTUAL RECORD SIZE
REABR1:	MOVE	AC11,AC3	;SETUP FOR THE "UNTIL"
	SUB	AC3,D.IBC(I16)	;REC-SIZE MINUS BYTE-COUNT
	JUMPGE	AC3,REABR2	;JUMP, USE ALL OF CURRENT BUFFER
	MOVN	AC3,AC11	;SO WE CAN ADJ THE BYTE-COUNT
	JRST	REABR3		;

REABR2:	MOVE	AC11,D.IBC(I16)	;BYTE-COUNT
	SETZM	D.IBC(I16)	;NOTE THE BUFFER IS EMPTY
REABR3:	IDIVI	AC11,6		;CONVERT TO WORDS
	JUMPE	AC12,REABR4	;CHECK THE REMAINDER
	ADDI	AC11,1		;ADJ WRDCNT IF THERE WAS ONE
	SUBI	AC12,6		;NEGATE TRAILING NULL BYTES
REABR4:	SKIPE	D.IBC(I16)	;SKIP IF THE BUFFER IS EMPTY
	ADD	AC12,AC3	;ADD IN THE REC-SIZE
	ADDM	AC12,D.IBC(I16)	;SUBTRACT FROM THE BYTE-COUNT
	HRL	AC5,D.IBB(I16)	;"FROM"
	HRRZ	AC4,AC5		;
	ADDI	AC4,-1(AC11)	;"UNTIL"
	BLT	AC5,(AC4)	;SLURP P P !!
	HRRI	AC5,1(AC4)	;NEW "TO"
	ADDM	AC11,D.IBB(I16)	;RESTORE THE BYTE-POINTER
	SKIPLE	D.IBC(I16)		;READ8 IF YOU CAN
	JRST	REABR5		;EXIT
	JUMPLE	AC3,REABR5	;EXIT IF ALL WAS BLT'ED
	PUSHJ	PP,READBF	;ADVANCE TO NEXT BUFFER
	PUSHJ	PP,REAABP	;ADJ BYTE-PTR
	TLNN	FLG,ATEND	;SKIP IF "EOF" WAS SEEN
	JRST	REABR1		;LOOP
REABR5:	ADDI	AC0,5		;ACTUAL SIZE
	LDB	AC2,F.BMRS	;MAX SIZE
	ADDI	AC2,5		;ROUND UP
	CAMN	AC0,AC2		;IF THE SAME
	JRST	READ8		;  EXIT
	IDIVI	AC0,6		;CONVERT TO
	IDIVI	AC2,6		;  WORDS
	SUB	AC2,AC0		;NUMBER OF WORDS TO ZERO FILL
	JUMPE	AC2,READ8	;EXIT IF NONE
REABR6:	SETZM	1(AC4)
	SOJLE	AC2,READ8
	AOJA	AC4,REABR6
REAAE1:	MOVEI	AC0,^D25	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 POPJ	PP,		;YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ/Encountered an "EOF" in the middle of a record./]
	JRST	REAAE0		;AT END ERROR

REAAEE:	SETOM	FS.IF		;IDX FILE
	MOVEI	AC0,^D24	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	RET.2		;YES
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /The AT END path has been taken./]
REAAE0:	MOVE	AC2,[BYTE (5)10,31,20,21]
	PUSHJ	PP,MSOUT.	;KILL

	;HERE IF RECORD SEQUENCE NUMBER FOUND IN LEFT SIDE OF MTA SIXBIT
	;HEADER-WORD IS NOT EQUAL TO RECORD COUNT IN FILE TABLE
	;NOTE. COUNT STARTS AT ZERO
REALR:	SKIPN	AC5,D.EXOF(I16)	; GET OPEN EXTEND RECORD SEQ OFFSET
	JRST	REALR1		; JUMP IF NONE SET, CHECK FOR FIRST EXT REC
	ADDI	AC4,(AC5)	; ADD EXTEND OFFSET TO REC SEQ NUM
	CAIE	AC0,(AC4)	; SKIP IF OK WITH OFFSET
	JRST	REALR2		; ELSE ERROR
	JRST	READ31		; OPN EXT  SECTION OK, CONT

	; CHECK FOR READ REVERSED, AND IF FIRST REC READ REV, RESET D.RP

REALR1:	HRRZ	AC2,D.RFLG(I16)	; GET SOME FLAGS
	TRNN	AC2,RDDREV	; READ REVERSE OPEN ACTIVE?
	JRST	RELR1A		; NO CONT
	CAIE	AC0,-1		; IS REC NUMBER -1?
	JRST	RELR1B		; NO, CHECK FOR FIRST REC

	; IF REC COUNT = -1 CHECK FOR HDR LABEL

IFE TOPS20,<

	HRRZ	AC2,D.IBH(I16)	; GET BUFF HEADER ADDR
	HLRZ	AC0,(AC2)	; GET BUFF SIZE
	TRZ	AC0,400000	; TURN OFF "X" BIT
	HRRZ	AC2,1(AC2)	; GET WORD COUNT 
	SUBI	AC0,1(AC2)	; CALC POSITION TO FIRST WORD
				; SUB EXTRA 1 FOR BUF SIZ EXTRA
	ADD	AC1,AC0		; UPDATE POINTER
	ADDM	AC0,D.IBB(I16)	; AND IN FILTAB TOO

>; END IFE TOPS20

	MOVE	AC0,(AC1)	; GET THE FIRST WORD AGAIN
	TRZ	AC0,7777	;
	CAME	AC0,[SIXBIT/HDR1/] ; IS THIS HDR1 LABEL?
	JRST	REALR2		; NO, THEN ERROR
	PUSHJ	PP,READBF	; READ AGAIN, SHOULD GET ATEND.	
	TLNN	FLG,ATEND	;SKIP IF "EOF" WAS SEEN
	JRST 	REALR2		; NO ERROR, NOT WHAT WE THOUGHT
	JRST	READEF		; YES ATEND, ALL OK , GO SET IT

RELR1B:	SOJG	AC0,REALR2	; JUMP IF NOT FIRST RECORD READ
	MOVEM	AC4,D.RP(I16)	; ELSE RESET REC COUNT TO COUNT BACK
	JRST	READ31		; AND CONT

RELR1A:	SOJN	AC4,REALR2	; JUMP IF NOT REC NUM 1
	SUBI	AC0,1		; ELSE SAVE THE OFFSET TO BEGINING
	MOVEM	AC0,D.EXOF(I16)	; OF THE EXTENDED RECORD SET
	JRST	READ31		; TRY AGAIN

REALR2:	MOVEI	AC0,^D26	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	READ31		;YES TRY TO RETURN WHAT YOU GOT
	OUTSTR	[ASCIZ /record-sequence-number /]
	HRLO	AC12,AC4	;RSN
	PUSHJ	PP,PPOUT4	;TYPE IT
	OUTSTR	[ASCIZ / should be /]
	HRLO	AC12,D.RP(I16)	;RECORD COUNT
	PUSHJ	PP,PPOUT4	;TYPE IT
	JRST	REAAE0		;FINISH UP MESSAGE

	;ADJUST BYTE-POINTER TO NON-EX BYTE LEFT OF NEXT WORD

REAABP:	SKIPGE	AC1,D.IBB(I16)	;
	POPJ	PP,		;
	TLZ	AC1,770000	;
	ADD	AC1,[POINT ,1]	;
	MOVEM	AC1,D.IBB(I16)	;
	POPJ	PP,		;

	;SETUP AC10 WITH CONVERSION INST.  ***POPJ***

REAXCT:	TLNE	FLG,DDMBIN	;IF BINARY,
	JRST	REAXC2		;  NO CONVERSION
	JUMPL	FLG,REAXC1	;JUMP IF DEV IS ASCII
	MOVE	AC10,[ADDI C,40]	;ASCII TO SIXBIT
	TLNE	FLG,CDMSIX		;SKIP IF CORE-DATA-MODE IS NOT SIXBIT
REAXC2:	MOVSI	AC10,(TRN)		;6BIT T0 6BIT (LABELS)
	POPJ	PP,			;

REAXC1:	MOVE	AC10,[MOVE C,CHTAB(C)]	;ASCII TO ASCII
	TLNE	FLG,CDMSIX		;
	TLO	AC10,4000		;SIXBIT TO ASCII  (MOVE TO MOVS)
	POPJ	PP,
SUBTTL	START VERB

	;A START VERB LOOKS LIKE:
	;MOVE	16,[FLAGS,,<FILE TABLE ADDRESS>]
	;MOVEI	1,<SIZE OF APPROXIMATE KEY>	;OPTIONAL
	;PUSHJ	17,C.STRT
	;RETURN+1		NORMAL RETURN
	;RETURN+2		"INVALID KEY" RETURN

	;FLAGS ARE:
	;STA%AP		APPROXIMATE KEY (SIZE IN 1(16))
	;STA%EQ		EQUAL TO (BITS 0 IF THIS)
	;STA%NL		NOT LESS THAN
	;STA%GT		GREATER THAN

;THE APPROXIMATE KEY SIZE IS STORED IN F.AKS(I16)

C.STRT:	TXO	AC16,V%STRT	;SET FAKE READ BIT
	TXNE	AC16,STA%AP	;IF APPROXIMATE KEY
	MOVEM	AC1,F.AKS(I16)	;PUT SIZE IN A SAFE PLACE
IFN LSTATS,<
	SETZ	AC1,		;ASSUME = TEST
	TXNE	AC16,STA%GT	;IS IT .GT. TEST ?
	AOJA	AC1,.+3		;YES,INDICATE AND GO
	TXNE	AC16,STA%NL	;IS IT .GE. TEST ?
	MOVEI	AC1,2		;YES, MARK THIS 
	LSH	AC1,1		;MULTIPLY BY 2
	L.METR	(MB.STE(AC1),AC16) ;METER THE START MARKED BY AC1
				;START METER TIMING BEGINS IN READ
>;END IFN LSTATS
	JRST	READ.		;AND DO FAKE READ

STRT.0:	TXNN	AC16,STA%EQ	;TEST FOR =
	JRST	STRT.I		;YES, FAIL FIRST TIME
	HRRZ	AC1,F.RACK(I16)	;GET POINTER TO RELATIVE KEY
	JUMPE	AC1,STRT.I	;NO KEY
	AOS	(AC1)		;INCREMENT
	JRST	RANDOM		;TRY AGAIN

STRT.I:	PUSHJ	PP,NRESTS	; SET REC NOT FOUND (23)
	JRST	RET.2		;AND GIVE ERROR RETURN
SUBTTL	RANDOM/IO-STUFF
	;RANDOM AND IO READ AND WRITE ENTER HERE FROM READ. OR WRITE.
	;	DUMP MODE POINTERS
	;(I12)R.IOWD	DUMP MODE IOWD
	;(I12)R.TERM	TERMINATOR
	;(I12)R.BPNR	BYTE-POINTER TO NEXT RECORD
	;(I12)R.BPLR	BYTE-POINTER TO LAST RECORD
	;(I12)R.BPFR	BYTE POINTER TO FIRST RECORD
	;(I12)+5	NOT USED
	;(I12)R.DATA	-1 IF ACTIVE DATA IN BUFFER
	;(I12)R.WRIT	-1 IF LAST UUO WAS A WRITE
	;(I12)R.FLMT	AOBJ PTR TO FILE LIMITS
	;(I12)R.DLRW	BLK NUMBER SAVED BEFORE DEL/REWRT (74)

	;CHECK THE FILE-LIMITS, READ IN THE LOGICAL BLOCK, AND
	;POINT AT THE RECORD.  ***WRTRE7***

RANDOM:	SETZ	AC4,		; [431] ASSUME ACTUAL KEY IS ZERO
	HLLZ	FLG1,D.F1(I16)	;GET FLAGS
	HLRZ	I12,D.BL(I16)	;POINTER TO DUMP MODE POINTERS
	TLNN	FLG,RANFIL	;SKIP IF NOT SEQIO
	JRST	SEQIO		;
IFN ANS68,<
	PUSHJ	PP,FLIMIT	;CHECK ACTUAL KEY VS. FILE LIMITS
>
IFN ANS74,<
	PUSHJ	PP,SETKEY	;SET AND CHECK RELATIVE KEY
>

; THE FOLLOWING CALCULATES THE DISTANCE BETWEEN RANDOM I/O
;REQUESTS AND INCREMENTS THE APPROPRIATE BUCKET.

IFN LSTATS,<
	JUMPE	AC4,RDKYDX	;SKIP ALL THIS IF KEY ZERO
	MOVE	AC1,AC4		;GET KEY
	SUB	AC1,D.RP(I16)	;GET DISTANCE FROM CURRENT RECORD
	MOVEI	AC2,3		;ASSUME DIST. SMALL POS.
	JUMPL	AC1,RDKYD0	;SKIP AHEAD IF NEG DISTANCE
	CAIGE	AC1,^D100	;DIST. LS 100?
	JRST	RDKYD2		;YES,GO CHECK 0-99 RANGE
	CAIL	AC1,^D1000	;DIST. GTR= 1000?
	ADDI	AC2,1		;YES,INCREMENT TO GET 5
	ADDI	AC2,1		;NO, INCREMENT TO GET 4
	JRST	RDKYD1		;GO COUNT BUCKET
RDKYD0:	MOVN	AC1,AC1		;MAKE POS
	CAIG	AC1,^D100	;DIST FARTHER THAN 100?
	SOJA	AC2,RDKYD1	;NO,INDICATE OFFSET 2 AND GO BUCKET
	CAILE	AC1,^D1000	;DIST FARTHER THAN 1000?
	SUBI	AC2,1		;YES,SUB TO GET 0 OFFSET
	SUBI	AC2,2		;NO,SUB TO GET 1 OFFSET
RDKYD1:	LDB	AC1,DTCN.	;GET CHANNEL NUMBER
	ADD	AC2,MROPTT(AC1)	;ADD BUCKET BLK ADDR TO OFFSET
	AOS	MB.KYD(AC2)	;INCREMENT BUCKET
	JRST	RDKYDX		;FINISHED NOW

RDKYD2:	SOJG	AC1,RDKYD3	;JUMP IF GRT THAN 1
	AOS	AC2,AC1		;ELSE SET AC2=AC1+1
	JRST	RDKYD4		;AND GO INCR BUCKET

RDKYD3:	CAIGE	AC1,5		;SKIP IF GTR = 6 (REMBER -1 ABOVE)
	SOJA	AC2,RDKYD4	;ELSE SET AC2=2 AND GO BUCKET
	CAILE	AC1,^D24	;SKIP IF LS = 25
	ADDI	AC2,1		;ELSE SET AC2=4
RDKYD4:	LDB	AC1,DTCN.	;GET CHANNEL NUMBER
	ADD	AC2,MROPTT(AC1)	;ADD BUCKET BLK ADDR TO OFFSET
	AOS	MB.KY2(AC2)	;INCREMENT BUCKET
RDKYDX:>;END IFN LSTATS

	LDB	AC2,F.BBKF	;BLOCKING FACTOR
	SKIPN	AC1,AC4		;ZERO MEANS GET NEXT RECORD
	AOSA	AC1,D.RP(I16)	;ZERO! SO LAST KEY PLUS ONE
	MOVEM	AC1,D.RP(I16)	;SAVE IT HERE TOO
	MOVEM	AC1,FS.RN	;SAVE FOR ERROR-STATUS
	SOSN	AC1		;[300]
	TDZA	AC2,AC2		;
	IDIV	AC1,AC2		;
	IMUL	AC1,D.BPL(I16)	;BUFFER PER BLOCK
	ADDI	AC1,1		;PHYS. BLOCK NUMBER FOR USETI
	MOVEM	AC1,FS.BN	;SAVE IT FOR ERROR-STATUS
	JUMPE	AC4,SEQIOZ	;[461] IF ACT-KEY = 0, READ SEQUENTIALLY
	CAME	AC1,D.CBN(I16)	;SKIP IF RECORD IS IN CORE
	PUSHJ	PP,RANIN	;OTHERWISE GET IT
	 SKIPA	AC5,R.BPFR(I12)	;BYTE POINTER TO THE FIRST RECORD
	JRST	RANXI8		;[273] EOF
	LDB	AC0,F.BBKF	;HOW MANY RECORDS ARE LEFT
	SUBI	AC0,1(AC2)	;  IN THIS LOGICAL BLOCK.
IFN ANS74,<
	SETZM	D.SRCL(I16)	; CLEAR ANY SAVED D.RCL AFTER DEL/REWRT 
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RDKYD5		; NO, CONT
	LDB	AC11,F.BFAM	; GET ACCESS MODE
	JUMPE	AC11,RDKYD5	; IF SEQ ACCESS SKIP THIS SAVE
				; IN THIS CASE D.RCL WILL BE OK
	MOVE	AC11,D.RCL(I16)	; ELSE,GET CURRENT RECS LEFT IN LOG-BLK
	MOVEM	AC11,D.SRCL(I16) ; SAVE IT HERE FOR POSSIBLE SEQ READ NEXT
>
RDKYD5:	MOVEM	AC0,D.RCL(I16)	;SAVE FOR RANSHF
	TLNE	FLG,DDMBIN	;IF BINARY,
	JRST	RANDO7		;  GO TO SPECIAL ROUTINE
	JUMPL	FLG,RANA01	;JUMP IF ASCII
	TLNE	FLG,DDMEBC	; IF EBCDIC FILE
	JRST	RNER		; GO HERE
	JUMPE	AC2,RANDO2	;JUMP IF WE'RE DONE
	LDB	AC0,F.BMRS	;MAX-REC-SIZ
RANDO1:	HRRZ	AC10,@AC5	;RECORD SIZE IN CHARS
	;ANDI	AC10,7777	;
	CAMGE	AC0,AC10	;IS CHAR-CNT TOO LARGE?
	JRST	RANDO2		;COMPLAIN
	IDIVI	AC10,6		;RECORD
	SKIPE	AC11		;SIZE
	ADDI	AC10,1		;IN
	ADDI	AC5,1(AC10)	;WORDS
	SOJG	AC2,RANDO1	;JUMP TILL NXTREC=CURREC
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RAND2A		; NO, CONT
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPN	AC0,RANDO2	; IF NOT SEQ ACCESS SKIP POSITION CHANGE
>
RAND2A:	MOVEM	AC5,R.BPNR(I12)	;SAVE AS CURRENT RECORD

	;HERE TO CHECK THAT NEW RECORD SIZE LE THAN MAX
RANDO2:	HRRZ	AC2,@AC5	;RECORD SIZE IN CHARACTERS
	LDB	AC0,F.BMRS	;MAX RECORD SIZE
	CAMG	AC2,AC0		;[613] LE THAN MAX?
	JRST	RNDO20		;[613] YES, CONT
	PUSHJ	PP,ERRMR1	;NO - GO COMPLAIN
	
	;[613] HERE IF ERROR IGNORED BY USE PROCEDURE
	;[613] GIVE WARNING ABOUT WHAT WE ARE ASSUMING AND SET TO USE
	;[613] MAX REC SIZE AS THE CORRECT ONE

	HRRM	AC0,@AC5	;[613] RESET RECORD LENGTH TO BE MAX

	; AC2 LOADED WITH MAX SIZE IN ERRMR0


	;[613] PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;[613] IS LARGER THAN FD MAXIMUM

	OUTSTR	[ASCIZ/%Record length field larger than FD maximum,assuming max.
/]

RNDO20:	JUMPN	AC2,RANWRZ	;ONWARD IF NOT A ZERO LENGTH RECORD
	TXNN	AC16,V%READ!V%RWRT	;READ OR REWRITE?
	JRST	RANWR0		;WRITE OR DELETE!
IFN ANS68,<
	MOVE	AC1,F.RACK(I16)	;GET THE
	MOVE	AC1,(AC1)	;  ACTUAL KEY
>
IFN ANS74,<
	TXNE	AC16,V%STRT	;START VERB?
	JRST	STRT.0		;YES, NON-EXISTENT RECORD
	LDB	AC1,F.BFAM	;GET ACCESS MODE
>
	TLNE	FLG,RANFIL	;A RANDOM FILE?
IFN ANS68,<
	JUMPN	AC1,RANDO3	;YES  -  NEXT RECORD?
>
IFN ANS74,<
	JUMPN	AC1,[TXNE AC16,V%RNXT	;YES, BUT READ NEXT IS OK
		JRST	.+1		;READ NEXT WINS
		JRST	RANDO3]		;RANDOM LOSES
>
	SKIPN	NRSAV.		;[426] IF WE ALREADY HAVE START OF NULL STRING
	SKIPN	AC1,D.LBN(I16)	;[426] OR IF NOT AN IO FILE
	JRST	RNDO21		;[426] JUMP
	CAMLE	AC1,D.CBN(I16)	;[426] IS THIS THE LAST BLOCK OF FILE?
	JRST	RNDO21		;[426] NO
	MOVE	AC1,[-5,,NRSAV.-1]	;[426] SAVE PTRS TO LAST REAL REC
	PUSH	AC1,R.BPNR(I12)	;[426]
	PUSH	AC1,FS.RN	;[426]
	PUSH	AC1,D.RP(I16)	;[426]
	PUSH	AC1,D.RCL(I16)	;[426]
RNDO21:	MOVE	AC0,R.BPNR(I12)	;[426] YES - HERE TO GET NEXT NON-0-RECORD
	MOVEM	AC0,R.BPLR(I12)	;  BUT FIRST UPDATE
	AOS	R.BPNR(I12)	;  THE POINTERS
	HRRZ	AC0,D.WPR(I16)	; GET WORDS PER RECORD
	SUBI	AC0,1		; DECREMENT FOR AOS ABOVE
	JUMPGE	FLG,RNDO22	; JUMP IF NOT ASCII
	TLNE	FLG,RANFIL	; SKIP IF NOT A RANDOM FILE I.E.SEQ
	ADDM	AC0,R.BPNR(I12)	; POSITION TO NEXT RECORD
RNDO22:	AOS	D.RP(I16)	;COUNT 0LEN RECORDS
	AOS	FS.RN		;BUMP THE RECORD NUMBER
IFN ANS74,<
	HRRZ	AC1,F.RACK(I16)	;GET POINTER TO RELATIVE KEY
	SKIPE	AC1
	AOS	(AC1)		;POINT TO RECORD WE WILL GET NEXT TRY
>
	AOJA	AC5,SQIO2	;FIND THE NEXT ONE

	;HERE IF RECORD NOT FOUND
RANDO3:	PUSHJ	PP,NRESTS	;[601]SET FILE STATUS TO 23
	TLNE	FLG,RANFIL	;SKIP IF NOT A RANDOM FILE
	JRST	RANDO4		;RANDOM JUMPS
	SOS	D.RP(I16)	;DONT COUNT THIS ONE
	AOS	D.RCL(I16)	;DONT COUNT "EOF" AS A RECORD
	TLO	FLG,ATEND	;SET "EOF" FLAG
RANDO4:
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNDO4A		; NO, CONT
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPN	AC0,RANXI3	; IF NOT SEQ ACCESS SKIP POSITION CHANGE
>
RNDO4A:	MOVE	AC0,R.BPNR(I12)	;UPDATE POINTERS IN CASE HE WANTS TO
	TLNE	FLG,RANFIL	;RANDOM FILE?
	HRRI	AC0,(AC5)	;YES, USE THIS REC POINTER
	MOVEM	AC0,R.BPLR(I12)	;  WRITE AFTER "EOF"
	HRRM	AC5,R.BPNR(I12)	;MAKE THIS THE NEXT RECORD
	AOS	R.BPNR(I12)	; NEXT
	HRRZ	AC0,D.WPR(I16)	; GET WORDS PER RECORD
	SUBI	AC0,1		; DECREMENT FOR AOS ABOVE
	JUMPGE	FLG,RNDO41	; JUMP IF NOT ASCII
	TLNE	FLG,RANFIL	; SKIP IF NOT A RANDOM FILE I.E.SEQ
	ADDM	AC0,R.BPNR(I12)	; POSITION TO NEXT RECORD
RNDO41:	JRST	RANXI3		;RETURN

	;HERE TO POSITION TO ASCII REC WITHIN LOGICAL BLOCK
RANA01:	TLNN	FLG,RANFIL		; SKIP IF A RANDOM FILE
	SKIPN	(AC5)			; SKIP IF SEQIO NON-NULL RECORD
	TRNA				; RANDOM OR NULL RECORD SKIPS
	JRST	RANA09			; WE DONT HAVE TO POSITION
	HRRZ	AC10,D.WPR(I16)		; GET WORDS PER RECORD
	IMUL	AC10,AC2		; GET OFFSET TO FIRST REC WRD
	ADDI	AC5,(AC10)		; POINT BYTE-PTR AT RECORD
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RAN09X		; NO, CONT
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPE	AC0,RAN09X	; IF SEQ ACCESS POSITION CHANGE
	PUSH	PP,AC5		; DELETE-RERIT, SAVE START POS
	TDNA			; AND SKIP
RAN09X:
>
	MOVEM	AC5,R.BPNR(I12)	; SAVE IT AWAY

	; CHECK WHOLE RECORD FOR NULL CASE

RANA09:	MOVE	AC1,D.WPR(I16)	;[670]GET WORDS PER RECORD
	TLNE	FLG,DDMBIN	;[670]  UNLESS DOING BINARY
	MOVE	AC1,AC10	;[670]  THEN WPR IS IN AC10
RAN09A:	MOVE	AC2,(AC5)	;[670]GET A RECORD WORD
	JUMPN	AC2,RAN09B	;[670]CONTINUE WHEN NON-NULL FOUND
	SOJLE	AC1,RAN09B	;[670]  OR WHEN WHOLE RECORD CHECKED
	AOJA	AC5,RAN09A	;[670]TRY NEXT WORD
RAN09B:
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RAN09Y		; NO, RESET NEXT RECORD
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPE	AC0,RAN09Y	; IF SEQ ACCESS CONT
	POP	PP,AC5		; DELETE-RERIT,RESTORE START POS
	TDNA			; AND SKIP (DON'T USE NEXT REC )
RAN09Y:
>
	MOVE	AC5,R.BPNR(I12)	;[670]RESET BYTE POINTER
	JRST	RNDO20		; CONT
;FILE IS BINARY.
;STEP DOWN TO CORRECT RECORD AND MOVE TO/FROM RECORD AREA.

RANDO7:	LDB	AC10,F.BMRS	;GET MAXIMUM RECORD SIZE
	LDB	AC11,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC11,RBPTBL(AC11) ; GET CHARS PER WORD
	ADDI	AC10,-1(AC11)	;  *
	IDIVI	AC10,(AC11)	;  *
	MOVE	AC11,AC10	;SAVE IT

	IMULI	AC11,(AC2)	;MULTIPLY BY # RECORDS FROM TOP
	ADD	AC5,AC11	;ADD TO RECORD BYTE POINTER
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNDO7A		; NO, CONT
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPE	AC0,RNDO7A	; IF SEQ ACCESS POSITION CHANGE
	PUSH	PP,AC5		; DELETE-RERIT, SAVE START POS
	JRST	RANA09		; AND CHECK FOR NULL RECORD
>

RNDO7A:	MOVEM	AC5,R.BPNR(I12)	;SAVE AS CURRENT RECORD
	JRST	RANA09		;[670]CHECK FOR NULL RECORD

RAND7A:	HRL	AC5,FLG		;[670]GET RECORD ADDRESS
	TXNN	AC16,V%READ	;IS IT READ?
	JRST	RANDO9		;NO
	MOVSS	AC5		;YES--MOVING TO RECORD
	SETZM	R.WRIT(I12)	;REMEMBER IT WAS A READ
	JRST	RAND10

RANDO9:	SETOM	R.DATA(I12)	;FORCE WRITE LATER
	SETOM	R.WRIT(I12)	;REMEMBER IT WAS A WRITE
IFN ANS74,<
	TXNN	AC16,V%DLT	; IS THIS DELETE??
	JRST	RAND10		; NO,GO ON
	HRLS	AC5		; YES,SET SO IT WILL BLT TO ITSELF
	SETZM	(AC5)		; CLEAR FIRST WORD
	ADDI	AC5,1		; SET TO BLT . TO .+1
	SUBI	AC10,1		;DECREMENT THIS TO MAKE UP FOR ADD ABOVE
>;END IFN ANS74
RAND10:	ADDI	AC10,(AC5)	;FINAL DESTINATION PLUS 1
	BLT	AC5,-1(AC10)	;BLAT!!
	TXNE	AC16,V%READ	;IS IT READ?
	MOVSS	AC5		;YES,RESET AC5 TO GET BUFFER ADDR IN RIGHT HALF
	JRST	RANXIT
	;SEQUENTIAL IO READ AND WRITE ARE PROCESSED HERE
SEQIOZ:	SETZM	NRSAV.		;[461] CLEAR SO WRONG BYTE POINTERS
				;[461] DON'T GET POP'D
SEQIO:
IFN ANS74,<
	SKIPN	AC5,D.SRCL(I16)	; SKIP AND LOAD IF SAVED D.RCL AFT DEL/REWRT
	JRST	SEQI00		; ELSE, CONT
	MOVEM	AC5,D.RCL(I16)	; RESTORE IT
	SETZM	D.SRCL(I16)	; CLEAR SAVED VALUE
SEQI00:	HRRZ	AC5,F.RACK(I16)	;IF THERE IS A RELATIVE KEY
	JUMPE	AC5,SEQIO0	;NOT
	PUSH	PP,D.RP(I16)	;THEN UPDATE IT
	POP	PP,0(AC5)	;WITH NEW VALUE
SEQIO0:>
	SKIPE	R.BPLR(I12)	;SKIP IF FIRST INPUT
	JRST	SQIO1		;ITS NOT
	MOVE	AC5,R.BPFR(I12)	;FIRST RECORD
	MOVEM	AC5,R.BPLR(I12)	;LAST RECORD
	MOVEI	AC1,1		;FIRST BLOCK
	JRST	SQIO11		;READ IT IN

SQIO1:
	; IF R.DLRW(I12) SET THEN READ BACK "CURRENT" DSK BLK

IFN ANS74,<
	SKIPN	AC1,R.DLRW(I12)	; IS DEL/RERIT BLK NUM SAVED?
	JRST	SQIO1A		; NO, CONT
	TXO	AC16,V%DLT	; FAKE OUT RANIN NOT T O RESET "CURRENT" LOC
	PUSHJ	PP,RANIN	; YES, READ IT INTO THE BUFFER
	 JRST	SQIO1B		; OK, BLK IN BUFFER

	; TROUBLE, BLOCK WE USED TO HAVE ISN'T THERE NOW

	OUTSTR	[ASCIZ/?Internal error, no DELETE-REWRITE "current" DSK blk.
/]
	JRST	KILL.		; GIVE UP

SQIO1B:	TXZ	AC16,V%DLT	; CLEAR FAKE OUT
>;END IFN ANS74
SQIO1A:	SKIPN	R.WRIT(I12)	;SKIP IF WRITE WAS LAST
IFN ANS68,<
	TXNN	AC16,V%WRITE!V%WADV ;SKIP IF WRITE AFTER READ
>
IFN ANS74,<
	TXNN	AC16,V%RWRT!V%DLT	;SKIP IF REWRITE OR DELETE AFTER READ
>
SQIO2:	SKIPA	AC1,D.RCL(I16)	;NUMBER OF REC TO FILL CURRENT LOGBLK
	JRST	SQIO20		;
SQIO4:	JUMPN	AC1,SQIO30	;JUMP IF RECORD IS IN CORE
	SKIPN	NRSAV.		; NON-ZERO MEANS THIS IS LAST BLOCK
	JRST	SQIO10		; NOT THE LAST BLOCK OF FILE
	MOVE	AC0,[-5,,NRSAV.+3]; IT IS SO BACK UP TO
	POP	AC0,D.RCL(I16)	; THE RECORD POSITION
	AOS	D.RCL(I16)	;
	POP	AC0,D.RP(I16)	; JUST AFTER THE LAST
	POP	AC0,FS.RN	; REAL RECORD SO APPEND
	POP	AC0,R.BPLR(I12)	; WILL FIND THE RIGHT RECORD SLOT
	MOVE	AC0,R.BPLR(I12)	; NOW, MAKE THE NEXT RECORD SLOT
	MOVEM	AC0,R.BPNR(I12)	; BE THE SAME AS THE LAST RECORD SLOT
	SETZM	NRSAV.		; ZERO NULL-REC-IN-LAST-BLOCK FLAG
	SETZM	R.WRIT(I12)	; ZERO THE WRITE FLAG
	TLO	FLG,ATEND	; SET ATEND FLAG
	PUSHJ	PP,ENDSTS	; [601] NO NEXT REC STATUS (10)
IFN ANS74,<
	HRRZ	AC4,F.RACK(I16)	; GET POINTER TO RELATIVE KEY
	JUMPE	AC4,RANXI0	; DONT RESTORE NONEX KEY
	MOVE	AC0,NRSAV.+4	; GET ORIGINAL KEY
	MOVEM	AC0,(AC4)	; AND RESTORE IT
>
	JRST	RANXI0		; AND GIVE ATEND RETURN
	;HERE TO GET THE NEXT LOGICAL BLOCK
SQIO10:	HRRZ	AC1,D.BPL(I16)	;BUFFERS PER LOGBLK
	ADD	AC1,D.CBN(I16)	;USETI OPERAND (CURRENT PHYS BLOCK)
SQIO11:	PUSHJ	PP,RANIN	;WRITE LAST BLOCK IF NECESSARY,THEN INPUT
	 JRST	SQIO30		;NOW THE RECORD IS IN CORE
	TXNN	AC16,V%READ	;SKIP IF NOT WRITE AFTER EOF
	JRST	SQIO30		;WRITE
	MOVE	AC0,R.BPFR(I12)	;BP TO FIRST REC
	MOVEM	AC0,R.BPLR(I12)	; = BP TO LAST REC
	JRST	RANXI0		;[273]

	;HERE ON WRITE AFTER READ
SQIO20:
SQIO21:	SOS	D.RP(I16)	;THIS REC HAS BEEN COUNTED
	SOS	FS.RN		;BEEN COUNTED BY PREVIOUS READ
	MOVE	AC5,R.BPLR(I12)	;BP TO LAST RECORD
	MOVEM	AC5,R.BPNR(I12)	;BP TO NEXT RECORD
	TLNE	FLG,ATEND	;[322] IF ATEND THEN
	SOS	D.RCL(I16)	;[322] DECREMENT REC/LOGBLK CNT
	JRST	SQIO32		;

	;HERE WHEN RECORD IS IN CORE
SQIO30:	TLNN	FLG,ATEND	;APPENDING?
	JRST	SQIO31		; NOT APPENDING
	TLNN	FLG,DDMEBC!DDMASC	;[526] NO REC-CNT IF EBC
	MOVEM	AC3,@R.BPNR(I12);GIVE A REC-CNT
SQIO31:	SOS	D.RCL(I16)	;DECREMENT REC/LOGBLK COUNT
	MOVE	AC5,R.BPNR(I12)	;CURRENT/NEXT RECORD
SQIO32:	JUMPG	FLG,SQIO33	;JUMP IF NOT ASCII
	TLNN	FLG,SEQFIL	;SKIP IF SEQ FILE
	JRST	RANA09		; NOT SEQ,GO ON
	JRST	RANWRT		; SEQ, SKIP WORD CHECKS

SQIO33:	TLNE	FLG,DDMBIN	;JUMP IF
	JRST	RANBIN		;  IT IS A BINARY FILE
	TLNE	FLG,DDMEBC	; IF EBCDIC FILE
	JRST	RNES		; GO HERE
	JRST	RANDO2		;GO CHECK THE RECORD SIZE
	;ENTRY POINT FOR RANDOM EBCDIC FILES
	;LOGICAL BLOCK IS IN CORE SO SETUP THE BYTE-POINTER
RNER:	HRRZ	AC10,D.WPR(I16)	; GET WORD OFFSET TO NEXT RECORD
	IMUL	AC10,AC2	; GET NUMBER OF WORDS BEFORE THE DESIRED RECORD
	ADDI	AC5,(AC10)	; ADD THIS OFFSET TO BYTE-PTR
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNERAA		; NO, CONT
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPN	AC0,.+2		; IF NOT SEQ ACCESS SKIP POSITION CHANGE
>
RNERAA:	MOVEM	AC5,R.BPNR(I12)	; UPDATE NEXT RECORD POINTER

	;ENTRY POINT FOR SEQIO EBCDIC FILES
RNES:	TXNN	AC16,V%READ	; READ SKIPS
	JRST	RNER30		; WRITE JUMPS
	MOVE	AC10,D.RCNV(I16); SETUP THE CONVERSION INST
	SETZB	AC0,R.WRIT(I12)	; READ WAS LAST
	JUMPL	FLG1,RNER10	; BRANCH IF VAR-LEN RECORDS

	;READ - FIXED-LEN RECORDS SEE IF ALL CHARS ARE NULL
RNER01:	MOVE	AC1,AC5		; GET COPY SOURCE PTR
	MOVE	AC0,AC3		; GET COUNT OF CHARS IN REC
RNR01A:	ILDB	C,AC1		; GET A CHAR
	JUMPN	C,RNER06	; EXIT HERE IF NOT NULL
	SOJG	AC0,RNR01A	; LOOP
	TLNN	FLG,RANFIL	; NULL RECORD,SKIP IF RANDOM FILE
	MOVE 	AC5,AC1		; RESET AC5 TO NEXT RECORD FOR SEQ 

	;GOT A NULL RECORD SEE WHAT TO DO WITH IT
RNRNUL:
IFN ANS74,<
	TXNE	AC16,V%STRT	; SKIP IF NOT START
	JRST	STRT.0		; BACK TO START WITH NO FIND
>
	SKIPN	NRSAV.		; IF WE ALREADY GOT START OF NULL STRING
	SKIPN	AC3,D.LBN(I16)	; OR IF NOT AN IO FILE
	JRST	RNER02		; BRANCH
	CAMLE	AC3,D.CBN(I16)	; IF THIS IS NOT THE LAST BLOCK,
	JRST	RNER02		; DONT PUSH
	MOVE	AC0,[-5,,NRSAV.-1]; SAVE POINTERS TO LAST REAL RECORD
	PUSH	AC0,R.BPNR(I12)	;
	PUSH	AC0,FS.RN	;
	PUSH	AC0,D.RP(I16)	;
	PUSH	AC0,D.RCL(I16)	;

RNER02:	SKIPL	D.FCPL(I16)	; SKIP IF NULL BLOCK (SET AT RNIN1A)
	JRST	RNER2A		; JUMP AHEAD IF NON-NULL BLOCK
				; IN NULL CASE SET UP SO AS TO 
				; SKIP AHEAD TO THE NEXT BLOCK
	MOVE	D.RCL(I16)	; GET NUMBER RECORDS LEFT IN BLK
	ADDM	AC0,D.RP(I16)	; ADVANCE RECORD COUNTERS
	ADDM	AC0,FS.RN	; SO AS TO INDICATE BEGINING OF NEXT BLK
	SETZM	D.RCL(I16)	; CLEAR THIS TO GET NEXT BLK
RNER2A:	LDB	AC3,F.BMRS	; RESTORE RECORD SIZE
	TLNN	FLG,RANFIL	; SKIP IF RANDOM FILE
	JRST	RNER2B		; ELSE, NULL RECORD IN SEQUENTIAL FILE
	HRRZ	AC0,D.WPR(I16)	; GET WORDS PER RECORD
	ADD	AC5,AC0		; ADVANCE AC5 TO NEXT RECORD 
RNER03:	JUMPN	AC4,RNER05	; JUMP IF ACT-KEY NON-ZERO
	MOVEM	AC5,R.BPNR(I12)	; SAVE AS PTR TO NEXT REC
	JRST	RANDOM		; ACT-KEY = 0 SO GET NEXT RECORD

RNER2B:	EXCH	AC5,R.BPNR(I12)	; NULL RECORD - GET NEXT
	MOVEM	AC5,R.BPLR(I12)	; UPDATE BYTE-PTRS
	AOS	D.RP(I16)	; COUNT THIS RECORD
	AOS 	FS.RN		; HERE TOO
	JRST	SQIO2		; GET NEXT RECORD

RNER05:	AOS	(PP)		; GIVE HIM AN INVALID KEY RETURN
	MOVEI	AC1,^D23	; READ INVALID KEY
	MOVEM	AC1,FS.FS	; LOAD FILE-STATUS
	JRST	RNER40		; EXIT

	;RESTORE THE NULL CHARS IF ANY
RNER06:
IFN ANS74,<
	TXNE	AC16,V%STRT	; SKIP IF NOT START
	JRST	RNRSTT		; START, GO ON WITHOUT FINISHING READ
>
	SETZM	NRSAV.		; ZERO WHEN REAL REC IS FOUND
	ILDB	C,AC5		; REGET FIRST CHAR
	JRST	RNER21		; NOW GET REST OF RECORD

	
	;HERE IF GOT NON-NULL FOR START
RNRSTT:	SETOM	R.STRT(I12)	; INDICATE START DONE
	JRST	RNER40		; RETURN TO USER (EVENTUALLY)

	;READ - VAR-LEN RECORDS SO CHECK THE SIZE
RNER10:	PUSHJ	PP,RNDW		; GET RDW INTO AC1 AND AC0
	JUMPN	AC1,RNR10A	; JUMP IF NOT NULL RECORD
	TLNN	FLG,RANFIL	; SKIP IF RANDOM FILE
	JRST	RNULER		; ELSE,ERROR NULL RECORD IN SEQ VARIABLE FILE
	JRST	RNRNUL		; NOW GO CHECK WHAT TO DO WITH NULL



RNR10A:
IFN ANS74,<
	TXNE	AC16,V%STRT	; SKIP IF NOT START
	JRST	RNRSTT		; JUMP IF START
>
	CAIL	AC3,-4(AC1)	;[613] WILL IT FIT INTO RECORD AREA
	JRST	RNR10B		;[613] YES
	PUSHJ	PP,ERRMR1	;[613] NO - COMPLAIN

	;[613] HERE IF USE PROCEDURE IGNORED ERROR
	
	OUTSTR	[ASCIZ/%Record length field larger than FD maximum,assuming max.
/]
	JRST	RNR10C		;[613] AND CONTINUE USING MAX RECORD SIZE

RNR10B:	MOVEI	AC3,-4(AC1)	;[613] USE ACTUAL ,NOT MAX SIZE
RNR10C:	ADDI	AC5,1		;[613] ADVANCE AC5 PAST RDW


	;READ - MOVE RECORD FROM BUFFER TO RECORD AREA
RNER20:	ILDB	C,AC5		; GET CHAR
RNER21:	XCT	AC10		; CONVERT
	IDPB	C,AC6		; PUT CHAR
	SOJG	AC3,RNER20	; LOOP
	JRST	RNER40		; EXIT

	;WRITE - MOVE RECORD AREA TO BUFFER
RNER30:	MOVE	AC10,D.WCNV(I16); SETUP THE CONVERSION INST
IFN ANS74,	JUMPGE	FLG1,RNR30A	; JUMP IF FIXED LEN RECORDS
IFN ANS68,	JUMPGE	FLG1,RNER33	; JUMP IF FIXED LEN RECORDS
	PUSHJ	PP,RNDW		; GET RDW INTO AC1
IFN ANS74,	JUMPN	AC1,RNR30C	; IT WILL BE 0 IF WE ARE APPENDING
IFN ANS68,	JUMPN	AC1,RNER31	; IT WILL BE 0 IF WE ARE APPENDING
IFN ANS74,<
	TXNE	AC16,V%DLT!V%RWRT ;DELETE OR REWRITE?
	JRST	RNDLER		;YES, ERROR NULL RECORD 
>
	PUSHJ	PP,MAKRDW	; GO WRITE AN RDW
	JRST	RNER32		; GO WRITE RECORD

MAKRDW:	HRLZI	AC1,4(AC3)	; SO MAKE A RDW
	MOVNI	AC0,4(AC3)	; NEGATE THE COUNT
	ROT	AC1,11		; HI-BITS FIRST
	IDPB	AC1,AC5		;
	ROT	AC1,11		; LO-BITS NEXT
	IDPB	AC1,AC5		;
	SETZ	AC1,		; THEN SOME NULLS
	IDPB	AC1,AC5		;
	IDPB	AC1,AC5		;
	POPJ	PP,		; RETURN

IFN ANS74,<
	;CHECK FOR NULL RECORD ERRORS
;[D1006] RNR30A:	MOVE	AC1,AC5		; GET COPY DESTINATION PTR
;[D1006] ADDI	AC1,1		; ADVANCE PTR PAST RDW
;[D1006] ILDB	AC1,AC1		; GET A BYTE
RNR30A:				;[1006]
	PUSH	PP,AC5		;[1006] SAVE DEST POINTER
	PUSH	PP,AC3		;[1006]  AND BYTES/REC
RNR30D:				;[1006]
	ILDB	AC1,AC5		;[1006] GET A BYTE
	SKIPN	AC1		;[1006] CONTINUE WHEN NON-NULL FOUND
	SOJG	AC3,RNR30D	;[1006]  OR WHEN NO BYTES LEFT
	POP	PP,AC3		;[1006] RESTORE BYTES/REC
	POP	PP,AC5		;[1006]  AND DEST POINTER
	JUMPE	AC1,RNR30B	; SKIP AHEAD IF NULL RECORD
	PUSHJ	PP,WRTNUL	; GO CHECK FOR RANDOM WRITE TO NON-NULL REC
				; DOESN'T RETURN IF ERROR
	JRST	RNER33		; OK, GO DO IT

RNR30B:	TXNE	AC16,V%WRIT	; IS THIS WRITE?
	JRST	RNR33A		; YES, ALL OK GO ON
	JRST	RNDLER		; NO,TROUBLE-REWRITE OR DELETE WITH NULL REC

RNR30C:	PUSHJ	PP,WRTNUL	; GO CHECK FOR RANDOM WRITE TO NON-NULL REC
				; DOESN'T RETURN IF ERROR
>;END IFN ANS74

RNER31:
IFN ANS74,<
	TXNE	AC16,V%DLT	;DELETE?
	JRST	RNRDLV		;YES, JUMP
>
	CAIN	AC1,4(AC3)	; SIZE OF EXISTING RECORD SAME AS NEW?
	AOJA	AC5,RNER32	; SIZES EQUAL,GO WRITE RECORD
				; AFTER ADANCING AC5 PAST RDW
	LDB	AC1,F.BMRS	; GET MAXIMUM RECORD SIZ
				; ,RANDOM SPACED BY MAX REC SIZE
	CAIGE	AC1,4(AC3)	; WILL NEW RECORD FIT IN OLD PLACE?
	JRST	RERE5		; NO,SIZE ERROR
	PUSHJ	MAKRDW		; YES,MAKE NEW RDW
RNER32:
RNER33:
IFN ANS74,<
	TXNE	AC16,V%DLT	;DELETE?
	JRST	RNERDL		;YES, JUMP
>
RNR33A:	ILDB	C,AC6		; GET CHAR
	XCT	AC10		; CONVERT
	IDPB	C,AC5		; PUT CHAR
	SOJG	AC3,RNR33A	; LOOP
	SETOM	R.DATA(I12)	; NOTE ACTIVE DATA IN BUFFER
	SETOM	R.WRIT(I12)	; AND WRITE WAS LAST

	;FINISH UP AND EXIT
RNER40:
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNR40X		; NO, CURRENT POSITION RESET
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPN	AC0,RNR40B	; IF NOT SEQ ACCESS JUMP PAST POSITION CHANGE
>
RNR40X:	TLNN	FLG,RANFIL	; RANDOM FILE?
	JRST	RNR40A		; NO
	HRRZ	AC5,D.WPR(I16)	; YES,GET DISTANCE TO NEXT RECORD
	ADD	AC5,R.BPNR(I12)	; THEN PTR IT TO NEXT RANDOM RECORD
RNR40A:	EXCH	AC5,R.BPNR(I12)	; UPDATE NEXT-RECORD AND
	MOVEM	AC5,R.BPLR(I12)	; LAST-RECORD POINTERS
RNR40B:	TLNN	FLG,RANFIL	; RANFIL FILE?
	JRST	RANXI0		; NO - SEQIO FILE!
	TXNN	AC16,V%READ	; READ OR ?
	JRST	RANXI2		; WRITE
	JRST	RANXI1		; READ

IFN ANS74,<

	;RESET RDW WORD TO INDICATE NULL RECORD
RNRDLV:	MOVE	AC1,AC5		;GET POINTER TO RDW
	SETZ	C,		;GET NULL
	IDPB	C,AC1		;ZERO FIRST BYTE
	IDPB	C,AC1		;AND SECOND
	AOJA	AC5,RDERD1	; ADVANCE AC5 TO RECORD START (AFTER RDW)
				;GO DELETE RECORD

	;DELETE A FIXED LENGTH RECORD
	;FIRST CHECK THAT THERE IS NOT A NULL RECORD ALREADY THERE

RNERDL:	MOVE	AC1,AC5		;GET BUFFER POINTER
	ILDB	C,AC1		;GET A CHAR
	JUMPE	C,RNDLER	;ERROR, NULL RECORD

	;NOW DELETE WHAT IS THERE

RDERD1:	SETZ	C,		;SET NULL CHAR
	IDPB	C,AC5		;DELETE ONE CHAR
	SOJG	AC3,.-1		;LOOP TILL ALL GONE
	SETOM	R.DATA(I12)	;NOTE ACTIVE DATA
	SETOM	R.WRIT(I12)	;AND NOT LAST READ
	JRST	RNER40		;CLEAN UP

>;END IFN ANS74

	;RETURNS RECORD DESCRIPTOR WORD IN AC1 AND AC0 (NEGATED)
RNDW:	MOVE	AC0,AC5		; GET BYTE-POINTER
	ILDB	AC1,AC0		; GET HI-BITS
	ILDB	AC0,AC0		; AND LO-BITS
	LSH	AC1,11		; LINE EM UP
	IOR	AC1,AC0		; MERGE EM
	MOVN	AC0,AC1		; NEGATE EM
	JRST	RET.1		; EXIT

	; RNTBL IS USED TO FIND NTH RECORD IN LOGICAL BLOCK.
	; DIVIDE REC-SIZE BY CHARS PER WORD - REMAINDER IS INDEX
	; TABLE YIELDS BYTE-PTR TO FIRST CHAR OF NEXT RECORD
RNTBL:	POINT 9,
	POINT 9,,8
	POINT 9,,17
	POINT 9,,26
;MOVE THE RANDOM/IO RECORD AREA TO THE BUFFER AREA.  ***RANXIT***

IFN ANS74,<
WRTNUL:	TLNE	FLG,RANFIL
	TXNN	AC16,V%WRITE	;RANDOM WRITE ?
	POPJ	PP,		; NO,OK- GO BACK
	PUSHJ	PP,DPLSTS	;YES, THEN ITS ILLEGAL
	MOVEM	AC5,R.BPLR(I12)	; UPDATE LAST RECORD POINTER
	TLNN	FLG,DDMSIX	; DEVICE DATA MODE  SIXBIT?
	JRST	WRTNLA		; NO
	ADDI	AC2,5+6		; ROUND UP - ACCOUNT FOR HEADER WORD
	IDIVI	AC2,6		; CONVERT TO WORDS
	ADD	AC5,AC2		; UPDATE POINTER TO NEXT RECORD
	JRST	RANWRX		; FINISH

WRTNLA:	ADD	AC5,D.WPR(I16)	; POSITION TO NEXT RECORD
RANWRX:	JUMPGE	FLG1,.+2	; SKIP IF NOT VAR-LEN EBCDIC
	SUBI	AC5,1		; OTHERWISE BACK AC5 TO ADDRESS RDW
	MOVEM	AC5,R.BPNR(I12)	; UPDATE THE POINTER
	POP	PP,(PP)		; KILL RETURN TO CALL POINT
	JRST	RET.3		;BYPASS WRITE PARAMETERS & GIVE ERROR RETURN
>;END IFN ANS74

RANWRZ:
IFN ANS74,<
	PUSHJ	PP,WRTNUL	; CHECK FOR WRITE ON NULL (NO RETURN ON ERROR)
>
RANWR0:
IFN ANS74,<			;[670]
	TXNE	AC16,V%DLT	;[670]IF DELETE
	JRST	.+3		;[670]	SKIP BINARY CHECK
>				;[670]
	TLNE	FLG,DDMBIN	;[670]IF BINARY,
	JRST	RAND7A		;[670]  GO TO SPECIAL ROUTINE
	TLNN	FLG,DDMASC+DDMBIN  ;[670] ASCII/BINARY SKIP - NO HEADER WORD
	ADDI	AC5,1		;POINT AT DATA NOT RECSIZ
RANWRT:
IFN ANS68,<
	TXNN	AC16,V%WRITE!V%WADV ;IF IT'S WRITE,
>
IFN ANS74,<
	TXNE	AC16,V%DLT	;DELETE?
	JRST	RANDEL		;YES, ITS SPECIAL
	TXNN	AC16,V%WRITE!V%WADV!V%RWRT	;IF IT'S WRITE,
>
	JRST	RANREA		;IT'S READ
	TLNE	FLG,DDMSIX	;SIXBIT STUFF IN THE BUFFER?
	PUSHJ	PP,RANSHF	;YES - MAKE SURE NEW RECORD FITS
	TLNN	FLG,CONNEC!DDMASC	;SKIP IF CONVERSION IS NECESSARY
	JUMPGE	FLG,RANRB	;SIXBIT, GO BLT THE DATA


	MOVE	AC10,D.WCNV(I16)	;SETUP AC10
	TXNE	AC16,V%WADV	; SKIP IF IT'S NOT WADV,
	PUSHJ	PP,WRTADV	; ELSE GO ADVANCE
IFN ANS74,<
	  TRNA			;NORMAL RETURN
	AOS	(PP)		;COPY END OF PAGE SKIP RETURN
>
RANWR1:	ILDB	C,AC6		;PICK UP A CHARACTER
	XCT	AC10		;CONVERT IF NECESSARY
	IDPB	C,AC5		;DEPOSIT THE CHAR.
	SOJG	AC3,RANWR1	;LOOP TILL A COMPLETE RECORD IS PROCESSED
	JUMPGE	FLG,RANWR2	;JUMP,SIXBIT HAS NO "CRLF"

	TXNN	AC16,V%WADV	;[WADV] SKIP IF IT'S WRITE ADVANCE,
	JRST	RNWR2A		;[WADV] ELSE WRITE CR-LF
	PUSHJ	PP,WRTADV	; DO ADVANCING NOW	
IFN ANS74,<
	  TRNA			;NORMAL RETURN
	AOS	(PP)		;COPY END OF PAGE SKIP RETURN
>
	JRST	RNWR2B		;[WADV] CONTINUE

	;[WADV] NO ADVANCING SO GIVE JUST CR-LF FOR RANDOM WRITE

RNWR2A:				;[M1114]
IFN ANS74,<			;[A1114]
	TXNE	AC16,V%RWRT	;[A1114] DOING REWRITE?
	 JRST	RNWR2B		;[A1114] YES, DON'T PUT IN <CR><LF>
>				;[A1114]
	PUSHJ	PP,RANCR	;[WADV] WRITE CR [M1114]
	PUSHJ	PP,RANLF	;[WADV] GIVE HIM A "LF"
RNWR2B:	TLNE	FLG,SEQFIL	;[WADV] SEQ FILE?
	JRST	RANWR3		;[WADV] YES,DO NON-WORD ALIGNED CASE
RANWR2:	ADDI	AC5,1		; ADVANCE NXT-REC PRT TO NEXT FREE WORD
RNWR2X:	SETOM	R.DATA(I12)	;THERE IS ACTIVE DATA IN THE BUFFER
	SETOM	R.WRIT(I12)	;THE LAST COBOL UUO WAS A WRITE
	JRST	RANXIT		; ADVANCE NXT-REC PTR AND TAKE STANDARD EXIT 

RANWR3:
	SETOM	R.DATA(I12)	;BUFFER DIRTY
	SETOM	R.WRIT(I12)	;WRITE LAST I-O
;IFN ANS74,<			;[1023]test is taken out
;	TXNE	AC16,V%RWRT	; IS THIS RERIT?
;	JRST	RANXI0		; YES,SKIP CURRENT POSITION RESET
;				;[1023] to update pointer
;>
	EXCH	AC5,R.BPNR(I12) ;UPDATE NXT REC PTR
	MOVEM	AC5,R.BPLR(I12)	;UPDATE LAST REC PTR
	JRST	RANXI0		;FINISH AND EXIT


IFN ANS74,<
RANDEL:	TLNN	FLG,DDMSIX	;SIXBIT?
	JRST	RANDLA		;NO, ASCII
	HRRZ	AC3,-1(AC5)	;GET THE RECORD SIZE
	JUMPE	AC3,RNDLER	;NO RECORD--SO INVALID KEY
	SETZ	AC3,		;NO DATA JUST HEADER
	PUSHJ	PP,RANSHF	;MOVE EXISTING RECORDS DOWN
	MOVE	AC0,R.BPNR(I12)	;[1035] CURRENT RECORD
	MOVEM 	AC0,R.BPLR(I12)	;[1035] LAST RECORD
	HRRI	AC0,(AC5)	;[1035] ADR OF 1ST WRD OF NEXT REC
	MOVEM	AC0,R.BPNR(I12)	;[1035] BP TO NEXT RECORD
	SETOM	R.DATA(I12)	;[1035] THERE IS ACTIVE DATA IN BUFFER
	SETOM	R.WRIT(I12)	;[1035] THE LAST COBOL UUO WAS A WRITE
	AOJA	AC5,RANXI0	;[1035] UPDATE REC POINTER & SIGNAL ACTIVE DATA

RANDLA:	HRRZ	AC1,AC5		; GET ADR OF FIRST REC WORD
	SKIPN	AC2		;[670] SKIP IF NOT A NULL RECORD
	JRST	RNDLER		; NULL! SO INVALID KEY RETURN
	TLNE	FLG,DDMBIN	;[670]IF BINARY,
	JRST	RAND7A		;[670]  GO TO SPECIAL ROUTINE
	LDB	AC10,F.BMRS	; GET MAX-RECORD SIZE
	ADDI	AC10,2+4	; INCLUDE CRLF AND ROUND UP
	IDIV	AC10,D.BPW(I16)	; CONVERT TO REC SIZE IN WRDS
	ADDI	AC5,(AC10)	; POINT BYTE-PTR AT NEXT RECORD
	HRL	AC1,AC1		; MAKE A BLT XWD
	SETZM	(AC1)		; ZERO THE FIRST RECORD WORD
	ADDI	AC1,1		; NOW ITS A BLT XWD
	HLRZ	AC0,AC1		; GET ADR OF FIRST REC WORD
	CAIGE	AC0,-1(AC5)	; SKIP BLT IF REC ONLY 1 WRD
	BLT	AC1,-1(AC5)	; CLEAR THE RECORD
	JRST	RNWR2X		; FINISH UP
RNDLER:	JRST	RANDO3		;[601] EXIT WITH INVALID KEY

>;END IFN ANS74
	;MOVE THE RANDOM/IO BUFFER AREA TO THE RECORD AREA.  ***RANXIT***
RANREA:
IFN ANS74,<
	TXNN	AC16,V%STRT	;JUST DOING START?
	JRST	RNREA0		; NO, CONT
	SETOM	R.STRT(I12)	;YES, SET FLAG
	TLNE	FLG,DDMSIX	;SIXBIT STUFF IN THE BUFFER?
	SUBI	AC5,1		; YES, ADDRESS HEADER COUNT
	JRST	RANXIT		;AND EXIT
RNREA0:
>
	TLC	FLG,DDMASC+SEQFIL ;SEQ ASCII FILE?
	TLCN	FLG,DDMASC+SEQFIL ;IFSO 
	JRST	RANRE5		  ;DO NON-WORD ALIGNED CASE
	MOVE	AC1,AC3		;SAVE MAX RECORD SIZE IN CHARS
	TLNE	FLG,DDMSIX	;IF A SIXBIT FILE
	HRRZ	AC3,-1(AC5)	;  USE THE ACTUAL SIZE
	MOVEM	AC3,D.CLRR(I16) ;SAVE LENGTH OF REC TO BE READ
	TLNN	FLG,CONNEC!DDMASC	;SKIP IF CONVERSION IS NECESSARY
	JUMPGE	FLG,RANBR	;SIXBIT, GO BLT	THE DATA
	MOVE	AC0,AC3		;SAVE ACTUAL RECORD SIZE
	MOVE	AC10,D.RCNV(I16)	;SETUP AC10
	HRRZ	AC2,AC5		;SAVE RECORD ORIGIN
RANRE0:	ILDB	C,AC5		;PICK UP A CHARACTER
	XCT	AC10		;CONVERT IF NECESSARY
	JUMPL	C,RANRE0	;IGNORE LEADING EOL CHARS
	JUMPG	C,RANRE1	;[300] IF NOT NULL , CONTINUE
	SOJG	AC3,RANRE0	;[300] IF MORE CHARS. THEN LOOP
;[1013]	JUMPE	AC4,RANDOM	;[300] JUMP IF SEQ
	JUMPN	AC4,RANREN	;[1013]IF SEQUENTIAL
	MOVE	AC5,D.WPR(I16)	;[1013]  ADD WORDS/RECORD TO BYTE PTR
	ADDB	AC5,R.BPNR(I12)	;[1013]  SO IT POINTS TO NEXT RECORD
	JRST	RANDOM		;[1013]  AND TRY AGAIN
RANREN:				;[1013]
	MOVEI	AC1,^D23	; READ INVALID KEY
	MOVEM	AC1,FS.FS	; LOAD FILE-STATUS
	AOS	(PP)		;[300] SET UP SKIP RETURN
	JRST	RANRE2		;[300] GO SET FLAGS

RANRE1:	IDPB	C,AC6		;DEPOSIT INTO RECORD AREA
	SOJE	AC3,RANRE3	;EXIT AFTER PROCESSING THE RECORD
	ILDB	C,AC5		;GET NEXT CHAR
	XCT	AC10		;CONVERT IF NECESSARY
	JUMPGE	C,RANRE1	;LOOP IF NOT AN EOL CHAR
RANRE3:	JUMPL	C,RANRE4	;ASCII AND NEEDS FILL
	JUMPL	FLG,RANRE2	;ASCII NO FILL REQUIRED
	SUB	AC1,AC0		;SIXBIT - HOW MUCH FILL?
	JUMPE	AC1,RANRE2	;JUMP IF NONE
	MOVE	AC3,AC1		;
	JRST	.+3		;SKIP PAST D.CLRR UPDATE

RANRE4:	SUB	AC0,AC3		;SET AC0 TO SIZE READ
	MOVEM	AC0,D.CLRR(I16)	;SAVE SIZE ACTUALLY READ
	MOVEI	C," "		;ASCII SPACE
	TLNN	FLG,CDMASC	;ASCII?
	MOVEI	C,0		;NO, SIXBIT SPACE
	IDPB	C,AC6		;FILL OUT RECORD
	SOJG	AC3,.-1		;WITH SPACES
	ADDI	AC5,1		; ADVANCE NXT REC PTR
RANRE2:	JUMPGE	FLG,RNRE2A	; JUMP IF FILE NOT ASCII
	ADD	AC2,D.WPR(I16)	; POINT TO FIRST WRD OF NEXT REC
	SKIPA 	AC5,AC2		; PUT IT IN AC5
				; SKIP,FINISH AND EXIT

	; HERE IF NON-ASCII READ, ADVANCE PTR AC5 TO NEXT WORD

RNRE2A:	ADDI	AC5,1		; ADVANCE NEXT RECORD PTR AND CONT
RNRE2B:	SETZM	R.WRIT(I12)	;THE LAST COBOL UUO WAS A READ
	JRST	RANXIT		; TAKE NORMAL RANDOM EXIT
	; HERE FOR SEQ-IO READ. CHECK FOR NULL RECORD, 
	; IFSO , COUNT IT AS REC FOR LOG-BLK AND START WITH NEXT
	; WHEN REAL RECORD START IS FOUND , READ REC. 


RANRE5:	MOVE	AC10,D.RCNV(I16) ;GET CONVERSION INSTR

RANRE6:	SOJL	AC3,RANRE9	;CNT CHAR,JUMP END OF REC
RANRE8:	ILDB	C,AC5		;GET CHAR
	CAIE	11,15		;[1031] EXCLUDE <CR> <LF> WHEN DECREMENTING 
	CAIN	11,12		;[1031] THE CHRCNT
	JRST	RANRE8		;[1031]
	XCT	AC10		;CONVERT
	JUMPLE	C,RANRE6	;SKIP LEAD NULL AND EOR CHARS
	JRST	RANRE7		;GOT REAL CHAR,GET REC

	; NULL RECORD FOUND, COUNT THIS ONE AND GET START OF NEXT

RANRE9:	SKIPE	D.RCL(I16)	;LAST REC IN LBLK?
	JRST	RANR12		; NO
	MOVE	AC1,D.LBN(I16)	; YES,GET LAST LBLK #
	CAMLE	AC1,D.CBN(I16)	;LAST LBLK?
	JRST	RANR10		; NO,GET NEXT LBLK
	TLO	FLG,ATEND	; YES,SET ATEND
	SETOM	R.WRIT(I12)	;SET NO READ LAST I-O
	PUSHJ	PP,ENDSTS	;SET NO NEXT REC STATUS
	JRST	RANXI0		;EXIT WITH ATEND SKIP

RANR10:	HRRZ	AC1,D.BPL(I16)	;GET BUFF/LBLK
	ADD	AC1,D.CBN(I16)	;INDICATE CURRENT BUF #
	PUSHJ	PP,RANIN	;DO INPUT,WRITE IF BUF DIRTY
	 JRST	RANR11		;SUCCESS,CONT
	OUTSTR	[ASCIZ/?EOF in RANRE5, internal error./] ;EOF
	JRST	KILL.		;COMPLAIN AND EXIT

RANR11:	MOVE	AC5,R.BPNR(I12)	;SET NEXT REC PTR
RANR12:	SOS	D.RCL(I16)	;CNT THIS REC
	LDB	AC3,F.BMRS	;SET MAX REC SIZE
	MOVE	AC10,D.RCNV(I16) ;GET CONVERSION INSTR
	JRST	RANRE8		;CONT SCAN FOR REC

				;FIRST BACK UP ONE CHAR
RANRE7:
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RANR7R		; NO, CURRENT POSITION RESET
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPN	AC0,RNRE7A	; IF NOT SEQ ACCESS SKIP POSITION CHANGE
>
RANR7R:	MOVE	AC1,AC5		; GET COPY CURRENT POS PTR
	SUBI	AC1,1		; BACK TO PREV. WORD
	IBP	AC1		; SKIP AHEAD
	IBP	AC1		; SKIP AHEAD
	IBP	AC1		; SKIP AHEAD
	IBP	AC1		; SKIP AHEAD
	MOVEM	AC1,R.BPLR(I12)	; SET LAST PTR TO CHAR JUST
				; BEFORE REC START
RNRE7A:	LDB	AC3,F.BMRS	;GET MAX REC SIZE
	MOVE	AC0,AC3		;SAVE MAX REC SIZE
	MOVEM	AC0,D.CLRR(I16) ;SAVE HERE TOO

RANR13:
	IDPB	C,AC6		;PUT CHAR
	SOJE	AC3,RNR13A	;CNT CHAR,JUMP IF ALL MOVED
	ILDB	C,AC5		;GET ANOTHER
	XCT	AC10		;CONVERT
	JUMPGE	C,RANR13	;LOOP TIL EOR

	JUMPLE	AC3,RANR14	;REC FILLED? JUMP IF SO

	; FILL END OF RECORD WITH BLANKS

	SUB	AC0,AC3		;GET SIZE ACTUALLY READ
	MOVEM	AC0,D.CLRR(I16)	;UPDATE CHAR LENGTH OF REC READ
	MOVEI	C," "		; NO, GET BLANK
	XCT	AC10		;[1130]CONVERT
	IDPB	C,AC6		; WRT BLANK IN REC
	SOJG	AC3,.-1		; BLANK FILL REC
	JRST	RANR14		; FIN

	; REC FILLED , CHECK FOR SCAN TO EOR CHAR

RNR13A:	HRRZ	AC1,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNE	AC1,SASCII	; SKIP IF NOT STANDARD ASCII
	JRST	RANR14		; ELSE SKIP EOR SCAN
	MOVE	AC1,D.RCL(I16)	; GET RECS LEFT IN LOG-BLK
	SOJLE	AC1,RANR14	; IS THIS LAST RECORD IN LOG-BLK?
				; YES, JUMP ,DON'T BOTHER WITH EOR SCAN 
				; NO, CONT EOR SCAN

REPEAT 1,<			;[1024] THIS PATCH IS NOT WORTH IT
				; THERE ARE OTHER PLACES WHERE THE COUNT CAN RUN OUT
;[1024] THE PATCH IS NECESSARY FOR THE LAST BLOCK OF A FILE
	MOVE	AC1,D.LBN(I16)	;[1024] GET LAST BLOCK NO.
	CAME	AC1,D.CBN(I16)	;[1024] SAME AS CURRENT BLOCK?
	JRST	RNR13D		;[1024] NO, SKIP CALCULATION
	PUSH	PP,AC5		; SAVE CURRENT POSITION INCASE WE DON'T FIND EOR
	HLRZ	AC1,D.BL(I16)	; GET POINTER TO IOWD
	MOVE	AC1,(AC1)	; GET IOWD
	HLRO	AC0,AC1		; GET NO. OF WORDS (NEGATIVE)
	MOVNS	AC0		; POSITIVE WORDS
	IMUL	AC0,D.BPW(I16)	; BYTES IN BUFFER
	SUBI	AC5,(AC1)	; NO. OF FULL WORDS USED + PARTIAL LAST WORD
	HRRZ	AC1,AC5
	IMUL	AC1,D.BPW(I16)	; CHARACTERS USED
	TRNA			; NOW ACCOUNT FOR UNUSED CHAR IN PARTIAL WORD
	IBP	AC5
	TLNE	AC5,760000	; ALL BYTES USED?
	SOJA	AC1,.-2		; NOT YET
	MOVNS	AC1,AC1
	ADD	AC1,AC0		; GET NUMBER OF UNUSED CHAR IN BUFFER
	MOVE	AC5,(PP)	; RESTORE INPUT BYTE POINTER
RNR13B:	ILDB	C,AC5		; GET A CHAR
	XCT	AC10		; CONVERT IT
	JUMPL	C,RNR13C	; FOUND AN EOR CHAR
	SOJG	AC1,RNR13B	; NOT FOUND YET
	POP	PP,AC5		; RESTORE PREVIOUS POINTER
	JRST	RANR14

RNR13C:	POP	PP,AC1		; CLEAN UP STACK
	JRST	RANR14		;[1024] CONT
>
RNR13D:	ILDB	C,AC5		;[1024] GET A CHAR
	XCT	AC10		;[1024] CONVERT IT
	JUMPGE	C,RNR13D	;[1024]	SCAN TO EOR CHAR
REPEAT 0,<			;[1024] THIS IS THE ORIGINAL CODE
RNR13B:	ILDB	C,AC5		; GET A CHAR
	XCT	AC10		; CONVERT IT
	JUMPGE	C,RNR13B	; SCAN TO EOR CHAR
>

RANR14:
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNR14A		; NO, CURRENT POSITION RESET
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPN	AC0,.+2		; IF NOT SEQ ACCESS SKIP POSITION CHANGE
>
RNR14A:	MOVEM	AC5,R.BPNR(I12)	;UPDATE NEXT REC PTR
	SETZM	R.WRIT(I12)	;READ WAS LAST I-O
	JRST	RANXI0		;FINISH AND EXIT
	;SETUP FLAG WORDS AND EXIT.  ***WRTRE7***
				
RANXIT:
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNXITA		; NO, CONT
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	CAIE	AC0,%FAM.D	;[1077] IF DYNAMIC, COULD NEED SEQ POINTERS
	JUMPN	AC0,RANXI0	; IF NOT SEQ ACCESS SKIP POSITION CHANGE
>
RNXITA:	MOVE	AC0,R.BPNR(I12)	; CURRENT RECORD
	MOVEM	AC0,R.BPLR(I12)	; LAST RECORD
	HRRI	AC0,(AC5)	; ADR OF 1ST WRD OF NEXT ASCII REC
	MOVEM	AC0,R.BPNR(I12)	;BP TO NEXT RECORD
RANXI0:	SKIPN	F.WSMU(I16)	;[1065] SIMULTANEOUS UPDATE?
	 JRST	RNXI0A		;[1065] NO
	MOVE	AC2,SU.T1##	;[1065] GET RRT ENTRY
	HLLZ	AC3,1(AC2)	;[1065] IS RETAIN NEXT
	TLNN	AC3,400000	;[1065] FLAG ON?
	 JRST	RNXI0A		;[1065] NO.
	MOVE	AC1,F.RACK(I16)	;[1065] IF SO, WE NEED TO GET 
	MOVE	AC3,(AC1)	;[1065] THE KEY AND
	MOVEM	AC3,2(AC2)	;[1065] PUT IT IN THE RRT.
RNXI0A:				;[1065]
	TLNE	FLG,RANFIL	;[273] IF A RANDOM FILE
	JRST	RANXI1		;[273]  ZERO ATEND FLAG
	TXNN	AC16,V%READ	;SKIP IF A READ
	JRST	RANXI2		;WRITE HAS NO ATEND SKIP EXIT
	TLNN	FLG,ATEND	;SKIP IF ATEND
RANXI1:	TLZE	FLG,ATEND	;ZERO THE ATEND FLAG
	JRST	RANXI4		;HERE ON ATEND
RANXI2:	MOVEM	FLG,F.WFLG(I16)	;SAVE FLAGS
	HLLM	FLG1,D.F1(I16)	;SAVE MORE FLAGS
	HLLZS	UOUT.		;ZERO THE RIGHT HALF
	HLLZS	UIN.		;   IOWD POINTER
;[D1064] SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE ?
;[D1064] PUSHJ	PP,LRDEQX##	; YES
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	SETZM	R.DLRW(I12)	; NO,CLEAR DEL/RWT SAVE BLK NUM
>
	TLNE	FLG,IOFIL	;BL; [622] IF THIS IS AN IO FILE
	TXNN	AC16,V%WRIT	;BL; ARE WE WRITING?
	JRST	WRTRE7		;BL; NO, DON'T UPDATE LAST BLOCK
	MOVE	AC0,D.CBN(I16)	; UPDATE THE LAST BLOCK NUMBER
	CAMLE	AC0,D.LBN(I16)	; IF CURRENT BN IS GT LAST BN
	MOVEM	AC0,D.LBN(I16)	; SAVE IT AS LBN
	JRST	WRTRE7		;EXIT TO USER

RANXI4:	TLNE	FLG,RANFIL	;RANDOM FILE?
	SOS	D.RCL(16)	;YES - DONT COUNT THIS RECORD
RANXI3:	AOS	(PP)		;SKIP EXIT
	SKIPN	AC1,FS.FS	; NO CHANGE IF NON ZERO
	MOVEI	AC1,^D10	; READ INVALID KEY
	MOVEM	AC1,FS.FS	; LOAD FILE-STATUS
	SETOM	R.WRIT(I12)	;READ NOT SUCCESSFUL
	JRST	RANXI2		;

RANXI8:
IFN ANS74,<
	PUSHJ	PP, NRESTS	; REC NOT FOUND STATUS (23)
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNXI8A		; NO, CURRENT POSITION RESET
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPN	AC0,RANXI1	; IF NOT SEQ ACCESS SKIP POSITION CHANGE
>
RNXI8A:	MOVE	AC0,R.BPNR(I12)	;[273] KEEP THE RECORD POINTERS
	MOVEM	AC0,R.BPLR(I12)	;[273] UP TO DATE
IFN ANS74,<
	SKIPE	NRSAV.+4	; EXIT IF ACTUAL KEY NOT SAVED
	TXNN	AC16,V%STRT	; SKIP IF START FAILED
	JRST	RANXI1		; ELSE EXIT
	MOVE	AC0,[-5,,NRSAV.+3]; IT IS SO BACK UP TO
	POP	AC0,D.RCL(I16)	; THE RECORD POSITION
	AOS	D.RCL(I16)	;
	POP	AC0,D.RP(I16)	; JUST AFTER THE LAST
	POP	AC0,FS.RN	; REAL RECORD SO APPEND
	POP	AC0,R.BPLR(I12)	; WILL FIND THE RIGHT RECORD SLOT
	MOVE	AC0,R.BPLR(I12)	; NOW, MAKE THE NEXT RECORD SLOT
	MOVEM	AC0,R.BPNR(I12)	; BE THE SAME AS THE LAST RECORD SLOT
	SETZM	NRSAV.		; ZERO NULL-REC-IN-LAST-BLOCK FLAG
	SETZM	R.WRIT(I12)	; ZERO THE WRITE FLAG
	HRRZ	AC4,F.RACK(I16)	;GET POINTER TO RELATIVE KEY
	MOVE	AC2,NRSAV.+4	; GET KEY
	SKIPE	AC4		; SKIP IF NO KEY POINTER
	MOVEM	AC2,(AC4)	; SAVE IT FOR INVALID KEY CONDITION
>
	JRST	RANXI1		;[273]
	;SIXBIT: BLT THE RECORD TO/FROM THE BUFFER AREA.

RANBR:	EXCH	AC5,AC6		;GO THE OTHER WAY
RANRB:	HRL	AC5,AC6		;FROM,,TO
	HRRZM	AC5,TEMP.	;
	TXNE	AC16,V%READ	;SKIP IF NOT READ
	HLRZM	AC5,TEMP.	;BUFFER ORIGIN
	MOVEI	AC4,6		;SIX PER WORD
RANBR1:	IDIV	AC3,AC4		;CONVERT TO WORDS
	JUMPE	AC4,.+2		;SKIP IF NO REMAINDER
	ADDI	AC3,1		;ELSE ACCOUNT FOR IT
	MOVE	AC0,AC3		;SAVE ACT SIZE FOR ZERO FILL
	ADDM	AC3,TEMP.	;NEXT RECORD
	ADDI	AC3,-1(AC5)	;UNTIL
	TXNE	AC16,V%DLT	;IS THIS DELETE??
	SUBI	AC3,1		;YES, DO THIS TO MAKE UP FOR AC5=BUFF,,BUFF+1
				;NOT AC5=REC,,BUFF
	BLT	AC5,(AC3)	;ZRAPPP!
	MOVE	AC5,TEMP.	;
	TXNN	AC16,V%READ	;SKIP IF IT'S A READ
	JRST	RANBR2		;NOP, A WRITE
	TLNE	FLG,DDMBIN	;IS DEVICE BINARY?
	JRST	RNRE2B		;YES,NO FILL NEEDED,FINISH UP
	ADDI	AC1,5		;GET MAX SIZE
	IDIVI	AC1,6		;  IN WORDS
	SUB	AC1,AC0		;WHAT'S THE DIFFERENCE?
	JUMPLE	AC1,RNRE2B	;  DONE IF THE SAME
	SETZM	1(AC3)		;ZERO THE FIRST WORD
	HRLI	AC2,1(AC3)	;FROM
	HRRI	AC2,2(AC3)	;FROM , TO
	ADDI	AC1,(AC3)	;UNTIL
	CAIL	AC1,(AC2)	;DONE IF ONLY ONE WORD
	BLT	AC2,(AC1)	;FILL IN THE ZEROS
	JRST	RNRE2B		;
RANBR2:	JUMPE	AC4,RNWR2X	;EXIT HERE IF NO FILL REQUIRED
	HRREI	AC1,-6		;ASSUME RECORD IS SIXBIT
	TLNN	FLG,CDMSIX	;  IF NOT SIXBIT
	HRREI	AC1,-7		;  ITS ASCII
	IMUL	AC4,AC1		;ZERO FILL THE LAST DATA WORD
	SETO	AC0,		;--
	LSH	AC0,(AC4)	;--
	ANDCAM	AC0,(AC3)	;DOIT
	JRST	RNWR2X		; TAKE NORMAL EXIT

	;BINARY: BLT THE RECORD TO/FROM THE BUFFER AREA.

RANBIN:	HRL	AC5,FLG		;FROM RECORD TO BUFFER
	HRRZM	AC5,TEMP.	;SAVE BUFFER LOC
IFN ANS74,<
	TXNN	AC16,V%DLT	; IS THIS DELETE??
	JRST	RANBNA		; NO,GO ON
	HRLS	AC5		; YES,SET SO IT WILL BLT TO ITSELF
	SETZM	(AC5)		; CLEAR FIRST WORD
	ADDI	AC5,1		; SET TO BLT . TO .+1
RANBNA:>;END IFN ANS74
	TXNE	AC16,V%READ	;IF READ,
	MOVSS	AC5		;  REVERSE THE DIRECTION OF BLT
	LDB	AC4,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC4,RBPTBL(AC4)	; GET CHARS PER WORD

	JRST	RANBR1
	;ALL RANDOM/IO INPUTS ARE EXECUTED FROM HERE.  OUTPUTS ARE
	;EXECUTED ONLY WHEN THERE IS ACTIVE DATA IN THE BUFFER AND
	;AND AN INPUT IS ABOUT TO OVERWRITE IT.  THE LAST ACTIVE DATA
	;IS CAUGHT BY THE CLOSE UUO.   ***POPJ***

RANIN:
IFN ANS74,<
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RANI0A		; NO, RESET CURRENT BLK NUM
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	JUMPE	AC0,RANI0A	; IF SEQ ACCESS SKIP THIS SAVE
	MOVE	AC0,D.CBN(I16)	; GET CURRENT BLK NUM
	SKIPN	R.DLRW(I12)	; DON'T RESET IF ALREADY SET
	MOVEM	AC0,R.DLRW(I12)	; AND SAVE IT FOR SEQ "CURRENT" POSITION
	TDNA			; AND SKIP
>
RANI0A:	
IFN ANS74,<
	SETZM	R.DLRW(I12)	; CLEAR DEL/RERIT SAVE 
>
	SKIPGE	R.DATA(I12)	;SKIP IF THERES NOTHING TO OUTPUT
	PUSHJ	PP,RANOUT	;
	MOVEM	AC1,D.CBN(I16)	;SAVE CURRENT PHYS BLOCK NUMBER
	MOVEM	AC1,FS.BN	;SAVE BLOCK-NUMBER
	HLLZS	D.IBL(I16)	;[475] TURN FLAG OF IN CASE
	CAML	AC1,D.LBN(I16)	;[475] IF WE ARE READING LAST BLOCK
	HLLOS	D.IBL(I16)	;[475] IT MAY BE A PART BLOCK REMEMBER
	TLNN	FLG,RANFIL	;SKIP THE USETI IF SEQIO
	JRST	RANI00		;SKIP


IFN LSTATS,<			;CALL I/O HISTOGRAM ROUTINE TO RECORD
				; THIS BLOCK REFERENCE
  IFN ANS74,<
	LDB	AC5,F.BFAM	;GET ACCESS MODE
	JUMPE	AC5,RANMRX	;IF SEQ ACCESS SKIP THIS
  >
	MOVEM	AC1,MRBNUM	;BLOCK NUMBER STORED HERE
	PUSHJ	PP,IOHSTR	;CALL HISTOGRAM ROUTINE
RANMRX:
>;END IFN LSTATS

	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSI		; DO A FILOP. TYPE USETI
	  XCT	USETI.		;*****************
RANI00:	HRRM	AC12,UIN.	;DUMP MODE IOWD
	LDB	AC5,F.BBKF	;BLOCKING FACTOR
IFN ANS68,<
	TXNN	AC16,V%READ	;SKIP IF READ UUO
	CAIE	AC5,1		;DONT INPUT IF BLOCKING-FACTOR = 1
>
RANIN0:	TLNN	FLG,OPNIN!RANFIL ;DONT INPUT IF NOT OPEN FOR INPUT
	JRST	RANIN5		; NORMAL RET
	AOS	D.IE(I16)	;COUNT INPUT EXECUTED
	HRRZ	AC10,D.IBL(I16)	;[475] SKIP IF WE ARE ABOUT TO READ LAST BLOCK
	JUMPE	AC10,RNIN0A	;[475] ELSE DON'T CLEAR
	PUSH	PP,AC4		;SAVE AC4 FOR EBCDIC READ
	PUSHJ	PP,ZDMBUF	;[475] SO CLEAR BUFFER OF OLD GARBAGE
	POP	PP,AC4		;GET BACK AC4
RNIN0A:	XCT	UIN.		;********************
	 JRST	RANIN1		;NORMAL RETURN
	MOVEM	AC2,TEMP.1	;SAVE AC2
	 PUSHJ	PP,READCK	; ERROR RETURN
RANIN1:	 SKIPA	AC10,R.BPFR(I12);BYTE POINTER TO FIRST RECORD
	JRST	RANIN3		;EOF WAS SEEN  ;READI1 SKIP EXIT
IFN ANS74,<
	TXNE	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNIN1B		; IFSO SKIP NEXT REC RESET
>
	MOVEM	AC10,R.BPNR(I12);POINTER TO CURRENT RECORD
	MOVEM	AC5,D.RCL(I16)	;REMAINING RECORDS IN CURRENT BLOCK
RNIN1B:	JUMPGE	FLG1,RET.1	; VAR-LEN RECS DROP THROUGH
	HRRZ	AC10,R.BPFR(I12); GET POINTER TO BDW
	MOVS	AC0,-1(AC10)	; GET BDW
	JUMPN	AC0,RNIN1A	; JUMP IF NOT NULL BLOCK
	TXNN	AC16,V%READ	; SKIP IF READ,WHEN D.FCPL WILL BECOME =-4
	PUSHJ	PP,MAKBDW	; CREATE BDW
RNIN1A:	SUBI	AC0,4		; -4 FOR BDW ITSELF
	MOVEM	AC0,D.FCPL(I16)	; SAVE AS FREE CPL
	POPJ	PP,

	;HERE ON END-OF-FILE
RANIN3:	MOVE	AC2,R.IOWD(I12)	;GET IOWD TO BUFFER
	SKIPE	1(AC2)		; SKIP IF A 0 SEEN
	 JRST	.+3		;SOMETHING THERE
	AOBJN	AC2,.-2		;LOOP UNTIL NON-ZERO WORD SEEN
	JRST	RANIN4		; NOTHING WAS INPUT - IT IS REALLY EOF
	MOVE	AC2,TEMP.1	;RESTORE AC2
	TLZ	FLG,ATEND	;YES, SO TURN OFF THE EOF
	JRST	RANIN1		;  AND MAKE BELEIVE IT DIDN'T HAPPEN

RANIN4:	MOVE	AC2,TEMP.1	;RESTORE AC2
	TXNN	AC16,V%READ	;READ UUO?
	TLZA	FLG,ATEND	;  WRITE UUO SO CLEAR "ATEND"
	AOSA	(PP)		;  READ GETS A SKIP EXIT
	JRST	RANIN5		; TAKE NORMAL RETURN
IFN ANS68,<
	HRRZ	AC4,F.RACK(I16)
	MOVE	AC4,(AC4)		;GET ACTUAL KEY AGAIN
>
IFN ANS74,<
	LDB	AC4,F.BFAM	;GET FILE ACCESS MODE
>
	TLNE	FLG,RANFIL	; SEQUENTIAL FILE?
	SKIPN	AC4		; [601] NO,ACTUAL-KEY 0?(FILE IS SEQ?)
	JRST	RANN4B		; SEQ FILE HERE
	TXNN	AC16,V%RNXT	; IS THIS READ NEXT?
	JRST	RANN4A		; [601] NO,"RECORD NOT FOUND" GOES HERE
RANN4B:	PUSHJ	PP,ENDSTS	; [601] YES,SET NO NEXT RECORD
	JRST	RANIN5		; [601] GO ON

RANN4A:	PUSHJ	PP,NRESTS	; [601]SET NO RECORD FOUND STATUS

	;IF VAR LEN RECS MAKE A BLOCK DESCRIPTOR WORD
RANIN5:	JUMPGE	FLG1,RANIN1	; JUMP IF FIXED LEN RECS
	PUSHJ	PP,MAKBDW	; MAKE BDW FOR NEW BLOCK
	JRST	RANIN1		; CONTINUE WITH NORMAL RETURN

	;ROUTINE TO MAKE BDW AT FIRST WORD IN BLK
MAKBDW:	HRRZ	AC10,R.BPFR(I12); GET POINTER TO BDW (POINTS AFTER BDW)
	HRRZ	AC0,D.TCPL(I16)	; GET BLOCK SIZE
	ADDI	AC0,4		; PLUS 4 FOR BDW
	MOVSM	AC0,-1(AC10)	; SAVE AS BDW
	POPJ	PP,		; RETURN
	;ALL RANDOM/IO OUTPUTS ARE EXECUTED FROM HERE.  ***@POPJ***

RANOUT:	SETZM	R.DATA(I12)	;NOTE DATA WENT OUT
	EXCH	AC1,D.CBN(I16)	;NEXT BLOCK,,CURRENT BLOCK
	MOVEM	AC1,FS.BN	;SAVE FOR ERROR STATUS
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSO		; DO A FILOP. TYPE USETO
	  XCT	USETO.		;******************
	MOVE	AC1,D.CBN(I16)	;NEXT BLOCK BECOMES CURRENT BLOCK
	HRRM	AC12,UOUT.	;DUMP MODE IOWD
	JRST	WRTOUT		;DO IT

	;CHECK ACTUAL KEY AGAINST THE FILE-LIMIT-CLAUSES AND TAKE
	;THE INVALID-KEY RETURN IF NOT LEGAL.  ***POPJ***

IFN ANS68,<
FLIMIT:	MOVE	AC1,R.FLMT(I12)	;PICK UP THE IOWD "FLC"
	HRRZ	AC4,F.RACK(I16)
	SKIPN	AC4,(AC4)	;ACTUAL KEY
	POPJ	PP,		;OK IF 0, HE WANTS TO READ SEQ FROM HERE
	TRNA
FLIMI1:	ADDI	AC1,2		;ACCOUNT FOR TWO LIMIT WORDS
	CAMLE	AC4,2(AC1)	;SKIP IF ACTKEY LE LARGER LIMIT
	JRST	.+3
	CAML	AC4,1(AC1)	;SKIP IF ACTKEY L THE SMALLER LIMIT
	POPJ	PP,		;OK EXIT
	AOBJN	AC1,FLIMI1	;
	TXNN	AC16,V%READ!V%WRITE!V%WADV ;SKIP IF NOT A SEEK UUO
	POPJ	PP,		;SEEK, RETURN TO ***ACP***
	POP	PP,(PP)		;POP OFF RETURN ADR
	TXNN	AC16,V%READ	;INVALID-KEY EXITSKIP IF READ
	AOS	(PP)		;SKIP OVER THE OPERAND
	MOVEI	AC1,^D24	;BOUNDRY VIOLATION
	MOVEM	AC1,FS.FS	;LOAD FILE-STATUS
	PUSHJ	PP,IVKSTS	;[601] BOUNDARY VIOLATION, SET FILE STATUS
	JRST	RET.2		;  AND TAKE A SKIP EXIT   ***ACP***
>

	;ZERO THE DUMP MODE BUFFER AREA

ZDMBUF:	HLRO	AC4,R.IOWD(I12)	;-LEN
	HRR	AC1,R.IOWD(I12)	;LOC-1
	HRLI	AC1,1(AC1)	;FROM
	HRRI	AC1,2(AC1)	;TO
	SETZM	-1(AC1)		;THE ZERO
	MOVN	AC4,AC4		;LEN
	ADDI	AC4,-1(AC1)	;UNTIL
	BLT	AC1,(AC4)	;DOIT
	POPJ	PP,

RANLF:	SKIPA	C,[$LF]		;
RANCR:	MOVEI	C,$CR		;
	IDPB	C,AC5		;
	POPJ	PP,		;
IFN ANS74,<
	;IF ACCESS MODE IS SEQUENTIAL 
	; SET AC4 = 0 IF NO RELATIVE KEY
	; ELSE SET AC4 TO NEXT RECORD AND UPDATE KEY
	;IF ACCESS MODE IS RANDOM MAKE SURE KEY IS VALID (GREATER THAN 0)
	;F.BFAM   0 = SEQUENTIAL, 1 = RANDOM, 2 = DYNAMIC

SETKEY:	LDB	AC1,F.BFAM	;GET ACCESS MODE
	HRRZ	AC4,F.RACK(I16)	;GET POINTER TO RELATIVE KEY
	SKIPN	AC2,AC4		; SKIP IF KEY PTR EXISTS
	JRST	SETKE1		; NO KEY PTR SO 0 KEY
	SKIPN	AC2,NRSAV.+4	; GET SAVED KEY IF ANY
	MOVE	AC2,(AC4)	; GET KEY
SETKE1:	MOVEM	AC2,NRSAV.+4	; SAVE IT FOR INVALID KEY CONDITION
	JUMPE	AC4,SETKSA	;NO KEY SPECIFIED, READ SEQUENTIALLY
	TXC	AC16,V%READ!V%RNXT	;READ NEXT RECORD?
	TXCN	AC16,V%READ!V%RNXT
	JRST	[SKIPL	R.STRT(I12)	;YES
		JRST	SETKSA		;THEN ITS SEQUENTIAL
		JRST	.+1]		;UNLESS START WAS LAST IO
	TXNE	AC16,V%READ
	TXNN	AC16,V%STRT	;IS IT START?
	JRST	@[EXP SETKYS,SETKYR,SETKYD](AC1)
	SKIPE	(AC4)		; SKIP IF ZERO KEY VALUE
	JRST	SETKE2		; NON ZERO, CONT
	TXNN	AC16,STA%EQ	; START = ?
	JRST	STKYRX		; YES,0 KEY VALUE (ERROR)
SETKE2:	TXZN	AC16,STA%GT	;GREATER THAN?
	JRST	@[EXP SETKSS,SETKYR,SETKYD](AC1)
	TXO	AC16,STA%NL	;YES, MAKE NOT LESS THAN
	AOS	(AC4)		;AND INCREMENT THE KEY
	JRST	@[EXP SETKSS,SETKYR,SETKYD](AC1)

	;SEQUENTIAL
SETKSS:	SKIPE	AC4,(AC4)	;GET KEY FOR START
	POPJ	PP,
SETKYS:	SKIPN	R.BPLR(I12)	;FIRST TIME?
	SETZM	(AC4)		;YES, START AT FRONT OF FILE
	TXNN	AC16,V%DLT	;DELETING LAST RECORD READ?
	SKIPE	R.STRT(I12)	; OR LAST IO WAS A START
	TRNA			;NO
	AOSA	(AC4)		;NO, INCREMENT KEY
	SKIPA	AC4,(AC4)	;YES
SETKSA:	SETZ	AC4,		;SIGNAL SEQUENTIAL
	SETZM	R.STRT(I12)	;ONLY ONCE
	POPJ	PP,

	;RANDOM
SETKYR:	SETZM	R.STRT(I12)	;CLEAR LAST IO WAS START
	SKIPE	AC4,(AC4)	;RELATIVE KEY
	POPJ	PP,		; RETURN WITH KEY SET UP
STKYRX:	POP	PP,(PP)		;POP OFF RETURN ADR
	TXNN	AC16,V%READ!V%DLT	;INVALID-KEY EXITSKIP IF READ
	AOS	(PP)		;SKIP OVER THE OPERAND
	PUSHJ	PP,IVKSTS	;BOUNDRY VIOLATION - LOAD FILE-STATUS
	JRST	RET.2		;  AND TAKE A SKIP EXIT   ***ACP***

	;DYNAMIC
SETKYD:	JRST	SETKYR		;SEQUENTIAL TAKEN CARE OF, MUST BE RANDOM
>
	;HERE BEFORE WRITING A NEW RECORD
	;MAKE THE OLD RECORD SIZE CONFORM TO NEW SIZE
RANSHF:	CAMN	AC2,AC3		;ACTUAL-SIZE VS NEW-SIZE
	POPJ	PP,		;SKIP THIS MESS
	MOVE	AC4,D.RCL(I16)	;IF NO RECORDS FOLLOWING
	JUMPE	AC4,RANS09	;  DONE
	MOVEI	AC0,5(AC3)	;NEW SIZE
	IDIVI	AC0,6		;  IN WORDS
	MOVEI	AC1,5(AC2)	;ACTUAL SIZE
	IDIVI	AC1,6		;  IN WORDS
	SUB	AC0,AC1		;NS - AS
	JUMPE	AC0,RANS09	;SAME SIZE SO EXIT

;FIND THE LAST DATA WORD IN THIS LOGICAL BLOCK
	MOVE	AC10,AC1	;SIZE OF THIS RECORD
	MOVEI	AC2,-1(AC5)	;ADR OF THIS RECORD'S HEADER WORD
RANS01:	ADDI	AC2,1(AC10)	;ADR OF NEXT HEADER WORD
	HRRZ	AC10,@AC2	;SIZE OF NEXT RECORD IN CHARACTERS
	ADDI	AC10,5		;  --
	IDIVI	AC10,6		;  IN WORDS
	SOJG	AC4,RANS01	;LOOP IF ANY MORE
	ADDI	AC2,(AC10)	;ADR OF LAST DATA WORD
	HRRO	AC10,AC5	;ADR OF THE FIRST RECORD WORD
	ADD	AC10,AC1	;ADR OF NEXT RECORD'S HEADER WORD
	JUMPG	AC0,RANS03	;IF POSITIVE MAKE A LARGER HOLE

;NEGATIVE SO MAKE A SMALLER HOLE
	HRLS	AC10		;ADR OF NEXT RECORD HEADER WORD
	ADD	AC10,AC0	;  PLUS THE DIFFERENCE
	ADD	AC2,AC0		;THE BLT UNTIL POINTER
	BLT	AC10,(AC2)	;MOVE IT
	SETZM	1(AC2)		;TERMINATE DATA
	JRST	RANS09

;POSITIVE SO MAKE A LARGER HOLE
RANS03:	HRRZ	AC4,AC2		;ADR OF LAST DATA WORD
	SUBI	AC4,-1(AC10)	;NUMBER OF WORDS TO MOVE
	HRR	AC10,AC2	;START WITH THE LAST DATA WORD
	HRLI	AC0,(POP AC10,(AC10))
	HRLZI	AC1,(SOJG AC4,AC0)
	HRLZI	AC2,(POPJ PP,)
	PUSHJ	PP,AC0		;POP-POP-POP
RANS09:	HRRZM	AC3,-1(AC5)	;GIVE IT A HEADER WORD
	HRRZ	AC2,AC3		;RESTORE AC2
	POPJ	PP,
	;FORCE WRITE FOR SIMULTANEOUS UPDATE
FORCW.:: MOVE	AC0,[FS.ZRO,,FS.FS] ; CLEAR FILE STATUS BLOCK
	BLT	AC0,FS.IF	; FOR POSSIBLE ERROR ACTION
	PUSHJ	PP,SETCN.	; SET UP CHANNEL NUMBER
	MOVE	FLG,F.WFLG(I16)	; JUST IN CASE OF ERRORS
	MOVE	AC1,D.CBN(I16)	; GET THE BLOCK NUMBER
	HLRZ	AC12,D.BL(I16)
	PUSHJ	PP,RANOUT	; GO WRITE IT OUT
	 SOS	(PP)		; NORMAL RETURN
	SOS	D.OE(I16)	; DON'T COUNT THIS OUTPUT
	HLLZS	UOUT.		; CLEAR IOWRD PTR
	SETZM	R.DATA(I12)	; SET NO ACTIVE DATA FLAG
	JRST	RET.2		; RETURN

	;FORCE READ FOR SIMULTANEOUS UPDATE
FORCR.:: MOVE	AC0,[FS.ZRO,,FS.FS] ; CLEAR FILE STATUS BLOCK
	BLT	AC0,FS.IF	;
	MOVE	FLG,F.WFLG(I16)	; GET FLG REGISTER
IFN ISAM,<TLNE	FLG,IDXFIL	;ISAM FILE?
	JRST	FORCRY		;JUMP IF FILE INDEXED
>
	MOVE	AC1,D.CBN(I16)	; GET BLOCK NUMBER
	MOVEM	AC1,FS.BN	; SAVE FOR ERROR ACTION
	PUSHJ	PP,SETCN.	; SET UP CHANNEL
	HLRZ	AC12,D.BL(I16)
	HRRM	AC12,UIN.	; SET IOWRD PTR
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSI		; DO A FILOP. TYPE USETI
	  XCT	USETI.		; THIS IS THE BLOCK
	XCT	UIN.		; TO READ
	 JRST	FORCRX		; NORMAL RETURN
	PUSHJ	PP,READCK	; ERROR RETURN (EOF?)
	 JRST	FORCRX		; SHOULD NOT GET HERE
	TLNN	FLG,ATEND	; EOF GETS NORMAL RETURN
	AOS	(PP)		; ERROR GETS SKIP RET
FORCRX:	HLLZS	UIN.		; CLEAR THE IOWRD PTR
	POPJ	PP,

IFN ISAM,<
	;ZERO THE ISAM BLOCK NUMBERS TO CAUSE FRESH INPUTS
FORCRY:
IFN ISTKS,<HLRZ I12,D.BL(I16)
	   AOS INSSSS+15(I12)>
	HLRZ	I12,D.BL(I16)	;ZERO POINTERS
	HRRI	AC1,USOBJ(I12)
	HRLI	AC1,(AC1)
	ADDI	AC1,1
	SETZM	-1(AC1)
	BLT	AC1,USOBJ+13(I12)
	SETZM	CNTRY(I12)	;[1027] ZERO BUFFER ADDRESS
	PUSHJ	PP,VNDE1	; READ FRESH COPY OF STATISTICS BLOCK
	  POPJ	PP,		; NO NEW LEVELS EXIT
	POPJ	PP,
>
SUBTTL ISAM-CODE
IFN ISAM,<
	;INDEX-SEQ READ
IREAD:	SETZ	FLG1,		;[605]  INITIALIZE FLG1
	PUSHJ	PP,SETIC	;SET THE CHANNEL
	HRR	AC0,F.WBSK(I16)
	HRRM	AC0,GDPSK(I12)
	AOS	RWRSTA(I12)	;# OF READ/WRITE/REWRITES
IFN ANS74,<			;[605]
	TXNE	AC16,V%STRT	;[605] SKIP IF NOT START
	JRST	ISTRT		;[605] START GOES HERE
>				;[605]
	PUSHJ	PP,LVTST	;SYMKEY = LOW-VALUES ?
	 JRST	SREAD		;YES, SEQUENTIAL READ

IFN ANS74,<	;  CLEAR SAVED NEXT RECORD POSITION FLAG
	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
	TRZ	AC0,SAVNXT	; CLEAR FLAG FOR NXT REC POS SAVED
	SKIPN	SU.FRF		;  IF NOT RETAIN FAKE READ
	HRRM	AC0,D.RFLG(I16)	; PUT IT BACK 
	SKIPLE	SU.FRF		; Is this RETAIN del/rewrt?
	PUSHJ	PP,SVDLRW	; Yes, then try saving current position
>;END IFN ANS74
	PUSHJ	PP,@GETSET(I12)	;ADJKEY OR GD67 OR FPORFP
	PUSHJ	PP,IBS		;LOCATE THE RECORD
IREAD1:	SKIPN	SU.FRF
	JRST	MOVBR		;JUMP IF NOT FAKE READ TO MOVE RECORD

IREADF:	MOVE	AC1,USOBJ(I12)	; FAKE READ - DONT TOUCH REC-AREA
	MOVEM	AC1,FS.BN	; JUST RETURN THE BLOCK NUMBER TO RETAIN
	POPJ	PP,

;[605]	HERE IS THE START CODE FOR ISAM FILES. 

IFN ANS74,<			;[605]

ISTRT:	PUSHJ	PP,@GETSET(I12)	;[605] ADJKEY OR GD67 OR FPORFP
	PUSHJ	PP,IBS		;[605] LOCATE THE RECORD
				;[605] IBS GIVES A SKIP RET FOR STRT
				;[605] INVALID KEY CONDITIONS

	JRST	ISTRT0		;[605] REC = SYM-KEY FOUND

	TXNE	AC16,STA%EQ	;[605] SYM-KEY = NOT FOUND
				;[605] SKIP IF START AT .EQ. CURRENT RECORD

	JRST	ISTRT1		;[605] START GT OR NOT.LS.
	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
	TRZE	AC0,SAVNXT	; CLEAR FLAG FOR NXT REC POS SAVED
	HRRM	AC0,D.RFLG(I16)	; PUT IT BACK 
	PUSHJ	PP,NRESTS	;[605] SET NO RECORD STATUS INVALID KEY 
	SKIPE	F.WSMU(I16)	;[605] SIMULTANEOUS UPDATE ?
	PUSHJ	PP,LRDEQX##	;[605] YES
	JRST	RET.2		;[605] GIVE INVALID KEY RETURN

;[605]	HERE IF RECORD = SYM-KEY FOUND. IF STRT = OR STRT NOT.LS
;[605] THEN WE ARE DONE. THE CURRENT REC IS THE DESIRED ONE. IF STRT
;[605] GTR THEN GO SET PTRS TO NEXT REC.

ISTRT0:	TXNE	AC16,STA%GT	;[605] SKIP IF NOT START AT .GT. CURRENT RECORD

;[605]	HERE IF NEED NEXT REC, WHETHER OR NOT = REC FOUND

ISTRT1:	PUSHJ	PP,NXTISM	;[605] GET NEXT REC IN FILE
				;[605] UPDOWN WILL GIVE INVALID KEY RETURN
				;[605] IF NO NEXT RECORD IS FOUND

	; Now reset DAKBP and IAKBP pointers, in case del/rewrt follows
	; first must save the record area in AUXBUF

	MOVE	AC1,AUXBUF	; Auxbuf destination
	HRL	AC1,FLG		; Get record area addr. source
	HRRZ	AC2,AC1		; 
	ADD	AC2,RCARSZ(I12)	; Get record area size, calc last word
	BLT	AC1,-1(AC2)	; Copy record area to AUXBUF

	; Now reset record area to record pointed to by START

	PUSHJ	PP,MOVBR	; Copy buffer to record area
	
	; Not restore record area

	HRLZ	AC1,AUXBUF	; AUXBUF source
	HRR	AC1,FLG		; Get record area addr. destination
	HRRZ	AC2,AC1		; 
	ADD	AC2,RCARSZ(I12)	; Get record area size, calc last word
	BLT	AC1,-1(AC2)	; Copy AUXBUF to record area
				; 

	SETOM	NNTRY(I12)	;[605] NOTE THAT CNTRY POINTS TO NEXT RECORD
	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
	TRZE	AC0,SAVNXT	; CLEAR FLAG FOR NXT REC POS SAVED
	HRRM	AC0,D.RFLG(I16)	; PUT IT BACK 
	PUSHJ	PP,CLRSTS	;[605] SET NO ERROR FILE STATUS
	SKIPE	F.WSMU(I16)	;[605] SIMULTANEOUS UPDATE ?
	PUSHJ	PP,LRDEQX##	;[605] YES
	POPJ	PP,		;[605] AND GIVE GOOD RETURN TO USER PROGRAM
	
>;[605] END IFN ANS74
RRDIVK:	SKIPE	BRISK(I12)	;SKIP IF SLOW MODE
	JRST	RRDIV4		;JUMP IF FAST MODE
	TLOE	FLG1,RIVK	;[466] SET INVALID-KEY, FIRST TIME?
	JRST	RRDIV4		;[466] NO
	TLNN	FLG,OPNOUT	;[466] IS FILE OPEN FOR OUTPUT
	JRST	IBSTO1		;[466] NO, REPEAT

	;MAKE CNTRY POINT AT THE RECORD PRECEEDING THE 'NOT-FOUND' RECORD
RRDIV4:	HRRZI	AC0,-1(AC4)	;ADR OF THE RECORD HEADER WORD
	HRRZ	AC2,DRTAB	;
RRDIV3:	SKIPL	AC3,(AC2)	;ADR OF FIRST REC-HEADER WORD IN THIS BLOCK
	CAIN	AC0,(AC3)	;CURRENT RECORD?
	SKIPA	AC3,-1(AC2)	;YES, GET ADR OF PREVIOUS REC-HDR
	AOJA	AC2,RRDIV3	;NO, TRY AGAIN
	ADDI	AC3,1		;FIRST WORD AFTER HEADER
	CAME	AC2,DRTAB	;FIRST RECORD OF THE FILE?
	JRST	RRDIV2		;NO
	SETOM	NNTRY(I12)	;NOTE CNTRY POINTS TO NEXT ENTRY
	MOVE	AC0,IOWRD(I12)	;
	ADDI	AC0,2		;
	HRRM	AC0,CNTRY(I12)	;POINT AT FIRST RECORD IN BLOCK
	JRST	RRDIV1
RRDIV2:	HRRZM	AC3,CNTRY(I12)	;POINT AT FIRST REC BEFORE 'NOT -FOUND' REC
	SETZM	NNTRY(I12)	;[275] CLEAR NNTRY SO CNTRY POINTS TO CURRENT ENTRY
RRDIV1:
IFN ANS74,<			;[605]
	TXNE	AC16,V%STRT	;[605] IS THIS START??
	JRST	RET.2		;[605] YES, GIVE SKIP RETURN TO START IBS CALL
>				;[605]
	TLNE	FLG1,SEQ	; [610] SKIP IF NOT SEQ READ
	POP	PP,(PP)		; [610] ELSE THROW AWAY NXTISM RETURN
	POP	PP,AC0		; THROW AWAY IBS RETURN
IFN ANS68,<
	TXNN	AC16,V%READ	; READ?
	AOS	(PP)		;NO, RERITE OR DELET
>
IFN ANS74,<
	TXNE	AC16,V%READ	;Read?
	JRST	RDIV1A		; Yes, cont
	AOS	(PP)		;No, RERITE OR DELET
	SETZM	NNTRY(I12)	; Clear next rec flag, no current rec
	SETZM	CNTRY(I12)	; CLEAR CURRENT DATA ENTRY TO INDICATE
				; SEQ READ CURRENT ENTRY IS NOT SET
RDIV1A:
>

	SKIPE	F.WSMU(I16)
	PUSHJ	PP,LRDEQX##	;CALL LRDEQX IF FILE OPEN FOR SIMULTANEOUS UPDATE
	PUSHJ	PP,NRESTS	;[601] SET NO RECORD ERROR
IFN ANS74,<
	TXNE	AC16,V%DLT	;; RERITE AND READ SKIP
	POPJ	PP,		;; DELETE ALREADY HAS A SKIP EXIT
>
	JRST	RET.2		;INVALID-KEY RETURN
	;SEQUENTIAL READ
SREAD:	TLO	FLG1,SEQ	;FLAG SREAD
IFN ANS74,<
	SKIPLE	SU.FRF		; IS THIS RETAIN OF DEL/REWRIT?
	PUSHJ	PP,SVDLRW	; YES, SAVE "CURRENT" RECORD POSITION
>
	PUSHJ	PP,NXTISM	;[605]  SET PTRS TO NEXT REC
	SETZM	NNTRY(I12)	;[605] NOTE CNTRY POINTS AT CURRENT ENTRY
	PUSHJ	PP,SETLRW	;[605] SET UP LRW INCASE A 'DELET' OCCURED
	SKIPN	SU.FRF
	JRST	MOVBR		;[605] JUMP IF NOT FAKE READ TO MOVE RECORD

	; HERE IF FAKE READ TO GET BLOCK NUMBER
	HRRZ	AC2,CNTRY(I12)	;[447] GET CURRENT REC ADDR IN BUFFER
	ADD	AC2,DBPRK(I12)	;[447] ADD RELATIVE DATA-REC-KEY PTR
	MOVEM	AC2,SU.RBP	; SAVE IT FOR RETAIN
	JRST	IREADF		; GET THE BLOCK NUMBER AND EXIT

;[605] 	NXTISM SETS THE ISM PTRS TO ADDRESS THE NEXT NONE NULL RECORD
;[605] 	ON THE ISAM FILE. USES CODE THAT WAS INLINE AT SREAD CALL TO NXTISM

NXTISM:	SKIPE	CNTRY(I12)	;[605] IS THIS THE FIRST READ EVER?
	JRST	SREAD1		; NO
IFN ANS74,<
	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
	TRZE	AC0,SAVNXT	; CLEAR FLAG FOR NXT REC POS SAVED
	JRST	NXTIS0		; AND GO RESTORE CURRENT POSITION IF
				; DELETE OR REWRITE WAS LAST
>;END IFN ANS74
	TXO	FLG1,FSTIDX	;  SET 1ST READ SEQ SCAN FLAG

	PUSHJ	PP,IBS		; FIND FIRST DATA RECORD
	TXZ	FLG1,FSTIDX	;  CLEAR 1ST READ SEQ SCAN FLAG
	JRST	SREAD2

	; HERE TO RESTORE THE "CURRENT RECORD POSITION" TO BEFORE 
	; THE REWRITE OR DELETE THAT EXECUTED PREVIOUSLY
	; RWDLKY HAS   NNTRY,,ADR-DAK-AND-IAK-SAV-AREA

IFN ANS74,<

NXTIS0:	SKIPN	SU.FRF		; IF RETAIN FAKE READ
				;  WE WANT SAVED POS TO STAY UNTIL REAL I-O
				;  NEEDS IT
	HRRM	AC0,D.RFLG(I16)	; ELSE RESET RFLGS
	HRL	AC1,RWDLKY(I12)	; GET ADDR OF CNTRY ADJ KEY COPY(SOURCE)
	HRR	AC1,DAKBP(I12)	; GET ADDR OF ADJ DATA KEY KEY(DESTINATION)

	; If SVNXRT is non-zero then RWDLRT has save area address just after
	;  dat keys

	HLRZ	AC2,AC1		; GET HEAD OF SOURCE
	SKIPE	SVNXRT(I12)	; Is RETAIN save area being used?
	HRRZ	AC2,RWDLRT(I12)	; Yes, then use the saved "save area" address
	BLT	AC1,-1(AC2)	; COPY TO AREA JUST BEFORE SAVE AREA
				; (SAV AREA IMMEDIATELY FOLLOWS IDX DAT KYS )

	; NOW CALL IBS TO REGET THE IDX AND DATA BLKS FOR CNTRY

	PUSH	PP,FLG1		; Save flags
	TLZ	FLG1,SEQ	; TEMP INDICATE NONE SEQ SEARCH
	PUSH	PP,AC16		; Save verb flags
	TXO	AC16,V%STRT	; MARK TO GET START TYPE IBS FAILURE RETURN
	SKIPE	SU.FRF		; IS THIS FAKE SMU READ?
	PUSH	PP,NNTRY(I12)	; YES, save next rec flag, for INVALID KEY
	PUSHJ	PP,IBS		; SEARCH FOR OLD CNTRY
	TDNA			; SKIP FOR IBS SUCCESS
	JRST	NXTIX2		; IBS FAIL,SKIP NNTRY RESET, RRDIVK RESET IT
	SKIPE	SU.FRF		; IS THIS FAKE SMU READ?
	POP	PP,(PP)		; Yes, discard saved NNTRY value
	HLRZ	AC1,RWDLKY(I12)	; GET NNTRY VALUE	
	SKIPN	SU.FRF		; DON'T RESET IF RETAIN 
	MOVEM	AC1,NNTRY(I12)	; ELSE RESET IT
	JRST	NXTIX1		; Reset flags, and cont

	; Must reset saved value if the restore got invalid return. record
	;  is not there now, resave "current" "current" record

NXTIX2:	HRRZ	AC0,D.RFLG(16)	; Get flags for SDLRW1
	PUSHJ	PP,SDLRW1	; Force save "current position"
	SKIPE	SU.FRF		; IS THIS FAKE SMU READ?
	POP	PP,NNTRY(I12)	; YES,  reset next rec flag

NXTIX1:	POP	PP,AC16		; Reset verb flags
	POP	PP,FLG1		; Reset flags

>; END IFN ANS74

	;TRY FOR THE NEXT DATA REC IN THIS BLOCK
SREAD1:	SETZ	LVL,		;WE ARE AT LEVEL 0!
	HRRZ	AC4,CNTRY(I12)	;CURRENT ENTRY
	SKIPE	NNTRY(I12)	;CNTRY ALREADY POINTING AT NEXT ENTRY?
	JRST	SREAD2		;YES
	LDB	AC1,RSBP(I12)	;
	IDIV	AC1,D.BPW(I16)	;
	JUMPE	AC2,.+2		;
	ADDI	AC1,1		;
	ADDI	AC4,1(AC1)	;NEXT ENTRY
SREAD2:	SKIPE	-1(AC4)		;NULL REC = LAST REC
	CAMLE	AC4,LRW(I12)	;WAS THAT THE LAST REC?
	PUSHJ	PP,UPDOWN	;YES, GET THE NEXT
	HRRM	AC4,CNTRY(I12)	;SAVE AS CURRENT ENTRY
	JRST	SETLRW		;[1075] [605] GO UPDATE LRW

	;LOOK UP AND DOWN THROUGH THE INDEX FOR THE NEXT REC
UPDOWN:	ADDI	LVL,1		;UP AN INDEX LEVEL
	CAMLE	LVL,MXLVL(I12)	;ANY MORE LEVELS?
	JRST	UPDOW1		;NO, INVALID KEY EXIT

	MOVE	AC4,@CNTRY0(I12)  ;GET THE LAST ENTRY
	SKIPN	@NNTRY0(I12)	;CNTRY ALREADY AT NEXT ENTRY?
	ADD	AC4,IESIZ(I12)	;NO, THE CURRENT ENTRY
	HRRZ	AC2,@IOWRD0(I12)  ;
	ADD	AC2,IBLEN(I12)	;
	HRRZI	AC2,3(AC2)	;UPPER LIMIT
	SKIPE	(AC4)		;IF NULL, REST OF BLOCK IS EMPTY
	CAIG	AC2,(AC4)	;ANY MORE ENTRIES AT THIS LEVEL?
	PUSHJ	PP,UPDOWN	;NO, UP ANOTHER LEVEL
	HRRM	AC4,@CNTRY0(I12)  ;CURRENT ENTRY SAVED
	SETZM	@NNTRY0(I12)	;CNTRY POINTS AT CURRENT ENTRY
	SOJL	LVL,RET.1	;DOWN AN INDEX LEVEL
	PUSHJ	PP,GETBLK	;GET NEXT BLOCK
	MOVE	AC4,@IOWRD0(I12)
	ADDI	AC4,2		;
	JUMPE	LVL,RET.1	;
	AOJA	AC4,RET.1	;CURRENT ENTRY OR REC

UPDOW1:	POP	PP,AC0		;[605] POPOFF THE RETURNS
	POP	PP,AC0		;[605] POPOFF THE RETURNS
	SOJG	LVL,.-1		;
	PUSHJ	PP,ENDSTS	;SET STATUS
	JRST	RET.2		;INVALID KEY RETURN

	;HERE FROM GETBLK VERSION NUMBER DISCREPANCY WHEN SREADING
UDVERR:	TLNN	FLG1,VERR	;IF WE'VE BEEN HERE BEFORE OR
	SKIPN	CNTRY(I12)	;  THIS IS THE FIRST READ EVER
	JRST	UDVER1		;  LEAVE THE STACK ALONE.
	JUMPE	LVL,UDVER1	;  SAME THING IF A DATA BLOCK
	POP	PP,(PP)		;MAKE THE STACK RIGHT
	SOJG	LVL,.-1		;

	;MOVE THE CURRENT KEY TO THE SYMBOLIC KEY
UDVER1:	LDB	AC1,KY.TYP	; GET KEY TYPE
	CAIGE	AC1,3		; DISPLAY?
	JUMPN	AC1,.+3		; JUMP IF NUMERIC DISPLAY
	CAIGE	AC1,7		; SKIP IF COMP-3
	JRST	UDVER2		; DISPLAY, FIXED, OR FLOATING POINT

	;CONVERT BINNARY TO DISPLAY KEY
	PUSHJ	PP,SAVAC.	;SAVE THE ACS
	MOVE	AC0,2(AC4)	;THE KEY
	LDB	AC2,KY.MOD	; GET KEY MODE
	HLRZ	AC10,PDTBL(AC2)	; GET CONVERSION ROUTINE
	LDB	AC2,KY.TYP	; GET KEY TYPE
	CAIL	AC2,7		; IF COMP-3
	HRRZI	AC10,PC3.	; USE THIS ROUTINE
	MOVE	AC15,F.WBSK(I16);BYTE POINTER TO SYM-KEY
	TLZ	AC15,7777	;MAKE A PARAMETER WORD FOR PD6/7.
	LDB	AC1,KY.SIZ	; GET KEY SIZE
;	[502] CHANGE AC15 TO AC2 FOR CALL TO PD6. OR PD7. BECAUSE PD USES 15.
	TSO	AC2,AC1		;[502] INCLUDE THE KEY SIZE
	HRRZI	AC16,AC2	;[502] AC0 IS SOURCE,,AC15 IS PARAMETER WRD
	PUSHJ	PP,(AC10)	;CALL PD6. OR PD7.
	PUSHJ	PP,RSTAC.	;RESTORE ACS
	JRST	UDVER3		;--DONE--

	;JUST MOVE THE KEY
UDVER2:	HRLI	AC1,2(AC4)	;MOVE CURRENT KEY TO SYMBOLIC-KEY
	HRR	AC1,F.WBSK(I16)	;FROM,,TO
	MOVE	AC2,IESIZ(I12)	;
	SUBI	AC2,2		;LEN
	ADDI	AC2,-1(AC1)	;UNTIL
	BLT	AC1,(AC2)	;MOVIT
UDVER3:	PUSHJ	PP,VNDE		;[307] IF TOP INDEX BLOCK WAS SPLIT - TRY AGAIN
	  TRN			;
	TLOE	FLG1,VERR	;
	JRST	LV2SK3		;[307] NO - GIVE ERROR MESSAGE AND QUIT

	MOVE	LVL,MXLVL(I12)	;[307] OK - TAKE IT FROM THE TOP
	PUSHJ	PP,@GETSET(I12)	;
	PUSHJ	PP,IBSTO1	;

	;SET LOW-VALUES TO SYMKEY
LV2SK.:: MOVE	AC1,F.WBSK(I16)	;SK BYTE-POINTER
	HLRZ	AC12,D.BL(I16)
	LDB	AC3,KY.TYP	; GET KEY TYPE
	CAIL	AC3,7		; COMP-3?
	JRST	LV2SK1		; YES
	CAIGE	AC3,3		;DISPLAY ?
	JRST	LV2SK2		;YES

	;FIXED OR FLOATING POINT
	MOVSI	AC0,400000	;ASSUME IT IS A COMP ITEM
	CAILE	AC3,4		;FIXED POINT ?
	ADDI	AC0,1		;NO, COMP-1
	MOVEM	AC0,(AC1)	;TO SYMKEY
	TLNN	AC3,1		;TWO WORDS ?
	MOVEM	AC0,1(AC1)	;
	POPJ	PP,		;NO, EXIT

	;COMP-3
LV2SK1:	LDB	AC3,KY.SGN	; GET SIGN BIT
	SKIPN	AC3		; SKIP IF UNSIGNED
	SKIPA	AC2,[9B13+15B17+9B31+9B35]	; LOW-VALUES

	;DISPLAY
LV2SK2:	SETZ	AC2,		; LOW VALUES FOR DISPLAY
	LDB	AC0,KY.SIZ	; GET KEY SIZE
	IDPB	AC2,AC1		;DEPOSIT SOME LV'S
	SOJG	AC0,.-1
	TLNN	AC2,-1		; SKIP IF SIGNED COMP-3
	POPJ	PP,		;
	MOVSS	AC2		; GET THE LSAT BYTE
	DPB	AC2,AC1		; "9-"
	POPJ	PP,

	;ERROR MESSAGE OR IGNORE THE ERROR
LV2SK3:	PUSHJ	PP,GBVER	;IGNORE ERROR?
	JRST	LV2SK.		;YES - RESTORE SYM-KEY
	;HERE TO DELETE A RECORD
DELET.:	MRTMS.	(AC1)		;START METER TIMING
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.DL	; YES
	TXO	AC16,V%DLT	;
	JRST	RERIT1		;

	;HERE TO REWRITE AN EXISTING RECORD
RERIT.:	MRTMS.	(AC1)		;START METER TIMING
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.RW	; YES
	TXO	AC16,V%RWRT
RERIT1:	MOVE	AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
	BLT	AC0,FS.IF	;   STATUS WORDS.
	HRRZ	AC15,(PP)	;(UOCAL.)
	MOVE	AC15,(AC15)	;
	PUSHJ	PP,WRTSUP	;
	TLNN	FLG,OPNOUT	;FILE OPEN FOR OUTPUT?
	JRST	ERROPN		;NO
IFN LSTATS,<
	MOVE	AC1,AC3		;GET RECORD SIZE
	PUSHJ	PP,BUCREC	;SET AC2 TO REC BUCKET OFFSET
	TXNE	AC16,V%DLT	;DELETE?
	JRST	RERITN		;YES,JUMP
	L.METR	(MB.RWT(AC2),I16) ;NO, METER REWRITE BUCKET
	JRST	RERITO		;FINISH
RERITN:	L.METR	(MB.DEL(AC2),I16) ;METER DELETE BUCKET
RERITO:>;END IFN LSTATS

	TXNE	AC16,V%DLT	;IS IT DELET?
	JRST	RERIT3		; YES,SKIP I-O CHECK
	LDB	AC3,WOPRS.	;NO,GET ACTUAL REC SIZE
IFN ANS74,<
	TLC	FLG,OPNIO	;[622] 
	TLCN	FLG,OPNIO	;[622] OPEN I-O?
	JRST	RERIT3		; YES,NEXT CHECK
	MOVE	AC2,[BYTE(5)10,31,20,6,14]; NO,ERROR
	PUSHJ	17,MSOUT.	;  OUTPUT MESS,I-O REQUIRED FOR
	OUTSTR	[ASCIZ/ for I-O/]	;THIS VERB
	JRST	KILL.

>;END IFN ANS74

RERIT3:

IFN ANS74,<

	LDB	AC0,F.BFAM	;GET ACCESS MODE
	JUMPE	AC0,RERT30	;IF SEQ, LAST OPERATION CHECK
	TLNN	FLG,IDXFIL	;ISAM?
	JRST	RANDOM		; NO, 
	JRST	RERIT4		; YES,
	; LAST I-O OPERATION MUST HAVE BEEN A READ FRO SEQ ACCESS

RERT30:	TLNN	FLG,IDXFIL	;ISAM?
	JRST	RERT3A		; NO, GO ON

	; CHECK ISAM READ LAST IO (RDLAST) FLAG FOR SEQ ACCESS CHECK
	
	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
	TRNE	AC0,RDLAST	; WAS READ LAST IO OPERATION
	JRST	RERIT4		; YES,CHECKS OK
	JRST	RERT3B		; NO GIVE ERROR CASE

RERT3A:	HLRZ	I12,D.BL(I16)	; GET BUFFER POINTER
	SKIPN	R.WRIT(I12)	; READ LAST I-O ?
	JRST	RANDOM		; YES,CHECKS OK
RERT3B:	OUTSTR	[ASCIZ/?READ must precede DELETE or REWRITE for SEQUENTIAL access files.
/];
	JRST KILL		;GIT
RERIT4:
>; END IFN ANS74

	; HERE FOR ISAM RERIT AND DELETE

	PUSHJ	PP,LVTST	;LOW-VALUES IN SYMBOLIC KEY?
	 JRST	LVERR		;YES, ITS ILLEGAL

IFN ANS74,<			
	PUSHJ	PP,SVDLRW	; save current record position
	JRST	RRIT2A		; and continue
			
; SVDLRW	routine to save "current" record when about
;		to do a DELETE or REWRITE, or a RETAIN for
;		either.
;
; alternate entry	skip SAVNXT check, sav it no matter what
; at SDLRW1:			used when recovering from NXTIS0 reset that
;			gets RRDIVK return (called from NXTIX2)

;
; on entry	I11 = address of buffer
;		AC16 = filtab address
;
; uses		AC0, AC1, AC2


	; SAVE THE CURRENT POSITION ADJUSTED KEY SO THE A SEQUENTIAL OPERATION
	; FOLLOWING REWRITE OR DELETE WILL GET THE POSITION BEFORE THE DELETE
	; OR REWRITE (74 ONLY FOR 12B)

SVDLRW:	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
	TRNn	AC0,SAVNXT	; IS DEL/RWT SAV ACTIVE?
	JRST	SDLRW1		; No go save current position
	SKIPg	SU.FRF		; IS THIS DEL/REWRIT RETAIN?
	POPJ	PP,		; No, cont
	TXNE	AC16,V%RNXT	; Yes, and READ NEXT?
	SETOM	NNTRY(I12)	;  Yes, then reset NNTRY as BLKNUM wants
	POPJ	PP,		; DON'T SAVE IT AGAIN

	; IF CNTRY= 0 NO "CURRENT" REC YET, NO NEED TO SAVE IT
sdlrw1:	SKIPE	CNTRY(I12)	; IS THERE A "CURRENT" REC LOC?
	JRST	SDLRW2		; YES, SAVE IT
	SKIPG	SU.FRF		; NO CURRENT REC, IS THIS DEL/REWRIT RETAIN?
	POPJ	PP,		; NO, CONT, DON'T SAVE "CURRENT"
				;  THIS WILL CAUSE NEXT READ TO GET FIRST REC
				;  BECAUSE CNTRY WILL REMAIN 0

	; IF DEL/REWRT RETAIN MUST FIND FIRST RECORD, SO ITS KEY CAN BE SAVED 

	PUSHJ	PP,@GETSET(I12)	; First initialize keys
	TXO	FLG1,FSTIDX	;  SET 1ST READ SEQ SCAN FLAG
	PUSHJ	PP,IBS		; FIND FIRST DATA RECORD
	TXZ	FLG1,FSTIDX	;  CLEAR 1ST READ SEQ SCAN FLAG
	HRRZ	AC0,D.RFLG(I16)	; Now restore RFLG
	SETOM	NNTRY(I12)	; SET "CURRENT IS NEXT" FLAG


SDLRW2:	TRO	AC0,SAVNXT	; SET REWRITE WAS DONE,NXT KEY SAVED
	HRRM	AC0,D.RFLG(I16)	; PUT BACK FLAGS
	HRR	AC1,NNTRY(I12)	; NO,GET "NXT IS CURRENT" FLG
	HRLM	AC1,RWDLKY(I12)	; SET LEFT OF SAV ADR AS NNTRY FLG
	SKIPLE	SU.FRF		; IF RETAIN CASE
	SETOM	NNTRY(I12)	;  THEN RESET NNTRY AS BLKNUM TRIED TO DO
	HRR	AC1,RWDLKY(I12)	; GET ADDR OF CNTRY ADJ KEY COPY(DEST)
	HRL	AC1,DAKBP(I12)	; GET ADDR OF ADJ DATA KEY (SOURCE)
	HRRZ	AC2,IESIZ(I12)	; GET IDX KEY SIZ (EXTRA 2 WDS)
	LSH	AC2,1		; TIMES 2 (EXTRA USED TO OFFSET WRAP AROUND)
	ADDI	AC2,(AC1)	; ADD LENGTH TO DESTINATION
	BLT	AC1,-1(AC2)	; COPY KEY TO SAV AREA(2 EXTRA FOR WRAP
				; AROUND AND 2 FOR IDX HDR WDS GOT FROM IESIZ )
	POPJ	PP,		; ALL DONE


>; END IFN ANS74
RRIT2A:	AOS	RWRSTA(I12)
	SETZ	FLG1,		;[605] INITIALIZE FLG1 REG
	PUSHJ	PP,SETIC	;SET THE INDEX CHANNEL
	PUSHJ	PP,@GETSET(I12)	;ADJKEY OR GD67 OR FPORFP
	PUSHJ	PP,IBS		;FIND THE RECORD
	PUSHJ	PP,SETLRW	;FIND THE LAST RECORD WORD
	PUSHJ	PP,SHFREC	;MAKE SURE THE NEW REC WILL FIT
	TXNE	AC16,V%DLT	;DELET ?
	JRST	DEL01		;YES
	PUSHJ	PP,MOVRB	;MOVE THE RECORD
RERIT2:	PUSHJ	PP,WDBK		;WRITE THE DATA BLOCK
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
	PUSHJ	PP,LRDEQX##	; YES
	MRTME.	(AC1)		;END REWRITE TIMING
	PUSHJ	PP,CLRSTS	;[601] SET STATUS TO 00

	HRRZ	AC1,D.RFLG(I16)	; GET SOME FLAGS
	TRZ	AC1,RDLAST	; CLEAR READ LAST IO OPERATION
	HRRM	AC1,D.RFLG(I16)	; PUT THEM BACK

IFN ANS74,<
	SETZM	NNTRY(I12)	; Clear next rec flag, no current rec
	SETZM	CNTRY(I12)	; CLEAR CURRENT DATA ENTRY TO INDICATE
				; SEQ READ CURRENT ENTRY IS NOT SET
	TXNN	AC16,V%DLT	;DON'T INCREMENT PC IF DELETE
	AOS	(PP)
	POPJ	PP,		;RETURN TO USER
>
IFN ANS68,<
	JRST	RET.2
>
DEL01:	HRRZ	AC2,LRW(I12)	;
	SETZM	1(AC2)		;TERMINATE THE DATA BLOCK
	HRRZ	AC3,IOWRD(I12)
	CAMN	AC2,AC3		;IS DATA BLOCK EMPTY ?
	PUSHJ	PP,DEL10	;YES, GO UPDATE THE INDEX
	SKIPE	OLDBK		;ANYTHING TO DE-ALLOCATE?
	PUSHJ	PP,DALC		;YES
	JRST	RERIT2

	;IF NOT FIRST ENTRY IN THE INDEX BLOCK
	; JUST DELET THE ENTRY & EXIT
DEL10:	MOVE	AC1,USOBJ(I12)	;ADR OF EMPTY BLOCK
	MOVEM	AC1,OLDBK	;SAVE FOR DE-ALLOCATION
DEL11:	ADDI	LVL,1		;UP A LVL
	HRRZ	AC1,@CNTRY0(I12)
	HRRZ	AC0,@IOWRD0(I12)  ;
	ADDI	AC0,3
	CAME	AC0,AC1		;FIRST ENTRY THIS BLK ?
	JRST	DEL40		;NO, DELET ENTRY & EXIT

	HLL	AC1,IAKBP(I12)	;[276] BYTE POINTER TO DATA RECORD KEY
	PUSHJ	PP,LVTSTI	;TEST FOR LOW-VALUES
	 JRST	DEL13		;LOW-VALUES!

	HRRZ	AC1,@CNTRY0(I12) ;FIRST WORD OF CURRENT ENTRY
	SETZM	(AC1)		;BLOCK IS EMPTY; CLEAR THE BLOCK NUMBER
	ADD	AC1,IESIZ(I12)
	SKIPN	(AC1)		;IS IB EMPTY ?
	JRST	DEL11		;YES, UP A LEVEL & DELET ITS ENTRY
	HRRZ	AC1,@CNTRY0(I12)
	PUSHJ	PP,DEL40	;NO, DELET THIS ENTRY
	MOVE	AC3,@CNTRY0(I12) ;SETUP AC3 FOR DEL50
	AOJA	LVL,DEL50	;FIX NEXT LEVEL'S KEY

DEL13:	SETZM	OLDBK		;SAVE THIS EMPTY BLOCK
	HRRZ	AC1,@CNTRY0(I12)
	SETZM	1(AC1)		;MAKE VERSION NUMBER BE SAME AS DATA'S
	ADD	AC1,IESIZ(I12)
	SKIPN	(AC1)		;IS IB EMPTY ?
	JRST	WIBK		;YES, EXIT

	;KEY = LOW-VALUES SO JUST UPDATE BLOCK / VERSION NUMBERS
	HRRZ	AC1,@CNTRY0(I12)
	MOVE	AC2,AC1		;FIRST ENTRY
	ADD	AC1,IESIZ(I12)	;SECOND ENTRY
	MOVE	AC0,(AC1)
	MOVEM	AC0,(AC2)	;BLOCK NUMBER
	MOVE	AC0,1(AC1)
	MOVEM	AC0,1(AC2)	;VERSION NUMBER
	;DELET AN INDEX ENTRY
DEL40:	HRR	AC2,AC1
	ADD	AC1,IESIZ(I12)
	HRL	AC2,AC1		;FROM,,TO
	HLRO	AC6,@IOWRD0(I12)
	MOVNS	AC6
	ADD	AC6,@IOWRD0(I12)	;LAST WORD OF LAST ENTRY

DEL41:	CAIG	AC1,(AC6)	;STILL IN ACTIVE DATA?
	SKIPN	(AC1)		;YES, NULL ENTRY?
	JRST	DEL42		;DONE
	ADD	AC1,IESIZ(I12)	;
	JRST	DEL41

DEL42:	SUB	AC1,IESIZ(I12)	;
	BLT	AC2,-1(AC1)	;
	SETZM	(AC1)		;TERMINATE THE ENTRIES
	SETOM	@NNTRY0(I12)	;NOTE CNRTY POINTS AT NEXT ENTRY
	JRST	WIBK		;WRITE THE NEW INFO

	;OK NEXT LEVEL, UPDATE THE KEY
DEL50:	CAMLE	LVL,MXLVL(I12)	;ANY MORE LEVELS?
	POPJ	PP,		;NO - EXIT
	HRRZ	AC5,@CNTRY0(I12) ;ENTRY'S FATHER
	HRLI	AC1,2(AC3)	;FROM,,0
	HRRI	AC1,2(AC5)	;FROM,,TO
	ADD	AC5,IESIZ(I12)	;UNTIL+1
	BLT	AC1,-1(AC5)	;MOVE THE KEY
	PUSHJ	PP,WIBK		; AND WRITE IT OUT

	;SEE IF THIS IS FIRST ENTRY IN INDEX BLOCK
	MOVE	AC3,@CNTRY0(I12) ;CURRENT ENTRY
	HRRZ	AC0,@IOWRD0(I12) ;BEGINNING OF BLOCK
	CAIE	AC0,-3(AC3)	;IF NOT THE FIRST ENTRY
	POPJ	PP,		;  EXIT
	AOJA	LVL,DEL50	;  ELSE UPDATE NEXT LEVEL'S KEY
	;HERE FROM WRITE.
IWRITE:	SETZ	FLG1,		;[605] INITIALIZE FLG1 REG
	PUSHJ	PP,LVTST	;LOW VALUES IN SYM-KEY?
	 JRST	LVERR		;ILLEGAL!

IFN ANS74,<
	PUSHJ	PP,SVDLRW	;[1021] SAVE CURRENT RECORD POSITION AND CONTINUE
>;END IFN ANS74

	AOS	RWRSTA(I12)	;BUMP # OF WRITE STATEMENTS
	PUSHJ	PP,SETIC	;SET CHAN FOR INDEX FILE
	PUSHJ	PP,@GETSET(I12)	;
	PUSHJ	PP,IBS		;FIND WHERE TO INSERT
	HRRZ	AC6,D.RCL(I16)	;# OF EMPTY RECS THIS BLK
	JUMPG	AC6,IWRI02	;IS CURRENT BUFFER FULL?
	JRST	SPLTBK		;YES, MAKE SOME ROOM

IWRI01:	PUSHJ	PP,WABK		;WRITE THE AUXBUF
IWRI02:	HRRZ	AC1,DBF(I12)	;GET BLOCKING FACTOR
	CAIE	AC1,1		;DON'T NEED A HOLE IF BF = 1
	PUSHJ	PP,SHFHOL	;MAKE A HOLE
	PUSHJ	PP,SRHW		;SET THE RECORD HEADER WORD
	PUSHJ	PP,MOVRB	;INSERT THE RECORD
	PUSHJ	PP,WDBK		;MARK DATA BLOCK ACTIVE
	TLZN	FLG1,BVN	;[503] WAS DATA BLOCK SPLIT?
	JRST	IWRIX		;NO
	SKIPE	LIVE(I12)	;ANYTHING TO BE OUTPUT?
	PUSHJ	PP,WWDBK	;YES - WWRITE OUT THE DATA
	;MAKE AN INDEX ENTRY & UPDATE THE INDEX FILE
IWRI04:	MOVE	AC1,IAKBP(I12)	;
	MOVE	AC0,NEWBK1	;
	MOVEM	AC0,-2(AC1)	;BLOCK NUMBER
	MOVE	AC2,IOWRD(I12)	;
	HLRZ	AC0,1(AC2)	;
	TRZ	AC0,-100	;CLEAR FILE FORMAT INFO
	MOVEM	AC0,-1(AC1)	;VERSION NUMBER

	MOVE	AC3,AUXBUF	;
	ADD	AC3,DBPRK(I12)	;[276] DATA BYTE-POINTER TO RECORD KEY
	ADDI	AC3,1		;
	MOVE	AC2,AC3		;
	HRLZI	AC1,7777	;MASK
	ANDCAM	AC1,AC2		;CLEAR BYTE SIZE
	AND	AC1,GDPSK(I12)	;GET KEY SIZE & SIGN
	IOR	AC2,AC1		;MERGE
	MOVE	AC0,GDX.D(I12)	;[465] USE DATA MODE. NOT CORE MODE
	PUSH	PP,GDX.I(I12)	;[465] SAVE INDEX VS SYM-KEY
	MOVEM	AC0,GDX.I(I12)	;[465] AND USE DATA VS SYM-KEY
	PUSH	PP,GDPSK(I12)	;[276] SAVE IT
	PUSH	PP,F.WBSK(I16)	;[276] SAVE IT
	MOVEM	AC3,F.WBSK(I16)	;[276] FIRST KEY OF AUXBUF VS SYMKEY
	MOVEM	AC2,GDPSK(I12)	;[276]
	TLO	FLG1,NOTEST	;[276] SKIP THE CONVERSION AT ADJKEY
	PUSHJ	PP,@GETSET(I12)	;PLACE FIRST KEY OF AUXBUF IN IAKBP
	TLZ	FLG1,NOTEST	;[276] RESTORE THE FLAG
	POP	PP,F.WBSK(I16)	;[276] RESTORE SYMKEK POINTER
	POP	PP,GDPSK(I12)	;[276] RESTORE
	POP	PP,GDX.I(I12)	;[465] RESTORE INDEX VS SYM-KEY
	PUSHJ	PP,UDIF		;UPDATE THE INDEX FILE
	PUSHJ	PP,WIBK		;WRITE THE INDEX BLOCK

;[D1001]IWRIX:	SKIPE	OLDBK		;ANY BLOCKS TO DEALLOCATE
IWRIX:				;[M1001]
IFN ANS74,<
	PUSHJ	PP,@GETSET(I12)	;[1001] RESET INDEX AND DATA POINTERS
>
	SKIPE	OLDBK		;[M1001] ANY BLOCKS TO DEALLOCATE
	PUSHJ	PP,DALC		;YES, DOIT
;[D1064] SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
;[D1064] PUSHJ	PP,LRDEQX##	; YES

	HRRZ	AC1,D.RFLG(I16)	; GET SOME FLAGS
	TRZ	AC1,RDLAST	; CLEAR READ LAST IO OPERATION
	HRRM	AC1,D.RFLG(I16)	; PUT THEM BACK


	PUSHJ	PP,CLRSTS	;SET STATUS TO 00
	LDB	AC0,F.BCRC	; GET CHP=PNT REC CNT
	JUMPE	AC0,.+2		; SKIP IF NONE
	PUSHJ	PP,CKPREC	; DECR. COUNT AND CHKPNT IF TIME
	PUSHJ	PP,CHKRRN	; CHECK FOR RERUN DUMP
	MRTME.	(AC1)		; END METER TIMING
	SKIPN	F.WSMU(I16)	;[1064] SIMULTANEOUS UPDATE?
	 JRST	IWRIXA		;[1064] NO
	SKIPN	SU.FRF		;[1064] DOING FAKE READ FOR SMU?
	 PUSHJ	PP,LRDEQX##	;[1064] NO
IWRIXA:				;[1064]

IFN ANS74,<
	SETZM	NNTRY(I12)	;[1021] CLEAR NEXT REC FLAG, NO CURRENT REC
	SETZM	CNTRY(I12)	;[1021] CLEAR CURRNET DATA ENTRY TO INDICATE
				;[1021]SEQ READ CURRENT ENTRY IS NOT SET
>; END IFN ANS74
	JRST	RET.2


IWIVK:	SKIPN	BRISK(I12)	;[466] SKIP IF NOT SLOW MODE
	TLO	FLG1,WIVK	;[466] SET FLAG
IWIVK2:	SUB	AC4,DBPRK(I12)	;[276] POINT AT BEGINNING OF THIS ENTRY
	HRRZM	AC4,CNTRY(I12)	;SAVE IN CASE SEQ READ IS NEXT
IWIVK1:	POP	PP,(PP)		;
	MOVEI	AC0,^D22	;RECORD ALREADY EXISTS
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SKIPE	F.WSMU(I16)
	PUSHJ	PP,LRDEQX##	;CALL LRDEQX IF FILE OPEN FOR SIMULTANEOUS UPDATE
	PUSHJ	PP,DPLSTS	;SET STATUS TO 22
	MRTME.	(AC1)		;END WRITE TIMING
	JRST	RET.3
	;UPDATE THE INDEX FILE
UDIF:	ADDI	LVL,1		;UP A LEVEL
	CAMLE	LVL,MXLVL(I12)	;ANY MORE LEVELS?
	JRST	UDIF10		;NO, MAKE A NEW LEVEL

	;UPDATE CURRENT ENTRY BLOCK & VERSION NUMBERS
	HRRO	AC2,@CNTRY0(I12) 
	MOVE	AC3,NEWBK2	;
	MOVEM	AC3,(AC2)	;NEW BLOCK NUMBER
	MOVE	AC1,1(AC2)	;THE VERSION NUMBER
	ADDI	AC1,1		;BUMP IT
	CAIN	LVL,1		;A DATA BLOCK VERSION NUMBER?
	TRZ	AC1,-100	;CLEAR THE FILE FORMAT INFO
	MOVEM	AC1,1(AC2)	;PUT IT BACK

	;MUST INDEX BLOCK BE SPLIT?
	MOVE	AC1,IBLEN(I12)	;
	ADD	AC1,@IOWRD0(I12)
	ADDI	AC1,3		;SKIP OVER THE HEADER
	SUB	AC1,IESIZ(I12)	;POINT AT LAST ENTRY
	SKIPE	(AC1)		;MUST IDXBLK BE SPLIT?
	JRST	UDIF20		;YES

	;MAKE A HOLE FOR NEW ENTRY
UDIF30:	MOVE	AC1,IESIZ(I12)	;DISPLACEMENT
	HRRO	AC2,@CNTRY0(I12)
	ADD	AC2,AC1		;
	SKIPN	(AC2)		;
	JRST	UDIF31		;NO HOLE NEEDED, JUST APPEND
UDIF33:	ADD	AC2,AC1		;
	SKIPE	(AC2)		;IS THIS LAST ENTRY?
	JRST	UDIF33		;NO
	HRRZ	AC0,AC2		;
	SUBI	AC2,1		;-1 ,, LEN
	SUB	AC0,@CNTRY0(I12)  ;LEN
	PUSHJ	PP,SHFR00	;MAKE HOLE

UDIF31:	TLNE	FLG1,WSTB	;MUST STATISTICS BLOCK BE WRITTEN?
UDIF34:	PUSHJ	PP,WSTBK	;YES
	MOVE	AC0,IAKBP(I12)	;
	ADDI	AC0,-2		;
	HRL	AC0,AC0		;FROM,,FROM
	HRR	AC0,@CNTRY0(I12)  ;FROM,,TO
	MOVE	AC1,IESIZ(I12)	;
	ADD	AC0,AC1		;
	ADD	AC1,AC0		;UNTIL
	TLZE	FLG1,BVN	;[552] [503] IS DATA IN SECOND NEW BLOCK?
	HRRM	AC0,@CNTRY0(I12)  ;[503] YES - UPDATE CNTRY FOR SREAD
	BLT	AC0,-1(AC1)	;INSERT THE ENTRY
	POPJ	PP,		;EXIT TO IWRITE
	;BUMP THE VERSION NUMBER
UDIF20:	MOVE	AC2,AUXBUF
	HRRZ	AC3,@IOWRD0(I12)
	ADDI	AC3,2
	MOVE	AC0,-1(AC3)	;
	MOVEM	AC0,(AC2)	;HEADER WORD - BLOCK SIZE EXPRESSED AS 6BIT BYTES
	AOS	AC3,(AC3)	;IN THE CURRENT IDXBLK
	MOVEM	AC3,1(AC2)	;  AND IN AUXBUF

	;DECIDE WHERE TO SPLIT THE INDEX BLOCK
	MOVE	AC3,EPIB(I12)	;NUMBER OF INDEX ENTRIES
	LSH	AC3,-1		;HALVE IT
	IMUL	AC3,IESIZ(I12)	;
	ADDI	AC3,3		;
	ADD	AC3,@IOWRD0(I12)  ;FIRST ENTRY OF 2ND HALF
	TLZ	AC3,-1		;CLEAR LEFT HALF THEN COMPARE
	CAMG	AC3,@CNTRY0(I12)  ;NEW ENTRY IN FIRST HALF?
	JRST	UDIF21		;YES

	;NEW ENTRY IS IN FIRST HALF OF CURRENT IDXBLK
	;MOVE SECOND HALF TO AUXBUF
	HLRZ	AC2,@IOWRD0(I12)
	MOVNI	AC2,(AC2)	;
	ADD	AC2,@IOWRD0(I12)
	HRRZM	AC2,TEMP.	;UNTIL - FOR ZEROING IDXBLK
	SUBI	AC2,-1(AC3)	;<LEN-1> OF 2ND HALF
	ADDI	AC2,2		;SKIP OVER HEADER
	ADD	AC2,AUXBUF	;UNTIL
	HRL	AC1,AC3		;FROM
	HRR	AC1,AUXBUF	;TO
	ADDI	AC1,2		;SKIP OVER HEADER
	BLT	AC1,-1(AC2)	;

	;INSERT NEW ENTRY IN CURRENT IDXBLK
	SETZM	(AC3)		;SET LOOP CATCHER FOR UDIF33
	ADD	AC3,IESIZ(I12)	;INCLUDE THE NEW ENTRY
	MOVEM	AC2,TEMP.1
	MOVEM	AC3,TEMP.2
	PUSHJ	PP,UDIF30
	MOVE	AC2,TEMP.1
	MOVE	AC3,TEMP.2
	JRST	UDIF25		;FINISH UP
UDIF21:	TLO	FLG1,IIAB	;INSERTION IS IN AUXBUF
	ADD	AC3,IESIZ(I12)	;PUT ONE MORE ENTRY IN 1ST HALF
	CAMLE	AC3,@CNTRY0(I12)  ;NEW ENTRY FIRST IN AUXBUF?
	JRST	UDIF22		;YES

	;MOVE FIRST PART OF 2ND HALF TO AUXBUF
	HRL	AC2,AC3		;FROM
	HRR	AC2,AUXBUF	;TO
	ADDI	AC2,2		;SKIP OVER HEADER & VERSION NUMBER
	HRRZ	AC1,@CNTRY0(I12)
	SUBI	AC1,(AC3)	;LEN
	ADD	AC1,IESIZ(I12)	;INCLUDE THE CURRENT ENTRY
	HRRZM	AC1,TEMP.	;LEN OF 1ST PART
	ADDI	AC1,(AC2)	;UNTIL
	BLT	AC2,-1(AC1)	;MOVE FIRST PART
	JRST	UDIF23

	;NEW ENTRY IS FIRST IN AUXBUF
UDIF22:	SETZM	TEMP.		;LEN OF FIRST PART IS ZERO
	HRRZ	AC1,AUXBUF	;TO
	ADDI	AC1,2		;SKIP OVER THE HEADER WORD

	;INSERT THE NEW ENTRY
UDIF23:	HRRZM	AC1,TEMP.2	;AUXBUF CNTRY, SAVE FOR MAUXI
	HRR	AC0,IAKBP(I12)	;
	ADDI	AC0,-2		;
	HRL	AC0,AC0		;
	HRR	AC0,AC1		;FROM,,TO
	ADD	AC1,IESIZ(I12)	;UNTIL
	BLT	AC0,-1(AC1)	;INSERT

	;MOVE REST OF 2ND HALF TO AUXBUF
	HRR	AC0,TEMP.	;LEN OF FIRST PART
	ADD	AC0,AC3		;FROM
	HRL	AC0,AC0		;FROM,,FROM
	HRR	AC0,AC1		;TO
	MOVE	AC2,@IOWRD0(I12)
	MOVE	AC5,IESIZ(I12)	;
	IMUL	AC5,EPIB(I12)	;
	ADDI	AC2,2(AC5)	;LAST WORD OF LAST ENTRY
	HRRZM	AC2,TEMP.1	;'LEW', SAVE FOR MAUXI
	SUB	AC2,TEMP.	;
	ADDM	AC2,TEMP.	;UNTIL, FOR CLEARING CURRENT IDXBLK
	SUBI	AC2,(AC3)	;LEN-1
	ADDI	AC2,1(AC1)	;UNTIL
	BLT	AC0,-1(AC2)	;REST TO AUXBUF
	HRRZM	AC2,LRWA	;
	SOS	LRWA		;LAST ACTIVE WORD IN AUXBUF, SAVE FOR MAUXI
	;ZERO 2ND HALF OF CURRENT IDXBLK
UDIF25:	SETZM	(AC3)	;
	HRL	AC0,AC3		;
	HRRI	AC0,1(AC3)	;FROM,,TO
	HRRZ	AC1,TEMP.	;
	BLT	AC0,(AC1)	;

	;ZERO 2ND HALF OF AUXBUF
	SETZM	(AC2)		;
	HRL	AC2,AC2		;
	HRRI	AC2,1(AC2)	;FROM,,TO
	MOVE	AC1,AUXIOW	;
	HLRZ	AC0,AC1		;
	SUB	AC1,AC0		;UNTIL - END OF AUXBUF
	BLT	AC2,(AC1)	;

	;MAKE A NEW ENTRY
	PUSHJ	PP,ALC2IB	;GRAB TWO BLOCKS
	MOVE	AC0,NEWBK1	;
	MOVEM	AC0,AUXBNO	;
	MOVE	AC1,IAKBP(I12)	;
	MOVEM	AC0,-2(AC1)	;BLOCK NUMBER
	MOVE	AC2,@IOWRD0(I12)
	MOVE	AC0,2(AC2)	;
	MOVEM	AC0,-1(AC1)	;VERSION NUMBER

	MOVE	AC3,AUXBUF	;MOVE KEY TO HOLDING AREA
	HRLI	AC3,4(AC3)	;
	HRRI	AC3,(AC1)	;FROM,,TO
	MOVE	AC2,IESIZ(I12)	;
	ADDI	AC2,-2(AC3)	;
	BLT	AC3,-1(AC2)	;

	;WRITE OUT THE SPLIT BLOCKS
	MOVE	AC1,NEWBK2	;
	MOVEM	AC1,@USOBJ0(I12)  ;NEW BLOCK NUMBER FOR CURRENT IDXBLK
	PUSHJ	PP,WIBK		;CURRENT
	PUSHJ	PP,WABK		;AUXBLK
	CAMN	LVL,MXLVL(I12)	;IS THIS THE TOP INDEX LEVEL?
	PUSHJ	PP,SAVTIE	;YES, SO SAVE TOP INDEX ENTRY FOR NEW TOP-LVL
	TLZE	FLG1,IIAB	;WAS INSERTION IN AUXBUF?
	PUSHJ	PP,MAUXI	;MOVE AUXBUF TO IDXBUF
	JRST	UDIF		;UPDATE THE NEXT LEVEL
	;CREATE ANOTHER LEVEL OF INDEX
UDIF10:	CAILE	LVL,12		;MORE LEVELS AVAILABLE?
	JRST	UDIER		;NO
	AOS	MXLVL(I12)	;INCREASE MXLVL BY ONE
	MOVEI	AC11,@IOWRD0(I12)
	SKIPN	KEYCV.		;SORT IN PROGRESS?
	PUSHJ	PP,UDIF11	;NO, TRY FOR MORE CORE
	MOVE	AC3,-1(AC11)	;YES, IOWRD OF OLD TOP INDEX BLOCK
	MOVE	AC5,1(AC3)	;FIRST HEADER WORD OF OLD TOP LEVEL
	ADD	AC5,[XWD 1,0]	;BUMP THE LEVEL BY ONE
	MOVE	AC1,(AC11)	;IOWRD OF NEW TOP INDEX BLOCK
	MOVEM	AC5,1(AC1)	;SAVE AS FIRST HEADER WORD
	SETZM	2(AC1)		;VERSION NUMBER OF TOP LEVEL IS ZERO

	;MAKE AN ENTRY  POINTING AT OLD TOP-LEVEL
	HRL	AC5,IESAVE	;
	HRRI	AC5,3(AC1)	;TO
	HRRZM	AC5,@CNTRY0(I12)  ;FIRST ENTRY = CURRENT ENTRY
	HRRZ	AC2,AC5	
	ADD	AC2,IESIZ(I12)	;UNTIL
	BLT	AC5,-1(AC2)	;DOIT

	PUSHJ	PP,ALC1IB	;GET THE NEXT FREE BLOCK
	MOVE	AC1,NEWBK2	;
	MOVEM	AC1,TOPIBN(I12)	;TOP INDEX BLOCK NUMBER
	MOVEM	AC1,@USOBJ0(I12)  ;  ALSO CURRENT
IFE ANS74,<
;DELETE FOR NOW AS IT CAUSES NAVY TESTS IX104 & IX204 TO FAIL
	SETOM	FS.IF		;[462] TURN ON THIS IS ISAM FLAG
	MOVE	AC0,[E.FIDX+E.BIDX+^D27] ;[462] THE ERROR MESSAGE
	PUSHJ	PP,IGCVR	;[462] DO USE PRO IF ANY
	 JRST	UDIF34		;[462] IGNORE, NO MESSAGE
>
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /% /]
	MOVE	AC2,[BYTE (5)10,31,20,14]
	PUSHJ	PP,MSOUT1
	OUTSTR	[ASCIZ / should be reorganized,
The top index block was just split.
/]
	JRST	UDIF34

UDIER:	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+E.BIDX+^D2]	;THE ERROR NUMBER
	PUSHJ	PP,IGCVR1	;FATAL MESSAGE OR IGNORE ERROR?
	 JRST	RET.2		;NO MESSAGE JUST RETURN TO CBL-PRGM
	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /No more index levels available to /]
	MOVE	AC2,[BYTE (5)10,31,20]
	PUSHJ	PP,MSOUT1	;KILL
UDIF11:	CAIN	LVL,12		;IF HIGHEST POSSIBLE LEVEL
	SKIPL	@IOWRD0(I12)	;  AND SPACE IS STILL AVAILABLE
	JRST	.+2
	JRST	UDIF12		;  USE THE ALLOCATED AREA

	;ZERO FREE CORE
	HRRZ	AC1,.JBFF	;SET UP TO ZERO THE FIRST FREE WORD
	CAMG	AC1,.JBREL	;[320] DON'T ZERO IT IF OUT-OF-BOUNDS
	SETZM	(AC1)		;ZERO INITIAL WORD
	HRL	AC0,AC1		;MAKE A BLT
	HRRI	AC0,1(AC1)	;  POINTER
	CAML	AC1,.JBREL	;[320] EXIT
	JRST	UDIF13		;[320]  HERE IF DONE
	HRRZ	AC1,.JBREL	;MAKE A BLT TERMINATOR
	SKIPE	HLOVL.		;[474] ARE THERE OVERLAYS?
	HRRZ	AC1,HLOVL.	;[474] YES, ONLY CLEAR TO BOTTOM OF OVERLAY
	BLT	AC0,(AC1)	;PROPAGATE THE ZERO

UDIF13:	HLRO	AC1,-1(AC11)	;[320]
	MOVN	AC0,AC1		;LENGTH FOR GETSPC
	HRL	AC1,.JBFF	;DWOI
	PUSHJ	PP,GETSPC	;GET SOME SPACE
	 JRST	UDIF12		;NO MORE CORE
	HRRZ	AC0,HLOVL.	;[346] GET START OF OVERLAY AREA
	CAMGE	AC0,.JBFF	;[346] BUFFER EXTEND INTO OVL AREA?
	JUMPN	AC0,UDIF15	;ERROR IF IN OVERLAY AREA
	MOVE	AC0,(AC11)	;IOWD FOR ALLOCATED AREA
	CAIGE	LVL,12		;SKIP IF IF CAN'T BE
	MOVEM	AC0,1(AC11)	;SAVE FOR NEXT TOP BLK SPLIT
	MOVSS	AC1		;-LEN,,LOC
	SUBI	AC1,1		;MAKE IT AN IOWD
	MOVEM	AC1,(AC11)	;SAVE AS CURRENT IOWRD

UDIF12:	SKIPE	(AC11)		;ANY CORE ALLOCATED?
	POPJ	PP,		;YES, PHEW!
	MOVEI	AC0,^D30	;RERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+E.BIDX+^D3]	;ERROR NUMBER
	PUSHJ	PP,IGCVR2	;FATAL MESSAGE OR IGNORE ERROR?
	 JRST	RET.2		;IGNORE SO RETURN TO MAIN LINE CODE

UDIF14:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /Insuficient memory while attempting to split the top index block of
/]
	MOVE	AC2,[BYTE(5)10,31,20]
	PUSHJ	PP,MSOUT1	;KILL
UDIF15:	HLRZM	AC1,.JBFF	;GET OUT OF OVERLAY AREA
	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+E.BIDX+^D36]	;ERROR NUMBER
	PUSHJ	PP,IGCVR2	;IGNORE?
	 JRST	RET.2		;YEP
	XCT	WOVLRX		;GIVE ERROR MESSAGE
	JRST	UDIF14		; AND KILL

	;ALOCATE TWO INDEX BLOCKS

ALC2IB:	MOVE	AC1,FMTSCT(I12)	;
	MOVEM	AC1,NEWBK1	;
	MOVE	AC0,ISPB(I12)	;NUMBER OF SECTORS PER INDEX BLOCK
	ADDM	AC0,FMTSCT(I12)	;UPDATE FIRST EMPTY SECTOR AVAILABLE
ALC1IB:	MOVE	AC1,FMTSCT(I12)	;
	MOVEM	AC1,NEWBK2	;
	MOVE	AC0,ISPB(I12)	;
	ADDM	AC0,FMTSCT(I12)	;
	TLO	FLG1,WSTB	;REMEMBER TO WRITE THE STATISTICS BLOCK
	POPJ	PP,
	;DECIDE WHERE TO SPLIT THE BLOCK
SPLTBK:	TLO	FLG1,BVN	;NOTE THE BLOCK WAS SPLIT
	PUSHJ	PP,SETLRW	;BUMP THE VERSION NUMBERS
	HRRZ	AC4,CNTRY(I12)	;
	SUBI	AC4,1		;ONE FOR HEADER WORD
	HRRZ	AC5,DBF(I12)	;DATA BLOCKING FACTOR
	LSH	AC5,-1		;2ND HALF GE 1ST HALF
	MOVE	AC11,DRTAB	;
	ADD	AC11,AC5	;BEG OF 2ND HALF
	MOVE	AC10,(AC11)	;
	CAIG	AC4,(AC10)	;NEWREC IN 2ND HALF?
	JRST	SPLT01		;NO

	;MAKE HEADER WORD FOR NEWREC
	TLO	FLG1,IIAB	;NOTE INSERTION IS IN AUX BUFFER
	ADDI	AC11,1		;MAKE 1ST HALF GE 2ND HALF
	LDB	AC2,WOPRS.	;NEWREC SIZE
	MOVEM	AC2,AC6		;FIRST PART OF HEADER WORD
	JUMPGE	FLG,SPLT03	;ASCII?
	ADDI	AC2,2		;<CRLF>
	ADDI	AC6,2		;<CRLF>
	LSH	AC6,1		;MAKE ROOM FOR BIT35
	TRO	AC6,1		;MAKE IT LOOK LIKE A SEQUENCE NUMBER
SPLT03:	MOVE	AC3,IOWRD(I12)	;GET VERSION NUMBER
	HLL	AC6,1(AC3)	;HEADER WORD = VERSION # ,, RECSIZ

	;HOW MANY WORDS IN NEWREC?
	IDIV	AC2,D.BPW(I16)	;
	JUMPE	AC3,.+2		;
	ADDI	AC2,1		;
	ADDI	AC2,1		;PLUS ONE FOR HEADER WORD

	;MOVE 1ST PART OF 2ND HALF TO AUXBUF
	HRL	AC0,(AC11)	;
	HRR	AC0,AUXBUF	;FROM ,, TO
	HRRZI	AC1,-1(AC4)	;
	HRRZ	AC3,(AC11)	;ADR OF FIRST REC-HDR TO GO IN AUXBUF
	SUB	AC1,AC3		;LENGTH OF FIRST PART
	HRRZM	AC1,TEMP.	;LEN OF PART BEFORE NEW-REC
	CAIGE	AC1,0		;IS NEW-REC FIRST IN AUXBUF?
	SETZM	TEMP.		;YES
	ADD	AC1,AUXBUF	;UNTIL
	SKIPE	TEMP.		;[271] DON'T DO BLT IF FIRST RECORD
	BLT	AC0,(AC1)	;FIRST PART
	MOVEM	AC6,1(AC1)	;NEWREC HEADER WORD
	;MAKE ROOM FOR NEWREC & MOVE THE REST TO AUXBUF
	HRL	AC0,(AC11)	;
	HRR	AC0,AUXBUF	;
	SKIPE	AC6,TEMP.	;LEN OF FIRST PART
	ADDI	AC6,1		;
	HRL	AC6,AC6		;
	ADD	AC0,AC6		;SKIP OVER FIRST PART
	HLL	AC3,CNTRY(I12)	;BYTE-POINTER POSITION & SIZE
	HLLM	AC3,TEMP.2	;SAVE FOR MOVRBA
	HRRM	AC0,TEMP.2	;WHERE TO MAKE INSERTION IN AUXBUF
	AOS	TEMP.2		;
	ADD	AC0,AC2		;MAKE ROOM FOR NEWREC
	HRRZ	AC2,LRW(I12)	;
	HLRZ	AC1,AC0		;
	SUBM	AC2,AC1		;
	ADD	AC1,AC0		;UNTIL
	BLT	AC0,(AC1)	;MOVIT
	JRST	SPLT02

	;MOVE 2ND HALF OF CURRENT BLOCK TO AUXBUF
SPLT01:	HRL	AC0,(AC11)	;
	HRR	AC0,AUXBUF	;FROM,,TO
	HRRZ	AC1,LRW(I12)	;
	SUB	AC1,(AC11)	;LEN
	ADD	AC1,AC0		;UNTIL
	BLT	AC0,(AC1)	;
SPLT02:	HRRZM	AC1,LRWA	;LAST-REC-WRD FOR AUXBUF

	;ZERO THE REST OF AUXBUF
	HLRZ	AC2,IOWRD(I12)	;
	MOVE	AC0,AUXBUF	;
	SUBI	AC0,1(AC2)	;
	HRLI	AC1,1(AC1)	;
	HRRI	AC1,2(AC1)	;FROM ,,TO
	HRRZ	AC2,AC0		;UNTIL
	CAIGE	AC2,(AC1)	;IF UNTIL LESS THAN TO
	JRST	SPLT04		;  SKIP THE BLT
	SETZM	-1(AC1)		;ZERO THE FIRST WORD
	EXCH	AC0,AC1		;
	BLT	AC0,(AC1)	;

	;ZERO 2ND HALF OF CURRENT BLOCK
SPLT04:	HRRZ	AC2,(AC11)	;FIRST FREE DATA WRD LOC
	SUBI	AC2,1		;LRW
	HRRZI	AC0,2(AC2)	;
	CAMLE	AC0,LRW(I12)	;CHECK BLT POINTERS
	JRST	SPLT05		;FROM GE UNTIL
	HRLI	AC0,1(AC2)	;
	SETZM	1(AC2)		;
	EXCH	AC2,LRW(I12)	;
	BLT	AC0,(AC2)	;
SPLT05:	MOVE	AC1,@AUXBUF	;GET THE VERSION NUMBER
	HLLM	AC1,(AC10)	;  SO BLOCKING FACTOR OF 1 WILL WORK
	PUSHJ	PP,ALC2BK	;GET TWO BLKNO
	MOVE	AC1,NEWBK2	;
	EXCH	AC1,USOBJ(I12)	;GIVE NEW BLKNO TO CURRENT BUFFER
	MOVEM	AC1,OLDBK	;MARK OLD ONE FOR DE-ALLOCATION
	MOVE	AC0,NEWBK1	;
	MOVEM	AC0,AUXBNO	;GIVE 2ND NEW BLKNO TO AUXBUF

	TLZN	FLG1,IIAB	;INSERTION IN AUX BLOCK?
	JRST	IWRI01		;NO
	PUSHJ	PP,WWDBK	;WRITE A DATA BLOCK
	PUSHJ	PP,MOVRBA	;INSERT
	PUSHJ	PP,WABK		;WRITE AUXBUF
	PUSHJ	PP,MAUXD	;MOVE AUXBUF TO DATABUF
	HRRZM	AC1,LRW(I12)	;
	JRST	IWRI04		;
	;ROUTINE MOVES CONTENTS OF AUXBUF TO DATA OR INDEX BUFFER
	;UPDATES CNTRY AND USOBJ SO SEQ-READS WILL WORK
MAUXD:	MOVE	AC0,LRW(I12)	;
	HRRZM	AC0,TEMP.1	;LAST RECORD WORD
MAUXI:	MOVE	AC0,TEMP.2	;
	SUB	AC0,AUXIOW	;
	ADD	AC0,@IOWRD0(I12)  ;
	HRRM	AC0,@CNTRY0(I12)  ;CURRENTRY
	MOVE	AC0,AUXBNO	;
	MOVEM	AC0,@USOBJ0(I12)  ;USETO OBJECT
	MOVE	AC1,LRWA	;
	SUB	AC1,AUXIOW	;LENGTH
	ADD	AC1,@IOWRD0(I12)  ;UNTIL
	MOVE	AC0,@IOWRD0(I12)
	ADDI	AC0,1		;
	HRL	AC0,AUXBUF	;FROM,,TO
	HRRZ	AC3,TEMP.1	;
	CAIL	AC3,(AC1)	;ANY REMNANTS LEFT?
	HRRZM	AC3,AC1		;YES, COVER THEM UP WITH ZEROES
	BLT	AC0,(AC1)	;DOIT!
	POPJ	PP,

	;SAVE TOP INDEX ENTRY FOR THE NEW TOP INDEX BLOCK
SAVTIE:	MOVE	AC2,@IOWRD0(I12)  ;
	ADDI	AC2,1		;
	HRLI	AC2,4(AC2)	;
	HRR	AC2,IESAVE	;FROM,,TO
	MOVE	AC3,NEWBK2	;
	MOVEM	AC3,(AC2)	;BLOCK NUMBER FOR THIS LEVEL
	MOVE	AC3,@IOWRD0(I12)
	MOVE	AC3,2(AC3)	;
	MOVEM	AC3,1(AC2)	;VERSION OF CURRENT IDX BLOCK
	HRR	AC3,IESIZ(I12)	;
	ADD	AC3,-1(AC2)	;UNTIL
	ADDI	AC2,2		;WHERE THE KEY WILL GO
	BLT	AC2,(AC3)	;MOVIT
	POPJ	PP,
	;MAKE TWO COPIES OF SYMKEY
	;ADJUST ONE TO MATCH IDXKEY, AND ONE TO RECKEY

ADJKEY:	MOVE	AC0,F.WBSK(I16)	;SYMBOLIC KEY BP
	MOVE	AC1,DAKBP(I12)	;DATA ADJUSTED KEY POINTER
	HRRM	AC1,DKWCNT(I12)	;DATA KEY WRD CNT
	MOVE	AC2,IAKBP(I12)	;INDEX ADJUSTED KEY POINTER
	HRRM	AC2,IKWCNT(I12)	;-CNT,,FRST-WRD
	MOVE	AC10,D.WCNV(I16); GET CONVERSION INST.
	TLNE	FLG1,NOTEST	; IF NOTEST - NO CONVERSION
	MOVSI	AC10,(TRN)	;
	LDB	AC4,KY.SIZ	; GET KEY SIZE
	TXNN	AC16,STA%AP	;BL; APPROXIMATE KEY?
	JRST	ADJKE1		;BL; NO
	MOVE	AC5,AC4		;BL; YES, SAVE FULL COUNT
	MOVE	AC4,F.AKS(I16)	; LOAD APPROXIMATE KEY SIZE
ADJKE1:	ILDB	C,AC0		;SYMKEY
	XCT	AC10		; CONVERT IF NECESSARY
	IDPB	C,AC1		;RECKEY
	IDPB	C,AC2		;IDXKEY
	SOJG	AC4,ADJKE1	;
	TXNN	AC16,STA%AP	;BL;APPROXIMATE KEY?
	POPJ	PP,		;BL; NO, RETURN
	MOVN	AC4,F.AKS(I16)	; YES, GET NEG APP-KEY SIZE
	ADD	AC4,AC5		;BL; BYTES LEFT
	TXNN	AC16,STA%GT	; GREATER THAN?
	TDZA	C,C		; NO, LOW-VALUES
	SETO	C,		; YES, HIGH VALUES
ADAPKY:	IDPB	C,AC1		;BL; RECKEY
	IDPB	C,AC2		;BL; IDXKEY
	SOJG	AC4,ADAPKY	;BL; LOOP THRU REST OF SYM-KEY
	POPJ	PP,


	;CONVERT NUMERIC DISPLAY OR COMP-3 TO ONE/TWO WRD INTEGER
GD67:	MOVEI	AC0,ACSAV0	;
	BLT	AC0,ACSAV0+16	;
	MOVE	AC16,[Z AC2,GDPSK]  ;PARAMETER
	ADD	AC16,I12	;INDEX IT
	PUSHJ	PP,@GDX.I(I12)	;CALL GD6. OR GD7. OR GD9. OR GC3.
	MOVEM	AC2,@IAKBP(I12)
	MOVEM	AC2,@DAKBP(I12)
	MOVEM	AC3,@IAKBP1(I12)
	MOVEM	AC3,@DAKBP1(I12)
	HRLZI	AC0,ACSAV0
	BLT	AC0,AC16
	POPJ	PP,


	;GET SET FOR ONE/TWO WRD INTEGER
FPORFP:	MOVE	AC1,F.WBSK(I16)	;SYM-KEY
	MOVE	AC0,(AC1)	;
	MOVEM	AC0,@IAKBP(I12)
	MOVEM	AC0,@DAKBP(I12)
	MOVE	AC0,1(AC1)
	MOVEM	AC0,@IAKBP1(I12)
	MOVEM	AC0,@DAKBP1(I12)
	POPJ	PP,
	;DO THE BINARY SEARCH AGAIN, THERE WAS A VERSION NUMBER DISCREPANCY
	;ROUTINE CAUSES GETBLK TO REREAD INDEX/DATA BLOCKS FROM DSK
IBSTOP:	POP	PP,AC1		;CLEAR RETURN TO IBS+1
IBSTO1:	MOVN	AC1,MXLVL(I12)	;NUMBER OF IOWD'S TO ZERO
	MOVEI	AC2,USOBJ(I12)	;ADR OF FIRST IOWD
	HRL	AC2,AC1		;FOR AOBJN
	SETZM	(AC2)		;
	AOBJN	AC2,.-1		;

	;BINARY SEARCH ROUTINE FOR THE INDEX BLOCKS

IBS:	PUSHJ	PP,GETOP	;GET THE TOP LEVEL INDEX BLOCK
	JRST	.+2

IBS0:	PUSHJ	PP,GETBLK	;GET THE BLOCK INTO CORE
	MOVE	AC5,SINC(I12)	;THE SEARCH INCREMENT
	HRRZ	AC4,@IOWRD0(I12)
	SUB	AC4,IESIZ(I12)	;INITIALIZE AT ZEROTH ENTRY
	ADDI	AC4,3		;ADR OF FIRST WRD OF FIRST ENTRY
	MOVE	AC6,IBLEN(I12)	;TABLE LEN
	ADD	AC6,AC4		;TABLE LIMIT

IBSGE:	LSH	AC5,-1		;HALF THE INC
	CAMGE	AC5,IESIZ(I12)	;BEGINNING OF TABLE?
	JRST	IBS100		;YES, DONE
	ADD	AC4,AC5		;CURRENT ENTRY PLUS INC
IBS2:	MOVE	AC10,AC4
	ADD	AC10,IESIZ(I12)
	CAMG	AC10,AC6	;[311] END OF TABLE?
	SKIPN	(AC10)		;[311] NULL ENTRY?
	JRST	IBSLT		;YES, GO OTHER WAY
	TXNE	FLG1,FSTIDX	;[605] SKIP IF NOT 1ST READ SEQ
	JRST	IBSLT		;[605] ELSE GO DOWN LEFT SIDE TO 1ST DATA REC
	JRST	@ICMP(I12)	;DO THE COMPARISON
	;RETURNS ARE IBSGE OR IBSLT

IBSLT:	LSH	AC5,-1		;HALF THE INC
	CAMGE	AC5,IESIZ(I12)	;BEG OF TABLE?
	JRST	IBS10		;YES, DONE
	SUB	AC4,AC5		;CURRENT ENTRY MINUS INC
	JRST	IBS2		;

IBS100:	MOVE	AC4,AC10	;AC10 HAS ENTRY FROM GE
IBS10:	MOVEM	AC4,@CNTRY0(I12)  ;ADR OF CURRENT ENTRY
	SETZM	@NNTRY0(I12)	;SO 'SREAD' WILL WORK IF IT'S NEXT
	SOJG	LVL,IBS0	;GO AGAIN DOWN A LEVEL
	JRST	DSRCH		;LEVEL ZERO, EXIT SEARCH ROUTINE
	;INDEX DISPLAY NON-NUMERIC COMPARE
ICDNN:	MOVE	AC1,IKWCNT(I12)	;-CNT ,, ADR OF IAK
	MOVEI	AC2,2(AC10)	;INDEX ENTRY
ICDNN1:	MOVE	AC0,(AC2)	;INDEX ENTRY
	CAME	AC0,(AC1)	;SYM-KEY = IDX-KEY
	JRST	ICDNN2		;NOT EQUAL
	ADDI	AC2,1		;NEXT
	AOBJN	AC1,ICDNN1	;LOOP IF YOU CAN
	JRST	IBSGE		;EQUAL RETURN
ICDNN2:	MOVE	AC3,(AC1)	;SYM-KEY
	TLC	AC0,1B18	;
	TLC	AC3,1B18	;
	CAMG	AC0,AC3		;
	JRST	IBSGE		;SYM-KEY GT IDX-KEY
	JRST	IBSLT		;SYM-KEY LT IDX-KEY


	;INDEX COMPARE ONE WORD SIGNED
IC1S:	MOVE	AC0,@IAKBP(I12)	;SYM-KEY
	CAMGE	AC0,2(AC10)	;
	JRST	IBSLT		;SYM-KEY LT IDX-KEY
	JRST	IBSGE		;SYM-KEY EQ OR GT IDX-KEY

	;TWO WORD SIGNED
IC2S:	MOVE	AC0,@IAKBP(I12)	;SYM-KEY
	CAMGE	AC0,2(AC10)	;
	JRST	IBSLT		;SYM-KEY LT IDX-KEY
	CAME	AC0,2(AC10)	;
	JRST	IBSGE		;SYM-KEY GT IDX-KEY
	MOVE	AC0,@IAKBP1(I12)  ;NEXT WRD
	CAMGE	AC0,3(AC10)	;
	JRST	IBSLT		;SK LT IK
	JRST	IBSGE		;SK EQ OR GT IK

	;ONE WORD UNSIGNED
IC1U:	MOVM	AC0,@IAKBP(I12)	;SK
	MOVM	AC1,2(AC10)	;IK
	CAMGE	AC0,AC1		;
	JRST	IBSLT		;SK LT IK
	JRST	IBSGE		;SK EQ OR GT IK

	;TWO WORD UNSIGNED
IC2U:	MOVM	AC0,@IAKBP(I12)	;SK
	MOVM	AC1,2(AC10)	;IK
	CAMGE	AC0,AC1		;
	JRST	IBSLT		;SK LT IK
	CAME	AC0,AC1		;
	JRST	IBSGE		;SK GT IK
	MOVM	AC0,@IAKBP1(I12)	;
	MOVM	AC1,3(AC10)	;
	CAMGE	AC0,AC1		;
	JRST	IBSLT		;SK LT IK
	JRST	IBSGE		;SK EQ OR GT IK
	;SEACH FOR A DATA FILE KEY 
DSRCH:	MOVE	AC0,(AC4)	;GET THE BLOCK NUMBER
	JUMPN	AC0,DSRCH1	;IS IT ZERO ?
	TXNN	AC16,V%WRITE	;YES, TAKE INVALID KEY EXIT
	JRST	RRDIV1
	JRST	IWIVK1		;NO


DSRCH1:	PUSHJ	PP,GETBLK	;
	PUSHJ	PP,SETLRW	;SETUP LRW, POINTER TO LAST FREE RECWRD
	LDB	AC6,F.BBKF	;NUMBER OF RECS THIS BLK
	HRRZ	AC4,IOWRD(I12)	;
	ADDI	AC4,2		;FIRST WORD, FIRST REC
	LDB	AC1,RSBP(I12)	;RECSIZ IN CHARS
	IDIV	AC1,D.BPW(I16)	;
	JUMPE	AC2,.+2		;
	ADDI	AC1,1		;
	JUMPE	AC1,DSNUL	;EXIT HERE IF DATA BLOCK IS EMPTY
	MOVEI	AC5,1(AC1)	;RECSIZ IN WRDS PLUS ONE
	ADDI	AC5,-1(AC4)	;5 POINTS AT NEXT RECSIZ WRD
	TLNE	FLG1,SEQ	;A SEQUENTIAL READ?
	POPJ	PP,		;YES, EXIT HERE
DSLOOP:	ADD	AC4,DBPRK(I12)	;[276] FIRST KEY,FIRST REC
	MOVE	AC10,AC4	;
	JRST	@DCMP(I12)	; RETURNS TO DSGT, DSEQ OR DSLT
DSGT:	HRRZI	AC4,1(AC5)	;FIRST WRD NEXT REC
	SOJE	AC6,DSGT03	;EXIT IF NO ROOM FOR MORE RECORDS
	LDB	AC1,RSBP(I12)	;RECSIZ IN CHARS
	IDIV	AC1,D.BPW(I16)	;
	JUMPE	AC2,.+2		;
	ADDI	AC1,1		; IN WORDS
	MOVEI	AC5,1(AC1)	;RECSIZ INWORDS PLUS ONE
	ADDI	AC5,-1(AC4)	;5 POINTS AT NEXT RECSIZ WORD
	SKIPE	-1(AC4)		;SKIP IF APPENDING TO THE RECS IN THIS BLK
	JRST	DSLOOP		;
DSGT01:	HRRZI	AC4,(AC5)
	TXNN	AC16,V%WRITE	;LAST REC & NOT FOUND
	JRST	RRDIVK		;READ, RERIT, DELET INVALID-KEY
	JRST	DSXIT1		;THIS WILL BE THE LAST RECORD IN THIS BLOCK
DSGT03:	AOJA	AC5,DSGT01	;CNTRY MUST POINT AT RECORD NOT HEADER

DSEQ:	TXNE	AC16,V%WRITE	;
	JRST	IWIVK		;WRITE INVALID-KEY
DSXIT:	SUB	AC4,DBPRK(I12)	;[276] DATA BYTE-POINTER TO RECORD KEY
DSXIT1:	MOVEM	AC4,CNTRY(I12)	;
;BL;	1 LINE INSERTED AT DSXIT+1 TO FIX START-RETAIN BUG  ***************
	SKIPN	SU.FRF		;DON'T RESET IF RETAIN
	SETZM	NNTRY(I12)	;SO SREAD WILL GET "NEXT" RECORD
	POPJ	PP,

	;NO RECORDS IN THIS DATA BLOCK
DSNUL:	TXNE	AC16,V%WRITE	;
	JRST	DSXIT1
	TRNN	FLG1,FSTIDX	;[661] DOING FIRST SEQ READ TO BEGIN OF FILE
	JRST	RRDIVK
	POPJ	PP,		;[661] YES, RETURN TO BROWSE THRU FILE
	;CALL IS:	JRST @DCMP(I12)
	;RETURNS:	DSGT OR DSEQ OR DSLT

	;CONVERT NUMERIC DISPLAY TO 1 OR 2 WRD INTEGER
DGD67:	MOVE	AC0,[XWD AC4, ACSAV0+4]  ;
	BLT	AC0,ACSAV0+16	;SAVE ACS
	HRRM	AC10,GDPRK(I12)  ;POINT AT CURRENT DATA KEY
	MOVE	AC16,[Z AC2,GDPRK]  ;PARAMETER
	ADD	AC16,I12	;INDEX IT
	PUSHJ	PP,@GDX.D(I12)	;CONVERT, GD6. OR GD7.
	MOVE	AC0,[XWD ACSAV0+4, AC4]  ;
	BLT	AC0,AC16	;
	MOVEI	AC10,2		;POINT AT CONVERTED DATA
	JRST	@DCMP1(I12)	;OFF TO COMPARISION ROUTINE

	;DATA DISPLAY NON-NUMERIC COMPARE
DCDNN:	MOVE	AC1,DKWCNT(I12)	;-CNT ,, DAKBP
	MOVE	AC0,FWMASK(I12)	;FIRST WRD MASK
	JUMPE	AC0,DCDNN2	;JUMP ONLY ONE WRD
	AND	AC0,(AC10)	;REC-KEY
	JRST	.+2
DCDNN1:	MOVE	AC0,(AC10)	;REC-KEY
	CAME	AC0,(AC1)	;
	JRST	DCDNN3		;NOT EQ
	ADDI	AC10,1		;NEXT
	AOBJN	AC1,DCDNN1	;
DCDNN2:	MOVE	AC0,LWMASK(I12)	;LAST WRD MASK
	AND	AC0,(AC10)	;
	CAMN	AC0,(AC1)	;
	JRST	DSEQ		;SYM-KEY EQ REC-KEY
DCDNN3:	MOVE	AC3,(AC1)	;
	TLC	AC0,1B18	;
	TLC	AC3,1B18	;
	CAMG	AC0,AC3		;
	JRST	DSGT		;SYM-KEY GT REC-KEY
;	JRST	DSLT		;SYN-KEY LT REC-KEY
DSLT:	TXNE	AC16,V%WRITE	;
	JRST	DSXIT		;NORMAL IWRITE EXIT
	SUB	AC4,DBPRK(I12)	;[276] DATA BYTE-POINTER TO RECORD KEY
	JRST	RRDIVK		;READ, RERIT, DELETE INVALID-KEY
	;DATA, ONE WRD SIGNED
DC1S:	MOVE	AC0,@DAKBP(I12)	;
	CAMGE	AC0,(AC10)	;
	JRST	DSLT		;SK LT RK
	CAME	AC0,(AC10)	;
	JRST	DSGT		;SK GT RK
	JRST	DSEQ		;SK EQ RK

	;DATA, TWO WRD SIGNED
DC2S:	MOVE	AC0,@DAKBP(I12)	;
	CAMGE	AC0,(AC10)	;
	JRST	DSLT		;SK LT RK
	CAME	AC0,(AC10)	;
	JRST	DSGT		;SK GT RK
	MOVE	AC0,@DAKBP1(I12);
	CAMGE	AC0,1(AC10)	;
	JRST	DSLT		;SK LT RK
	CAME	AC0,1(AC10)	;
	JRST	DSGT		;SK GT RK
	JRST	DSEQ		;SK EQ RK

	;DATA, ONE WRD UNSIGNED
DC1U:	MOVM	AC0,@DAKBP(I12)	;
	MOVM	AC1,(AC10)	;
	CAMGE	AC0,AC1		;
	JRST	DSLT		;SK LT RK
	CAME	AC0,AC1		;
	JRST	DSGT		;SK GT RK
	JRST	DSEQ		;SK EQ RK

	;DATA, TWO WRD UNSIGNED
DC2U:	MOVM	AC0,@DAKBP(I12)	;
	MOVM	AC1,(AC10)	;
	CAMGE	AC0,AC1		;
	JRST	DSLT		;SK LT RK
	CAME	AC0,AC1		;
	JRST	DSGT		;SK GT RK
	MOVM	AC0,@DAKBP1(I12);
	MOVM	AC1,1(AC10)	;
	CAMGE	AC0,AC1		;
	JRST	DSLT		;SK LT RK
	CAME	AC0,AC1		;
	JRST	DSGT		;SK GT RK
	JRST	DSEQ		;SK EQ RK
	;GET A BLOCK, MAYBE THE TOP-BLOCK & CHECK VERSION NOS
GETOP:	MOVE	LVL,MXLVL(I12)	;NOTE ITS TOP LVL
	SKIPA	AC1,TOPIBN(I12)	;THE BLOCK NO.

GETBLK:	MOVE	AC1,(AC4)	;NEXT BLKNO
	MOVE	AC2,@IOWRD0(I12)  ;CURRENT IOWRD
	MOVEM	AC2,CMDLST	;SET THE IOWD
	CAMN	AC1,@USOBJ0(I12)  ;IN CORE?
	JRST	GETB0A		;YES
GETB0E:	JUMPE	LVL,GETB0C	;JUMP IF DATA FILE
IFN ISTKS,<AOS @INSSS0(I12)	;COUNT THE IN'S	>
IFN LSTATS,<
	MOVEM	AC1,MRBNUM	;SAVE BLOCK NUMBER
	PUSHJ	PP,IOHSTR	;CALL HISTOGRAM ROUTINE
>
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FIUSI	; DO A FILOP. TYPE USETI
	  XCT	ISETI		;INDEX FILE
	XCT	IIN		;[IN CH,CMDLST]
GETB1E:	SKIPA	AC2,2(AC2)	;GET NEW VERSION NO.
	  JRST	GBIER		;INPUT ERROR
GETB0D:	MOVEM	AC1,@USOBJ0(I12)  ;BLKNO TO USOBJ(I12)
	SKIPE	LVL		;DATA BLOCK ALWAYS HAS VERSION NO.
	CAME	AC1,TOPIBN(I12)	;TOPBLOCK HAS NO VERSION NO.
	CAMN	AC2,1(AC4)	;SAME VERNO?
	POPJ	PP,		;YES
	JRST	GETB0B		;VERSION ERROR

	;IGNORE THIS INDEX FILE INPUT ERROR?
GBIER:	MOVE	AC0,[E.MINP+E.FIDX+E.BIDX]	;NOTE IT WAS AN INPUT ERROR
	PUSHJ	PP,IGMI		;IGNORE THIS ERROR?
	 JRST	IINER		;NO, GIVE AN ERROR MESSAGE
	PUSHJ	PP,CLRIS	;YES, CLEAR THE INDEX FILE STATUS BITS
	JRST	GETB1E		;  AND IGNORE THE ERROR.

GETB0A:	TLNE	FLG1,RIVK!VERR	;FORCE INPUT?
	JRST	GETB0E		;YEP
	JUMPE	LVL,GETB0F	;LEVEL 0 IS A DATA FILE
	MOVE	AC2,2(AC2)	;
	CAME	AC1,TOPIBN(I12)	;TOP-BLOCK HAS NO VERNO
	CAMN	AC2,1(AC4)	;
	POPJ	PP,

GETB0B:	MOVEI	AC1,@USOBJ0(I12);GET ADR OF THIS LEVEL'S BLOCK #
	MOVE	AC1,1(AC1)	;GET BLOCK # OF PRECEDING LEVEL
	MOVEM	AC1,FS.BN	;SAVE THE OFFENDING BLOCK NUMBER
	TLNE	FLG1,SEQ	;SEQ READ?
	JRST	UDVERR		;SPECIAL CASE
	TLON	FLG1,VERR	;FIRST OR SECOND ERROR?
	JRST	IBSTOP		;FIRST, SO TRY AGAIN
	PUSHJ	PP,VNDE		;[307] IF TOP BLOCK WAS SPLIT TRY AGAIN
	  JRST	GBVER		;[307] NO - SO ERROR MESSAGE AND QUIT
	JRST	IBSTOP		;[307] YES - TRY ONE MORE TIME
	;IGNORE THIS ERROR?
GBVER:	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDA+E.BDAT+^D4]	;ERROR NUMBER
	CAIE	LVL,0		;SKIP IF DATA BLOCK
	MOVE	AC0,[E.FIDX+E.BIDX+^D4]	;ERROR NUMBER
	PUSHJ	PP,IGCV		;IGNORE ERROR?
	 JRST	GETB0G		;NO -- GIVE A ERROR MESSAGE
	POPJ	PP,		;YES -- TAKE A NORMAL EXIT

GETB0G:	OUTSTR	[ASCIZ /Version number discrepancy /]
	JRST	IINER2		;

GETB0C:	SKIPN	LIVE(I12)	;MUST BLOCK BE OUTPUT?
	JRST	GETB1C		;NO
	PUSHJ	PP,WWDBK	;YES--DOIT
	JRST	GETBLK		;
GETB1C:	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSI		; DO A FILOP. TYPE USETI
	  XCT	USETI.	
	HRRI	AC0,CMDLST
	HRRM	AC0,UIN.
IFN ISTKS,<AOS @INSSS0(I12)	;COUNT THE IN'S	>
	XCT	UIN.
GETB0F:	SKIPA	AC2,1(AC2)
	 JRST	GBDER
	HLLZS	UIN.
	HLRZS	AC2		;VERSION NO TO RIGHT HALF
	TRZ	AC2,-100	;CLEAR OUT THE FILE FORMAT INFO
	JRST	GETB0D

	;IGNORE DATA FILE IO ERROR?
GBDER:				;[1103]

IFE TOPS20,<			;[1103] TOPS-10 ONLY EOF ERROR FLAG TO TEST
	SKIPE	SU.FRF		;[1103] DOING FAKE READ, I.E. SMU RETAIN?
	PUSHJ	PP,GBDEOF	;[1103] YES, GO TEST FOR EOF FLAG FROM IN UUO
	 JRST	GBDER1		;[1103]  TEST IS FALSE, RETURN +1
	PUSHJ	PP,CLRDS	;[1103]  TEST IS TRUE, RETURN +2, GO CLEAR STATUS
	JRST	GETB0F		;[1103]   AND GO RETURN BLOCK = 0, WHICH IS OK
GBDER1:				;[1103] 
>				;[1103] END IFE TOPS20

	MOVE	AC0,[E.MINP+E.FIDA+E.BDAT]	;ERROR NUMBER
	PUSHJ	PP,IGMD		;IGNORE THE ERROR?
	 JRST	UINER		;NO, GIVE ERROR MESSAGE
	PUSHJ	PP,CLRDS	;CLEAR DATA FILE STATUS BITS
	JRST	GETB0F		;YES, TAKE A NORMAL RETURN

	;[1103] TEST TOPS-10 EOF ERROR FLAG FROM IN UUO

IFE TOPS20,<			;[1103] 

GBDEOF:				;[1103] 
	PUSH	PP,AC2		;[1103] SAVE CHANNEL INFO FROM IN UUO CALL
	XCT	UGETS.		;[1103] DO A GETSTS UUO ON CHANNEL
	TXNE	AC2,IO.ERR	;[1103] REPORTING A REAL I-O ERROR?
	 JRST	GBDEO1		;[1103]  YES, RETURN +1
	TXNE	AC2,IO.EOF	;[1103] EOF FLAG SET FOR IN UUO?
	 AOS	-1(PP)		;[1103]  YES, SET UP TO RETURN +2
GBDEO1:				;[1103] 
	POP	PP,AC2		;[1103] RESTORE CHANNEL INFO
	POPJ	PP,		;[1103]  AND RETURN
>				;[1103] END IFE TOPS20
	;[307] HERE ON "VERSION NUMBER DISCREPANCY ERROR"
	;[307]  SEE IF THERE ARE MORE INDEX LEVELS THAN THE READER KNOWS ABOUT
	;[307]  I.E. WHEN A WRITER SPLITS THE TOP BLOCK AND CREATES A NEW
	;[307]  INDEX LEVEL.
	;[307]  IF SO GET ANOTHER BUFFER TO ACCOMMODATE THE NEW INDEX LEVEL(S)
	;[307]  AND TRY AGAIN.
	;[307]  POPJ IF	OPNOUT OR NO NEW INDEX LEVEL OR SORT IN PROGRESS
	;[307] 		OR NO MORE CORE.
	;[307]  ELSE TAKE A SKIP EXIT -- TRY AGAIN.

VNDE:	TLZE	FLG1,TRYAGN	;[307] BEEN HERE BEFORE ?
	POPJ	PP,		;[307] YES - CAN'T HELP
	TLO	FLG1,TRYAGN	;[307] REMEMBER YOU'VE BEEN HERE

	; ENTRY POINT TO READ FRESH COPY OF STS BLOCK
VNDE1:	PUSHJ	PP,RSTBK	;[307] NO - GET FRESH COPY OF STATISTICS BLOCK
	MOVN	AC5,MXLVL(I12)	;[307] SEE IF SOMEONE HAS CREATED
	SUB	AC5,OMXLVL(I12)	;[307]   A NEW INDEX LEVEL
	JUMPE	AC5,RET.1	;[307]   EXIT HERE IF NOT

	HRRZ	AC1,ISPB(I12)	;[307] BUILD AN IOWRD IN AC6
	IMULI	AC1,200		;[307]   AND GET THE LENGTH IN AC1
	MOVN	AC6,AC1		;[307]   --
	HRLZS	AC6		;[307]   --
	HRR	AC6,.JBFF	;[307]   --
	SUBI	AC6,1		;[307]   --.

	MOVEI	AC4,IOWRD+1(I12);[307] GET LOCATION OF THE FIRST
	SUB	AC4,OMXLVL(I12)	;[307]   UNUSED IOWRD POINTER	
	HRL	AC4,AC5		;[307] # OF NEW IOWRD'S REQUIRED

VNDE10:	SKIPE	(AC4)		;[307] IF IOWRD ALREADY EXIST	
	JRST	VNDE20		;[307]   TRY TO LOOP		
	SKIPE	KEYCV.		;[307] IF SORT IN PROGRESS
	POPJ	PP,		;[307]   QUIT -- CAN'T HANDLE THAT
	HRRZ	AC0,AC1		;[307] LENGTH OF THE BUFFER AREA
	PUSHJ	PP,GETSPC	;[307] GET SOME SPACE
	  POPJ	PP,		;[307]   NONE LEFT
	HRRZ	AC0,HLOVL.	;SEE IF WE'RE WIPING OUT
	CAMGE	AC0,.JBFF	; THE OVL-AREA
	JUMPN	AC0,VNDERR	;COMPLAIN IF WE ARE
	MOVEM	AC6,(AC4)	;[307] MAKE A NEW IOWRD
	ADD	AC6,AC1		;[307]   AND SET UP FOR NEXT ONE
VNDE20:	AOBJN	AC4,VNDE10	;[307] LOOP IF MORE LEVELS
	JRST	RET.2		;[307] TAKE SKIP EXIT + TRY AGAIN

VNDERR:	EXCH	AC1,.JBFF	;FIRST GET OUT 
	SUBM	AC1,.JBFF	; OF OVL-AREA
	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+^D35];IDX-FLAG TOO
	PUSHJ	PP,OXITP	;DONT RET IF IGNORING ERRORS
	XCT	WOVLRX		;GIVE MESSAGE
	JRST	GETB0G		;FINISH UP
	;MARK THIS BLOCK SO IT WILL BE OUTPUT
WDBK:	SETOM	LIVE(I12)	;MARK IT
	SKIPE	BRISK(I12)	;SKIP IS SLOW BUT SAFE
	POPJ	PP,

	;WRITE A DATA BLOCK
WWDBK:	MOVE	AC1,USOBJ(I12)	;
	MOVE	AC0,IOWRD(I12)	;
WWDBK1:	MOVEM	AC0,CMDLST	;
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSO		; DO A FILOP. TYPE USETI
	  XCT	USETO.		;
	MOVEI	AC2,CMDLST	;
	HRRM	AC2,UOUT.	;
	SETZM	LIVE(I12)	;CLEAR THE LIVE FLAG
	AOS	IOUUOS(I12)	;
IFN ISTKS,<AOS @OUTSS0(I12)	;COUNT THE OUT'S	>
	XCT	UOUT.		;
	 JRST	.+2		;
	PUSHJ	PP,WDBER	;OUTPUT ERROR
	HLLZS	UOUT.		;
	PUSHJ	PP,CKFOD	;[523] DO CHECK POINT FILOP.(.FOURB)
				;[530] RETURN TO CALLER IF OK

	;DATA FILE IO ERROR
WDBER:	MOVE	AC0,[E.MOUT+E.FIDA+E.BDAT];ERROR NUMBER
	PUSHJ	PP,IGMD		;IGNORE THIS ERROR?
	 JRST	UOUTER		;NO -- GIVE A ERROR MESSAGE
	JRST	CLRDS		;YES, CLEAR STATUS BITS

	;WRITE AN INDEX BLOCK
WIBK:	MOVE	AC1,@USOBJ0(I12)
	MOVE	AC0,@IOWRD0(I12)
IFN ISTKS,<AOS @OUTSS0(I12)	;COUNT THE OUT'S	>
WIBK1:	MOVEM	AC0,CMDLST	;
	AOS	IOUUOS(I12)	;
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FIUSO	; USE FILOP. TYPE USETO
	  XCT	ISETO		;
	XCT	IOUT		;
	  PUSHJ	PP,CKFOI	;[523] DO CHECK POINT FILOP.(.FOURB)
WIBK2:	MOVE	AC0,CMDLST	; RESTORE AC0
	CAMN	AC0,IOWRD+13(I12);SAT BLOCK?
	MOVE	AC0,[E.BSAT]	;YES
	CAMN	AC0,IOWRD+14(I12);STATISTICS BLOCK?
	MOVE	AC0,[E.BSTS]	;YES
	CAIG	AC0,0		;NONE OF THE ABOVE?
	MOVE	AC0,[E.BIDX]	;MUST BE INDEX BLOCK
	ADD	AC0,[E.MOUT+E.FIDX];OUTPUT ERROR
	PUSHJ	PP,IGMI		;IGNORE ERROR?
	 JRST	IOUTER		;NO
	JRST	CLRIS		;CLEAR STATUS BITS AND RETURN
	;WRITE A SAT BLOCK
WSBK:	MOVE	AC1,USOBJ+13(I12)
	MOVE	AC0,IOWRD+13(I12)
IFN ISTKS,<AOS OUTSSS+13(I12)	;COUNT THE OUT'S	>
	JRST	WIBK1		;

	;WRITE AUXILARY BLOCK
WABK:	MOVE	AC1,AUXBNO
	MOVE	AC0,AUXIOW
	HLL	AC0,IOWRD(I12)
	JUMPE	LVL,WWDBK1
	HLL	AC0,IOWRD+1(I12)
IFN ISTKS,<AOS @OUTSS0(I12)	;COUNT THE OUT'S	>
	JRST	WIBK1

	;WRITE STATISTICS BLOCK
WSTBK:	MOVEI	AC1,1
	MOVE	AC0,IOWRD+14(I12)
IFN ISTKS,<AOS OUTSSS+14(I12)	;COUNT THE OUT'S	>
	JRST	WIBK1

	;READ A STATISTICS BLOCK
RSTBK:	MOVEI	AC1,1			;[307]
	MOVE	AC2,IOWRD+14(I12)	;[307]
	MOVEM	AC2,CMDLST		;[307]

IFN LSTATS,<
	MOVEM	AC1,MRBNUM	;SAVE BLOCK NUMBER
	PUSHJ	PP,IOHSTR	;CALL I/O HISTOGRAM ROUTINE
>
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FIUSI	; USE FILOP. TYPE USETI
	 XCT	ISETI		;[307]
IFN ISTKS,<AOS INSSSS+14(I12)	;COUNT THE IN'S	>
	XCT	IIN		;[307]
	 POPJ	PP,		;[307]
	MOVE	AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER
	PUSHJ	PP,IGMI4	;IGNORE THE ERROR?
	 JRST	RSTBK1		;NO
	PUSHJ	PP,CLRIS	;CLEAR STATUS BITS
	TXNE	AC16,V%READ	;IF NOT IREAD OR SREAD
	AOS	(PP)		;  SKIP EXIT
	POPJ	PP,

RSTBK1:	OUTSTR	[ASCIZ /Cannot read statistics block./]	;[307]
	JRST	IINER		;[307]

	;READ A SAT BLOCK
RSBK:	MOVEM	AC1,USOBJ+13(I12)
	MOVE	AC2,IOWRD+13(I12)
	MOVEM	AC2,CMDLST
	AOS	IOUUOS(I12)

IFN LSTATS,<
	MOVEM	AC1,MRBNUM	;BLOCK NUMBER
	PUSHJ	PP,IOHSTR	;CALL HISTOGRAM ROUTINE
>
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FIUSI	; USE FILOP. TYPE USETI
	 XCT	ISETI
IFN ISTKS,<AOS INSSSS+13(I12)	;COUNT THE IN'S	>
	XCT	IIN
	 POPJ	PP,
	MOVE	AC0,[E.MINP+E.FIDX+E.BSAT] ;ERROR NUMBER
	PUSHJ	PP,IGMI2	;IGNORE ERROR?
	 JRST	RSBK1		;NO
	PUSHJ	PP,CLRIS	;CLEAR STATUS BITS
	JRST	RET.2		;TAKE A NORMAL EXIT
RSBK1:	OUTSTR	[ASCIZ /Cannot read sat block./]
	JRST	IINER
	;ROUTINE TO CLEAR INDEX FILE ERROR STATUS BITS
CLRIS:	PUSH	PP,AC2		;SAVE AC2
	XCT	IGETS		;GET STATUS TO AC2
	TXZ	AC2,IO.ERR	;TURN EM OFF
	XCT	ISETS		; AND RESET THEM
CLRIS1:	POP	PP,AC2		;
	POPJ	PP,		;

	;ROUTINE TO CLEAR DATA FILE ERROR STATUS BITS
CLRDS:	PUSH	PP,AC2		;SAVE AC2
	XCT	UGETS.		;GET STATUS TO AC2
	TXZ	AC2,IO.ERR	;TURN EM OFF
	XCT	USETS.		; AND RESET THEM
	JRST	CLRIS1
	;MOVE BUFFER TO RECORD  (READ)
MOVBR:
IFN ANS74,<
	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
	TRZE	AC0,SAVNXT	; CLEAR FLAG FOR NXT REC POS SAVED
	HRRM	AC0,D.RFLG(I16)	; Put IT BACK 
>
	LDB	AC0,F.BMRS	;MAX-REC-SIZ
	MOVEM	AC0,D.CLRR(I16)	;SAVE LENGTH 
	MOVE	AC6,RECBP(I12)	;REC BYTE-POINTER
	HRRZ	AC4,CNTRY(I12)	;[V10] POINTER TO DATA.
	HRRZ	AC3,-1(AC4)
	TLNN	FLG,DDMASC	;ASCII ?
	JRST	MOVBR1		;NO
	LSH	AC3,-1		;
	SUBI	AC3,2		;<CRLF>
MOVBR1:	ANDI	AC3,7777
	CAML	AC0,AC3		;[613]
	JRST	MOVB1A		;[613] REC SIZE OK
	PUSHJ	PP,ERRMR0	; THE RECORD SIZE IS TOO BIG!

	;[613] PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;[613] IS LARGER THAN FD MAXIMUM

	OUTSTR	[ASCIZ/%Record length field larger than FD maximum, assuming max.
/]
	; AC3 LOADED WITH MAX SIZE IN ERRMR0

MOVB1A:	MOVEM	AC3,D.CLRR(I16)	;[613] UPDATE WITH LENGTH READ
	TLNN	FLG,CONNEC!DDMASC!DDMBIN
	JRST	BLTBR			; EBCDIC OR SIXBIT, BLTIT
	LDB	AC10,[POINT 2,FLG,2]	; GET DEVICE DATA MODE
	HLL	AC4,RBPTB1(AC10)	; GET BYTE PTR
	MOVE	AC10,D.RCNV(I16)	; SET AC10
	SUBI	AC0,(AC3)	;[335] KEEP TRACK OF NEEDED BLANK FILL

MOVB0A:	ILDB	C,AC4
	XCT	AC10
	JUMPLE	C,MOVB0A	;IGNOR LEADING EOLS & NULLS
MOVB0B:	IDPB	C,AC6
	SOJE	AC3,MOVB0C	;[335] DONT RETURN TILL CHECK FILL
	ILDB	C,AC4
	XCT	AC10
	JUMPGE	C,MOVB0B	;MOVE THE RECORD
MOVB0C:	LDB	C,[POINT 2,FLG,14]; GET CORE DATA MODE
	MOVE	C,SPCTB1(C)	; GET A SPACE CHAR
	ADD	AC3,AC0		;[335] #LEFT+ MAX - THIS REC
	SKIPE	AC3		;[335] COULD BE NOTHING LEFT TO DO
	IDPB	C,AC6
	SOJG	AC3,.-1		;FILL WITH SPACES

MOVBXT:

IFN LSTATS,<
	MOVE	AC1,D.CLRR(I16)	;GET REC LENGTH
	PUSHJ	PP,BUCREC	;SET AC2 TO REC BUCKET OFFSET
	L.METR	(MB.RDD(AC2),I16) ;CNT READ BUCKET
	MRTME.	(AC1)		;END TIMING,UPDATE TIME BUCKET
>;END IFN LSTATS

	; IF SEQUENTAIL READ CALL @GETSET TO COPY KEY FOR CNTRY INTO 
	; DAKBP AND IAKBP POSITIONS, SO THAT REWRITE OR DELETE FOLLOWING
	; WILL HAVE THE CURRENT KEY TO SAVE

IFN ANS74,<			
	TXNN	AC16,V%STRT	; Is this a call from START?
	JRST	MOVBXX		; No
	PUSHJ	PP,@GETSET(I12)	; YES, COPY CNTRY KEY 
	POPJ	PP,		; And return now to START

MOVBXX:	TLNE	FLG1,SEQ	; IS THIS A SEQUENTIAL READ?
	PUSHJ	PP,@GETSET(I12)	; YES, COPY CNTRY KEY 
>				

;[D1064] SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
;[D1064] PUSHJ	PP,LRDEQX##	; YES
	LDB	AC0,F.BCRC	; GET CHP=PNT REC CNT
	JUMPE	AC0,MVBXAA	; SKIP IF NONE
	TXNE	AC16,V%DLT+V%RWRT+V%WRITE+V%WADV ; IS THIS DELET,RERIT,WRITE?
	PUSHJ	PP,CKPREC	; YES, DECR. COUNT AND CHKPNT IF TIME
MVBXAA:	PUSHJ	PP,CHKRRN	; CHECK FOR RERUN DUMP
	SKIPN	F.WSMU(I16)	;[1064] SIMULTANEOUS UPDATE?
	 JRST	MVBXAC		;[1064] NO
	SKIPN	SU.FRF		;[1064] DOING FAKE READ FOR SMU?
	 PUSHJ	PP,LRDEQX##	;[1064] NO
MVBXAC:				;[1064]
	HRRZ	AC1,D.RFLG(I16)	; GET SOME FLAGS
	TRO	AC1,RDLAST	; SET READ LAST IO OPERATION
	HRRM	AC1,D.RFLG(I16)	; PUT THEM BACK




	JRST	CLRSTS		;SET STATUS TO 00 AND POPJ
	;BLT BUFFER TO RECORD
BLTBR:	CAIN	AC0,(AC3)	;[335] IF RECS =
	JRST	BLTB1		;[335] NO NEED FOR FILL
	IDIV	AC0,D.BPW(I16)	; CONVERT TO WORDS
	SKIPE	AC1		; ROUND UP?
	ADDI	AC0,1		; YES
	MOVEI	AC1,1(AC6)	;[335] BLT TO
	HRLI	AC1,(AC6)	;[335] BLT FROM
	LDB	AC2,[POINT 2,FLG,14]	; GET CORE DATA MODE
	MOVE	AC2,SPCTBL(AC2)	; AND A WORD OF SPACES
	MOVEM	AC2,(AC6)	; START BLANK
	ADDI	AC0,-1(AC6)	;[335]BLT LIMIT
	MOVE	AC2,AC0		;[335]
	BLT	AC1,(AC2)	;[335]ZAP
BLTB1:	HRRZ	AC1,-1(AC4)	;RECSIZ
	;ANDI	AC1,7777
	IDIV	AC1,D.BPW(I16)	; IN WORDS

	HRRI	AC0,	(AC6)		;[V10] TO LOCATION.
	ADDI	AC6,	(AC1)		;[V10] UPDATE THE BYTE POINTER.

	JUMPE	AC1,	BLTB4		;[V10] IF THERE IS NOTHING TO
					;[V10]  BLT, GO ON.
	HRLI	AC0,	(AC4)		;[V10] FROM LOCATION.
	BLT	AC0,	-1(AC6)		;[V10] DO IT TO IT.

BLTB4:	JUMPE	AC2,	MOVBXT		;[V10] IF THERE IS NOTHING LEFT
					;[V10]  OVER, GO ON.
	ADDI	AC4,	(AC1)		;[V10] CONSTRUCT THE SENDING
	HLL	AC4,	AC6		;[V10]  BYTE POINTER.

BLTB6:	ILDB	C,	AC4		;[V10] TRANSFER THE REST OF THE
	IDPB	C,	AC6		;[V10]  CHARACTERS.
	SOJG	AC2,	BLTB6		;[V10]
	JRST	MOVBXT
	;MOVE RECORD TO AUXBUF  (WRITE)
	;BUT FIRST CLEAR BIT-35 IF DEVICE DATA MODE IS ASCII
	;SO THE KEY COMPARISION ROUTINES WILL WORK
MOVRBA:	TLNN	FLG,DDMASC	;IS DATA FILE IS ASCII?
	JRST	MOVRB0		;NO
	LDB	AC0,WOPRS.	;GET RECORD SIZE
	ADDI	AC0,2+4		;PLUS 2 FOR CRLF AND 4 TO ROUND UP
	IDIVI	AC0,5		;CONVERT TO WORDS
	MOVN	AC1,AC0		;MAKE A
	HRLS	AC1		;  AOBJN
	HRR	AC1,TEMP.2	;  POINTER
	SETZM	(AC1)		;CLEAR BIT 35
	AOBJN	AC1,.-1		;LOOP
MOVRB0:	SKIPA	AC5,TEMP.2	;POINTER TO AUXBUF

	;MOVE RECORD TO BUFFER
MOVRB:	MOVE	AC5,CNTRY(I12)	;POINTER TO BUFFER
	LDB	AC0,F.BMRS	;MAX-REC-SIZ
	MOVE	AC6,RECBP(I12)	;REC BYTE-POINTER
	LDB	AC3,WOPRS.	;
	CAML	AC0,AC3		;[613] IS RECORD LEGAL SIZE?
	JRST	MVRB0		;[613] YES CONT
	PUSHJ	PP,ERRMR0	;NO -- TOO BIG

	;[613] PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;[613] IS LARGER THAN FD MAXIMUM

	OUTSTR	[ASCIZ/%Record length field larger than FD maximum, assuming max.
/]
	; AC3 LOADED WITH MAX SIZE IN ERRMR0

MVRB0:	TLNN	FLG,CONNEC!DDMASC!DDMBIN ;[613]
	JRST	BLTRB		; EBCDIC OR SIXBIT - BLTIT
	LDB	AC10,[POINT 2,FLG,2]	; GET DEVICE DATA MODE
	HLL	AC5,RBPTB1(AC10)	; GET BYTE PTR
	MOVE	AC10,D.WCNV(I16);SET AC10

MOVR0A:	ILDB	C,AC6		;
	XCT	AC10		;
	IDPB	C,AC5		;
	SOJG	AC3,MOVR0A	;
	JUMPGE	FLG,RET.1	;IF NOT ASCII EXIT
	PUSHJ	PP,RANCR	;
	JRST	RANLF		;<CRLF> AND EXIT

BLTRB:	MOVE	AC1,AC3		;DONT DESTRY 4
	IDIV	AC1,D.BPW(I16)	; GET BYTES PER WORD
	JUMPE	AC2,.+2		;
	ADDI	AC1,1		;
	HRLI	AC0,(AC6)	;FROM
	HRRI	AC0,(AC5)	;TO
	ADDI	AC1,-1(AC5)	;UNTIL
	BLT	AC0,(AC1)	;
	POPJ	PP,
	;IWRITE - SO MAKE HOLE FOR REC TO FIT IN
SHFHOL:	SETZ	AC3,		;FAKE AN OLD SIZE OF ZERO
	LDB	AC1,WOPRS.	;NEW-SIZ
	JUMPGE	FLG,.+2		;ASCII REC?
	ADDI	AC1,2		;YES, ACCOUNT FOR <CRLF>
	MOVE	AC4,CNTRY(I12)	;POINT AT CURRENT REC
	JRST	SHFR10		;

	;SHUFFLE RECORDS SO NEXT RECORD WILL JUST FIT
SHFREC:	MOVE	AC4,CNTRY(I12)	;CURRENT REC
	LDB	AC1,RSBP(I12)	;OLD RECSIZ IN CHARS
	LDB	AC3,WOPRS.	;NEW RECSIZ IN CHARS
	JUMPGE	FLG,SHFR03	;
	ADDI	AC3,2		;ASCII AND WRITE OR RERIT, ADD 2 FOR <CRLF>
SHFR03:	TXNE	AC16,V%DLT	;DELET?
	JRST	SHFR04		;YES
	CAMN	AC3,AC1		;SAME SIZE ?
	POPJ	PP,		;YES

SHFR04:	IDIV	AC1,D.BPW(I16)	;
	JUMPE	AC2,.+2		;
	ADDI	AC1,1		;
	ADDI	AC1,1		;
	EXCH	AC1,AC3		;AC3 = OLD SIZ IN WRDS

SHFR10:	TXNE	AC16,V%DLT	;DELETING?
	JRST	SHFR20		;YES
	TXNN	AC16,V%WADV!V%WRITE	;IWRITE GETS A COMPLETE NEW HEADER WRD
	DPB	AC1,RSBP(I12)	;UPDATE RECSIZ
	IDIV	AC1,D.BPW(I16)	;
	JUMPE	AC2,.+2		;
	ADDI	AC1,1		;
	ADDI	AC1,1		;AC1 = NEW SIZ IN WRDS

	SUB	AC1,AC3		;AC1 = DIFF
SHFR11:	ADDM	AC1,LRW(I12)	;UPDATE LRW
	HRRO	AC2,LRW(I12)	;
	JUMPL	AC1,SHFR01	;BLTIT - MAKE A SMALLER HOLE

	SUB	AC2,AC1		;FROM
	HRRZ	AC0,AC2		;
	SUBI	AC0,-1(AC4)	;LEN + OLD-REC-SIZ
	SUB	AC0,AC3		;LEN
	JUMPLE	AC0,RET.1	;ZERO = OLD-REC IS LAST-REC (ALSO FOR NEG LEN)
	ADDI	AC0,1		;MOVE THE HEADER WRD ALSO
	;AC0=LEN,  AC1=DISPLACEMENT,  AC2=-1,,FROM
SHFR00:	MOVE	AC4,AC1		;POPIT - MAKE LARGER
	ADD	AC4,[POP AC2,(AC2)]
	MOVE	AC5,[SOJG AC0,AC4]
	MOVE	AC6,[JRST SHFR30]	;[600]
	JRST	AC4

	;SHRINK THE OLD RECORD SIZE
SHFR01:	ADDI	AC3,-1(AC4)	;FROM
	HRL	AC3,AC3		;FROM,AC3		;FROM,,FROM
	ADD	AC3,AC1		;FROM,,TO
	MOVE	AC1,LRW(I12)	;UNTIL
	BLT	AC3,(AC1)	;
SHFR30:	HRRZ	AC2,LRW(I12)	;[600] GET LAST RECORD WORD
	SKIPLE	D.RCL(I16)	;[600] NOT IF LAST RECORD
	SETZM	1(AC2)		;[600] OTHERWISE, ZERO NEXT WORD
	POPJ	PP,

	;SETUP TO DELETE A REC
SHFR20:	MOVNI	AC1,(AC3)	;RECSIZ + HEADER
	MOVE	AC5,LRW(I12)	;[1034] SAVE OLD LRW
	ADDM	AC1,LRW(I12)	;UPDATE LRW
	SETOM	NNTRY(I12)	;NOTE: CNTRY POINTS AT NEXT ENTRY
	PUSHJ	PP,SHFR01	;MOVIT
	HRRZ	AC2,LRW(I12)
	SETZM	1(AC2)		;ZERO RECSIZ MEANS END OF DATA
	MOVEI	AC3,1(AC2)	;[1034] SET UP SOURCE
	HRL	AC3,AC3		;[1034] 
	ADDI	AC3,1		;[1034] ADJUST DESTINATION
	BLT	AC3,(AC5)	;[1034] ZERO UNUSED BLOCK AREA
	POPJ	PP,
	;SET POINTER TO LAST FREE RECORD WORD
SETLRW:	LDB	AC6,F.BBKF	;NUMBER OF RECS PER BLOCK
	HRRZ	AC4,IOWRD(I12)	;
	ADDI	AC4,1		;POINT AT REC-CNT
	HRRZ	AC5,D.BPW(I16)	;BYTES PER WORD
	MOVE	AC11,DRTAB	;WHERE TO STORE REC-ORIGN
	SUBI	AC11,1		;SET UP FOR PUSH
	HLRZ	AC0,(AC4)	;VERSION NUMBER
	ADDI	AC0,1		;  BUMP IT
SETLR1:	LDB	AC1,RSBP1(I12)	;RECSIZ IN CHARS
	JUMPE	AC1,SETLR2	;ZERO RECSIZ IMPLIES LAST REC
	ADDI	AC1,-1(AC5)	;CONVERT TO WORDS AND
	IDIV	AC1,AC5		;  ROUND UP
	HRL	AC3,AC1		;RECNT IN WORDS
	HRR	AC3,AC4		;LOC OF REC-ORIGN
	PUSH	AC11,AC3		;PUSH IT IN THE DR-TABLE
	TLNE	FLG1,BVN	;SPLITTING?
	DPB	AC0,[POINT 6,(AC4),17]	;VERSION NUMBER IS SIX BITS WIDE
	ADDI	AC4,1(AC1)	;PLUS ONE FOR RECSIZ
	SOJG	AC6,SETLR1	;MORE RECORDS?
SETLR2:	MOVEM	AC6,D.RCL(I16)	;NO, ROOM FOR <N> RECS
	HRROM	AC4,AC3		;TERMINATOR (-1,,LRW+1)
	PUSH	AC11,AC3	;
	SUBI	AC4,1		;
	MOVEM	AC4,LRW(I12)	;SAVIT
	POPJ	PP,

	;SET THE INDEX CHANNEL NUMBER
SETIC:	HLRZ	I12,D.BL(I16)	;INDEX TABLE
	MOVE	LVL,MXLVL(I12)	;SET LVL TO TOP-LEVEL
	MOVE	AC5,ICHAN(I12)	;
	MOVEI	AC10,LASTIC	;
	MOVE	AC1,[POINT 4,FRSTIC,12]
	DPB	AC5,AC1		;
	CAIE	AC10,(AC1)	;
	AOJA	AC1,.-2	;
	POPJ	PP,		;
	;ALLOCATE DATA BLOCKS HERE
	;BLOCK NUMBER IS RETURNED IN NEWBK1 & NEWBK2
ALC2BK:	TLZ	FLG1,TRYAGN	;[307] INIT THIS FLAG
	TLO	FLG1,BLK2	;REMEMBER TO GRAB 2 BLOCKS
	MOVE	AC2,IOWRD+13(I12)  ;
	ADD	AC2,[XWD 2,2]	;
	HRRZM	AC2,TEMP.	;FIRST WORD OF SAT BITS
	SKIPE	USOBJ+13(I12)	;IS THERE A SAT BLK INCORE?
	JRST	ALC05		;YES
ALC01:	TLZE	FLG1,WSB	;SHLD SAT BLK BE WRITTEN?
	PUSHJ	PP,WSBK		;YES
	MOVE	AC1,SBLOC(I12)	;LOC OF FIRST SAT BLK
ALC02:	PUSHJ	PP,RSBK		;GET A SAT BLK

	;NOW FIND A WORD WITH SOME EMPTY BLOCKS IN IT
	ADD	AC2,[XWD 2,2]	;FIRST WORD OF SAT BITS
	HRRZM	AC2,TEMP.	;FIRST-WRD SAVE FOR LATER
ALC05:	HRROI	AC0,-1		;WHAT WERE NOT LOOKING FOR
	CAMN	AC0,(AC2)	;ANY FREE BLOCKS?
	AOBJN	AC2,.-1		;NO, LOOP IF MORE WORDS
	JUMPL	AC2,ALC07	;[271] JUMP IF FOUND

	;THAT BLOCK WAS FULL, TRY NEXT ONE
	TLNN	FLG1,TRYAGN	;HAVE WE LOOKED FROM THE BEGINNING?
	JRST	ALC20		;NO, SO DOIT
	MOVE	AC0,SBTOT(I12)	;[271] # OF SAT BLOCKS
	SUBI	AC0,1		;[271] ADJUST COUNT
	IMUL	AC0,ISPB(I12)	;[271] TIMES # SECTORS / SAT
	ADD	AC0,SBLOC(I12)	;[271] PLUS FIRST BLOCK #
	CAMG	AC0,USOBJ+13(I12)  ;IS THERE A NEXT ONE?
	JRST	ALC20		;NO, TRY AGAIN, SEE IF ANY WERE DELETED
	TLZE	FLG1,WSB	;[310] WRITE OUT THE SAT-BLK?
	PUSHJ	PP,WSBK		;YES
	MOVE	AC1,ISPB(I12)	;[271] SECTORS / SAT
	ADDB	AC1,USOBJ+13(I12)  ;[271] NEW USETI/O POINTER
	JRST	ALC02		;YES, TRY NEXT SAT BLOCK

	;FOUND A BLK - FLAG IT IN USE
ALC07:	SETCM	AC0,(AC2)	;SO JFFO WILL WORK
	JFFO	AC0,ALC08	;FIND THE BIT
	JRST	ALC05		;TRY NEXT WORD
ALC08:	MOVSI	AC0,400000	;
	MOVNS	AC1		;
	LSH	AC0,(AC1)	;
	ORM	AC0,(AC2)	;FLAG IT IN USE
	;OK - WHATS THE BLOCK NUMBER?
	HRRZ	AC0,AC2		;
	SUB	AC0,TEMP.	;
	IMULI	AC0,^D36	;
	SUB	AC0,AC1		;
	ADDI	AC0,1		;
	MOVE	AC1,USOBJ+13(I12)
	SUB	AC1,SBLOC(I12)	;
	PUSH	PP,AC2		;[271] NEED TO SAVE AC2
	IDIV	AC1,ISPB(I12)	;[271] / NUMBER OF SECTORS PER SAT
	POP	PP,AC2		;[271] ...
	IMUL	AC1,BPSB(I12)	;
	ADD	AC0,AC1		;AC0 HAS THE LOGICAL BLKNO
	MOVE	AC1,D.BPL(I16)	;BUFFERS PER LOGICAL BLOCK
	SUBI	AC0,1		;MINUS ONE
	IMUL	AC0,AC1		;TIMES LOGICAL-BLOCK NUMBER
	ADDI	AC0,1		;  IS USETO OBJECT

	TLO	FLG1,WSB	;REMEMBER TO WRITE THE SAT BLOCK
	MOVEM	AC0,NEWBK1	;SAV THE FIRST BLKNO
	TLZN	FLG1,BLK2	;A TWO BLOCK REQ?
	JRST	WSBK		;ALLOCATE! WRITE OUT THE SAT BLOCK
	MOVEM	AC0,NEWBK2	;
	JRST	ALC07		;GO FOR NEXT ONE

	;START AT BEGINNING AND SEE IF ANY WERE DELETED
ALC20:	TLON	FLG1,TRYAGN	;FIRST RETRY?
	JRST	ALC01		;YES, TRY AGAIN
	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+E.BSAT+^D5]	;ERROR NUMBER
	PUSHJ	PP,IGCVR1	;IGNORE ERROR?
	  JRST	RET.2		;YES, RETURN TO CBL-PRGM.
	OUTSTR	[ASCIZ /Allocation failure, all blocks are in-use./]
	JRST	IOUTE1		;& KILL
	;DE-ALLOCATE BLOCK NUMBER FOUND IN OLDBK
DALC:	MOVE	AC1,OLDBK	;
	IDIV	AC1,D.BPL(I16)	;CONVERT PHYSICAL TO LOGICAL BLKNO
	SKIPE	AC2		;REMAINDER?
	ADDI	AC1,1		;YEP
	IDIV	AC1,BPSB(I12)	;FIND WHICH RELATIVE SATBLK IT'S IN
	IMUL	AC1,ISPB(I12)	;[271] TIMES SECTORS / SAT
	ADD	AC1,SBLOC(I12)	;ABSOLUTE
	MOVEM	AC2,AC3		;SAVE RELATIVE BIT POSITION IN SATBLK
	CAME	AC1,USOBJ+13(I12)  ;IS IT IN CORE?
	PUSHJ	PP,RSBK		;NO,GO GET IT
	MOVEM	AC1,USOBJ+13(I12)  ;MAKE THIS BLK CURRENT
	IDIVI	AC3,^D36	;RELATIVE WORD POSITION
	ADD	AC3,IOWRD+13(I12)  ;ABSOLUTE WORD POSITION -2
	MOVN	AC4,AC4		;ROTATE TO THE RIGHT
	MOVEI	AC0,1		;THE MASK
	ROT	AC0,(AC4)	;
	SKIPN	AC4		;IF REMAINDER = 0
	SUBI	AC3,1		;  BACKUP A WORD
	ANDCAM	AC0,2(AC3)	;MARK IT FREE
	TLZ	FLG1,WSB
	SETZM	OLDBK		;
	JRST	WSBK
	;SETUP RECORD HEADER WORD
SRHW:	MOVE	AC4,CNTRY(I12)
	MOVE	AC1,IOWRD(I12)
	MOVE	AC1,1(AC1)
	MOVEM	AC1,-1(AC4)	;SET VERSION NUMBER & BIT35
	LDB	AC1,WOPRS.
	JUMPGE	FLG,SRHW1	;ASCII?
	ADDI	AC1,2		;ADD 2 FOR CR + LF
	MOVEI	AC0,1		;ASCII FLAG, BIT 35
	ORM	AC0,-1(AC4)	;
SRHW1:	DPB	AC1,RSBP(I12)	;THE RECORD SIZE IN CHARS
	POPJ	PP,

	;LOW-VALUE TEST
	;POPJ IF SYMKEY = LOW-VALUES, SKIP EXIT IF NOT
LVTST:	HLRZ	I12,D.BL(I16)	;SETUP I12
IFN ANS74,<
	TXC	AC16,V%READ!V%RNXT	;READ NEXT RECORD?
	TXCN	AC16,V%READ!V%RNXT
	POPJ	PP,		;YES, THEN ITS SEQUENTIAL
	LDB	AC1,F.BFAM	;GET ACCESS MODE
	TXNE	AC16,V%READ	;READ?
	JUMPE	AC1,RET.1	;SEQUENTIAL BY DEFINITION
>
	MOVE	AC1,F.WBSK(I16)	;SK BYTE-POINTER
	LDB	AC3,KY.TYP	; GET KEY TYPE
	CAIGE	AC3,3		;DISPLAY ?
	JRST	LVTS02		;YES
	CAIL	AC3,7		; COMP-3?
	JRST	LVC3		; YES

LVTS01:	CAIG	AC3,6		; COMP-3 IS SAME AS FIXED-POINT
	CAIG	AC3,4		;FIXED POINT ?
	SKIPA	AC2,[1B0]	;YES, LOW-VALUE
	MOVE	AC2,[1B0+1]	;FLOATING PT. LOW-VALUE
	CAME	AC2,(AC1)	;LOW-VALUE ?
	AOSA	(PP)		;NO, SKIP RETURN
	TRNE	AC3,1		;TWO WORDS ?
	POPJ	PP,		;NO, EXIT
	CAME	AC2,1(AC1)	;LV ?
	AOS	(PP)		;NO, SKIP RETURN
	POPJ	PP,		;LV.

LVTS02:	LDB	AC2,KY.SIZ	; GET KEY SIZE
LVTS03:	ILDB	AC0,AC1
	JUMPN	AC0,RET.2	;NOT LV
	SOJG	AC2,LVTS03
	POPJ	PP,		;LOW-VALUE

	;ENTRY FOR INDEX-KEY LOW-VALUE TEST
LVTSTI:	ADDI	AC1,2		;SKIP OVER THE TWO WORD HEADER
	LDB	AC3,KY.TYP	; GET KEY TYPE
	JUMPE	AC3,LVTS02	;DISPLAY EXITS HERE
	JRST	LVTS01		;NUMERIC DISPLAY IS NUMERIC IN THE INDEX
	; LV TEST FOR COMP-3
LVC3:	LDB	AC3,KY.SIZ	; GET KEY SIZE
	MOVEI	AC2,2(AC3)	; ROUND UP AND GET NUMBER
	LSH	AC2,-1		; OF NINE BIT BYTES
	LDB	AC0,KY.SGN	; SKIP IF A SIGNED KEY
	JUMPN	AC0,LVC310	; JUMP IF NOT SIGNED

	; HERE IF A SIGNED COMP3
	; LOW-VALUES = A SRTING OF 9'S FOLLOWED BY A SIGN
	SOJE	AC2,LVC302	; JUMP IF ONLY ONE BYTE
	ILDB	AC0,AC1		; GET FIRST TWO DIGITS
	TLNN	AC3,1		; IF ONLY ONE DIGIT IN THIS BYTE
	DPB AC0,[POINT 4,AC0,31]; DUPLICATE IT
	JRST	.+2		; SKIP INTO MAIN LOOP

LVC301:	ILDB	AC0,AC1		; GET NEXT TWO DIGITS
	CAIE	AC0,9B31+9B35	; LOW-VALUES?
	JRST	RET.2		; NO EXIT
	SOJG	AC2,LVC301	; LOOP

LVC302:	ILDB	AC0,AC1		; GET THE LAST BYTE
	CAIE	AC0,9B31+15B35	; 9 AND MINUS SIGN?
	CAIN	AC0,9B31+13B35	; THERE ARE TWO MINUS SIGNS
	POPJ	PP,		; LOW-VALUE RETURN
	JRST	RET.2		; NOT LV RET

	; HERE IF A UNSIGNED COMP3
	; LOW-VALUES = A SRTING OF 0'S FOLLOWED BY A SIGN
LVC310:	SOJE	AC2,LVC312	; JUMP IF ONLY ONE BYTE
	TLNN	AC3,1		; IF ONLY ONE DIGIT IN THIS BYTE
	JRST	LVC311		; SKIP INTO MAIN LOOP
	ILDB	AC0,AC1		; GET FIRST TWO DIGITS
	TRZA	AC0,360		; ZERO LEADING DIGIT

LVC311:	ILDB	AC0,AC1		; GET NEXT TWO DIGITS
	JUMPN	AC0,RET.2	; JUMP IF NOT LV
	SOJG	AC2,LVC311	; LOOP

LVC312:	ILDB	AC0,AC1		; GET THE LAST BYTE
	TRZ	AC0,17		; FORGET ABOUT THE SIGN
	JUMPN	AC0,RET.2	; JUMP IF NOT LV
	POPJ	PP,		; LOW-VALUE RETURN
	;INDEX FILE INPUT ERROR
IINER:	XCT	IGETS		;GET STATUS TO AC2
	TXNE	AC2,IO.EOF	;EOF?
	OUTSTR	[ASCIZ /Found an EOF instead of index block./]
IINER1:	MOVE	LVL,D.DC(I16)	;DEV CHARACTERISTICS
	PUSHJ	PP,IOERM1	;NO, CHECK THE OTHERS
IINER2:	MOVE	AC2,[BYTE (5)10,31,20,21,4]
	PUSHJ	PP,MSOUT.	;FILE CANNOT DO INPUT & KILL

	;DATA FILE INPUT ERROR
UINER:	XCT	UGETS.		;ERROR BITS
	TXNE	AC2,IO.EOF	;EOF?
	OUTSTR	[ASCIZ /Found an EOF instead of data block./]
	JRST	IINER1		;MESSAGE AND KILL

LVSKER:	TXNE	AC16,V%RWRT
	OUTSTR	[ASCIZ /REWRITE, /]
	TXNE	AC16,V%DLT
	OUTSTR	[ASCIZ /DELETE, /]
	TXNE	AC16,V%WRITE
	OUTSTR	[ASCIZ /WRITE, /]
	OUTSTR	[ASCIZ /SYMBOL-KEY must not equal LOW-VALUES./]
	HRLZI	AC2,(BYTE (5) 10,31,20)
	PUSHJ	PP,MSOUT.	;KILL & DON'T RETURN

	;SEE IF THIS MESSAGE SHOULD BE IGNORED
LVERR:	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+^D1]	;LOW-VALUES ILLEGAL
	PUSHJ	PP,IGCV		;FATAL ERROR OR IGNORE ERROR?
	 JRST	LVSKER		;FATAL!
	JRST	RET.2		;DONT PROCESS THIS VERB
				;JUST RETURN TO CBL-PRGM
	;INDEX FILE OUTPUT ERROR
IOUTER:	XCT	IWAIT
	XCT	IGETS
	TXNN	AC2,IO.ERR
	POPJ	PP,		;NO ERRORS SO EXIT
	MOVE	LVL,D.DC(I16)	;DEV-CHAR
	PUSHJ	PP,IOERM1
IOUTE1:	MOVE	AC2,[BYTE (5) 10,31,20,22,4]
	PUSHJ	PP,MSOUT.	;& KILL

	;DATA FILE OUTPUT ERROR
UOUTER:	XCT	UWAIT.
	MOVE	LVL,D.DC(I16)	;DEVICE CHARACTERISTICS

	PUSHJ	PP,IOERMS
	MOVE	AC2,[BYTE (5) 10,36,31,20,4]
	JRST	MSOUT.		;MESSAGE AND KILL


; CKPREC	ROUTINE TO CHECK FOR CHECKPOINT ON RECORD COUNT
;
; RETURNS	+1 ALWAYS
;
; USES		AC0,AC1

CKPREC:	SOSE	D.CRC(I16)	; DECREMENT COUNT AND SKIP IF TIME TO DO IT
	POPJ	PP,		; NOT NOW, RETURN
	LDB	AC0,F.BCRC	; GET COUNT
	MOVEM	AC0,D.CRC(I16)	; RESET IT
	TLNN	FLG,IDXFIL	; [1016] SKIP IF ISAM FILE
	TLNN	FLG,RANFIL+IOFIL ; DUMP MODE FILE?
	JRST	CPREC1		; NO, CONT

	; DUMP MODE FILES MUST OUTPUT PARTIAL BUFFER BEFORE CHK-PNT

	MOVE	AC1,D.CBN(I16)	; GET CURRENT BLOCK NUMBER
	PUSHJ	PP,RANOUT	; DUMP CURRENT BUFFER (MAYBE PARTIAL)
	HLLZS	UOUT.		; [1036] ZEROES RIGHT HALF

	; NOW RESET BACK TO LAST POSITION BEFORE DOING CHK-PNT

	MOVE	AC1,D.CBN(I16)	; CURRENT BLOCK
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSO		; DO A FILOP. TYPE USETO
	  XCT	USETO.		;******************

CPREC1:	LDB	AC0,DTCN.	; GET CHANNEL FOR DATA FILE
	PUSHJ	PP,CHKPNT	; DO CHECKPOINT
	TLNN	FLG,IDXFIL	; ISAM FILE?
	POPJ	PP,		; NO, RETURN NOW
	MOVE	AC0,ICHAN(I12)	; YES,GET CHANNEL FOR INDEX FILE
;	JRST	CHKPNT		; DO IT AND RETURN
; CHKPNT	ROUTINE TO DO CHECKPOINT FILOP.
;
; ARG		AC0 CONTAINS CHANNEL NUMBER
;
; RETURNS	+1 ALWAYS,ERROR IS KILL
; USES		AC0

CHKPNT:	HRLM	AC0,FUSCP.	; PUT CHANNEL IN ARG.BLOCK
	MOVE	AC0,[1,,FUSCP.]	; POINT AT ARG BLOCK
	FILOP.	AC0,		; DO FILOP (UPDATE EOF POINTERS)
	 JRST 	[OUTSTR [ASCIZ/
?CHECKPOINT FILOP. failed (shouldn't happen)./]
		 JRST	KILL ]	; 
	POPJ	PP,		; OK RETURN


;[523] USER WANTS FILOP. (.FOURB)
;RETURNS
;OK TO CALLER'S CALLER +1

CKFOI:
;IFE TOPS20,<			;[1100, don't let monitor control update]
;	SKIPE	M7.00		;[1100] IF 7.00
;	JRST	PPOPJ		;[1100] RIB UPDATE WILL BE DONE BY MONITOR
;>				;[1100]
	LDB	AC0,F.BCKP	;SEE IF USER WANTS TO CHECKPOINT FILE
	JUMPE	AC0,PPOPJ	;NO, RETURN TO CALLER'S CALLER+1
	MOVE	AC0,ICHAN(I12)	;[523] GET CHANNEL FOR INDEX FILE
	JRST	CKFOC		;[523] DON'T GET CH FOR DATA FILE

CKFOD:
;IFE TOPS20,<			;[1100, don't let control update]
;	SKIPE	M7.00		;[1100] IF 7.00
;	JRST	PPOPJ		;[1100] RIB UPDATE WILL BE DONE BY MONITOR
;>				;[1100]
	LDB	AC0,F.BCKP	;SEE IF USER WANTS TO CHECKPOINT FILE
	JUMPE	AC0,PPOPJ	;NO, RETURN TO CALLER'S CALLER+1

	LDB	AC0,DTCN.	;[523] GET CHANNEL FOR DATA FILE
CKFOC:	PUSHJ	PP,CHKPNT	; DO FILOP.
PPOPJ:	POP	PP,(PP)		;[523] POP OFF CALLER
	POPJ	PP,		;[523] GOOD RETURN

>	;END IFN ISAM

	;BLOCK NUMBER IS LARGER THAN 18 BITS SO DO A FILOP TYPE USETI
FIUSI:	MOVE	AC0,ICHAN(I12)	; GET INDEX FILE'S CHANNEL
	JRST	.+2
FUSI:	LDB	AC0,DTCN.	; GET DATA FILE'S CHANNEL
	HRLM	AC0,FUSIA.	; SET IT IN THE ARG-BLOCK
	MOVEM	AC1,FUSIA.+1	; SETUP THE BLOCK-NUMBER
	MOVE	AC0,[2,,FUSIA.]	; POINT AT ARG-BLOCK
	FILOP.	AC0,		; DO THE USETI
	  JRST	RET.2		; ERROR RETURN
	JRST	RET.2		; DONE

	;BLOCK NUMBER IS LARGER THAN 18 BITS SO DO A FILOP TYPE USETO
FIUSO:	MOVE	AC0,ICHAN(I12)	; GET INDEX FILE'S CHANNEL
	JRST	.+2
FUSO:	LDB	AC0,DTCN.	; GET DATA FILE'S CHANNEL
	HRLM	AC0,FUSOA.	; SET IT IN THE ARG-BLOCK
	MOVEM	AC1,FUSOA.+1	; SETUP THE BLOCK-NUMBER
	MOVE	AC0,[2,,FUSOA.]	; POINT AT ARG-BLOCK
	FILOP.	AC0,		; DO THE USETO
	  JRST	RET.2		; ERROR RETURN
	JRST	RET.2		; DONE
SUBTTL ERROR RECOVERY

	;REVERSE EXIT PROCEDURE FOR IGMD
IGMDR:	PUSHJ	PP,IGMD 	;MAKE ERROR NUMBER AND TEST
	 AOS	(PP)		;SKIP EXIT TO FATAL MESSAGE
	POPJ	PP,		;RETURN

	;REVERSE EXIT PROCEDURE FOR IGMI
IGMIR:	PUSHJ	PP,IGMI 	;MAKE ERROR NUMBER AND TEST
	 AOS	(PP)		;SKIP EXIT TO FATAL MESSAGE
	POPJ	PP,		;RETURN

	;INCLUDE MONITOR ERROR STATUS IN AC0
IGMI4:	POP	PP,-1(PP)	;POP OFF A RETURN
IGMI3:	POP	PP,-1(PP)	;POP OFF A RETURN
IGMI2:	POP	PP,-1(PP)	;POP OFF A RETURN
IGMI1:	POP	PP,-1(PP)	;POP OFF A RETURN
IGMI:	PUSHJ	PP,SAVAC.	;SAVE ACS
	XCT	IGETS		;GET THE INDEX FILE ERROR STATUS BITS
	SETOM	FS.IF		;SET IDX-FILE FLAG
	JRST	IGMD1		;
IGMD:	PUSHJ	PP,SAVAC.	;SAVE ACS
	XCT	UGETS.		;GET DATA FILE STATUS BITS
	SETZM	FS.IF		;IDA FILE
IGMD1:	TLNE	FLG,IDXFIL	;SKIP IF NOT ISAM FILE
	MOVEM	AC1,FS.BN	;SAVE THE CURRENT BLOCK NUMBER
	SETZ	AC1,		;INIT AC1 TO ZERO
	TXC	AC2,IO.ERR	;
	TXCN	AC2,IO.ERR	;MTA LABEL PROCESSING ERROR?
	JRST	IGMD2		;YES
	TXNE	AC2,IO.IMP	;IMPROPER MODE?
	MOVEI	AC1,^D18
	TXNE	AC2,IO.DER	;DEVICE ERROR
	MOVEI	AC1,^D19
	TXNE	AC2,IO.DTE	;DATA ERROR
	MOVEI	AC1,^D20
	TXNE	AC2,IO.BKT	;QUOTA EXCEEDED, FILE STR, OR RIB FULL
	MOVEI	AC1,^D21
	TXNE	AC2,IO.EOF	;EOF
	MOVEI	AC1,^D22
	MOVEI	AC3,^D34	;ASSUME DSK FULL
	TXNE	AC2,IO.BKT	;IS IT?
	JRST	IGMD2		;YES
	SKIPN	AC3,FS.FS	;NO CHANGE IF NON ZERO
	MOVEI	AC3,^D30	;PERMANENT ERROR
IGMD2:	ADD	AC0,AC1		;UPDATE THE ERROR NUMBER
	MOVEM	AC3,FS.FS	;LOAD FILE-STATUS
	JRST	IGCV2		;AVOID CLEARING FS.BN
	;REVERSE THE EXIT PROCEDURE FOR IGCV
	;POPJ		TO IGNORE THE ERROR
	;SKIP EXIT	TO GET A FATAL MESSAGE
IGCVR2:	POP	PP,-1(PP)	;POP OFF A RETURN
IGCVR1:	POP	PP,-1(PP)	;POP OFF ANOTHER
IGCVR:	PUSHJ	PP,IGCV		;FLAG THE VERB AND TEST FOR IGNORE...
	 AOS	(PP)		;NO -- SKIP EXIT TO FATAL MESS
	POPJ	PP,		;YES - EXIT

	;FLAG THE COBOL VERB
IGCV:	PUSHJ	PP,SAVAC.	;SAVE ACS
IGCV2:	PUSHJ	PP,SETSTS	; SET STATUS FIELDS
	JRST	IGTST		; CHECK FOR IGNORE ERROR


	; HERE TO SET UP ERROR NUMBER AND FILE STATUS WORDS

SETSTS:	TXNN	AC16,V%OPEN
	JRST	STSTS3		; NOT OPEN
	TXNE	AC16,OPN%EX	; OPEN EXTEND?
	ADD	AC0,[EXP E.VEXT-E.VOPE]	; YES
	ADD	AC0,[EXP E.VOPE] ; NO, JUST OPEN
	JRST	STSTS2		; CONT

STSTS3:	TXNE	AC16,CLS%EF!CLS%EV!CLS%BV
	ADD	AC0,[EXP E.VCLO]
	TXNE	AC16,V%WADV!V%WRIT
	ADD	AC0,[EXP E.VWRI]
	TXNE	AC16,V%RWRT
	ADD	AC0,[EXP E.VREW]
	TXNE	AC16,V%DLT
	ADD	AC0,[EXP E.VDEL]
	TXNN	AC16,V%STRT	; START?
	JRST	STSTS1		; NO,CONT
	ADD	AC0,[EXP E.VSTR] ; YES, SET IT 
	JRST	STSTS2		; AND SKIP READ CHECK (ALSO SET FOR STRT)
STSTS1:	TXNE	AC16,V%READ
	ADD	AC0,[EXP E.VREA]

	;FALL THROUGH TO SETSTX

	;BUT FIRST INCLUDE FILE TYPE IN ERROR STATUS
STSTS2:	MOVE	AC13,D.DC(I16)	;GET DEV CHARACTERISTICS
	TXNN	AC13,DV.MTA	;IS IT AN MTA?
	JRST	IGCVF1		;NO, SO NO LABEL ERRORS
	TXC	AC2,IO.ERR	;
	TXCE	AC2,IO.ERR	; IS THIS A MTA LABEL PROCESSING ERROR?
	JRST	IGCVF1		; NO

	MOVE	AC4,[2,,1]	; LENGTH ,, ADDRESS
	MOVEI	AC1,.DFRES	; FUNCT - EXTENDED IO ERRORS
	MOVE	AC2,D.ICD(I16)	; ADDRESS OF
	MOVE	AC2,(AC2)	; SIXBIT /DEVICE/
	DEVOP.	AC4,		; GET IO ERRORS
	 SETZ	AC4,		; "ERROR" GETTING ERROR CODE!
	ADD	AC0,[E.FMTA]	; FLAG IT AS LABEL PROCESSING ERROR
	ADDI	AC0,(AC4)	; ADD IN THE LTC
	JRST	IGCVF2		; SKIP OVER THE REST
IGCVF1:	TLNE	FLG,SEQFIL	;SEQUENTIAL?
	ADD	AC0,[E.FSEQ]	;YES
	TLNE	FLG,RANFIL	;RANDOM?
	ADD	AC0,[E.FRAN]	;YES
IGCVF2:	MOVEM	AC0,FS.EN	;SAVE THE ERROR-NUMBER

	;AND THEN SETUP SEQ/IO FILE FS.BN AND FS.RN
IGBNRN:	TXNE	AC16,V%OPEN	;OPEN?
	JRST	IGSS		;YES
	TLNE	FLG,IOFIL	;[622] IO-FILE?
	TLNN	FLG,SEQFIL	;SEQ-FILE?
	JRST	IGBNR1		;NOT SEQ-IO FILE.
	MOVE	AC3,D.IE(I16)	;NUMBER OF INPUTS EXECUTED
	IMUL	AC3,D.BPL(I16)	;TIMES BUFFERS/BLOCK
	SUB	AC3,D.BPL(I16)	;MINUS BUFFERS/BLOCK
	ADDI	AC3,1		;PLUS ONE
	SKIPG	AC3		;UNLESS ITS NEGATIVE
	SETZM	AC3		;WHICH MEANS NONE WERE DONE
	MOVEM	AC3,FS.BN	;SAVE THE BLOCK-NUMBER
	MOVE	AC3,D.RP(I16)	;RECORDS PROCESSED SO FAR
	ADDI	AC3,1		;BRING IT UP TO DATE
	MOVEM	AC3,FS.RN	;AND SAVE IT AWAY
	JRST	IGSS		;
	;SETUP SEQUENTIAL FILE BLOCK AND RECORD NUMBERS
IGBNR1:	TLNN	FLG,SEQFIL	;SEQ FILE?
	JRST	IGSS		;NO
	SKIPN	AC3,D.IE(I16)	;GET NUMBER OF INPUTS
	MOVE	AC3,D.OE(I16)	; OR OUTPUTS EXECUTED.
	MOVEM	AC3,FS.BN	;AND SAVE IT.
	MOVE	AC3,D.RP(I16)	;GET THE RECORD NUMBER
	ADDI	AC3,1		;UPDATE THE COUNT
	MOVEM	AC3,FS.RN	;AND SAVE IT.

	;HERE TO SETUP THE STATUS WORDS
IGSS:	SKIPN	AC1,F.WPFS(I16)		;GET FILE-STATUS POINTER
	JRST	SETSTX			;DONE IF NO POINTER
	MOVE	AC0,FS.FS		;GET FILE-STATUS
	PUSHJ	PP,IGCNVT		;MOVE IT TO DATA-ITEM

	SKIPN	AC1,F.WPEN(I16)		;GET ERROR-NUMBER POINTER
	JRST	SETSTX			;DONE IF NO POINTER
	MOVE	AC0,FS.EN		;GET ERROR-NUMBER
	PUSHJ	PP,IGCNVT		;MOVE IT TO DATA-ITEM

	SKIPN	AC1,F.WPAC(I16)		;GET ACTION-CODE POINTER
	JRST	SETSTX			;DONE IF NO POINTER
	SETZM	(AC1)			;ZERO THE ACTION CODE

	MOVE	AC2,F.WPID(I16)		;GET VALUE-OF-ID POINTER
	JUMPE	AC2,SETSTX		;DONE IF NO POINTER
IFN ISAM,<
	HLRZ	I12,D.BL(I16)		;RESTORE I12
	HRRI	AC1,DFILNM(I12)		;ADR OF IDA-FILE NAME
	HRLI	AC1,(POINT 6,)		;NOW ITS AN INPUT BYTE-PTR
	MOVE	FLG,-10(PP)		;RESTORE FLG (EXTRA -1 FOR CALL)
	TLNE	FLG,IDXFIL		;AN ISAM FILE?
	SKIPE	FS.IF			;YES - IDX OR IDA?
>
	MOVE	AC1,F.WVID(I16)		;GET THE REAL VID POINTER
	LDB	AC3,[POINT 2,AC1,11]	;GET INPUT BYTE SIZE
	LDB	AC4,[POINT 2,AC2,11]	;GET DESTINATION BYTE SIZE
	TLZ	AC2,007700		;ZERO BYTE FIELD
	PUSH	PP,I16			;SAVE I16
	MOVEI	AC16,1			;SETUP PARAMETER WORD
	PUSHJ	PP,@IGTAB2-1(AC3)	;MOVE IT TO DATA-ITEM
	POP	PP,I16			;RESTORE AC16

	SKIPN	AC1,F.WPBN(I16)		;GET BLOCK-NUMBER POINTER
	JRST	SETSTX			;DONE IF NO POINTER
	MOVE	AC0,FS.BN		;GET BLOCK-NUMBER
	MOVEM	AC0,(AC1)		;MOVE IT TO DATA-ITEM
	SKIPN	AC1,F.WPRN(I16)		;GET RECORD-NUMBER POINTER
	JRST	SETSTX			;DONE IF NO POINTER
	MOVE	AC0,FS.RN		;GET RECORD-NUMBER
	MOVEM	AC0,(AC1)		;MOVE IT TO DATA-ITEM

	SKIPN	AC2,F.WPFN(I16)		;GET POINTER TO FILE-NAME
	JRST	SETSTX			;DONE IF NONE
	MOVE	AC1,I16			;GET FILE-TBL FILE-NAME POINTER
	HRLI	AC1,(POINT 6,)		;MAKE IT A BYTE POINTER
	LDB	AC4,[POINT 2,AC2,11]	;GET BYTE SIZE
	TLZ	AC2,007700		;ZERO BYTE FIELD
	PUSH	PP,I16			;SAVE I16
	MOVEI	AC16,1			;SETUP PARAMETER WORD
	PUSHJ	PP,@IGTAB4-1(AC4)	;MOVE IT TO DATA-ITEM
	POP	PP,I16			;RESTORE I16

	HRRZM	I16,@F.WPFT(I16)	;SET FILE-TABLE PTR TO DATA-ITEM

SETSTX:	POPJ	PP,		; ALL DONE, RETURN


	;CALL =		PUSHJ PP,IG????
	;AC0 =		THE ERROR NUMBER
	;RETURN
	;POPJ		IF THERE IS NO ERROR USE PROCEDURE
	;		OR IF THE ACTION CODE POINTER, F.WPAC IS ZERO
	;		OR IF THE ACTION CODE IS ZERO
	;		GIVE ERROR MESSAGE AND KILL
	;SKIP EXIT	IF (F.WPAC) IS NON-ZERO TO IGNORE THE ERROR

IGTST:

;[1043] END-OF-FILE ERRORS ARE NOT TO BE IGNORED 
;[1043] IFN ANS74,<
;[1043]	MOVE	AC1,FS.FS	;GET ERROR CODE
;[1043]	CAIN	AC1,^D10	;END-OF-FILE ONLY?
;[1043]	JRST	IGTST2		;YES
;[1043]>

	SKIPE	FS.IGE		;ANY ERRORS IGNORED YET?
	JRST	IGTST2		;YES - IGNORE ALL FOR DURATION OF THIS VERB
	MOVE	FLG,-7(PP)	;[501] RESTORE FLAG.  NOTE ** THIS 
				;ASSUMES THAT A "PUSHJ SAVAC" HAS
				;BEEN DONE PRIOR TO COMING HERE.
	MOVEI	AC1,0		;CALL THE ERROR USE PROCEDURE
	PUSHJ	PP,USEPRO	;DO IT
	 JRST	IGTST1		;THERE IS ONE
	JRST	RSTAC1		;THERE IS NONE

IGTST1:	SETOM	FS.UPD		;REMEMBER ERROR USE-SRO WAS DONE
	SKIPE	AC1,F.WPAC(I16)	;IS THERE AN F.WPAC POINTER?
	SKIPN	AC1,(AC1)	;YES, IGNORE THE ERROR?
	JRST	RSTAC1		;NO -- MESSAGE AND KILL
	SETOM	FS.IGE		;YES -- FOR THE DURATION OF THIS VERB
	AOS	FS.IEC		; COUNT IGNORED ERRORS
IGTST2:	PUSHJ	PP,RSTAC.	;RESTORE ACS
	JRST	RET.2		;SKIP EXIT
	;HERE TO MOVE DECIMAL NUMBER TO DISPLAY FIELD
	;AC0 HAS THE NUMBER

INTERN IGCNVT				;CALLED BY LBLERR
IGCNVT:	PUSH	PP,I16			;SAVE THE FILE-TABLE POINTER
	LDB	AC3,[POINT 2,AC1,11]	;PICKUP THE BYTE SIZE
	TLZ	AC1,007700		;ZERO THE SIZE FIELD
	MOVEI	AC16,1			;SETUP PARAMETER WORD
	PUSHJ	PP,@IGTAB1-1(AC3)	;CONVERT AND MOVE IT
	POP	PP,I16			;RESTORE I16
	POPJ	PP,			;RETURN

IGTAB1:	PD9.			;DECIMAL TO EBCDIC
	PD6.			;DECIMAL TO SIXBIT
	PD7.			;DECIMAL TO ASCII

IGTAB2:: @ IGTAB3-1(AC4)	;EBCDIC TO SOMETHING
	@ IGTAB4-1(AC4)		;SIXBIT TO SOMETHING
	@ IGTAB5-1(AC4)		;ASCII TO SOMETHING

IGTAB3:	MOVE.			;EBCDIC TO EBCDIB
	C.D9D6			;EBCDIC TO SIXBIT
	C.D9D7			;EBCDIC TO ASCII

IGTAB4:: C.D6D9			;SIXBIT TO EBCDIC
	MOVE.			;SIXBIT TO SIXBIT
	C.D6D7			;SIXBIT TO ASCII

IGTAB5:	C.D7D9			;ASCII TO EBCDIC
	C.D7D6			;ASCII TO SIXBIT
	MOVE.			;ASCII TO ASCII
	; ROUTINE TO SET UP FILE STATUS WORDS

STSTAT:	PUSHJ	PP,SAVAC.	; SAVE THE AC'S
	SETZ	AC0,		; CLEAR ERROR NUMBER ARG
	PUSHJ	PP,SETSTS	; SET UP WORDS
	JRST	RSTAC1		; RESTORE AC'S AND POPJ


	;SET FILE STATUS WORD (IF IT EXISTS) TO 00

CLRSTS:	SKIPE	AC1,F.WPFS(I16)	;FILE STATUS WORD?
	SKIPE	FS.FS		;YES AND OK STATUS?
	POPJ	PP,		;NO, ASSUME ITS ALREADY SET UP
	PUSHJ	PP,STSTAT	; SET REST OF STATUS FIELDS
	MOVE	AC1,F.WPFS(I16)	;GET FILE STATUS PTR
	LDB	AC2,[POINT 2,AC1,11]	;GET BYTE SIZE TO FIND TYPE
	MOVE	AC2,[EXP 360,'0',"0"]-1(AC2)	;GET ZERO
CLRST2:	TLZ	AC1,77		;CLEAR COUNT
	IDPB	AC2,AC1		;STORE STATUS
CLRST1:	IDPB	AC2,AC1		;BOTH CHARACTERS
	POPJ	PP,

	;SET FILE STATUS WORD (IF IT EXISTS) TO 10

ENDSTS:	MOVEI	AC0,^D10	; [601]READ INVALID KEY
	MOVEM	AC0,FS.FS	; [601]LOAD FILE-STATUS
	SKIPN	AC1,F.WPFS(I16)	;FILE STATUS WORD?
	POPJ	PP,		;NO
	PUSHJ	PP,STSTAT	; SET REST OF STATUS FIELDS
	MOVE	AC1,F.WPFS(I16)	;GET FILE STATUS PTR
	LDB	AC2,[POINT 2,AC1,11]	;GET BYTE SIZE TO FIND TYPE
	MOVE	AC2,[EXP 361,'1',"1"]-1(AC2)	;GET TEN
	TLZ	AC1,77		;CLEAR COUNT
	IDPB	AC2,AC1		;STORE STATUS
	SOJA	AC2,CLRST1	;STORE ZERO

	;SET FILE STATUS WORD (IF IT EXISTS) TO 22

DPLSTS:	HLLZS	UIN.		;[666] RESET UIN.
	SKIPN	AC1,F.WPFS(I16)	;[666] FILE STATUS WORD? 
	POPJ	PP,		;NO
	PUSHJ	PP,STSTAT	; SET REST OF STATUS FIELDS
	MOVE	AC1,F.WPFS(I16)	;GET FILE STATUS PTR
	LDB	AC2,[POINT 2,AC1,11]	;GET BYTE SIZE TO FIND TYPE
	MOVE	AC2,[EXP 362,'2',"2"]-1(AC2)	;GET TEN
	JRST	CLRST2		;STORE BOTH CHATACTERS

	;SET FILE STATUS WORD (IF IT EXISTS) TO 23

NRESTS:	MOVEI	AC0,FSNRCF	;[601]GET FS.FS NUMBER FOR REC NOT FOUND
	MOVEM	AC0,FS.FS	;[601]SET IT
	SKIPN	AC1,F.WPFS(I16)	;FILE STATUS WORD?
	POPJ	PP,		;NO
	PUSHJ	PP,STSTAT	; SET REST OF STATUS FIELDS
	MOVE	AC1,F.WPFS(I16)	;GET FILE STATUS PTR
	LDB	AC2,[POINT 2,AC1,11]	;GET BYTE SIZE TO FIND TYPE
	MOVE	AC2,[EXP 362,'2',"2"]-1(AC2)	;GET TEN
	TLZ	AC1,77		;CLEAR COUNT
	IDPB	AC2,AC1		;STORE STATUS
CLRST3:	AOJA	AC2,CLRST1	;STORE "3"

	;SET FILE STATUS WORD (IF IT EXISTS) TO 24

IVKSTS:	SKIPN	AC1,F.WPFS(I16)	;FILE STATUS WORD?
	POPJ	PP,		;NO
	PUSHJ	PP,STSTAT	; SET REST OF STATUS FIELDS
	MOVE	AC1,F.WPFS(I16)	;GET FILE STATUS PTR
	LDB	AC2,[POINT 2,AC1,11]	;GET BYTE SIZE TO FIND TYPE
	MOVE	AC2,[EXP 362,'2',"2"]-1(AC2)	;GET TEN
	TLZ	AC1,77		;CLEAR COUNT
	IDPB	AC2,AC1		;STORE STATUS
	AOJA	AC2,CLRST3	;STORE "4"
SUBTTL	RERUN-DUMP-CODE
	;SCAN FOR AN OPEN RANDOM IO FILE
RRDMP:	PUSHJ	PP,SAVAC.	;SAVE AC'S
	MOVE	AC15,REDMP.	;SAVE THE "FORCE-DUMP" FLAG
	SETZB	AC0,REDMP.	;CLEAR THE "FORCE-DUMP" FLAG

	SKIPN	AC1,RRFLG.	; FLG IS SET IF RERUN CLAUSE WAS USED
	SKIPN	OPNCH.		; ANY CHANNELS AVAILABLE?
	JUMPE	AC1,RRERR5	; IF NOT - ERROR
IFN DBMS,<
	SKIPE	DBMLOK##	;[520] IS THIS A DBMS PROGRAM?
	JRST	RRDM10		;[520] YES, ERROR
>;END IFN DBMS

	SKIPN	KEYCV.		; [431] ARE WE SORTING?
	JRST	RRDMP7		; [431] NO
	PUSHJ	PP,RRERR0	; [431] COMPLAIN
	OUTSTR	[ASCIZ / SORT in progress.
/]
	JRST	RRXIT		; [431] THEN EXIT.
RRDMP7:	SKIPN	OVRFN.		;IF OVERLAY FILE IS OPEN
	JRST	RRDMP6		;
	PUSHJ	PP,RRERR0	;    ABORT -- CHANNEL 1 IS IN USE
	OUTSTR	[ASCIZ/ OVERLAY/]
	JRST	RRDMP9		;

RRDMP6:	SYSPHY	AC0,		;SYSPHY UUO ;XIT IF LEVEL C
	  JRST	RSTAC1		;EXIT
	HRRZ	AC16,FILES.	;POINT TO FIRST FILE TABLE
	TRNA
RRDMP1:	HRRZ	AC16,F.RNFT(I16);POINTER TO NEXT FILE-TABLE
	JUMPE	AC16,RRDMP2	;
	MOVE	AC13,D.DC(I16)	;DEVCHR TO 13
	MOVE	FLG,F.WFLG(I16)	;FLAGS TO FLG
	JRST	RRDMP5		;
RRDMP0:	PUSHJ	PP,RRERR0	;"DUMP ABORTED"
	OUTSTR	[ASCIZ / IO/]
	JRST	RRDMP9		;EXIT, NO DUMP

	;SCAN FOR OPEN OUTPUT FILES
RRDMP2:	PUSH	PP,.JBFF	; SAVE START OF LOWSEG FREE SPACE
	HRRZ	AC16,FILES.	;FIRST FILE-TABLE
	TRNA
RRDMP3:	HRRZ	AC16,F.RNFT(I16);NEXT FILE-TABLE
	JUMPE	AC16,RRDIT	;GO DUMP IT
	MOVE	FLG,F.WFLG(I16)	;FLAGS
	TLNN	FLG,OPNIN!OPNOUT ;SKIP IF FILE IS OPEN
	JRST	RRDMP4		;ELSE CONT
	MOVE	AC1,F.WDNM(I16)	;DEVICE POINTER
	MOVE	AC1,(AC1)	;6BIT DEVICE NAME
	MOVEM	AC1,D.RD(I16)	;SAVE IT FOR RERUN
RRDMP4:	TLNE	FLG,IDXFIL	; ISAM FILE??
	JRST	RRDMPI		; YES, GO DO IT
	TLNN	FLG,OPNOUT	;SKIP IF OPEN FOR OUTPUT 
	JRST	RRDMP3		;LOOP
	MOVE	AC13,D.DC(I16)	;DEVCHR
	TXC	AC13,DV.DSK!DV.CDR	;[321];IF IT'S A DSK AND A CARD READER
	TXCE	AC13,DV.DSK!DV.CDR	;[321];  IT'S THE NULL DEVICE - SO SKIP
	TXNN	AC13,DV.DSK!DV.MTA	;SKIP IF DSK OR MTA
	JRST	RRDMP3		;
	PUSHJ	PP,SETCN.	;SET CHAN NUMBER
	TLNN	FLG,IOFIL!RANFIL ;[622] SKIP IF DSK DUMP MODE
	JRST	RRBUF		;DSK/MTA BUFFERED MODE
	;DSK DUMP MODE
	PUSHJ	PP,RRCLE	;CLOSE, LOOKUP, ENTER SEQUENCE
	MOVE	AC1,D.CBN(I16)	;NEXT BLOCK
	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSI		; DO A FILOP. TYPE USETI
	  XCT	USETI.		;
	JRST	RRDMP3		;CONT LOOP

RRDMP5:	TLNN	FLG,OPNIN!OPNOUT
	JRST	RRDMP1		;THIS FILE IS NOT OPEN = CONT
	TXC	AC13,DV.DSK!DV.CDR	;[321];
	TXCN	AC13,DV.DSK!DV.CDR	;[321];NULL DEVICE
	JRST	RRDMP1		;[321];YES -- GO ON

	SKIPE	F.WSMU(I16)	; ENQ'ING?
	JRST	[PUSHJ	PP,RRERR0	; "DUMP ABORTED"
		OUTSTR	[ASCIZ/ SIMULTANEOUS UPDATE/]
		JRST	RRDMP9]		; "FILE IS OPEN"

	TXNN	AC13,DV.CDR!DV.PTP!DV.PTR!DV.DTA	;(REMOVED LPT:) 7/25/78
	JRST	RRDMP1		;NO, CONT SCAN
RRDMP8:	PUSHJ	PP,RRERR0	;DUMP ABORTED
	TXNE	AC13,DV.CDR	;CARDS?
	OUTSTR	[ASCIZ / CARD/]

	TXNE	AC13,DV.PTP!DV.PTR	;PAPER TAPE?
	OUTSTR	[ASCIZ / PAPER-TAPE/]
IFE TOPS20,<
	TXNE	AC13,DV.DTA	;
	OUTSTR	[ASCIZ / DEC-TAPE/]
>
RRDMP9:	OUTSTR	[ASCIZ / file is OPEN.
/]
	JRST	RRXIT		;EXIT NO DUMP

RRDM10:	PUSHJ	PP,RRERR0	;[520] YES WE CAN'T RERUN SO DON'T DUMP
	OUTSTR	[ASCIZ / Program has calls to DBMS.
/]
	JRST	RRXIT		;[520] THEN EXIT

	;CLOSE LOOKUP ENTER ROUTINE

RRCLE:	XCT	UCLOS.		;CLOSE, ENSURES FILES CURRENT STATE IS PRESERVED
	PUSHJ	PP,WRTWAI	;CHECK FOR ERRORS
RRCLE1:	PUSHJ	PP,OPNLID	;SET UP LOOKUP  BLOCK
	XCT	ULKUP.		;LOOKUP
	  JRST	LOOKER		;ERROR
IFE TOPS20,<
	TXNE	AC13,DV.DTA	;SKIP IF NOT DTA
	POPJ	PP,		;
>
RRCLE2:	PUSHJ	PP,OPNEID	;ENTER BLK
	XCT	UENTR.		;ENTER
	  JRST	ENTRER		;ERROR
	POPJ	PP,		;

RRDMPI:
	; FIRST SAVE IDX AND IDA DEVICE NAMES IF TOPS10
IFE TOPS20,<
	MOVE	AC2,.JBFF	; GET FREE CORE POINTER
	MOVEI	AC3,2		; INDICATE NEED TWO WORDS FOR TWO DEVICE NAMES
	ADDB	AC3,.JBFF	; INCREMENT FREE CORE POINTER
	CAMGE	AC3,.JBREL	; SKIP IF NEED MORE CORE
	 JRST	RRDMI1		; ELSE CONT
	CORE	AC3,		; EXPAND CORE
	 JRST	RRERR4		; ERROR, CAN'T DO IT

RRDMI1:	HRRZ	AC3,F.WDNM(I16)	; GET ADDR OF IDX DEVICE NAME
	DMOVE	AC0,(AC3)	; GET IDX AND IDA DEVICE NAMES
	DMOVEM	AC0,(AC2)	; SAVE THEM IN FREE CORE
	MOVEM	AC2,D.RD(I16)	; SAVE ADDR TO IDX AND IDA DEVICE NAMES
	

>

	; IF NOT OPEN FOR OUTPUT, DON'T BOTHER TO CLOSE AND REOPEN
	; JUST CONTINUE OPEN FILE SEARCH. THIS IS REALLY ONLY FOR 
	; TOPS10, WHICH MUST SAVE IDX AND IDA DEVICE NAMES FOR 
	; FILES OPEN FOR INPUT

	TLNN	FLG,OPNOUT	;SKIP IF OPEN FOR OUTPUT 
	JRST	RRDMP3		;LOOP


	HLRZ	AC12,D.BL(I16)	; GET BUFFER LOCATION
	MOVE	AC5,ICHAN(I12)	; GET IDX CHANNEL NUMBER
	PUSHJ	PP,SETC1.	; GO SET UP FOR IDX UUO'S
	XCT	UCLOS.		;CLOSE, ENSURES FILES CURRENT STATE IS PRESERVED
	PUSHJ	PP,WRTWAI	;CHECK FOR ERRORS
	PUSHJ	PP,OPNLIX	;SET UP LOOKUP  BLOCK
RRDMIL:	XCT	ULKUP.		;LOOKUP
	  JRST	LOKERI		;ERROR
RRDMIE:	PUSHJ	PP,OPNEIX	;ENTER BLK
	XCT	UENTR.		;ENTER
	  JRST	ETRERI		;ERROR

	; NOW SET UP TO SAVE IDA FILE

	PUSHJ	PP,SETCN.	; SPREAD IDA CHANNEL NUM AROUND
	PUSHJ	PP,RRCLE	; NOW CLOSE,LOOKUP,ENTER IDA FILE
	JRST	RRDMP3		; AND CONTINUE WITH NEXT FILE IN FILTAB


LOOKER:	PUSHJ	PP,LUPERR	;ERROR MESSAGE
	JRST	RRCLE1	;TRY AGAIN

ENTRER:	PUSHJ	PP,ENRERR	;
	JRST	RRCLE2		;

LOKERI:	PUSHJ	PP,LUPERR	;ERROR MESSAGE
	JRST	RRDMIL	;TRY AGAIN

ETRERI:	PUSHJ	PP,ENRERR	; ERROR MESSAGE
	JRST	RRDMIE		; TRY AGAIN



	;BUFFERED MODE
RRBUF:	PUSH	PP,D.OBC(I16)	;OUTPUT
	PUSH	PP,D.OBB(I16)	;BUFFER
	PUSH	PP,D.OBH(I16)	;HEADER
	HRR	AC1,D.OBH(I16)	;CURRENT BUFFER'S ADR
	ADDI	AC1,1		;MAKE BYTPTR INDICATE EMPTY BUFFER
	HRRM	AC1,D.OBB(I16)	;HDR BYTE-POINTER
	PUSHJ	PP,RRCLE	;CLOSE, LOOKUP, ENTER
	TXNE	AC13,DV.MTA	;MTA?
	JRST	RRBUF5		;YES
	POP	PP,D.OBH(I16)	;OUTPUT
	POP	PP,D.OBB(I16)	;BUFFER
	POP	PP,D.OBC(I16)	;HEADER
	MOVE	AC1,D.OE(I16)	;NUMBER OF OUTPUTS
	AOJA	AC1,RRBUF2	;DSK

RRBUF2:	TLNN	AC1,-1		; [641] IF GREATER THAN 777777
	CAILE	AC1,-11		; [641] OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSO		; DO A FILOP. TYPE USETO
	  XCT	USETO.		;
	JRST	RRDMP3		;

	;MAG-TAPE, IF CLOSE GENERATED AN EOF BACK OVER IT
RRBUF5:	XCT	UOUT.		;DUMMY OUTPUT, ??? IT WORKS
	XCT	MBSPR.		;BACKUP ONE RECORD  (EOF)
IFE TOPS20,<
	XCT	MWAIT.		;WAIT FOR TAPE MOTION TO STOP
>
	XCT	UGETS.		;GET STATUS INTO AC2
	TXNN	AC2,IO.EOF!IO.BOT	;SKIP IF EOF OR BOT
	XCT	MADVR.		;NOT AN EOF, SPACE OVER IT

	;NOW MOVE WHAT WAS THE CURRENT BUFFER TO THE CURRENT CURRENT BUFFER
	HRR	AC2,D.OBH(I16)	;TO - 1
	HRL	AC2,(PP)	;FROM - 1
	HLRZ	AC1,(AC2)	;BUF SIZE, MAY CHANGE FROM FILE TO FILE
	ADDI	AC1,(AC2)	;UNTIL
	AOBJP	AC2,.+1		;FROM,,TO
	BLT	AC2,(AC1)	;MOVIT

	;UPDATE THE HEADER
	POP	PP,AC1		;FRST HDR WRD
	POP	PP,AC2		;BYTE-PTX
	SUBI	AC2,(AC1)	;#OF WRDS IN BFR
	HRRZ	AC1,D.OBH(I16)	;CRNT BFRS ADR
	ADD	AC2,AC1		;NEW BYTE-PTR
	MOVEM	AC2,D.OBB(I16)	;SAVIT
	POP	PP,D.OBC(I16)	;OLD BYTE-CNT
	JRST	RRDMP3		;NEXT
RC==1	;RERUN IO CHANNEL
	;DUMP THE LOWSEG
RRDIT:	MOVEI	AC5,RC		; GET DEFAULT CHANNEL
	SKIPN	RRFLG.		; USE IT IF RERUN CLAUSE WAS USED
	PUSHJ	PP,GCHAN	; ELSE GET ON FROM THE POOL
	MOVEI	AC3,'DSK'
	HRLZM	AC3,UOBLK.+1	;DEVICE NAME
	MOVEI	AC3,.IODMP	;DUMP MODE
	HRRZM	AC3,UOBLK.	;
	SETZM	UOBLK.+2	;ELSE LAST BUF-HDR IS OVER-WRITTEN
	MOVE	AC6,[OPEN UOBLK.]
	DPB	AC5,[POINT 4,AC6,12]
	XCT	AC6
	 JRST	RRERR		;ERROR
	HRROI	AC3,.GTPRG	;USER PROGRAN NAME
	GETTAB	AC3,		;PROGRAM NAME TO AC3
	  JRST	RRERR3		;ERROR RET ;HRLZI AC3,(SIXBIT /PKC/)
	MOVEM	AC3,UEBLK.	;LOW-SEG NAME
	HRLZI	AC3,'CKP'
	HLLZM	AC3,UEBLK.+1	;EXTENSION
	SETZM	UEBLK.+2
	SETZM	UEBLK.+3
	MOVE	AC6,[ENTER UEBLK.]
	DPB	AC5,[POINT 4,AC6,12]
	XCT	AC6
	 JRST	RRERR1		;ERROR

	MOVS	AC1,HLOVL.	; IF THERE IS AN OVERLAY AREA GET
	ADDI	AC1,1		; ADR OF FIRST FREE LOC FOLLOWING IT
	CAIE	AC1,1		; SKIP IF NO LINK TYPE OVERLAY
	HRRZM	AC1,.JBFF	; USE THIS AREA FOR JOBDATA STORAGE

	HRRZ	AC0,.JBFF	;
	ADDI	AC0,.JBDA	;
	CAMGE	AC0,.JBREL	;SKIP IF NEXT BLT VIOLATES MEMORY
	JRST	RRDIT3		;
	CORE	AC0,		;EXPAND CORE
	  JRST	RRERR4		;ERROR RET
RRDIT3:	MOVE	AC0,FILES.	;
	HRL	AC0,.JBFF	;FRST FREE
	MOVEM	AC0,TEMP.	;FIRST FILE TABLE
	MOVEM	PP,TEMP.1	;PP POINTER
	HRLI	AC10,TEMP.	;POINTER TO FILES. AND PP
	HRR	AC10,.JBREL	;LENGTH FOR IOWD
	HRRZ	AC1,.JBFF	;
	MOVEM	AC10,(AC1)	;INTO FIRST FREE LOC
	HRROI	AC1,-1(AC1)	;IOWD
	PUSH	PP,2(AC1)
	MOVE	AC2,LIBVR.	;STORE VERSION #
	MOVEM	AC2,2(AC1)	;SO WE KNOW ITS V12 OR LATER
IFN TOPS20,<
	HRRZ	AC2,JSARR.	;GET POINTER TO START.
	MOVE	AC3,(AC2)	;GET JSP
	CAMN	AC3,[JFCL]
	 MOVE	AC3,1(AC2)	;GET JSP!
	MOVE	AC2,2(AC3)	;GET POINTER TO JFN STRING
	PUSH	PP,3(AC1)	;JUST IN CASE
	MOVEM	AC2,3(AC1)	;STORE IT
	HRLI	AC1,-3		;WRITE OUT 3 WORDS
>
IFE TOPS20,<
	HRLI	AC1,-2		;WRITE OUT 2 WORDS
>
	SETZ	AC2,		;TERMINATOR
	MOVE	AC6,[OUT AC1]	;FIRST RECORD	;TEMP.,,(.JBREL)
	DPB	AC5,[POINT 4,AC6,12]
	XCT	AC6
	  TRNA
	JRST	RRERR2		;OUTPUT ERROR
IFN TOPS20,<
	POP	PP,3(AC1)	;RESTORE
>
	POP	PP,2(AC1)	;RESTORE
	HRRZ	AC1,.JBFF	;SAVE JOBDATA AREA
	MOVEI	AC3,.JBDA(AC1)	;UNTIL
	BLT	AC1,(AC3)	;   STARTING AT .JBFF
	MOVNI	AC1,-140(AC10)	;IOWD FOR SECOND RECORD
	HRL	AC1,AC1		;ALL OF LOW-SEG
	HRRI	AC1,.JBDA-1	;  BUT JOB-DATA AREA
	MOVE	AC6,[OUT AC1]	;SECOND RECORD
	DPB	AC5,[POINT 4,AC6,12]
IFE LSTATS,<
	XCT	AC6
	  TRNA
	JRST	RRERR2		;OUTPUT ERROR
>;END IFE LSTATS
IFN LSTATS,<
	SKIPN	MRRERN		;DID WE RESTART WITH RERUN BEFORE?
	 JRST	MNORRN		;NO, OK TO SET AND CLEAR "RERUNNING" FLAG

;WE RESTARTED THE PROGRAM USING RERUN AND NOW WE ARE DOING ANOTHER DUMP.
; THE FLAG "MRRERN" MUST STAY SET TO -1, SO NO OUTPUT GETS DONE TO MTO FILE.

	XCT	AC6		;DO OUTPUT
	 JRST	RROUOK		;ALL OK
	JRST	RRERR2		;OUTPUT ERROR

;THE PROGRAM HAS NOT BEEN "RERUN". SET THE FLAG MRRERN TO -1 SO
;THAT IF WE ^C AND RUN RERUN LATER, THE PROGRAM WILL NOT TRY AND WRITE
;BAD INFORMATION INTO THE .MTO FILE.

MNORRN:	SETOM	MRRERN		;WE'LL SET AND CLEAR FLAG THIS TIME
	XCT	AC6		;DO OUTPUT
	 JRST	[SETZM MRRERN	;ALL OK, CLEAR FLAG
		JRST	RROUOK]
	JRST	[SETZM MRRERN	;OUTPUT ERROR..BUT CLEAR FLAG ANYWAY
		JRST	RRERR2] ;SO WE GET THE INFO COLLECTED SO FAR
RROUOK:
>;END IFN LSTATS
	POP	PP,.JBFF	; RESTORE THE STACK AND JOBFF
	MOVSI	AC6,(CLOSE)
	DPB	AC5,[POINT 4,AC6,12]
	XCT	AC6
	OUTSTR	[ASCIZ /DUMP completed.
/]
RRXIT:	AOSN	AC15		;SKIP IF NOT FORCED
	EXIT	1,		;EXIT IF IT WAS FORCED
	JRST	RSTAC1		;RESTORE ACS AND POPJ
RRERR0:	OUTSTR	[ASCIZ /DUMP aborted ./]
	POPJ	PP,		;

		;OPEN FAILED
RRERR:	PUSHJ 	PP,RRERR0	;
	OUTSTR	[ASCIZ /OPEN failed. /]
	JRST	RRXIT		;

		;ENTER FAILED
RRERR1:	PUSHJ	PP,RRERR0	;
	OUTSTR	[ASCIZ /ENTER failed,/]
	HRRZ	AC2,UEBLK.+1	;THE ERROR BITS
	TRZ	AC2,777740	;   NOTHING ELSE
	CAIL	AC2,LEMLEN	;LEGAL MESSAGE?
	HRRI	AC2,LEMLEN	;NO
	CAIN	AC2,0		;
	HRRI	AC2,LEMLEN+1	;ILL-FIL-MAME
	OUTSTR	@LEMESS(AC2)	;COMPLAIN
	JRST	RRERRX		;ERROR EXIT

		;OUTPUT FAILED
RRERR2:	POP	PP,.JBFF	; RESTORE THE STACK AND JOBFF
	PUSHJ	PP,RRERR0	;
	OUTSTR	[ASCIZ /OUTPUT error, /]
	GETSTS	RC,AC2		;ERROR STATUS
	PUSHJ	PP,IOERM1	;COMPLAIN

RRERRX:	OUTSTR	[ASCIZ /
/]
	CLOSE	RC,CL.RST	;CLOSE, BUT DONT SUPERCEDE
	JRST	RSTAC1		;EXIT

	;CAINT FIND THE PROGRAM NAME
RRERR3:	PUSHJ	PP,RRERR0	;
	OUTSTR	[ASCIZ /Cannot find program name./]
	JRST	RRERRX		;

	;CORE UUO FAILED
RRERR4:	POP	PP,.JBFF	; RESTORE THE STACK AND JOBFF
	PUSHJ	PP,RRERR0
	OUTSTR	[ASCIZ /CORE UUO failed./] 
	JRST	RRERRX		;

	;NO IO CHANNELS FOR THE DUMP FILE
RRERR5:	PUSHJ	PP,RRERR0
	OUTSTR	[ASCIZ /No channels available./]
	JRST	RRERRX
SUBTTL	POINTERS AND THINGS

FLPS10:	POINT	6,F.WPMT(AC10),17	;FILE POSITION USING AC10
WOPRS.:	POINT	12,AC15,11	;RECORD SIZE IN CHARS
WOPCN:	POINT	3,AC15,17	;LPT CHANNEL NUMBER
STDLBP:	POINT	6,STDLB.	;STANDARD LABEL POINTER
OPNCBP:: POINT	1,OPNCH.,0	;[342]POINTER TO CHAN. STATUS
IFN SIRUS<SIRDEV:	SIXBIT/SIRS/	; SIRUS ARCHIVE DEVICE >

	;CONSTANTS FOR ISAM
IFN	ISAM,<
KY.TP:	POINT	18,1+KEYDES(AC1),17	; KEY TYPE
KY.MD:	POINT	2,1+KEYDES(AC1),19	; MODE OF FILE
KY.TYP:	POINT	18,KEYDES(I12),17	; KEY TYPE
KY.MOD:	POINT	2,KEYDES(I12),19	; MODE OF FILE
KY.SGN:	POINT	1,KEYDES(I12),20	; ONE IF UNSIGNED
					;NOTE: UNTIL V11, THIS WAS INCORRECTLY
					;DOCUMENTED AS 'ONE IF SIGNED'
					;REVERSING THE EFFECTS FOR COMP-3
					;EBCDIC LOW-VALUE SYMBOLIC KEYS.
KY.SIZ:	POINT	12,KEYDES(I12),35	; KEY SIZE
>

DTCN.:	POINT	4,D.CN(I16),15	; CHANNEL NUMBER
UUOCHN:	POINT	4,UOPEN.,12	; CHANNEL NUMBER AS SET IN OPEN UUO XCT WORD
DTIBS.:	POINT	6,D.IBB(I16),11	; INPUT HEADER BYTE SIZE
DTOBS.:	POINT	6,D.OBB(I16),11	; OUTPUT HEADER BYTE SIZE
DTRN.:	POINT	12,D.RN(I16),11	; MTA REEL NUMBER
F.QOPN:	POINT	1,F.WSMU(I16),15	;[565] LFENQ. OPEN FLAG
					;[565] 0= NOT AFTER LFENQ. OPEN
					;[565] 1= AFTER LFENQ. OPEN
F.BNDV:	POINT	6,F.WNOD(I16),17	;NUMBER OF DEVICES SELECTED
F.BLF::	F%BLF	;LOCK FLAG

F.BCVR:	F%BCVR	; COMPILER'S VERSION NUMBER
F.BBLC:: F%BBLC	; BUFFER LOCATION IS ASSIGNED - BUFLOC
F.BSDF:	F%BSDF	; SORT-DESCRIPTION FILE FLAG - SRTFIL
F.BDRM:	F%BDRM	; OPEN REVERSED ACTIVE FLAG
F.BNOD:	F%BNOD	; NUMBER OF DEVICES ASSIGNED TO FILE
IFN ANS68,<
F.BNFL:	F%BNFL	; NUMBER OF FILE LIMIT CLAUSES
>
IFN ANS74,<
F.BFAM:	F%BFAM	; FILE ACCESS MODE
>
F.BLBT:	F%BLBT	; SYSTEM LABEL TYPE (SEE MONITOR CALLS FOR CODE VALUES)
F.BLBU:	F%BLBU	; "U" FORMAT SYSTEM LABEL FORMAT FLAG BIT
F.BLBF:	F%BLBF	; "F" FORMAT SYSTEM LABEL FORMAT FLAG BIT
F.BLBD:	F%BLBD	; "D" FORMAT SYSTEM LABEL FORMAT FLAG BIT
F.BLBS:	F%BLBS	; "S" FORMAT SYSTEM LABEL FORMAT FLAG BIT
F.BFMT:	F%BFMT	; LABELED TAPE FORMAT BITS
F.BPMT:	F%BPMT	; FILE POSITION ON MAG-TAPE
F.BNAB:	F%BNAB	; NUMBER OF ALTERNATE BUFFERS
F.BRMS::	F%BRMS	; THE RMS FILE FLAG
F.BMRS::	F%BMRS	; MAXIMUM RECORD SIZE IN CHARS
F.BBKF: F%BBKF	; THE BLOCKING FACTOR
F.BPAR:	F%BPAR	; MAG-TAPE PARITY
F.BDNS:	F%BDNS	; MAG-TAPE DENSITY
F.BDIO:	F%BDIO	; DEFERRED ISAM OUTPUT FLAG
F.BOUP:	F%BOUP	; OPEN USE-PROCEDURE WHEN ENTER FAILS
F.BBM:	F%BBM	; BYTE MODE FLAG
F.BCKP:	F%BCKP	; CHECKPOINT ISAM FLAG
F.BCRC: F%BCRC	; CHECKPOINT ON RECORD COUNT 
	;THE TABLE IS USED TO CONVERT FROM LOWER CASE TO UPPER CASE
	;TO SIXBIT ETC.  END-OF-LINE (EOL) CHARS ARE NEGATIVE.
	;	SIXBIT	ASCII	;CHAR
CHTAB:	XWD	0,	0	;
	XWD	0,	1	;
	XWD	0,	2	;
	XWD	0,	3	;
	XWD	0,	4	;
	XWD	0,	5	;
	XWD	0,	6	;
	XWD	0,	7	;
	XWD	0,	10	;
	XWD	0,	11	;HT
	XWD	400000,	400012	;LF
	XWD	400000,	400013	;VT
	XWD	400000,	400014	;FF
IFE SIRUS,<XWD	400000,	400015	;CR >
IFN SIRUS,<XWD	0,	0	;CR TREAT AS NULL-IE. IGNORE >
	XWD	0,	16	;
	XWD	0,	17	;
	XWD	400000,	400020	;DLE
	XWD	400000,	400021	;DC1
	XWD	400000,	400022	;DC2
	XWD	400000,	400023	;DC3
	XWD	400000,	400024	;DC4
	XWD	0,	25	;
	XWD	0,	26	;
	XWD	0,	27	;
	XWD	0,	30	;
	XWD	0,	31	;
	XWD	400000,	400032	;TTY EOF (^Z)
	XWD	0,	33	;ALT-MODE
	XWD	0,	34	;
	XWD	0,	35	;
	XWD	0,	36	;
	XWD	0,	37	;

	XWD	0,	40	;SPACE
	XWD	1,	41	;!
	XWD	2,	42	;"
	XWD	3,	43	;#
	XWD	4,	44	;$
	XWD	5,	45	;%
	XWD	6,	46	;&
	XWD	7,	47	;'
	XWD	10,	50	;(
	XWD	11,	51	;)
	XWD	12,	52	;*
	XWD	13,	53	;+
	XWD	14,	54	;,
	XWD	15,	55	;-
	XWD	16,	56	;.
	XWD	17,	57	;/
	XWD	20,	60	;0
	XWD	21,	61	;1
	XWD	22,	62	;2
	XWD	23,	63	;3
	XWD	24,	64	;4
	XWD	25,	65	;5
	XWD	26,	66	;6
	XWD	27,	67	;7
	XWD	30,	70	;8
	XWD	31,	71	;9
	XWD	32,	72	;:
	XWD	33,	73	;;
	XWD	34,	74	;<
	XWD	35,	75	;=
	XWD	36,	76	;>
	XWD	37,	77	;?

	XWD	40,	100	;@
	XWD	41,	101	;A
	XWD	42,	102	;B
	XWD	43,	103	;C
	XWD	44,	104	;D
	XWD	45,	105	;E
	XWD	46,	106	;F
	XWD	47,	107	;G
	XWD	50,	110	;H
	XWD	51,	111	;I
	XWD	52,	112	;J
	XWD	53,	113	;K
	XWD	54,	114	;L
	XWD	55,	115	;M
	XWD	56,	116	;N
	XWD	57,	117	;O
	XWD	60,	120	;P
	XWD	61,	121	;Q
	XWD	62,	122	;R
	XWD	63,	123	;S
	XWD	64,	124	;T
	XWD	65,	125	;U
	XWD	66,	126	;V
	XWD	67,	127	;W
	XWD	70,	130	;X
	XWD	71,	131	;Y
	XWD	72,	132	;Z
	XWD	73,	133	;[
	XWD	74,	134	;\
	XWD	75,	135	;]
	XWD	76,	136	;^
	XWD	77,	137	;_
	XWD	74,	140	;` - no valid conversion
	XWD	41,	141	;a
	XWD	42,	142	;b
	XWD	43,	143	;c
	XWD	44,	144	;d
	XWD	45,	145	;e
	XWD	46,	146	;f
	XWD	47,	147	;g
	XWD	50,	150	;h
	XWD	51,	151	;i
	XWD	52,	152	;j
	XWD	53,	153	;k
	XWD	54,	154	;l
	XWD	55,	155	;m
	XWD	56,	156	;n
	XWD	57,	157	;o
	XWD	60,	160	;p
	XWD	61,	161	;q
	XWD	62,	162	;r
	XWD	63,	163	;s
	XWD	64,	164	;t
	XWD	65,	165	;u
	XWD	66,	166	;v
	XWD	67,	167	;w
	XWD	70,	170	;x
	XWD	71,	171	;y
	XWD	72,	172	;z
	XWD	73,	173	;{ - convert to [ (+0)
	XWD	74,	174	;| - no valid conversion
	XWD	75,	175	;} - convert to ] (-0)
	XWD	74,	176	;~ - no valid conversion
	XWD	0,	177	;Delete / HIGH-VALUE
	SUBTTL	METERING STUFF
IFN CSTATS,<
IFE TOPS20,<

;TOPS10 CSTATS ROUTINE TO GET A FREE CHANNEL
; RETURNS .+1 IF NONE AVAILABLE, ELSE .+2 WITH NUMBER IN RH(AC5)

GMCHAN:	SKIPN	AC5,OPNCH.	;ANY CHANNELS AVAIL?
	 POPJ	PP,		;NO
	MOVE	AC6,OPNCBP	;GET BYTE PTR
	HRRI	AC5,1		;START WITH 1
	MOVEI	AC2,17		; UPPER LIMIT
GMCHN2:	ILDB	AC11,AC6
	SOJE	AC11,GMCHN1	; SEE GCHAN. ROUTINE
	CAILE	AC2,(AC5)
	AOJA	AC5,GMCHN2
GMCHN0:	SETZB	AC5,AC11	;USE CHANNEL 0 IF NONE OTHER FREE
GMCHN1:	DPB	AC11,AC6	;NOTE CHANNEL UNAVAILABLE
	JRST	RET.2		;GIVE SKIP RETURN

>;END IFE TOPS20
>;END IFN CSTATS
	;METER--ING STUFF

;CALL: MOVEI 16,NUMBER
;	PUSHJ 17,METER.
;	<RETURN HERE>

METER.:
IFE CSTATS,<
	POPJ	PP,		;JUST RETURN IF WE EVER GET HERE
>
IFN CSTATS,<
IFN TOPS20,<
	EXCH	16,PBUKET	;GET PREVIOUS BUCKET IN 16, SAVE NEW
				;PREVIOUS BUCKET
	AOS	MTRNUM(16)	;ANOTHER ONE OF THESE
	PUSH	PP,1		;SAVE 1 AND 2
	PUSH	PP,2
	MTRJS%			;GET NEW CLOCK TIME IN 1,2
	  ERJMP	.+6		;ERROR
	DMOVE	14,1		;SAVE IN 14, 15
	DSUB	1,PCLOCK	; GET INCREMENTAL CLOCK TIME
	ASHC	1,^D24		; SHIFT INTO 36 BIT VALUE
	ADDM	1,MTRTIM(16)	;INCREMENT TIME
	DMOVEM	14,PCLOCK	;SAVE NEW "PREVIOUS" CLOCK TIME
	POP	PP,2
	POP	PP,1
	POPJ	PP,		;RETURN
>;END IFN TOPS20
IFE TOPS20,<

; WE CAN SMASH AC14 AT THE METER--JSYS STATEMENT (NOBODY ELSE CARES)
	HRRZ	AC14,METR.	;AC14 POINTS TO START OF THE METER BUCKETS
	EXCH	16,PBUKET(AC14)	;GET PREVIOUS BUCKET, STORE NEW ONE
	ADD	16,AC14		; 16 POINTS TO COUNTER FOR OLD BUCKET
	AOS	(16)		; COUNT THIS OCCURANCE
	POPJ	PP,		;AND RETURN
>;END IFE TOPS20

IFN TOPS20,<
;THE TABLES

MTRST==.		;START OF INFO

; *** DANGER !!!! ENRAGED CROCK APPROACHING !!! ***

MTRNUM:	BLOCK ^D500	;NUMBER OF TIMES THINGS WERE DONE
	EXP 1
	BLOCK ^D499
	EXP 1
	BLOCK ^D499
	EXP 1
	BLOCK ^D499
	EXP 1
	BLOCK ^D498
	EXP 1
MTRTIM:	BLOCK ^D500	; TIMINGS
	EXP 1
	BLOCK ^D499
	EXP 1
	BLOCK ^D499
	EXP 1
	BLOCK ^D499
	EXP 1
	BLOCK ^D499

;*** END OF CROCK ***

MTREND==.-1		;END
MTRLEN==MTREND-MTRST	;LENGTH OF THINGS TO WRITE OUT

METRNM:	BLOCK 3		;ASCIZ NAME OF FILE

PCLOCK:	BLOCK 2		;PREVIOUS VALUE RETURNED BY METER JSYS
PBUKET:	BLOCK 1		;PREVIOUS BUCKET NUMBER
>;END IFN TOPS20

;ROUTINE TO DO SETUP IF METR. WAS SET
; CALLED BY RESET CODE

SETMTR:
IFN TOPS20,<
	MOVEI	MTRNUM		;MAKE METR. POINT
	MOVEM	METR.##		; TO THE COUNTER TABLE
>;END IFN TOPS20
IFE TOPS20,<
METRLN==^D2500			;NUMBER OF BUCKETS TO WRITE OUT

MTRNM6==0+METRLN		;SIXBIT NAME OF FILE
METRNM==1+METRLN		;ASCIZ NAME OF FILE
PBUKET==4+METRLN		;PREVIOUS BUCKET NUMBER

METCLN==5+METRLN		; NUMBER OF LOWSEG LOCS WE NEED

	;CALL FUNCT. TO GET CORE AT PAGE BOUNDARY
	;STORE POINTER IN METR.

	MOVEI	16,1+[-5,,0
			XWD 0,FUN.A0##
			XWD 0,[ASCIZ/LBL/]
			XWD 0,FUN.ST##
			XWD 0,FUN.A1##
			XWD 0,FUN.A2##]
F.PAG==15
	MOVEI	1,F.PAG		;FUNCTION WE WANT
	MOVEM	1,FUN.A0##	;STORE FUNCTION
	SETZM	FUN.ST##	;CLEAR STATUS
	SETZM	FUN.A1##	; AND ADDRESS RETURNED
	MOVEI	1,METCLN	;NUMBER OF WORDS TO ALLOCATE
	MOVEM	1,FUN.A2##	;STORE AS ARG #2
	PUSHJ	PP,FUNCT.##	;CALL FUNCT. ROUTINE...
	SKIPE	FUN.ST##	; STATUS MUST BE 0...
	 JRST	METNCR		; ? NOPE - NO CORE AVAIL
	HRRZ	1,FUN.A1##	;GOT IT -- GET ADDRESS OF START
	MOVEM	1,METR.		;STORE IN METR.
>;END IFE TOPS20

	MOVEI	MTRREE		;SET REENTER ADDRESS
	MOVEM	.JBREN		; (NOTE: RERUN DUMPS WON'T WORK)
IFN TOPS20,<
	SETZM	MTRNUM+^D500	;GET RID OF THE 1'S
	SETZM	MTRNUM+^D1000
	SETZM	MTRNUM+^D1500
	SETZM	MTRNUM+^D2000
	SETZM	MTRTIM-1
	SETZM	MTRTIM+^D500
	SETZM	MTRTIM+^D1000
	SETZM	MTRTIM+^D1500
	SETZM	MTRTIM+^D2000
	GETNM			;GET SIXBIT NAME OF PROGRAM
	SKIPN	1
	 MOVE	1,[SIXBIT/METER/] ;DEFAULT NAME
>;END IFN TOPS20
IFE TOPS20,<
	HRROI	1,.GTPNM
	GETTAB	1,
	  TRNA			;IF GETTAB FAILS, USE DEFAULT
	SKIPN	1
	 MOVE	1,[SIXBIT/METER/]
	HRRZ	2,METR.
	MOVEM	1,MTRNM6(2)	;STORE NAME
>;END IFE TOPS20
	MOVE	0,1
	SETZ	1,		;MAKE SURE LAST BYTE IS 0
	MOVSI	2,(POINT 6,0)
	MOVE	3,[POINT 7,METRNM]
IFE TOPS20,<
	ADD	3,METR.		;ADD INDEX TO GET REAL ADDRESS
>;END IFE TOPS20
SETMT1:	ILDB	4,2
	JUMPE	4,SETMT2
	ADDI	4,40
	IDPB	4,3
	JRST	SETMT1
SETMT2:	MOVE	2,[POINT 7,[ASCIZ/.DYN/]]
SETM2A:	ILDB	4,2
	JUMPE	4,SETMT3	;DONE MAKING THE STRING
	IDPB	4,3
	JRST	SETM2A
SETMT3:	SETZ	4,
	IDPB	4,3
	POPJ	PP,		;ALL DONE!

IFE TOPS20,<
; COME HERE IF COULDN'T GET CORE FOR METER--ING

METNCR:	OUTSTR	[ASCIZ/? Not enough core for meter--ing.
/]
	SETZM	METR.##		;CLEAR LOCATION
	JRST	KILL.		;PUNT!
>;END IFE TOPS20


;HERE IF HE DID A ^C REENTER

MTRREE: IFE TOPS20,	JRST	1,.+1		;PORTAL IF TOPS10
	PUSHJ	PP,WRTMET	;WRITE IT OUT
	EXIT			;AND EXIT


;ROUTINE TO WRITE IT OUT
; CALL:	PUSHJ PP,WRTMET
;	<RETURN HERE, EVEN IF ERRORS>

WRTMET:	SKIPN	METR.		;IF METER--ING WAS DONE, WRITE THE FILE
	 POPJ	PP,
	OUTSTR	[ASCIZ/[Writing METER file: /]
IFN TOPS20,	OUTSTR	METRNM
IFE TOPS20,<
	HRRZ	1,METR.
	OUTSTR	METRNM(1)
>
	OUTSTR	[ASCIZ/]
/]
IFN TOPS20,<
	MOVX	1,GJ%FOU!GJ%SHT
	HRROI	2,METRNM
	GTJFN%
	 ERJMP	METRRR
	MOVX	2,OF%WR
	OPENF%
	 ERJMP	METRRR
	MOVE	2,[444400,,MTRST]
	MOVNI	3,MTRLEN
	SOUT%
	CLOSF%
	 ERJMP	METRRR		;JSYS ERROR
	POPJ	PP,

METRRR:	HRROI	1,[ASCIZ/?JSYS error: /]
	PSOUT%
	MOVEI	1,.PRIOU
	HRLOI	2,.FHSLF
	SETZ	3,
	ERSTR%
	 JFCL
	 JFCL
	HRROI	1,[ASCIZ/ for METER file /]
	PSOUT%
	HRROI	1,METRNM
	PSOUT%
	HRROI	1,[ASCIZ/
/]
	PSOUT%
	POPJ	PP,
>;END IFN TOPS20

IFE TOPS20,<
;FIND A FREE CHANNEL, WRITE OUT THE FILE WITH DUMP MODE IO,
; RELEASE THE CHANNEL & POPJ

	PUSHJ	PP,GMCHAN	;GET A FREE CHANNEL TO USE
	 JRST	[OUTSTR	[ASCIZ/? No free channels to write METER file.
/]
		POPJ	PP,]	;JUST GIVE IT UP
	ANDI	AC5,17		;JUST SAVE CHANNEL NUMBER
	DPB	AC5,[POINT 4,AC5,12] ;SAVE IN AC FIELD OF AC5
	HLLZ	AC5,AC5		;FOR MAKING UUOS

;DO OPEN UUO
	MOVEI	AC1,.IODMP	;BINARY DUMP MODE
	MOVSI	AC2,'DSK'	; TO DEVICE "DSK"
	SETZ	AC3,		;NO BUFFER HEADERS
	MOVE	AC0,[OPEN AC1]
	OR	AC0,AC5		;READY TO DO IT
	XCT	AC0
	 JRST	GMOPNF		; ?OPEN UUO FAILED

;DO ENTER UUO
	HRRZ	AC1,METR.
	MOVE	AC1,MTRNM6(AC1)
	MOVSI	AC2,'DYN'
	SETZB	AC3,AC4
	MOVE	AC0,[ENTER AC1]
	OR	AC0,AC5
	XCT	AC0
	 JRST	GMENTF		; ?ENTER UUO FAILED

;DO OUT UUO
	MOVNI	AC1,METRLN
	HRLZ	AC1,AC1		;-NUMBER OF WORDS TO WRITE OUT,,0
	HRR	AC1,METR.	; GET RH= ADDRESS-1
	SUBI	AC1,1
	SETZ	AC2,
	MOVE	AC0,[OUT AC1]
	OR	AC0,AC5
	XCT	AC0
	 TRNA			;OK
	  JRST	GMOUTF		; ?OUT UUO FAILED

;DO RELEAS UUO
GMRELS:	MOVSI	AC0,(RELEAS 0,)
	OR	AC0,AC5
	XCT	AC0
	POPJ	PP,		;AND RETURN FROM THIS ROUTINE

GMOPNF:	OUTSTR	[ASCIZ/? OPEN failed for METER file.
/]
GMGIVU:	OUTSTR	[ASCIZ/% METER file not written.
/]
	JRST	GMRELS

GMENTF:	OUTSTR	[ASCIZ/? ENTER filed for METER file.
/]
	JRST	GMGIVU		;GIVE UP

GMOUTF:	OUTSTR	[ASCIZ/? OUT UUO failed for METER file.
/]
	JRST	GMGIVU		;GIVE UP

>;END IFE TOPS20
>;END IFN CSTATS
IFN LSTATS,<
	SUBTTL	LSTATS - I/O HISTOGRAM ROUTINE
;THE I/O HISTOGRAM ROUTINE
;CALL WITH THE BLOCK NUMBER TO BE READ IN MRBLKO
; THE CHANNEL NUMBER OF THE FILE IS AVAILABLE BY
;EXTRACTING IT FROM THE "INPUT UUO", WHICH IS ABOUT TO BE XCT'D.
;
;ALL ACS ARE SAVED
;
;  CALCULATE THE OVERHEAD TIME FOR METERING DISK USAGE
;BY SAVING THE TIME AT METERING BEGIN (IN LOCATION MRBLKO)
;AND THEN USING IT TO CALCULATE TIME SPENT IN METERING. THIS
;TIME IS ADDED TO ANY EXISTING LIBOL METER POINT START TIME
;(IN LOCATION MBTIM.) TO CANCEL OUT THIS OVERHEAD.

IOHSTR:	PUSH	PP,AC10		;SAVE AC10 AND AC11
	PUSH	PP,AC11
  IFN TOPS20,<
	DMOVE	AC10,AC1	;SAVE AC1 AND AC2 IN AC10 AND AC11
	MTRJS%			;GET FAST METER TIME IN AC1&AC2
	 ERJMP	.+2		;ERRORS SKIP
	DMOVEM	AC1,MRBLKO	;SAVE OVERHEAD START TIME
  >;END IFN TOPS20

  IFE TOPS20,<
	SETZB	AC10,AC11	;CLEAR AC10 AND AC11
	RUNTIME	AC10,		;GET FAST 10 TIME IN AC10
  >;END IFE TOPS20


;UPDATE MOST-RECENTLY USED TABLE OF FILE NUMBER AND PAGE NUMBER

	PUSH	PP,AC1		;SAVE ACS USED
	PUSH	PP,AC2
	PUSH	PP,AC3
	PUSH	PP,AC4

;IF AN OLD ENTRY IS IN THE TABLE, UPDATE HISTOGRAM.
; THE ENTRY WILL ALWAYS END UP AT THE BOTTOM OF THE TABLE (MOST
; RECENTLY USED).

	HRRZ	AC2,MRTDBP	;ADDRESS OF TRAILER BLOCK
	AOS	MB.HTC(AC2)	; REMEMBER ROUTINE WAS DONE ANOTHER TIME
	HRRZ	AC4,MRBNUM	;GET BLOCK NUMBER
IFN TOPS20, LSH AC4,-2		;(PAGE NUMBER IF TOPS20)
	LDB	AC3,[POINT 4,UIN.,12] ;GET CHANNEL NUMBER= FILE NUMBER
	HRL	AC4,AC3		;LH(AC4) = FILE #, RH (AC4)= BLOCK NUMBER

;LOOK FOR ENTRY IN THE TABLE, BOTTOM-UP.
; IF NOT FOUND, MOVE THE WHOLE TABLE UP WITH A BLT AND
; ADD IT TO THE BOTTOM.
;IF ENTRY IS ALREADY IN TABLE, MOVE UP ENTRIES BELOW IN
;(ERASING THE OLD ENTRY) AND PUT NEW ENTRY AT THE BOTTOM;
;THEN INCREMENT THE APPROPRIATE HISTOGRAM BUCKET.

	HRRZ	AC2,MRFPGT	;POINT TO THE TABLE
	MOVEI	AC3,MBHISL-1(AC2) ; AC3 POINTS TO LAST ENTRY
MRFLUP:	CAMN	AC4,(AC3)	; FOUND ENTRY?
	 JRST	MRFNDE		;YES, MOVE UP REST OF TABLE
	SUBI	AC3,1
	CAIL	AC3,(AC2)	;AT START OF TABLE YET?
	 JRST	MRFLUP		;NO, KEEP SEARCHING

;ENTRY WAS NOT IN TABLE. BLT UP WHOLE TABLE, AND PUT IT
; AT THE BOTTOM.

	MOVSI	AC1,1(AC2)	;ST+1
	HRRI	AC1,(AC2)	;ST
	ADDI	AC2,MBHISL-1	;POINT TO LAST ENTRY IN TABLE
	BLT	AC1,-1(AC2)	; MOVE UP TABLE, ERASE TOP ENTRY
	MOVEM	AC4,(AC2)	;STORE MOST RECENTLY USED ENTRY AT END
	JRST	NOHADD		; DONE--DON'T INCREMENT ANY HISTOGRAM BUCKETS

;ENTRY FOUND.. AC3 POINTS TO IT.  MOVE UP TABLE SUCH THAT IT ERASES
; THIS ENTRY BUT LEAVES THE ONES ABOVE IT IN PLACE, THEN ADD NEW
; ENTRY TO THE BOTTOM.  THE NET EFFECT IS TO HAVE THE SAME ENTRIES
; IN THE TABLE, BUT IN A DIFFERENT ORDER (MOST RECENTLY USED AT THE
; BOTTOM).

MRFNDE:	HRLI	AC1,1(AC3)	;FROM: THIS ENT+1
	HRRI	AC1,(AC3)	;TO:  THIS ENT
	BLT	AC1,MBHISL-2(AC2); BLT TO LAST ENTRY-1
	MOVEM	AC4,MBHISL-1(AC2) ;STORE THIS ENTRY AT END.

	HRRZ	AC4,MRTDBP	;POINT TO TRAILER BLOCK
	SUBI	AC2,-MBHISL+1(AC3); END - ENTRY = HISTOGRAM BUCKET TO AOS
	ADDI	AC4,MB.HTO(AC2)	; POINT TO THE HISTOGRAM BUCKET
	AOS	(AC4)		;INCREMENT IT
NOHADD:	POP	PP,AC4		;RESTORE ACS USED
	POP	PP,AC3
	POP	PP,AC2
	POP	PP,AC1
  IFN TOPS20,<
	MTRJS%			;GET FAST TIME IN AC1 AND AC2
	 ERJMP	RST111		;SKIP THE TIME CALC IF ERROR
	DSUB	AC1,MRBLKO	;SUB START TIME
	DADD	AC1,MRBKO.	;ADD IN FIXED OVERHEAD
	DADD	AC1,MBTIM.	;ADD TO METER POINT START TIME
	DMOVEM	AC1,MBTIM.	;RESTORE METER POINT START TIME
	DMOVE	AC1,AC10	;RESTORE AC1 AND AC2
  >;END IFN TOPS20

  IFE TOPS20,<
	RUNTIME	AC11,		;GET FAST 10 TIME IN AC11
	SUB	AC11,AC10	;SUB OUT START TIME
	ADD	AC11,MRBKO.	;ADD IN FIXED OVERHEAD TIME
	ADDM	AC11,MBTIM.	;UPDATE METER RPOINT START TIME
  >;END IFE TOPS20
RST111:	POP	PP,AC11		;RESTORE AC11 AND AC10
	POP	PP,AC10
	POPJ	PP,		;RETURN
;CLRFBT - ROUTINE TO CLEAR OUT ENTRIES OF THIS FILE IN THE
;FILE/BLOCK TABLE, BECAUSE WE ARE CLOSING THE FILE
;SAVES ALL ACS

CLRFBT:	PUSH	PP,AC1		;SAVE ACS USED
	PUSH	PP,AC2
	PUSH	PP,AC3
	HRRZ	AC1,MRFPGT	;POINT TO THE TABLE
	ADDI	AC1,MBHISL-1	;POINT TO LAST ENTRY
	LDB	AC2,DTCN.	;GET CHANNEL NUMBER= FILE NUMBER
CLRBFL:	HLRZ	AC3,(AC1)	;GET AN ENTRY
	CAMN	AC2,AC3		; SAME FILE NUMBER?
	 SETZM	(AC1)		;YES, DELETE IT
	CAME	AC1,MRFPGT	;REACHED TOP?
	 SOJA	AC1,CLRBFL	;NO, LOOP
	POP	PP,AC3
	POP	PP,AC2
	POP	PP,AC1
	POPJ	PP,		;RETURN
	SUBTTL	LSTATS - TIMING ROUTINES
;LMETR. IS THE ROUTINE THAT INCREMENTS THE LIBOL BUCKET NUMBER
;INDICATED AND SAVES THE ADDRESS OF THE TIME BUCKET TO BE 
;UPDATED.
;	ARGUEMENTS:	AC2=	BUCKET OFFSET WITHIN THE BUCKET BLK
;			AC1=	ADDRESS OF THE PROPER FILTAB
;
;	SETS:		MRTMB.	(THE ADDRESS OF THE TIME BUCKET)

LMETR.:	LDB	AC1,[POINT 4,D.CN(AC1),15]	;GET CHAN #
	ADD	AC2,MROPTT(AC1)	;ADD ADDRESS OF MTR BLK TO OFFSET 
	AOS	(AC2)		;INCREMENT BUCKET
	ADDI	AC2,1		;ADDRESS TIME BUCKET
	MOVEM	AC2,MRTMB.	;SAVE TIME BUCKET ADDRESS
	POPJ	PP,		;RETURN
;  MRACDP IS THE METER POINT ROUTINE FOR ACCEPT AND 
;DISPLAY. THESE METER BUCKETS ARE IN THE TRAILER BLOCK,
;SINCE THEY ARE IN NO WAY RELATED TO ANY PARTICULAR FILE.
;
;ARGUEMENT:	AC2=	THE OFFSET FOR THE BUCKET,RELATIVE TO
;			THE BASE OF THE TRAILER BLOCK
;USES:		AC1
;

MRACDP:	MRTMS.	(AC1)		;START METER TIMING
	ADD	AC2,MRTDBP	;ADD IN TRAILER BASE ADDRESS
	AOS	(AC2)		;INCREMENT BUCKET
	ADDI	AC2,1		;ADDRESS TIME BUCKET
	MOVEM	AC2,MRTMB.	;SAVE TIME BUCKET ADDRESS
	SETZ	AC2,		;CLEAR AC2,USED IN DISPLAY AS A FLAG
	POPJ	PP,		;RETURN


;MRTM.S AND MRTM.E ARE THE LIBOL METERING TIME ROUTINES.
;MRTM.S SETS THE START TIME .
;MRTM.E ENDS THE TIMING AND UPDATES THE TIME BUCKET
;INDICATED BY MRTMB.

IFN TOPS20,<

IFNDEF METER%,<	;IF METER% JSYS UNDEFINED, THIS IS BEFORE RELEASE 4

MRTM.S:	PUSH	PP,AC1	;SAVE AC1
	PUSH	PP,AC2	;SAVE AC2
	MTRJS%		;GET FAST CLOCK TIME IN AC1& AC2
	  ERJMP	.+2	;ERROR SKIP TIME SET
	DMOVEM	AC1,MBTIM. ;SAVE START TIME 
	POP	PP,AC2	;RESTORE AC2
	POP	PP,AC1	;RESTORE AC1
	POPJ	PP,	;RETURN

MRTM.E:	PUSH	PP,AC1	;SAVE AC1
	PUSH	PP,AC2	;SAVE AC2
	MTRJS%		;GET FAST CLOCK TIME IN AC1&AC2
	  ERJMP	.+4	;ERROR, SKIP TIME CALC
	DSUB	AC1,MBTIM. ;SUB START TIME
	ASHC	AC1,^D24 ;SHIFT TO SINGLE WORD
	ADDM	AC1,@MRTMB. ;ADD TO TIME BUCKET
	POP	PP,AC2	;RESTORE AC2
	POP	PP,AC1	;RESTORE AC1
	POPJ	PP,	;RETURN

>;END IFNDEF METER%
IFDEF METER%,<		;RELEASE 4 SYSTEM -- USE MONITOR JSYS

MRTM.S:	PUSH	PP,AC1	;SAVE 3 ACS
	PUSH	PP,AC2
	PUSH	PP,AC3
	MOVEI	AC1,.MEREA ;READ E-BOX TICKS
	METER%		;GET FAST CLOCK TIME IN AC2&AC3
	 ERJMP	.+2	;ERROR, SKIP TIME CALC
	DMOVEM	AC2,MBTIM. ;SAVE START TIME
	POP	PP,AC3
	POP	PP,AC2
	POP	PP,AC1
	POPJ	PP,

MRTM.E:	PUSH	PP,AC1
	PUSH	PP,AC2
	PUSH	PP,AC3
	MOVEI	AC1,.MEREA ;E-BOX TICKS
	METER%		;GET FAST CLOCK TIME IN AC2& AC3
	 ERJMP	.+4	;ERROR, SKIP TIME CALC
	DSUB	AC2,MBTIM.	;SUB START TIME
	ASHC	AC2,^D24 ;SHIFT TO SINGLE WORD
	ADDM	AC2,@MRTMB. ;ADD TO TIME BUCKET
	POP	PP,AC3	;RESTORE AC3
	POP	PP,AC2	;RESTORE AC2
	POP	PP,AC1	;RESTORE AC1
	POPJ	PP,	;RETURN
>;END IFDEF METER%

>;END IFN TOPS20
	SUBTTL	LSTATS - ROUTINES TO CALCULATE BUCKET OFFSETS
;BUCREC IS A ROUTINE TO CALCULATE THE BUCKET OFFSET FOR
;READ,WRT,ETC. GIVEN THE RECORD SIZE. THE BUCKETS ARE 
;ALLOCATED FOR SIZES 72,80,132 (CHARS) ,128 AND 512 (WORDS)
;AND THE SPACES IN BETWEEN THEM.
;	
;	ARGUMENTS:	AC1=	REC SIZE IN CHARS
;
;	RETURNS:	AC2=	BUCKET OFFSET
;
;	AC1 IS NOT PRESERVED.

BUCREC:	SETZ	AC2,		;CLEAR OFFSET
	CAILE	AC1,^D132	;.LE. 132?
	JRST	BUCRE2		;NO,TEST WORD LENGTHS
	CAIE	AC1,^D132	;
	JRST	BUCRE0		;.LT.132
	ADDI	AC2,5		;= 132, OFFSET=5
	JRST	BUCREX		;EXIT
BUCRE0:	CAIGE	AC1,^D80	;
	JRST	BUCRE1		;.LT. 80
	CAIE	AC1,^D80	;
	ADDI	AC2,1		;.GT. 80, OFFSET=4
	ADDI	AC2,3		;= 80, OFFSET=3
	JRST	BUCREX		;EXIT
BUCRE1:	CAILE	AC1,^D72	;
	AOJA	AC2,.+2		;.GT.72&.LT.80, OFFSET=2
	CAIL	AC1,^D72	;
	ADDI	AC2,1		;= 72, OFFSET=1
	JRST	BUCREX		;.LT. 72, OFFSET=0
BUCRE2:	MOVE	AC2,D.BPW(I16)	;GET BYTES PER WORD
	IDIV	AC1,AC2		;CALC WDS PER REC
	JUMPE	AC2,.+2		;SKIP IF NO REMAINDER
	ADDI	AC1,1		;ROUND UP
	SETZ	AC2,		;CLEAR THE OFFSET
	CAILE	AC1,^D128	;
	JRST	BUCRE3		;.GT.128 WORDS
	CAIL	AC1,^D128	;
	ADDI	AC2,1		;=128 WORDS, OFFSET=7
	ADDI	AC2,6		;.LT.128 WORDS, OFFSET=6
	JRST	BUCREX		;EXIT
BUCRE3:	CAILE	AC1,^D512	;
	AOJA	AC2,.+2		;.GT.512 WORDS, OFFSET=10
	CAIL	AC1,^D512	;
	ADDI	AC2,1		;=512 WORDS, OFFSET=9
	ADDI	AC2,^D8		;.LT.512 WORDS, OFFSET=8
BUCREX:	LSH	AC2,1		;MULTIPLY BY 2,ALLOWING FOR TIME BKTS
	POPJ	PP,		;RETURN

>;END IFN LSTATS





C.END:	END