Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/cblio.mac
There are 23 other files named cblio.mac in the archive. Click here to see a list.
;IGUANA:<8X-COBOL.EDITED>CBLIO.MAC.28, 20-Mar-89 14:52:05, Edit by KSTEVENS
;IGUANA:<8X-COBOL.EDITED>CBLIO.MAC.27, 20-Mar-89 14:11:02, Edit by KSTEVENS
; UPD ID= 1620 on 5/22/84 at 9:19 AM by HOFFMAN

TITLE CBLIO for COBOL OTS version 13

	SEARCH COPYRT
	SALL

COPYRIGHT (C) 1974, 1986 BY DIGITAL EQUIPMENT CORPORATION


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

;EDITS
;NAME	DATE	  COMMENTS
;V13************
;RLF	06-JUL-90 [1207] If ISAM file is ASCII but key is unsigned, make
;			 it work the same way as non-numeric.
;KWS	25-APR-88 [1202] To generate appropriate error message when byte count
;		         to index file is set to zero in the middle of the
;			 program.
;KWS	27-JAN-88 [1201] Fix edit 1166.
;RLF	04-FEB-87 [1176] Reverse part of 1137 so BLT won't trash
;			 location for name string
;RLF	14-OCT-86 [1171] Don't output CRLF before first ASCII record
;RLF	08-OCT-86 [1167] Flag WANT8. was not checked correctly
;MEM	01-OCT-86 [1166] PDL size is off by 20
;RLF	30-SEP-86 [1165] COMPT. UUO failed because DF.DEV is corrupted
;RLF	03-SEP-86 [1164] Buffer is cleared if OPEN EXTEND with SAME AREA
;KWS	18-NOV-85 [1152] Make sure that the channel number is set up correctly
;			 when using Declaratives...
;MJC	03-SEP-85 [1151] Clear dump mode IOWD in RH of UOUT. on invalid key
;KWS	01-JUL-85 [1147] Fix problem with catching "File being modified" error.
;JSM	22-APR-85 [1143] Change where progs. fail if missing ISAM files
;MJC	28-MAR-85 [1141] Search 9 char VALUE OF ID for a separator before
;				assuming it is the old style.
;BCM	27-Mar-85 [1140] Make PA1050 allocate buffers in prealloc area.
;KWS	28-MAR-85 [1137] Fix the lookup of overlay files.
;MJC	03-JAN-85 [1133] Make file-not-found create on the right device
;KWS	15-OCT-84 [1131] Fix OPEN I-O FILENAME. so it doesn't do SMU.
;KWS	12-SEP-84 [1130] Add conversion factor for reading sequential i-o.
;JEH	22-MAY-84 [1126] New feature test switch and code to print blank
;				ascii text lines
;JSM	14-MAY-84 [1125] Test on 'RPTW.' before generating +2 return from
;			  WADV. to Report Writer routine
;JEH	10-MAY-84 [1121] READ NEXT after 2 REWRITES fails, flags reset at
;			  wrong time
;JBB	27-APR-84 [1120] Don't get a channel number when opening a file
;			 assigned to LPT:
;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.
SUBTTL	PICK UP UNIVERSALS AND SET UP JOBDAT.

	SEARCH	LBLPRM,COBVER		;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
	SEARCH COMUNI
	%%COMU==:%%COMU
	INFIX%
	SEARCH	FTDEFS			;FILE-TABLE DEFINITIONS
	%%FTDF==:%%FTDF

	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	ISTKS,<ISTKS==0>	;TYPE  # OF IN'S AND OUT'S



DEFINE SAVACS,<
	MOVEM	0,RACS
	MOVE	0,[1,,RACS+1]
	BLT	0,RACS+17
>

DEFINE RSTACS,<
	MOVE	0,[RACS+1,,1]
	BLT	0,17
	MOVE	0,RACS
>
	HISEG
	SALL
	MLON
SUBTTL CONSTANTS

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

	; USE PROCEDURE TABLE OFFSET VALUES

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



	;[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
CMP.13==13	;OPEN EXTEND
>

	;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		;[1104] BYTE COUNT WORD IN FILE'S FDB

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

;BITS 0 THROUGH 3 ARE SET BY THE COMPILER (SEE FTDEFS)
;BITS 4 & 5 ARE USED FOR LABEL PROCESSING

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
FOPERR==2	; FILOP.UUO FAILED
RIVK==1		;READ, RERIT OR DELET INVALID-KEY
EIX==1		;ENTER OF NAME.IDX IN PROGRESS

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

IFE TOPS20,<
F1CLR==37777	; THESE FLG1 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


KEYSIZ==7777	; MASK TO GET KEY SIZE FIELD OF ISAM KEY DESCRIPTOR
SUBTTL	EXTERNALS.


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

INTERN GDPSK	;[447]SIMULTANEOUS UPDATE
INTERN	CHTAB	;[455] SIMULTANEOUS UPDATE
INTERN	SEQFIL	;[455] SIMULTANEOUS UPDATE
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	C.STRT,RDNXT.
INTERN	DELET.,RERIT.,PURGE.
INTERN USOBJ,LVTST,LV2SK.,FOPIDX,NNTRY
INTERN	LIBVR.,LIBSW.
INTERN	CNTRY			;[650] MAKE INTERNAL FOR LSU

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.
EXTERNAL 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.,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 CMPTER		;HOLD ERROR CODE FROM RETURN FROM COMPT. UUO
EXTERNAL MOVE.,PD6.,PD7.,C.D6D7,C.D7D6
EXTERNAL PD9.,C.D9D6,C.D9D7,C.D6D9,C.D7D9

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

EXTERNAL RELEN.		;[332]
EXTERN DATE.,DATE1.
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,SU.RR ;[1162]SIMULTANEOUS UPDATE
EXTERN	FOP.BK,FOP.IS,FOP.DN,FOP.LB		;SIMULTANEOUS UPDATE
EXTERN	SU.FRF			;FAKE READ FLAG
				; NEXT RECORD BY KEY DURING READ OF
				; RELATIVE FILE.
EXTERN	.JBSA,.JBFF,.JBREL,.JBAPR,.JBTPC,.JBCNI,.JBDA,.JBOPC,.JBREN
EXTERNAL RET.1,RET.2,RET.3
EXTERNAL HLOVL.			;[346] XWD	HIGHEST OVERLAY LOC , LOWEST LOC
EXTERNAL GD6.,GD7.,GD9.,GC3.,PD6.,PD7.,PD9.,PC3.,KEYCV.	;[370]

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

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

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

	$COPYRIGHT		;Put standard copyright statement in EXE file
LIBVR.:	EXP	LBLVER		;OTS VERSION NUMBER
LIBSW.:	EXP	SWSET%		;OTS 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.
IFE TOPS20,<
	RUNTIM	AC1,		;[346]GET THE RUNTIME.
>
IFN TOPS20,<
	MOVNI	AC1,5		;GET RUNTIME FOR THIS JOB
	RUNTM%			;IN MILLISECS
>
	MOVEM	AC1,RUN.TM	;[346]SAVE IT.
	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%##

	HRRZ	AC10,(AC14)	;GET THE PROGRAM'S ENTRY POINT.
	HRRZ	AC10,1(AC10)	;GET THE ADDRESS OF %FILES.
	MOVN	PP,%PUSHL(AC10) ;GET THE PDL SIZE.
	HRL	PP,.JBFF	;START-LOC,,-LENGTH
	MOVSS	PP,PP		;POINTER IS SET UP.


;[1201]set .jbff to 20 above stack end to allow expansion on pdlov

	ADDI	AC10,20		;[1166]LENGTH+20
	ADDB	AC10,.JBFF	;ADJUST .JBFF
IFN TOPS20,<
	ADDI	AC10,200	;MAKE SURE THERE IS ENOUGH ROOM FOR .EXE SPEC
>
	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.

RESET2:
IFN TOPS20,<
;Store text string to file spec of .EXE file.
;This is used to re-initialize data in INITIAL programs.

	HRRZ	AC1,JSARR.	;GET A PAGE # (ORIGINAL START ADDRESS)
	LSH	AC1,-9
	HRLI	AC1,.FHSLF
RSET2A:	RPACS%			;FIND OUT ABOUT IT
	  ERJMP	RSET2B		;GIVE UP
	TXNN	AC2,PA%PEX	;IF PAGE DOESN'T EXIST
	JRST	RSET2B		;GIVE UP
	TXNE	AC2,PA%PRV	;IF PRIVATE PAGE
	AOJA	AC1,RSET2A	;TRY NEXT ONE
	RMAP%			;GET JFN
	  ERJMP	RSET2B		;ERROR
	HLRZ	AC2,AC1		;JFN
	HRRO	AC1,.JBFF	;WHERE TO STORE STRING
	MOVX	AC3,<<FLD .JSAOF,JS%DEV>!<FLD .JSAOF,JS%DIR>!<FLD .JSAOF,JS%NAM>!<FLD .JSAOF,JS%TYP>!<FLD .JSAOF,JS%GEN>!JS%PAF>	;[1137]
	JFNS%			;GET STRING
	  ERJMP	RSET2B		;ERROR
	HRRZI	AC1,1(AC1)	;GET NEXT FREE LOC
	EXCH	AC1,.JBFF	;AND UPDATE IT
	HRROM	AC1,EXJFN.##	;STORE PTR TO TEXT
RSET2B:>
	;SET FLAGS TO TRAP ON
	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
	SKIPE	RMFLG.##	;SKIP IF RMS NOT USED
	 PUSHJ	PP,RMSGET##	; ** GO GET RMS **
	SETOM	INRST.##	;[530] SET END OF RESET FLAG
	MOVE	AC10,COBSW.	;GET COMPILER ASSEMBLY SWITCHES
	TXNE	AC10,SW.STB	;WANT TO SUPPRESS TRAILING BLANKS
	SETOM	SUPTB.##	;YES, SAVE FOR LATER TESTS
IFLE ANS82,<
	SETZM	WANT8.##	;DEFAULT TO ANS-74
	TXNE	AC10,SW.A82	;DO WE WANT ANS-8x?
	SETOM	WANT8.		;YES
>
IFG ANS82,<
	SETOM	WANT8.##	;DEFAULT TO ANS-8x
	TXNE	AC10,SW.A74	;DO WE WANT ANS-74?
	SETZM	WANT8.		;YES
>
	HRRZS	AC10		;ONLY FEATURE TESTS WE CARE ABOUT
	HRRZ	AC3,LIBSW.	;GET OTS ASSEMBLY-TIME 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.
	CAIGE	AC10,7		;TEST FOR 7.00 SERIES MONITOR
	JRST	[OUTSTR	[ASCIZ	/?COBOL requires 7.01 or later.
/]
		EXIT]
>
IFE TOPS20,<
	HRROI	AC1,.GTPRG	;MONITOR TABLE FOR PROGRAM NAME
	GETTAB	AC1,
	  MOVE	AC1,RN.NAM	;USE PROGRAM NAME INSTEAD
>
IFN TOPS20,<
	GETNM%			;GET PROGRAM NAME
>
	MOVEM	AC1,DF.PRG##	;SAVE AS DEFAULT FILE NAME
IFN TOPS20,<
	SETZM	DF.NAM##	;CREATE ASCIZ DEFAULT FILE NAME
	SETZM	DF.NAM+1
	SKIPN	AC2,AC1		;GIVE UP IF ZERO
	JRST	RESET4
	MOVE	AC3,[POINT 7,DF.NAM]
RESET3:	SETZ	AC1,
	LSHC	AC1,6		;GET NEXT CHAR
	ADDI	AC1,40		;CONVERT TO ASCII
	IDPB	AC1,AC3
	JUMPN	AC2,RESET3
RESET4:>
IFN DBMS,<
	MOVE	AC1,[JRST FUNCT.##]	; put FUNCT. entry vector
	MOVEM	AC1,@[.JBBLT.+2]	;   where DBCS can get at it
> ; end IFN DBMS
	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:	LDB	AC5,[POINT 4,UFRST.,12]	; GET CHAN FROM UUO
	DPB	AC5,DTCN.	;SAVE IT
	MOVE	FLG,F.WFLG(I16)	;GET THE FLAGS
	TXNE	FLG,B%RER!B%RRC	;RERUNING?
	SETOM	TEMP.2		;YES, REMEMBER TO TURN OFF CHAN 17
	HRLOI	AC15,4077	;[316] #OF DEVICES,,LOC OF FIRST ONE
	AND	AC15,F.WDNM(I16)	;
	TXZE	AC15,B%BLA	;IS BUFFER LOCATION ASSIGNED?
	JRST	RSTNFL		; [377A] YES-NEXT FILE
	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
	MOVX	AC15,B%BLA	; 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
	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
	TXZ	AC6,B%STL	;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
	SETZM	CMPTER##	;ZERO OUT ERROR WORD
	COMPT.	AC1,		;GET JFN *************
	 SKIPA			;ERROR
	JRST	RET.2		; OK, RETURN

	MOVEM	AC1,CMPTER	;SAVE ASIDE UUO ERROR CODE
	  POPJ	PP,		; ERROR 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

	HRRM	AC1,D.JFN(I16)	;STORE JFN
	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:	MOVEI	AC2,INDASC	; SET STANDARD ASCII FLAG
	IORM	AC2,D.RFLG(I16)
	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:	MOVEI	AC3,SASCII	; SET STD-ASCII BIT
	IORM	AC3,D.RFLG(I16)	; 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
	SKIPN	AC6		;IF ZERO
	MOVEI	AC6,DFLTBF	;USE DEFAULT
	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 BUFFER AREA
IFN TOPS20,<
	HRLZM	AC12,D.FBS(I16)	;SAVE IT FOR NATIVE I/O
>
RSTDE3:	CAML	AC12,TEMP.
	MOVEM	AC12,TEMP.	;SAVE SIZE OF LARGER
			;LOOP AGAIN
RSTLOO:
	TLNN	FLG,IDXFIL
	AOBJN	AC13,RSTDEV	;JUMP IF MORE DEV/FILTAB
RSTLO1:	MOVX	AC15,B%BLA	;[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

	;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
	TXNN	AC6,B%STL	;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:	TXNN	AC6,B%STL	; LABELS STANDARD?
	JRST	RSTDE8		;NO - MUST BE OMITTED
	CAIGE	AC10,^D20+4	;
	MOVEI	AC10,^D20+4	;LABEL RECORD IS THE LARGEST RECORD

RSTDE8:	MOVEI	AC1,-3(AC10)	;
	HRRM	AC1,D.LRS(I16)	;SAVE IT FOR OPNNSB
	LDB	AC12,F.BNAB	;NUMBER OF BUFFERS
	SKIPN	AC12		; SKIP IF NOT ZERO RESERVED
	MOVEI	AC12,DFLTBF	; 0 MEANS DEFAULT NUMBER
	IMULI	AC10,(I12)	; NO, REC TIMES NUMBER OF 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
	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
;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 3,F.WFLG(AC12),17]; [377A] GET ACCESS MODE
	CAIE	AC0,4		; [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
	MOVE	AC13,AC3	;SETUP AC13 FOR DEVICE TESTS IN OCPT BELOW
	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,OPNX9 ;[1143] INVALID SMU ACCESS
			JRST RSTID1 ;[1143] IF FNF,GO SET FLAG AND LET USER GO TO OPEN
		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
		SETZM	CMPTER##	;
		COMPT.	AC1,		;OPEN FILE IN FROZEN MODE
		 JRST	[MOVEM AC1,CMPTER	;SAVE ASIDE ERR CODE
			 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:	POP	PP,AC1		;[1143] GET BACK TO RIGHT PLACE ON STACK
	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 ;[1143] ACTUALLY RESTORES
				;.JBFF FROM 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
;	CAMLE	AC2,AC6		;[535] [515] IF NOT LESS OR EQUAL ERROR
	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
	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:	MOVEI	AC4,12		; (1+1)*5
	TRNN	AC6,1		; ODD = 1, EVEN = 2
	MOVEI	AC4,17		; (2+1)*5

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

	; 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

;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
	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 = SIXBIT /FILE NAME/		FOR TOPS-10
;	 OVRFN. = POINT 7,[ASCIZ /FILE NAME/]	FOR TOPS-20

SETOVR:
IFN TOPS20,<
				; FIRST WE HAVE TO FIND THE NAME OF THE OVERLAY FILE
				; WE HAVE THE FILE SPEC OF THE EXE IN EXJFN.
				; GET A JFN ON THE EXE AND THEN GET BACK THE PARTS WE WANT
	MOVX	AC1,GJ%OLD!GJ%SHT
	SKIPN	AC2,EXJFN.
	JRST	SETOV0		;NOT SETUP, USE MAIN PROGRAM NAME
	GTJFN%
	  JRST	SETOV4		;ERROR
	MOVE	AC2,AC1		;JFN
	HRRO	AC1,.JBFF	;WHERE TO STORE STRING
	ADDI	AC1,.GJF2	;LEAVE SPACE FOR ARG BLOCK
	MOVX	AC3,<<FLD .JSAOF,JS%DEV>!<FLD .JSAOF,JS%DIR>!JS%PAF>	;[1137]
	JFNS%			;GET STRING
	  ERJMP	SETOV4		;ERROR
	HRRZ	AC1,AC2		;JFN
	RLJFN%
	  JFCL
SETOV0:	HRRZ	AC3,.JBFF
	MOVEM	AC3,OVRIX.	;WHERE INDEX BLOCK WILL BE
	MOVSI	AC1,OVRBLK
	HRR	AC1,AC3		;BLT WORD
	BLT	AC1,.GJJFN(AC3)	;[1176]
	MOVE	AC1,OVRFN.	;GET BYTE POINTER
	MOVEM	AC1,.GJNAM(AC3)	;STORE NAME POINTER
	HRRZ	AC1,AC3		;OVRBLK
	HRROI	AC2,.GJF2(AC3)	;STRING
	GTJFN%
	  JRST	SETOV4		;ERROR
	MOVEM	AC1,OVRJFN##	;STORE JFN
	MOVX	AC2,OF%RD	;READ 36 BITS
	OPENF%
	  JRST	SETOV4		;ERROR
	ADDI	AC3,400
	HRLI	AC3,(POINT 36,)	;FORM INITIAL BYTE POINTER
	MOVEM	AC3,OVRBF.	;WHERE DATA BUFFER IS
	MOVEI	AC0,1000
	PUSHJ	PP,GETSPC	;MAKE SURE WE ALLOCATE SPACE
	  JRST	GETSPK		;FAILED
	HRRZ	AC2,OVRIX.
	HRLI	AC2,(POINT 36,)
	MOVNI	AC3,400
	SIN%
	  ERJMP	SETOV6
	POPJ	PP,
OVRBLK:	GJ%OLD
	.NULIO,,.NULIO
	EXP	0,0,0
	POINT	7,[ASCIZ /OVR/]
	EXP	0,0,0		;[1176]

SETOV4:	HRROI	AC1,[ASCIZ /Cannot find overlay file./]
	PSOUT%
	JRST	KILL

SETOV6:	HRROI	AC1,[ASCIZ /Input error on overlay file./]
	PSOUT%
	JRST	KILL
>

IFE TOPS20,<
	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
>
;TRAP INTERUPT ROUTINE

TRAP.:
IFE TOPS20,<
	PORTAL	.+1		; SET EXECUTE ONLY ENTRY POINT
>
	SKIPE	INTRP.##	;ARE WE ALREADY IN A TRAP?
	 EXIT			;YES, JUST QUIT
	SETOM	INTRP.		;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.:	OUTSTR	[ASCIZ "?LBLADP Attempt to drop off end of program."]
	JRST	KILL.

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

ILLC.:	OUTSTR	[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.:
	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
	MOVE	AC13,D.DC(I16)		;[1033] [444] GET DEV CHARACTERISTICS
	TLNE	FLG,OPNOUT		;[622] [444] OPEN FOR OUTPUT
	TLNE	FLG,OPNIN		;[622] [444] YES, OPEN FOR OUTPUT ONLY
	TRNA				;[1033] SKIP IF INPUT FILE
	JRST	KILL1A			;[1033] JUMP IF OUTPUT ONLY
	TXNE	AC13,DV.MTA		;[1033] MAG TAPE?
	JRST	KILL2A			;[1033] YES, DO ABORT CLOSE
	JRST	KILL4			;[444] NO, CHECK NEXT ONE

KILL1A:	TXNN	AC13,DV.DSK		;[1033] [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
	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:	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 DBMS,<
	SKIPE	DBMLOK##	;IF A DBMS PROGRAM
	PUSHJ	PP,@DBSTP.##	; DO DBMS CLEANUP
>
	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
	OUTSTR	[ASCIZ /
COBOL /]
	MOVE	AC12,COBVR.	;GET COBOL VERSION NUMBER
	PUSHJ	PP,VEROU0	;TYPE VERSION NUMBER IN STANDARD FORMAT
	OUTSTR	[ASCIZ /, COBOTS /]
	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
>
	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.
;;;;;
;
; IN ITS CALCULATIONS FOR CORE ALLOCATIONS FOR SMU OPTION 1, THIS ROUTINE
; USES AS INPUT THE VALUES PUT IN THE FIELDS %SURRT, %SUEQT, AND %SUFBT
; BY THE COMPILER. THESE VALUES ARE SUPPOSED TO REPRESENT THE LARGEST
; SIZES REQUIRED FOR THE RETAINED RECORDS TABLE, THE ENQ TABLE AND THE
; FILL-FLUSH BUFFER TABLE. IT IS SUPPOSED TO CALCULATE THE THREE VALUES
; FOR THE SIZES OF THESE AREAS SEPARATELY. HOWEVER, THEY SOMEHOW GET MASHED
; INTO THE SIZE OF THE ENQ TABLE. NOT DESIRING TO CHANGE THE ALGORITHM
; DRASTICALLY, I HAVE MADE THE ASSUMPTION THAT 5 TIMES THE SIZE GIVEN
; IN %SUEQT IS SUFFICIENT BECAUSE 4 TIMES WAS SUFFICIENT WITH SMU OPTION 1
; WITH NON-RMS FILES. SINCE I ADDED A FIFTH OPEN-TIME LOCK FOR RMS FILES
; THE FACTOR NOW BECOMES 5. THIS NUMBER IS TOO BIG, BUT IT WOULD BE
; DIFFICULT TO TRIM WITHOUT INTRODUCING SEVERE PROBLEMS WITHOUT TOTALLY
; RE-DOING THE ALGORITHM. SEE THE HEADER OF THE ROUTINE SUSPC1: FOR A
; LITTLE MORE INFORMATION ON THE PARAMETERS.
;
;;;;;

	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,5		;[537];NOTE: ONLY RMS FILES HAVE UP TO 5 LOCKS AT OPEN TIME
				; AND THE OTHERS HAVE ONLY UP TO 4, BUT WE AREN'T GOING
				; TO GO THRU THE FILE TABLES NOW AT RESET TIME JUST TO SAVE A
				; MEAGER FEW WORDS OF CORE.
	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	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
;AC4=		;BLANK COUNTER (TO SUPPRESS TRAILING BLANKS)
;AC12		;MUST NOT BE USED

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

DSPLY.:	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.	;	.
	JRST	OUTBF.		;OUTPUT BUFFER 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:	JRST	OUTBF.		; OUTPUT BUFFER AND EXIT
;HERE FOR DISPLAY OF SIXBIT DATA

DSPL.6:	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:	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
	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:	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
	MOVEI	AC0,AFTADV!RDLAST	;RESET SO BFR-ADV WILL NOT WRITE 'CR' FIRST
	ANDCAM	AC0,D.RFLG(I16)	; AND MAKE SURE VALID READ LAST VERB IS OFF
	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	FLG,OPNOUT	;JUMP IF OUTPUT
	 JRST	OPNSBA		; OUTPUT FILES ARE NOT OPTIONAL
	TXNE	FLG1,B%OPTF	;IS FILE OPTIONAL?
	JRST	OPNOP		;YES. RETURNS ONLY IF PRESENT
OPNSBA:	PUSHJ	PP,DEVIOW	;RESET THE DEVICE IOWD
	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,[<F%BRMS>&<777760,,-1>+<Z (AC4)>] ;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,FE%12	;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,FE%30	;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,FE%31	;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
;ATTEMPT TO OPEN FILE WHICH WAS SELECTED AS OPTIONAL

OPNOP:
	PUSHJ	PP,OPNSBA	;ATTEMPT TO OPEN THE FILE THE USUAL WAY
	SKIPN	CMPTER##	;CHECK FOR ERROR - ONLY AN 05 WILL COME BACK HERE
	 POPJ	PP,		; NONE FOUND
	PUSHJ	PP,$SIGN	;[277] OUTPUT "$" FOR .OPERATOR
	OUTSTR	[ASCIZ /Optional/] ;OPTIONAL FILE FOUND NOT TO BE PRESENT
	PUSHJ	PP,MSFIL.
	OUTSTR	[ASCIZ / is not present. Proceed? ... /]
	PUSHJ	PP,YES.NO	;SKIP RETURN IF "NO" ANSWER
	 SKIPA			;USER WANTS TO CONTINUE
	  PUSHJ	PP,KILL		;DOESN'T WANT TO CONTINUE
	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************

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)	;
	TLNE	FLG,IDXFIL	;IF INDEX FILE
	AOBJP	AC0,.+1		;  POINT AT DATA DEVICE
	MOVEM	AC0,D.ICD(I16)	;
	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
	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
	MOVEM	AC13,D.DC(I16)	;[330] SAVE THE CHARACTERISTICS
	JUMPE	AC13,OPNDE9	;NOT A DEVICE
	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,FE%14	;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,FE%55	; 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:	MOVEI	AC0,EXTOPN	; YES, SET OPEN WAS EXTEND
	IORM	AC0,D.RFLG(I16)
	TXNE	AC13,DV.MTA	;MTA?
	TXZ	FLG1,B%STL	;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,FE%16	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

OPNDE7:	TXNE	AC13,DV.DSK	;SKIP IF DEVICE IS NOT A DSK
	JRST	OPNCHN		;FIND A FREE CHANNEL
	MOVEI	AC0,FS%37	;8x FILE STATUS CODE
	MOVEM	AC0,FS.FS	;
	MOVEI	AC0,FE%15	;ERROR NUMBER
	MOVE	AC2,[BYTE (5)10,2,4,20,17]
	JRST	OXITER		;

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,FE%17	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

OPNDE9:	MOVE	AC2,[BYTE (5)10,2,4,20,13]	;FCBO,DINAD.
	MOVEI	AC0,FE%18	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN
	;FIND A FREE DEVICE CHANNEL AND SETUP THE BUFFERS
	;XCT OPEN, INBUF AND/OR OUTBUF  ***OPNBSI***

OPNCHN:
IFN TOPS20,<
	TXNE	AC13,DV.LPT	;[1120] SIMPLE OUTPUT DEVICE
	JRST	OPCH1A		;[1120] YES, DON'T GET CHANNEL NUMBER
>
	PUSHJ	PP,GCHAN	;LOAD AC5 WITH A CHANNEL NUMBER
	DPB	AC5,DTCN.	;SAVE IT
	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
OPCH1A:	TLNE	FLG,DDMASC	;[1120] 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
	TLNN	FLG,IDXFIL	;ISAM ?
	JRST	OPNCH3		;NO
	MOVE	AC1,F.WDNM(I16)	;ADR
	MOVE	AC1,(AC1)	;IDX DEVICE NAME
	MOVEM	AC1,UOBLK.+1	;

OPNCH3:	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	OPNCH4		;NO
	TXNE	AC13,DV.MTA	; DOING MAG-TAPE OPEN?
	TXNN	AC16,OPN%NR	;AND NO-REWIND BIT SET?
	JRST	OPNCH4		;NO
	MOVEI	AC0,FS%07	;YES GIVE FS = 7
	MOVEM	AC0,FS.FS	;
	MOVEI	AC0,FE%58	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;GO SET UP FS REPORT
	 TRN			; IGNORE ERROR RETURN

OPNCH4:	SKIPE	AC1,F.PADD(I16)	; DO WE NEED TO SET UP PADDING CHAR?
	PUSHJ	PP,SETPAD	; YES
	TXNE	AC16,OPN%EX	;OPEN EXTENDED?
	JRST	OPNC3A		; YES

IFN TOPS20,<
	TXNE	AC13,DV.MTA	;[1066] IF ITS NOT AN MTA
	TLNE	FLG1,MSTNDR	;[1066]  OR MONITOR IS LABELING
	JRST	OPNC3C		;[1066]  OPEN VIA COMPT. UUO
	JRST	OPNC31		;[1066] OTHERWISE OPEN VIA FILOP.
>
IFE TOPS20,<
	SKIPN	F.WSMU(I16)	; SKIP IF SIMULTANEOUS UPDATE
	 JRST	OPNC31		; NO, CONT
	JRST	OPNC3A		; OPEN VIA FILOP
>
IFN TOPS20,<
OPNC3C:	PUSHJ	PP,OCPT		; [431] OPEN FILE VIA DEC-SYS-20 COMPT.
	  TRNA			;ERROR, CHECK FOR FNF
	JRST	OPNC41		; CONT NORMALLY, ALL OK

	TLNE	FLG,IDXFIL	;IS IT AN ISAM FILE
	JRST	OCPER		;YES, GIVE THE ERROR
	TLC	FLG,OPNIN!OPNOUT
	TLCE	FLG,OPNIN!OPNOUT	;IF OPEN I/O
	TXNN	AC16,OPN%EX	;OR OPEN EXTEND
IFG ANS82,<
	SKIPL	WANT8.		;[1167] ITS OK, CREATE NON-EXISTENT FILE IF ANS-82 DEFAULT
>
	JRST	OCPER		; OTHERWISE GIVE FNF 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:	HRRZI	AC1,GJ.BLK	;[1133]DO FILE CREATE OPEN (LONG FORM)
	MOVEM	AC1,CP.BK1
	SETZM	GJ.BLK		;[1133] TURN OFF GJ%OLD
	MOVE	AC1,[10,,CP.BLK]
	TXNE	AC16,OPN%EX	;IF OPEN EXTEND
	HRLI	AC1,11		; ARG BLOCK HAS ONE MORE WORD
	SETZM	CMPTER##	;
;**;[1140] At OPNFNF+6L
	TXNN	AC16,OPN%EX	;[1140] IF OPEN EXTEND
	  JRST	UNXTND		;[1140] ELSE SKIP
	PUSH	PP,.JBFF	;[1140] SAVE .JBFF
	HLRZ	AC11,D.BL(I16)	;[1140] PNT TO BUFFER LOCATION
	MOVEM	AC11,.JBFF	;[1140] SO PA1050 STARTS THERE
UNXTND:	COMPT.	AC1,		;DO IT
	  TDZA	AC11,AC11	;[1140] CLEAR FOR FAILURE
	SETOI	AC11,		;[1140] ELSE WE SUCCEED
	TXNE	AC16,OPN%EX	;[1140] OPEN EXTEND?
	  POP	PP,.JBFF	;[1140] YES, RESTORE END-OF-CORE PNTR
	SKIPN	AC11		;[1140] SKIP FOR SUCCESS
	 JRST	[MOVEM	AC1,CMPTER	;SAVE ASIDE UUO ERROR CODE
		 JRST	OCPER]		;FAILED AGAIN, SCREW IT
	TLNE	FLG1,FOPIDX	; IF AN ISAM.IDX FILE GET CHAN #
	SKIPA	AC2,ICHAN(I12)	;   FROM HERE
	LDB	AC2,DTCN.	; ELSE FROM HERE
	PUSHJ	PP,GETJFN	; GET THE JFN
	  SETZ	AC1,		; FAILED, CANNOT HAPPEN
	HRRM	AC1,D.JFN(I16)	; STORE JFN
	JRST	OPNC41		;GOOD CONTINUE WITH NEW FILE
>;END IFN TOPS20

OPNC3A:
IFN TOPS20,<
	TXNE	AC13,DV.MTA	; IF MTA STILL USE FILOP
	JRST	OPNC3B
	LDB	AC1,F.BNAB	;GET NUMBER OF BUFFERS WANTED
	SKIPN	AC1		;ZERO MEANS
	MOVEI	AC1,DFLTBF	; USE DEFAULT NO.
	HRLZM	AC1,CP.BK8	;STORE NO. OF BUFFERS
	JRST	OPNC3C		;USE, NEW COMPT. FUNCTION
OPNC3B:>
	PUSHJ	PP,OPNFOP	; [431] YES OPEN FILE VIA FILOP
	 JRST	OFERRI		; [576] [431] ERROR RETURN
	JRST	OPNC41		; CONT NORMALLY
OPNC31:
IFE TOPS20,<
	TXNN	AC13,DV.MTA	; SKIP IF A MTA
	JRST	OPC31X		; JUMP IF NOT MTA

	; 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:	TXZ	FLG1,B%STL	; 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:	MOVX	AC0,E.MTAP+FE%54 ; 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
;FOR TOPS-20 MTA DEVICES ONLY - ALL OTHERS USE COMPT. UUO OR NATIVE MODE
; AND REJOIN AT OPNC41.

	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 BUFFERS (FOR INBUF X,(AC6))
	SKIPN	AC6		;ZERO MEANS
	MOVEI	AC6,DFLTBF	; USE DEFAULT NO.
IFE TOPS20,<			;[561]
	TXNE	AC13,DV.MTA	;SKIP IF NOT A MTA
>				;[561]
IFN TOPS20,<
	TXNE	AC13,DV.MTA	;[1066] [561] MTA??
	TLNE	FLG1,MSTNDR	;[1066]  OR IS UNLABELED TAPE
	JRST	OPNC4D		;[561][1156] 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]
	LDB	AC2,DTCN.	; GET CHANNEL NO.
	PUSHJ	PP,GETJFN	; GET THE JFN
	  SETZ	AC1,		; FAILED, CANNOT HAPPEN
	HRRM	AC1,D.JFN(I16)	; STORE JFN
>;END IFN TOPS20
OPNC4D:	TXNE	AC13,DV.MTA	;[1066] [561][1156] MTA??
	JUMPN	AC5,OPNNSB	;[561] NON STANDARD BUFFER SETUP
OPNC4X:	TLNE	FLG,IDXFIL	;[561] 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
	TXNE	AC16,OPN%EX	;APPEND?
	JRST	OPNC45		;YES, DO FILOP NOW
IFN TOPS20,<
	TXNE	FLG1,B%NIO	;NATIVE I/O?
	JRST	OPNC46		;YES, BUFFER IS SETUP
>
	TLNE	FLG,OPNIN	;INPUT?
	XCT	UIBUF.		;**********
	TLNE	FLG,OPNOUT	;OUTPUT?
	XCT	UOBUF.		;**********
	JRST	OPNC46

OPNC45:	HRLZM	AC6,FOP.BN##	;SET NO. OF BUFFERS 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 PREVIOUS 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 DENSITY 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,FE%49	; 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
	MOVX	AC0,E.MTAP+FE%50 ; 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,FE%51	; 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
IFN TOPS20,<
	TXNN	AC13,DV.MTA	;IF NOT MTA
	JRST	OPNEX5		;ITS ALREADY OPENED VIA COMPT. UUO
>
	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] SKIP IF NOT BLOCKED
		TLNN	FLG,IOFIL!RANFIL!IDXFIL ;[1042] SEQUENTIAL FILE?
		POP	PP,(PP)		;[1042] YES, DISCARD .JBFF SAV
		JRST	OFERR]		; FAILED
OPNEX5:	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
	TXNN	AC16,OPN%EX	;[1164] OPEN EXTEND?
	JUMPN	AC2,ZROBUF	;[507] CLEAR ANY POSSIBLE PREVIOUS JUNK
	POP	PP,.JBFF	;RESTORE .JBFF

OPNCH2:	TLNN	FLG,IDXFIL!RANFIL!OPNIN ;[622]
	TLNN	FLG,OPNOUT	;TEST FOR SEQ. OUTPUT
	JRST	OPNC21		;NO
	LDB	AC6,[F%BLCR]	;LINAGE-COUNTER WANTED?
	SKIPE	AC6		;NO
	MOVEI	AC6,1		;YES, SET TO 1
	MOVEM	AC6,D.LCV(I16)	;SET VALUE

OPNC21:	TXNE	AC13,DV.DIR	;SKIP IF NON-DIRECTORY DEVICE
	TXNE	FLG1,B%STL	;SKIP IF NOT STANDARD 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,FE%19	;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:	TXNE	FLG1,B%STL	;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	; IS DEVICE MODE BINARY?
	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
	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
	SETZM	R.DLRW(I12)	; CLEAR DEL/RWT SAVE BLK NUM
	HRRI	AC6,1+R.DLRW(I12);FIRST DATA WORD
	TXNE	FLG1,B%VLER	; 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
;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,<
;	TLNN	FLG,OPNOUT	;[1007] [667] IF OPEN READ ONLY OR
;	JRST	OPNIX2		;DISK IS ALWAYS OPENED VIA COMPT. UUO
>
IFE TOPS20,<
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNIX2		; YES
	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
IFE TOPS20,<
	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		;
	PUSHJ	PP,SETIC	;[1202]SET UP IGETS CHANNEL NUMBER
	MOVX	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./]
	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,<
;	SKIPN	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
;	TLNN	FLG,OPNOUT	;[1007] [667] OR OPEN READ ONLY
;	TRNA			;[667] YES
;	JRST	OPNI21		; NO
	PUSHJ	PP,OCPTD	; [431] OPEN FILE VIA DEC-SYS-20 COMPT.
	 JRST	OCPERI		; [431] ERROR RETURN
;	JRST	OPNI22		; SKIP THE OPEN UUO
>
IFE TOPS20,<
	SKIPN	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNI21		; NO
	PUSHJ	PP,OPNFPD	; [431] OPEN FILE VIA FILOP UUO
	 JRST	OFERR		; [576] [431] ERROR RETURN
	JRST	OPNI22		; SKIP THE OPEN UUO

OPNI21:	XCT	UOPEN.		;OPEN THE DATA FILE
	 JRST	OERRDF		;ERROR RETURN
>; [431] END IFE TOPS20
	;SETUP IOWRD TABLE

	; Set record area length for START

OPNI22:	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
	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:	OUTSTR	[ASCIZ /Users maximum record size /] ; [375] [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:	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
	HRRZ	AC10,F.RREC(I16);GET START OF RECORD
	SUBI	AC6,(AC10)	;GET IN RELATIVE FORM
	CAMN	AC6,DBPRK(I12)	;[574] MUST BE SAME AS FILE OPENED
	JRST	OPNI7B		;OK, 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,AC6		;[617] GET WORD OFFSET OF KEY ONLY
	HRRZ	AC6,DBPRK(I12)	;[617] GET ISAM-GENERATED WORD OFFSET
	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
	HRRZ	AC0,F.RREC(I16)	;GET RECORD BASE
	SUB	AC10,AC0	;GET NUMBER OF FULL WORDS
	IMULI	AC10,(AC3)	;[617] CALC NUMBER BYTES TO KEY (FULL WDS)
	ADD	AC10,AC1	;[617] PLUS PARTIAL = BYTES TO KEY FOR PROGRAM
	CAIE	AC6,(AC10)	;[617] IS THE BYTE OFFSET TO THE KEY THE SAME??
	JRST	OPNERR		;[617] NO, TOO BAD

OPNI7B:	PUSHJ	PP,OPNWPB	;AC5 = BLKFTR, AC10 = WPB
	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
	TRZ	AC10,777	;ROUND UP
OPNI7E:	MOVE	AC6,DBF(I12)	;DATA FILE BLOCKING FACTOR VIA STA BLOCK
	CAMN	AC5,AC6		;AC5 = BLKFTR VIA FILE TABLE
	JRST	OPNI05		;OK
	MOVX	AC0,E.FIDX+FE%9	;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:	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	OPNERY		; NO
	MOVEI	AC0,FS%39	;SET UP F-S CODE FOR ATTRIB CONFLICT
	MOVEM	AC0,FS.FS	; AND SAVE IT ASIDE
	MOVEI	AC0,FE%59	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;DO REPORTING
	 TRN			;IGNORE ERROR IF IT RETURNS
OPNERY:	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

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

	; 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

	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:	TLNE	FLG,DDMASC	;[1207] IF FILE IS ASCII, TREAT IT
	HRRZI	AC2,0		;[1207] AS NON-NUMERIC
	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 RECORD KEY
	TLZ	AC1,770000	;MASK
	HLLZ	AC2,F.WBSK(I16)	;
	TLZ	AC2,7777	;
	IOR	AC1,AC2		;RECORD KEY BYTE RESIDUE
	MOVEM	AC1,GDPSK(I12)	;GD PARAMETER FOR RECORD 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)	; RECORD 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)	; RECORD 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,FS%30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	MOVX	AC0,E.FIDX+FE%7	;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,FS%30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	MOVX	AC0,E.FIDX+FE%8	;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
	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:	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
	TXNE	FLG1,B%VLER	;[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
	TRNE	AC1,INDASC	; IS IT INDUSTRY-COMP ASCII?
	JRST	OPNBS0		; YES, SO SET 8 BIT BYTES AND INDUSTRY COMPAT-MODE
	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.
OPNBS0:	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

	HRRZ	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
	TXNE	FLG1,B%VLER	; 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
	TXNN	AC13,DV.DIR	;SKIP IF DIRECTORY DEVICE
	JRST	OPNRLB		;READ LABEL INTO RECORD AREA
IFN TOPS20,<
;	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
;	TXNN	AC13,DV.MTA	;[667]  WE HAVE ALREADY DONE THE LOOKUP VIA COMPT. UUO
	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)
>
	SKIPE	F.WSMU(I16)	;OR SIMULTANEOUS UPDATE?
	JRST	OPNLU2		;[565] YES, DON'T DO LOOKUP
	TLNN	FLG,OPNIN!IDXFIL; SKIP IF ISAM OR INPUT FILE
	PUSHJ	PP,OPNENT	; SUPERSEDE THE EXISTING FILE
	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
	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

	DMOVE	AC0,ARGBK.+.RBEXT	;[612] GET EXTENSION, DATE AND PROTECTION BITS
	DMOVEM	AC0,ULBLK.+1		;[612] INTO SHORT LOOKUP 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
	DMOVE	AC0,ULBLK.	;FILE NAME & EXTENSION
IFE TOPS20,<
	TXNE	AC13,DV.DTA	;SKIP IF NOT A DTA
	HRRM	AC1,D.CBN(I16)	;SAVE AS THE FIRST BLOCK NUMBER
>
	TXNN	AC13,DV.MTA	;UNLESS MTA
	JRST	OPNBBF		;DON'T CREATE A LABEL
	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,DATE1.	;CREATION 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
	JUMPGE	AC5,OPNEL4		;[565] SKIP AHEAD IF LOOKUP RETURNS BLKS
	MOVNS	AC5			;[565] NEGATE LOOKUP NUMBER OF WRDS
	TRNA

OPNEL2:	MOVE	AC5,ARGBK.+.RBSIZ	; GET LAST BLOCK OF FILE
	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,FS%30	;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


;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

;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
	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:	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] MUST BE ERSATZ SO CLEAR SFD
OPNF2A:	TDNA			;[1030] [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
	  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
		TLC	FLG,OPNIN!OPNOUT
		TLCE	FLG,OPNIN!OPNOUT	;IF OPEN I/O
		TXNN	AC16,OPN%EX	;OR OPEN EXTEND
		SKIPL	WANT8.		;[1167] ITS OK, CREATE NON-EXISTENT FILE IF ANS-82 DEFAULT
		POPJ	PP,		; OTHERWISE GIVE FNF ERROR
		MOVE	AC1,[7,,FOP.BK]	;[576]RESTORE FILOP ARG
		JRST	.+1]		;[576]NON ISAM FILE NOT FOUND,WILL CREATE ONE
	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
OFERRI:	MOVEI	AC0,FS%30	;GET FILE-STATUS CODE = PERM. ERROR
	MOVEM	AC0,FS.FS	;SET IT UP
	MOVX	AC0,E.MFOP+E.FIDX ;MAKE AN ERROR NUMBER
	TLON	FLG1,FOPIDX	; REMEMBER IT'S A FILOP ERROR
	MOVX	AC0,E.MFOP+E.FIDA
	TLNN	FLG,IDXFIL	; ISAM FILE?
	MOVX	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,CP.BK8
EXTERN FID.PT,FID.BK,TMP.BK,TMP.PT

; OPEN FILE VIA COMPT. UUO USING LONG FORM GTJFN
; IT IS USED FOR ALL BUT MTA FILES
; THIS ROUTINE BUILDS A PRIMARY STRING FROM THE VALUE OF ID
; IT ALSO BUILDS  THE FOLLOWING DEFAULTS
; DEVICE FROM EITHER 1) [PPN] OR 2) SELECT CLAUSE
; <DIRECTORY> FROM [PPN]
; FILE NAME FROM PROGRAM NAME
; EXTENSION ONLY IF ISAM
; PROTECTION FROM PROTECTION CLAUSE

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:	PUSHJ	PP,OPNLID		; [431] NO, GET VID...

;BUILD A TOPS20 FILE-DESCRIPTOR STRING - AC2 GTJFN BITS
;FIRST ZERO THE STORAGE AREAS

	MOVE	AC1,[FID.BK,,FID.BK+1]	; CLEAR ALL STUFF
	SETZM	FID.BK
	BLT	AC1,FID.BK+51		;[1165] GET WHOLE FILE SPEC
	MOVE	AC1,[GJ.BLK,,GJ.BLK+1]
	SETZM	GJ.BLK##
	BLT	AC1,GJ.BLK+.GJJFN
	MOVE	AC0,[.NULIO,,.NULIO]	;NO INPUT TO OR FROM A FILE
	MOVE	AC1,[POINT 7,DF.NAM]	;SETUP THE DEFAULT FILENAME NAME
	DMOVEM	AC0,GJ.BLK+.GJSRC
;STORE THE DEVICE NAME IN SIXBIT IN  THE COMPT. BLOCK
	MOVE	AC1,UOBLK.+1		; GET THE DEVICE NAME
	MOVEM	AC1,CP.BK3		; SET UP FOR COMPT. FUNCT 3--MAYBE
;AND AS AN ASCIZ STRING
	MOVE	AC5,[POINT 7,DF.DEV##]
	MOVEM	AC5,GJ.BLK+.GJDEV
OCPT01:	SETZ	AC0,			;INITIALIZE CHAR
	LSHC	AC0,6			;GET NEXT ONE
	ADDI	AC0,40
	IDPB	AC0,AC5
	JUMPN	AC1,OCPT01
	MOVEI	AC0,":"			;END DEVICE WITH COLON
	IDPB	AC0,AC5
	IDPB	AC1,AC5			;AND NULL
;THEN STORE PROTECTION FIELD AS ASCIZ STRING
	HLRZ	AC4,F.PROT(I16)		; DID USER SUPPLY PROTECTION CODE?
	JUMPE	AC4,OCPT6B		; NO
	SKIPN	(AC4)			; IS IT ZERO?
	JRST	OCPT6B			; YES, SO NO PROTECTION CODE
	HRLI	AC4,(POINT 3,0,17)	; FORM BYTE POINTER
	MOVE	AC5,[POINT 7,DF.PRO##]
	MOVEM	AC5,GJ.BLK+.GJPRO
	MOVEI	AC0,6			; ALLOW SIX CHARACTERS
OCPT6A:	ILDB	C,AC4
	ADDI	C,"0"
	IDPB	C,AC5
	SOJG	AC0,OCPT6A		; LOOP FOR ALL 6
	IDPB	AC0,AC5			; TERMINATE THE STRING

;NEXT CONVERT PPN TO STR:<DIRECTORY>
OCPT6B:	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	AC2,(AC1)		; GET PPN FROM ADR
	MOVE	AC1,FID.PT		; GET POINTER TO TEMP FILE-DESCRIPTOR
	HRROI	AC3,DF.DEV		; POINTER TO DEFAULT DEVICE
	PPNST%				; CONVERT [PPN] TO STRING
	 ERJMP	RET.1

;NOW MOVE THE DEVICE TO DF.DEV AND RESET THE POINTER TO THE DIRECTORY
	MOVE	AC1,FID.PT		;POINT TO RETURNED STRING
	MOVE	AC5,[POINT 7,DF.DEV]	;POINT TO NEW DEFAULT DEVICE
OCPT1L:	ILDB	AC0,AC1
	IDPB	AC0,AC5
	CAIE	AC0,":"
	JRST	OCPT1L			;LOOP UNTIL END OF DEVICE
	SETZ	AC0,
	IDPB	AC0,AC5			;STORE A NUL AT END OF STRING
	MOVE	AC5,[POINT 7,DF.DIR##]	;POINT TO DEFAULT DIRECTORY
	MOVEM	AC5,GJ.BLK+.GJDIR	;STORE POINTER TO DIRECTORY ONLY
	IBP	AC1			;DELETE LEFT ANGLE BRACKET
OCPT1P:	ILDB	AC0,AC1
	IDPB	AC0,AC5
	CAIE	AC0,^O76		;END OF DIRECTORY?
	JRST	OCPT1P			;NO
	SETZ	AC0,			;YES
	DPB	AC0,AC5			;YES, STORE NUL OVER ANGLE

;NOW GET THE VALUE OF ID STRING
;IF IT IS EXACTLY 9 CHARACTERS WITH NO PERIOD THEN INSERT PERIOD AFTER 6 CHARS.
;OTHERWISE USE THE STRING AS IS. CONVERT IT TO ASCIZ THOUGH (MUST ADD A NULL).

OCPT4:	TLNE	FLG,IDXFIL		; [431] SKIP IF NOT ISAM FILE
	TLNE	FLG1,FOPIDX		; [431] SKIP IF ISAM .IDA FILE
	SKIPA	AC5,F.WVID(I16)		; [431] BYTE-PTR TO VALUE OF ID
	JRST	OCPT4A		;ISAM .IDA FILE WANTED
	JUMPE	AC5,OCPT2	;NONE, USE DEFAULT
	MOVE	AC10,FID.PT	;GET STORAGE POINTER
	LDB	AC6,F.BSID	;GET SIZE OF VALUE OF ID
	SKIPN	AC6
	MOVEI	AC6,9		;ASSUME 9 BY DEFAULT

;[1141]CONVERT SIXBIT OR EBCDIC FILENAME TO ASCII SO WE CAN SCAN IT FOR
;[1141]FILENAME SEPARATOR CHARACTERS

OPCT7:	CAILE	AC6,^D160	;[1165] FILE ID CAN'T BE LONGER
	MOVEI	AC6,^D160	;[1165] THAN 160 CHARACTERS
	TLNN	AC5,600		; IS VID EBCDIC?
	JRST	OCPT7E		;YES
	TLNN	AC5,100		;IS VID ASCII?
	JRST	OCPT7S		;NO, MUST BE SIXBIT
;	JRST	OCPT7A		;YES

OCPT7A:	ILDB	C,AC5		;PICK UP A CHAR
	IDPB	C,AC10		;STORE IN E BLOCK
	SOSE	AC0		;[1165] CAN'T HAVE MORE THAN 160 CHAR
	SOJN	AC6,OCPT7A	;LOOP 'TIL
	JRST	OCPT7Z		;DONE

OCPT7E:	ILDB	C,AC5		;PICK UP A CHAR
	LDB	C,PTR.97##	; CONVERT TO ASCII
	IDPB	C,AC10		;STORE IN E BLOCK
	SOSE	AC0		;[1165] CAN'T HAVE MORE THAN 160 CHAR
	SOJN	AC6,OCPT7E	;LOOP 'TIL
	JRST	OCPT7Z		;DONE

OCPT7S:	ILDB	C,AC5		;PICK UP A CHAR
	LDB	C,PTR.67##	; CONVERT TO ASCII
	IDPB	C,AC10		;STORE IN E BLOCK
	SOSE	AC0		;[1165] CAN'T HAVE MORE THAN 160 CHAR
	SOJN	AC6,OCPT7S	;LOOP 'TIL DONE

OCPT7Z:	SETZ	C,
	IDPB	C,AC10		;STORE NUL AT END

	LDB	AC6,F.BSID	;[1141]GET SIZE OF VALUE OF ID
	SKIPN	AC6		;[1141]
	MOVEI	AC6,9		;[1141]ASSUME 9 BY DEFAULT
	CAIE	AC6,9		;[1141]IS IT 9 EXACTLY?
	JRST	OCPT2		;[1141]NO, DONE - GO SET UP FOR GTJFN

;[1141]LOOK FOR SEPARATORS
;[1141]USE OLD METHOD IF NONE FOUND

	MOVE	AC10,FID.PT	;[1141]GET STORAGE POINTER
OCPTSP:	ILDB	C,AC10		;[1141]PICK UP A CHAR
	CAIE	C,"."		;[1141]PERIOD?
	CAIN	C,":"		;[1141]OR COLON?
	JRST	OCPT2		;[1141]YES DON'T CONVERT
	CAIE	C,^O74		;[1141]LEFT ANGLE BRACKET?
	CAIN	C,"["		;[1141]OR LEFT SQUARE BRACKET?
	JRST	OCPT2		;[1141]YES DON'T CONVERT
	CAIN	C,";"		;[1141]OR MAYBE ";"
	JRST	OCPT2		;[1141]YES DON'T CONVERT
	SOJN	AC6,OCPTSP	;[1141]LOOP TILL DONE OR SEPARATOR FOUND

;[1141]NO SEPARATOR. USE OLD METHOD.

	MOVE	AC5,F.WVID(I16)	;[1141]BYTE-PTR TO VALUE OF ID
	MOVE	AC10,FID.PT	;[1141]GET STORAGE POINTER
	MOVEI	AC6,9		;[1141]LENGTH 9
	JRST	OCPT9		;[1141]CONVERT AGAIN

;HERE FOR ISAM .IDA FILE
OCPT4A:	MOVE	AC5,[POINT 6,DFILNM(I12)]; [431] .IDA - SO VALUE-ID IS HERE
	MOVE	AC10,FID.PT	;GET STORAGE POINTER
	MOVEI	AC6,9		;ASSUME 9 CHAR FOR NOW
				;USE OLD METHOD BY DEFAULT

OCPT9:	TLNN	AC5,600		; IS VID EBCDIC?
	JRST	OCPT9E		;YES
	TLNN	AC5,100		;IS VID ASCII?
	JRST	OCPT9S		;NO, MUST BE SIXBIT
;	JRST	OCPT9A		;YES

OCPT9A:	ILDB	C,AC5		;PICK UP A CHAR
	CAIE	C," "		;IGNORE SPACES
	IDPB	C,AC10		;OTHERWISE STORE
	CAIE	AC6,4		;IS IT TIME FOR "."?
	SOJN	AC6,OCPT9A	;NO, LOOP 'TIL DONE
	JUMPE	AC6,OCPT9Z	;[1141]ALL DONE
	MOVEI	C,"."
	IDPB	C,AC10
	SOJN	AC6,OCPT9A	;BACK FOR EXTENSION
	JRST	OCPT9Z		;[1141]DONE

OCPT9E:	ILDB	C,AC5		;PICK UP A CHAR
	LDB	C,PTR.97##	; CONVERT TO ASCII
	CAIE	C," "		;IGNORE SPACES
	IDPB	C,AC10		;STORE IN E BLOCK
	CAIE	AC6,4		;IS IT TIME FOR "."?
	SOJN	AC6,OCPT9E	;NO, LOOP 'TIL DONE
	JUMPE	AC6,OCPT9Z	;[1141]ALL DONE
	MOVEI	C,"."
	IDPB	C,AC10
	SOJN	AC6,OCPT9E	;BACK FOR EXTENSION
	JRST	OCPT9Z		;[1141]DONE

OCPT9S:	ILDB	C,AC5		;PICK UP A CHAR
	LDB	C,PTR.67##	; CONVERT TO ASCII
	CAIE	C," "		;IGNORE SPACES
	IDPB	C,AC10		;STORE IN E BLOCK
	CAIE	AC6,4		;IS IT TIME FOR "."?
	SOJN	AC6,OCPT9S	;NO, LOOP 'TIL DONE
	JUMPE	AC6,OCPT9Z	;[1141]ALL DONE
	MOVEI	C,"."
	IDPB	C,AC10
	SOJN	AC6,OCPT9S	;BACK FOR EXTENSION
OCPT9Z:	SETZ	C,		;[1141]
	IDPB	C,AC10		;[1141]STORE NUL AT END

; NOW COMPLETE THE COMPT. UUO BLOCK
OCPT2:	MOVX	AC0,GJ%FOU		; SPECIFY THE LONG FORM & NEXT GENERATION
	TXNN	AC16,OPN%EX		; FILE MUST EXIST FOR OPEN EXTEND
	TLNE	FLG,IDXFIL!OPNIN	; ISAM FILE OR OPEN FOR INPUT?
	TXC	AC0,GJ%OLD!GJ%FOU	; YES, FILE MUST EXIST
	MOVEM	AC0,GJ.BLK+.GJGEN	; FLAGS FOR GTJFN JSYS
	MOVEI	AC0,GJ.BLK		; POINT TO ARG BLOCK
	MOVE	AC1,FID.PT		; [431] GET POINTER TO FILE DESCRIPTOR STRING
	DMOVEM	AC0,CP.BK1		; [431]  FOR GJGFN ARGUMENT

; SETUP THE FLAG BITS IN AC2 FOR OPENF
OCPT6:	SETZ	AC0,
	TLNE	FLG,DDMASC		; [431] DEVICE DATA MODE ASCII?
	TXO	AC0,7B5			; [431] YES
	TLNE	FLG,DDMSIX		; [431] SIXBIT?
	TXO	AC0,6B5			; [431] YES
	TLNE	FLG,DDMBIN		; [431] BINARY?
	TXO	AC0,44B5		; [431] YES
	TLNN	FLG,DDMEBC		; [431] EBCDIC?
	JRST	OCPT10			; [431] NO
	TXO	AC0,10B5		; [431] ASSUME DEVICE IS A MAG-TAPE
	TXNN	AC13,DV.MTA		; [431] DEVICE A MTA?
	TXO	AC0,11B5		; [431] NO, ITS A DSK

OCPT10:	TLNE	FLG,IOFIL!RANFIL!IDXFIL	; [622] [431] RANDOM,INDEXED OR IO FILES
	TXO	AC0,17B9		; [431]  ARE DUMP MODE
	TLNE	FLG,RANFIL!IDXFIL!OPNIN ; [622] [431] OPEN FOR INPUT?
	TXO	AC0,OF%RD		; [431] YES
	TLNE	FLG,OPNOUT		; [431] OPEN FOR OUTPUT?
	TXO	AC0,OF%WR		; [431] YES
	SKIPN	F.WSMU(I16)		;[667] SIMULTANEOUS UPDATE?
	TXZA	AC0,OF%THW		;[667] NO, CLEAR THAWED BIT
	TXOA	AC0,OF%THW		;[667] [431] THAWED I.E. SIMULTANEOUS UPDATE
	TXNE	AC16,OPN%EX		; IF OPEN EXTEND
	TXO	AC0,OF%RD!OF%WR		;[1131] TURN ON BOTH READ AND WRITE
	TXNN	AC0,OF%WR		;[1131] Is the write bit on?
	TXO	AC0,OF%RDU		;[667] TURN ON READ UNRESTRICTED ALSO
	MOVEM	AC0,CP.BK3		; [431] INIT AC2 OPENF BITS
	LDB	AC0,F.BRMS		; IF ITS AN RMS FILE
	JUMPN	AC0,RET.2		; RETURN TO RMSIO TO DO GETJFN

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

; [431]LOCATE THE BUFFER HEADERS AND EXTENDED LOOKUP BLOCK
	MOVEI	AC1,D.IBH(I16)		; [431] INPUT BUFFER HEADER
	DMOVEM	AC0,CP.BK4		; [431]
	MOVEI	AC0,D.OBH(I16)		; [431] OUTPUT BUFFER HEADER
	MOVEI	AC1,ARGBK.		; [431] ADR OF EXTENDED LOOKUP BLOCK
	DMOVEM	AC0,CP.BK6		; [431]

; [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
	TXNE	AC16,OPN%EX		; HOWEVER OPEN EXTEND
	HRLI	AC1,CMP.13		; NEEDS SPECIAL FUNCTION
	MOVSM	AC1,CP.BLK		; [431] ARG ,, FUNCTION
	MOVE	AC1,[10,,CP.BLK]	; [431] COUNT,,ADR FOR ARG-BLOCK
	TXNE	AC16,OPN%EX		; AGAIN OPEN EXTEND
	HRLI	AC1,11			; HAS ONE MORE ARG (BUFFER NUMBER)
	TXNE	AC13,DV.LPT!DV.PTP	; SIMPLE DEVICE
	JRST	OPNATV			; YES, USE NATIVE MODE I/O
	TXNE	AC13,DV.MTA		; [1066] IS IT A LABELLED MTA?
	PUSHJ	PP,OCPT1A		; [1066]  YES, GO SET UP ATTR. BLOCK
	SETZM	CMPTER##		;
;**;[1140] At OCPT10+55L
	TXNN	AC16,OPN%EX		;[1140] IF OPEN EXTEND
	  JRST	NOXTND			;[1140] ELSE SKIP
	PUSH	PP,.JBFF		;[1140] SAVE .JBFF
	HLRZ	AC11,D.BL(I16)		;[1140] AND PNT IT TO BUFFER LOCATION
	MOVEM	AC11,.JBFF		;[1140] PA1050 MAKES BUFFER RING THERE
NOXTND:	COMPT.	AC1,			; [431] OPEN FILE
	  TDZA	AC11,AC11		;[1140] CLEAR AC11 TO FLAG FAILURE
	SETOI	AC11,			;[1140] ELSE, FLAG SUCCESS
	TXNE	AC16,OPN%EX		;[1140] OPEN EXTEND?
	  POP	PP,.JBFF		;[1140] RESTORE END OF CORE PNTR
	SKIPN	AC11			;[1140] SKIP RETURN IF SUCCESS
	 JRST	[MOVEM	AC1,CMPTER##	;SAVE ASIDE UUO ERROR CODE
		  POPJ	PP,]		; [431] ERROR RETURN
	TLZE	FLG1,FOPIDX		; CLEAR FLAG, IF AN ISAM.IDX FILE
	SKIPA	AC2,ICHAN(I12)		;  GET CHAN # FROM HERE
	LDB	AC2,DTCN.		; ELSE FROM HERE
	PUSHJ	PP,GETJFN		; GET THE JFN
	  SETZ	AC1,			; FAILED, CANNOT HAPPEN
	HRRM	AC1,D.JFN(I16)		; STORE JFN

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

	TLNE	FLG,RANFIL		;IS IT RELATIVE FILE
	TLNN	FLG,OPNIO		; AND BEING OPENED FOR I-O?
	 JRST	RET.2			;NO
	SKIPN	F.WSMU(I16)		; UNDER SMU-OPTION 1?
	 JRST	RET.2			;NO
	HRRZS	AC1,AC1			;MAKE SURE ONLY JFN IN AC1
	HRLI	AC2,1			; WANT ONLY 1 WORD FROM FDB
	HRRI	AC2,.FBSIZ		; THE FILE SIZE
	HRRZI	AC3,AC0			; PUT IT IN AC0
	GTFDB				;GET THE FDB INFO
	 ERJMP	[POPJ PP,]		; SHOULDN'T HAPPEN, TAKE ERROR RETURN
	HRLOI	AC2,377777		;PUT MAX NO. OF PAGES IN AC2
	CAMN	AC0,AC2			; SAME AS IN FDB?
	 JRST	RET.2			;  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.		;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

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

OCPT1A:	PUSH	PP,AC0			;[1066]
	HRRZ	AC0,D.RFLG(I16)		;[1066] Get infomation flag
	TXNN	AC0,SASCII		;[1066] Recording mode ASCII ?
	JRST	OCPT1B			;[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.
	MOVE	AC0,GJ.BLK+.GJGEN	;[1066]
	TXO	AC0,GJ%XTN		;[1066] Set GJ%XTN in GTJFN block
	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
OCPT1B:	POP	PP,AC0			;[1066]
	POPJ	PP,			;[1066]
;Here to open simple devices in native mode

OPNATV:	SOS	D.OBH(I16)		; BACKUP TO FIRST WORD OF BUFFER AREA
	DMOVE	AC1,CP.BLK+1		; GET GTJFN BITS
	GTJFN%
	  POPJ	PP,			; ERROR
	HRRM	AC1,D.JFN(I16)		; STORE JFN
	DMOVE	AC2,CP.BLK+3		; GET OPENF BITS
	OPENF%
	  POPJ	PP,			; ERROR
	TXO	FLG1,B%NIO		; SIGNAL NATIVE I/O
	SETO	AC1,
	DPB	AC1,F.NIO		; MAKE A PERMANENT COPY OF FLG1
	HLRZ	AC1,D.FBS(I16)		; GET BUFFER SIZE IN WORDS
	TLNE	FLG,DDMASC		; DEVICE DATA MODE ASCII?
	IMULI	AC1,5			; 5 BYTES PER WORD
	TLNE	FLG,DDMSIX		; SIXBIT?
	IMULI	AC1,6			; 6 BYTES PER WORD
	TLNE	FLG,DDMEBC		; EBCDIC?
	LSH	AC1,2			; 4 BYTES PER WORD
	HRRM	AC1,D.FBS(I16)		; STORE SIZE IN BYTES
	JRST	RET.2			; OK
OCPER:	SETZM	FS.IF		; CLEAR .IDA FILE FLAG
	MOVE	AC1,CMPTER##	;GET ERROR CODE FROM COMPT. UUO
	CAIN	AC1,GJFX24	; FILE NOT FOUND?
	 JRST	OCPFNF		; NO, NOT FOUND.
	CAIN	AC1,OPNX9	;[1147] Invalid Simul. Access error?
	 JRST	[PUSHJ	PP,SAVAC. ;[1147] yes
		 MOVEI	AC2,3
		 JRST	ENRAGN]	;[1147] Turn into file being modified error
	MOVEI	AC0,FS%30	;[1054] FILL FILE-STATUS FOR PERMANENT ERROR
	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	OCPERI		; NO
	JRST	OCPERJ		;  YES, ON TO NEXT RAIN DANCE
OCPFNF:				;
	HLLZ	FLG1,D.F1(I16)	;GET FLG1 FLAGS
	TXNE	FLG1,B%OPTF	;IS FILE OPTIONAL?
	 JRST	OCPEOP		; YES
	MOVEI	AC0,FS%30	;SET PERMANENT ERROR
	SKIPGE	WANT8.		;WANT ANSI 8X USAGE?
	MOVEI	AC0,FS%35	;YES, FILE NOT FOUND
	JRST	OCPERI		; NO
OCPEOP:				;
	SKIPL	WANT8.		;WANT ANS 8X USAGE?
	 POPJ	PP,		; NO
	MOVEI	AC0,FS%05	; YES, LET EM OFF EASY
	MOVEM	AC0,FS.FS	; SAVE FILE-STATUS ASIDE
	MOVX	AC0,E.MCPT	;SPECIFY COMPT. UUO
	PUSHJ	PP,IGCVR	; AND CONVERT IT INTO WORKING-STORAGE FIELD
	 TRN			;  AND RETURN
	POPJ	PP,		;   IN ANY EVENT

				;CHECK ATTRIBUTE ERRORS ON OPEN.
OCPERJ:	CAIN	AC1,GJFX50	;VARIOUS ERROR CODES FROM GETJFN RELATE TO STATUS
	MOVEI	AC0,FS%39	;THEY INCLUDE GJFX45,46,47,49 AND 50
	CAIL	AC1,GJFX45	; GJFX50 HAS TO BE TESTED SEPARATELY BECAUSE
	CAILE	AC1,GJFX49	; ITS VALUE IS NOT CONTIGUOUS WITH THE
	JRST	OCPERI		; OTHERS.
	CAIE	AC1,GJFX48	; ALSO, GJFX48 IS NOT AN ATTRIBUTE ERROR.
	MOVEI	AC0,FS%39
;	JRST	OCPERI

OCPERI:	MOVEM	AC0,FS.FS		;[1054] AND SAVE IT ASIDE
	MOVX	AC0,E.MCPT+E.FIDX	;[1054] MAKE AN ERROR NUMBER
	TLZN	FLG1,FOPIDX		; IDX OR IDA?
	MOVX	AC0,E.MCPT+E.FIDA	; IDA!
	TLNN	FLG,IDXFIL		; SKIP IF AN ISAM FILE
	MOVX	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 MAGTAPE DEVICE.  ***OPNBBF***

OPNRLB:	TXNN	AC13,DV.LPT!DV.TTY!DV.PTR!DV.PTP!DV.CDR ;[575]SKIP IF DEVICE IS ONE OF THESE
	TXNN	FLG1,B%STL	;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,<
	TXNN	FLG1,B%NIO	;NATIVE I/O
	JRST	OPNBB2		;NO
	PUSHJ	PP,WRTNIO	;YES, DO DUMMY OUTPUT (SET UP BUFFERS)
	JRST	OPNBB1
>
IFE TOPS20,<
	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:	TXNN	AC13,DV.LPT!DV.PTR!DV.PTP!DV.TTY!DV.CDR	;NO LABELS - NO CHECKS
	TXNN	FLG1,B%STL	;SKIP IF LABELS ARE STANDARD
	JRST	OPNABF		;AFTER BEG FILE
	TLNE	FLG,OPNIN	;SKIP IF NOT INPUT / IO
	JRST	OPNCSL		;STANDARD LABEL CHECK
	TXNE	AC13,DV.MTA	;IF MTA
	PUSHJ	PP,OPNCAL	;CREATE A LABEL
	;DO AFTER BEGINNING FILE LABEL PROCEDURE
	;AND WRITE OUT THE LABEL.  ***OPNENR***

OPNABF:	TLNN	FLG,OPNOUT	;OUTPUT SKIPS
	JRST	OPNDVC
	TXNE	AC13,DV.DIR	;SKIP IF NOT DIR. DEV. (I.E. DSK OR DTA)
	JRST	OPNENR
	TXNN	AC13,DV.LPT!DV.PTP!DV.PTR!DV.TTY!DV.CDR	;SKIP IF LPT,TTY,PTR,PTP,OR CDR.
	TXNN	FLG1,B%STL	;SKIP IF ANY LABELS
	JRST	OPNDVC		;NO LABELS
	PUSHJ	PP,RECBUF	;MOVE THE LABEL INTO THE BUFFER
	SKIPGE	FLG		;SKIP IF DEVICE IS NOT ASCII
	PUSHJ	PP,WRTCRLF	;
	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)
IFN TOPS20,<
	MOVE	AC13,D.DC(I16)	;GET DEVCHR CHARACTERISTICS
>
	TXNN	AC16,OPN%EX	; APPEND MODE
IFN TOPS20,<
	TXNN	AC13,DV.MTA	;IF NOT MTA THEN WE HAVE USED THE COMPT. UUO
	JRST	OPNDVC
>
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:	MOVEM	FLG,F.WFLG(I16)	;UPDATE THE FLAGS
	MOVE	AC13,D.DC(I16)	;DEVCHR BITS
	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
	TXNE	FLG1,B%STL	;SKIP IF LABELS ARE OMITTED
	PUSHJ	PP,ZROREC	;CLEAR THE RECORD AREA I.E.LABEL
	PUSHJ	PP,CLRSTS	;[601] CLEAR FILE STATUS WORD
	TLNN	FLG,IDXFIL!RANFIL!OPNIN ;[622]
	TLNN	FLG,OPNOUT	;TEST FOR SEQ. OUTPUT
	JRST	OPNDV3		;NO
	SKIPN	D.LCV(I16)	;LINAGE STUFF?
	JRST	OPNDV3		;NO
	HLRZ	AC6,F.LAT(I16)	;LINES AT TOP?
	JUMPE	AC6,OPNDV3	;ZERO
	PUSHJ	PP,WRTCRLF	;THERE ARE SOME
	SOJG	AC6,.-1		;LOOP

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

	TXNN	FLG1,B%STL	;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: 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
	TXNN	AC13,DV.MTA	;IF NOT A MTA
	JRST	[PUSHJ	PP,OPNLID	;JUST MOVE ID TO LOOKUP BLOCK
		JRST	OPNABF]		;AND CONTINUE
	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:	DMOVE	AC0,STDLB.	;
	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	OPNABF		;MATCH
	LDB	AC2,F.BPMT	;
	JUMPN	AC2,OPNABF	;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
	;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,DATE.	;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 '	;
	DMOVEM	AC1,STDLB.+4	;REEL NUMBER AND 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

	; 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


	; NOW SET DENSITY AND HARDWARE DATA MODE

OMTA01:
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	RET.2		; NO,DEFAULT OK, GOOD RETURN
	JRST	DEFMOD		;[1061] SET MODE TO CORE DUMP
	TXNE	FLG1,B%STL	; 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:	MOVX	AC0,E.MTAP+FE%46 ; 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:	MOVX	AC0,E.MTAP+FE%45 ; 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,FE%47	; 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:	MOVX	AC0,E.MTAP+FE%48 ;ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE?
	  JRST	RCHAN		; YES
	OUTSTR	[ASCIZ /
?TAPOP. failed - unable to get-set label type-information ./]
	JRST	OMTA99


VSWERR:	MOVX	AC0,E.MTAP+FE%56 ;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

	;HERE IF READ BACKWARDS NOT SUPPORTED ON SPECIFIED MTA

OMTA97:	MOVEI	AC0,FE%57	; 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.
	TXNN	FLG1,B%STL	; LABELS OMITTED?
	MOVEI	AC3,1		; YES, 1 EOF/FILE.
	MOVX	AC5,B%HUF	;"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
	TXNN	AC16,OPN%NR	;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,FE%52	; 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?
	TRNA			; 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]
	JRST	OPNFW5		;

OPNFW2:	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	OPNFW3		; NO
	MOVEI	AC0,FS%36	;SET UP F-S CODE FOR BAD MTA OPEN ON MULTI-FILE TAPE
	MOVEM	AC0,FS.FS	; AND SAVE IT ASIDE
	PUSHJ	PP,IGCVR	;REPORT IT
	 TRN			;IGNORE ERROR RETURN

OPNFW3:	OUTSTR	[ASCIZ /$ Unexpected EOT marker/]	;[277]
OPNFW5:	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,B%HUF	;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
	TLNE	FLG,IDXFIL		;ISAM ?
	SKIPA	AC5,[POINT 6,DFILNM(I12)]
	SKIPE	AC5,F.WVID(I16)		;BYTE POINTER TO VALUE OF ID
	SKIPN	AC5			;GOT ONE?
	SKIPA	AC5,DF.PRG		;NO, USE PROGRAM NAME BY DEFAULT
	PUSHJ	PP,OPNVID	;[447]
	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
	SETZM	UEBLK.+2	;CLEAR PROTECTION AND DATE
	HLRZ	AC5,F.PROT(I16)	; DID USER GIVE PROTECTION CODE
	JUMPE	AC5,OPNPPN	; NO
	MOVE	AC5,(AC5)	; YES, GET IT
	DPB	AC5,[POINT 9,UEBLK.+2,35]	;STORE FOR ENTER
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

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
	TXNN	FLG1,B%STL
	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
	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
	TXNN	FLG1,B%STL	; STANDARD LABELS?
	TDZA	AC2,AC2		; NO
	MOVEI	AC2,^D80	; 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 CHARS 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***
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:	MOVX	AC0,E.MOPE+E.FIDA	;ERROR NUMBER
	SETZM	FS.IF		;IDA FILE
	JRST	OERRI1		;

	;OPEN FAILED
OERRIF:	MOVX	AC0,E.MOPE+E.FIDX	;ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVX	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:	MOVX	AC0,E.MREN+E.FIDX	;MAKE AN ERROR NUMBER
	JRST	OEERR1		;

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

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

	;ENTER FAILED
OEERR:	MOVEI	AC0,FS%30	;GET FILE-STATUS CODE = PERM. ERROR
	MOVEM	AC0,FS.FS	;SET IT UP
	SETZM	FS.IF		;IDA FILE
	MOVX	AC0,E.MENT+E.FIDA	;ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVX	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:	MOVX	AC0,E.MLOO+E.FIDX	;ERROR NUMBER
	JRST	OLERR1		;


	;LOOKUP FAILED
OLERR:	SETZM	FS.IF		;IDA FILE
	MOVX	AC0,E.MLOO+E.FIDA	;ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVX	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,FS%30	;YES
	MOVEM	AC1,FS.FS	;LOAD FILE-STATUS
	JRST	IGCVR		;FINISH UP

	;RELEASE THE IO CHANNEL AND NOTE THAT IT'S FREE

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

PRGERC:				;FILE-STATUS CODE FOR CLOSE IF NOT OPEN
	MOVEI	AC0,FS%30	; MAKE IT PERMANENT ERROR
	MOVEM	AC0,FS.FS	; AND SAVE IT FOR REPORTING
;	JRST	PRGERR		;DROP DOWN TO REGULAR REPORTING PROCEDURE

PRGERR:	SETZM	PRGFLG		;[1003] IN CASE FILE WAS CLOSED WITH DELETE
	MOVX	AC0,E.VCLO+FE%20	;ERROR NUMBER
	MOVE	AC2,[BYTE(5)10,31,20,37,33]

	;CALL VIA JRST
	;AC0 HAS ERROR NUMBER FOR IGCV - AC2 HAS ERROR MESSAGE FOR MSOUT.
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,FS%41	;8x FILE-STATUS NUMBER
	MOVEM	AC0,FS.FS	;SAVE FILE-STATUS FOR REPORTING
	MOVEI	AC0,FE%10	;FILE STATUS ERROR NO.
	JRST	OXITER		;ONLY CLOSED FILES MAY BE OPENED

	;FILE ALREADY LOCKED

OPNFAL:	MOVEI	AC0,FS%38	;8x FILE-STATUS CODE
	MOVEM	AC0,FS.FS	;SAVE FILE STATUS FOR REPORTING
	MOVEI	AC0,FE%11	;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,FE%13	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

;IF CHECKPOINT MODE IS REQUIRED SET BIT IN OPEN BLOCK

IFE TOPS20,<
OPNCKP:	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,
>

;IF PADDING CHAR IS SUPPLIED SET UP THE CORRECT RUNTIME ONE TO MATCH OUTPUT TYPE.

SETPAD:	TLNE	FLG,DDMBIN	;NO PADDING FOR BINARY FILES?
	POPJ	PP,		; SO RETURN (IS THIS RIGHT?)
	MOVE	AC1,F.PADD(I16)	;GET BYTE POINTER
	TLNN	AC1,-1		;IS AN ASCII LITERAL?
	SKIPA	C,AC1		;YES, GET IT
	ILDB	C,AC1		;NO, GET SINGLE CHAR
	LDB	AC2,[POINT 6,AC1,11]	;GET BYTE SIZE
	LDB	AC1,[POINT 2,FLG,2]	;GET DEVICE DATA MODE
	SKIPN	AC2		;CONVERT ASCII LITERAL
	MOVEI	AC2,7		;TO ASCII SIZE
	ANDI	AC2,3		;WE WANT TO TURN S=6, A=7, E=9
	TRC	AC2,3		;INTO A=0, S=1, E=2
	XCT	@WCTBL(AC2)	;CONVERT CHAR
	DPB	C,[F%PADD]	;AND STORE IT FOR EASY ACCESS
	POPJ	PP,		;RETURN
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
IFN TOPS20,<
	TXNE	FLG1,B%NIO	;WANT NATIVE I/O?
	JRST	WRTNIO		;YES
>
	XCT	UOUT.		;DO THE OUTPUT
	  PUSHJ	PP,CKFOD	;NORMAL RETURN, SEE IF CHECKPOINT REQUIRED
				; DOES NOT RETURN UNLESS ERROR
WRTWAI:	XCT	UWAIT.		;FOR ALL THE ERRORS
	XCT	UGETS.		;
	TXNE	AC2,IO.ERR	;ERRORS?
	JRST	WRTERR		;THERE ARE ERRORS.
	MOVE	AC13,D.DC(I16)	; GET DEVICE CHARACTERISTICS
	TXNE	AC13,DV.MTA	;MTA?
	TXNN	AC2,IO.EOT	;EOT?
	JRST	WRTXTN		;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,SETS10	;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.
WRTXTN:	TXZE	AC2,IO.ERR!IO.EOF	;OTHER.
	XCT	USETS.		;SET STATUS
	POPJ	PP,		;RETURN
;HERE FOR NATIVE MODE I/O

IFN TOPS20,<

WRTNIO:	PUSH	PP,AC1		; JUST TO BE SURE
	PUSH	PP,AC2
	PUSH	PP,AC3		; THIS NEEDS TO BE SAVED FOR SURE
	HRRZ	AC2,D.OBH(I16)	; START OF BUFFER
	HLL	AC2,D.OBB(I16)	; BYTE SIZE
	TLZ	AC2,770000	; CLEAR JUNK
	TLO	AC2,440000	; POINT TO START
	MOVEM	AC2,D.OBB(I16)	; RESET IT
	HRRZ	AC1,D.FBS(I16)	; GET BUFFER SIZE
	MOVE	AC3,D.OBC(I16)	; GET COUNT OF WHATS LEFT
	SUB	AC3,AC1		; NEGATIVE NO. OF BYTES
	MOVEM	AC1,D.OBC(I16)	; RESET COUNT
	SKIPGE	D.OBH(I16)	; INITIAL DUMMY OUTPUT?
	JRST	[HRRZS	D.OBH(I16)	;YES, CLEAR VIRGIN BIT
		JRST	WRTNI1]		;AND RETURN
	HRRZ	AC1,D.JFN(I16)	; GET JFN
	SOUT%
	  ERJMP	WRNTER
WRTNI1:	POP	PP,AC3
	POP	PP,AC2
	POP	PP,AC1
	POPJ	PP,

WRNTER:	HALT
>
;[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 or insufficient system resources/] ;[1175]
	TXNE	AC2,IO.DTE
	OUTSTR	[ASCIZ/ data error/]
	TXNN	AC2,IO.BKT
	POPJ	PP,
	TXNE	AC13,DV.DSK	;DSK?
IFN TOPS20,<
	OUTSTR	[ASCIZ / quota exceeded or file structure full/]
>
IFE TOPS20,<
	OUTSTR	[ASCIZ / quota exceeded, file structure or rib full/]
	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
	MOVX	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:	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
;HERE FOR NATIVE MODE I/O

IFN TOPS20,<

RDNIO:	HRRZ	AC2,D.IBH(I16)	; START OF BUFFER
	HLL	AC2,D.IBB(I16)	; BYTE SIZE
	TLZ	AC2,770000	; CLEAR JUNK
	TLO	AC2,440000	; POINT TO START
	MOVEM	AC2,D.IBB(I16)	; RESET IT
	HRRZ	AC1,D.FBS(I16)	; GET BUFFER SIZE
	MOVE	AC3,D.IBC(I16)	; GET COUNT OF WHATS LEFT
	SUB	AC3,AC1		; NEGATIVE NO. OF BYTES
	MOVEM	AC1,D.IBC(I16)	; RESET COUNT
	HRRZ	AC1,D.JFN(I16)	; GET JFN
	SIN%
	  ERJMP	.+2
	POPJ	PP,
	HALT
>
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	INRST.			;[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:	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:	LDB	AC4,F.BSID	;GET SIZE OF VALUE-OF-ID
	SKIPN	AC4
	MOVEI	AC4,^D9		;9 CHARACTERS BY DEFAULT
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
	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.
;******	DO NOT ADD ANY MORE MESSAGES	*****

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./]		;11 [1037]
	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

;******	DO NOT ADD ANY MORE MESSAGES	*****
	;LOOKUP OR ENTER ERROR MESSAGES.   ***KILL OR OPNENR***

LUPERR:	MOVE	AC0,ULBLK.+1		;[1010] MOVE LOOKUP ERROR
	MOVEM	AC0,UEBLK.+1		;[1010] TO ENTER BLOCK
	TDZA				;LOOKUP ERROR
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.

	;PERFORM USE PROCEDURE AND RETRY ENTER UUO
	;LOOP TILL ENTER 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
	TLNE	FLG1,EIX		;IF INDEX FOR ISAM FILE
	JRST	OPNI00			;  EXIT HERE
	LDB	AC5,DTCN.		;[1152] CORRECT VALUE IN AC5 FOR RETRY
	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 extension.\]
	[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

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

PURGE.:	TLZ	AC16,(Z 17,)
	TXO	AC16,V%CLOS	;MAKE PURGE BE A CLOSE VERB
	SETOM	PRGFLG		;REMEMBER TO RENAME TO ZERO

C.CLOS:	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
	SKIPGE	WANT8.		;WANT 8x FUNCT?
	TLNE	FLG,OPNIO	;IS THIS FILE OPEN AT ALL?
	JRST	CLOS02		;WANT 74 OR FILE OPEN (OR BOTH)
	MOVEI	AC0,FS%42	;CLOSING WITHOUT FILE OPEN
	MOVEM	AC0,FS.FS	;SAVE FOR REPORTING
	MOVX	AC0,E.VCLO	;TELL ERROR RECOVERY THAT WE ARE CLOSING
	PUSHJ	PP,IGCVR	;
	 SKIPA			;IGNORE ERROR
	PUSHJ	PP,KILL		;FATAL

CLOS02:	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:	TLNE	FLG,OPNIN+OPNOUT	;FILE NOT OPEN?
	 JRST	CLOS05			;FILE IS OPEN
	SKIPN	F.WSMU(I16)	;IF SMU OPTION 1 BEING DONE, OPEN MUST
				; HAVE FAILED, SO WE ARE JUST CLEANING UP
				; NO NEED TO
	 JRST	PRGERR		;[1003] BOMB THE USER OUT
	  POPJ	PP,		;  JUST RETURN TO CALLING ROUTINE
CLOS05:				;

	MOVE	AC13,D.DC(I16)	;PICK UP DEVICE CHARACTERISTICS
	TXNN	AC16,CLS%CR!CLS%NR!CLS%UN ;TRYING TO CLOSE REEL, NO REWIND, REEL
	JRST	CLOS04		; NO
	TXNE	AC13,DV.MTA	;MAG-TAPE DEVICE?
	JRST	CLOS04		;YES
	SKIPL	WANT8.		;8-X?
	JRST	CLOS04		;NO
	MOVEI	AC0,FS%07	;YES,IS "FRIENDLY" ERROR
	MOVEM	AC0,FS.FS	;SAVE FOR REPORTING
	HRRZI	AC0,0		;CLEAR AC0 FOR ERROR RECOVERY ADD PROC
	TXO	AC16,CLS%IC	;FLAG AC16 FOR INVALID CLAUSE ON CLOSE
	PUSHJ	PP,IGCVR	;
	 TRN			;IGNORE ERROR RETURN
CLOS04:

IFN TOPS20,<
	TXNE	AC13,DV.LPT	;SIMPLE OUTPUT DEVICE
	JRST	CLSLPT		;YES, USE NATIVE CODE
>
	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
	TXNN	AC16,CLS%CR	;SKIP IF CLOSE REEL
	JRST	CLOSE0
	TXNN	AC13,DV.MTA	;MTA?
	POPJ	PP,		; NO, IGNORE & CONTINUE
	TXO	AC16,CLS%EV	;% CLOSE REEL
	LDB	AC5,F.BPMT	;FILE POSITION ON TAPE
	JUMPN	AC5,CLOSF5	;CLOSE "REEL" A MULTI-FILE-REEL - AN ERROR
	JRST	CLOS00
CLOSE0:	TXO	AC16,CLS%EF	;%CLOSE FILE
CLOS00:	PUSHJ	PP,SETCN.	;DISTRIBUTE THE CHAN NUMBER
	HLRZ	AC12,D.BL(I16)	;BUFFER LOCATION
	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	CLOS03		;
	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
CLOS03:	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?
	 JRST	CLOSE2		;[1112] YES, THEN NO <CR>
	TRZE	AC4,AFTADV	;[1112] SKIP IF DON'T NEED 'CR'
;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 AND CHECK FOR "EOF/V" LABEL TYPE.

CLOSE3:	TXNN	AC13,DV.MTA	; IS A MTA?
	JRST	CLOSE7		; NO, SO SKIP ALL LABEL STUFF
	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	CLOSE6		;[341] NO
	TXNE	FLG1,B%STL	;[341] IF LABELLED
	XCT	MADVF.		;[341] SKIP OVER EOF AFTER LABEL REC.

CLOSE4:	TLNN	FLG,OPNIN	;SKIP IF INPUT
	JRST	CLOSE6		;JUMP IF OUTPUT
	TXNE	FLG1,B%STL	;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, WRITE OUT THE LABEL AND LOCK THE FILE.

CLOSE6:	PUSHJ	PP,CLSCAL	;CREATE STD MTA ENDING LABEL
CLOSE7:	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

	TXNN	AC13,DV.MTA	;MTA?
	JRST	CLOSF2		;NO, SKIP TAPE STUFF
	PUSHJ	PP,OPNRWD	;REWIND UUO
	TXNE	AC16,CLS%UN	;UNLOAD?
	XCT	MREWU.		;YES
CLOSF2:	MOVX	AC0,B%HUF
	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
	TXNE	FLG1,B%STL	;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:	TLNN	FLG,IDXFIL	;[336] 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.		;DELETE 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,B%HUF	;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
	MOVX	AC0,RF1CLR	; GET MORE FLAGS
	ANDCAM	AC0,D.RFLG(I16)	; TO CLEAR
IFN TOPS20,<
	TXNE	FLG1,B%NIO	;NATIVE I/O?
	JRST	[HRRZS	AC1,D.JFN(I16)	;CLEAR JFN
		RLJFN%
		  HALT
		JRST	.+2]	;OK
>
	XCT	URELE.		;RELEASE THE DEVICE**************
	PUSHJ	PP,CLRSTS	;CLEAR FILE STATUS WORD
	JRST	FRECHN		;EXIT TO THE COBOL PROGRAM


CLOSF5:	MOVX	AC0,E.FIDX+FE%21	;ERROR NUMBER
	TLNN	FLG,IDXFIL	;SKIP IF AN ISAM FILE
	MOVX	AC0,FE%21	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	CLOS00		;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:
	TXNN	FLG,B%RER	;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
	JRST	CLSR2B		; 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:	HRRZ	AC1,D.JFN(I16)	;GET JFN
	;NOW MUST DO OPENF TO MAKE SURE THE JFN IS OPEN

	MOVE	AC3,AC1		;SAVE JFN IN CASE OF OPENF ERROR
	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)
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
	TXO	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
	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
	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
	TXNN	FLG1,B%STL	;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,FE%32	;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

	;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	CLOSE7
	;CREATE A LABEL OR ZERO IT.  ***@POPJ***

CLSCAL:	TXNE	AC13,DV.MTA	;SKIP IF DEVICE IS NOT A MTA
	TXNN	FLG1,B%STL	;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] TOPS-10 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
	JRST	CLSWL1		;[1011]
	PUSHJ	PP,CLWSMU	;[1005] YES, FREE THEM ALL
CLSWLX:>;[576] END IFE TOPS20

IFN TOPS20,<
	TXNE	FLG1,B%NIO	;NATIVE I/O?
	JRST	[HRRZ	AC1,D.JFN(I16)
		TXO	AC1,CO%NRJ	;DON'T RELEASE JFN YET
		CLOSF%
		  HALT
		JRST	CLSWL2]	;OK
>
	XCT	UCLOS.		;[576] DUMP ALL THE BUFFERS
CLSWL1:	PUSHJ	PP,WRTWAI	;[576] WAIT FOR ERROR CHECKING
IFN TOPS20,<
CLSWL2:	SKIPE	F.WSMU(I16)	;[576] [571] ANY RETAINED RECORDS?
	PUSHJ	PP,CLWSMU	;[576] SMU, FREE RETAINED BLOCKS
>;[576] END IFN TOPS20

CLSWLA:	TXNE	AC13,DV.MTA	;[573] SKIP NOT A MAGTAPE
	TXNN	FLG1,B%STL	;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	NATIVE MODE CLOSE

IFN TOPS20,<

;CLOSE for simple output device such as LPT:

CLSLPT:	SETZM	PRGFLG		;WE CAN'T PURGE LPT FILES
	TXNE	AC16,CLS%CR	;CLOSE REEL?
	POPJ	PP,		;YES, IGNORE & CONTINUE
	TXO	AC16,CLS%EF	;%CLOSE FILE
	HLRZ	AC12,D.BL(I16)	;BUFFER LOCATION
	HRRZ	AC4,D.RFLG(I16)	; NO, GET STD ASCII FLAG
	TRZE	AC4,AFTADV	; SKIP IF DON'T NEED 'CR'
;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.
	XCT	NOXCR.		; WRITE 'CR'
	HRRM	AC4,D.RFLG(I16)	; RESET FLAG
	SKIPGE	D.OBB(I16)	; SKIP IF BUFFER MIGHT HAVE DATA(NOT 44S00,LOC)
	JRST	CLSLP1		; 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
CLSLP1:	HRRZ	AC1,D.JFN(I16)
	TXO	AC1,CO%NRJ	;DON'T RELEASE JFN YET
	CLOSF%
	  HALT
	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
	MOVX	AC0,RF1CLR	; GET MORE FLAGS
	ANDCAM	AC0,D.RFLG(I16)	; TO CLEAR
	HRRZS	AC1,D.JFN(I16)	;CLEAR JFN
	RLJFN%
	  HALT
	PJRST	CLRSTS		;CLEAR FILE STATUS WORD AND EXIT TO THE COBOL PROGRAM

;CLOSE for simple input device such as CDR:

CLSCDR:	SETZM	PRGFLG		;WE CAN'T PURGE CDR FILES
	TXNE	AC16,CLS%CR	;CLOSE REEL?
	POPJ	PP,		;YES, IGNORE & CONTINUE
	TXO	AC16,CLS%EF	;%CLOSE FILE
	JRST	CLSLP1		;JOIN COMMON CODE
>
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.:	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:	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.		;IF THIS IS A REPORT WRITER CALL
	JRST	WRITE2		;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:	MOVEI	AC0,RDLAST	;TURN OFF VALID READ FLAG
	ANDCAM	AC0,D.RFLG(I16)
	TLNN	FLG,OPNOUT	;SKIP IF OPEN FOR OUTPUT
	JRST	ERROP3		;ERROR MESSAGE
	TLNE	FLG,IDXFIL	;
	JRST	IWRITE		;WRITE AN INDEX-FILE

	;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
	CAIN	AC0,%FAM.S	;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	;NO, 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
	MOVEI	AC4,AFTADV	; NO, GET AFT-ADV ASCII FLAG
	IORM	AC4,D.RFLG(I16)	; SET 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
	  TRNA			;NORMAL RETURN
	AOS	(PP)		;COPY END OF PAGE SKIP RETURN
	JRST	WRTRCB		; CONT

WRTRCA:	JUMPGE	FLG,WRTRCB	; JUMP THIS IF NOT ASCII
	HRRZ	AC0,D.RP(16)	;[1171] IS THIS THE FIRST RECORD?
	JUMPLE	AC0,WRTRCB	;[1171] IF SO, DON'T OUTPUT CRLF

	; 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?
	PUSHJ	PP,WRTCRLF	; NO, THEN WRITE CR-LF
				; YES, NO CRLF

WRTRCB:	JUMPE	AC3,WRTZRE	;TRYING TO WRITE A NULL REC?

;SUPPRESS TRAILING BLANKS FOR ASCII OUTPUT FILES IF REQUIRED
	SKIPN	SUPTB.		; COBOL SYNTAX TO SUPPRESS TRAILING BLANKS SEEN?
	JRST	WRTSIX		; NO
	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

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	WRTRE6		; ELSE DO CR-LF
	PUSHJ	PP,WRTADV	;WADV.
	  JRST	WRTRE6		;[1125] NORMAL RETURN
	SKIPN	RPTW.##		;[1125] SKIP RETURN, DOING RPTW?
	AOS	(PP)		; NO, COPY END-OF-PAGE SKIP RETURN
	SETZM	RPTW.##		;[1125] SET FLAG TO ZERO
	JRST	WRTRE6		; CONT


; PADLAB	ROUTINE TO SAVE 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


	;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:	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:	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:	MOVEI	AC0,RDLAST
	TXNE	AC16,V%READ	;DOING READ?
	IORM	AC0,D.RFLG(I16)	;YES, TURN ON VALID READ FLAG
	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,(V%CLOS+CLS%RO+CLS%CR)	;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

	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 @ OPNDVC
	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
	TXNN	FLG,B%RRC	;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
	JRST	CKRRN2

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

CKRRN2:	PUSHJ	PP,RRDMP	;DUMP

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

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

;FORCE A CALL TO RRDMP
RENDP:	SETOM	REDMP.		;
IFN	TOPS20,<
	SAVACS			;[1206]SAVE ACS
	MOVEI	1,.FHSLF	;[1206]SELF PROCESS HANDLE
	MOVEI	2,XTDBLK	;[1206]ARG. BLOCK
	XRIR%			;[1206]READ BLOCK
	  ERJMP [RSTACS
		 JRST @.JBOPC##];[1206]4.1 MONITOR... OLD WAY
	MOVE	1,XTDBLK+1	;[1206]GET TABLE ADDRESS
	MOVE	1,(1)		;[1206]FIRST INDIRECTION...
	MOVEM	1,SAVADR	;[1206]
	RSTACS			;[1206]
	XJRSTF	@SAVADR
	  ERJMP .+1
	>
	JRSTF	@.JBOPC		;CONTINUE
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,FS%30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	MOVEI	AC0,FE%35	;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,FS%30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	HRRZM	AC2,.JBFF	;BACK OUT OF OVERLAY AREA
	MOVEI	AC0,FE%8		;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:	TLNE	FLG,DDMBIN	;[343] IF BINNARY LET NXT WRITE/CLOSE OUTPUT IT
	JRST	WRTR18
	SKIPE	F.PADD(I16)	;DID USER SUPPLY PADDING CHAR?
	PUSHJ	PP,PADBUF	;YES, PADD REST OF BUFFER WITH 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 RECORD 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
	JUMPN	C,WAD2		;GIVE UP IF NOT JUST LINE FEED
	SKIPE	D.LCV(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

	SKIPN	D.LCV(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,D.LCV(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,D.LCV(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,D.LCV(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

WRTDC3:	PUSHJ	PP,WRTCR	;CR
	MOVEI	C,$DC3		;DC3
	JRST	WRTCH		;WRITE AND RETURN

WRTCRLF:
	PUSHJ	PP,WRTCR	;CR-LF
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,

;HERE TO PADD BUFFER WITH PADD CHARACTER
PADBUF:	SKIPG	D.OBC(I16)	;ALREADY FULL?
	POPJ	PP,		;YES
	PUSH	PP,C		;JUST TO BE SURE
	LDB	C,[F%PADD]	;GET CHAR
	IDPB	C,D.OBB(I16)	;STORE IN BUFFER
	SOSLE	D.OBC(I16)	;FULL YET?
	JRST	.-2		;NO
	POP	PP,C		;YES
	POPJ	PP,		;RETURN

;SEE IF ZERO LEN RECORD IS LEGAL
WRTZRE:	SKIPE	NOCR.		;
	JRST	WRTRE2		;A WAY TO GET ONLY PAPER-ADVANCING-CHARS
	MOVEI	AC0,FE%23	;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,		;
ERROP3: AOS	(PP)		;WRITE ERROR IMPROPER OPEN MODE
	MOVEI	AC0,FS%30	;IS PERMANENT ERROR
	MOVE	AC1,D.RFLG(I16)	;GET OPEN EXT FLAG
	TXNN	AC1,EXTOPN	; FILE OPENED FOR EXTEND?
	TXNE	FLG,OPNOUT	;  OPENED FOR OUTPUT?
	 TRNA			; YES TO ONE OR THE OTHER
	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	ERROP4		; NO
	MOVEI	AC0,FS%48	;YES, SET PROPER FILE-STATUS
	MOVEM	AC0,FS.FS	; AND SAVE FOR REPORTING
ERROP4:	MOVEI	AC0,FE%22	;THE "OUTPUT" MESSAGE
	JRST	ERROP2

ERROPN: AOS	(PP)		;REWRITE-DELETE ERROR IMPROPER OPEN MODE
				; ALSO, WRITE "DUPL KEY VIOL" C-74
	TXNN	AC16,V%RWRT!V%DLT ;REWRITE OR DELETE?
	JRST	ERROP4		; NO
	MOVEI	AC0,FS%30	;IS PERMANENT ERROR
	TXNE	FLG,OPNIO	;  OPENED FOR IO?
	 TRNA			; YES
	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	ERROP4		;NO,
	MOVEI	AC0,FS%49	;yes, SET I-O FILE-STATUS
	MOVEM	AC0,FS.FS	; AND SAVE FOR REPORTING
	JRST	ERROP4

ERROP1:	MOVEI	AC0,FS%47
	SKIPGE	WANT8.		;WANT 8x FUNCT?
	MOVEM	AC0,FS.FS	;YES, SAVE IT FOR REPORTING
	MOVEI	AC0,FE%34	;THE "INPUT" MESS

ERROP2:	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"
	TXNN	AC16,V%RWRT!V%DLT ;FOR "REWRITE" OR "DELETE"?
	JRST	ERDLR1		;NO
	OUTSTR	[ASCIZ/ for Input-Output./]
	SETZ	AC2,		;GO TO KILL
ERDLR1:	PUSHJ	PP,MSOUT.	;NEVER RETURNS

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
	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	ERRMR3		;NO
	MOVEI	AC0,FS%04	;WRONG-LENGTH RECORD FOR READ
	TXNE	AC16,V%RWRT!V%WRIT!V%WADV ;DOING WRITE OR REWRITE?
	MOVEI	AC0,FS%44	; YES, SOCK IT TO EM!
	MOVEM	AC0,FS.FS	;AND SAVE IT ASIDE
ERRMR3:	MOVEI	AC0,FE%6	;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]
	PUSHJ	PP,MSOUT.	;CANNOT DO OUTPUT (OR INPUT)

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

ERRLR2:	PUSH	PP,AC0		;SAVE MAX-REC-SIZE
	TLNE	FLG,IDXFIL	;ISAM FILE?
	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	ERRRL3		;NO
	MOVEI	AC0,FS%04	;WRONG-LENGTH RECORD FOR READ
	TXNE	AC16,V%RWRT!V%WRIT!V%WADV ;DOING WRITE OR REWRITE?
	MOVEI	AC0,FS%44	; YES, SOCK IT TO EM!
	MOVEM	AC0,FS.FS	;AND SAVE IT ASIDE
ERRRL3:	MOVEI	AC0,FE%6	;THE ERROR NUMBER
	ADD	AC0,[E.FIDA]	;YES
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	ERRMRX		;YES

	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ /The minimum record size may not be exceeded./]
	JRST	ERRMR
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	;TURN ON READ NEXT FLAG
READ.:	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.RD	; YES
	MOVEI	AC0,RDLAST	;TURN OFF VALID READ FLAG
	ANDCAM	AC0,D.RFLG(I16)	;ONLY TURN ON IF SUCCESSFUL
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
	SKIPGE	WANT8.		;WANT 8x FUNCT?
	TXNN	AC16,V%RNXT	;YES, DOING READ NEXT?
	JRST	FAKER2		; NO
	MOVE	AC0,D.RFLG(I16)	;GET EXTRA FLAGS
	TXNN	AC0,B%BDRD	;BAD READ PRECEDES?
	JRST	FAKER2		;NO
	MOVEI	AC0,FS%46	;SET UP READ SEQ AFTER BAD READ F-S CODE
	MOVEM	AC0,FS.FS	; AND SAVE IT ASIDE
	MOVEI	AC0,FE%60	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;SET UP FILE-STATUS
	 JRST	KILL		; MAKE FATAL IF ERROR RETURN
FAKER2:	MOVX	AC0,B%BDRD 	;CLEAR BAD-READ FLAG
	ANDCAM	AC0,D.RFLG(I16)	; IN FILE-TABLE ENTRY
	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
	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
	JUMPE	AC4,RED31B	;NO TESTS IF ZERO
	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:	LDB	AC3,F.BLRS	;LOAD MINIMUM SIZE
	CAMG	AC3,AC4		;IS RECORD LESS THAN MINIMUM
	JRST	RED31B		;NO
	PUSHJ	PP,ERRLR2	;ERROR MESSAGE

	;PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;IS SMALLER THAN FD MINIMUM

	OUTSTR	[ASCIZ/%Record length field smaller than FD minimum.
/]

RED31B:	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
	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
	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 B%VLER 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:	JUMPE	AC4,RER7A	;NO TESTS IF ZERO
	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


RER7:	LDB	AC3,F.BLRS	;LOAD MINIMUM SIZE
	CAMG	AC3,AC4		;IS RECORD LESS THAN MINIMUM
	JRST	RER7A		;NO
	PUSHJ	PP,ERRLR2	;ERROR MESSAGE

	;PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;IS SMALLER THAN FD MINIMUM

	OUTSTR	[ASCIZ/%Record length field smaller than FD minimum.
/]

	;MOVE THE RECORD INTO THE RECORD AREA
RER7A:	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,FE%39	; 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,FE%40	; 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,FE%41	; 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,FE%42	; 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,FE%43	; 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,FE%44	; 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
	MOVEI	AC0,FS%10	;GIVE AT END ERROR
	SKIPL	WANT8.		;UNLESS WANTS -8x STATUS
	JRST	RERE7B		;NO, 74 IS WHAT WE WANT
	LDB	AC0,F.BFAM	;GET ACCESS MODE
	JUMPE	AC0,RERE7A	;SEQUENTIAL ACCESS
	TXNE	AC16,V%RNXT	; OR READ NEXT
	JRST	RERE7A		; IS ERROR 15
				;OTHERWISE IT IS START OR READ WITH INV KEY
	MOVEI	AC0,FS%25	; WHICH IS ERROR 25
	JRST	RERE7B

RERE7A:	MOVEI	AC0,FS%15	;SET UP FILE STATUS 15 FOR SEQUENTIAL READ
RERE7B:	PUSHJ	PP,SET10A	;SET FILE STATUS .. THIS ROUTINE SAVES
				; AC0 IN FS.FS AS ITS FIRST STEP
	JRST	RET.2		;SKIP EXIT

RNULER:	MOVE	AC0,D.LBN(I16)	; GET LAST BLK NUMBER,IF THERE IS ONE
	JUMPE	AC0,RNRNUA	; NONE, GIVE ERROR
	CAME	AC0,D.CBN(I16)	; SKIP IF LAST BLOCK
	JRST	RNRNUA		; NO(T) LAST BLOCK,ERROR
	SETZM	R.WRIT(I12)	; ZERO THE WRITE FLAG
	MOVEI	AC0,RDLAST	;THIS ONE ALSO
	ANDCAM	AC0,D.RFLG(I16)
	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,SETS10	;[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.
	TXNN	FLG1,B%STL	;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,(V%CLOS+CLS%CR)	;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,FE%25	;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

;File is already AT END or second READ of non-existant optional file

REAAEE:	TXNE	FLG,IDXFIL	;INDEXED FILE?
	SETOM	FS.IF		;YES, SET FLAG
	MOVEI	AC0,FS%30	;ERROR NUMBER FOR PERM ERROR
	SKIPGE	WANT8.		;DOES USER WANT ANS-8x EFFECT?
	MOVEI	AC0,FS%16	;YES, RETURN WITH FILE STATUS = 16
	MOVEM	AC0,FS.FS	;
	MOVEI	AC0,FE%24
	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 previously./]
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,FE%26	;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:
	SKIPE	F.WSMU(I16)	;[1162] Doing SMU on this file
	 SKIPN	SU.RR		;[1162] Yes, within scope of retain/free
	  SKIPA			;[1162] Everything OK
	   JRST	STRT.E		;[1162] Can't do START within RETAIN
	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
	JRST	FAKER.		;[1162]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,SETS23	; SET REC NOT FOUND (23)
	JRST	RET.2		;AND GIVE ERROR RETURN
STRT.E:	OUTSTR	[ASCIZ/Attempt to execute START verb within scope of RETAIN and FREE statements/]
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

	;READ IN THE LOGICAL BLOCK, AND POINT AT THE RECORD.

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		;
	PUSHJ	PP,SETKEY	;SET AND CHECK RELATIVE KEY
	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.
	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
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RAND2A		; NO, CONT
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	CAIN	AC0,%FAM.S	; IF NOT SEQ ACCESS SKIP POSITION CHANGE
RAND2A:	MOVEM	AC5,R.BPNR(I12)	;SAVE AS CURRENT RECORD

	;HERE TO CHECK THAT NEW RECORD SIZE IS BETWEEN MIN AND MAX

RANDO2:	HRRZ	AC2,@AC5	;RECORD SIZE IN CHARACTERS
	JUMPE	AC2,RNDO19	;NO TEST IF ZERO
	LDB	AC0,F.BLRS	;MIN RECORD SIZE
	CAML	AC2,AC0		;IS RECORD LESS THAN MINIMUM
	JRST	RNDO19		;NO
	PUSHJ	PP,ERRLR2	;ERROR MESSAGE

	;PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;IS SMALLER THAN FD MINIMUM

	OUTSTR	[ASCIZ/%Record length field smaller than FD minimum.
/]
	HRRZ	AC2,@AC5	;GET RECORD SIZE AGAIN

RNDO19:	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!
	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?
	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
	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,SETS23	;[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:	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
	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:	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
	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
	MOVEI	AC0,RDLAST	;TURN ON VALID READ FLAG
	IORM	AC0,D.RFLG(I16)
	JRST	RAND10

RANDO9:	SETOM	R.DATA(I12)	;FORCE WRITE LATER
	SETOM	R.WRIT(I12)	;REMEMBER IT WAS A WRITE
	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

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

	; IF R.DLRW(I12) SET THEN READ BACK "CURRENT" DSK BLK

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

SQIO1A:	SKIPN	R.WRIT(I12)	;SKIP IF WRITE WAS LAST
	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,SETS10	; [601] NO NEXT REC STATUS (10)
	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
	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNERAA		; NO, CONT
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	CAIN	AC0,%FAM.S	; 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:	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,FS%23	; READ INVALID KEY
	MOVEM	AC1,FS.FS	; LOAD FILE-STATUS
	JRST	RNER40		; EXIT

	;RESTORE THE NULL CHARS IF ANY

RNER06:	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:	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:	LDB	AC3,F.BLRS	;LOAD MINIMUM SIZE
	CAMG	AC3,-4(AC1)	;IS RECORD LESS THAN MINIMUM
	JRST	RNR10D		;YES
	PUSHJ	PP,ERRLR2	;ERROR MESSAGE

	OUTSTR	[ASCIZ/%Record length field smaller than FD minimum.
/]

RNR10D:	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
	JUMPGE	FLG1,RNR30A	; JUMP IF FIXED LEN RECORDS
	PUSHJ	PP,RNDW		; GET RDW INTO AC1
	JUMPN	AC1,RNR30C	; IT WILL BE 0 IF WE ARE APPENDING
	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

	;CHECK FOR NULL RECORD ERRORS

RNR30A:	PUSH	PP,AC5		;[1006] [700] SAVE DEST POINTER
	PUSH	PP,AC3		;[1006] [700]  AND BYTES/REC
RNR30D:	ILDB	AC1,AC5		;[1006] [700] GET A BYTE
	SKIPN	AC1		;[1006] [700] CONTINUE WHEN NON-NULL FOUND
	SOJG	AC3,RNR30D	;[1006] [700]  OR WHEN NO BYTES LEFT
	POP	PP,AC3		;[1006] [700] RESTORE BYTES/REC
	POP	PP,AC5		;[1006] [700]  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

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

	;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

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

WRTNUL:	TLNE	FLG,RANFIL
	TXNN	AC16,V%WRITE	;RANDOM WRITE ?
	POPJ	PP,		; NO,OK- GO BACK
	PUSHJ	PP,SETS22	;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
	HLLZS	UOUT.		;[1151] CLEAR RIGHT HALF DUMP MODE IOWD
	POP	PP,(PP)		; KILL RETURN TO CALL POINT
	JRST	RET.3		;BYPASS WRITE PARAMETERS & GIVE ERROR RETURN

RANWRZ:	PUSHJ	PP,WRTNUL	; CHECK FOR WRITE ON NULL (NO RETURN ON ERROR)

RANWR0:	TXNE	AC16,V%DLT	;[670] IF DELETE
	JRST	.+3		;[670]	SKIP BINARY CHECK
	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:	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
	  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
	  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]
	TXNE	AC16,V%RWRT	;[A1114] DOING REWRITE?
	 JRST	RNWR2B		;[A1114] YES, DON'T PUT IN <CR><LF>
	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
;[1023] Test is taken out.
;[1023]	TXNE	AC16,V%RWRT	; IS THIS RERIT?
;[1023]	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


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 WORD OF NEXT RECORD
	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 THE RECORD POINTER & SIGNAL ACTIVE DATA

RANDLA:	HRRZ	AC1,AC5		; GET ADR OF FIRST REC WORD
	JUMPE	AC2,RNDLER	;[670] NULL RECORD, 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==RANDO3		;[601] EXIT WITH INVALID KEY
	;MOVE THE RANDOM/IO BUFFER AREA TO THE RECORD AREA.  ***RANXIT***

RANREA:	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:	MOVEI	AC1,FS%23	;[1013] 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	C,$CR		;[1031] EXCLUDE <CR> AND <LF> WHEN
	CAIN	C,$LF		;[1031]  DECREMENTING THE CHARACTER COUNT
	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,SETS10	;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:	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

;[1024] This 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

RANR14:	TXNN	AC16,V%DLT+V%RWRT ; IS THIS DELETE OR RERIT?
	JRST	RNR14A		; NO, CURRENT POSITION RESET
	LDB	AC0,F.BFAM	; GET ACCESS MODE
	CAIN	AC0,%FAM.S	; 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:	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:
	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:
	TLNE	FLG,RANFIL	;[1065]IF A RELATIVE FILE
	SKIPN	F.WSMU(I16)	;[1065] AND SMU OPTION 1 IN EFFECT
	 JRST	RNXI0A		;[1065]NOT EITHER (CAN BE NOT BOTH)
	TXNN	AC16,V%RNXT	;[1065]AND READ NEXT
	 JRST	RNXI0A		;[1065] IS NOT
	MOVE	AC2,SU.T1##	;[1065]GET RRT ENTRY ADDR SAVED BY SU.XX ROUTINE
	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,3(AC2)	;[1065]  PUT IT IN THE RRT ENTRY.
RNXI0A:				;[1065]
	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
;[1064]	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE ?
;[1064]	PUSHJ	PP,LRDEQX##	; YES
	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
	SETOM	R.WRIT(I12)	;READ NOT SUCCESSFUL
	MOVEI	AC1,RDLAST
	ANDCAM	AC1,D.RFLG(I16)	;HERE ALSO
	SKIPN	AC1,FS.FS	; NO CHANGE IF NON ZERO
	MOVEI	AC1,FS%10	; READ INVALID KEY
	MOVEM	AC1,FS.FS	; LOAD FILE-STATUS
	JRST	RANXI2		;

RANXI8:	PUSHJ	PP, SETS23	; 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
	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
	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:	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:	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
	TRNA			; AND SKIP

RANI0A:	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
	PUSHJ	PP,FUSI		; DO A FILOP. TYPE USETI
RANI00:	HRRM	AC12,UIN.	;DUMP MODE IOWD
	LDB	AC5,F.BBKF	;BLOCKING FACTOR
REPEAT 0,<
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
	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
	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,SETS10	; [601] YES,SET NO NEXT RECORD
	JRST	RANIN5		; [601] GO ON

RANN4A:	PUSHJ	PP,SETS23	; [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
	PUSHJ	PP,FUSO		; DO A FILOP. TYPE USETO
	MOVE	AC1,D.CBN(I16)	;NEXT BLOCK BECOMES CURRENT BLOCK
	HRRM	AC12,UOUT.	;DUMP MODE IOWD
	JRST	WRTOUT		;DO IT

	;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,		;
	;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,SETS24	;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
	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
	PUSHJ	PP,FUSI		; DO A FILOP. TYPE USETI
	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,

;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] CLEAR BUFFER ADDRESS
	PUSHJ	PP,VNDE1	; READ FRESH COPY OF STATISTICS BLOCK
	  POPJ	PP,		; NO NEW LEVELS EXIT
	POPJ	PP,
SUBTTL ISAM-CODE

;INDEX-SEQ READ
IREAD:	TLZ	FLG1,F1CLR	;[605]  INITIALIZE FLG1 FOR ISAM FLAGS
	PUSHJ	PP,SETIC	;SET THE CHANNEL
	HRR	AC0,F.WBSK(I16)
	HRRM	AC0,GDPSK(I12)
	AOS	RWRSTA(I12)	;# OF READ/WRITE/REWRITES
	TXNE	AC16,V%STRT	;[605] SKIP IF NOT START
	JRST	ISTRT		;[605] START GOES HERE
	PUSHJ	PP,LVTST	;RECORD KEY = LOW-VALUES ?
	 JRST	SREAD		;YES, SEQUENTIAL READ

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

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 = RECORD KEY FOUND

	TXNE	AC16,STA%EQ	;[605] RECORD 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,SETS23	;[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 = RECORD 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
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:	TXNE	AC16,V%STRT	;[605] IS THIS START??
	 JRST	RDIV1B		; YES
	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
	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,SETS23	;[601] SET NO RECORD ERROR
	TXNE	AC16,V%DLT	; RERITE AND READ SKIP
	POPJ	PP,		; DELETE ALREADY HAS A SKIP EXIT
	JRST	RET.2		;INVALID-KEY RETURN

RDIV1B:				;
	SKIPE	F.WSMU(I16)	;DOING SMU OPTION 1?
	 PUSHJ	PP,LRDEQX##	; YES, GO DEQ IMPLICITLY
	JRST	RET.2		;[605] GIVE SKIP RETURN TO START CALL
	;SEQUENTIAL READ
SREAD:	TLO	FLG1,SEQ	;FLAG SREAD
	TXNE	AC16,V%RTAN	;[JSM] DOING SMU RETAIN?
	JRST	SR1		;[JSM] YES, BYPASS THE "SAVE"
	SKIPLE	SU.FRF		; IS THIS RETAIN OF DEL/REWRIT?
	PUSHJ	PP,SVDLRW	; YES, SAVE "CURRENT" RECORD POSITION
SR1:	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
	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
	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


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


	;TRY FOR THE NEXT DATA REC IN THIS BLOCK
SREAD1:	SETZ	LVL,		;WE ARE AT LEVEL 0!
	HRRZ	AC4,CNTRY(I12)	;CURRENT ENTRY
	TXNE	AC16,V%RTAN	;[JSM] DOING SMU RETAIN?
	JRST	SR2		;[JSM] YES, CNTRY PROBABLY BLOWN AWAY
	SKIPE	NNTRY(I12)	;CNTRY ALREADY POINTING AT NEXT ENTRY?
	JRST	SREAD2		;YES
SR2:	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
;	POPJ	PP,		;[605][1075] RETURN
	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,SETS10	;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 RECORD 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 RECORD 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 RECORD 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 RECORD KEY
LV2SK.:: MOVE	AC1,F.WBSK(I16)	;RECORD KEY 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 RECORD KEY
	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 RECORD KEY
SUBTTL	DELETE and REWRITE VERBs

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

DELET.:	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.DL	; YES
	TXO	AC16,V%DLT	;
	JRST	RERIT1		;

	;HERE TO REWRITE AN EXISTING RECORD

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

RERIT.:	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
	TXNE	AC16,V%DLT	;IS IT DELET?
	JRST	RERIT3		; YES,SKIP I-O CHECK
	LDB	AC3,WOPRS.	;NO,GET ACTUAL REC SIZE
	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.


RERIT3:	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
	TRZN	AC0,RDLAST	;[1121] WAS READ LAST IO OPERATION
	JRST	ERDLRW		; NO GIVE ERROR CASE
	HRRM	AC0,D.RFLG(I16)	;[1121] STORE FLAG
	JRST	RERIT4		;[1121] YES, CHECKS OK

RERT3A:	HLRZ	I12,D.BL(I16)	; GET BUFFER POINTER
	SKIPE	R.WRIT(I12)	; READ LAST I-O ?
	JRST	ERDLRW		; NO, ERROR
	MOVEI	AC0,RDLAST
	ANDCAM	AC0,D.RFLG(I16)	;BUT MAKE SURE ITS OFF
	JRST	RANDOM		; YES, CHECKS OK

ERDLRW:	MOVEI	AC0,FS%43	;GIVE FS FOR NO PRECEDING VALID READ.
	MOVEM	AC0,FS.FS	; AND SAVE IT FOR REPORTING
	MOVEI	AC0,FE%61	;ERROR NUMBER
	SETOM	FS.IF		;IDX FILE
	TLNE	FLG,IDXFIL	;ISAM FILE?
	ADD	AC0,[E.FIDX]	;YES
	SETZ	AC2,
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	  JRST	RERT3B		;YES, GIVE A FAILURE RETURN
RERT3C:	PUSHJ	PP,DSPL1.	;DUMP CURRENT BUFFER, APPEND CR-LF
	OUTSTR	[ASCIZ/A successful READ must precede DELETE or REWRITE for SEQUENTIAL access files/]
	MOVE	AC2,[BYTE (5)10,31,20,14]
	PUSHJ	PP,MSOUT.	;STANDARD PART OF MESSAGE
	JRST	KILL		;GIVE UP

RERT3B:	SKIPL	WANT8.		;WANT 8x FUNCT?
	JRST	RERT3C		;NO, GIVE ERROR ANY WAY
	TXNE	AC16,V%RWRT	;REWRITE?
	AOS	(PP)		;YES, ACCOUNT FOR EXTRA WORD FOLLOWING
	JRST	RET.2		;RETURN WITH FAILURE

	; HERE FOR ISAM RERIT AND DELETE

RERIT4:	PUSHJ	PP,LVTST	;LOW-VALUES IN RECORD KEY?
	 JRST	LVERR		;YES, ITS ILLEGAL

	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
RRIT2A:	AOS	RWRSTA(I12)
	TLZ	FLG1,F1CLR	;[605]  INITIALIZE FLG1 FOR ISAM FLAGS
	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
	PUSHJ	PP,CLRSTS	;[601] SET STATUS TO 00

	MOVEI	AC1,RDLAST	; CLEAR READ LAST IO OPERATION
	ANDCAM	AC1,D.RFLG(I16)

	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
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:	TLZ	FLG1,F1CLR	;[605]  INITIALIZE FLG1 FOR ISAM FLAGS
	PUSHJ	PP,LVTST	;LOW VALUES IN RECORD KEY?
	 JRST	LVERR		;ILLEGAL!

	;  CLEAR SAVED NEXT RECORD POSITION FLAG
;[1021]	HRRZ	AC0,D.RFLG(I16)	; GET SOME FLAGS
;[1021]	TRZE	AC0,SAVNXT	; CLEAR FLAG FOR NXT REC POS SAVED
;[1021]	HRRM	AC0,D.RFLG(I16)	; PUT IT BACK IF WAS SET
	PUSHJ	PP,SVDLRW	;[1021] SAVE CURRENT RECORD POSITION AND CONTINUE

	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 RECORD KEY
	MOVEM	AC0,GDX.I(I12)	;[465] AND USE DATA VS RECORD 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 RECORD KEY
	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 RECORD KEY
	PUSHJ	PP,UDIF		;UPDATE THE INDEX FILE
	PUSHJ	PP,WIBK		;WRITE THE INDEX BLOCK

IWRIX:	PUSHJ	PP,@GETSET(I12)	;[1001] RESET INDEX AND DATA POINTERS
	SKIPE	OLDBK		;ANY BLOCKS TO DEALLOCATE
	PUSHJ	PP,DALC		;YES, DOIT
;[1064]	SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
;[1064]	PUSHJ	PP,LRDEQX##	; YES

	MOVEI	AC1,RDLAST	; CLEAR READ LAST IO OPERATION
	ANDCAM	AC1,D.RFLG(I16)

	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
	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:
	SETZM	NNTRY(I12)	;[1021] CLEAR NEXT REC FLAG, NO CURRENT REC
	SETZM	CNTRY(I12)	;[1021] CLEAR CURRENT DATA ENTRY TO INDICATE
				;[1021] SEQ READ CURRENT ENTRY IS NOT SET
	JRST	RET.2


IWIVK:	SKIPN	BRISK(I12)	;[466] SKIP IF NOT SLOW MODE
	TLO	FLG1,WIVK	;[466] SET FLAG
	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,FS%22	;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,SETS22	;SET STATUS TO 22
	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
REPEAT 0,<
;DELETE FOR NOW AS IT CAUSES NAVY TESTS IX104 & IX204 TO FAIL
	SETOM	FS.IF		;[462] TURN ON THIS IS ISAM FLAG
	MOVX	AC0,E.FIDX+E.BIDX+FE%27 ;[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
	MOVX	AC0,E.FIDX+E.BIDX+FE%2	;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,FS%30	;RERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVX	AC0,E.FIDX+E.BIDX+FE%3	;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,FS%30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVX	AC0,E.FIDX+E.BIDX+FE%36	;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 RECORD KEY
	;ADJUST ONE TO MATCH IDXKEY, AND ONE TO RECKEY

ADJKEY:	MOVE	AC0,F.WBSK(I16)	;RECORD 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		;RECORD KEY
	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 RECORD KEY
	POPJ	PP,


	;CONVERT NUMERIC DISPLAY OR COMP-3 TO ONE/TWO WRD INTEGER
GD67:	PUSH 17,16		;[1161]SAVE AC 16
	MOVEI	AC16,ACSAV0	;[1161]
	BLT	AC16,ACSAV0+16	;[1161]
	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	AC16,ACSAV0	;[1161]
	BLT	AC16,AC16	;[1161]
	POP	17,16		;[1161]Restore ac16
	POPJ	PP,


	;GET SET FOR ONE/TWO WRD INTEGER
FPORFP:	MOVE	AC1,F.WBSK(I16)	;RECORD 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)	;RECORD 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)	;RECORD KEY
	TLC	AC0,1B18	;
	TLC	AC3,1B18	;
	CAMG	AC0,AC3		;
	JRST	IBSGE		;RECORD KEY GT IDX-KEY
	JRST	IBSLT		;RECORD KEY LT IDX-KEY


	;INDEX COMPARE ONE WORD SIGNED
IC1S:	MOVE	AC0,@IAKBP(I12)	;RECORD KEY
	CAMGE	AC0,2(AC10)	;
	JRST	IBSLT		;RECORD KEY LT IDX-KEY
	JRST	IBSGE		;RECORD KEY EQ OR GT IDX-KEY

	;TWO WORD SIGNED
IC2S:	MOVE	AC0,@IAKBP(I12)	;SYM-KEY
	CAMGE	AC0,2(AC10)	;
	JRST	IBSLT		;RECORD KEY LT IDX-KEY
	CAME	AC0,2(AC10)	;
	JRST	IBSGE		;RECORD 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		;RECORD KEY EQ REC-KEY
DCDNN3:	MOVE	AC3,(AC1)	;
	TLC	AC0,1B18	;
	TLC	AC3,1B18	;
	CAMG	AC0,AC3		;
	JRST	DSGT		;RECORD KEY GT REC-KEY
;	JRST	DSLT		;RECORD 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 WORD 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	>
	PUSHJ	PP,FIUSI	; DO A FILOP. TYPE USETI
	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:	MOVX	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
	MOVX	AC0,E.FIDA+E.BDAT+FE%4	;ERROR NUMBER
	CAIE	LVL,0		;SKIP IF DATA BLOCK
	MOVX	AC0,E.FIDX+E.BIDX+FE%4	;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:	PUSHJ	PP,FUSI		; DO A FILOP. TYPE 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,FS%30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVX	AC0,E.FIDX+FE%35	;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	;
	PUSHJ	PP,FUSO		; DO A FILOP. TYPE USETI
	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:	MOVX	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)	;
	PUSHJ	PP,FIUSO	; USE FILOP. TYPE USETO
	XCT	IOUT		;
	  PUSHJ	PP,CKFOI	;[523] DO CHECK POINT FILOP.(.FOURB)
WIBK2:	MOVE	AC0,CMDLST	; RESTORE AC0
	CAMN	AC0,IOWRD+13(I12);SAT BLOCK?
	MOVX	AC0,E.BSAT	;YES
	CAMN	AC0,IOWRD+14(I12);STATISTICS BLOCK?
	MOVX	AC0,E.BSTS	;YES
	CAIG	AC0,0		;NONE OF THE ABOVE?
	MOVX	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]
	PUSHJ	PP,FIUSI	; USE FILOP. TYPE USETI
IFN ISTKS,<AOS INSSSS+14(I12)	;COUNT THE IN'S	>
	XCT	IIN		;[307]
	 POPJ	PP,		;[307]
	MOVX	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)
	PUSHJ	PP,FIUSI	; USE FILOP. TYPE USETI
IFN ISTKS,<AOS INSSSS+13(I12)	;COUNT THE IN'S	>
	XCT	IIN
	 POPJ	PP,
	MOVX	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:	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


	; 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

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

;[1064]	SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
;[1064]	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:
	MOVEI	AC1,RDLAST	; SET READ LAST IO OPERATION
	IORM	AC1,D.RFLG(I16)
	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.	;
	JUMPE	AC3,MVRB00	;NO TEST IF ZERO
	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:	LDB	AC0,F.BLRS	;LOAD MINIMUM SIZE
	CAMG	AC0,AC3		;IS RECORD LESS THAN MINIMUM
	JRST	MVRB00		;NO
	PUSHJ	PP,ERRLR2	;ERROR MESSAGE

	;PRINT WARNING THAT RECORD LENGTH FIELD (SIXBIT OR V FORMAT)
	;IS SMALLER THAN FD MINIMUM

	OUTSTR	[ASCIZ/%Record length field smaller than FD minimum.
/]

MVRB00:	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
	MOVX	AC0,E.FIDX+E.BSAT+FE%5	;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 FOR ISAM FILE
	;POPJ IF RECORD KEY = LOW-VALUES, SKIP EXIT IF NOT
LVTST:	HLRZ	I12,D.BL(I16)	;SETUP I12
	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 STRING 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 STRING 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 /RECORD 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
	MOVX	AC0,E.FIDX+FE%1	;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] ZERO RIGHT HALF

	; NOW RESET BACK TO LAST POSITION BEFORE DOING CHK-PNT

	MOVE	AC1,D.CBN(I16)	; CURRENT BLOCK
	PUSHJ	PP,FUSO		; DO A FILOP. TYPE 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,<
	JRST	PPOPJ		;RIB UPDATE WILL BE DONE BY MONITOR
>
	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,<
	JRST	PPOPJ		;RIB UPDATE WILL BE DONE BY MONITOR
>
	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

;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	.+1		; ERROR RETURN
	POPJ	PP,		; 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	.+1		; ERROR RETURN
	POPJ	PP,		; 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,EU%18
	TXNE	AC2,IO.DER	;DEVICE ERROR
	MOVEI	AC1,EU%19
	TXNE	AC2,IO.DTE	;DATA ERROR
	MOVEI	AC1,EU%20
	TXNE	AC2,IO.BKT	;QUOTA EXCEEDED, FILE STR, OR RIB FULL
	MOVEI	AC1,EU%21
	TXNE	AC2,IO.EOF	;EOF
	MOVEI	AC1,EU%22
	MOVEI	AC3,FS%34	;ASSUME DSK FULL
	TXNE	AC2,IO.BKT	;IS IT?
	JRST	IGMD2		;YES
	SKIPN	AC3,FS.FS	;NO CHANGE IF NON ZERO
	MOVEI	AC3,FS%30	;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:	TXNN	AC16,CLS%EF!CLS%EV!CLS%BV!CLS%IC ;SOME NON-FATAL CLOSE ERROR?
	 JRST	STSTS4				 ; NO, SOME OTHER VERB
	ADD	AC0,[EXP E.VCLO]		 ;FLAG FOR CLOSE VERB
	JRST	STSTS2				 ;AND GET OUT OF THIS (MESS)

STSTS4:						 ;
	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
	AOSG	AC3		;PLUS ONE UNLESS ITS NEGATIVE
	SETZ	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
	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:
	MOVE	AC1,FS.FS	;GET ERROR CODE
	CAIN	AC1,FS%10	;ALL OTHER END-OF-FILE?
	 JRST	IGTST2		;YES
	SKIPGE	WANT8.		;WANT 8x FUNCT?
	TXNN	AC16,V%READ	;DOING READ?
	JRST	IGTST4		; NO, NO
	MOVX	AC1,B%BDRD	;SET BAD-READ FLAG
	IORM	AC1,D.RFLG(I16)	; AND PUT IT BACK IN FILE TABLE.
IGTST4:
	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
SUBTTL	FILE STATUS

	; 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

SETS10:	MOVEI	AC0,FS%10	; [601] READ INVALID KEY
SET10A:				;
	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

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

SETS23:	MOVEI	AC0,FS%23	;[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

SETS24:	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
	JUMPN	AC16,RRDMP5	;

	;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
	PUSHJ	PP,FUSI		; DO A FILOP. TYPE USETI
	JRST	RRDMP3		;CONT LOOP

RRDMP5:	MOVE	AC13,D.DC(I16)	;DEVCHR TO 13
	MOVE	FLG,F.WFLG(I16)	;FLAGS TO FLG
	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:	PUSHJ	PP,FUSO		; DO A FILOP. TYPE 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]
	XCT	AC6
	  TRNA
	JRST	RRERR2		;OUTPUT ERROR
	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
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 RECORD KEYS.
KY.SIZ:	POINT	12,KEYDES(I12),35	; KEY SIZE

UUOCHN:	POINT	4,UOPEN.,12	; CHANNEL NUMBER AS SET IN OPEN UUO XCT WORD
DTCN.:	F%BCN	; CHANNEL NUMBER
DTIBS.:	F%BIBS	; INPUT HEADER BYTE SIZE
DTOBS.:	F%BOBS	; OUTPUT HEADER BYTE SIZE
DTRN.:	F%BRN	; MTA REEL NUMBER
F.NIO:	F%NIO	; NATIVE I/O BIT
F.BLF::	F%BLF	; LOCK FLAG

F.BNDV:	F%BNOD	; NUMBER OF DEVICES SELECTED
F.BCVR:	F%BCVR	; COMPILER'S VERSION NUMBER
F.BBLC:: F%BBLC	; BUFFER LOCATION IS ASSIGNED
F.BSDF:	F%BSDF	; SORT-DESCRIPTION FILE FLAG
F.BDRM:	F%BDRM	; OPEN REVERSED ACTIVE FLAG
F.BNOD:	F%BNOD	; NUMBER OF DEVICES ASSIGNED TO FILE
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 ACTUAL BUFFERS
F.BRMS:: F%BRMS	; THE RMS FILE FLAG
F.BMRS:: F%BMRS	; MAXIMUM RECORD SIZE IN CHARS
F.BLRS:: F%BLRS	; MINIMUM 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
F.QOPN:	F%BQOF	; [565] LFENQ. OPEN FLAG
			;[565] 0= NOT AFTER LFENQ. OPEN
			;[565] 1= AFTER LFENQ. OPEN
F.BSID:	F%BSID	; SIZE OF VALUE OF ID
	;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


XTDBLK:	3
	Z
	Z
SAVADR:	BLOCK 1
RACS:	BLOCK ^D16	;SAVE ACS

C.END:	END