Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50517/cblio.mac
There are 23 other files named cblio.mac in the archive. Click here to see a list.
TITLE CBLIO FOR LIBOL				16-JAN-75
SUBTTL	EDIT HISTORY

;COPYRIGHT 1974, 1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
	EDIT==420


;********* MODIFIED TO SUPPORT RPGII 5/29/76 *********
;
;ALL RPGII MODIFICATIONS COPYRIGHT 1976, BOB CURRIER AND CERRITOS COLLEGE



;***** V10 *****

; 420	17-OCT-75	JEC
;	FIX SPACING WITH NO PAGE HEADER. - LINE -
; 417	21-OCT-75	JEC
;	MAKE SURE THAT CSORT TAKES NO MORE THAN 6 CHANNELS - CSORT -
; 416	25-SEP-75	JEC
;	FIXED FUNCOR ROUTINE TO RETURN START ADDRESS.
;	NOT IN V10 - COBFUN WAS EXTENSIVLY MODIFIED WHICH FIXED THE PROBLEM.

; 415	25-SEP-75	JEC
;	FIX EDIT 334 SO THAT SINGLE DIGTIT TESTS WORK.
;	NOT IN V10 - NUMBRS WAS REWRITTEN.

; 414	27-AUG-75	JEC	SPR-16722
;	PUT IN INTERRUPT CODE FOR ON-LINE PRINTER AND SET LPT BUFFER TO 1.

; 413	30-JUN-75	JEC	SPR-16266
;	FIX MESSAGE THAT BEGINS WITH " SO IT DOESN'T GO TO CTY.

; 412	30-JUN-75	JEC	SPR-16175
;	FIX CALCULATION OF POINTER FOR UNSTRING WHEN DELIMITER IS "ALL".

;	MARCH 12, 1975  ADDITION OF SUSPC, SUSPC1 SUBROUTINES TO
;	RESET FOR THE PURPOSE OF COMPUTING THE SPACE REQUIRED BY
;	SIMULTANEOUS UPDATE, AND GETTING IT. ALSO ADDITION OF THE
;	CALL TO THESE SUBROUTINES IN RESET. GIL STEIL

;	16-JAN-75	/ACK	1.  CHANGE REFERENCE TO PARAMETER FILE
;					LBLPRM TO REFERENCE UNIVERSAL
;					FILE LBLPRM.
;				2.  ADD CODE FOR SETTING UP THE PUSH DOWN
;					LIST WITH THE VALUE SUPPLIED BY
;					THE USER WHEN HE COMPILED THE
;					PROGRAM

;********** VERSION 7A RELEASE **********
; EDIT 411 MAKE SURE LPT DEVICE DOES NOT CAUSE "ILLEGAL MODE" MONITOR MESSAGE AT RESET TIME.
; ALSO FIX RECOVERY FROM "EOF FOUND INSTEAD OF A LABEL".
; EDIT 410 PUT OUT "$"  IN MESSAGE TO TRY ANOTHER MAG TAPE SO OPERATOR SEES THE
;	MESSAGE, WHEN THE JOB IS RUNNING UNDER BATCH
;	 SPR 15662
; EDIT 407 IF POSSIBLE OUTPUT PHYSICAL DEVICE NAME
; AS WELL AS LOGICAL DEVICE NAME- FOR DEVICE MESSAGES
;	SPR 15184
; EDIT 406 FIX SORT RELEASE LENGTH CALCULATION SO WORD SIZE AGREES WITH INTERNAL RECORD MODE
;	SPR 15189.
; EDIT 405 SET UP REF I12 FOR ISAM FILES AT MSVID FOR FILE VALUE OF ID PRINTOUT.
; EDIT 404 IN LINE.MAC FIX SPACING FOR RPT WRITER
;	SPR 14927
; EDIT 403 PUT IN SIRUS CODE AND TRAILING BLANK SUPPRESSION (SWITCH OPTION)
; EDIT 402 FIX CORE PROBLEM IN CSORT; FOR .JBFF VS .JBREL
; EDIT 401 FIX EDIT SO THAT ZERO SUPPRESSION NO LONGER HAPPENS AFTER A 9'S FIELD IS SEEN
;	SPR 14617
; EDIT 400 FIX COBFUN SO THAT CHANNEL 0 IS OBTAINED LAST
; EDIT 377 FIX ISAM BUFFER PROBLEM IF ISAM FILE IS
;	SHARED AREA (BUFFER) WITH ANY OTHER FILE.
; EDIT 376 GIVE A MEANINFUL ERROR MSG IF UNEXPECTED EOF ON ISAM IDX FILE IS SEEN
;	SPR 14453
; EDIT 375 ADD TO EDIT 371- IF ISAM FILE OPEN FOR INPUT ALLOW
;	FD > OR = TO ISAM MAX REC SIZE- AND IF FILE OPEN FOR OUTPUT ALLOW
; 	FD < OR = TO ISAM MAX REC SIZE.
; EDIT 374 FIX  TEST FOR OPTIONAL ISAM FILE AT RESET TIME
; EDIT 373 FIX UP CLOSE WITH DELETE FOR DTA FILES.
; EDIT 372 CORRECT BLOCK FACTOR CALC FOR ASCII NON-ISAM FILES 
; EDIT 371 CHECK THAT USERS MAX REC DESC SAME AS ISAM MAXREC PARM.
;	SPR 13772
;EDIT 370	SEQUENTIAL READING OF AN ISAM FILE MAY OCCASIONALLY
;		MISS SEVERAL RECORDS. THE PROBLEM OCCURS WHEN THE
;		SYMBOLIC KEY IS A NUMERIC DISPLAY ITEM AND A VERSION
;		NUMBER ERROR OCCURS.
;EDIT 343 THROUGH 367 ARE RESERVED FOR DEVELOPMENT
;********* VERSION 7 RELEASE **********
;EDIT 347	FIX STRING TO SPACE FILL EVEN IF NO UNSTRING
;EDIT 346	CBLIO - LIBIMP - CSORT
;		MAKE OVERLAYS WORK. CHECK THAT NO IO IS DONE IN AN
;		OVERLAY. WHEN ALLOCATING ISAM BUFFER SPACE BE SURE
;		YOU DON'T OVERLAP THE OVERLAY AREA, GIVE ERROR MESSAGE.
;EDIT 345	RE-ADJUST SUBROUTINES DISPATCH TABLE SIZE FOR MCS
;EDIT 344	FIX MEMORY MANAGEMENT BUG IN CSORT
;EDIT 343	THIS FIX PREVENTS AN EXTRA BLOCK FROM BEING APPENDED TO
;		A BINNARY FILE WHEN THE OUTPUT DEVICE IS A DTA (QAR-40)
;EDIT 342	MAKE EDIT 333 WORK FOR PROGRAMS WO/R SWITCH
		; AND MAKE CHN 0 THE LAST ONE USED (FOR RERUN)
		; CHANGES TO OVRLAY.MAC AND COBRG OF COMPILER
		; ALSO REQUIRES COBST ROUTINE IN LIBOL
;EDIT 341	FIX POSITIONING ; MULTI-FILE LABELLED REELS W/NO
		; POSITION CLAUSES
;EDIT 340	UPDATE JOBDAT SYMBOLS, CHANGES IN CSORT,UUO
;EDIT 337	FIX IN ACCEPT, NOT IN CBLIO, SEE JC
;EDIT 336	FIX FILE POSITIONING FOR MULTI-FILE TAPES
;EDIT 335	FIX GARBAGE IN RECORD W/VARIABLE LENGTH ISAM RECS
;EDIT 334	NOT IN CBLIO. JOHN DID EM
;EDIT 333	GET OVERLAY FILE FROM SAME PLACE AS MAIN PROGRAM
;EDIT 332	HANDLE VARIABLE LENGTH RECORDS FOR STAND ALONE SORT
;EDIT 330	FIX READING FROM NUL DEVICE SO THAT CBLIO DOESN'T CONFUSE IT WITH MTA
;EDIT 327	FIX STD LABELS FOR MTA WHEN READING > REEL 9
;EDIT 326	CHANGED CHTAB SO THAT 173 TO 20(ZERO) AND 175 TO 32 (:)
;	  WHEN READING ASCII FILE TO SIXBIT RECORD JEC
;EDIT 325	FIX SPACING AND REPORT CODE FOR REPORT GEN IN LINE.325 JEC 4/5/74
;EDIT 324	FIX APPENDING TO RANDOM ACCESS FILES READ TO END
;EDIT 323	DONT DO ENTER WHEN LOOKUP OF ISAM DATA FILE FAILS
;EDIT 322	FIX APPENDING OF RECORDS FOR SEQUENTIAL I/O
;EDIT 321	LIBOL REFUSES TO TAKE A RERUN DUMP IF A FILE IS ASSIGNED
;		TO THE NULL DEVICE
;EDIT 320	ISAM - "MEM-PRO-VIO..." WHEN ZEROING FREE CORE AT UDIF11
;EDIT 317	MOVE THE TEST FOR EBCDIC FILES INTO THE MAIN LOOP
;EDIT 316	FIXES "ADDRESS CHECK..." WHEN SORT FILE SHARES SAME BUFFER AREA
;EDIT 315	FIX TO EDIT 301      ILG  1-FEB-74
;EDIT 314	*CSORT*  PREFIX "?" TO "ERROR IN SORT I-O" MESSAGE
;EDIT 313	*CSORT*  FIX REDUNDANT "RECORDS SORTED"
;EDIT 312	IF "ILL-MEM-REF" IN RSTLNK ROUTINE TELL USER HE MAY HAVE LOADED A MACRO ROUTINE IN PLACE OF COBOL SUBROUTINE
;EDIT 311	ISAM - "MEMORY PROTECTION VIOLATION" WHEN WRITING AFTER SPLITING THE TOP INDEX BLOCK
;EDIT 310	ISAM - "?KEYS OUT OF ORDER" CAUSED BY TESTING THE WRONG FLAG WORD
;EDIT 307	ISAM FILE READER GETS "VERSION NUMBER DISCREPANCY" WHEN A WRITER CREATES A NEW INDEX LEVEL
;EDIT 306	ISAM - OPNI03 ASSUMES A 200 WORD BUFFER SIZE BUT IT MAY BE LARGER
;EDIT 305	CHANGE "NOT A LEGAL SIXBIT FILE" ERROR MS TO INDICATE THAT INCORRECT BLOCKING FACTOR COULD BE CAUSE.
;EDIT 304	CORRECT VALUE OF ID AS GIVEN AFTER LOOKUP OR ENTER FAILS
;EDIT 303	FIX TO REPORT-WRITER
;EDIT 302	CORRECT MAG-TAPE POSITION AFTER READING LABELLED FILE
;EDIT 301	DO AN ENTER ON NON-DIRECTORY DEVICES FOR DIRECT,LPTSPL,ETC.
;EDIT 300	HANDLE NULLS IN ASCII RANDOM FILES CORRECTLY
;EDIT 277	PRECEDE ALL ERROR MESSAGES HAVING TO DO WITH POSSIBLE WRONG REELS OR OPTIONAL FILES WITH "$"
;EDIT 276	DUPLICATE ISAM RECORDS IF DATA MODE DIFFERS BTWN RECORD AND DATA FILE
;EDIT 275	CODE TO CORRECT LOW-VALUES READ FOR ISAM AFTER INVALID KEY PATH TAKEN
;EDIT 274	CODE TO SUPPORT THE DATE75 FORMAT I.E. 15 BIT WIDE DATES
;EDIT 273	FIRST RANDOM READ WITH AN ACTUAL KEY POINTING BEYOND THE "EOF" DOES NOT TAKE THE INVALID KEY RETURN
;EDIT 272	TYPE THE VERSION # NOT JUST EDIT # WITH ERROR MESSAGES
;EDIT 271	FIXES "VERSION NUMBER DISCREPANCY..." WHEN MORE THAN ONE SECTOR PER LOGICAL BLOCK
;EDIT 270	STOPS "ILL-UUO-AT-PC..." WHEN TYPING OUT LIBOL ERROR MESSAGE
;EDIT 267	CHANGE GETCH. ROUTINE SO ^U WILL RUBOUT TYPED AHEAD CHARACTERS
	SUBTTL	PICK UP UNIVERSALS AND SET UP JOBDAT.

IFE	%%RPG,<
	SEARCH	LBLPRM			;DEFINE PARAMETERS.
	%%LBLP==:%%LBLP
	>
IFN	%%RPG,<
	SEARCH	RPGPRM, RPGUNV
	>
	SEARCH COMUNI
	%%COMU==:%%COMU
	INFIX%
	ISAM==:ISAM
	EBCMP.==:EBCMP.
	SEARCH	FTDEFS			;FILE-TABLE DEFINITIONS
	%%FTDF==:%%FTDF

IFE	%%RPG,<
	ENTRY	C.RSET			;MAKE SURE WE GET LOADED.


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


	VERWHO==0
	VERMJR==10
	VERMNR==0
	VEREDT==EDIT

	VERSION==BYTE(3)VERWHO(9)VERMJR(6)VERMNR(18)VEREDT
	PURGE	VERWHO,VERMJR,VERMNR,VEREDT
	LOC	137			;.JBVER
	EXP	VERSION

	VERSION==<VERSION>B53&77777	;FOR LATER REFERENCE.

	>	; END OF IFE %%RPG

	IFNDEF EBCLBL,<EBCLBL=0>

	IFNDEF	TOPS20,<TOPS20==0>	; JSYS SWITCH

	IFNDEF	SUPPTB,<SUPPTB==0>	; [403] SUPPRESS TRAILING BLANKS ON OUTPUT ASCII FILES.

	IFNDEF EBCMP.,<EBCMP.==0>



	HISEG
SUBTTL CONSTANTS

AC0==0		;AC ASSIGNMENTS
AC1==1
AC2==2
AC3==3
AC4==4
AC5==5
AC6==6
FLG==7
AC10==10
AC11==11
C==11
AC12==12
I12==12
AC13==13
LVL==13
AC14==14
FLG1==14
AC15==15
AC16==16
I16==16
PP==17

REPEAT 0,<		;FLAGS IN LEFT SIDE OF "F.WFLG(I16)" BEFORE RESET
400000==400000	;VARIABLE LENGTH EBCDIC RECORDS
NONSTD==100000	;NON STANDARD LABELS
STNDRD==40000	;STANDARD LABELS
OPNIO==4000	;FILE IS AN INPUT/OUTPUT FILE
BIT 7-9		;0 = SIXBIT DEVICE DATA MODE
		;1 = BINARY
		;2 = ASCII
		;3 = EBCDIC
		;4 = ASCII-8
		;5-7 NOT USED
RRUNER==200	;RERUN DUMP AT END-OF-REEL
RRUNRC==100	;RERUN DUMP VIA RECORD-COUNT
FILOPT==20	;OPTIONAL FILE
BIT 14-15	;0 = SIXBIT CORE DATA MODE
		;1 = BINARY
		;2 = ASCII
		;3 = EBCDIC
BIT 16-17	;0 = SEQUENTIAL FILE
		;1 = RANDOM FILE
		;2 = INDEXED-SEQ FILE
		;3 = NOT USED
>

HUF==1
LOCK==2
;CONSTANTS FOR CONSTRUCTION OF ERROR NUMBERS
E.VOPE==^D100000000	;COBOL VERB OPEN
E.VCLO==^D200000000	;	CLOSE
E.VWRI==^D300000000	;	WRITE
E.VREW==^D400000000	;	REWRITE
E.VDEL==^D500000000	;	DELETE
E.VREA==^D600000000	;	READ
E.VRET==^D700000000	;	RETAIN

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

E.FIDX==^D10000		;ISAM INDEX FILE
E.FIDA==^D20000		;ISAM DATA FILE
E.FSEQ==^D30000		;SEQUENTIAL FILE
E.FRAN==^D40000		;RANDOM FILE


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

		;FLAGS IN LEFT SIDE OF FLG1 & D.F1(I16) AFTER RESET.
VLREBC==400000	;VARIABLE LENGTH EBCDIC RECORDS
FILOPT==200000	;FILE IS OPTIONAL
NONSTD==100000	;LABELS ARE NON-STANDARD
STNDRD==40000	;LABELS ARE STANDARD

F1CLR==3777	; THESE FLAGS ARE CLEARED AT CLOSE TIME

FOPERR==2	; FILOP.UUO FAILED
IFN ISAM,<
NOTEST==2000	;SKIPE THE CONVERSION TEST AT ADJKEY			[EDIT#276]
WSTB==1000	;WRITE THE STATISTICS BLOCK
IIAB==400	;INSERTION IS IN AUX BUFFER
TRYAGN==200	;MAKE A SECOND PASS AT ALC01 OR DON'T AT VNDE
BVN==100	;BUMP-VERSION-NUMBER SPLITTING A BLOCK
WSB==40		;WRITE THE SAT BLOCK
BLK2==20	;REQ FOR 2ND DATA BLOCK
SEQ==10		;SEQUENTIAL READ
VERR==4		;VERSION NUMBER DISCREPANCY BTWEEN INDEX LEVELS
WIVK==2		;WRITE INVALID-KEY
FOPIDX==2	;FILOP OF NAME.IDX IN PROGRESS
RIVK==1		;READ, RERIT OR DELET INVALID-KEY
EIX==1		;ENTER OF NAME.IDX IN PROGRESS
>
		;FLAGS IN LEFT SIDE OF AC16 FOR DURATION OF CURRENT COBOL UUO
WADV==400000
WRITE==200000
READ==100000
OPEN==40000
CLOSEF==20000	;EOF
CLOSER==10000	;EOV
CLOSEB==4000	;HDR
RERIT==10	;ISAM REWRITE
DELET==4	;ISAM DELETE
SLURP==2	;WRITE REEL CHANGE, RESTORE THE RECORD AREA
MTAEOT==1	;END-OF-TAPE

BUFLOC==4000	;BUFFER LOCATION HAS BEEN ASSIGNED, LEFT-HALF OF 5(I16)
SRTFIL==2000	;[316];THIS IS A SORT FILE, LEFT-HALF OF 5(I16)

OEUP==4000	;OPEN ERROR USE PROCEDURE - ENTER ERROR FILE BEING MODIFIED, BIT 6 OF 22(I16)

SASCII==1	; REQUEST FOR STANDARD ASCII, IN D.RFLG

TAPOP.==CALLI 154	; FOR TU70'S 1600 BPI AND STANDARD ASCII
	.TFKTP==1002	; FUNCT TO GET CONTROLER TYPE
	.TC10C==2	; CONTROLLER FOR A TU43
	.TX01==3	; CONTROLLER FOR A TU70
	.TM02==4	; CONTROLLER FOR A TU16
	.TFMOD==2007	; FUNCT TO SET STANDARD ASCII MODE
	.TFM8B==2	; CODE FOR INDUSTRY-COMPATIBLE
	.TFM7B==4	; CODE FOR STANDARD ASCII
	.TFSDN==2001	; FUNCT TO SET DENSITY
	.TFGDN==1001	; FUNCT TO GET DENSITY

FILOP.==CALLI 155	; FOR SIMULTANEOUS UPDATE


	;CONSTANTS FOR EXTENDED LOOKUP BLOCK
.RBPPN==1
.RBNAM==2
.RBEXT==3
.RBPRV==4
.RBSIZ==5

R.IOWD==0	; IOWRD FOR RANDOM/IO FILES
R.TERM==1	; IOWRD TERMINATOR
R.BPNR==2	; BYTE POINTER TO NEXT RECORD IN BUFFER
R.BPLR==3	; LAST RECORD
R.BPFR==4	; FIRST RECORD
R.DATA==6	; BUFFER HAS ACTIVE DATA TO BE WRITTEN OUT
R.WRIT==7	; LAST IO OPERATION FOR THIS FILE WAS A WRITE
R.FLMT==10	; AOBJ POINTER TO FILE LIMITS
	SUBTTL	EXTERNALS.


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

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

EXTERNAL UOCAL.,OPNCH.,UOBLK.,NRSAV.

EXTERNAL UEBLK.,ULBLK.,TTOBP.,TTOBC.,TTOBF.,STDLB.
EXTERNAL REDMP.,TEMP.,TEMP.1,JSARR.,TEMP.2,AINFO.,OVRBF.,FLDCT.,OVRIX.
EXTERNAL NOCR.,PRGFLG,TTYOPN,ACSAV0,MXIE,IESAVE,MXBUF,AUXBUF,AUXIOW,AUXBNO,CMDLST,NEWBK1
EXTERNAL NEWBK2,OLDBK,MXBF,DRTAB,LRWA
EXTERNAL FS.ZRO,FS.FS,FS.EN,FS.BN,FS.RN,FS.UPD,FS.IGE,FS.IF,ISETS,FS.IEC
EXTERNAL MOVE.,PD6.,PD7.,C.D6D7,C.D7D6
IFN EBCMP. <
EXTERNAL PD9.,C.D9D6,C.D9D7,C.D6D9,C.D7D9
>

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

EXTERNAL RELEN.		;[332]

EXTERNAL  RUN.TM	;[333]
EXTERNAL PUSHL.,CB.DDT,LEVEL.,%F.PTR,SBPSA.

IFE	%%RPG,<
EXTERNAL SU.RBP,SU.CL,SU.WR,SU.RD,SU.DL,SU.RW	;SIMULTANEOUS UPDATE
	>
EXTERN	FOP.BK,FOP.IS,FOP.DN,FOP.LB		;SIMULTANEOUS UPDATE
IFE	%%RPG,<
EXTERN	SU.FRF			;FAKE READ FLAG
INTERN	FAKER.,IGSS,RANFIL,IDXFIL,E.VRET,D.RP,D.CBN,D.CN,D.BL	;SIMULTANEOUS UPDATE
INTERN	DSPLY.
	>

EXTERN	.JBSA,.JBFF,.JBREL,.JB41,.JBAPR,.JBTPC,.JBCNI,.JBVER,.JBDA,.JBOPC,.JBREN

EXTERN	.JBOPS
INTERN	C.CLOS,DOPFS.,C.END,GETCH.,DSPL1.,MSOUT.,C.OPEN,OUTCH.
INTERN	OUT6B.,OUTBF.,READ.,RSTAB.,SEEK.,STOPR.,C.STOP,TODAY.,TRAP.,WRITE.,WADV.,WRPW.
INTERN	GOTO.,KILL.,PPOUT.,ULOSE.

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

INTERN	DELET.,RERIT.,PURGE.

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

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

EXTERNAL FILES.,USES.

IFE	%%RPG,<
EXTERN	RN.PPN,RN.DEV,RN.NAM,OVRFN.,TRAC1.,SEGNO.
	>

IFN	%%RPG,<
INTERN	OUTBF1, WAD2, SETCN.
	>
IFN ISAM,<
ADR==0
DEFINE	TABADR(N,L) <
N==ADR
ADR==ADR+L
>

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

STABL==ADR	;EQUALS SIZE OF STATISTICS BLOCK
TABADR	IOWRD,14+1	;TABLE OF DUMP MODE IOWD'S FOR EACH INDEX LEVEL
			;0 DATA BLOCK
			;1-12 INDEX BLOCKS
			;13 SAT BLOCK
			;14 STATISTICS BLOCK
TABADR	OMXLVL,1	;ORIGINAL MAX NUMBER OF LEVELS IN INDEX FILE
TABADR	CORE0,1		;LAST,,FIRST -  CORE AREA CLEARED AT CLOSE
TABADR	ICHAN,1		;CHANNEL NUMBER FOR INDEX DEVICE
TABADR	USOBJ,14+1	;USETI/O OBJECT: DATA, 10 INDEX, SAT & STA
TABADR	CNTRY,14+1	;CURRENT INDEX ENTRY
TABADR	NNTRY,14+1	;FLAG, CNTRY POINTS TO NEXT ENTRY NOT CURRENT
TABADR	LIVE,1	;(-1) IF DATA NOT YET OUTPUT
TABADR	BRISK,1		;IF -1 OUTPUT ONLY WHEN INPUT IS EMINENT
TABADR	CLVL,1		;CURRENT LEVEL
TABADR	IAKBP,1		;INDEX ADJUSTED SYMBOLIC KEY BYTE-POINTER
TABADR	IAKBP1,1	;POINTER TO SECOND KEY WORD
TABADR	DAKBP,1		;DATA ADJUSTED SYMBOLIC KEY BP
TABADR	DAKBP1,1	;POINTER TO THE SECOND KEY WORD
TABADR	SINC,1		;BINARY SEARCH INCREMENT
TABADR	IBLEN,1		;INDEX BLOCK LENGTH NOT COUNTING HEADERS
TABADR	IKWCNT,1		;INDEX, NUMBER OF WORDS IN THE KEY
TABADR	DKWCNT,1		;DATA, NUMBER OF WORDS IN KEY
TABADR	FWMASK,1		;MASK FOR FIRST WORD OF DATA KEY
TABADR	LWMASK,1	;MASK FOR LAST WORD OF DATA KEY
TABADR	ICMP,1		;HOLDS ADR OF THE INDEX COMPARE ROUTINE
TABADR	DCMP,1		;HOLDS ADR OF DATA COMPARE OR CONVERT ROUTINE
TABADR	DCMP1,1		;HOLDS ADR OF DATA COMPARE ROUTINE IF KEY IS NUMERIC DISPLAY
TABADR	GDX.I,1		; ADR OF CONVERT ROUTINE -- SK VS INDEX-ENTRY
TABADR	GDX.D,1		; ADR OF CONVERT ROUTINE -- SK VS DATA FILE KEY
TABADR	GDPSK,1		;PARAMETER FOR SYM-KEY CONVERSION
TABADR	GDPRK,1		;PARAMETER FOR REC-KEY CONVERSION
TABADR	GDPRK1,1	;
TABADR	GETSET,1	;DISPATCH LOC: ADJKEY OR GD67 OR FPORFP
TABADR	RECBP,1		;RECORD AREA BYTE-POINTER
TABADR	RSBP,1		;BYTE POINTER TO RECORD SIZE IN BUFFER
TABADR	RSBP1,1		;ANOTHER BP TO RECORD SIZE
TABADR	LRW,1		;FIRST FREE RECORD WORD, USED BY SETLRW
TABADR	IOWRD0,1	;POINTS TO CURRENT IOWRD
TABADR	USOBJ0,1	;POINTS TO CURRENT USOBJ
TABADR	CNTRY0,1	;POINTS TO CURRENT CNTRY
TABADR	NNTRY0,1	;FLAG, CNTRY POINTS TO NEXT ENTRY
TABADR	BPSB,1		;NUMBER OF BITS PER SAT BLOCK
ITABL==ADR-STABL	;INDEX TABLE LEN 
TABADR	BA,0		;START OF BUFFER AREA
ISCLR1==IOWRD		; [432] [377] START OF ISAM SHARED BUFFER AREA TO SAVE
ISCLR2==ICHAN-1	; [377] END OF ISAM SHARED BUFFER TO SAVE
ISMCLR==ISCLR2-ISCLR1	; [377] DIFFERENCE OR SIZE OF AREA LESS 1 TO SAVE
> ;END OF 'IFN ISAM'
SUBTTL	RESET

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

IFE	%%RPG,<
LIBSW.:	SWSET%		;LIBOL ASSEMBLY SWITCHES

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.
	CALLI	AC11,27		;[346]GET THE RUNTIME.
	MOVEM	AC11,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,[TTCALL 3,[ASCIZ/COBOL PROGRAMS MAY ONLY BE STARTED THROUGH
USE OF "GET AND ST" OR "RUN" MONITOR COMMANDS/]
			CALLI 12]	;EXIT
	HRRM	AC0,.JBSA
	MOVE	PP,[PUSHJ PP,UUO.]
	MOVEM	PP,41
	HLRZ	PP,.JBOPS	;START OF IMPURE AREA
RSET1A:	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.
	SKIPN	AC10,	%PUSHL(AC10)	;GET THE PDL SIZE.
	MOVEI	AC10,	200	;THIS IS FOR SORT
	MOVNI	PP,	(AC10)		;0,,-LENGTH
	HRL	PP,	.JBFF		;START-LOC,,-LENGTH
	MOVSS	PP,	PP		;POINTER IS SET UP.

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

	;SET FLAGS TO TRAP ON
RESET2:	MOVEI	AC0,TRAP.	;[312];INTERUPT ROUTINE ADR
	MOVEM	AC0,.JBAPR	;[312];
	MOVEI	AC0,230000	;[312];PDLOV - MPVIO - NXM
	CALLI	AC0,16		;[312];APRENB UUO

	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

	PUSHJ	PP,SETOVR	;SET UP OVERLAY FILE
	PUSHJ	PP,RSTAB.	;ASSIGN THE  BUFFER AREA
	SKIPE	KEYCV.##	;WERE WE CALLED BY SORT?
	JRST	1(AC14)		;YES, RETURN.
	HRRZ	AC10,COBSW.	;GET COMPILER ASSEMBLY SWITCHES
	HRRZ	AC3,LIBSW.	;GET LIBOL ASS-SWITCHES
	CAME	AC10,AC3	;THE SAME?
	TTCALL 3,[ASCIZ /% COBOL-LIBOL ASSEMBLY SWITCHES MISMATCHED
/]
	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
RSTL10:	HRRZ	AC5,(AC1)	;[346] CHECK TO SEE IF THIS SUBROUTINE
	JUMPN	AC5,RSTL30	; IS IN AN LINK-10 OVERLAY AREA.
				;; ((AC1)) = SKIPA 0,0 == IT ISN'T
				;; ((AC1)) = JSP 1,MUMBLE == IT IS.
	MOVE	AC1,1(AC1)	;ADDRES 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
	JUMPE	AC4,RSTL12	;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
RSTL30:	SKIPE	1(AC2)		;ANY MORE SUBPRGMS?
	AOJA	AC2,RSTL20	;INCREMENT POINTER AND TRY AGAIN
RSTLNX:	POPJ	PP,		;[312];NO--DONE.

	>	; END OF IFE %%RPG
	;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
	HRRZ	AC16,FILES.	;FIRST FILE TABLE
	JUMPE	AC16,RET.1	;THERE ARE NO FILES
RSTIFI:	SETZM	TEMP.		;MAX SIZE OF BUF AREA
RSTIF1:	MOVE	AC15,F.WDNM(I16);IF THIS IS FIRST
	TLNN	AC15,BUFLOC	 ;[316] TIME THROUGH TABLE,
	PUSHJ	PP,RSTFLG	;REORGANIZE THE FLAGS
	MOVE	FLG,F.WFLG(I16)	;GET THE FLAGS
	HRLOI	AC15,4077	;[316];#OF DEVICES,,LOC OF FIRST ONE
	AND	AC15,F.WDNM(I16)	;
	TLZE	AC15,BUFLOC	;IS BUFLOC SET?
IFE	ISAM,<	JRST	RSTNFL		; [377] YES-NEXT FILE >
IFN	ISAM,<	JRST	RSTSAL		; [377] YES- SET UP SAVE AREA FOR ISAM FILES >
	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/
	CALLI	AC3,4		;DEVCHR UUO
	TLNN	AC3,140610	;SKIP IF A LPT,TTY,PTP,PTR,CDP, OR CDR
	JRST	RSTDE0		;
	TLNN	AC3,40000	; [414] LPT?
	JRST	RSTDV1		; [414] NO
	MOVE	AC12,(AC13)	; [414] LPT - GET NAME
	DEVTYP	AC12,		; [414] SEE IF REAL LPT.
	JRST	RSTDV1		; [414] CAN'T, SKIP THIS.
	TLNE	AC12,20		; [414] IF SPOOLED SKIP THIS.
	JRST	RSTDV1		; [414] IT IS
	PUSHJ	PP,INTINT	; [414] REAL LPT SET UP TRAPPING.
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	;
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
	HRLM	AC12,D.BL(I16)	;SET BUFFER LOCATION
	MOVE	AC12,(AC13)	;SIXBIT /DEVNAM/
	MOVEM	AC12,UOBLK.+1	;FOR THE INIT BLOCK
	HRLZI	AC12,D.OBH(I16)	;LOC OF OBUF HDR
	TLNE	FLG,OPNIO	;SKIP IF NOT IO
	HRRI	AC12,D.IBH(I16)	;LOC OF IBUF HDR
	MOVEM	AC12,UOBLK.+2	;INIT BLOCK
IFN ISAM,<
	MOVEI	AC1,17		;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
	TLNN	AC3,20		;SKIP IF A MTA
	TLNE	FLG,RANFIL+OPNIO ;SKIP IF  NOT RANDOM OR IO
	JRST	RSTDE4		;SETUP FOR NON-STD OR DUMP MODE BUFFERS

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

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

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

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

IFN	ISAM,<
; THIS ROUTINE GOES ALL FILES IN A SAME RECORD  AREA CHAIN TO
;SET UP A SAVE AREA FOR ISAM FILES. THIS SAVE AREA WILL BE USED TO SAVE
;THE SECTION OF THE SHARED BUFFER AREA THAT ISAM FILE EXPECTS TO
;BE TRUE VALUES
RSTSAL:	SKIPE	KEYCV.			; [377] SKIP THIS IS HERE ON SORT
	JRST	RSTNFL			; [377]
	PUSH	PP,AC16			; [377] SAVE CURRENT FILE TABLE ADR
	MOVE	AC12,TEMP.		; [377] UPDATE .JBFF
	ADDB	AC12,.JBFF		; [377]
	SETZM	TEMP.			; [377] CLEAR BUFFER SIZE
RSTSL1:	MOVE	FLG,F.WFLG(I16)		; [377] GET FILE PARAMS
	TLNN	FLG,IDXFIL		; [377] ISAM FILE ?
	JRST	RSTLP			; [377] NO- GET NEXT FILE
	HRRZ	AC2,D.IBL(I16)		; [377] SAVE AREA ALREADY SET UP?
	JUMPN	AC2,RSTLP		; [377] IF SO, GO GET NEXT FILE
	HRRZ	AC12,.JBFF		; [377] GET FREE CORE AREA
	HRRM	AC12,D.IBL(I16)		; [377] SET START OF SAVE AREA TO .JBFF
	MOVEI	AC0,ISMCLR+1		; [377] AMOUNT OF SPACE FOR SAVE ARE
	PUSHJ	PP,GETSPC		; [377] GET CORE SPACE
	 JRST	GETSPK			; [377] NO CORE- QUIT
RSTLP:	HLRZ	AC12,F.LSBA(I16)	; [377] GET NEXT FILE IN SAME AREA CHAIN
	JUMPE	AC12,RSTSL2		; [377] NO MORE
	CAMN	AC12,(PP)		; [377] SEE IF WE WENT ALL THRU CHAIN
	JRST	RSTSL2			; [377] YES ALL DONE
	MOVEM	AC12,AC16		; [377] SET UP NEXT FILE IN SAME AREA CHAIN
	JRST	RSTSL1			; [377] DO THIS FILE
RSTSL2:	POP	PP,AC16			; [377] GET BACK FIRST FILE IN CHAIN
	JRST	RSTNFL			; [377] GO ON TO NEXT FILE TABLE
>	; [377] END IFN ISAM
	;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
	TLNN	AC3,20		; AND DEVICE IS A MTA
	JRST	RSTD40		;
	MOVEI	AC5,1		; THEN BLK-FTR DEFAULTS TO 1
	DPB	AC5,F.BBKF	;
RSTD40:	PUSHJ	PP,OPNWPB	;AC10= WODRS PER LOGICAL BLOCK
	JUMPE	AC5,RSTDE7	;JUMP IF BLOCKING FACTOR IS 0
	ADDI	AC10,3		;   PLUS 3 FOR BOOKEEPING WORDS
	TLNN	AC3,20		;SKIP IF A MTA
	JRST	RSTDE6		;JUMP ITS NOT A MTA
	HLLZ	AC6,D.F1(I16)	;SECOND FLAG REG
	TLNN	AC6,STNDRD	;SKIP IF STANDARD LABELS
	JRST	RSTD41		;MTA W/NONSTD OR OMITTED LABELS
	CAIGE	AC10,^D16+4	;SKIP IF RECORD IS GE THE LABEL RECORD
	MOVEI	AC10,^D16+4	;ENSURE LABEL REC WILL FIT IN REC AREA
RSTD41:	TLNN	FLG,DDMEBC	;SKIP IF EBCDIC
	JRST	RSTDE8		;ITS NOT
;IFN EBCDIC,<
	TLNN	AC3,20		; DEVICE A MTA?
	JRST	RSTD42		; NO
	SKIPGE	D.F1(I16)	; VARIABLE LENGTH EBCDIC?
	ADDI	AC10,1		; YES - ADD IN ONE FOR BLOCK DESCRIPTOR WORD
RSTD42:	TLNN	AC6,STNDRD	; LABELS STANDARD?
	JRST	RSTDE8		;NO - MUST BE OMITTED
	CAIGE	AC10,^D20+4	;
	MOVEI	AC10,^D20+4	;LABEL RECORD IS THE LARGEST RECORD
;>
RSTDE8:	TLNN	AC6,NONSTD	;SKIP IF NON-STANDARD LABELS
	JRST	RSTDE9		;
	HLRZ	AC1,F.LNLS(I16)	;NONSTD LABEL SIZE
	JUMPGE	FLG,RSTD10	;JUMP IF NOT ASCII
	ADDI	AC1,2		;ADD IN "CR-LF" CHARS
	IDIVI	AC1,5		;
RSTD10:	TLNN	FLG,DDMASC	;SKIP IF ASCII
	IDIVI	AC1,6		;
	SKIPE	AC2		;
	ADDI	AC1,1		;CONVERT CHARS TO WORDS
	CAIGE	AC10,3(AC1)	;
	MOVEI	AC10,3(AC1)	;ENSURE LABEL REC WILL FIT IN REC AREA
RSTDE9:	MOVEI	AC1,-3(AC10)	;
	HRRM	AC1,D.LRS(I16)	;SAVE IT FOR OPNNSB
	LDB	AC12,F.BNAB	;NUMBER OF ALTERNATES
	CAIN	I12,77		; [414] REALLY WANTS ONE?
	SETOI	I12,		; [414] YES ONE BUFFER.
	IMULI	AC10,2(I12)	;REC TIMES NUMBER OF ALTERNATE BUFFERS
	JRST	RSTD11		;
RSTDE6:	TLNN	AC3,200000	;SKIP IF DEV IS A DSK
	JRST	RSTER0		;COMPLAIN
	ADDI	AC10,7		;3+7=12 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:	TTCALL	3,[ASCIZ /ONLY DSK MAY BE USED FOR RANDOM, IO OR INDEX-SEQ PROCESSING/]
RSTERR:	MOVE	AC2,[BYTE (5)10,31,20]
	PUSHJ	PP,MSOUT.
IFE ISAM,<
RERIT.:	TTCALL	3,[ASCIZ /REWRITE ?/]
	SKIPA
DELET.:	TTCALL	3,[ASCIZ /DELETE ?/]
RSTIDX:	TTCALL	3,[ASCIZ /
TO PROCESS ISAM FILES CBLIO MUST BE REASSEMBLED WITH THE CONDITIONAL
ASSEMBLY SWITCH,ISAM, EQUAL TO A NON-ZERO VALUE./]
	JRST	KILL
>
IFN ISAM,<
;SETUP FOR AN INDEX FILE

RSTIDX:	PUSHJ	PP,OPNLIX	;IDXFIL FILENAME
IFE	TOPS20,<
	XCT	ULKUP.		;***************
	JRST	RSTID1		;
>
IFN	TOPS20,<
	PUSH	PP,.JBFF	;SAVE IT
	MOVEI	AC0,ICHAN	;MAKE SURE WE HAVE CORE
	PUSHJ	PP,GETSPC	;GO SEE
	 JRST	GETSPK		;NO CORE RETURN SO COMPLAIN
	POP	PP,.JBFF	;RESTORE JOBFF
	PUSH	PP,AC13		;SAVE AC13
	HLRZ	I12,D.BL(I16)	;GET BUFFER LOCATION
	MOVEI	AC0,1		;USE CHANNEL ONE
	MOVEM	AC0,ICHAN(I12)	;SAVE IT AWAY
	PUSHJ	PP,OCPT		;USE TOPS20 COMPT. UUO
	 JRST	[CAME	AC1,[0,,600130]	;INVALID SMU ACCESS?
		JRST	[TTCALL	3,[ASCIZ /RESET TIME /]
			JRST	OCPERR	]
		HRRZI	AC0,1B25	;YES - SO TRY A VALID ACCESS
		ANDCAM	AC0,CP.BK3	;TURN OFF THAWED (ON FROZEN)
		MOVE	AC1,[10,,CP.BLK];COUNT,,ADR OF ARG-BLK
		COMPT.	AC1,		;OPEN FILE IN FROZEN MODE
		 JRST	[TTCALL	3,[ASCIZ /RESET TIME /]
			JRST OCPERR	]
		JRST	.+1]
	POP	PP,AC13		;RESTORE AC13
	MOVE	AC3,(AC13)	;GET DEVICE NAME
	CALLI	AC3,4		;RESTORE DEVICE CHARACTERISTICS
>
	MOVEI	AC0,STABL	;
	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	AC12,1+ISPB(AC1)	;INDEX SECTORS / BLK
	JRST	RSTIER		;

	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
	TTCALL	3,[ASCIZ/ IS NOT THE INDEX FOR ISAM/]
	PUSHJ	PP,MSFIL.	;OUTPUT FILE NAME AND VID
	PUSHJ	PP,KILL	;KILL NEVER RETURNS

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

RSTID8:	PUSHJ	PP,MSFIL.	; [323]OUTPUT FILE NAME
	TTCALL	3,[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)	;
	CAMLE	AC2,MXBF	;
	MOVEM	AC2,MXBF	;

	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,3		;RESERVE 3 KEY AREAS
	JRST	RSTID3		;

RSTID2:	MOVEI	AC4,6		;1+1*3
	TRNN	AC6,1		;ODD = 1 WRD,  EVEN = 2 WRDS
	MOVEI	AC4,9		;2+1*3

RSTID3:	ADDI	AC12,2(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
	CALLI	AC2,4		;DEVCHR
	TLNE	AC2,200000	;DATA FILE
	TLNN	AC3,200000	;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
	TTCALL	3,[ASCIZ /DATA-MODE DISCREPANCY/]
	MOVE	AC2,[BYTE (5)10,31,20,4]
	JRST	MSOUT.		;

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
	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
	SETZM	UOBLK.		;
	JRST	RSTDE5		;RETURN

RSTIER:	XCT	UGETS.		;INPUT ERROR DURING RESET UUO
	TRNE	AC2,020000	;[376] EOF?
	TTCALL	3,[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
	CALLI	AC0,11		;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:	TTCALL	3,[ASCIZ/INSUFICIENT CORE FOR BUFFER REQUIREMENTS/]
	POPJ	PP,

GETSPK:	PUSHJ	PP,GETSP9
	JRST	KILL
		;SUBROUTINE TO SET UP OVERLAY FILE
IFE	%%RPG,<

SETOVR:	SKIPN	AC1,OVRFN.	;ANY FILE TO BE OPENED
	POPJ	PP,		;NO--RETURN

	HRLZI	AC0,577774	;[342]TURN OFF CHAN 1
	ANDM	AC0,OPNCH.	;DOIT
	HRROI	AC0,-1		;DSK = -1
	SKIPN	AC3,RN.DEV	;[333]IF DEVICE SPECIFIED, GET IT
	HRLZI	AC3,(SIXBIT /DSK/) ;
SETOV1:	MOVEI	AC2,14+1B30	;SET UP DEVICE
	HRRZI	AC4,OVRBF.	;
	OPEN	1,AC2		;[342]INIT 
	JRST	SETOV4		;
	MOVSI	AC2,(SIXBIT "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
	MOVEI	AC1,OVRIX.	;
	PUSHJ	PP,SETOV2	;
	MOVEI	AC1,OVRIX.+200	;

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

SETOV4:	TTCALL	3,[ASCIZ "CANNOT INITIALIZE OVERLAY DEVICE"]
	JRST	KILL

SETOV5:	HRLZI	AC3,(SIXBIT /SYS/) ;TRY SYS IF DSK FAILS
	AOJE	SETOV1		;
	TTCALL	3,[ASCIZ "CANNOT FIND OVERLAY FILE"]
	JRST	KILL

SETOV6:	TTCALL	3,[ASCIZ "INPUT ERROR ON OVERLAY DEVICE"]
	JRST	KILL

	>	; END OF IFE %%RPG

			;ROUTINE TO REORGANIZE THE FLAGS
RSTFLG:	MOVE	FLG,F.WFLG(I16)		;GET FLAGS
	HRLZI	AC15,4300		;
	AND	AC15,FLG		;RRUNER & RRUNRC
	LDB	AC1,[POINT 3,FLG,9]
	HLLZ	AC2,FLGTAB(AC1)		;DEVICE DATA MODE
	TLZ	AC2,037777		;
	IOR	AC15,AC2		;
	MOVEI	AC0,SASCII		; GET STANDARD ASCII FLAG
	CAIN	AC1,4			; AND SET IT IF REQUESTED
	IORM	AC0,D.RFLG(I16)		; DOIT
	LDB	AC1,[POINT 2,FLG,15]
	HLLZ	AC2,FLGTAB(AC1)		;CORE DATA MODE
	TLZ	AC2,777707		;
	IOR	AC15,AC2		;
	LDB	AC1,[POINT 2,FLG,17]
	HLLZ	AC2,FLGTAB(AC1)		;ACCESS MODE
	TLZ	AC2,777770		;
	IOR	AC15,AC2		;

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

	;BITS  0-3	DEVICE DATA MODE
	;     12-14	CORE DATA MODE
	;     15-17	ACCESS MODE
FLGTAB:	200022,,0
	040001,,0
	400044,,0
	100010,,0
	400000,,0	; STANDARD ASCII
	Z
	Z
	Z
;**; BEFORE TRAP. [414]
; FOR REAL PRINTER ON-LINE.
;
;	ERROR INTERCEPT.
INTLOC:	PUSH	PP,INTBLK+2	; [414] SAVE RETURN ADDRESS.
	PUSH	PP,AC13		; [414] SAVE AC13
	SETZM	INTBLK+2	; [414]
	MOVEI	AC13,^D30000	; [414] SLEEP FOR 1/2 MIN.
	HIBER	AC13,		; [414]
	JFCL			; [414]
	POP	PP,AC13		; [414] RESTORE AC13
	POPJ	PP,		; [414] RETURN TO PROGRAM TO RETRY.
;
;INITIALIZE INTERRUPT.
;
INTINT:	PUSH	PP,AC13		; [414] SAVE
	MOVEI	AC13,INTBLK	; [414] SAVE LOCATION OF INTERRUPT BLOCK
	MOVEM	AC13,.JBINT	; [414] IN JOBDAT.
	MOVEI	AC13,INTLOC	; [414] SAVE INTERRUPT ADDRESS
	HRLI	AC13,4		; [414] AND ITS LENGTH
	MOVEM	AC13,INTBLK	; [414] INTO INTERRUPT BLOCK
	MOVEI	AC13,1		; [414] SET FOR OFFLINE DEVICE.
	MOVEM	AC13,INTBLK+1	; [414]
	SETZM	INTBLK+2	; [414] CLEAR BLOCK
	SETZM	INTBLK+3	; [414]
	POP	PP,AC13		; [414] RESTORE AC13
	POPJ	PP,		; [414] RETURN.


			;TRAP INTERUPT ROUTINE
TRAP.:	MOVE	AC0,.JBCNI	;APR STATUS
	TRNE	AC0,20000
	TTCALL	3,[ASCIZ/MEMORY PROTECTION VIOLATION AT USER LOC /]
	TRNE	AC0,10000
	TTCALL	3,[ASCIZ/NON-EX-MEM REQUEST AT USER LOC /]
	TRNE	AC0,200000
	JRST	TRAP1		;PDLOV
TRAP0:	HRLO	AC12,.JBTPC	;THE GUILTY LOCATION
	PUSHJ	PP,PPOUT4	;OUTPUT THE LOC
IFE	%%RPG,<
	HRRZ	AC0,.JBTPC	;[312];SEE IF ERROR IS
	CAIL	AC0,RSTLNK	;[312];  IN RSTLNK
	CAIL	AC0,RSTLNX	;[312];  ROUTINE.
	JRST	KILL		;[312];NO
	TTCALL	3,[ASCIZ /$FAILING ROUTINE IS RSTLNK IN CBLIO
MACRO ROUTINE LOADED IN PLACE OF COBOL SUBROUTINE?/]
	>
	JRST	KILL		;AND KILL

TRAP1:	TTCALL	3,[ASCIZ/PUSH-DOWN-LIST OVERFLOW AT /]
	JRST	TRAP0

SRTER.:: TTCALL	3,[ASCIZ /YOU MUST RECOMPILE TO USE THE NEW SORT/]
	JRST	KILL.

	;ULOSE. IS THE ERROR EXIT FOR A UUO CALL TO A ROUTINE
	;THAT WAS NOT LOADED. THE RUN IS TERMINATED VIA KILL
ULOSE.:	TTCALL	3,[ASCIZ /ENCOUNTERED A UUOCALL FOR A ROUTINE THAT WAS NOT LOADED
/]
	SKIPA		;TO KILL

	;GOTO IS THE ERROR EXIT FOR UNALTERED "GOTO"
	;STATEMENTS WHICH DID NOT PROVIDE AN OBJECT PARAGRAPH NAME.
GOTO.:	TTCALL 3,[ASCIZ /ENCOUNTERED AN UNALTERED GOTO WITH NO DESTINATION
/]
	;KILL TYPES OUT THE LOCATION OF THE LAST COBOL UUO,
	;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
	TTCALL	3,[ASCIZ /
?/]
IFE	%%RPG,<
	SKIPE	TRAC1.		;IS THIS A PRODUCTION PROGRAM (I.E. /P)?	[EDIT#270]
	PUSHJ	PP,@TRAC1.	;NO, CALL BTRAC. IN TRACE ROUTINE
	>
	PUSHJ	PP,PPOUT.	;TYPE THE LOCATION OF LAST COBOL VERB
	JRST	STOPR2
	;TYPE OUT SOME ERROR INFORMATION

TYPSTS:	TTCALL	3,[ASCIZ /
$ ERROR-NUMBER = /]
TYPST1:	MOVE	AC0,FS.EN	;ERROR-NUMBER
	PUSHJ	PP,PUTDEC	;TYPE IT
	MOVE	AC0,FS.BN	;BLOCK-NUMBER
	JUMPE	AC0,TYPST2	;
	TTCALL	3,[ASCIZ /   BLOCK-NUMBER = /]
	PUSHJ	PP,PUTDEC	;
TYPST2:	MOVE	AC0,FS.RN	;RECORD-NUMBER
	JUMPE	AC0,RET.1	;
	TTCALL	3,[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
	TLNE	FLG,OPNIN+OPNOUT;  IF THE FILE IS OPEN
	PUSHJ	PP,C.CLOS	;  CLOSE IT
	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
	TTCALL	3,[ASCIZ /% /]	;
	PUSHJ	PP,PUTDEC	; TYPE NUMBER
	TTCALL	3,[ASCIZ/ ERRORS IGNORED/]
STOPR3:
IFE	%%RPG,<
	PUSHJ	PP,@HPRT.##	; PRINT HISTORY REPORT IF ANY
	>
	CALLI	12		;CALLI EXIT
	;TYPE THE VERSION NUMBER "LIBOL N(M)"
VEROUT:	SKIPN	AC12,.JBVER	;GET VERSION NUMBER
	JRST	VEROU1		;EXIT IF NOT THERE
IFE	%%RPG,<
	TTCALL	3,[ASCIZ /
LIBOL /]
	>
IFN	%%RPG,<
	TTCALL	3,[ASCIZ /
RPGLIB /]
	>
	MOVEI	AC0,4		;
	PUSHJ	PP,NUMOUT	;THE VERSION NUMBER
	MOVEI	AC0,6		;
	HRLZ	AC12,.JBVER	;
	JUMPE	AC12,VEROU1	;DONE IF NO EDIT NUMBER
	MOVEI	C,"("		;
	PUSHJ	PP,OUTCH.	;
	PUSHJ	PP,NUMOUT	;THE EDIT NUMBER
	MOVEI	C,")"		;
	PUSHJ	PP,OUTCH.	;
VEROU1:	JRST	DSPL1.		;"CRLF" AND EXIT

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
	POPJ	PP,

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

C.STOP:	TTCALL	3,[ASCIZ /$ TYPE CONTINUE TO PROCEED .../]
	CALLI	1,12		; WAIT FOR CONT
	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.:
IFE	%%RPG,<
	TTCALL	3,[ASCIZ /LAST COBOL VERB CALLED FROM /]
	>
IFN	%%RPG,<
	TTCALL	3,[ASCIZ /Last RPGLIB 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
IFE	%%RPG,<
	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
	TTCALL	3,[ASCIZ/ IN PROGRAM /]

	SKIPN	AC3,SBPSA.	; SKIP IF ANY SUBPRGMS
	JRST	PPOUT6		; NONE
PPOUT5:	TTCALL	3,[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
	TTCALL	3,[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
	TTCALL	3,[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
IFE	%%RPG,<
;	SUSPC: A SUBROUTINE THAT DETERMINES THE AMOUNT OF SPACE REQUIRED
;	FOR SIMULTANEOUS UPDATE, AND GETS IT. IT ALSO INITIALIZES THE
;	GLOBAL VARIABLES SU.RRT, SU.EQT, SU.DQT, SU.MQT,
;	AND SU.FBT TO POINT TO THE RETAINED RECORDS TABLE, THE ENQUEUE
;	TABLE, THE DEQUEUE TABLE, THE MODIFY TABLE, AND THE FILL/FLUSH
;	BUFFER TABLE.
;
;	ARGUMENTS:
;
;		AC14 CONTAINS THE ADDRESS OF A WORD CONTAINING THE
;		STARTING ADDRESS OF THE MAIN PROGRAM.
;
;	CHANGES:
;
;		AC0
;		AC1
;		AC2
;		AC3
;		WHATEVER GETSPC CHANGES
;
;	CALLS:
;
;		SUSPC1
;		GETSPC
;
;	ERRORS:
;
;		NOT ENOUGH SPACE AVAILABLE FOR SIMULTANEOUS UPDATE
;		REQUIREMENTS. IF THIS OCCURS, A MESSAGE IS SENT
;		TO TTY AND A JRST KILL. IS EXECUTED.

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

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

	SETZM	SU.RRT		;INITIALIZE GLOBAL VARIABLES
	SETZM	SU.EQT
	SETZM	SU.FBT
	PUSHJ	PP,SUSPC1	;EXAMINE THE MAIN PROGRAM AND ALL ITS
				;SUBPROGRAMS TO DETERMINE THE MAXIMUM
				;REQUIREMENTS FOR SIMULTANEOUS UPDATE
				;SPACE
	MOVE	AC0,SU.RRT
	ADD	AC0,SU.EQT
	ADD	AC0,SU.EQT
	ADD	AC0,SU.EQT	;(THERE ARE THREE ENQ/DEQ TABLES)
	ADD	AC0,SU.FBT
	SKIPN	AC0
	POPJ	PP,		;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:	TTCALL	3,[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
	>	; END OF IFE %%RPG
SUBTTL	SEEK-UUO

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

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


IFE	%%RPG,<
	;FORCE A CALL TO RRDMP
RENDP:	SETOM	REDMP.		;
	JRSTF	@.JBOPC		;CONTINUE

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

RSAREN:	HRR	AC2,RESET1
	HRRM	AC2,.JBSA
	MOVEI	AC2,RENDP
	MOVEM	AC2,.JBREN
	MOVEI	AC2,EDIT
	HRLI	AC2,VERSION
	MOVEM	AC2,.JBVER	;					[EDIT#272]
	POPJ	PP,

	>	; END OF IFE %%RPG
SUBTTL	DISPLAY-UUO

IFE	%%RPG,<
;CALLING SEQUENCE IS PUSHJ PP,DSPLY. WITH THE CALLING UUO IN AC 16.
;THE UUO'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: 17,15,11,7,6,AND 4.

;AC16=		;THE CALLING UUO
;AC15=		;UUO'S OPERAND
;AC6=		;CHARACTER COUNT
;AC4=		;BLANK COUNT
;AC12		;MUST NOT BE USED

;FOLLOWING BITS ARE IN LEFT HALF OF FLG
BIT6=	  4000	;NUMERIC, SUPPRESS LEADING SPACES AND TABS
BIT7=	  2000	;LAST FIELD, APPEND "CRLF"

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.
	TLNE	FLG,BIT7	;APPEND CR-LF AT END?
	JRST	DSPL2		;  YES
	ILDB	C,AC15		;GET A CHARACTER.
	SKIPE	C		;DONT PASS NULLS BUT COUNT THEM
	PUSHJ	PP,OUTEST	;OUTPUT A CHAR.
	SOJG	AC6,.-3		;LOOP IF NOT DONE.
	JRST	OUTBF.		;DUMP THE BUFFER AND EXIT.
DSPL2:	SETZ	AC4,		;CLEAR THE BLANK COUNT
DSPL23:	ILDB	C,AC15		;GET A CHARACTER
	CAIN	C,040		;A BLANK?
	AOJA	AC4,DSPL21	;  YES
	JUMPE	AC4,DSPL22	;JUMP IF NO ACCUMULATED BLANKS
	MOVEI	C,040		;OUTPUT BLANKS
	PUSHJ	PP,OUTEST	;
	SOJG	AC4,.-2		;LOOP
	LDB	C,AC15		;RESTORE ORIGINAL CHARACTER
DSPL22:	SKIPE	C		;COUNT NULLS BUT DONT OUTPUT THEM
	PUSHJ	PP,OUTEST	;OUTPUT THE CHARACTER
DSPL21:	SOJG	AC6,DSPL23	;LOOP
	>		; end of IFE %%RPG
DSPL1.:	MOVEI	C,15		;APPEND CR-LF
	PUSHJ	PP,OUTCH.	;	.
	MOVEI	C,12		;	.
	PUSHJ	PP,OUTCH.	;	.
	JRST	OUTBF.		;DUMP BUFFER AND EXIT.
IFE	%%RPG,<
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

OUTEST:	TLNN	FLG,BIT6	;SUPPRESS LEADING SPACES?
	JRST	OUTCH.		; NO.
	CAIE	C,40		; YES, ARE THERE ANY?
	CAIN	C,11		;
	POPJ	PP,		;	YES.
	TLZA	FLG,BIT6	;	NO, AND NONE FOLLOWING.
	>		; END OF IFE %%RPG
OUT6B.:	ADDI	C,40		;CONVERT A 6IXBIT CHAR
OUTCH.:	IDPB	C,TTOBP.	;DEPOSIT CHAR. IN BUFFER.
	SOSLE	TTOBC.		;DUMP THE BUFFER?
	POPJ	PP,		; NO.

	;OUTPUT A TTY BUFFER.  ***POPJ***
OUTBF.:	SETZ	C,		;ASCIZ TERMINATOR
	IDPB	C,TTOBP.	;
	TTCALL	3,TTOBF.	;DUMP THE BUFFER
OUTBF1:	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
	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.:	TTCALL	4,C		;INPUT A LINE, FIRST CHAR TO C	[EDIT#267]
	CAIN	C,15
	JRST	GETCH.
	CAIN	C,33
	JRST	GETCH1
	CAIG	C,14
	CAIGE	C,12
	JRST	RET.2
GETCH1:	MOVEI	C,12
	POPJ	PP,
SUBTTL	OPEN-UUO

	;AN OPEN UUO LOOKS LIKE:
	;001000,,ADR	WHERE ADR = FILE TABLE ADDRESS
	;BIT9  =1	OPEN FOR OUTPUT
	;BIT10 =1	OPEN FOR INPUT
	;BIT11 =1	DON'T REWIND
	;BIT12 =0	ALWAYS 0 (VS. 1 = CLOSE)
	;CALL+1:	POPJ RETURN


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

C.OPEN:	TLO	AC16,OPEN	;OPEN-UUO
	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
	HLRZ	AC0,F.WDNM(I16)	;[346] CHECK FLAG TO SEE IF THIS
	TRNN	AC0,4000	; FILE TABLE HAS BEEN LINKED TO
	JRST	OOVLER		; THE CHAIN.
	TLNN	FLG,OPNIN+OPNOUT ;IS THE FILE OPEN?
	JRST	OPNLOC		;NO
	HRLZI	AC2,(BYTE (5)10,2,3) ;FCBO,AO.
	MOVEI	AC0,^D10	;ERROR NUMBER
	JRST	OXITER		;ONLY CLOSED FILES MAY BE OPENED
OPNLOC:	SETZM	D.RP(I16)	;INITIALIZE THE RECORD SEQUENCE NUMBER
	MOVE	AC5,D.LF(I16)	;
	TLNN	AC5,LOCK	;SKIP IF THE FILE IS LOCKED
	JRST	OPNOPT		;
	MOVEI	AC0,^D11	;ERROR NUMBER
	PUSHJ	PP,OXITP	;DOESN'T RETURN IF IGNORING ERRORS
	TTCALL	3,[ASCIZ /LOCKED /]
	HRLZI	AC2,(BYTE(5)10,2,4)
	JRST	MSOUT.		;EXIT, THE FILE IS LOCKED
OPNOPT:	TLNE	AC16,400	;SKIP IF NOT OUTPUT
	TLO	FLG,OPNOUT	;
	TLNE	AC16,200	;SKIP IF NOT INPUT
	TLO	FLG,OPNIN	;
	TLNE	FLG1,FILOPT	;IS FILE OPTIONAL?
	JRST	OPNOP		;YES. RETURNS ONLY IF PRESENT
OPNSBA:	PUSHJ	PP,DEVIOW	;RESET THE DEVICE IOWD
	TLNE	FLG,RANFIL	;SKMFILE
	PUSHJ	PP,OPNSFL	;STORE THE FILE LIMITS SO HE CAN'T DIDDLE
	HLRZ	AC4,F.LSBA(I16)	;FILTAB THAT SHARES THE SAME BUFFER
OPNSB1:	JUMPE	AC4,OPNDEV	;JUMP IF NO ONE SHARES
	CAIN	AC4,(I16)	;HAVE WE CHECKED ALL "SBA" FILTAB'S
	JRST	OPNDEV		;YES
	HLL	AC4,10(AC4)	;GET THE FLAGS
	TLNE	AC4,030000	;SKIP IF ANY FILES ARE NOT OPEN
	JRST	OPNSB2		;GIVE AN ERROR MESSAGE
	HLRZ	AC4,15(AC4)	;GET NEXT "SBA FILTAB"
	JRST	OPNSB1		;+LOOP
OPNSB2: MOVEI	AC0,^D12	;ERROR NUMBER
	PUSHJ	PP,OXITP	;DOESN'T RETURN IF IGNORING ERRORS
	MOVE	AC5,AC4		;MSOUT. USES AC4
	MOVE	AC2,[BYTE (5)10,31,20,2,1,14]
	PUSHJ	PP,MSOUT.
	HRLZI	AC2,(BYTE (5)10,31,20)
	HRR	AC16,AC5
	JRST	MSOUT.		;SOME OTHER FILE IS USING OUR BUFFER AREA

OOVLER:	HRRZ	AC0,HLOVL.	;[346] GET START OF OVERLAY AREA
	CAIG	AC0,(I16)	;[346] IF FILE-TABLE IN OVL AREA
	JUMPN	AC0,OOVLE1	;[346] COMPLAIN
	MOVEI	AC0,^D30	;ERROR NUMBER
	PUSHJ	PP,OXITP	;POPJ TO MAIN LINE IF IGNORING ERRORS
	TTCALL	3,[ASCIZ "ATTEMPT TO DO I/O FROM A SUBROUTINE CALLED BY A NON RESIDENT SUBROUTINE."]	;[346]
	JRST	OOVLE2		;[346]
OOVLE1:	MOVEI	AC0,^D31	;ERROR NUMBER
	PUSHJ	PP,OXITP	;POPJ IF IGNORING ERRORS
OOVLE2:	TTCALL	3,[ASCIZ /IO CANNOT BE DONE FROM AN OVERLAY/]	;[346]
	HRLZI	AC2,(BYTE (5)10,2)	;[346] GO COMPLAIN
	PUSHJ	PP,MSOUT.	;[346] DOESN'T RETURN

OPNOP:	TLNE	FLG,OPNOUT	;SKIP IF NOT OUTPUT
	JRST	OPNSBA		;OUTPUT FILES ARE NOT OPTIONAL
;OPNOP+2 [277] IG 22-OCT-73
	PUSHJ	PP,$SIGN	;OUTPUT "$" FOR .OPERATOR		[EDIT#277]
	TTCALL	3,[ASCIZ /IS /]	;OPTIONAL FILE PRESENT?
	PUSHJ	PP,MSFIL.
	TTCALL	3,[ASCIZ / PRESENT? .../]
	PUSHJ	PP,YES.NO	;SKIP RETURN IF "NO" ANSWER
	JRST	OPNOP1		;YES
	TLO	FLG,NOTPRS	;NO, "NOT PRESENT"
	TLZ	FLG,OPNIN	;NOTE THAT IT'S NOT OPEN
	MOVEM	FLG,F.WFLG(I16)	;%SAVE THE FLAG WORD
	POPJ	PP,		;RETURN TO MAIN LINE *EXIT************

OPNOP1:	TLNN	FLG,IDXFIL	;ISAM FILE?
	JRST	OPNSBA		;NO
	MOVE	AC1,D.OPT(I16)	;WERE THE BUFFERS SETUP AT RESET TIME?
	AOJN	AC1,OPNSBA	;EXIT HERE IF THEY WERE
	MOVEI	AC0,^D29	;ERROR NUMBER
	PUSHJ	PP,OXITP	;DOESN'T RETURN IF IGNORING ERRORS
	TTCALL	3,[ASCIZ /EITHER THE ISAM FILE DOES NOT EXIST OR
 THE VALUE OF ID CHANGED DURING THE PROGRAM/] ;[374]
	PUSHJ	PP,KILL		;AND DONT RETURN

YESNO:	TTCALL	11,0		;CLEAR THE BUFFER
	TTCALL	3,[ASCIZ /$ TYPE YES OR NO
/]
YES.NO:	MOVE	AC5,[POINT 7,[ASCIZ /ES/],]
	PUSHJ	PP,GETCH.
	  JRST	.-1

	CAIE	C,"Y"
	JRST	YESNO2
YESNO1:	PUSHJ	PP,GETCH.
	  POPJ	PP,		;IS THE "YES" RETURN
	ILDB	AC4,AC5
	JUMPE	AC4,RET.1	;[V10]
	CAMN	AC4,C
	JRST	YESNO1
	JRST	YESNO
YESNO2:	MOVE	AC5,[POINT 7,[ASCIZ /NO/],]
YESNO3:	ILDB	AC4,AC5
	JUMPE	AC4,RET.2	;[V10]
	CAME	AC4,C
	JRST	YESNO
	PUSHJ	PP,GETCH.
	  JRST	RET.2		;THE NO RETURN
	JRST	YESNO3
	;SETUP DEVICE IOWD
DEVIOW:	HRLOI	AC0,77		;
	AND	AC0,F.WDNM(I16)	;
	TLC	AC0,-1		;
	AOBJP	AC0,.+1		;
	HRR	AC0,F.WDNM(I16)	;
IFN ISAM,<
	TLNE	FLG,IDXFIL	;IF INDEX FILE
	AOBJP	AC0,.+1		;  POINT AT DATA DEVICE
>
	MOVEM	AC0,D.ICD(I16)	;
	POPJ	PP,		;
	;SET THE FILE LIMIT CLAUSES IN THE FILE-TABLE.  ***POPJ***

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

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

OPNDEV:	SETZM	D.OE(I16)	;CLEAR NUMBER OF OUTPUTS
	SETZM	D.IE(I16)	;  NUMBER OF INPUTS
	PUSHJ	PP,DEVCHR	;GET THE DEVICE CHAR.
	TLNE	AC13,40		;SKIP IF NOT AVAILABLE TO JOB
	JRST	OPNDE2
	MOVE	AC2,[BYTE (5)10,2,4,20,15]	;FCBO,DINATTJ.
	MOVEI	AC0,^D13	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN


OPNDE2:	TLNN	AC13,200000	;SKIP IF A DSK
	TRNN	AC13,200000	;SKIP IF DEV IS INITED
	JRST	OPNDE6
	MOVE	AC2,[BYTE (5)10,2,4,20,16]	;FCBO,DIATAF.
	MOVEI	AC0,^D14	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

OPNDE6:	TLNN	FLG,OPNIO	;SKIP IF IO IS REQUESTED
	JRST	OPNDE7		;NEXT TEST
	TLNE	AC13,200000	;SKIP IF DEVICE IS NOT A DSK
	JRST	OPNCHN		;FIND A FREE CHANNEL
	MOVE	AC2,[BYTE (5)10,2,4,20,17]
	MOVEI	AC0,^D15	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

OPNDE7:	TLNE	FLG,OPNIN	;SKIP IF NOT AN INPUT REQUEST
	TLNE	AC13,2		;SKIP IF DEVICE CANNOT DO INPUT
	JRST	OPNDE8		;NEXTEST
	MOVE	AC2,[BYTE (5)10,2,4,20,21]
	MOVEI	AC0,^D16	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

OPNDE8:	TLNE	FLG,OPNOUT	;SKIP IF NOT AN OUTPUT REQUEST
	TLNE	AC13,1		;SKIP IF DEVICE CANNOT DO OUTPUT
	JRST	OPNCHN		;FIND A FREE CHAN
	MOVE	AC2,[BYTE (5)10,2,4,20,22]
	MOVEI	AC0,^D17	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN

DEVCHR:	MOVE	AC13,D.ICD(I16)	;ADR OF DEV. NAME
	MOVE	AC13,(AC13)	;SIXBIT/DEVICE NAME/
	MOVEM	AC13,UOBLK.+1	;FOR OPEN
	CALLI	AC13,4		;DEVCHR UUO
	TLNN	FLG,OPNIO+OPNIN	;[330]IF NOT INPUT THEN IGNORE
	JRST	DEVCH1			;[330]
	TLC	AC13,300000		;[330]IF A DSK AND A CDR
	TLCN	AC13,300000		;[330]THEN ITS DEVICE 'NUL'
	TLZ	AC13,20			;[330]SO ITS NOT A MAGTAPE
DEVCH1:	MOVEM	AC13,D.DC(I16)	;[330]SAVE THE CHARACTERISTICS
	SKIPE	AC13
	POPJ	PP,
	MOVE	AC2,[BYTE (5)10,2,4,20,13]	;FCBO,DINAD.
	POP	PP,(PP)		;POP OFF THE RETURN
	MOVEI	AC0,^D18	;ERROR NUMBER
	JRST	OXITER		;COMPLAIN
	;FIND A FREE DEVICE CHANNEL AND SETUP THE BUFFERS
	;XCT OPEN, INBUF AND/OR OUTBUF  ***OPNBSI***

OPNCHN:	PUSHJ	PP,GCHAN	;LOAD AC5 WITH A CHANNEL NUMBER
	DPB	AC5,DTCN.	;SAVE IT
IFN ISAM,<
	TLNN	FLG,IDXFIL	;INDEX FILE ?
	JRST	OPNCH1		;NO
	PUSHJ	PP,GCHAN	;
	HLRZ	I12,D.BL(I16)	;
	HRRZM	AC5,ICHAN(I12)	;SAVE INDEX FILE CHAN NO.
>
OPNCH1:	PUSHJ	PP,SETC1.	;DISTRIBUTE THE CHANNEL NUMBER
	TLNE	FLG,DDMASC	;SKIP IF NOT ASCII
	TDZA	AC6,AC6		;ASCII MODE AND SKIP
	MOVEI	AC6,14		;PERHAPS BINARY
	TLNE	FLG,RANFIL!OPNIO!IDXFIL ;SKIP IF BUFFERED IO
	MOVEI	AC6,17		;DUMP MODE
	HRRM	AC6,UOBLK.	;UOBLK.+1 SET AT DEVCHR
	HRLI	AC6,D.OBH(I16)	;OUTPUT BUFFER HEADER
	HRRI	AC6,D.IBH(I16)	;INPUT BUF HDR
	MOVEM	AC6,UOBLK.+2
IFN ISAM,<
	TLNN	FLG,IDXFIL	;ISAM ?
	JRST	OPNCH3		;NO
	MOVE	AC1,F.WDNM(I16)	;ADR
	MOVE	AC1,(AC1)	;IDX DEVICE NAME
	MOVEM	AC1,UOBLK.+1	;
OPNCH3:>
	SKIPN	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNC31		; NO
IFE TOPS20,<
	PUSHJ	PP,OPNFOP	; YES OPEN FILE VIA FILOP
	 JRST	OFERR		; ERROR RETURN
>; END OF IFE TOPS20
IFN TOPS20,<
	PUSHJ	PP,OCPT	; OPEN FILE VIA DEC-SYS-20 COMPT.
	 JRST	OCPER		; ERROR RETURN
>; END IFN TOPS20
	JRST	OPNC41		;
OPNC31:	XCT	UOPEN.		;OPEN THE DEVICE ***************
OPNCH4:	 JRST	OERRIF		;OPEN FAILED
OPNC41:	PUSHJ	PP,OPNWPB	;RETS LOGICAL BLOCK SIZE IN AC10, BLKFTR IN AC5
	LDB	AC6,F.BNAB	;NUMBER OF ALTERNATE BUFFERS (FOR INBUF X,2(AC6))
	TLNE	AC13,20		;SKIP IF NOT A MTA
	JUMPN	AC5,OPNNSB	;NON STANDARD BUFFER SIZE
IFN ISAM,<
	TLNE	FLG,IDXFIL	;ISAM ?
	JRST	OPNIDX		;YES
>
	TLNE	FLG,OPNIO+RANFIL ;OPNIO=IOFILE
	JRST	OPNRIO		;RANDOM OR IO DUMP MODE BUFFERS
	PUSH	PP,.JBFF
	HLRZ	AC11,D.BL(I16)	;BUFFER LOCATION
	MOVEM	AC11,.JBFF
	CAIN	AC6,77		; [414] REALLY WANTS ONE?
	SETOI	AC6,		; [414] YES, ONE BUFFER.
	TLNE	FLG,OPNIN	;INPUT?
	XCT	UIBUF.		;**********
	TLNE	FLG,OPNOUT	;OUTPUT?
	XCT	UOBUF.		;**********
	POP	PP,.JBFF	;RESTORE .JBFF
OPNCH2:	TLNE	AC13,4		;SKIP IF NON-DIRECTORY DEVICE
	TLNE	FLG1,STNDRD	;SKIP IF NOT STANDARD LABELS
	JRST	OPNBSI		;SET THE BYTE SIZE
	PUSHJ	PP,RCHAN	;RELEASE DEVICE AND CHANNEL
	MOVEI	AC0,^D19	;ERROR NUMBER
	PUSHJ	PP,OXITP	;RETURN TO CBL-PRG IF IGNORING ERRORS
	MOVE	AC2,[BYTE (5)10,2,4,26] ;FCBO,DDMHSL
	JRST	MSOUT.
	;SET UP NON-STD MTA BUFFERS (SIZE OF LOGICAL BLOCK).  ***OPNCH2***

OPNNSB:	ADDI	AC6,2		;ALTERNATE PLUS 2 DEFAULT BUFFERS
	TLNE	FLG1,STNDRD+NONSTD ;SKIP IF OMITTED LABELS
	HRRZ	AC10,D.LRS(I16)	;IN CASE LABEL IS GE TO REC AREA
	HLRZ	AC4,D.BL(I16)	;BUFFER LOCATION
	ADDI	AC4,1		;BUF1+1
	HRLI	AC4,400000	;   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...
	JRST	OPNCH2		;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
	MOVNM	AC10,AC6	;0,,-N
	HRLI	AC6,R.FLMT(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
	HRRI	AC6,1+R.FLMT(I12);FIRST DATA WORD
	TLNE	FLG1,VLREBC	; IF VAR-LEN EBCDIC RECORDS
	ADDI	AC6,1		; SKIP OVER THE BLOCK-DESCRIPTOR-WORD
	MOVEM	AC6,R.BPNR(I12)	; NEXT RECORD
	MOVEM	AC6,R.BPFR(I12)	;BYTE POINTER TO THE FIRST RECORD
	JRST	OPNCON		;RET

IFN ISAM,<
	;SETUP INDEX FILE BUFFER AND TABLE AREAS

OPNIDX:	SETZM	USOBJ(I12)	;[377] CLEAR THE FIRST WORD OF INDEX TABLE
	HRRI	AC0,USOBJ+1(I12);TO
	HRLI	AC0,USOBJ(I12)	;FROM,,TO
	HRRZI	AC1,ITABL-15+ICHAN(I12)  ;UNTIL
	BLT	AC0,(AC1)	;CLEAR REST OF INDEX TABLE
	HRLZ	AC0,D.IBL(I16)	; [377] SEE IF WE HAVE A SAVE AREA
	JUMPE	AC0,OPNIX1	; [377] NO- GO ON
	HRRI	AC0,ISCLR1(I12)	; [377] SET UP TO
	HRRZI	AC1,ISCLR2(I12)	; [377] MOVE ISAM SAVE AREA TO
	BLT	AC0,(AC1)	; [377] TO SHARED BUFFER AREA
OPNIX1:	PUSHJ	PP,OPNLIX	;INDEX FILE-NAME TO LOOKUP BLOCK
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNIX2		; YES
	XCT	ULKUP.		;LOOKUP
	 JRST	OLERRI		;LOOKUP FAILED
OPNIX2:	TLNN	FLG,OPNOUT	  ;OPEN FOR UPDATING?
	JRST	OPNI01		;NO
OPNI00:	TLO	FLG1,EIX	;ENTER OF .IDX FILE IN PROGRESS
	PUSHJ	PP,OPNEIX	;INDEX FILE-NAME TO ENTER BLOCK
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNIX3		; YES
	XCT	UENTR.		;ENTER, FOR UPDATING
	 JRST	OEERRI		;ENTER FAILED
OPNIX3:	TLZ	FLG1,EIX	;FREE THIS BIT FOR "RIVK" FLAG
OPNI01:	HRLZI	AC1,STABL	;STATISTICS BLOCK LEN
	MOVNS	AC1		;
	HRR	AC1,I12		;
	SUBI	AC1,1		;DUMP MODE IOWD
	MOVEM	AC1,IOWRD+14(I12)	;SAVE IN IOWRD TABLE
	SETZ	AC2,		;TERMINATOR
	MOVEI	AC0,1		;
	HRRM	AC0,UIN.	;
	XCT	UIN.		;READ THE STATISTICS BLOCK
	 JRST	OPNI02		;
	MOVE	AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER
	PUSHJ	PP,IGMIR		;IGNORE THE ERROR?
	 JRST	RCHAN			;YES - RELEASE THE IO CHANNELS
	TTCALL	3,[ASCIZ /OPEN FAILED - /]
	TTCALL	3,[ASCIZ /CANNOT READ STATISTICS BLOCK/]
	PUSHJ	PP,SETIC		;SET UP IGETS CHANNEL NO.
	JRST	IINER

	;OPEN THE DATA FILE
OPNI02:	HLLZS	UIN.		;CLEAR THE IOWR POINTER
	MOVEI	AC0,17		;DUMP MODE
	HRRM	AC0,UOBLK.	;SETUP OPEN BLOCK
	MOVE	AC1,F.WDNM(I16)	;
	MOVE	AC1,(AC1)	;
	MOVEM	AC1,UOBLK.+1	;
	SETZM	UOBLK.+2	;
	PUSHJ	PP,SETCN.	;SET DATA FILE CHANNEL
	SKIPN	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNI21		; NO
IFE TOPS20,<
	PUSHJ	PP,OPNFPD	; OPEN FILE VIA FILOP UUO
	 JRST	OFERRI		; ERROR RETURN
>; END IFE TOPS20
IFN TOPS20,<
	PUSHJ	PP,OCPTD	; OPEN FILE VIA DEC-SYS-20 COMPT.
	 JRST	OCPERI		; ERROR RETURN
>;END IFN TOPS20
	JRST	OPNI22		; SKIP THE OPEN UUO
OPNI21:	XCT	UOPEN.		;OPEN THE DATA FILE
	 JRST	OERRDF		;ERROR RETURN

	;SETUP IOWRD TABLE
OPNI22:	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
	SKIPN	AC4,OMXLVL(I12)	;USE ORIGINAL # OF LEVELS
	MOVN	AC4,MXLVL(I12)	;MAXIMUM NUMBER OF INDEX LEVELS
	MOVEM	AC4,OMXLVL(I12)	;SAVE INCASE THIS FILE IS OPENED AGAIN
;[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
	JUMPE	AC5,OPNI06	;SKIP THE FOLLOWING IF NOT
	HRL	AC4,AC5		;NEW LEVEL(S)
	HRRZ	AC5,ISPB(I12)	; SECTORS PER BLOCK			[EDIT#306]
	IMULI	AC5,200		; WORDS PER SECTOR			[EDIT#306]
	MOVN	AC6,AC5		; NEGATE THE LENGTH			[EDIT#306]
	HRLZS	AC6		; -LENGTH,,0				[EDIT#306]
	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		;SET UP AC0				[EDIT#306]
	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	; GET PROGRAMS MAX REC SIZE [371]
	CAMN	AC0,RECBYT(I12)	; SEE IF SAME AS ISAM PARM [371]
	JRST	OPNI07		; IT DOES- OF [371]
	CAML	AC0,RECBYT(I12)	; [375]  WHICH WAY IS FD DIFFERENT?
	JRST	OPNGR		; [375] FD GT ISAM
	TLNN	FLG,OPNIN+OPNIO	; [375]  FD LT ISAM-FILE OPEN FOR OUTPUT?
	JRST	OPNI07		; [375] YES OKAY
	JRST	OPNER1		; [375] NO-INPUT OR I/O ERROR
OPNGR:	TLNN	FLG,OPNIO+OPNOUT	; [375]  FD GT ISAM- IS FILE OPEN FOR INPUT ?
	JRST OPNI07		; [375] YES OKAY
OPNER1:				; [375]
	TTCALL	3,[ASCIZ /USERS MAXIMUM RECORD SIZE /] ; [371]
	PUSHJ	PP,PUTDEC	; TYPE IT [371]
	TTCALL 3,[ASCIZ / DIFFERS FROM ISAM PARAMETER /]	;[371]
	MOVE	AC0,RECBYT(I12)	; GET ISAM MAX REC SIZE [371]
	PUSHJ	PP,PUTDEC	; TYPE IT [371]
	JRST	OPNERX		; FINISH UP MSG AND STOP RUN [371]
OPNI07:				; [371]
	PUSHJ	PP,OPNWPB	;AC5 = BLKFTR, AC10 = WPB
	MOVE	AC6,DBF(I12)	;DATA FILE BLOCKING FACTOR VIA STA BLOCK
	CAMN	AC5,AC6		;AC5 = BLKFTR VIA FILE TABLE
	JRST	OPNI05		;OK
	MOVE	AC0,[E.FIDX+^D9]	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE THE ERROR?
	 JRST	RCHAN		;YES - RELEASE IO CHANS
	TTCALL	3,[ASCIZ /USERS BLOCKING FACTOR /]	; [371]
	MOVE	AC0,AC5		; GET USER BF [371]
	PUSHJ	PP,PUTDEC	; TYPE IT [371]
	TTCALL 3,[ASCIZ / DIFFERS FROM ISAM PARAMETER /]	;[371]
	MOVE	AC0,AC6		; GET ISAM BF [371]
	PUSHJ	PP,PUTDEC	; TYPE IT [371]
OPNERX:				; [371]
	TTCALL 3,[ASCIZ/
/]				; [371]
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.

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

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

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

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

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

	LDB	AC4,[POINT 6,DBPRK(I12),5]
	SETZ	AC5,		;
	SETO	AC6,		;
	LSHC	AC5,(AC4)	;
	MOVEM	AC5,FWMASK(I12)	;007777 FIRST WORD MASK

	TLNN	AC3,760000	;
	JRST	OPNMS1		;
	LDB	AC4,[POINT 6,AC3,5]  ;THE KEY IS LESS THAN ONE WORD
	MOVNS	AC4		;
	LSH	AC5,(AC4)	;
	MOVNS	AC4		;
	LSH	AC5,(AC4)	;
	JRST	.+2		;007700 AC5 HAS MASK

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

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

	;BPSB - NUMBER OF BITS PER SAT BLOCK
OPNBPS:	MOVE	AC0,FILSIZ(I12)	;TOTAL NUMBER OF DATA BLOCKS IN FILE
	IDIV	AC0,SBTOT(I12)	;  WILL GIVE NUMBER PER SAT BLOCK
	MOVEM	AC0,BPSB(I12)	;SAVIT

	;ICMP, DCMP - SETUP DISPATCH ADR FOR COMPARE ROUTINES
	;0 = DCDNN, 1 = DC1S/U, 2 = DC2S/U
OPNDSP:	LDB	AC2,KY.TYP	; GET KEY TYPE
	JUMPE	AC2,OPNDS1	; ZERO STAYS A ZERO
	TRNE	AC2,1		;
	TRZA	AC2,-2		; ODD BECOMES 1
	HRRZI	AC2,2		; EVEN BECOMES 2
OPNDS1:	HRRZ	AC0,KEYDES(I12)	; GET KEY SIGN

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

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

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

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

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

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

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

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

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

OPNIR0:	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	MOVE	AC0,[E.FIDX+^D7]	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	RCHAN		;YES - RELEASE IO CHANNELS
	TTCALL	3,[ASCIZ /CANNOT EXPAND CORE WHILE SORT IS IN PROGRESS/]
	JRST	OMTA99

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

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

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

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

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

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

	LDB	AC6,[POINT 2,FLG,2] ; GET DEVICE DATA MODE
	HRRZ	AC6,RBPTBL(AC6)	; AND THEN CHARS PER WORD
	HRRZM	AC6,D.BPW(I16)	;CHARS PER WORD
	JUMPL	FLG,OPNWP1	;JUMP IF ASCII
	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
	IMUL	AC10,AC5	;WORDS PER LOGBLK
	POPJ	PP,		;

OPNWP4:	SKIPGE	D.F1(I16)	; IF VARIABLE LEN EBCDIC RECORDS
	ADDI	AC10,(AC6)	; INCLUDE RDW WITH REC-SIZE
	JRST	OPNWP6		;
OPNWP1:	ADDI	AC10,2		;FOR CRLF
OPNWP6:
IFN ISAM,<
	TLNE	FLG,IDXFIL	;INDEX FILE?	[372]
	JRST	OPNWP5		; YES USE DIFFERENT CALC [372]
>
	IMUL	AC10,AC5	; NO. OF CHARS IN LOGIGAL BLOCK [372]
	PUSH	PP,AC10		; SAVE CPL
	ADDI	AC10,-1(AC6)	; ROUND UP [372]
	IDIVI	AC10,(AC6)	; NO. OF WORDS PER LOGICAL BLOCK [372]
	POP	PP,AC6		; RESTORE CHARS-PER-LOGI-BLK
	MOVEM	AC6,D.TCPL(I16)	; TOTAL CHARS/LOG-BLOCK
	TLNE	FLG,OPNIN	; D.FCPL MUST BE ZERO FOR
	SETZ	AC6,		; THE FIRST READ UUO
	MOVEM	AC6,D.FCPL(I16)	; FREE CHARS/LOG-BLOCK
	TLNE	FLG1,VLREBC	; VAR-LEN EBCDIC FILE?
	ADDI	AC10,1		; YES - ADD 1 FOR BDW
	POPJ	PP,		; [372]

;RECORDING MODE IS BINARY--CONVERT SIZE TO WORDS

OPNWP3:	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:	JUMPL	FLG,OPNCON	;JUMP IF DEVICE IS ASCII
	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
	TLNN	AC13,20		; 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,		; ERROR RET - ASSUME ITS OK (IE 9TRK)
	TRNE	AC1,1B31	; 9 CHANNEL?
	JRST	OPNBS1		; 7 CHANNEL.
	MOVEI	AC6,^D8		; 9TRK SO 8 BITS WIDE
	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,(JFCL)		; 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,(JFCL)		; NO CONVERSION
	MOVEM	AC3,D.WCNV(I16)		; SAVE FOR LATER - WRITE

	MOVEI	AC0,200		;DSK BUFFER SIZE
	TLNE	FLG,OPNIO!RANFIL!IDXFIL ;SKIP IF NOT RANDOM OR IO
	JRST	OPNBP3		;
	TLNN	AC13,20		;SKIP IF A MTA
	JRST	OPNBP1		;JUMP, NOT A MTA
	JUMPE	AC5,OPNBP1	;JUMP IF BLK-FTR IS ZERO (AC5)
	MOVEI	AC10,1		;ONE BUFFER PER LOGICAL BLOCK
	JRST	OPNBP2		;
OPNBP1:	HRRZ	AC11,D.IBH(I16)	;ASSUME INPUT
	TLNN	FLG,OPNIN	;SKIP IF INPUT
	HRRZ	AC11,D.OBH(I16)	;MUST BE OUTPUT
	HLRZ	AC0,(AC11)	;BUFFER SIZE + 1 IN WORDS
	SUBI	AC0,1		;SIZE
OPNBP3:	IDIV	AC10,AC0	;/BUF-SIZE
	SKIPE	AC10+1		;ROUND UP
	ADDI	AC10,1		;AC10=BUFFERS PER LOGICAL BLOCK
OPNBP2:	MOVEM	AC10,D.BPL(I16)	;BUFBLK
	TLNE	FLG1,VLREBC	; IF EBCDIC VARIABLE LEN-RECS INIT
	SETZ	AC10,		; D.BCL TO ZERO FOR FIRST READ UUO
	MOVEM	AC10,D.BCL(I16)	;CURRENT BUFBLK
	HRR	AC10,F.RRRC(I16);GET RERUN RECORD COUNT

	HRRZM	AC10,D.RRD(I16)	;NUMBER OF RECORDS TO A RERUN DUMP

OPNBP4:	TLNE	AC13,20		;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:	TLNN	AC16,OPEN	;OPEN UUO SKIPS
	JRST	OPNLO1		;
	MOVEI	AC0,2020	;SIXBIT REEL NUMBER '00'
	LDB	AC1,F.BPMT	;FILE POSITION (ON MTA)
	SKIPN	AC1		;SKIP IF MULTI-FILE-REEL
	ADDI	AC0,1		;MULTI-REEL-FILE  REEL '01'
	TLNN	AC16,1000	;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
	TLNN	AC13,4		;SKIP IF DIRECTORY DEVICE
	JRST	OPNRLB		;READ LABEL INTO RECORD AREA
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNLU1		; YES
	XCT	ULKUP.		;*** LOOKUP ***************
	 JRST	OPNLER		;ERROR RETURN
OPNLU1:	TLNE	FLG,OPNIO	; TRY FOR EXTENDED LOOKUP
	PUSHJ	PP,OPNELO	; IF VLEN EBCDIC SEQIO FILE
	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
	MOVE	AC0,ULBLK.	;FILE NAME
	MOVE	AC1,ULBLK.+1	;EXTENSION
	TLNE	AC13,100	;SKIP IF NOT A DTA
	HRRM	AC1,D.CBN(I16)	;SAVE AS THE FIRST BLOCK NUMBER
	TRZ	AC1,-1		;THEN ZERO IT
	ROTC	AC0,14		;
	MOVEM	AC0,STDLB.+1	;
	HLLM	AC1,STDLB.+2	;
	HRLI	AC1,(SIXBIT /HDR/) ;LABEL TYPE
	IORI	AC1,(SIXBIT /1/)
	MOVEM	AC1,STDLB.	;
	LDB	AC4,[POINT 12,ULBLK.+2,35]	;GET LOW ORDER CREA DATE
	LDB	AC1,[POINT 3,ULBLK.+1,20]	;GET HIGH ORDER		[EDIT#274]
	DPB	AC1,[POINT 3,AC4,23]		;MERGE THE ORDERS	[EDIT#274]
	PUSHJ	PP,TODA1.	;CREATION DATE
	SETZ	AC1,		;
	ROTC	AC0,6		;
	MOVEM	AC0,STDLB.+7	;DATE
	MOVEM	AC1,STDLB.+6	;DATE
	PUSHJ	PP,OPNCA1	;MOVE STD-LABEL AREA TO RECORD AREA
	JRST	OPNBBF

	;THIS ROUTINE FINDS THE NUMBER OF THE FIRST SECTOR OF THE LAST
	;LOGICAL BLOCK OF THE  SEQIO FILE
OPNELO:	SKIPE	F.WSMU(I16)		; IF SMU-ING
	POPJ	PP,			; WE'VE ALREADY BEEN HERE
OPNEL1:	HRRZ	AC5,F.RPPN(I16)		; GET POINTER TO PPN
	SKIPE	AC5			; USE DEFAULT PPN IF NONE
	MOVE	AC5,(AC5)		; GET THE PPN
	MOVEM	AC5,ARGBK.##+.RBPPN	;
	MOVE	AC5,[ULBLK.,,ARGBK.+.RBNAM]; GET FILE NAME
	BLT	AC5,ARGBK.+.RBEXT	; AND EXTENSION
	HLLZS	ARGBK.+.RBEXT		; ZERO DATE FIELD
	SETZM	ARGBK.+.RBPRV		; AND PRIVILIGE FIELD
	SETZM	ARGBK.+.RBSIZ		; AND SIZE FIELD
	MOVE	AC0,ULKUP.		; GET A LOOKUP INST
	HRRI	AC0,ARGBK.		; SETUP E FIELD
	XCT	AC0			; EXTENDED LOOKUP
	 SKIPA	AC5,ARGBK.+.RBEXT	; ERROR SO GET ERROR BITS
	JRST	OPNEL2			; NORMAL RETURN
	HRRM	AC5,ULBLK.+1		; SAVE BITS FOR OPNLER
	JRST	OPNLER			; COMPLAIN

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

	MOVE	AC6,D.BPL(I16)		; GET NUMBER OF FIRST
	ADDI	AC5,-1(AC6)		; SECTOR OF THE LAST
	IDIV	AC5,AC6			; LOGICAL BLOCK
	SKIPN	AC5			; IF FILE DOESN'T EXIST
	MOVEI	AC5,1			; ONE IS THE FIRST BLOCK
	MOVEM	AC5,D.LBN(I16)		; SAVE IT FOR SEQIO
	POPJ	PP,			;
OPNLER:	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!OPNIO ;RANDOM OR IO OUTPUT FILE?
	JRST	OLERR		;NO

	;HERE TO CREATE A NULL FILE FOR USER
	PUSHJ	PP,OPNEID	;SETUP FOR AN ENTER
	XCT	UENTR.		;CREATE A NULL FILE
	 JRST	OEERR		;ERROR RETURN
	XCT	UCLOS.
	JRST	OPNLUP		;OK TRY THE LOOKUP AGAIN

IFE TOPS20,<
	; THIS ROUTINE OPENS A FILE VIA THE "FILOP." UUO
OPNFOP:	MOVE	AC0,UOBLK.	;SET THE DATA MODE
	MOVEM	AC0,FOP.IS
IFN ISAM,<
	TLNN	FLG,IDXFIL	; ISAM FILE?
	JRST	OPNFPD		; NO
	TLO	FLG1,FOPIDX	; ENTRY FOR ".IDX" FILE
	PUSHJ	PP,OPNLIX	; GET VID TO LOOKUP BLOCK
	MOVE	AC0,ICHAN(I12)	; CHANNEL FOR .IDX FILE
	JRST	OPNFP2
OPNFPD:	>;END IFN ISAM
	PUSHJ	PP,OPNLID	; GET VID TO LOOKUP BLOCK
	TLNN	FLG,OPNIO	; IF EXTENDED LOOKUP MUST BE DONE
	JRST	OPNFP1		; NO
	XCT	UOPEN.		; DO IT BEFORE THE FILOP. UUO 
	 JRST	OERRIF		; SO WE DONT GET
	PUSHJ	PP,OPNELO	; ILLEGAL SEQUENCE OF UUO'S ERROR
OPNFP1:	LDB	AC0,DTCN.	; GET CHANNEL NUMBER
OPNFP2:	HRLI	AC0,5		; MULTI ACCESS-UPDATE
	MOVSM	AC0,FOP.BK	; SAVE IN FILOP BLOCK
	MOVE	AC0,UOBLK.+1	; GET DEVICE NAME
	MOVEM	AC0,FOP.DN	;
	MOVEI	AC0,ULBLK.	; GET ADR OF LOOKUP BLOCK
	MOVEM	AC0,FOP.LB	; 
	MOVE	AC1,[7,,FOP.BK]	; SET UP FILOP'S AC
	FILOP.	AC1,		; OPEN THE FILE SIMULTANEOUS-UPDATE
	 POPJ	PP,		; ERROR RETURN
IFN ISAM,<TLZ	FLG1,FOPIDX>	; CLEAR FLAG
	JRST	RET.2		; EXIT


	; FILOP ERROR
OFERR:	SETZM	FS.IF		; IDA-FILE FLAG
IFE ISAM,<TLO	FLG1,FOPERR>	; FILOP. FAILED
IFN ISAM,<
OFERRI:	MOVE	AC0,[E.MFOP+E.FIDX] ;MAKE AN ERROR NUMBER
	TLON	FLG1,FOPIDX	; REMEMBER IT'S A FILOP ERROR
	MOVE	AC0,[E.MFOP+E.FIDA]
	TLNN	FLG,IDXFIL	; ISAM FILE?
>;END IFN ISAM
	MOVE	AC0,[E.MFOP]	; NO
	PUSHJ	PP,ERCDF	; IGNORE ERROR?
	 JRST	RCHAN		; YES
	JRST	LUPERR		; NO
>; END IFE TOPS20
IFN TOPS20,<
	SEARCH MONSYM, MACSYM
	.REQUIRE SYS:MACREL
EXTERN CP.BLK,CP.BK1,CP.BK2,CP.BK3,CP.BK4,CP.BK5,CP.BK6,CP.BK7,FID.PT
	E.MCPT==^D8000000	; MONITOR COMPT. UUO ERROR

;HERE IF THIS IS A DEC-SYSTEM-20 TO OPEN FILE FOR SIMULTANEOUS UPDATING

	;INIT THE CMPT. JSYS ARG BLOCK
OCPT:	TLNN	FLG,IDXFIL		; ISAM FILE?
	JRST	OCPTD			; NO
	PUSHJ	PP,OPNLIX		; YES, GET VID TO LOOKUP BLOCK
	TLOA	FLG1,FOPIDX		; AN IDX FILE
OCPTD:	;ENTRY POINT FOR ISAM.IDA FILES
	PUSHJ	PP,OPNLID		; NO, GET VID...
	SETZM	CP.BK1			; AC1 GTJFN BITS

	;BUILD A SNARK FILE-DESCRIPTOR STRING - AC2 GTJFN BITS
	;FIRST JUST MOVE THE DEVICE NAME
	MOVE	AC5,FID.PT		; GET POINTER TO FILE-DESCRIPTOR
	MOVEM	AC5,CP.BK2		; INIT COMPT. ARG BLOCK
	MOVE	AC0,[POINT 6,UOBLK.+1]	; POINTER TO DEVICE NAME
	MOVEI	AC1,6			; GET MAX OF SIX CHARS
OCPT1:	ILDB	C,AC0			; GET CHAR
	JUMPE	C,OCPT2			; DONE IF NULL
	ADDI	C,40			; CONVERT TO ASCII
	IDPB	C,AC5			; PUT CHAR IN STRING
	SOJG	AC1,OCPT1		; LOOP
OCPT2:	MOVEI	C,":"			; DEVICE TERMINATOR
	IDPB	C,AC5			; TO STRING

	;CONVERT PPN TO <DIRECTORY>
	MOVEI	C,"<"			; ORIGINATE DIRECTORY
	IDPB	C,AC5			;
	HRRZ	AC1,F.RPPN(I16)		; GET ADR OF PPN
	JUMPN	AC1,OCPT3		; JUMP IF YOU GOT ONE
	GJINF				; GET CONNECT DIR # IN AC2
	MOVE	AC1,AC5			; GET THE STRING POINTER
	DIRST				; STICK DIR # INTO STRING
	 POPJ	PP,			; IMPOSSIBLE!
	MOVEM	AC1,AC5			; GET STRING PTR BACK TO AC5
	JRST	OCPT4			;
OCPT3:	MOVE	AC1,(AC1)		; GET PPN FROM ADR
	MOVEM	AC1,CP.BK1		; PPN TO THE ARG-BLOCK
	MOVEM	AC5,CP.BK2		; SUPPLY STRING PTR
	MOVEI	AC0,3			; FUNCTION 3
	MOVEM	AC0,CP.BLK		;
	MOVE	AC0,[3,,CP.BLK]		; SETUP FOR COMPT.
	COMPT.	AC0,			; MOVE DIR # TO STRING
	 POPJ	PP,			;
	MOVE	AC5,CP.BK2		; RESTORE STRING PTR
OCPT4:	MOVEI	C,">"			; TERMINATE DIRECTORY
	IDPB	C,AC5			;

	;SETUP THE CP.BK? ARGUMENT BLOCK FOR COMPT. UUO
	HRLZI	AC0,(1B17)		; SPECIFY THE SHORT FORM OF
	MOVEM	AC0,CP.BK1		;  OPENF. JSYS
	MOVE	AC0,FID.PT		; GET POINTER TO FILE DESCRIPTOR STRING
	MOVEM	AC0,CP.BK2		;  FOR OPENF. ARGUMENT

	;MOVE VALUE OF ID TO F-D STRING
	TLNE	FLG,IDXFIL		; SKIP IF NOT ISAM FILE
	TLNE	FLG1,FOPIDX		; SKIP IF ISAM .IDA FILE
	SKIPA	AC4,F.WVID(I16)		; BYTE-PTR TO VALUE OF ID
	MOVE	AC4,[POINT 6,DFILNM(I12)]; .IDA - SO VALUE-ID IS HERE
	MOVEI	AC0,11			; MAX OF 11 CHARS
OCPT5:	ILDB	C,AC4			; GET A CHAR
	TLNN	AC4,600			; IS VID IN EBCDIC?
	LDB	C,PTR.96##(C)		; YES - CONVERT IT
	TLNN	AC4,100			; HOW BOUT SIXBIT?
	ADDI	C,40			; YES
	CAIE	C," "			; SPACES ARE IGNORED IN FILENAME
	IDPB	C,AC5			; STUFF IT AWAY
	CAIE	AC0,4			; IS IT TIME FOR A "."?
	SOJN	AC0,OCPT5		; NO - LOOP TILL DONE
	JUMPE	AC0,OCPT6		; JUMP IF DONE
	MOVEI	C,"."			; TERMINATE THE FILENAME
	IDPB	C,AC5			;
	SOJN	OCPT5			; BACK FOR THE EXTENSION
OCPT6:	SETZB	C,AC0			; A NULL
	IDPB	C,AC5			; TERMINATE THE STRING

	;INIT AC2 OPENF BITS
	TLNE	FLG,DDMASC		; DEVICE DATA MODE ASCII?
	TLO	AC0,(7B5)		; YES
	TLNE	FLG,DDMSIX		; SIXBIT?
	TLO	AC0,(6B5)		; YES
	TLNE	FLG,DDMBIN		; BINARY?
	TLO	AC0,(44B5)		; YES
	TLNN	FLG,DDMEBC		; EBCDIC?
	JRST	OCPT10			; NO
	TLO	AC0,(10B5)		; ASSUME DEVICE IS A MAG-TAPE
	TLNN	AC13,20			; DEVICE A MTA?
	TLO	AC0,(11B5)		; NO, ITSA DSK

OCPT10:	TLNE	FLG,OPNIO!RANFIL!IDXFIL	; RANDOM, INDEXED OR IO FILES
	TLO	AC0,(17B9)		;  ARE DUMP MODE

	TLNE	FLG,OPNIO!RANFIL!IDXFIL!OPNIN; OPEN FOR INPUT?
	TRO	AC0,1B19		; YES
	TLNE	FLG,OPNOUT		; OPEN FOR OUTPUT?
	TRO	AC0,1B20		; YES

	TRO	AC0,1B25		; THAWED I.E. SIMULTANEOUS UPDATE
	MOVEM	AC0,CP.BK3		; INIT AC2 OPENF BITS
	;INITIALIZE TO TOPS-10 OPEN MODE
	TLNE	FLG,DDMASC		; DATA-MODE ASCII?
	TDZA	AC0,AC0			; YES
	MOVEI	AC0,14			; NOT ASCII
	TLNE	FLG,RANFIL!IDXFIL!OPNIO	; THESE FILES ARE NOT BUFFERED
	MOVEI	AC0,17			; DUMP MODE
	MOVEM	AC0,CP.BK4		; OPEN MODE

	;LOCATE THE BUFFER HEADERS AND EXTENDED LOOKUP BLOCK
	MOVEI	AC0,D.IBH(I16)		;
	MOVEM	AC0,CP.BK5		; INPUT BUFFER HEADER
	MOVEI	AC0,D.OBH(I16)		;
	MOVEM	AC0,CP.BK6		; OUTPUT BUFFER HEADER
	MOVEI	AC0,ARGBK.		;
	MOVEM	AC0,CP.BK7		; ADR OF EXTENDED LOOKUP BLOCK

	;SET UP EXTENDED LOOKUP BLOCK
	HRRZ	AC1,F.RPPN(I16)		; GET ADR OF PPN
	SKIPE	AC1			; USE DEFAULT PPN IF ZERO
	MOVE	AC1,(AC1)		; GET PPN
	MOVEM	AC1,ARGBK.##+.RBPPN	; SETUP PPN
	MOVE	AC1,[ULBLK.,,ARGBK.+.RBNAM]; COPY FILE-NAME.EXT
	BLT	AC1,ARGBK.+.RBEXT	; FROM LOOKUP BLOCK
	HLLZS	ARGBK.+.RBEXT		; CLEAR RIGHT HALF
	SETZM	ARGBK.+.RBPRV		;   AND PRIV
	SETZM	ARGBK.+.RBSIZ		;   AND SIZE

	TLNE	FLG1,FOPIDX		; IF AN ISAM.IDX FILE GET CHAN #
	SKIPA	AC1,ICHAN(I12)		;   FROM HERE
	LDB	AC1,DTCN.		; ELSE FROM HERE
	HRLI	AC1,1			; THE FUNCTION
	MOVSM	AC1,CP.BLK		; ARG ,, FUNCTION
	MOVE	AC1,[10,,CP.BLK]	; COUNT,,ADR FOR ARG-BLOCK
	COMPT.	AC1,			; OPEN FILE FOR SIMULTANEOUS UPDATE
	 POPJ	PP,			; ERROR RETURN
IFN ISAM,<TLZ	FLG1,FOPIDX>		; CLEAR FLAG
	JRST	RET.2			; NORMAL RETURN

OCPER:	SETZM	FS.IF			; CLEAR .IDA FILE FLAG
IFN ISAM,<
OCPERI:	MOVE	AC0,[E.MCPT+E.FIDX]	; MAKE AN ERROR NUMBER
	TLZN	FLG1,FOPIDX		; IDX OR IDA?
	MOVE	AC0,[E.MCPT+E.FIDA]	; IDA!
	TLNN	FLG,IDXFIL		; SKIP IF AN ISAM FILE
>; END IFN ISAM
	MOVE	AC0,[E.MCPT]		;
	PUSHJ	PP,IGCVR		; IGNORE ERROR?
	 JRST	RCHAN			; YES
OCPERR:	TTCALL	3,[ASCIZ /COMPT. UUO FAILED /]
	MOVEI	AC0,.PRIIN		;
	CFIBF				; CLEAR TYPE AHEAD
	MOVEI	AC0,.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.			; FATAL ERROR MESSAGE

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

OPNRLB:	TLNN	AC13,140610	;SKIP IF DEVICE IS - CDR,LPT,TTY,PTR,OR PTP	[RPGLIB EDIT #64]
	TLNN	FLG1,NONSTD+STNDRD ;SKIP IF LABELS ARE PRESENT
	JRST	OPNBBF		;
OPNRL2:	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,OPNIO!RANFIL!IDXFIL ;SKIP IF NOT DUMP MODE
	JRST	OPNBB1		;
	TLNN	FLG,OPNOUT	; SKIP IF OUTPUT			[EDIT#301]
	JRST	OPNBB1		;;NOT OUTPUT,SKIP ENTER		[EDIT#301]
	TLNE	AC13,4		;DIRECTORY DEVICE?	[EDIT#315]
	JRST	OPNBB2		;YES, SKIP ENTER	[EDIT#315]
	PUSHJ	PP,OPNEID	;SET UP ID FOR ENTER 	[EDIT#301]
	XCT	UENTR.		;DO AN ENTER			[EDIT#301]
	 JRST	OEERR		;ERROR RETURN			[EDIT#301]
OPNBB2:	XCT	UOUT.		;DUMMY OUTPUT********************[EDIT#315]
OPNBB1:	MOVEI	AC1,1		;2 WORD CALL,
	PUSHJ	PP,USEPRO	;TO GET THE USE PRO. ADDRESS
	TLNN	AC13,140610	;NO LABELS - NO CHECKS	[RPGLIB EDIT #64]
	TLNN	FLG1,STNDRD	;SKIP IF LABELS ARE STANDARD
	JRST	OPNABF		;AFTER BEG FILE
	TLNE	FLG,OPNIN	;SKIP IF NOT INPUT / IO
	JRST	OPNCSL		;STANDARD LABEL CHECK
	PUSHJ	PP,OPNCAL	;CREATE A LABEL

	;DO AFTER BEGINNING FILE LABEL PROCEDURE
	;AND WRITE OUT THE LABEL.  ***OPNENR***

OPNABF:	MOVEI	AC1,2		;TWO WORD CALL
	PUSHJ	PP,USEPRO	;TO GET USE PRO. ADR.
	TLNN	FLG,OPNOUT	;OUTPUT SKIPS
	JRST	OPNDVC
	TLNE	AC13,4		;SKIP IF NOT DIR. DEV.
	JRST	OPNENR
	TLNN	AC13,140614	;SKIP IF CDR,LPT,TTY,PTR,PTP,OR DTA,DSK.	[RPGLIB EDIT #64]
	TLNN	FLG1,NONSTD+STNDRD ;SKIP IF ANY LABELS
	JRST	OPNDVC		;NO LABELS
	PUSHJ	PP,RECBUF	;MOVE THE LABEL INTO THE BUFFER
	JUMPGE	FLG,OPNAB1	;JUMP IF DEVICE IS NOT ASCII
	PUSHJ	PP,WRTCR	;
	PUSHJ	PP,WRTLF	;
OPNAB1:	PUSHJ	PP,WRTOUT	;WRITE THE LABEL
IFN EBCLBL ,<
	TLNN	FLG,DDMEBC	;EBCDIC?
	JRST	OPNDVC		;NO
	XCT	UCLOS.		;WRITE A TAPE MARK AFTER THE LABELS
	PUSHJ	PP,WRTWAI	;WAIT FOR ERROR CHECKING
	XCT	UOUT.		;DUMMY OUTPUT
>
	JRST	OPNDVC
	;DO AN ENTER AND SAVE THE FLAG REGISTER.  ***EXIT TO THE ACP***

OPNENR:	PUSHJ	PP,OPNEID	;SETUP UEBLK. (DUMP-MODE)
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE?
	JRST	OPNEN1		; YES - SKIP THE ENTER
	XCT	UENTR.		;ENTER - DIRECTORY DEVICE**********
	 JRST	OEERR		;ERROR RETURN
OPNEN1:	TLNN	FLG,RANFIL!OPNIO!IDXFIL ;DUMP MODE HAS NO DUMMY OUTPUTS
	XCT	UOUT.		;DUMMY OUTPUT*****ENTER VOIDS PREVIOUS DUMMY OUTPUTS.
OPNDVC:	MOVE	AC13,UOBLK.+1
	CALLI	AC13,4		;THE FINAL DEVCHR
	TLNN	FLG,OPNIO+OPNIN		;[330]IF NOT INPUT THEN IGNORE
	JRST	OPNDV1			;[330]
	TLC	AC13,300000		;[330]IF A DSK AND A CDR
	TLCN	AC13,300000		;[330]THEN ITS DEVICE 'NUL'
	TLZ	AC13,20			;[330]SO ITS NOT A MAGTAPE
OPNDV1:	MOVEM	AC13,D.DC(I16)		;[330]
	MOVEM	FLG,F.WFLG(I16)	;UPDATE THE FLAGS
	TLNE	AC13,10		;IS THIS A TTY FILE?
	HRRZM	AC16,TTYOPN	;YES, REMEMBER THAT
	TLNE	FLG1,STNDRD!NONSTD	;SKIP IF LABELS ARE OMITTED
	PUSHJ	PP,ZROREC	;CLEAR THE RECORD AREA I.E.LABEL
	TLNN	AC16,SLURP	;RESTORE THE REC-AREA IF A WRITE REEL CHANGE
	POPJ	PP,		;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
	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
	LDB	C,PTR.79##	;		EBCDIC
	MOVS	C,CHTAB(C)	;		SIXBIT

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


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

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

WCASC:	JFCL			; ASCII TO	ASCII
	LDB	C,PTR.79##	;		EBCDIC
	MOVS	C,CHTAB(C)	;		SIXBIT
	;STANDARD LABELS AND INPUT OR IO
	;CHECK THE VALUE OF ID.  ***OPNABF***

OPNCSL:	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	;
IFN EBCLBL ,<
	TLNE	FLG,DDMEBC	;IF EBCDIC
	PUSHJ	PP,OECLT	;  LOOK FOR 'VOL1' IF FIRST FILE
>
	CAMN	AC0,[SIXBIT /HDR1/]	;SKIP INTO ERROR MESSAGE
	JRST	OPNCID		;CHECK VALUE OF ID
	;MISSING OR WRONG LABEL TYPE
	TTCALL	3,[ASCIZ/$ THE BEGINNING FILE LABEL IS MISSING/]
OPNCL1:	PUSHJ	PP,SAVAC.
	MOVE	AC2,[BYTE(5)10,2,31,20,4,14]
	PUSHJ	PP,MSOUT.
	JRST	OPNFW4		;TRY AGAIN

IFN EBCLBL ,<
OECLT:	LDB	AC2,F.BPMT	;GET FILE POSITION
	SOJG	AC2,RET.1	;  AND RETURN IF NOT FIRST FILE ON REEL
	CAME	AC0,[SIXBIT /VOL1/]	;LABEL TYPE MUST BE 'VOL1'
	JRST	OECL1		;  ELSE ERROR MESSAGE
	PUSHJ	PP,READSY	;READ NEXT LABEL, SHLDB 'HDR1'
	 JRST	.+2		;OK
	JRST	OECL2		;ERROR RETURN, MESSAGE & SECOND CHANCE
	PUSHJ	PP,BUFREC	;MOVE LABEL INTO RECORD AREA
	PUSHJ	PP,RECSLB	;  THEN TO LABEL AREA
	MOVE	AC0,STDLB.	;LABEL TYPE TO AC0
	TRZ	AC0,7777	;  AND CLEAR THE GARBAGE
	POPJ	PP,		;TRY FOR 'HDR1'

OECL1:	TTCALL	3,[ASCIZ /LABEL "VOL1" IS MISSING/]
	POP	PP,(PP)		; KEEP THE STACK RIGHT
	JRST	OPNCL1

OECL2:	POP	PP,(PP)		; MAKE THE STACK RIGHT
	JRST	OPNRL2		; ERROR PATH
>
OPNCID:	HRR	AC0,STDLB.	;
	MOVE	AC1,STDLB.+1	;
	HLL	AC0,STDLB.+2	;
	ROTC	AC0,30		;JUSTIFY THE FILENAME
	CAME	AC0,ULBLK.	;CHECK FILE NAMES
	JRST	OPNIDE		;ID ERROR
	HLLZ	AC0,ULBLK.+1	;
	TRZ	AC1,-1		;CLEAR THE LABEL NUMBER
	CAMN	AC0,AC1		;CHECK EXTENSIONS
	JRST	OPNCDW		;CHECK DATE WRITTEN

	;ID ERROR.
OPNIDE:	PUSHJ	PP,SAVAC.	;
	MOVE	AC2,[BYTE (5)10,2,31,20,4,14]
	PUSHJ	PP,MSOUT.	;
	TTCALL	3,[ASCIZ/$ THE VALUE OF ID DOES NOT MATCH THE LABEL ID/]
	JRST	OPNFW4

	;CHECK DATE WRITTEN
OPNCDW:	SKIPN	AC5,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	AC6,AC5		;ONE FROM THE FILE TABLE
	TLNE	AC5,100		;SKIP IF SIXBIT
	SUBI	AC6,40		;MAKE IT SIXBIT
	TLNN	AC5,600		; EBCDIC?
	LDB	AC6,PTR.96##(AC6) ; YES
	CAME	AC6,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.
	TTCALL	3,[ASCIZ /THE FILE TABLE DATE DIFFERS FROM THE FILE LABEL DATE/]
	JRST	KILL

	;CHECK THE REEL NUMBER IF THE DEVICE IS A MAGTAPE
OPNCRN:	TLNN	AC13,20		;MAGTAPE?
	JRST	OPNABF		;NO
	HRL	AC0,STDLB.+4	;THE
	HLR	AC0,STDLB.+5	;  REAL
	ROT	AC0,-14		;  REEL
	ANDI	AC0,7777	;  NUMBER
	LDB	AC1,DTRN.	;AND WHAT IT OUGHT TO BE
	CAMN	AC0,AC1		;SKIP IF UNEQUAL
	JRST	OPNCR1		;MATCH
	LDB	AC2,F.BPMT	;
	JUMPN	AC2,OPNCR1	;JUMP ITSA MULTI-FILE-REEL
	PUSHJ	PP,SAVAC.	;
	TTCALL	3,[ASCIZ /
$/]
	MOVE	AC2,[BYTE(5)10,31,20,2,4,34,14] ;FODC.R#
	PUSHJ	PP,MSOUT.	;
	TTCALL	3,[ASCIZ/ WAS MOUNTED, PLEASE MOUNT /]
	PUSHJ	PP,MSDTRN
	TTCALL	3,[ASCIZ /
THEN/]
	JRST	OPNF04		;TRY AGAIN
OPNCR1:
IFN EBCLBL ,<
	TLNE	FLG,DDMEBC	;IF EBCDIC
	XCT	MADVF.		;  SKIP TO TAPE MARK
>
	JRST	OPNABF
	;CREATE A STANDARD LABEL.  ***@POPJ***

OPNCAL:	PUSHJ	PP,OPNEID	;LOAD FILENM.EXT INTO ENTER BLOCK
	PUSHJ	PP,ZROSLA	;ZERO THE STD LABEL AREA
IFN EBCLBL,<
	LDB	AC0,F.BPMT	;GET FILE POSITION
	TLNE	FLG,DDMEBC	;EBCDIC?
	SOJLE	AC0,[		;MAKE A 'VOL1' LABEL
	MOVE	AC0,[SIXBIT /VOL1/]
	MOVEM	AC0,STDLB.	;'VOL1' TO THE LABEL AREA
	PUSHJ	PP,SLBREC	;MOVE TO RECORD AREA
	PUSHJ	PP,RECBUF	;  THEN TO THE BUFFER
	PUSHJ	PP,WRTOUT	;  AND WRITE IT
	SETZM	STDLB.		;ZERO THE LABEL AREA
	JRST	.+1]		;RETURN
>
	MOVE	AC0,UEBLK.	;FILENAME
	HLLZ	AC1,UEBLK.+1	;EXT
	ROTC	AC0,14		;12 PLACES TO THE LEFT - MARCH.
	TRO	AC1,(SIXBIT /1/);FIRST LABEL
	MOVEM	AC0,STDLB.+1	;FILE
	HLLM	AC1,STDLB.+2	;DESCRIPTOR
	TLNE	AC16,OPEN+CLOSEB
	HRLI	AC1,(SIXBIT /HDR/)	;BEGINNING FILE LABEL
	TLNE	AC16,CLOSEF
	HRLI	AC1,(SIXBIT /EOF/)	;END OF FILE LABEL
	TLNE	AC16,CLOSER
	HRLI	AC1,(SIXBIT /EOV/)	;END OF VOLUME LABEL
	MOVEM	AC1,STDLB.	;
IFN EBCLBL,<
	TLNE	FLG,DDMEBC	;EBCDIC?
	PUSHJ	PP,JULIA0	;JULIAN DATE & SKIP EXIT (YYDDD)
>
	PUSHJ	PP,TODAY.	;GET TODAY'S DATE (YYMMDD)
	SETZ	AC1,		;
	ROTC	AC0,6		;
	MOVEM	AC1,STDLB.+6	;CREATION
	MOVEM	AC0,STDLB.+7	;DATE

OPNCA1:	SETZ	AC2,
	LDB	AC0,F.BPMT	;FILTAB FILE POSITION ON MAGTAPE
	IDIVI	AC0,^D10	;
	ADDM	AC1,AC2		;
	ROT	AC2,6		;
	JUMPN	AC0,.-3		;CONVERTED TO DECIMAL
	ADD	AC2,[20202020]	;SIXBITIZED

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

	SETZ	AC1,		;
	MOVE	AC0,[SIXBIT /PDP10 /]
	MOVEM	AC0,STDLB.+12
	HRLZ	AC0,.JBVER
	ROTC	AC0,14
	ROT	AC1,3
	ROTC	AC0,3
	ROT	AC1,3
	ROTC	AC0,3
	ADDI	AC1,202020
	HRLZM	AC1,STDLB.+13	;PDP10 VER
	JRST	SLBREC		;MOVE STD-LABEL TO RECORD AREA AND EXIT
	;SET MAGTAPE DENSITY & PARITY
	;POSITION MAGTAPE VIA FILE TABLE FILE POSITION.  ***OPNLO***

OPNMTA:	TLNN	FLG,DDMEBC	; RECORDING MODE EBCDIC?
	JRST	OMTA10		; NO
	TLNE	FLG1,NONSTD!STNDRD; LABELS OMITTED?
	JRST	OMTA98		; NO - ERROR
	HRRZ	AC1,F.WDNM(I16)	; GET THE SIXBIT
	MOVE	AC1,(AC1)	; DEVICE NAME AND
	MTCHR.	AC1,		; GET CHARACTERISTICS
	 SETZ	AC1,		; ERROR RET - ASSUME 9TRK
	TRNE	AC1,1B31	; 9 TRACKS?
	JRST	OMTA10		; NO - 7 TRK
	HRLZI	AC3,3		; LENGTH ,, ADDR
	MOVEI	AC0,.TFMOD	; FUNCTION
	MOVE	AC1,UOBLK.+1	; DEVICE NAME
	MOVEI	AC2,.TFM8B	; INDUSTRY-COMPATIBLE MODE
	TAPOP.	AC3,		; DOIT
	 JRST	OMTA93		; ERROR - COMPLAIN

	;SET PARITY
OMTA10:	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

	;STANDARD-ASCII OR 1600 BPI WANTED?
OMTA20:	LDB	AC5,F.BDNS	; GET DENSITY
	HRRZ	AC6,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	CAIGE	AC5,4		; SKIP IF 1600 BPI
	TRNE	AC6,SASCII	; DOES HE WANT IT?
	JRST	OMTA21		; YES

	;SET DENSITY
	XCT	UGETS.		;GET STATUS
	DPB	AC5,[POINT 3,AC2,28]
	XCT	USETS.		;SET STATUS
	JRST	OPNPMT		;


	;TU16/43/45/70 REQUIRED - DO WE HAVE ONE?
OMTA21:	HRLZI	AC3,2		; LENGTH ,, ADDR
	MOVEI	AC0,.TFKTP	; FUNCTION
	MOVE	AC1,UOBLK.+1	; DEVICE NAME
	TAPOP.	AC3,		; GET CONTROLER TYPE
	 JRST	OMTA90		; ERROR
	TRNN	AC6,SASCII	; STD-ASCII REQUEST?
	JRST	OMTA22		; NO
	CAIE	AC3,.TX01	; TU70 CONTROLLER?
	CAIN	AC3,.TM02	; OR A TU16 OR TU45?
	JRST	.+2		; YES
	JRST	OMTA91		; ERROR - WRONG TYPE

	;SET STANDARD ASCII MODE
	HRLZI	AC3,3		; LENGTH ,, ADDR
	MOVEI	AC0,.TFMOD	; FUNCTION
	MOVEI	AC2,.TFM7B	; STANDARD ASCII MODE
	TAPOP.	AC3,		; CHANGE MODE
	 JRST	OMTA93		; ERROR - COMPLAIN

	;TU16/43/45/70 CAN ONLY DO 800 OR 1600 BPI
	JUMPE	AC5,OPNPMT	; USE DEFAULT DENSITY
	CAIE	AC5,3		; 800 BPI?
	CAIN	AC5,4		; 1600?
	JRST	OMTA30		; YES SO SET IT
	JRST	OMTA94		; NO COMPLAIN

OMTA22:	CAIE	AC3,.TC10C	; TU43 CONTROLLER?
	CAIN	AC3,.TX01	; TU70?
	JRST	OMTA30		; OK
	CAIE	AC3,.TM02	; TU16/45?
	JRST	OMTA92		; NO COMPLAIN

	;SET DENSITY
OMTA30:	HRLZI	AC3,3		; LENGTH,,ADR
	MOVEI	AC0,.TFSDN	; SET DENSITY FUNCTION
	MOVE	AC1,UOBLK.+1	; DEVICE NAME
	MOVE	AC2,AC5		; REQUESTED DENSITY
	TAPOP.	AC3,		; SET IT
	 JRST	OMTA95		; OOPS

	;NOW GET/CHECK DENSITY
	HRLZI	AC3,2		; LEN,,ADR
	MOVEI	AC0,.TFGDN	; GET DENSITY FUNCTION
	MOVE	AC1,UOBLK.+1	; DEVICE NAME
	TAPOP.	AC3,		; GET DENSITY
	 JRST	OMTA95		; OOPS
	CAME	AC2,AC3		; CHECK IT
	JRST	OMTA95		; ERROR - NOT WHAT 'E ASKED FOR
	JRST	OPNPMT		;

	;HERE IF TAPOP. ERROR RET OR NOT A TU16/45/70 DRIVE
OMTA90:	TRNN	AC6,SASCII	; STD-ASCII MESSAGE?
	JRST	OMTA92		; NO 1600 BPI
OMTA91:	MOVE	AC0,[E.FIDX+^D37]; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	RCHAN		; YES
	TTCALL	3,[ASCIZ / STANDARD ASCII RECORDING MODE REQUIRES A TU16, TU45 OR TU70/]
	JRST	OMTA99		;

	;1600 BPI WANTS A TU16/43/45/70
OMTA92:	MOVE	AC0,[E.FIDX+^D38]; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	RCHAN		; YES
	TTCALL	3,[ASCIZ / DENSITY OF 1600 BPI REQUIRES A TU16, TU43,  TU45 OR TU70/]
	JRST	OMTA99		;

	;TAPOP. FAILED TO SET STANDARD ASCII MODE
OMTA93:	MOVE	AC0,[E.FIDX+^D45]; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	TTCALL	3,[ASCIZ / TAPOP. FAILED - UNABLE TO SET STANDARD-ASCII OR INDUSTRY-COMPATIBLE MODE/]
	JRST	OMTA99

	;TU16/43/45/70 CAN DO ONLY 800/1600 BPI
OMTA94:	MOVE	AC0,[E.FIDX+^D46]; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	TTCALL	3,[ASCIZ " TU16/43/45/70 CAN HAVE DENSITY OF ONLY 800 OR 1600 BPI"]
	JRST	OMTA99

	;TAPOP. FAILED OR "SET" DOESN'T MATCH "GET" DENSITY
OMTA95:	MOVE	AC0,[E.FIDX+^D47]; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE THE ERROR?
	 JRST	RCHAN		; YES
	TTCALL	3,[ASCIZ / CANNOT SET THE REQUESTED DENSITY/]
	JRST	OMTA99

	;FOR NOW EBCDIC FILES MUST HAVE OMITTED LABELS
OMTA98:	TTCALL	3,[ASCIZ /  EBCDIC MTA FILES MUST HAVE OMITTED LABELS /]
OMTA99:	MOVE	AC2,[BYTE (5) 10,31,20,2]
	PUSHJ	PP,MSOUT.	;DOESN'T RETURN

OPNPMT:	MOVEI	AC3,2		; 2 EOF'S PER FILE IF NOT EBCDIC
	TLNE	FLG,DDMEBC	; DEVICE DATA MODE EBCDIC?
	MOVEI	AC3,3		; YES, 3 EOF/FILE.
	TLNN	FLG1,NONSTD!STNDRD ; LABELS OMITTED?
	MOVEI	AC3,1		; YES, 1 EOF/FILE.

	HRLZI	AC5,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:	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,

OPNFND:	ANDCAM	AC5,D.HF(AC10)	;CLEAR THE HUF FLAG
	TLNN	AC16,100	;REWIND REQ?
	JRST	OPNREW		;YES
	LDB	AC10,[POINT 6,6(AC10),17] ;FIGURE OUT WHERE TO GO
	SUB	AC11,AC10	;DIRECTION + MAGNITUDE
	IMUL	AC11,AC3	; SEE HOW MANY EOF'S TO PASS
	JUMPE	AC11,OPNBOF	;GO TO THE BEG OF FILE
	JUMPG	AC11,OPNFWD	;SPACE FORWARD

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

OPNBOF:	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
	JRST	OPNLO		;EXIT FROM OPNPMT

OPNF00:	TLNE	AC16,100	;REWIND REQ ?
	JRST	OPNFW1		;NO
	JRST	OPNREW		;YES

OPNRE1:	TTCALL	3,[ASCIZ /$ UNEXPECTED BOT MARKER/]	;		[EDIT#277]
	SKIPA
OPNFW2:	TTCALL	3,[ASCIZ /$ UNEXPECTED EOT MARKER/]	;		[EDIT#277]
	PUSHJ	PP,SAVAC.
	TTCALL	3,[ASCIZ /$ ENCOUNTERED WHILE POSITIONING /]
	MOVE	AC2,[BYTE (5)10,31,20,14]  ;FILE ON DEVICE.
	PUSHJ	PP,MSOUT.
OPNFW4:	TLNN	AC13,120	;SKIP IF A REEL DEVICE
	JRST	KILL		;
	TTCALL	3,[ASCIZ /
WRONG REEL? /]
OPNF04:	PUSHJ	PP,C.STOP	;TYPE CONTINUE TO RETRY
	PUSHJ	PP,RSTAC.
	HRLZI	AC5,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
IFN ISAM,<
	TLNE	FLG,IDXFIL	;ISAM ?
	SKIPA	AC5,[POINT 6,DFILNM(I12)]
>
	MOVE	AC5,F.WVID(I16)	;BYTE POINTER TO VALUE OF ID
	MOVEI	AC6,11		;ID HAS 11 CHARACTERS MAX
OPNEI1:	ILDB	C,AC5		;PICK UP A CHAR
	TLNN	AC5,600		; IS VID EBCDIC?
	LDB	C,PTR.96##(C)	; YES - CONVERT TO SIXBIT
	TLNE	AC5,1100		;SKIP IF SIXBIT
	SUBI	C,40		;CONVERT FROM ASCII
	IDPB	C,AC10		;STORE IN E BLOCK
	SOJN	AC6,OPNEI1	;LOOP 11
	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
OPNPPN:	LDB	AC5,F.BCVR	;GET COMPILER NUMBER
	CAIGE	AC5,3		;VERSION 3 OR OLDER?
	POPJ	PP,		;NOP
	HRRZ	AC5,F.RPPN(I16)	;ADR OF PROJ,,PROG
	JUMPE	AC5,RET.1	;USE DEFAULT
	MOVE	AC5,(AC5)	;PROJECT,,PROGRAMER
	MOVEM	AC5,ULBLK.+3
	MOVEM	AC5,UEBLK.+3
	POPJ	PP,		;AND RETURN

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

USEPRO:	JUMPE	AC1,USEPR0	;JUMP IF ERROR USEPRO
	TLNN	FLG1,NONSTD!STNDRD
	POPJ	PP,		;EXIT, THERE ARE NO LABELS
USEPR0:	PUSHJ	PP,SAVAC.	;SAVE THE ACS
	PUSHJ	PP,USESUP	;GET USE-PRO ADDRESS INTO AC1 AND AC2
	TLNE	AC16,CLOSEB+CLOSER ;SKIP IF NOT A REEL PRO
	JRST	USEPR1		;
	LDB	AC0,F.BPMT	;FILE POSITION ON MTA
	JUMPN	AC0,USEPR2	;JUMP IF MULTI FILE REEL
	TLNE	AC16,CLOSEF	;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
	TLNN	AC16,CLOSEB+CLOSER ;EXIT IF A REEL PRO
	SKIPN	-1(PP)		;OR AN ERROR PRO
	JRST	RSTAC1		;EXIT
	PUSHJ	PP,USESUP	;SETUP
	TLNN	AC16,CLOSEF	;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

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
	TLNE	FLG,OPNIN	;SKIP IF NOT INPUT
	ADDI	AC1,5		;INPUT/OUTPUT USE PRO
	ADDI	AC1,5		;OUTPUT USE PRO
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
	TRNN	AC1,-1		;SKIP IF THERE IS A GENERAL USEPRO
	HRRZ	AC1,AC2		;GET SPECIFIC FILTAB USEPRO
	JUMPN	AC1,USEXC1	;GO PERFORM USEPRO
	JUMPN	AC3,USEXC2	;IF NO LABEL USEPRO RETURN
	AOSA	-20(PP)		;IF NO ERROR USEPRO SKIP-EXIT
USEXC1:	PUSHJ	PP,(AC1)	;XCT THE USEPRO
USEXC2:	POPJ	PP,		;
	;RECSLB.. MOVE RECORD AREA TO SIXBIT STD-LABEL AREA
	;SLBREC.. MOVE SIXBIT STD-LABEL AREA TO RECORD AREA.   ***POPJ***

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

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

BUFREC:	PUSHJ	PP,BUFRE0	;SETUP
	MOVE	AC10,D.RCNV(I16)	;SETUP AC10
BUFRE1:	SOSGE	D.IBC(I16)		;
	PUSHJ	PP,READSY	;FILL THE BUFFER
	 JRST	BUFR01		;NORMAL RETURN
	JRST	CLSRL0		;EOF - COMPLAIN
BUFR01:	ILDB	C,D.IBB(I16)	;PICK UP A LABEL CHAR
	XCT	AC10		;CONVERT IF NECESSARY
	IDPB	C,AC3		;TO THE RECORD AREA
	SOJG	AC0,BUFRE1	;LOOP TILL LABEL IS IN THE RECORD AREA
	SETZM	D.IBC(I16)		;THE BUFFER IS EMPTY
	POPJ	PP,
	;WRITE OUT THE LABEL.   ***POPJ***

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

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

	;ZERO THE STANDARD LABEL AREA.   ***POPJ***

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

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

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

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

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

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

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

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

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

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

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

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

	;RETURN A FREE CHANNEL NUMBER IN AC5

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

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


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

INCRN.:	LDB	AC2,DTRN.	;SIXBIT ADD ONE TO CURRENT REEL NUMBER
	MOVE	AC0,AC2		;SO THE REEL NUMBER MAY BE RESTORED
	TRNE	AC2,10
	TRNN	AC2,1		;SKIP IF INC. WILL CAUSE A CARRY OUT
	AOJA	AC2,INCRN1	;INCREMENT THE REEL NUMBER
	TRNE	AC2,1000
	TRNN	AC2,100
	SKIPA			;[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.
	TTCALL	3,[ASCIZ /99 IS THE MAXIMUM ACCEPTABLE REEL NUMBER/]
	JRST	KILL

	;OPEN FAILED - GIVE FATAL MESSAGE OR IGNORE IT
OERRDF:	MOVE	AC0,[E.MOPE+E.FIDA];ERROR NUMBER
	SETZM	FS.IF		;IDA FILE
	JRST	OERRI1		;

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

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

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

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

	;ENTER FAILED
OEERR:	SETZM	FS.IF		;IDA FILE
	MOVE	AC0,[E.MENT+E.FIDA];ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVE	AC0,[E.MENT]	;NO, ERROR NUMBER
OEERR1:	PUSHJ	PP,ERCDE	;IGNORE?
	 JRST	RCHAN		;YES
	JRST	ENRERR		;GIVE ERROR MESSAGE

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

	;LOOKUP FAILED
OLERR:	SETZM	FS.IF		;IDA FILE
	MOVE	AC0,[E.MLOO+E.FIDA];ERROR NUMBER
	TLNN	FLG,IDXFIL	;IDX FILE?
	MOVE	AC0,[E.MLOO]	;NO, ERROR NUMBER
OLERR1:	PUSHJ	PP,ERCDL	;IGNORE?
	 JRST	RCHAN		;YES
	JRST	LUPERR		;GIVE ERROR MESSAGE

	;GET THE LOOKUP/ENTER/RENAME/FILOP ERROR CODE INTO AC0
ERCDL:	SKIPA	AC1,ULBLK.+1	;GET ERROR CODE FROM LOOKUP BLOCK
ERCDE:	MOVE	AC1,UEBLK.+1	;  OR ENTER BLOCK
ERCDF:	ANDI	AC1,37		;GET ONLY THE ERROR BITS
	CAIL	AC1,10		;DON'T CONVERT TO
	ADDI	AC0,2		;  DECIMAL
	CAIL	AC1,20		;  GET RID
	ADDI	AC0,2		;  OF 8, 9
	CAIL	AC1,30		;  18, 19
	ADDI	AC0,2		;  28 AND 29
	ADD	AC0,AC1		;ADD IN THE ERROR CODE
	CAIE	AC1,6		;HARDWARE ERROR?
	JRST	IGCVR		;NO
	MOVEI	AC1,^D30	;YES
	MOVEM	AC1,FS.FS	;LOAD FILE-STATUS
	JRST	IGCVR		;FINISH UP

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

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

	;CALL VIA JRST
	;AC0 HAS ERROR NUMBER FOR IGCV - AC2 HAS ERROR MESSAGE FOR MSOUT.
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
SUBTTL	WRITE OUT THE BUFFER

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

WRTOUT:	AOS	D.OE(I16)	;BUMP OUTPUT COUNT
	XCT	UOUT.		;DO THE OUTPUT
	POPJ	PP,		;NORMAL RETURN

WRTWAI:;**SAVE ACS**	PUSHJ	PP,SETCN.	; SETUP THE CHANNEL FIELD
	XCT	UWAIT.		;FOR ALL THE ERRORS
	XCT	UGETS.		;
	TRNE	AC2,740000	;ERRORS?
	JRST	WRTERR		;THERE ARE ERRORS.
WRTFIN:	MOVE	AC13,D.DC(I16)	; GET DEVICE CHARACTERISTICS
	TLNE	AC13,20		;MTA?
	TRNN	AC2,2000	;EOT?
	JRST	WRTXIT		;NOT A MAGTAPE EOT
	TLNE	AC16,READ+CLOSEF+CLOSER	;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
	TLO	AC16,MTAEOT	;EOT FLAG
	JRST	WRTXIT		;

WRTMFR:	MOVE	AC0,[E.MOUT]	;OUTPUT ERROR
	PUSHJ	PP,IGMDR	;IGNORE ERROR?
	 JRST	WRTXIT		;YES
	TTCALL	3,[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"
WRTRS1:	AOS	(PP)		;SKIP EXIT VIA WRITE EXIT

WRTXIT:	XCT	UGETS.		;GET STATUS
	TLNE	AC13,20		;MAGTAPE?
	TRZA	AC2,762000	;MAGTAPE.
	TRZ	AC2,760000	;OTHER.
	XCT	USETS.		;SET STATUS
	POPJ	PP,		;RETURN

WRTERR:	TLNE	AC13,20		;MTA?
	TRNN	AC2,400000	;WRITE-LOCKED?
	JRST	WRTER1		;NO
	PUSHJ	PP,SAVAC.	;IT'S A WRITE-LOCKED MAGTAPE
	TTCALL	3,[ASCIZ /$ /]
	MOVE	AC2,[BYTE(5)22,27,10,31,20,4,14]
	PUSHJ	PP,MSOUT.	;"CANNOT DO OUTPUT TO <DEVICE><FILE>
	TTCALL	3,[ASCIZ/IS THE DEVICE WRITE ENABLED?/]
	PUSHJ	PP,C.STOP	;"TYPE CONTINUE TO PROCEDE"
	PUSHJ	PP,RSTAC.	;RESTORE THE ACS
	TRZ	AC2,760000	;TURN OFF THE ERROR BITS
	XCT	USETS.		;SET STATUS
	JRST	WRTOUT		;TRY 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:	PUSHJ	PP,ERCODE	;OUTPUT ERROR STATUS
	TRNE	AC2,400000
	TTCALL	3,[ASCIZ/ IMPROPER MODE/]
	TRNE	AC2,200000
	TTCALL	3,[ASCIZ/ DEVICE ERROR/]
	TRNE	AC2,100000
	TTCALL	3,[ASCIZ/ DATA ERROR/]
	TRNN	AC2,40000
	POPJ	PP,
	TLNE	AC13,200000	;DSK?
	TTCALL	3,[ASCIZ / QUOTA EXCEEDED, FILE STRUCTURE OR RIB FULL/]
	TLNE	AC13,100	;DTA?
	TTCALL	3,[ASCIZ / BLOCK NUMBER TOO LARGE OR DEC-TAPE IS FULL/]
	TLNN	AC13,200100	;ONLY ONE MESSAGE
	TTCALL	3,[ASCIZ/ BLOCK TOO LARGE/]
	POPJ	PP,

	;OUTPUT CONTENTS OF AC2 BITS 18-35 (ERROR STATUS)
ERCODE:	MOVEI C,"("		;
	TTCALL	1,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
	TTCALL	1,C		;OUTPUT IT
	SOJG	AC1,ERCOD1	;LOOP
	MOVEI	C,")"		;
	TTCALL	1,C		;OUTPUT )
	POPJ	PP,
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:	;**BOMB**	PUSHJ	PP,SETCN.	; SETUP THE CHANNEL FIELD
	XCT	UGETS.		; GET THE STATUS
	MOVE	AC13,D.DC(I16)	; AND DEVICE CHARACTERISTICS
	TLNN	AC13,20		; MTA ?
	JRST	READC1		; NO
	TRNE	AC2,2000	;SKIP IF NOT AN "EOT"
	TLO	AC16,MTAEOT	;"EOT" FLAG FOR READEF+N
READC1:	TRNN	AC2,760000	;SKIP IF ANY ERRORS IN THE CURRENT BUFFER
	JRST	WRTXIT		;CLEAR THE ERRORS AND POPJ

	TRNN	AC2,20000	;SKIP IF AN EOF
	JRST	REAERR		;REAL ERRORS!
	TLNN	AC16,OPEN+CLOSEB+CLOSER+CLOSEF	;SKIP IF OPEN OR CLOSE
	JRST	WRTRSX		;JUMP, IT'S READ OR WRITE "EOF"
	JRST	WRTRS1		;EXIT BUT DONT SET ATEND

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

	;READ IN SYNCHRONOUS MODE
READSY:	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
SUBTTL	TODAY.	8JAN

;CALLED BY PUSHJ PP,TODAY.
;EXIT WITH DATE IN AC0 YYMMDD
;	   TIME IN AC1 HHMMSS

AC0=0				;YYMMDD
AC1=1				;HHMMSS
AC4=4				;TEMP
AC5=AC4+1			;TEMP
AC6=AC5+1			;TEMP
PP=17				;
INTERN	TODAY.,TODA1.,TODA2.

	ENTRY	MCSTIM		;CMCS (LCM) USES THIS ROUTINE
TODAY.:	CALLI	AC4,14		;DATE UUO ((Y-64)*12+(M-1))*31+D-1
TODA1.:	IDIVI	AC4,^D31	;PICK OFF THE DAY
	ADDI	AC5,1		;MAKE IT RIGHT
	PUSHJ	PP,TODA4.	;RETURNS TWO SIXBIT NUMBERS
	DPB	AC5,DAY		;XXXXDD
	IDIVI	AC4,^D12	;PICK OFF THE MONTH
	ADDI	AC5,1		;MAKE IT RIGHT
	PUSHJ	PP,TODA4.	;RETURNS TWO SIXBIT NUMBERS
	DPB	AC5,MONTH	;XXMMDD
	MOVEI	AC5,^D64	;GET THE BASE YEAR
	ADD	AC5,AC4		;PLUS YEARS SINCE THEN
	CAIL	AC5,^D100	;CK FOR YEAR 2000+			[EDIT#274]
	SUBI	AC5,^D100	;IF SO, CONVERT TO 00+			[EDIT#274]
	PUSHJ	PP,TODA4.	;SIXBIT
	DPB	AC5,YEAR	;YYMMDD-DATE FINISHED

	CALLI	AC4,23		;TIME UUO GETS TIME IN MILLISECONDS
	IDIVI	AC4,^D1000	;CONVERT TO SECONDS
MCSTIM:	PUSHJ	PP,TODA3.	;PICK OFF SECONDS IN SIXBIT
	DPB	AC5,SECOND	;XXXXSS
TODA2.:	PUSHJ	PP,TODA3.	;PICK OFF MINUTES IN SIXBIT
	DPB	AC5,MINUTE	;XXMMSS
	MOVE	AC5,AC4		;WHAT'S LEFT IS HOURS
	PUSHJ	PP,TODA4.	;TO SIXBIT
	DPB	AC5,HOUR	;HHMMSS-TIME FINISHED
	POPJ	PP,		;RETURN

TODA3.:	IDIVI	AC4,^D60	;DIVIDE BY 60 FOR TIME
TODA4.:	IDIVI	AC5,^D10	;DIVIDE OUT A DECIMAL NUMBER
	LSH	AC5,6		;MAKE ROOM FOR THE REMIANDER
	ADDI	AC5,2020(AC6)	;CONVERT TO SIXBIT
	POPJ	PP,		;RETURN

YEAR:	POINT	12,AC0,11
MONTH:	POINT	12,AC0,23
DAY:	POINT	12,AC0,35
HOUR:	POINT	12,AC1,11
MINUTE:	POINT	12,AC1,23
SECOND:	POINT	12,AC1,35
IFN EBCLBL,<
;PUSHJ PP,JULIAN
;RETURNS WITH DATE IN AC0
;AS SIXBIT   YYDDD
JULIA0:	AOS	(PP)		;TAKE A SKIP EXIT

JULIAN:	SETZ	AC0,		;
	CALLI	AC4,14		;GET DATE
	IDIVI	AC4,^D31	;PICK OFF DAY-1
	ADDI	AC5,1		;DAY OF THE MONTH
	MOVE	AC1,AC5		;SAVE THE DAY
	IDIVI	AC4,^D12	;PICK OFF MONTH - 1
	ADDI	AC4,^D64	;GET YEAR IN AC4
	EXCH	AC4,AC5		;SWAP WITH MONTH INDEX
	PUSHJ	PP,TODA4.	;STORE THE SIXBIT YEAR
	DPB	AC5,YEAR	;  IN AC0
	ADD	AC1,DAYTAB(AC4)	;ADD PREVIOUS DAYS TO DAY OF MONTH
	CAIG	AC4,2		;PAST FEBRUARY?
	JRST	JULIA1		;YES
	IDIVI	AC4,4		;CHECK FOR LEAP YEAR
	CAIG	AC5,0		;LEAP YEAR?
	ADDI	AC1,1		;YES
JULIA1:	MOVE	AC4,AC1		;
	IDIVI	AC4,^D10	;DIVIDE OUT THE
	MOVE	AC1,AC5		;  UINTS AND
	IDIVI	AC4,^D10	;  THE TENS
	LSH	AC4,6		;SHIFT OVER THE HUNDREDS
	ADD	AC5,AC4		;ADD IN THE TENS
	LSH	AC5,6		;MAKE ROOM FOR THE UNITS
	ADDI	AC5,202020(AC1)	;ADDEM IN AND SIXBITIZE
	LSH	AC5,6		;GET THEM NEXT TO THE YEAR POSITION
	ADD	AC0,AC5		;   YYDDD
	POPJ	PP,

DAYTAB:	EXP	^D0	;JAN
	EXP	^D31	;FEB
	EXP	^D59	;MAR
	EXP	^D90	;APR
	EXP	^D120	;MAY
	EXP	^D151	;JUN
	EXP	^D181	;JUL
	EXP	^D212	;AUG
	EXP	^D243	;SEP
	EXP	^D273	;OCT
	EXP	^D304	;NOV
	EXP	^D334	;DEC
>
SUBTTL	ERROR MESSAGES	5-JAN-70

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

MSOUT.:	PUSHJ	PP,DSPL1.		;OUTPUT BUFFER AND "CRLF"
	MOVE	AC0,[POINT 5,AC2]	;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	.JBAPR			;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
	TLNE	AC4,20			; [407] IF SPOOLED FORGET IT
	JRST	MSDEVA
	TTCALL	3,[ASCIZ/ LOGICAL DEVICE /]	; [407]
	MOVE	AC3,(AC1)			; [407] LOGICAL DEVICE
	PUSHJ	PP,MSDEV1		; [407] TYPE IT
	TTCALL 3,[ASCIZ/; PHYSICAL DEVICE /]	 ; [407]
	MOVE	AC3,AC6		; [407] PHYSICAL DEVICE
	JRST	MSDEV1			; [407] TYPE AND RETURN
MSDEVA:
	TTCALL	3,[ASCIZ/ DEVICE /]
	MOVE	AC3,(AC1)		;DEVICE NAME
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
	TTCALL	3,[ASCIZ / FILE /]
	MOVE	AC1,[POINT 6,(I16)]	;POINT AT A FILE NAME
	PUSHJ	PP,MSFIL2		;OUTPUT FILE NAME

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

;MSSLR1+3 [277] IG 22-OCT-73
	;ROUTINE TO PRECEDE MESSAGES TO TTY WITH "$"			[EDIT#277]
$SIGN:	TTCALL	3,[ASCIZ/
$ /]	;								[EDIT#277]
	POPJ	PP,			;				[EDIT#277]

;TYPE OUT A SIGNED DECIMAL NUMBER, REMOVING LEADING ZEROES [371]
PUTDEC:	JUMPGE	AC0,PUTDC1	;IF NEGATIVE, [371] 
	TTCALL	3,[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]
	TTCALL	1,C	; TYPE DIGIT [371]
	POPJ	PP,	; [371]
	;THE FOLLOWING 40 LOC TABLE IS "XCT"ED FROM MSOUT.

MSAGE:	JRST	KILL					;0
	TTCALL	3,[ASCIZ/ SHARES BUFFER AREA WITH /]	;1
	TTCALL	3,[ASCIZ/ CANNOT BE OPENED/]		;2
	TTCALL	3,[ASCIZ/, ALREADY OPEN/]		;3
	TTCALL	3,[ASCIZ/
/]							;4
	TTCALL	3,[ASCIZ/ TOO MANY OPEN FILES/]		;5
	TTCALL	3,[ASCIZ/ IS NOT OPEN/]			;6
	TTCALL	3,[ASCIZ/ FOR INPUT/]			;7
	PUSHJ	PP,MSFIL.	;30 CHARACTER FILENAME	;10
	TTCALL	3,[ASCIZ/ FOR OUTPUT/]			;11
	TTCALL	3,[ASCIZ/ IS AT END/]			;12
	TTCALL	3,[ASCIZ/ IS NOT A DEVICE/]		;13
	POPJ	PP,		;RETURN			;14
	TTCALL	3,[ASCIZ/ IS NOT AVAILABLE TO THIS JOB/];15
	TTCALL	3,[ASCIZ/ IS ASSIGNED TO ANOTHER FILE/]	;16
	TTCALL	3,[ASCIZ . CANNOT DO INPUT/OUTPUT.]	;17
	PUSHJ	PP,MSDEV.	;6 CHARACTER DEVICE NAME;20
	TTCALL	3,[ASCIZ/ CANNOT DO INPUT/]		;21
	TTCALL	3,[ASCIZ/ CANNOT DO OUTPUT/]		;22
	TTCALL	3,[ASCIZ/ OR /]				;23
	PUSHJ	PP,C.STOP				;24
	TTCALL	3,[ASCIZ/INIT TOOK THE ERROR RETURN/]	;25
	TTCALL	3,[ASCIZ/DIRECTORY DEVICES MUST HAVE STANDARD LABELS/]
	TTCALL	3,[ASCIZ/ TO/]				;27
	PUSHJ	PP,MSDTRN	;DEVICE TABLE REEL NUMBER;30
	TTCALL	3,[ASCIZ/ ON/]				;31
	TTCALL	3,[ASCIZ/LABELS MAY NOT BE OMITTED FROM DTA OR DSK FILES/]
	TTCALL	3,[ASCIZ/ BECAUSE IT IS NOT OPEN/]	;33
	PUSHJ	PP,MSSLRN	;STANDARD LABEL REEL NUMBER;34
	TTCALL	3,[ASCIZ/ INPUT ERROR/]			;35
	TTCALL	3,[ASCIZ/ OUTPUT ERROR/]		;36
	TTCALL	3,[ASCIZ/ CANNOT BE CLOSED/]		;37
	;LOOKUP OR ENTER ERROR MESSAGES.   ***KILL OR OPNENR***

LUPERR:	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:	TLNN	AC16,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]
;ENRER2+3 [277] IG 22-OCT-73
	MOVE	AC13,D.ICD(I16)		;DEVICE NAME 			[EDIT#277]
	CALLI	AC13,4			;DEVCHR UUO			[EDIT#277]
	TLNE	AC13,120		;A REEL DEVICE?			[EDIT#277]
	PUSHJ	PP,$SIGN		;YES, OUTPUT "$"		[EDIT#277]
	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 /]
	TTCALL	3,(AC2)			; LOOKUP, ENTER, RENAME OR FILOP
	TTCALL	3,[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:	TTCALL	3,@LEMESS(AC2)		;TYPE A MESSAGE
	SKIPN	(PP)			;KILL IF ENTER
	TLNN	AC13,120		;A REEL DEVICE?
	JRST	KILL			;NO
	JUMPN	AC2,KILL		;KILL IF NOT UNFOUND FILE
	TTCALL	3,[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
IFN ISAM,<
	TLNE	FLG1,EIX		;IF INDEX FOR ISAM FILE
	JRST	OPNI00			;  EXIT HERE
>
	JRST	OPNENR			;TRY AGAIN
	;LOOKUP/ENTER ERROR MESSAGES

LEMESS:	[ASCIZ	/ FILE NOT FOUND/]
	[ASCIZ	/ UFD DOES NOT EXIST/]
	[ASCIZ	/ PROTECTION FAILURE OR DTA DIRECTORY FULL/]
	[ASCIZ	/ FILE BEING MODIFIED/]
	[ASCIZ	/ RENAME FILE ALREADY EXIST/]
	[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	/ GETSEG REQUIRES TWO RELOCATION REGISTERS/]
	[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/]

LELAST:	[ASCIZ / LOOKUP, ENTER OR RENAME ERROR/]
LEMLEN==LELAST-LEMESS
	[ASCIZ / ILLEGAL FILENAME/]
SUBTTL	CLOSE-UUO

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

	;A C.CLOS UUO LOOKS LIKE:
	;001040,,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)
	;CALL+1:	POPJ RETURN

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

C.CLOS:
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.CL	; YES
	>
	MOVE	AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
	BLT	AC0,FS.IF	;   STATUS WORDS.
	SETOM	FS.IF		;IDX FILE
	MOVE	FLG,F.WFLG(I16)	;PICK UP THE FLAGS
	HLLZ	FLG1,D.F1(I16)	;MORE FLAGS
	TLNN	FLG,NOTPRS	;SKIP IF FILE IS NOT PRESENT
	JRST	CLOS01		;  BUT IT IS
	SETZM	PRGFLG		;INCASE IT WAS CLOSE WITH DELETE
	TLZ	FLG,OPNIN!OPNOUT!ATEND!NOTPRS!CONNEC
	MOVEM	FLG,F.WFLG(I16)	;REINIT THE FLGS
	POPJ	PP,		;EXIT

CLOS01:	MOVE	AC0,[E.VCLO+^D20];ERROR NUMBER
	TLNN	FLG,OPNIN+OPNOUT
	SKIPA	AC2,[BYTE(5)10,31,20,37,33]
	SKIPA	AC13,D.DC(I16)	;PICK UP DEVICE CHARACTERISTICS
	JRST	OXITER		;FILE WAS NOT OPEN.
	TLNN	AC13,4		;A DIRECTORY DEVICE?
	SETZM	PRGFLG		;NO - SO WE CAN'T PURGE
	TLNE	AC13,10		;A TTY FILE?
	SETZM	TTYOPN		;YES, NOTE THAT IT'S CLOSED
	LDB	AC5,F.BPMT	;FILE POSITION ON TAPE
	TLNE	AC16,400	;SKIP IF NOT CLOSE REEL
	TLOA	AC16,CLOSER	;% CLOSE REEL
	TLOA	AC16,CLOSEF	;% CLOSE FILE
	JUMPN	AC5,CLOSF5	;CLOSE "REEL" A MULTI-FILE-REEL - AN ERROR

CLOS02:	TLNE	AC16,CLOSER	;
	TLNE	AC13,20		;CLOSE REEL AND NOT  MTA?
	JRST	CLOS00		;NO
	MOVEI	AC0,^D33	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	CLOS00		;YES
	TTCALL	3,[ASCIZ /$ CLOSE REEL IS LEGAL ONLY FOR MAG-TAPE
/]
	MOVE	AC2,[BYTE(5) 10,31,20,37,4,14]
	JRST	MSOUT.		;NON-FATAL CONTINUE WITH A POPJ

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

CLOSE1:	TLNE	FLG,OPNOUT	;SKIP IF NOT AN OUTPUT FILE
	SKIPG	AC5,D.BCL(I16)	;SKIP IF BUFFER/BLOCK IS NOT 0
	JRST	CLOSE3		;
	TLNE	FLG,DDMBIN	;IF BINARY MODE,
	JRST	CLOSE3		;  WE DON'T PAD

	CAME	AC5,D.BPL(I16)	;SKIP IF = BUF/LOGBLK
	JRST	CLOSE2		;PAD THE LOGICAL BLOCK
	HRRZ	AC1,D.OBH(I16)	;ADR OF CURRENT BUF+1
	HRRZ	AC3,D.OBB(I16)	;ADR OF BYTE PTR
	SKIPL	D.OBB(I16)	;440S00,,LOC MEANS BUF EMPTY
	CAIN	AC1,-1(AC3)	;SKIP IF DATA IN BUFFER
	JRST	CLOSE3		;
CLOSE2:	SKIPE	D.OBC(I16)	; SKIP IF BUFFER IS FULL
	IBP	D.OBB(I16)	;FAKE OUT DSKSER
	PUSHJ	PP,WRTBUF	;PAD THE LOGBLK
	SOJG	AC5,.-2		;LOOP TILL LOGBLK IS FULL
	;READ A LABEL, DO BEFORE ENDING FILE/REEL USE PROCEEDURE,
	;AND CHECK FOR "EOF/V" LABEL TYPE.

CLOSE3:	TLNN	FLG,OPNOUT!ATEND
	JRST	CLOSE8		;SKIP LABEL PROCESSING, READ AND NOT ATEND
	TLNE	FLG,OPNIN	;IF INPUT,
	PUSHJ	PP,CLSRL	;READ A LABEL
	LDB	AC5,F.BPMT	;[341]SEE IF FILE POSITIONED
	JUMPN	AC5,CLOSE4	;[341]IF THERE IS, SKIP NEXT
	TLNN	FLG,OPNIN	;[341]OPEN FOR INPUT?
	JRST	CLOSE4		;[341]NO
	TLNE	FLG1,NONSTD!STNDRD	;[341] IF LABELLED
	XCT	MADVF.		;[341]SKIP OVER EOF AFTER LABEL REC.
CLOSE4:	MOVEI	AC1,3		;
	PUSHJ	PP,USEPRO	;BEFORE ENDING FILE/REEL
	TLNN	FLG,OPNIN	;SKIP IF INPUT
	JRST	CLOSE6		;JUMP IF OUTPUT
	TLNE	FLG1,STNDRD	;SKIP IF NOT STD LABELS
	TLNN	AC16,CLOSER	;SKIP IF CLOSE REEL
	JRST	CLOSE7		;
	PUSHJ	PP,CLSEOV	;CHECK FOR EOV
	 JRST	CLOSE7		;
	TTCALL	3,[ASCIZ /STANDARD END-OF-REEL LABELS MUST HAVE "EOV" AS THE FIRST THREE CHARACTERS/]
	MOVE	AC2,[BYTE (5)10,31,20,37]
	JRST	MSOUT.		;TYPE IT OUT

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

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

CLOSE8:	TLNE	AC16,400	;SKIP IF CLOSE FILE
	JRST	CLOSR1		;CLOSE REEL
	TLNN	AC16,200	;LOCK THE FILE?
	JRST	CLOSF1		;NO
	HRLZI	AC0,LOCK	;SET THE LOCK FLAG
	ORM	AC0,D.LF(I16)	;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:	TLNE	AC16,100	;REWIND REQUEST?
	JRST	CLOSF3		;NO
	PUSHJ	PP,OPNRWD	;REWIND UUO
CLOSF2:	HRLZI	AC0,HUF		;"HUF" FLAG
	ANDCAM	AC0,D.HF(I16)	;CLEAR IT
	JRST	CLOSF4		;

CLOSF3:	LDB	AC5,F.BPMT	;GET FILE POSITION
	JUMPE	AC5,CLOSF4	;DONT POSITION IF NONE IS SPECIFIED
	TLNN	FLG,OPNOUT	;OPEN FOR OUTPUT?
	JRST	CLOSF9		;NO
	TLNE	FLG1,NONSTD!STNDRD  ;LABELED FILE?
	XCT	MBSPF.		;YES, BACK INTO THE LABEL
CLOSF9:	TLNE	FLG,OPNOUT!ATEND  ;SKIP IF INPUT AND NOT "AT-END"
	XCT	MBSPF.		;BACK SPACE INTO THE FILE
	TLNE	FLG,OPNOUT!ATEND;[336]IF OUTPUT OR AT END
	JRST	CLOSF4		;[336]WE ARE DONE
	SKIPL	D.IBH(I16)	;[336]IF HAVE DONE ANY READS
	XCT	MBSPR.		;[336]BACKSPACE 1 RECORD
CLOSF4:					;[336]
	IFN ISAM,<
	TLNN	FLG,IDXFIL	;INDEX FILE?
	JRST	CLOSF7		;NO
	PUSHJ	PP,CLSIDX	;YES, CLOSE & RELEAS THE INDEX-FILE
	PUSHJ	PP,FRECH1	;MAKE CHAN AVAILABLE
	MOVE	AC1,CORE0(I12)	;UNTIL,,FROM
	SETZM	(AC1)		;ZERO FIRST WORD
	HLRZ	AC2,AC1		;UNTIL
	HRL	AC1,AC1		;FROM,,FROM
	ADDI	AC1,1		;FROM,,TO
	BLT	AC1,(AC2)	;ZERO
CLOSF7:>
	SKIPN	PRGFLG		;PURGE?
	JRST	CLOSF8		;NO
	TLNN	FLG,OPNIN!RANFIL!IDXFIL	;SUPERSEDING?
	JRST	CLOS75		;COULD BE - GO SEE
CLOS71:	PUSHJ	PP,OPNEID	;
	SETZM	UEBLK.		;ZERO THE FILE-NAME
	XCT	URNAM.		;DELET IT *******************
	 PUSHJ	PP,ORERRI	;ERROR RET
CLOS72:	SETZM	PRGFLG		;CLEAR THE FLG
CLOSF8:	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
	XCT	URELE.		;RELEASE THE DEVICE**************
	JRST	FRECHN		;EXIT TO THE ***"ACP"***

CLOSF5:	MOVE	AC0,[E.FIDX+^D21];ERROR NUMBER
	TLNN	FLG,IDXFIL	;SKIP IF AN ISAM FILE
	MOVEI	AC0,^D21	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	CLOS02		;CONTINUE
	MOVE	AC2,[BYTE(5)10,31,20,37,14]
	PUSHJ	PP,MSOUT.
	TTCALL	3,[ASCIZ/
THE CLOSE "REEL" OPTION MAY NOT BE USED WITH A MULTI-FILE-TAPE./]
	JRST	KILL

CLOS75:	LDB	AC1,DTCN.	;GET THE CHANNEL NUMBER
	TLNE	AC13,4		; DIRECTORY DEVICE ? [373]
	TLNE	AC13,200000	; DSK?  IF NO IT IS DTA DO RENAME [373]
	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:	TLZ	AC16,777675	;CLEAR ALL BUT REWIND&SLURP FLAGS
	TLO	AC16,OPEN!CLOSEB!1000 ;OPEN WITH A REWIND + FLAG THE REEL CHANGE
	TLNN	FLG,RRUNER	;RERUN ON END OF REEL?
	JRST	CLOSR2		;NO
IFE	%%RPG,<
	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!!?
	>	; END OF IFE %%RPG
CLOSR2:	TLZN	AC16,100	;SKIP IF NO REWIND
	XCT	MREWU.		;REWIND AND UNLOAD
	PUSHJ	PP,INCRN.	;INCREMENT THE DEVTAB REEL NUMBER
	PUSHJ	PP,FRECHN	;NOTE THE CHAN IS FREE
	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
	TLNN	FLG,OPNIN	;SKIP IF INPUT
	JRST	CLOSR3		;JUMP IF OUTPUT
	TTCALL	3,[ASCIZ/
$ MOUNT/]
	PUSHJ	PP,MSDTRN	;"REEL N"
	TTCALL	3,[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:	TTCALL	3,[ASCIZ/
$ MOUNT SCRATCH TAPE ON/]
	PUSHJ	PP,MSDEV.	;DEVICE
	PUSHJ	PP,C.STOP	;TYPE CONT TO PRO
CLOSR4:	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,		;
	TLNE	AC13,20		;SKIP IF NOT A MAGTAPE
	TLNN	FLG1,NONSTD+STNDRD ;SKIP IF NOT OMITTED LABELS
	POPJ	PP,		;ZERO THE RECORD AREA
	XCT	UCLOS.		;CLEAR THE EOF
	PUSHJ	PP,READSY	;READ A LABEL
	 JRST	BUFREC		;NORMAL RETURN
CLSRL0:	MOVEI	AC0,^D32	;ERROR NUMBER
	PUSHJ	PP,IGCV		;IGNORE ERROR?
	 JRST	CLSRL2		;NO
	TLNE	AC16,READ	;YES READ UUO?
	POPJ	PP,		;YES, JUST RETURN
	TLNN	AC16,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
	TLO	AC16,100	;REWIND CAUSE WE'RE LOST
	JRST	CLOSE8		;FINISH UP

CLSRL2:	TTCALL	3,[ASCIZ/ READ AN "EOF" INSTEAD OF A LABEL/] ;
	MOVE	AC2,[BYTE(5)30,10,31,20,37]	;CLOSE
	TLNE	AC16,OPEN			;OPEN UUO?
	MOVE	AC2,[BYTE(5) 30,10,31,20,2]	;YES
	TLNE	AC16,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,(SIXBIT /EOV/)
	POPJ	PP,		;OK EXIT
	JRST	RET.2		;ERROR SKIP RET
CLSEO1:	MOVE	C,(FLG)		;FIRST WORD
	TRZ	C,77777		;CLEAR EXTRANEOUS BITS
	CAMN	C,[ASCIZ /EOV/]
	POPJ	PP,		;OK EXIT
	JRST	RET.2		;ERROR SKIP EXIT
IFN ISAM,<
	;CLOSE & RELEASE THE INDEX FILE
CLSIDX:	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
	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
	TRNE	AC2,760000	;SKIP IF ANY ERRORS
	PUSHJ	PP,WIBK2	;CATCH ANY ERRORS NOW
	JRST	CLSID1		;
CLSID2:	PUSHJ	PP,OPNEIX	;
	SETZM	UEBLK.		;ZERO THE FILENAME
	XCT	IRNAM		;DELET
	 JRST	CLSID4		;ERROR RET
CLSID1:	XCT	IRELE		;
	POPJ	PP,

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

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

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

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

CLSWEL:	SKIPN	PRGFLG		;DON'T OUTPUT IF DELETE IS NEXT
	XCT	UCLOS.		;DUMP ALL THE BUFFERS
	PUSHJ	PP,WRTWAI	;WAIT FOR ERROR CHECKING
	TLNE	AC13,20		;SKIP NOT A MAGTAPE
	TLNN	FLG1,NONSTD+STNDRD ;SKIP IF LABELS ARE NOT OMITTED
	POPJ	PP,		;
	XCT	UOUT.		;DUMMY OUTPUT
	PUSHJ	PP,RECBUF	;MOVE RECORD TO THE BUFFER AREA
	PUSHJ	PP,WRTOUT	;OUTPUT IT
	XCT	UCLOS.		;LEOT
	JRST	WRTWAI		;WAIT FOR ERROR CHECKING

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

CLSYNC:	XCT	UGETS.		;SET OR CLEAR
	TRC	AC2,40		;    THE SYNCHRONOUS
	XCT	USETS.		;    MODE STATUS BIT
	POPJ	PP,		;    FOR MAGTAPE

	;ZERO THE UNUSED AREA OF THE DUMP MODE BUFFER

CLSZBF:	TLNN	FLG,DDMEBC	; SKIP IF AN EBCDIC FILE
	JRST	CLSZB2		; JUMP ITS NOT
	HLRZ	AC1,R.BPNR(I12)	; PAD THE LAST RECORD WORD
	CAIN	AC1,441100	; DID REC END ON A WORD BOUNDRY?
	JRST	CLSZB2		; YES
	MOVE	AC1,R.BPNR(I12)	; GET BYTE-PTR
	SETZ	AC2,		; THE PAD CHAR
	JRST	CLSZB1		;
	IDPB	AC2,AC1		;
CLSZB1:	TLNE	AC1,770000	; 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
;	HLRO	AC2,R.IOWD(I12)	;-LEN
;	MOVN	AC2,AC2		;LEN
	HLRZ	AC2,AC1		;LENGTH
	SUBI	AC2,(AC1)	;LENGTH TO CLEAR
	JUMPE	AC2,RET.1	; EXIT IF NOTHING TO ZERO
	HRR	AC1,R.BPNR(I12)	;LOC
	HRL	AC1,AC1		;FROM
	HRRI	AC1,1(AC1)	;TO
	SETZM	-1(AC1)		;THE ZERO
	ADDI	AC2,-1(AC1)	;UNTIL
	CAIL	AC2,(AC1)	;JUST EXIT IF BUFFER IS FULL
	BLT	AC1,(AC2)	;DOIT
	POPJ	PP,
SUBTTL	WRITE-UUO

	;A WRITE. UUO LOOKS LIKE:
	;002140,,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. UUO LOOKS LIKE:
	;002200,,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-17	ADVANCE VIA THIS LPT CHANNEL
	;BIT18-35	NUMBER OF TIMES TO ADVANCE
	;CALL+2:	NORMAL POPJ RETURN

	;SETUP AND INITIAL CHECKS.  ***WRTREC***RANDOM***
WRPW.:	TLO	AC16,WADV	; WRITE ADVANCE VERB
	SETOM	NOCR.		;REPORT-WRITER ENTRY
	JRST	WRITE1		;
WADV.:	TLOA	AC16,WADV	;WRITE ADVANCE
WRITE.:	TLO	AC16,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.
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.WR	; YES
	>
	SKIPGE	NOCR.		;[QAR] IF THIS IS A REPORT WRITER CALL
	JRST	WRITE2		;[QAR] AC15 IS ALREADY SETUP
	HRRZ	AC15,(PP)	;OPERAND OR RETURN ADR	(UOCAL.)
	MOVE	AC15,(AC15)	;
WRITE2:	PUSHJ	PP,WRTSUP	;SETUP
	LDB	AC3,WOPRS.	;RECORD SIZE FROM AC15
	TLNN	FLG,OPNOUT	;SKIP IF OPEN FOR OUTPUT
	JRST	ERROPN		;ERROR MESSAGE
IFN ISAM,<
	TLNE	FLG,IDXFIL	;
	JRST	IWRITE		;WRITE AN INDEX-FILE
>
	TLNE	FLG,RANFIL+OPNIO ;SKIP IF NOT RANDOM OR I/O
	JRST	RANDOM		;RANDOM AND IO EXIT HERE
	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
	TLNE	AC13,20		;MTA?
	HRLM	AC4,(AC1)	;YES - STORE IN THE HEADER WORD
	HRRM	AC3,(AC1)	;MOVE RECSIZE TO THE BUFFER
	AOS	D.OBB(I16)	;SO REC-SIZE IS NOT OVERWRITTEN
	MOVN	AC4,D.BPW(I16)	;MAKE BYTE COUNT
	ADDB	AC4,D.OBC(I16)	; RIGHT
	JUMPN	AC4,WRTREC	;JUMP IF BUFFER IS NOT FULL
	TLNN	FLG,CONNEC	;SKIP IF CONVERSION IS NECESSARY
	SOS	D.OBB(I16)	;BACKUP THE BYTE-POINTER
	PUSHJ	PP,WRTBUF	;ADVANCE BUFFERS
	PUSHJ	PP,WRTABP	;ADJUST BYTE-POINTER

	;MOVE RECORD TO THE BUFFER, OUTPUT IF NECESSARY.
WRTREC:	TLNN	FLG,CONNEC	;SKIP IF CONVERSION IS NECESSARY
	JUMPGE	FLG,WRTRB	;NOT-ASCII, GO BLT RECORD
	MOVE	AC10,D.WCNV(I16)	;SETUP AC10
	TLNE	AC16,WADV	;SKIP IF WRITE.
	PUSHJ	PP,WRTADV	;SEE IF NOW IS THE TIME TO ADVANCE
	JUMPE	AC3,WRTZRE	;TRYING TO WRITE A NULL REC?

WRTRE1:	ILDB	C,AC6		;CHAR FROM THE RECORD AREA
	XCT	AC10		;CONVERT IF NECESSARY
	IDPB	C,D.OBB(I16)	;CHAR TO THE BUFFER
	SOSG	D.OBC(I16)		;SKIP IF YOU CAN
	PUSHJ	PP,WRTBUF	;BUFFER FULL, WRITE IT OUT
	SOJG	AC3,WRTRE1	;LOOP TILL A COMPLETE RECORD IS PASSED
	JUMPGE	FLG,WRTRE4	;JUMP IF NOT ASCII
	SKIPN	NOCR.		;CR WANTED?
	PUSHJ	PP,WRTCR	;YES
WRTRE2:	JUMPL	AC16,WRTRE3	;JUMP IF "WRITE ADVANCING"
	PUSHJ	PP,WRTLF	;WRITE ASCII REC LF
	JRST	WRTRE6		;
WRTRE3:	PUSHJ	PP,WRTADV	;WADV.
	JRST	WRTRE6		;

	;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:	LDB	AC2,F.BBKF	;BLOCKING-FACTOR
	JUMPE	AC2,WRTR10	;DON'T PAD IF BLK-FTR IS ZERO
	TLNN	FLG,OPNIO+RANFIL ;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:	SOSG	D.RRD(I16)	;SKIP IF IT'S NOT RERUN DUMP TIME
	TLNN	FLG,RRUNRC	;SKIP IF WE ARE RERUNNING
	JRST	WRTR15		;
	HRRZ	AC2,F.RRRC(I16)	;RESTORE NUMBER OF RECORDS
	MOVEM	AC2,D.RRD(I16)	;    TO A RERUN DUMP
	JRST	WRTR16		;

WRTR15:	SKIPL	REDMP.		;SKIP IF A FORCED DUMP
	JRST	WRTR11		;NEITHER
WRTR16:
IFE	%%RPG,<
	PUSHJ	PP,RRDMP	;DUMP
	PUSHJ	PP,RSAREN	;RESTORE .JBSA, .JBREN
	>
WRTR11:	TLNN	FLG,RANFIL	;DONT MESS WITH OLD KEY (D.RP) IF RANFIL
	AOS	D.RP(I16)	;BUMP THE RECORD COUNT
	TLNN	AC16,READ	;SKIP IF READ
	AOS	(PP)		;
	TLNN	AC16,MTAEOT	;SKIP IF "EOT"
	POPJ	PP,		;EXIT TO THE ***"ACP"***

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

	;SAVE THE SHARED RECORD-AREA WHILE CHANGING REELS
	HLRZ	AC1,F.LNLS(I16)	;NONSTD LABEL SIZE IN CHARS
	LDB	AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE
	HRRZ	AC2,RBPTBL(AC2)	; GET CHARS PER WORD
	IDIV	AC1,AC2		;CONVERT TO WORDS/LABEL
	SKIPN	AC1+1		;
	SUBI	AC1,1		;ROUND DOWN
	HLLZ	FLG1,D.F1(I16)	;FLAGS
	TLNN	FLG1,NONSTD	;SKIP IF NONSTD LABELS
	MOVEI	AC1,15		;STD LABEL SIZE IN WORDS (-1)
	HRR	AC2,.JBFF	;"TO" ADR
	HRL	AC2,FLG		;"FROM,,TO" ADRS
	MOVE	AC0,AC1		;SETUP AC10 FOR GETSPC
	PUSHJ	PP,GETSPC	;GET SOME SPACE
	 JRST	WCORER		;NO CORE AVAILABLE
	PUSH	PP,AC1		;SAVE LENGTH	POPED @ OPNDV1
	PUSH	PP,AC2		;SAVE "FROM,,TO"
	HRRZ	AC0,HLOVL.	;GET START OF OVERLAY AREA
	CAMGE	AC0,.JBFF	;BLT INTO OVL AREA?
	JUMPN	AC0,WOVLER	;ERROR IF IT DOES
	MOVE	AC1,.JBFF	;"UNTIL"
	BLT	AC2,(AC1)	;SLURP!
WRTR13:	HRLI	AC16,1442	;CLOSE REEL WITH REWIND AND SLURP FLAG SET
	JRST	C.CLOS		;DOIT!
WOVLER:	HRRZM	AC2,.JBFF	;GET JOBFF OUT OF OVL-AREA
	POP	PP,(PP)		;MAKE THE STACK RIGHT SO
	POP	PP,(PP)		;WE CAN RETURN TO CBL-PRG
	JRST	WOVLR2
WOVLR1:	EXCH	AC5,.JBFF	;MOVE JOBFF
	SUBM	AC5,.JBFF	;BACK OUT OF OVL-AREA
WOVLR2:	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	MOVEI	AC0,^D35	;ERROR-NUMBER
	PUSHJ	PP,OXITP	;RETURNS TO CBL-PRG IF IGNORING ERRORS
WOVLRX:	TTCALL	3,[ASCIZ /NOT ENOUGH FREE CORE BETWEEN JOBFF AND OVERLAY AREA/]
WOVLRY:	MOVE	AC2,[BYTE (5)10,31,20,21,4]
	TLNN	AC16,READ	;GET THE RIGHT MESSAGE
	MOVE	AC2,[BYTE (5)10,31,20,22,4]
	TLNE	AC16,OPEN	;OPEN VERB?
	MOVE	AC2,[BYTE (5) 10,31,20,2]
	JRST	MSOUT.		;MESSAGE AND KILL

WCORER:	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	HRRZM	AC2,.JBFF	;BACK OUT OF OVERLAY AREA
	MOVEI	AC0,^D8		;ERROR NUMBER
	PUSHJ	PP,OXITP	;RETURNS FOR FATAL MESS
	PUSHJ	PP,GETSP9	;GIVE MESSAGE
	JRST	WOVLRY		;AND KILL
	;PAD THE LOGICAL BLOCK IF NECESSARY.
WRTR14:	TLNN	AC16,READ	;SKIP IF READ
	JRST	WRTR17		;A WRITE
	PUSHJ	PP,READBF	;INPUT A BUF AND SKIP EXIT
	SETZM	D.IBC(I16)	;REMEMBER THAT IT'S EMPTY
	JRST	WRTR18		;[343]
WRTR17:	TLNN	FLG,DDMBIN	;IF BINNARY LET NXT WRITE/CLOSE OUTPUT IT [343]
	PUSHJ	PP,WRTBUF	;OUTPUT A BUF [343]
WRTR18:	TLZE	FLG,ATEND	;EOF? [343]
	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)	;IF THIS IS THE LAST RECORD	[343]
	CAIN	AC2,1		;  IN THIS LOGICAL BLOCK	[343]
	SETZM	D.OBC(I16)	;  NOTE THAT THE BUFFER IS FULL	[343]
	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)
	TLNN	AC13,20		; 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:	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,WEF1	; LOOP TIL DONE
	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
	JRST	WECH		; AND RETURN

	;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
	PUSHJ	PP,SETCN.	;SET THE IO CHANNEL NUMBER
	LDB	AC3,F.BMRS	;FILE TABLE MAX REC SIZE
	LDB	AC6,[POINT 2,FLG,14]	; GET CORE DATA MODE
	MOVE	AC6,RBPTB1(AC6)	; GET BYTE-POINTER TO RECORD AREA
	HRR	AC6,FLG		; RECORD ADR
	POPJ	PP,		;

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

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

	;SETUP THE CONVERSION INST IN AC10 

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

WRTADV:	TLCE	AC15,20		;WRTADV	OPERAND
	POPJ	PP,		;DON'T ADV THIS TIME
	TLNE	AC15,10		; POSITIONING?
	JRST	WAD1		; YES

	HRRZ	AC4,AC15	; GET CHAR CNT
	TLNE	AC15,40		; IS THIS REALLY AN ADR?
	HRRZ	AC4,(AC15)	; YES - GET COUNT FROM HERE
	JUMPE	AC4,RET.1	; IF CNT = 0 JUST RETURN
	LDB	C,WOPCN		; GET CHANNEL NUMBER
	JRST	WAD2		;

WAD1:	MOVEI	AC4,1		; ASSUME ONE CHAR TO OUTPUT
	HRRZ	C,(AC15)	; GET POSITIONING 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"
	SKIPA	C,[12]		; GET A "LF"

WAD2:	MOVE	C,WADTBL(C)	; GET CHAR FROM TABLE
	TLNE	FLG,RANFIL+OPNIO; SKIP IF NOT A RANDOM FILE
	JRST	WAD3		;
	PUSHJ	PP,WRTCH	;
	SOJG	AC4,.-1		;
	POPJ	PP,		;

WAD3:	IDPB	C,AC5		;AC5 BYTE-PTR. TO RANDOM BUFFER AREA
	SOJG	AC4,.-1		;
	POPJ	PP,		;

	;	CHAR		CHANNEL NUMBER
WADTBL:	EXP	12		;	8
	EXP	14		;	1
	EXP	20		;	2
	EXP	21		;	3
	EXP	22		;	4
	EXP	23		;	5
	EXP	24		;	6
	EXP	13		;	7

WRTLF:	SKIPA	C,[ 12 ]	;"LF"
WRTCR:	MOVEI	C,15		;"CR"
WRTCH:	IDPB	C,D.OBB(I16)	;TO THE BUFFER
	SOSLE	D.OBC(I16)	;SKIP IF FULL
	POPJ	PP,		;OR RETURN
WRTBUF:	PUSHJ	PP,WRTOUT
	SOS	D.BCL(I16)	;BUFFER PER LOGICAL BLOCK
	POPJ	PP,

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

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

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

ERROPN:	AOS	(PP)		;REWRITE-WRITE-DELETE
	MOVEI	AC0,^D22	;THE "OUTPUT" MESSAGE
	CAIA
ERROP1:	MOVEI	AC0,^D34	;THE "INPUT" MESS
	SETOM	FS.IF		;IDX FILE
	TLNE	FLG,IDXFIL	;ISAM FILE?
	ADD	AC0,[E.FIDX]	;YES
	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"
	TLNN	AC16,READ	;SKIP IF ATTEMPT TO READ
	HRLZI	AC2,(BYTE (5)11);"FOR OUTPUT"
	PUSHJ	PP,MSOUT.

ERRMR0:	SKIPA	AC3,AC0		;ISAM FILE
ERRMR1:	MOVE	AC2,AC0		;IO OR RANDOM FILE
	CAIA
ERRMR2:	EXCH	AC3,AC4		;SEQUENTIAL FILE
	PUSH	PP,AC0		;SAVE MAX-REC-SIZE
	MOVEI	AC0,^D6	;THE ERROR NUMBER
	TLNE	FLG,IDXFIL	;ISAM FILE?
	ADD	AC0,[E.FIDA]	;YES
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	ERRMRX		;YES
	TLNE	FLG,IDXFIL!OPNIO!RANFIL ;NO
	JRST	ERRMRS		;SKIP - JUST DESTROYED OLD REC-SIZ
	TRNE	AC3,770000	;TRUBLE IF THESE BITS ARE ON
	TTCALL	3,[ASCIZ/NOT A LEGAL SIXBIT FILE OR INCORRECT BLOCK FACTOR... ASCII?
/]
ERRMRS:	TTCALL	3,[ASCIZ /THE MAXIMUM RECORD SIZE MAY NOT BE EXCEEDED/]
ERRMR:	TLNE	AC16,READ	;SKIP IF OUTPUT FILE
	SKIPA	AC2,[BYTE (5)10,31,20,21,4]
	MOVE	AC2,[BYTE (5)10,31,20,22,4]
	JRST	MSOUT.		;CANNOT DO OUTPUT (OR INPUT)

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

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

READ.:
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.RD	; YES
	>
FAKER.:	TLO	AC16,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
	TLNN	FLG,NOTPRS	;SKIP IF OPTIONAL AND NOT PRESENT
	JRST	READ1		;
	TLOE	FLG,ATEND	;SET "AT END" PATH TAKEN
	JRST	REAAEE		;FATAL THE SECOND TIME
	MOVEM	FLG,F.WFLG(I16)	;SAVE FLG
	JRST	RET.2		;SKIP EXIT
READ1:	TLNN	FLG,OPNIN	;SKIP IF OPEN FOR INPUT
	JRST	ERROP1		;
	TLNE	FLG,ATEND	;SKIP IF NOT "AT END"
	JRST	REAAEE		;"FILENM IS AT END" STOPR.
	MOVE	AC10,D.RCNV(I16);SETUP AC10
IFN ISAM,<
	TLNE	FLG,IDXFIL	;INDEX FILE?
	JRST	IREAD		;YES
>
	TLNE	FLG,RANFIL+OPNIO ;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
	TLNN	AC13,20		;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
	CAMGE	AC3,AC4		;SKIP IF MAX RECORD SIZE IS NOT EXCEEDED
	PUSHJ	PP,ERRMR2	;ERROR MESSAGE
	MOVEM	AC4,RELEN.	;[332]FOR STAND ALONE SORT
	HRRZ	AC3,(AC1)	;MOVE IT INTO AC3
	;ANDI	AC3,7777	;
	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		;OAKAY
	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:	PUSHJ	PP,READCH	;GET CHAR
	TLNE	FLG,ATEND	;SKIP IF NOT "EOF"
	JRST	READEF		;"AT-END" BUT DONT INC REC COUNT
	XCT	AC10		;CONVERT IF NECESSARY
	JUMPL	C,READ4		;JUMP IF EOL CHAR
	MOVE	AC5,AC3		;SAVE ACTUAL RECORD SIZE FOR ZERO FILL
	MOVEM	AC5,RELEN.	;[332]INITIAL RELEASE SIZE

	;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]
	EXCH	AC5,RELEN.	;[332]
READ52:	MOVEI	C,40		;ASCII SPACE
	TLNN	FLG,CDMASC	;
	SETZ	C,		;SIXBIT SPACE
	IDPB	C,AC6		;TRAILING SPACES
	SOJG	AC3,.-1		;FILL OUT THE RECORD WITH SPACES
	JRST	READ8		;
READ51:	LDB	AC3,F.BMRS	;GET MAX RECORD SIZE
	SUB	AC3,AC5		;NUMBER OF ZEROS TO FILL
	JUMPG	AC3,READ52	;DOIT 
	;RECORD IS FULL.  PASS CHAR TILL AN "EOL" CHAR IS ENCOUNTERED.

READ6:	JUMPGE	FLG,READ8	;JUMP SIXBIT HAS NO "EOL"
READ7:	PUSHJ	PP,READCH	;
	XCT	AC10		;CONVERT IF NECESSARY
	TLZN	FLG,ATEND	;
	JUMPGE	C,READ7		;JUMP IF NON-EOL CHAR
READ8:	PUSHJ	PP,WRTRE7	;UPDATE DEVTAB, RERUN DUMP, ETC
	JFCL			;
	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
	MOVEI	AC12,6		;ASSUME DATA RECORD IS SIXBIT
	TLNE	FLG,CDMASC	;IS IT ACTUALLY ASCII?
	MOVEI	AC12,5		;YES--5 BYTES PER WORD
	ADDI	AC11,-1(AC12)	;CONVERT TO
	IDIVI	AC11,(AC12)	;  WORDS AND ROUND UP

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

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

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

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

	;PASS OVER CURRENT LOGICAL BLOCK AND GET NEXT
RER2:	SKIPLE	AC1,D.BCL(I16)	; ANY BUFFERS LEFT FOR THIS LOG-BLOCK?
	PUSHJ	PP,READBF	; PASS OVER THE EMTPY BUFFERS
	SOJG	AC1,.-1		; GET THEM ALL
	MOVE	AC1,D.BPL(I16)	; BUFFERS PER LOG-BLOCK
	MOVEM	AC1,D.BCL(I16)	; BUFFERS PER CURRENT LOG-BLOCK
	PUSHJ	PP,READBF	; NOW GET THE NEXT RECORD
	TLNE	FLG,ATEND	; END-OF-FILE?
	JRST	READEF		; YES
	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
	JUMPGE	FLG1,RER7	; FIXED RECS HAVE NO BDW OR RDW

	;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

	;FILE IS BLOCKED
RER5:	JUMPLE	AC4,RER2	; 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:	CAMLE	AC4,AC3		; WILL IT FIT IN RECORD AREA?
	PUSHJ	PP,ERRMR2	; NO - COMPLAIN

	;MOVE THE RECORD INTO THE RECORD AREA
RER7:	SETZ	AC0,		; ZERO THE NULL CHAR COUNT
;[V10]	MOVE	AC5,D.IBB(I16)	; SET UP AC5
RER71:	SOSL	D.IBC(I16)	; ANY CHARS AVAILABLE?
	JRST	RER74		; YES
	PUSHJ	PP,READBF	; NO - GET ANOTHER BUFFER
	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:
;[V10]	MOVE	AC5,D.IBB(I16)	; GET BYTE-PTR TO AC5
	SOS	D.IBC(I16)	; DECREMENT THE BYTE-COUNT
RER74:
;[V10]	ILDB	C,AC5		; GET CHAR
	ILDB	C,D.IBB(I16)	;[V10] GET CHAR
	JUMPN	C,RER75		; EXIT IF NON-NULL
	ADDI	AC0,1		; COUNT THE NULLS
;[V10]	SOJG	AC4,RER74	; LOOP FOR A RECORD
	SOJG	AC4,RER71	;[V10] LOOP FOR A RECORD

	;GOT A NULL RECORD
	LDB	AC4,F.BMRS	; RESTORE RECORD SIZE
;[V10]	MOVEM	AC5,D.IBB(I16)	; AND BYTE-PTR
	AOS	D.RP(I16)	; COUNT THE RECORD
	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
;[V10]	LDB	C,AC5		; REGET THE LAST CHAR
	LDB	C,D.IBB(I16)	;[V10] 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
;[V10]	MOVE	AC5,D.IBB(I16)	; GET BYTE-PTR TO AC5
	SOS	D.IBC(I16)	; DECREMENT THE BYTE-COUNT
RER81:
;[V10]	ILDB	C,AC5		; GET CHAR
	ILDB	C,D.IBB(I16)	;[V10] GET CHAR.
RER82:	XCT	AC10		; CONVERT
	IDPB	C,AC6		; PUT CHAR
	SOJG	AC4,RER8	; LOOP

;[V10]	MOVEM	AC5,D.IBB(I16)	; SAVE THE BYTE-POINTER
	JRST	WRTR10		; GO HOME

	;GET A CHARACTER
RECH:
;[V10]	SOSGE	D.IBC(I16)	; BUFFER EMPTY?
;[V10]	PUSHJ	PP,READBF	; YES - FILL IT
	SOSL	D.IBC(I16)	; BUFFER EMPTY?
	JRST	RECH1		; NO.
	PUSHJ	PP,READBF	; YES, GO FILL IT
	SOS	D.IBC(I16)	; KEEP THE CHAR COUNT RIGHT.
RECH1:	ILDB	C,D.IBB(I16)	; GET CHAR
	TLNN	FLG,ATEND	; EOF?
	JRST	RET.2		; 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
	SKIPE	C		; IF NON-ZERO
	PUSHJ	PP,RERE6	; ERROR
	PUSHJ	PP,RECH		; SKIP LAST CHAR
	 JUMPN	AC4,RERE0	; COMPLAIN IF EOF AND DATA
	SKIPE	C		; IF NON-ZERO
	PUSHJ	PP,RERE6	; ERROR
	JRST	RET.2		; NORMAL EXIT

	;HERE WHEN BYTE-CNT WAS WRONG, SHLD HAVE BEEN 0
REDWX:	SETZB	AC4,D.IBC(I16)	; ?DW IS 0 AND BUFFER IS EMPTY!
	JRST	RET.2		;

	;HERE IF GOT SOME DATA AND EOF INSTEAD OF ?DW
RERE0:	MOVEI	AC0,^D39	; YES GIVE AN ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 POPJ	PP,		; YES - EOF RETURN
	TTCALL	3,[ASCIZ "GOT AN EOF IN MIDDLE OF BLOCK/RECORD DESCRIPTOR WORD"]
	JRST	ERRMR		; ERROR MESS AND KILL

	;ERROR BDW = 4 OR LESS
RERE1:	MOVEI	AC0,^D40	; GIVE AN ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	RER2		; YES - GET NEXT LOG-BLOCK
	TTCALL	3,[ASCIZ /BLOCK DESCRIPTOR WORD BYTE COUNT IS LESS THAN FIVE/]
	JRST	ERRMR		; ERROR MESSAGE AND KILL

	;ERROR - RDW LE 0 AND WE GOT ANOTHER BUFFER OF WHAT?
RERE2:	MOVEI	AC0,^D41	; GIVE AN ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	READEF		; YES - TAKE END-OF-FILE RETURN
	TTCALL	3,[ASCIZ /ERROR - GOT ANOTHER BUFFER INSTEAD OF "EOF"/]
	JRST	ERRMR		; ERROR MESSAGE AND KILL

	;ERROR - RDW PUTS END OF RECORD BEYOND D.FCPL
RERE3:	MOVEI	AC0,^D42	; GIVE AN ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	RER6		; YES - GIVE HIM "RECORD" ANYHOW
 	TTCALL	3,[ASCIZ /ERROR RECORD EXTENDS BEYOND THE END OF THE LOGICAL BLOCK/]
	JRST	ERRMR		; ERROR MESSAGE AND KILL

	;GOT AN EOF IN MIDDLE OF A RECORD
RERE4:	CAMN	AC3,AC4		; ANY NON-NULL CHARACTERS SEEN?
	JRST	READEF		; NO - GIVE ATEND RETURN
	JRST	REAAE1		; YEP - ERROR

	;BUFFER REC SIZE DIFFERS FROM THE ONE HE'S TRYING TO WRITE
RERE5:	MOVEI	AC1,4(AC3)	; IN CASE HE IGNORES THE ERROR
	MOVEI	AC0,^D43	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 JRST	RNER32		; YEP
	TTCALL	3,[ASCIZ /IT IS ILLEGAL TO CHANGE THE RECORD SIZE OF AN EBCDIC IO RECORD/]
	JRST	ERRMR		;

	;ONE OF THE TWO LOW ORDER B/RDW BYTES IS NON-ZERO (SPANNED RECORDS?)
RERE6:	MOVEI	AC0,^D44	; ERROR NUMBER
	PUSHJ	PP,IGCVR	; IGNORE ERROR?
	 POPJ	PP,		; YES
	TTCALL	3,[ASCIZ "THE TWO LOW ORDER BYTES OF A BLOCK/RECORD WORD MUST BE ZERO"]
	JRST	ERRMR		; NO, COMPLAIN
	;READ AN "EOF".  TAKE "AT-END" PATH.  ***POPJ***

READEF:	MOVEI	AC0,^D10	; READ INVALID KEY
	MOVEM	AC0,FS.FS	; LOAD FILE-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
	TLNE	AC13,20		;SKIP IF  NOT A MTA,ETC.
	TLNN	FLG1,STNDRD	;SKIP IF STANDARD LABELS
	JRST	RET.2		;SKIP EXIT TO THE ***"ACP"***
	PUSHJ	PP,CLSRL	;READ IN THE LABEL
	XCT	MBSPR.		;BACK OVER THE LABEL
	PUSHJ	PP,CLSEOV	;CHECK FOR "EOV"
	JRST	READE1		;OK
	JRST	RET.2		;SKIP EXIT TO ***ACP***
READE1:	HRLI	AC16,440	;CLOSE REEL UUO
	PUSHJ	PP,C.CLOS	;A READ GENERATED CLOSE UUO
	HRLI	AC16,2100	;READ UUO
	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***

READCH:	SOSG	D.IBC(I16)		;DECREMENT THE BYTE COUNT
	PUSHJ	PP,READBF	;INPUT IF YOU MUST
	TLNE	FLG,ATEND	;SKIP IF AT END  ("EOF") ;IS  THIS NECES???
	POPJ	PP,		;
	ILDB	C,D.IBB(I16)	;RETURN WITH A CHAR IN C
	SKIPN	C		;SKIP IF NOT A NULL CHAR
	JUMPL	FLG,READCH	;IGNORE IT IF IT IS A ASCII NULL
	POPJ	PP,		;

READBF:	PUSHJ	PP,READIN	;GET A BUFFER
	JFCL
	SOS	D.BCL(I16)	;DECREMENT BUF/LOGBU
	POPJ	PP,		;
	;BLT BUFFER/S TO THE RECORD AREA

REABR:	HRR	AC5,FLG		;RECORD AREA  I.E. "TO"
	MOVE	AC0,AC3		;SAVE ACTUAL RECORD SIZE
REABR1:	MOVE	AC11,AC3	;SETUP FOR THE "UNTIL"
	SUB	AC3,D.IBC(I16)	;REC-SIZE MINUS BYTE-COUNT
	JUMPGE	AC3,REABR2	;JUMP, USE ALL OF CURRENT BUFFER
	MOVN	AC3,AC11	;SO WE CAN ADJ THE BYTE-COUNT
	JRST	REABR3		;
REABR2:	MOVE	AC11,D.IBC(I16)	;BYTE-COUNT
	SETZM	D.IBC(I16)		;NOTE THE BUFFER IS EMPTY
REABR3:	IDIVI	AC11,6		;CONVERT TO WORDS
	JUMPE	AC12,REABR4	;CHECK THE REMAINDER
	ADDI	AC11,1		;ADJ WRDCNT IF THERE WAS ONE
	SUBI	AC12,6		;NEGATE TRAILING NULL BYTES
REABR4:	SKIPE	D.IBC(I16)		;SKIP IF THE BUFFER IS EMPTY
	ADD	AC12,AC3	;ADD IN THE REC-SIZE
	ADDM	AC12,D.IBC(I16)	;SUBTRACT FROM THE BYTE-COUNT
	HRL	AC5,D.IBB(I16)	;"FROM"
	HRRZ	AC4,AC5		;
	ADDI	AC4,-1(AC11)	;"UNTIL"
	BLT	AC5,(AC4)	;SLURP P P !!
	HRRI	AC5,1(AC4)	;NEW "TO"
	ADDM	AC11,D.IBB(I16)	;RESTORE THE BYTE-POINTER
	SKIPLE	D.IBC(I16)		;READ8 IF YOU CAN
	JRST	REABR5		;EXIT
	JUMPLE	AC3,REABR5	;EXIT IF ALL WAS BLT'ED
	PUSHJ	PP,READBF	;ADVANCE TO NEXT BUFFER
	PUSHJ	PP,REAABP	;ADJ BYTE-PTR
	TLNN	FLG,ATEND	;SKIP IF "EOF" WAS SEEN
	JRST	REABR1		;LOOP
REABR5:	ADDI	AC0,5		;ACTUAL SIZE
	LDB	AC2,F.BMRS	;MAX SIZE
	ADDI	AC2,5		;ROUND UP
	CAMN	AC0,AC2		;IF THE SAME
	JRST	READ8		;  EXIT
	IDIVI	AC0,6		;CONVERT TO
	IDIVI	AC2,6		;  WORDS
	SUB	AC2,AC0		;NUMBER OF WORDS TO ZERO FILL
	JUMPE	AC2,READ8	;EXIT IF NONE
REABR6:	SETZM	1(AC4)
	SOJLE	AC2,READ8
	AOJA	AC4,REABR6

REAAE1:	MOVEI	AC0,^D25	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 POPJ	PP,		;YES
	TTCALL	3,[ASCIZ/ENCOUNTERED AN "EOF" IN THE MIDDLE OF A RECORD/]
	JRST	REAAE0		;AT END ERROR

REAAEE:	SETOM	FS.IF		;IDX FILE
	MOVEI	AC0,^D24	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	RET.2		;YES
	TTCALL	3,[ASCIZ /THE "AT END" PATH HAS BEEN TAKEN/]
REAAE0:	MOVE	AC2,[BYTE (5)10,31,20,21]
	PUSHJ	PP,MSOUT.	;KILL

	;HERE IF RECORD SEQUENCE NUMBER FOUND IN LEFT SIDE OF MTA SIXBIT
	;HEADER-WORD IS NOT EQUAL TO RECORD COUNT IN FILE TABLE
	;NOTE. COUNT STARTS AT ZERO
REALR:	MOVEI	AC0,^D26	;ERROR NUMBER
	PUSHJ	PP,IGCVR	;IGNORE ERROR?
	 JRST	READ31		;YES TRY TO RETURN WHAT YOU GOT
	TTCALL	3,[ASCIZ /RECORD-SEQUENCE-NUMBER /]
	HRLO	AC12,AC4	;RSN
	PUSHJ	PP,PPOUT2	;TYPE IT
	TTCALL	3,[ASCIZ / SHOULD BE /]
	HRLO	AC12,D.RP(I16)	;RECORD COUNT
	PUSHJ	PP,PPOUT2	;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,(JFCL)		;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	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

	;CHECK THE FILE-LIMITS, READ IN THE LOGICAL BLOCK, AND
	;POINT AT THE RECORD.  ***WRTRE7***

RANDOM:	SETZ	AC4,		; 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,FLIMIT	;CHECK ACTUAL KEY VS. FILE LIMITS
	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		;				[EDIT#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,SEQIO	;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		;EOF					[EDIT#273]
	JUMPL	FLG,RANWRT	;JUMP IF ASCII
	TLNE	FLG,DDMBIN	;IF BINARY,
	JRST	RANDO7		;  GO TO SPECIAL ROUTINE
	LDB	AC0,F.BBKF	;HOW MANY RECORDS ARE LEFT
	SUBI	AC0,1(AC2)	;  IN THIS LOGICAL BLOCK.
	MOVEM	AC0,D.RCL(I16)	;SAVE FOR RANSHF
	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? ASCII FILE?
	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
	MOVEM	AC5,R.BPNR(I12)	;SAVE AS CURRENT RECORD

	;HERE TO CHECK THAT NEW RECORD SIZE LE THAN MAX
RANDO2:	HRRZ	AC2,@AC5	;RECORD SIZE IN CHARACTERS
	LDB	AC0,F.BMRS	;MAX RECORD SIZE
	CAMLE	AC2,AC0		;LE THAN MAX?
	PUSHJ	PP,ERRMR1	;NO - GO COMPLAIN
	JUMPN	AC2,RANWR0	;ONWARD IF NOT A ZERO LENGTH RECORD
	TLNN	AC16,READ	;READ?
	JRST	RANWR0		;WRITE!
	MOVE	AC1,F.RACK(I16)	;GET THE
	MOVE	AC1,(AC1)	;  ACTUAL KEY
	TLNE	FLG,RANFIL	;A RANDOM FILE?
	JUMPN	AC1,RANDO3	;YES  -  NEXT RECORD?
	SKIPN	NRSAV.		; IF WE ALREADY HAVE START OF NULL STRING
	SKIPN	AC1,D.LBN(I16)	; OR IF NOT AN IO FILE
	JRST	RNDO21		; JUMP
	CAMLE	AC1,D.CBN(I16)	; IS THIS THE LAST BLOCK OF FILE?
	JRST	RNDO21		; NO
	MOVE	AC1,[-5,,NRSAV.-1]; SAVE POINTERS TO LAST REAL RECORD
	PUSH	AC1,R.BPNR(I12)	;
	PUSH	AC1,FS.RN	;
	PUSH	AC1,D.RP(I16)	;
	PUSH	AC1,D.RCL(I16)	;
RNDO21:	MOVE	AC0,R.BPNR(I12)	;HERE TO GET NEXT NON-0-RECORD
	MOVEM	AC0,R.BPLR(I12)	;  BUT FIRST UPDATE
	AOS	R.BPNR(I12)	;  THE POINTERS
	AOS	D.RP(I16)	;COUNT 0LEN RECORDS
	AOS	FS.RN		;BUMP THE RECORD NUMBER
	AOJA	AC5,SQIO2	;FIND THE NEXT ONE

RANDO3:	SOS	D.RP(I16)	;DONT COUNT THIS ONE
	TLNN	FLG,RANFIL	;SEQIO?
	TLO	FLG,ATEND	;SET "EOF" FLAG
	AOS	D.RCL(I16)	;DONT COUNT "EOF" AS A RECORD
	MOVE	AC0,R.BPNR(I12)	;UPDATE POINTERS IN CASE HE WANTS TO
	MOVEM	AC0,R.BPLR(I12)	;  WRITE AFTER "EOF"
	JRST	RANXI3		;RETURN

;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
	MOVEM	AC5,R.BPNR(I12)	;SAVE AS CURRENT RECORD

	HRL	AC5,FLG		;GET RECORD ADDRESS
	TLNN	AC16,READ	;IS IT READ?
	JRST	RANDO9		;NO
	MOVSS	AC5		;YES--MOVING TO RECORD
	SETZM	R.WRIT(I12)	;REMEMBER IT WAS A READ
	JRST	RAND10
RANDO9:	SETOM	R.DATA(I12)	;FORCE WRITE LATER
	SETOM	R.WRIT(I12)	;REMEMBER IT WAS A WRITE
RAND10:	ADDI	AC10,(AC5)	;FINAL DESTINATION PLUS 1
	BLT	AC5,-1(AC10)	;BLAT!!
	JRST	RANXIT
	;SEQUENTIAL IO READ AND WRITE ARE PROCESSED HERE

SEQIO:	SKIPE	R.BPLR(I12)	;SKIP IF FIRST INPUT
	JRST	SQIO1		;ITS NOT
	MOVE	AC5,R.BPFR(I12)	;FIRST RECORD
	MOVEM	AC5,R.BPLR(I12)	;LAST RECORD
	MOVEI	AC1,1		;FIRST BLOCK
	JRST	SQIO11		;READ IT IN
SQIO1:	SKIPN	R.WRIT(I12)	;SKIP IF WRITE WAS LAST
	TLNN	AC16,WRITE+WADV ;SKIP IF WRITE AFTER READ
SQIO2:	SKIPA	AC1,D.RCL(I16)	;NUMBER OF REC TO FILL CURRENT LOGBLK
	JRST	SQIO20		;
	JUMPGE	FLG1,SQIO4	; JUMP IF NOT VAR-LEN EDCDIC RECORDS
	MOVE	AC1,D.FCPL(I16)	; SEE IF ANOTHER REC IN THIS BLOCK
	CAIG	AC1,4		; COULD THERE BE A RDW?
	JRST	SQIO10		; NO - GET NEXT BLOCK
	MOVE	AC5,R.BPNR(I12)	; YES - SEE IF THERE IS A RECORD
	PUSHJ	PP,RNDW		; GET THE RDW INTO AC1
	CAILE	AC1,4		; IS THERE AT LEAST ONE CHAR?
	JRST	SQIO30		; YES - GOT A RECORD
	HRRZ	AC1,D.LBN(I16)	; NO - SEE IF THIS IS LAST BLOCK
	CAMLE	AC1,D.CBN(I16)	; OF THE FILE, IF SO
	JRST	SQIO10		; GET THE NEXT BLOCK
	TLO	FLG,ATEND	; REMEMBER WE'RE AT END-OF-FILE
	TLNN	AC16,READ	; IS THIS A READ VERB?
	JRST	SQIO3		; NO
	MOVE	AC0,R.BPNR(I12)	; UPDATE LAST-REC PTR
	MOVEM	AC0,R.BPLR(I12)	; SO APPEND WILL WORK
	SOS	D.RP(I16)	; NOT A RECORD SO DONT COUNT IT
	JRST	RANXI0		; TAKE INVALID KEY RETURN
SQIO3:	TLZ	FLG,ATEND	; NO ATEND FOR WRITE
	MOVE	AC1,D.FCPL(I16)	; IF WRITE SEE IF RECORD WILL FIT
	CAIGE	AC1,4(AC3)	; IN THIS BLOCK, IF NOT
	JRST	SQIO10		; GET NEXT BLOCK
	JRST	SQIO30		; HERE IF IT FITS
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
	SETZM	NRSAV.		; ZERO NULL-REC-IN-LAST-BLOCK FLAG
	SETZM	R.WRIT(I12)	; ZERO THE WRITE FLAG
	TLO	FLG,ATEND	; SET ATEND FLAG
	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
	TLNN	AC16,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		;					[EDIT#273]

	;HERE ON WRITE AFTER READ
SQIO20:	JUMPGE	FLG1,SQIO21	; JUMP IF FIXED LEN RECORDS
	MOVE	AC0,D.FCPL(I16)	; REWRITING OR APPENDING?
	MOVEI	AC0,4(AC3)	; IF APPENDING DO NOTHING
	CAME	AC0,D.TCPL(I16)	; IF REWRITING
	ADDM	AC1,D.FCPL(I16)	; THIS ADD NEGATES LATER SUBTRACT
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	; NO REC-CNT IF EBCDIC APPEND
	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:	JUMPL	FLG,RANWRT	;JUMP IF ASCII
	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:	LDB	AC10,F.BMRS	; GET MAX-REC-SIZE
	IMUL	AC10,AC2	; GET NUMBER OF CHARS BEFORE THE DESIRED RECORD
	IDIVI	AC10,4		; TURN IT INTO WORDS
	ADD	AC5,AC10	; ADD THIS OFFSET TO BYTE-PTR
	HLL	AC5,RNTBL(AC11)	; GET BYTE-POSITION IN WORD

	;ENTRY POINT FOR SEQIO EBCDIC FILES
RNES:	TLNN	AC16,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:	ILDB	C,AC5		; GET A CHAR
	JUMPN	C,RNER06	; EXIT HERE IF NOT NULL
	ADDI	AC0,1		; COUNT THE NULLS
	SOJG	AC3,RNER01	; LOOP

	;GOT A NULL RECORD SEE WHAT TO DO WITH IT
	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:	LDB	AC3,F.BMRS	; RESTORE RECORD SIZE
	TLNE	FLG,RANFIL	; RANDOM OR SEQIO FILE?
	JRST	RNER03		; RANDOM!
	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
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
RNER05:	AOS	(PP)		; GIVE HIM AN INVALID KEY RETURN
	MOVEI	AC1,^D23	; READ INVALID KEY
	MOVEM	AC1,FS.FS	; LOAD FILE-STATUS
	JRST	RNER40		; EXIT

	;RESTORE THE NULL CHARS IF ANY
RNER06:	SETZM	NRSAV.		; ZERO WHEN REAL REC IS FOUND
	JUMPE	AC0,RNER21	; JUMP IF NO NULLS
	SETZ	C,		; MAKE A NULL
	XCT	AC10		; CONVERT IT
	IDPB	C,AC6		; STORE IT
	SOJG	AC0,.-1		; LOOP
	LDB	C,AC5		; REGET LAST CHAR
	JRST	RNER21		;

	;READ - VAR-LEN RECORDS SO CHECK THE SIZE
RNER10:	PUSHJ	PP,RNDW		; GET RDW INTO AC1 AND AC0
	CAIGE	AC3,-4(AC1)	; WILL IT FIT INTO RECORD AREA
	PUSHJ	PP,ERRMR1	; NO - COMPLAIN
	MOVEI	AC3,-4(AC1)	; USE ACTUAL NOT MAX SIZE
	ADDB	AC0,D.FCPL(I16)	; UPDATE FREE CHARS PER LOGICAL BLOCK
	JUMPL	AC0,RERE3	; COMPLAIN IF REC TOO BIG

	;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,RNER33	; JUMP IF FIXED LEN RECORDS
	PUSHJ	PP,RNDW		; GET RDW INTO AC1
	JUMPN	AC1,RNER31	; IT WILL BE 0 IF WE ARE APPENDING
	HRLZI	AC1,4(AC3)	; SO MAKE A RDW
	MOVNI	AC0,4(AC3)	; NEGATE THE COUNT
	SUBI	AC5,1		; BACK UP THE BYTE-PTR ONE WRD
	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		;
	JRST	RNER32		;
RNER31:	CAIE	AC1,4(AC3)	; SIZES MUST MATCH
	JRST	RERE5		; THEY DONT SO ERROR
RNER32:	ADDM	AC0,D.FCPL(I16)	; UPDATE NUMBER OF FREE CHARS LEFT
RNER33:	ILDB	C,AC6		; GET CHAR
	XCT	AC10		; CONVERT
	IDPB	C,AC5		; PUT CHAR
	SOJG	AC3,RNER33	; LOOP
	SETOM	R.DATA(I12)	; NOTE ACTIVE DATA IN BUFFER
	SETOM	R.WRIT(I12)	; AND WRITE WAS LAST

	;FINISH UP AND EXIT
RNER40:	EXCH	AC5,R.BPNR(I12)	; UPDATE NEXT-RECORD AND
	MOVEM	AC5,R.BPLR(I12)	; LAST-RECORD POINTERS
	TLNN	FLG,RANFIL	; RANDOM FILE?
	JRST	RANXI0		; NO - SEQIO FILE!
	TLNN	AC16,READ	; READ OR ?
	JRST	RANXI2		; WRITE
	JRST	RANXI1		; READ

	;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
	AOJA	AC5,RET.1	; INC BYTE-PTR AND 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***
RANWR0:	ADDI	AC5,1		;POINT AT DATA NOT RECSIZ
RANWRT:	TLNN	AC16,WRITE+WADV ;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	;SKIP IF CONVERSION IS NECESSARY
	JUMPGE	FLG,RANRB	;SIXBIT, GO BLT THE DATA
	MOVE	AC10,D.WCNV(I16)	;SETUP AC10
	TLNE	AC16,WADV	;IF IT'S WADV,
	PUSHJ	PP,WRTADV	;GO ADVANCE
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"
	PUSHJ	PP,RANCR	;ALL ASCII RECORDS GET "CR"
	TLNE	AC16,WADV	;IF IT'S WRITE ADVANCE,
	PUSHJ	PP,WRTADV	;TRY TO
	TLNE	AC16,WRITE	;IF IT'S WRITE,
	PUSHJ	PP,RANLF	;GIVE HIM A "LF"
RANWR2:	SETOM	R.DATA(I12)	;THERE IS ACTIVE DATA IN THE BUFFER
	SETOM	R.WRIT(I12)	;THE LAST COBOL UUO WAS A WRITE
	JRST	RANXIT		;TAKE A STANDARD EXIT

	;MOVE THE RANDOM/IO BUFFER AREA TO THE RECORD AREA.  ***RANXIT***
RANREA:	MOVE	AC1,AC3		;SAVE MAX RECORD SIZE IN CHARS
	TLNE	FLG,DDMSIX	;IF A SIXBIT FILE
	HRRZ	AC3,-1(AC5)	;  USE THE ACTUAL SIZE
	TLNN	FLG,CONNEC	;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
RANRE0:	ILDB	C,AC5		;PICK UP A CHARACTER
	XCT	AC10		;CONVERT IF NECESSARY
	JUMPG	C,RANRE1	;IF NOT NULL , CONTINUE		[EDIT#300]
	SOJG	AC3,RANRE0	;IF MORE CHARS. THEN LOOP	[EDIT#300]
	JUMPE	AC4,RANDOM	;JUMP IF SEQ			[EDIT#300]
	MOVEI	AC1,^D23	; READ INVALID KEY
	MOVEM	AC1,FS.FS	; LOAD FILE-STATUS
	AOS	(PP)		;SET UP SKIP RETURN		[EDIT#300]
	JRST	RANRE2		;GO SET FLAGS			[EDIT#300]
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		;
RANRE4:	MOVEI	C,40		;ASCII SPACE
	TLNN	FLG,CDMASC	;ASCII?
	MOVEI	C,0		;NO, SIXBIT SPACE
	IDPB	C,AC6		;FILL OUT RECORD
	SOJG	AC3,.-1		;WITH SPACES
RANRE2:	SETZM	R.WRIT(I12)	;THE LAST COBOL UUO WAS A READ

	;SETUP FLAG WORDS AND EXIT.  ***WRTRE7***

RANXIT:	MOVE	AC0,R.BPNR(I12)	;CURRENT RECORD
	MOVEM	AC0,R.BPLR(I12)	;LAST RECORD
	HRRI	AC0,-1(AC5)	;ADR OF NEXT RECORD
	MOVEM	AC0,R.BPNR(I12)	;BP TO NEXT RECORD
RANXI0:	TLNE	FLG,RANFIL	;IF A RANDOM FILE			[EDIT#273]
	JRST	RANXI1		;  ZERO ATEND FLAG			[EDIT#273]
	TLNN	AC16,READ	;SKIP IF A READ
	JRST	RANXI2		;WRITE HAS NO ATEND SKIP EXIT
	TLNN	FLG,ATEND	;SKIP IF ATEND
RANXI1:	TLZE	FLG,ATEND	;ZERO THE ATEND FLAG
	JRST	RANXI4		;HERE ON ATEND
RANXI2:	MOVEM	FLG,F.WFLG(I16)	;SAVE FLAGS
	HLLM	FLG1,D.F1(I16)	;SAVE MORE FLAGS
	HLLZS	UOUT.		;ZERO THE RIGHT HALF
	HLLZS	UIN.		;   IOWD POINTER
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS UPDATE ?
	PUSHJ	PP,LRDEQX##	; YES
	>
	TLNN	FLG,OPNIO	; IF THIS IS AN IO FILE
	JRST	WRTRE7		; ITS NOT
	MOVE	AC0,D.CBN(I16)	; UPDATE THE LAST BLOCK NUMBER
	CAMLE	AC0,D.LBN(I16)	; IF CURRENT BN IS GT LAST BN
	MOVEM	AC0,D.LBN(I16)	; SAVE IT AS LBN
	JRST	WRTRE7		;EXIT TO USER

RANXI4:	TLNE	FLG,RANFIL	;RANDOM FILE?
	SOS	D.RCL(16)	;YES - DONT COUNT THIS RECORD
RANXI3:	AOS	(PP)		;SKIP EXIT
	SKIPN	AC1,FS.FS	; NO CHANGE IF NON ZERO
	MOVEI	AC1,^D10	; READ INVALID KEY
	MOVEM	AC1,FS.FS	; LOAD FILE-STATUS
	JRST	RANXI2		;

RANXI8:	MOVE	AC0,R.BPNR(I12)	;KEEP THE RECORD POINTERS		[EDIT#273]
	MOVEM	AC0,R.BPLR(I12)	;  UP TO DATE				[EDIT#273]
	JRST	RANXI1		;					[EDIT#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.	;
	TLNE	AC16,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
	BLT	AC5,(AC3)	;ZRAPPP!
	MOVE	AC5,TEMP.	;
	ADDI	AC5,1		;POINT TO NEXT RECORD
	TLNN	AC16,READ	;SKIP IF IT'S A READ
	JRST	RANBR2		;NOP, A WRITE
	TLNE	FLG,DDMBIN	;NO FILL IF DEVICE DATA MODE
	JRST	RANRE2		;  IS BINARY
	ADDI	AC1,5		;GET MAX SIZE
	IDIVI	AC1,6		;  IN WORDS
	SUB	AC1,AC0		;WHAT'S THE DIFFERENCE?
	JUMPLE	AC1,RANRE2	;  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	RANRE2		;
RANBR2:	JUMPE	AC4,RANWR2	;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	RANWR2

	;BINARY: BLT THE RECORD TO/FROM THE BUFFER AREA.

RANBIN:	HRL	AC5,FLG		;FROM RECORD TO BUFFER
	HRRZM	AC5,TEMP.	;SAVE BUFFER LOC
	TLNE	AC16,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:	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
	TLNE	FLG,RANFIL	;SKIP THE USETI IF SEQIO
	XCT	USETI.		;*****************
	HRRM	AC12,UIN.	;DUMP MODE IOWD
	LDB	AC5,F.BBKF	;BLOCKING FACTOR
	TLNN	AC16,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
	HLRO	AC0,R.IOWD(I12)	;;-LEN
	HRRZ	AC10,R.IOWD(I12)	;;LOC -1
	SUB	AC10,AC0	;;LAST WORD OF BUFFER AREA
	SETOM	(AC10)		;;MARK IT
	HRRZM	AC10,TEMP.	;;SAVIT SO WE CAN DISMISS PHONY EOF'S
	AOS	D.IE(I16)	;COUNT INPUT EXECUTED
	XCT	UIN.		;********************
	 JRST	RANIN1		;NORNAL RETURN
	MOVEM	AC2,TEMP.1	;SAVE AC2
;	XCT	UGETS.		;ERROR RETURN
;	MOVE	AC1,AC2		;
	PUSHJ	PP,READCK	;
RANIN1:	 SKIPA	AC10,R.BPFR(I12);BYTE POINTER TO FIRST RECORD
	JRST	RANIN3		;EOF WAS SEEN  ;READI1 SKIP EXIT
	MOVEM	AC10,R.BPNR(I12);POINTER TO CURRENT RECORD
	MOVEM	AC5,D.RCL(I16)	;REMAINING RECORDS IN CURRENT BLOCK
	JUMPGE	FLG1,RET.1	; VAR-LEN RECS DROP THROUGH
	HRRZ	AC10,R.BPFR(I12); GET POINTER TO BDW
	MOVS	AC0,-1(AC10)	; GET BDW
	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,TEMP.1	;RESTORE AC2
	SKIPE	@TEMP.		;EOF AND SOME DATA?
	JRST	RANIN4		;NO
	TLZ	FLG,ATEND	;YES, SO TURN OFF THE EOF
	JRST	RANIN1		;  AND MAKE BELEIVE IT DIDN'T HAPPEN

RANIN4:	PUSHJ	PP,ZDMBUF	;ZERO THE DUMP MODE BUFFER
	TLNN	AC16,READ	;READ UUO?
	TLZA	FLG,ATEND	;  WRITE UUO SO CLEAR "ATEND"
	AOSA	(PP)		;  READ GETS A SKIP EXIT
	JRST	RANIN5		; TAKE NORMAL RETURN
	TLNE	FLG,RANFIL	; SKIP IF SEQUENTIAL FILE
	SKIPN	AC4		; IF ACTUAL-KEY IS 0 FILE IS SEQ
	SKIPA	AC10,[^D10]	; AT END "NO NEXT RECORD"
	MOVEI	AC10,^D23	; "RECORD NOT FOUND"
	MOVEM	AC10,FS.FS	;LOAD FILE-STATUS

	;IF VAR LEN RECS MAKE A BLOCK DESCRIPTOR WORD
RANIN5:	JUMPGE	FLG1,RANIN1	; JUMP IF FIXED LEN RECS
	HRRZ	AC10,R.BPFR(I12); GET POINTER TO BDW
	HRRZ	AC0,D.TCPL(I16)	; GET BLOCK SIZE
	ADDI	AC0,4		; PLUS 4 FOR BDW
	MOVSM	AC0,-1(AC10)	; SAVE AS BDW
	JRST	RANIN1		;TAKE NORMAL 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
	XCT	USETO.		;******************
	MOVE	AC1,D.CBN(I16)	;NEXT BLOCK BECOMES CURRENT BLOCK
	HRRM	AC12,UOUT.	;DUMP MODE IOWD
	JRST	WRTOUT		;DO IT

	;CHECK ACTUAL KEY AGAINST THE FILE-LIMIT-CLAUSES AND TAKE
	;THE INVALID-KEY RETURN IF NOT LEGAL.  ***POPJ***

FLIMIT:	MOVE	AC1,R.FLMT(I12)	;PICK UP THE IOWD "FLC"
	HRRZ	AC4,F.RACK(I16)
	MOVE	AC4,(AC4)	;ACTUAL KEY
	JUMPE	AC4,RET.1	;OK IF 0, HE WANTS TO READ SEQ FROM HERE
	CAIA
FLIMI1:	ADDI	AC1,2		;ACCOUNT FOR TWO LIMIT WORDS
	CAMLE	AC4,2(AC1)	;SKIP IF ACTKEY LE LARGER LIMIT
	JRST	.+3
	CAML	AC4,1(AC1)	;SKIP IF ACTKEY L THE SMALLER LIMIT
	POPJ	PP,		;OK EXIT
	AOBJN	AC1,FLIMI1	;
	TLNN	AC16,READ!WRITE!WADV ;SKIP IF NOT A SEEK UUO
	POPJ	PP,		;SEEK, RETURN TO ***ACP***
	POP	PP,(PP)		;POP OFF RETURN ADR
	TLNN	AC16,READ	;INVALID-KEY EXITSKIP IF READ
	AOS	(PP)		;SKIP OVER THE OPERAND
	MOVEI	AC1,^D24	;BOUNDRY VIOLATION
	MOVEM	AC1,FS.FS	;LOAD FILE-STATUS
	JRST	RET.2		;  AND TAKE A SKIP EXIT   ***ACP***

	;ZERO THE DUMP MODE BUFFER AREA

ZDMBUF:	HLRO	AC4,R.IOWD(I12)	;-LEN
	HRR	AC1,R.IOWD(I12)	;LOC-1
	HRLI	AC1,1(AC1)	;FROM
	HRRI	AC1,2(AC1)	;TO
	SETZM	-1(AC1)		;THE ZERO
	MOVN	AC4,AC4	;LEN
	ADDI	AC4,-1(AC1)	;UNTIL
	BLT	AC1,(AC4)	;DOIT
	POPJ	PP,

RANLF:	SKIPA	C,[12]		;
RANCR:	MOVEI	C,15		;
	IDPB	C,AC5		;
	POPJ	PP,		;

	;HERE BEFORE WRITING A NEW RECORD
	;MAKE THE OLD RECORD SIZE CONFORM TO NEW SIZE
RANSHF:	CAMN	AC2,AC3		;ACTUAL-SIZE VS NEW-SIZE
	POPJ	PP,		;SKIP THIS MESS
	MOVE	AC4,D.RCL(I16)	;IF NO RECORDS FOLLOWING
	JUMPE	AC4,RANS09	;  DONE
	MOVEI	AC0,5(AC3)	;NEW SIZE
	IDIVI	AC0,6		;  IN WORDS
	MOVEI	AC1,5(AC2)	;ACTUAL SIZE
	IDIVI	AC1,6		;  IN WORDS
	SUB	AC0,AC1		;NS - AS
	JUMPE	AC0,RANS09	;SAME SIZE SO EXIT

;FIND THE LAST DATA WORD IN THIS LOGICAL BLOCK
	MOVE	AC10,AC1	;SIZE OF THIS RECORD
	MOVEI	AC2,-1(AC5)	;ADR OF THIS RECORD'S HEADER WORD
RANS01:	ADDI	AC2,1(AC10)	;ADR OF NEXT HEADER WORD
	HRRZ	AC10,@AC2	;SIZE OF NEXT RECORD IN CHARACTERS
	ADDI	AC10,5		;  --
	IDIVI	AC10,6		;  IN WORDS
	SOJG	AC4,RANS01	;LOOP IF ANY MORE
	ADDI	AC2,(AC10)	;ADR OF LAST DATA WORD
	HRRO	AC10,AC5	;ADR OF THE FIRST RECORD WORD
	ADD	AC10,AC1	;ADR OF NEXT RECORD'S HEADER WORD
	JUMPG	AC0,RANS03	;IF POSITIVE MAKE A LARGER HOLE

;NEGATIVE SO MAKE A SMALLER HOLE
	HRLS	AC10		;ADR OF NEXT RECORD HEADER WORD
	ADD	AC10,AC0	;  PLUS THE DIFFERENCE
	ADD	AC2,AC0		;THE BLT UNTIL POINTER
	BLT	AC10,(AC2)	;MOVE IT
	SETZM	1(AC2)		;TERMINATE DATA
	JRST	RANS09

;POSITIVE SO MAKE A LARGER HOLE
RANS03:	HRRZ	AC4,AC2		;ADR OF LAST DATA WORD
	SUBI	AC4,-1(AC10)	;NUMBER OF WORDS TO MOVE
	HRR	AC10,AC2	;START WITH THE LAST DATA WORD
	HRLI	AC0,(POP AC10,(AC10))
	HRLZI	AC1,(SOJG AC4,AC0)
	HRLZI	AC2,(POPJ PP,)
	PUSHJ	PP,AC0		;POP-POP-POP
RANS09:	HRRZM	AC3,-1(AC5)	;GIVE IT A HEADER WORD
	HRRZ	AC2,AC3		;RESTORE AC2
	POPJ	PP,
	;FORCE WRITE FOR SIMULTANEOUS UPDATE
FORCW.:: MOVE	AC0,[FS.ZRO,,FS.FS] ; CLEAR FILE STATUS BLOCK
	BLT	AC0,FS.IF	; FOR POSSIBLE ERROR ACTION
	PUSHJ	PP,SETCN.	; SET UP CHANNEL NUMBER
	MOVE	FLG,F.WFLG(I16)	; JUST IN CASE OF ERRORS
	MOVE	AC1,D.CBN(I16)	; GET THE BLOCK NUMBER
	HLRZ	AC12,D.BL(I16)
	PUSHJ	PP,RANOUT	; GO WRITE IT OUT
	 SOS	(PP)		; NORMAL RETURN
	SOS	D.OE(I16)	; DON'T COUNT THIS OUTPUT
	HLLZS	UOUT.		; CLEAR IOWRD PTR
	SETZM	R.DATA(I12)	; SET NO ACTIVE DATA FLAG
	JRST	RET.2		; RETURN

	;FORCE READ FOR SIMULTANEOUS UPDATE
FORCR.:: MOVE	AC0,[FS.ZRO,,FS.FS] ; CLEAR FILE STATUS BLOCK
	BLT	AC0,FS.IF	;
	MOVE	FLG,F.WFLG(I16)	; GET FLG REGISTER
IFN ISAM,<TLNE	FLG,IDXFIL	;ISAM FILE?
	JRST	FORCRY		;JUMP IF FILE INDEXED
>
	MOVE	AC1,D.CBN(I16)	; GET BLOCK NUMBER
	MOVEM	AC1,FS.BN	; SAVE FOR ERROR ACTION
	PUSHJ	PP,SETCN.	; SET UP CHANNEL
	HLRZ	AC12,D.BL(I16)
	HRRM	AC12,UIN.	; SET IOWRD PTR
	XCT	USETI.		; THIS IS THE BLOCK
	XCT	UIN.		; TO READ
	 JRST	FORCRX		; NORMAL RETURN
	PUSHJ	PP,READCK	; ERROR RETURN (EOF?)
	 JRST	FORCRX		; SHOULD NOT GET HERE
	TLNN	FLG,ATEND	; EOF GETS NORMAL RETURN
	AOS	(PP)		; ERROR GETS SKIP RET
FORCRX:	HLLZS	UIN.		; CLEAR THE IOWRD PTR
	POPJ	PP,

IFN ISAM,<
	;ZERO THE ISAM BLOCK NUMBERS TO CAUSE FRESH INPUTS
FORCRY:	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)
	PUSHJ	PP,VNDE1	; READ FRESH COPY OF STATISTICS BLOCK
	 JFCL			; NO NEW LEVELS EXIT
	POPJ	PP,
>
SUBTTL ISAM-CODE
IFN ISAM,<
	;INDEX-SEQ READ
IREAD:	TLZ	FLG1,-1		;INITIALIZE FLG1
	PUSHJ	PP,SETIC	;SET THE CHANNEL
	HRR	AC0,F.WBSK(I16)
	HRRM	AC0,GDPSK(I12)
	AOS	RWRSTA(I12)	;# OF READ/WRITE/REWRITES
	PUSHJ	PP,LVTST	;SYMKEY = LOW-VALUES ?
	 JRST	SREAD		;YES, SEQUENTIAL READ
	PUSHJ	PP,@GETSET(I12)	;ADJKEY OR GD67 OR FPORFP
	PUSHJ	PP,IBS		;LOCATE THE RECORD
IFE	%%RPG,<
	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,

RRDIVK:	SKIPE	BRISK(I12)	;SKIP IF SLOW MODE
	JRST	RRDIV4		;JUMP IF FAST MODE
	TLON	FLG1,RIVK	;SET INVALID-KEY, FIRST TIME?
	JRST	IBSTO1		;YES

	;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)	;CLEAR NNTRY SO CNTRY POINTS TO CURRENT ENTRY	[EDIT#275]
RRDIV1:	POP	PP,AC0		;
	TLNN	AC16,READ	;READ?
	AOS	(PP)		;NO, RERITE OR DELET
	MOVEI	AC0,^D23	; READ IVK FILE STATUS
RRDIV0:	MOVEM	AC0,FS.FS	; SAVE FILE STATUS
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)
	PUSHJ	PP,LRDEQX##	;CALL LRDEQX IF FILE OPEN FOR SIMULTANEOUS UPDATE
	>
	JRST	RET.2		;INVALID-KEY RETURN
	;SEQUENTIAL READ
SREAD:	TLO	FLG1,SEQ	;FLAG SREAD
	SKIPE	CNTRY(I12)	;IS THIS THE FIRST READ EVER?
	JRST	SREAD1		;NO
	PUSHJ	PP,@GETSET(I12)	;SET UP SEARCH FOR LOW-VALUES
	PUSHJ	PP,IBS		;FIND FIRST DATA RECORD
	JRST	SREAD2

	;TRY FOR THE NEXT DATA REC IN THIS BLOCK
SREAD1:	SETZ	LVL,		;WE ARE AT LEVEL 0!
	HRRZ	AC4,CNTRY(I12)	;CURRENT ENTRY
	SKIPE	NNTRY(I12)	;CNTRY ALREADY POINTING AT NEXT ENTRY?
	JRST	SREAD2		;YES
	LDB	AC1,RSBP(I12)	;
	IDIV	AC1,D.BPW(I16)	;
	JUMPE	AC2,.+2		;
	ADDI	AC1,1		;
	ADDI	AC4,1(AC1)	;NEXT ENTRY
SREAD2:	SKIPE	-1(AC4)		;NULL REC = LAST REC
	CAMLE	AC4,LRW(I12)	;WAS THAT THE LAST REC?
	PUSHJ	PP,UPDOWN	;YES, GET THE NEXT
	HRRM	AC4,CNTRY(I12)	;SAVE AS CURRENT ENTRY
	SETZM	NNTRY(I12)	;NOTE CNTRY POINTS AT CURRENT ENTRY
	PUSHJ	PP,SETLRW	;SET UP LRW INCASE A 'DELET' OCCURED
IFE	%%RPG,<
	SKIPN	SU.FRF
	>
	JRST	MOVBR		;JUMP IF NOT FAKE READ TO MOVE RECORD

	; HERE IF FAKE READ TO GET BLOCK NUMBER
IFE	%%RPG,<
	MOVE	AC2,F.WBRK(I16)	; GET RELATIVE REC-KEY BYTE-PTR
	ADD	AC2,CNTRY(I12)	; FILL IN THE ADR
	MOVEM	AC2,SU.RBP	; SAVE IT FOR RETAIN
	JRST	IREADF		; GET THE BLOCK NUMBER AND EXIT
	>

	;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		;
	SKIPE	LVL		;
	ADDI	AC4,1		;CURRENT ENTRY OR REC
	POPJ	PP,

UPDOW1:	POP	PP,AC0		;POPOFF THE RETURNS
	SOJG	LVL,.-1		;
	MOVEI	AC0,^D10	; NO NEXT LOGICAL RECORD FOUND
	MOVEM	AC0,FS.FS	; SAVE FILE STATUS
	JRST	RET.2		;INVALID KEY RETURN

	;HERE FROM GETBLK VERSION NUMBER DISCREPANCY WHEN SREADING
UDVERR:	TLNN	FLG1,VERR	;IF WE'VE BEEN HERE BEFORE OR
	SKIPN	CNTRY(I12)	;  THIS IS THE FIRST READ EVER
	JRST	UDVER1		;  LEAVE THE STACK ALONE.
	JUMPE	LVL,UDVER1	;  SAME THING IF A DATA BLOCK
	POP	PP,(PP)		;MAKE THE STACK RIGHT
	SOJG	LVL,.-1		;

	;MOVE THE CURRENT KEY TO THE SYMBOLIC KEY
UDVER1:	LDB	AC1,KY.TYP	; GET KEY TYPE
	CAIGE	AC1,3		; DISPLAY?
	JUMPN	AC1,.+3		; JUMP IF NUMERIC DISPLAY
	CAIGE	AC1,7		; SKIP IF COMP-3
	JRST	UDVER2		; DISPLAY, FIXED, OR FLOATING POINT

	;CONVERT BINNARY TO DISPLAY KEY
	PUSHJ	PP,SAVAC.	;SAVE THE ACS
	MOVE	AC0,2(AC4)	;THE KEY
	LDB	AC2,KY.MOD	; GET KEY MODE
	HLRZ	AC10,PDTBL(AC2)	; GET CONVERSION ROUTINE
	LDB	AC2,KY.TYP	; GET KEY TYPE
	CAIL	AC2,7		; IF COMP-3
	HRRZI	AC10,PC3.	; USE THIS ROUTINE
	MOVE	AC15,F.WBSK(I16);BYTE POINTER TO SYM-KEY
	TLZ	AC15,7777	;MAKE A PARAMETER WORD FOR PD6/7.
	LDB	AC1,KY.SIZ	; GET KEY SIZE
	TSO	AC15,AC1	;INCLUDE THE KEY SIZE
	HRRZI	AC16,AC15	;AC0 IS SOURCE,,AC15 IS PARAMETER WRD
	PUSHJ	PP,(AC10)	;CALL PD6. OR PD7.
	PUSHJ	PP,RSTAC.	;RESTORE ACS
	JRST	UDVER3		;--DONE--

	;JUST MOVE THE KEY
UDVER2:	HRLI	AC1,2(AC4)	;MOVE CURRENT KEY TO SYMBOLIC-KEY
	HRR	AC1,F.WBSK(I16)	;FROM,,TO
	MOVE	AC2,IESIZ(I12)	;
	SUBI	AC2,2		;LEN
	ADDI	AC2,-1(AC1)	;UNTIL
	BLT	AC1,(AC2)	;MOVIT

UDVER3:	PUSHJ	PP,VNDE		;IF TOP INDEX BLOCK WAS SPLIT - TRY AGAIN [EDIT#307]
	 JFCL			;
	TLOE	FLG1,VERR	;
	JRST	LV2SK3		;NO - GIVE ERROR MESSAGE AND QUIT	[EDIT#307]

	MOVE	LVL,MXLVL(I12)	;OK - TAKE IT FROM THE TOP		[EDIT#307]
	PUSHJ	PP,@GETSET(I12)	;
	PUSHJ	PP,IBSTO1	;

	;SET LOW-VALUES TO SYMKEY
LV2SK.:: MOVE	AC1,F.WBSK(I16)	;SK BYTE-POINTER
	HLRZ	AC12,D.BL(I16)
	LDB	AC3,KY.TYP	; GET KEY TYPE
	CAIL	AC3,7		; COMP-3?
	JRST	LV2SK1		; YES
	CAIGE	AC3,3		;DISPLAY ?
	JRST	LV2SK2		;YES

	;FIXED OR FLOATING POINT
	MOVSI	AC0,400000	;ASSUME IT IS A COMP ITEM
	CAILE	AC3,4		;FIXED POINT ?
	ADDI	AC0,1		;NO, COMP-1
	MOVEM	AC0,(AC1)	;TO SYMKEY
	TLNN	AC3,1		;TWO WORDS ?
	MOVEM	AC0,1(AC1)	;
	POPJ	PP,		;NO, EXIT

	;COMP-3
LV2SK1:	LDB	AC3,KY.SGN	; GET SIGN BIT
	SKIPE	AC3		; SKIP IF UNSIGNED
	SKIPA	AC2,[9B13+15B17+9B31+9B35]	; LOW-VALUES

	;DISPLAY
LV2SK2:	SETZ	AC2,		; LOW VALUES FOR DISPLAY
	LDB	AC0,KY.SIZ	; GET KEY SIZE
	IDPB	AC2,AC1		;DEPOSIT SOME LV'S
	SOJG	AC0,.-1
	TLNN	AC2,-1		; SKIP IF SIGNED COMP-3
	POPJ	PP,		;
	MOVSS	AC2		; GET THE LSAT BYTE
	DPB	AC2,AC1		; "9-"
	POPJ	PP,

	;ERROR MESSAGE OR IGNORE THE ERROR
LV2SK3:	PUSHJ	PP,GBVER	;IGNORE ERROR?
	JRST	LV2SK.		;YES - RESTORE SYM-KEY

	;HERE TO DELETE A RECORD
DELET.:
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.DL	; YES
	>
	TLO	AC16,DELET	;
	JRST	RERIT1		;

	;HERE TO REWRITE AN EXISTING RECORD
RERIT.:
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	;ANY RETAINED RECORDS?
	PUSHJ	PP,SU.RW	; YES
	>
	TLO	AC16,RERIT	;
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
	PUSHJ	PP,LVTST	;LOW-VALUES IN SYMBOLIC KEY?
	 JRST	LVERR		;YES, ITS ILLEGAL

	AOS	RWRSTA(I12)
	TLZ	FLG1,-1		;INITIALIZE THE FLAG REG
	PUSHJ	PP,SETIC	;SET THE INDEX CHANNEL
	PUSHJ	PP,@GETSET(I12)	;ADJKEY OR GD67 OR FPORFP
	PUSHJ	PP,IBS		;FIND THE RECORD
	PUSHJ	PP,SETLRW	;FIND THE LAST RECORD WORD
	PUSHJ	PP,SHFREC	;MAKE SURE THE NEW REC WILL FIT
	TLNE	AC16,DELET	;DELET ?
	JRST	DEL01		;YES
	PUSHJ	PP,MOVRB	;MOVE THE RECORD
RERIT2:	PUSHJ	PP,WDBK		;WRITE THE DATA BLOCK
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
	PUSHJ	PP,LRDEQX##	; YES
	>
	JRST	RET.2
DEL01:	HRRZ	AC2,LRW(I12)	;
	SETZM	1(AC2)		;TERMINATE THE DATA BLOCK
	HRRZ	AC3,IOWRD(I12)
	CAMN	AC2,AC3		;IS DATA BLOCK EMPTY ?
	PUSHJ	PP,DEL10	;YES, GO UPDATE THE INDEX
	SKIPE	OLDBK		;ANYTHING TO DE-ALLOCATE?
	PUSHJ	PP,DALC		;YES
	JRST	RERIT2

	;IF NOT FIRST ENTRY IN THE INDEX BLOCK
	; JUST DELET THE ENTRY & EXIT
DEL10:	MOVE	AC1,USOBJ(I12)	;ADR OF EMPTY BLOCK
	MOVEM	AC1,OLDBK	;SAVE FOR DE-ALLOCATION
DEL11:	ADDI	LVL,1		;UP A LVL
	HRRZ	AC1,@CNTRY0(I12)
	HRRZ	AC0,@IOWRD0(I12)  ;
	ADDI	AC0,3
	CAME	AC0,AC1		;FIRST ENTRY THIS BLK ?
	JRST	DEL40		;NO, DELET ENTRY & EXIT

	HLL	AC1,DBPRK(I12)	;BYTE POINTER TO DATA RECORD KEY	[EDIT#276]
	PUSHJ	PP,LVTSTI	;TEST FOR LOW-VALUES
	 JRST	DEL13		;LOW-VALUES!

	SUBI	AC1,2		;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,-1		;INITIALIZE				[EDIT#307]
	PUSHJ	PP,LVTST	;LOW VALUES IN SYM-KEY?
	 JRST	LVERR		;ILLEGAL!

	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
	TLNN	FLG1,BVN	;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)	;DATA BYTE-POINTER TO RECORD KEY	[EDIT#276]
	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
	PUSH	PP,GDPSK(I12)	;SAVE IT				[EDIT#276]
	PUSH	PP,F.WBSK(I16)	;SAVE IT				[EDIT#276]
	MOVEM	AC3,F.WBSK(I16)	;FIRST KEY OF AUXBUF VS SYMKEY		[EDIT#276]
	MOVEM	AC2,GDPSK(I12)	;					[EDIT#276]
	TLO	FLG1,NOTEST	;SKIP THE CONVERSION AT ADJKEY		[EDIT#276]
	PUSHJ	PP,@GETSET(I12)	;PLACE FIRST KEY OF AUXBUF IN IAKBP
	TLZ	FLG1,NOTEST	;RESTORE THE FLAG			[EDIT#276]
	POP	PP,F.WBSK(I16)	;RESTORE SYMKEK POINTER			[EDIT#276]
	POP	PP,GDPSK(I12)	;RESTORE				[EDIT#276]
	PUSHJ	PP,UDIF		;UPDATE THE INDEX FILE
	PUSHJ	PP,WIBK		;WRITE THE INDEX BLOCK

IWRIX:	SKIPE	OLDBK		;ANY BLOCKS TO DEALLOCATE
	PUSHJ	PP,DALC		;YES, DOIT
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
	PUSHJ	PP,LRDEQX##	; YES
	>
	JRST	RET.2


IWIVK:	SKIPE	BRISK(I12)	;SKIP IF SLOW MODE
	JRST	IWIVK2		;
	TLON	FLG1,WIVK	;HAVE WE BEEN HERE BEFOR?
	JRST	IBSTO1		;NO, TRY AGAIN
IWIVK2:	SUB	AC4,DBPRK(I12)	;POINT AT BEGINNING OF THIS ENTRY	[EDIT#276]
	HRRZM	AC4,CNTRY(I12)	;SAVE IN CASE SEQ READ IS NEXT
IWIVK1:	POP	PP,(PP)		;
	MOVEI	AC0,^D22	;RECORD ALREADY EXISTS
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)
	PUSHJ	PP,LRDEQX##	;CALL LRDEQX IF FILE OPEN FOR SIMULTANEOUS UPDATE
	>
	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
	HRRM	AC0,@CNTRY0(I12)  ;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
	TTCALL	3,[ASCIZ /
$ /]
	MOVE	AC2,[BYTE (5)10,31,20,14]
	PUSHJ	PP,MSOUT.
	TTCALL	3,[ASCIZ / SHOULD BE REORGANIZED,
THE TOP INDEX BLOCK WAS JUST SPLIT.
/]
	JRST	UDIF34

UDIER:	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+E.BIDX+^D2]	;THE ERROR NUMBER
	PUSHJ	PP,IGCVR1	;FATAL MESSAGE OR IGNORE ERROR?
	 JRST	RET.2		;NO MESSAGE JUST RETURN TO CBL-PRGM
	TTCALL 3,[ASCIZ /NO MORE INDEX LEVELS AVAILABLE TO/]
	MOVE	AC2,[BYTE (5)10,31,20]
	PUSHJ	PP,MSOUT.	;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
	BLT	AC0,(AC1)	;PROPAGATE THE ZERO

UDIF13:	HLRO	AC1,-1(AC11)	;[320];
	MOVN	AC0,AC1		;LENGTH FOR GETSPC
	HRL	AC1,.JBFF	;DWOI
	PUSHJ	PP,GETSPC	;GET SOME SPACE
	 JRST	UDIF12		;NO MORE CORE
	HRRZ	AC0,HLOVL.	;[346] GET START OF OVERLAY AREA
	CAMGE	AC0,.JBFF	;[346] BUFFER EXTEND INTO OVL AREA?
	JUMPN	AC0,UDIF15	;ERROR IF IN OVERLAY AREA
	MOVE	AC0,(AC11)	;IOWD FOR ALLOCATED AREA
	CAIGE	LVL,12		;SKIP IF IF CAN'T BE
	MOVEM	AC0,1(AC11)	;SAVE FOR NEXT TOP BLK SPLIT
	MOVSS	AC1		;-LEN,,LOC
	SUBI	AC1,1		;MAKE IT AN IOWD
	MOVEM	AC1,(AC11)	;SAVE AS CURRENT IOWRD

UDIF12:	SKIPE	(AC11)		;ANY CORE ALLOCATED?
	POPJ	PP,		;YES, PHEW!
	MOVEI	AC0,^D30	;RERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+E.BIDX+^D3]	;ERROR NUMBER
	PUSHJ	PP,IGCVR2	;FATAL MESSAGE OR IGNORE ERROR?
	 JRST	RET.2		;IGNORE SO RETURN TO MAIN LINE CODE

UDIF14:	TTCALL	3,[ASCIZ /INSUFICIENT CORE WHILE ATTEMPTING TO SPLIT THE TOP INDEX BLOCK OF
/]
	MOVE	AC2,[BYTE(5)10,31,20]
	PUSHJ	PP,MSOUT.	;KILL
UDIF15:	HLRZM	AC1,.JBFF	;GET OUT OF OVERLAY AREA
	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+E.BIDX+^D36]	;ERROR NUMBER
	PUSHJ	PP,IGCVR2	;IGNORE?
	 JRST	RET.2		;YEP
	XCT	WOVLRX		;GIVE ERROR MESSAGE
	JRST	UDIF14		; AND KILL

	;ALOCATE TWO INDEX BLOCKS

ALC2IB:	MOVE	AC1,FMTSCT(I12)	;
	MOVEM	AC1,NEWBK1	;
	MOVE	AC0,ISPB(I12)	;NUMBER OF SECTORS PER INDEX BLOCK
	ADDM	AC0,FMTSCT(I12)	;UPDATE FIRST EMPTY SECTOR AVAILABLE
ALC1IB:	MOVE	AC1,FMTSCT(I12)	;
	MOVEM	AC1,NEWBK2	;
	MOVE	AC0,ISPB(I12)	;
	ADDM	AC0,FMTSCT(I12)	;
	TLO	FLG1,WSTB	;REMEMBER TO WRITE THE STATISTICS BLOCK
	POPJ	PP,
	;DECIDE WHERE TO SPLIT THE BLOCK
SPLTBK:	TLO	FLG1,BVN	;NOTE THE BLOCK WAS SPLIT
	PUSHJ	PP,SETLRW	;BUMP THE VERSION NUMBERS
	HRRZ	AC4,CNTRY(I12)	;
	SUBI	AC4,1		;ONE FOR HEADER WORD
	HRRZ	AC5,DBF(I12)	;DATA BLOCKING FACTOR
	LSH	AC5,-1		;2ND HALF GE 1ST HALF
	MOVE	AC11,DRTAB	;
	ADD	AC11,AC5	;BEG OF 2ND HALF
	MOVE	AC10,(AC11)	;
	CAIG	AC4,(AC10)	;NEWREC IN 2ND HALF?
	JRST	SPLT01		;NO

	;MAKE HEADER WORD FOR NEWREC
	TLO	FLG1,IIAB	;NOTE INSERTION IS IN AUX BUFFER
	ADDI	AC11,1		;MAKE 1ST HALF GE 2ND HALF
	LDB	AC2,WOPRS.	;NEWREC SIZE
	MOVEM	AC2,AC6		;FIRST PART OF HEADER WORD
	JUMPGE	FLG,SPLT03	;ASCII?
	ADDI	AC2,2		;<CRLF>
	ADDI	AC6,2		;<CRLF>
	LSH	AC6,1		;MAKE ROOM FOR BIT35
	TRO	AC6,1		;MAKE IT LOOK LIKE A SEQUENCE NUMBER
SPLT03:	MOVE	AC3,IOWRD(I12)	;GET VERSION NUMBER
	HLL	AC6,1(AC3)	;HEADER WORD = VERSION # ,, RECSIZ

	;HOW MANY WORDS IN NEWREC?
	IDIV	AC2,D.BPW(I16)	;
	JUMPE	AC3,.+2		;
	ADDI	AC2,1		;
	ADDI	AC2,1		;PLUS ONE FOR HEADER WORD

	;MOVE 1ST PART OF 2ND HALF TO AUXBUF
	HRL	AC0,(AC11)	;
	HRR	AC0,AUXBUF	;FROM ,, TO
	HRRZI	AC1,-1(AC4)	;
	HRRZ	AC3,(AC11)	;ADR OF FIRST REC-HDR TO GO IN AUXBUF
	SUB	AC1,AC3		;LENGTH OF FIRST PART
	HRRZM	AC1,TEMP.	;LEN OF PART BEFORE NEW-REC
	CAIGE	AC1,0		;IS NEW-REC FIRST IN AUXBUF?
	SETZM	TEMP.		;YES
	ADD	AC1,AUXBUF	;UNTIL
	SKIPE	TEMP.		;DONT DO BLT IF FIRST RECORD		[EDIT#271]
	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	;
	HRRZM	AC0,AUXBNO	;GIVE 2ND NEW BLKNO TO AUXBUF

	TLZN	FLG1,IIAB	;INSERTION IN AUX BLOCK?
	JRST	IWRI01		;NO
	PUSHJ	PP,WWDBK		;WRITE A DATA BLOCK
	PUSHJ	PP,MOVRBA	;INSERT
	PUSHJ	PP,WABK		;WRITE AUXBUF
	PUSHJ	PP,MAUXD	;MOVE AUXBUF TO DATABUF
	HRRZM	AC1,LRW(I12)	;
	JRST	IWRI04		;

	;ROUTINE MOVES CONTENTS OF AUXBUF TO DATA OR INDEX BUFFER
	;UPDATES CNTRY AND USOBJ SO SEQ-READS WILL WORK
MAUXD:	MOVE	AC0,LRW(I12)	;
	HRRZM	AC0,TEMP.1	;LAST RECORD WORD
MAUXI:	MOVE	AC0,TEMP.2	;
	SUB	AC0,AUXIOW	;
	ADD	AC0,@IOWRD0(I12)  ;
	HRRM	AC0,@CNTRY0(I12)  ;CURRENTRY
	MOVE	AC0,AUXBNO	;
	MOVEM	AC0,@USOBJ0(I12)  ;USETO OBJECT
	MOVE	AC1,LRWA	;
	SUB	AC1,AUXIOW	;LENGTH
	ADD	AC1,@IOWRD0(I12)  ;UNTIL
	MOVE	AC0,@IOWRD0(I12)
	ADDI	AC0,1		;
	HRL	AC0,AUXBUF	;FROM,,TO
	HRRZ	AC3,TEMP.1	;
	CAIL	AC3,(AC1)	;ANY REMNANTS LEFT?
	HRRZM	AC3,AC1		;YES, COVER THEM UP WITH ZEROES
	BLT	AC0,(AC1)	;DOIT!
	POPJ	PP,

	;SAVE TOP INDEX ENTRY FOR THE NEW TOP INDEX BLOCK
SAVTIE:	MOVE	AC2,@IOWRD0(I12)  ;
	ADDI	AC2,1		;
	HRLI	AC2,4(AC2)	;
	HRR	AC2,IESAVE	;FROM,,TO
	MOVE	AC3,NEWBK2	;
	MOVEM	AC3,(AC2)	;BLOCK NUMBER FOR THIS LEVEL
	MOVE	AC3,@IOWRD0(I12)
	MOVE	AC3,2(AC3)	;
	MOVEM	AC3,1(AC2)	;VERSION OF CURRENT IDX BLOCK
	HRR	AC3,IESIZ(I12)	;
	ADD	AC3,-1(AC2)		;UNTIL
	ADDI	AC2,2		;WHERE THE KEY WILL GO
	BLT	AC2,(AC3)	;MOVIT
	POPJ	PP,
	;MAKE TWO COPIES OF SYMKEY
	;ADJUST ONE TO MATCH IDXKEY, &ONE TO RECKEY
ADJKEY:	MOVE	AC0,F.WBSK(I16)	;SYMBOLIC KEY BP
	MOVE	AC1,DAKBP(I12)	;DATA ADJUSTED KEY POINTER
	HRRM	AC1,DKWCNT(I12)	;DATA KEY WRD CNT
	MOVE	AC2,IAKBP(I12)	;INDEX ADJUSTED KEY POINTER
	HRRM	AC2,IKWCNT(I12)	;-CNT,,FRST-WRD
	MOVE	AC10,D.WCNV(I16); GET CONVERSION INST.
	TLNE	FLG1,NOTEST	; IF NOTEST - NO CONVERSION
	MOVSI	AC10,(JFCL)	;
	LDB	AC4,KY.SIZ	; GET KEY SIZE
ADJKE1:	ILDB	C,AC0		;SYMKEY
	XCT	AC10		; CONVERT IF NECESSARY
	IDPB	C,AC1		;RECKEY
	IDPB	C,AC2		;IDXKEY
	SOJG	AC4,ADJKE1	;
	POPJ	PP,


	;CONVERT NUMERIC DISPLAY OR COMP-3 TO ONE/TWO WRD INTEGER
GD67:	MOVEI	AC0,ACSAV0	;
	BLT	AC0,ACSAV0+16	;
	MOVE	AC16,[Z AC2,GDPSK]  ;PARAMETER
	ADD	AC16,I12	;INDEX IT
	PUSHJ	PP,@GDX.I(I12)	;CALL GD6. OR GD7. OR GD9. OR GC3.
	MOVEM	AC2,@IAKBP(I12)
	MOVEM	AC2,@DAKBP(I12)
	MOVEM	AC3,@IAKBP1(I12)
	MOVEM	AC3,@DAKBP1(I12)
	HRLZI	AC0,ACSAV0
	BLT	AC0,AC16
	POPJ	PP,


	;GET SET FOR ONE/TWO WRD INTEGER
FPORFP:	MOVE	AC1,F.WBSK(I16)	;SYM-KEY
	MOVE	AC0,(AC1)	;
	MOVEM	AC0,@IAKBP(I12)
	MOVEM	AC0,@DAKBP(I12)
	MOVE	AC0,1(AC1)
	MOVEM	AC0,@IAKBP1(I12)
	MOVEM	AC0,@DAKBP1(I12)
	POPJ	PP,
	;DO THE BINARY SEARCH AGAIN, THERE WAS A VERSION NUMBER DISCREPANCY
	;ROUTINE CAUSES GETBLK TO REREAD INDEX/DATA BLOCKS FROM DSK
IBSTOP:	POP	PP,AC1		;CLEAR RETURN TO IBS+1
IBSTO1:	MOVN	AC1,MXLVL(I12)	;NUMBER OF IOWD'S TO ZERO
	MOVEI	AC2,USOBJ(I12)	;ADR OF FIRST IOWD
	HRL	AC2,AC1		;FOR AOBJN
	SETZM	(AC2)		;
	AOBJN	AC2,.-1		;

	;BINARY SEARCH ROUTINE FOR THE INDEX BLOCKS

IBS:	PUSHJ	PP,GETOP	;GET THE TOP LEVEL INDEX BLOCK
	JRST	.+2

IBS0:	PUSHJ	PP,GETBLK	;GET THE BLOCK INTO CORE
	MOVE	AC5,SINC(I12)	;THE SEARCH INCREMENT
	HRRZ	AC4,@IOWRD0(I12)  ;
	SUB	AC4,IESIZ(I12)	;INITIALIZE AT ZEROTH ENTRY
	ADDI	AC4,3		;ADR OF FIRST WRD OF FRST 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	;END OF TABLE?				[EDIT#311]
	SKIPN	(AC10)		;NULL ENTRY?				[EDIT#311]
	JRST	IBSLT		;YES, GO OTHER WAY

	JRST	@ICMP(I12)	;DO THE COMPARISON
	;RETURNS ARE IBSGE OR IBSLT

IBSLT:	LSH	AC5,-1		;HALF THE INC
	CAMGE	AC5,IESIZ(I12)	;BEG OF TABLE?
	JRST	IBS10		;YES, DONE
	SUB	AC4,AC5		;CURRENT ENTRY MINUS INC
	JRST	IBS2		;

IBS100:	MOVE	AC4,AC10	;AC10 HAS ENTRY FROM GE
IBS10:	MOVEM	AC4,@CNTRY0(I12)  ;ADR OF CURRENT ENTRY
	SETZM	@NNTRY0(I12)	;SO 'SREAD' WILL WORK IF IT'S NEXT
	SOJG	LVL,IBS0	;GO AGAIN DOWN A LEVEL
	JRST	DSRCH		;LEVEL ZERO, EXIT SEARCH ROUTINE
	;INDEX DISPLAY NON-NUMERIC COMPARE
ICDNN:	MOVE	AC1,IKWCNT(I12)	;-CNT ,, ADR OF IAK
	MOVEI	AC2,2(AC10)	;INDEX ENTRY
ICDNN1:	MOVE	AC0,(AC2)	;INDEX ENTRY
	CAME	AC0,(AC1)	;SYM-KEY = IDX-KEY
	JRST	ICDNN2		;NOT EQUAL
	ADDI	AC2,1		;NEXT
	AOBJN	AC1,ICDNN1	;LOOP IF YOU CAN
	JRST	IBSGE		;EQUAL RETURN
ICDNN2:	MOVE	AC3,(AC1)	;SYM-KEY
	TLC	AC0,1B18	;
	TLC	AC3,1B18	;
	CAMG	AC0,AC3		;
	JRST	IBSGE		;SYM-KEY GT IDX-KEY
	JRST	IBSLT		;SYM-KEY LT IDX-KEY


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

	;TWO WORD SIGNED
IC2S:	MOVE	AC0,@IAKBP(I12)	;SYM-KEY
	CAMGE	AC0,2(AC10)	;
	JRST	IBSLT		;SYM-KEY LT IDX-KEY
	CAME	AC0,2(AC10)	;
	JRST	IBSGE		;SYM-KEY GT IDX-KEY
	MOVE	AC0,@IAKBP1(I12)  ;NEXT WRD
	CAMGE	AC0,3(AC10)	;
	JRST	IBSLT		;SK LT IK
	JRST	IBSGE		;SK EQ OR GT IK

	;ONE WORD UNSIGNED
IC1U:	MOVM	AC0,@IAKBP(I12)	;SK
	MOVM	AC1,2(AC10)	;IK
	CAMGE	AC0,AC1		;
	JRST	IBSLT		;SK LT IK
	JRST	IBSGE		;SK EQ OR GT IK

	;TWO WORD UNSIGNED
IC2U:	MOVM	AC0,@IAKBP(I12)	;SK
	MOVM	AC1,2(AC10)	;IK
	CAMGE	AC0,AC1		;
	JRST	IBSLT		;SK LT IK
	CAME	AC0,AC1		;
	JRST	IBSGE		;SK GT IK
	MOVM	AC0,@IAKBP1(I12)	;
	MOVM	AC1,3(AC10)	;
	CAMGE	AC0,AC1		;
	JRST	IBSLT		;SK LT IK
	JRST	IBSGE		;SK EQ OR GT IK
	;SEACH FOR A DATA FILE KEY 
DSRCH:	MOVE	AC0,(AC4)	;GET THE BLOCK NUMBER
	JUMPN	AC0,DSRCH1	;IS IT ZERO ?
	TLNN	AC16,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)	;FIRST KEY,FIRST REC			[EDIT#276]
	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)
	TLNN	AC16,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:	TLNE	AC16,WRITE	;
	JRST	IWIVK		;WRITE INVALID-KEY
DSXIT:	SUB	AC4,DBPRK(I12)	;DATA BYTE-POINTER TO RECORD KEY	[EDIT#276]
DSXIT1:	MOVEM	AC4,CNTRY(I12)	;
	SETZM	NNTRY(I12)	;SO SREAD WILL GET "NEXT" RECORD
	POPJ	PP,

DSLT:	TLNE	AC16,WRITE	;
	JRST	DSXIT		;NORMAL IWRITE EXIT
	SUB	AC4,DBPRK(I12)	;DATA BYTE-POINTER TO RECORD KEY	[EDIT#276]
	JRST	RRDIVK		;READ, RERIT, DELETE INVALID-KEY

	;NO RECORDS IN THIS DATA BLOCK
DSNUL:	TLNE	AC16,WRITE	;
	JRST	DSXIT1
	JRST	RRDIVK
	;CALL IS:	JRST @DCMP(I12)
	;RETURNS:	DSGT OR DSEQ OR DSLT

	;CONVERT NUMERIC DISPLAY TO 1 OR 2 WRD INTEGER
DGD67:	MOVE	AC0,[XWD AC4, ACSAV0+4]  ;
	BLT	AC0,ACSAV0+16	;SAVE ACS
	HRRM	AC10,GDPRK(I12)  ;POINT AT CURRENT DATA KEY
	MOVE	AC16,[Z AC2,GDPRK]  ;PARAMETER
	ADD	AC16,I12	;INDEX IT
	PUSHJ	PP,@GDX.D(I12)	;CONVERT, GD6. OR GD7.
	MOVE	AC0,[XWD ACSAV0+4, AC4]  ;
	BLT	AC0,AC16	;
	MOVEI	AC10,2		;POINT AT CONVERTED DATA
	JRST	@DCMP1(I12)	;OFF TO COMPARISION ROUTINE

	;DATA DISPLAY NON-NUMERIC COMPARE
DCDNN:	MOVE	AC1,DKWCNT(I12)	;-CNT ,, DAKBP
	MOVE	AC0,FWMASK(I12)	;FIRST WRD MASK
	JUMPE	AC0,DCDNN2	;JUMP ONLY ONE WRD
	AND	AC0,(AC10)	;REC-KEY
	JRST	.+2
DCDNN1:	MOVE	AC0,(AC10)	;REC-KEY
	CAME	AC0,(AC1)	;
	JRST	DCDNN3		;NOT EQ
	ADDI	AC10,1		;NEXT
	AOBJN	AC1,DCDNN1	;
DCDNN2:	MOVE	AC0,LWMASK(I12)	;LAST WRD MASK
	AND	AC0,(AC10)	;
	CAMN	AC0,(AC1)	;
	JRST	DSEQ		;SYM-KEY EQ REC-KEY
DCDNN3:	MOVE	AC3,(AC1)	;
	TLC	AC0,1B18	;
	TLC	AC3,1B18	;
	CAMG	AC0,AC3		;
	JRST	DSGT		;SYM-KEY GT REC-KEY
	JRST	DSLT		;SYN-KEY LT REC-KEY

	;DATA, ONE WRD SIGNED
DC1S:	MOVE	AC0,@DAKBP(I12)	;
	CAMGE	AC0,(AC10)	;
	JRST	DSLT		;SK LT RK
	CAME	AC0,(AC10)	;
	JRST	DSGT		;SK GT RK
	JRST	DSEQ		;SK EQ RK

	;DATA, TWO WRD SIGNED
DC2S:	MOVE	AC0,@DAKBP(I12)	;
	CAMGE	AC0,(AC10)	;
	JRST	DSLT		;SK LT RK
	CAME	AC0,(AC10)	;
	JRST	DSGT		;SK GT RK
	MOVE	AC0,@DAKBP1(I12);
	CAMGE	AC0,1(AC10)	;
	JRST	DSLT		;SK LT RK
	CAME	AC0,1(AC10)	;
	JRST	DSGT		;SK GT RK
	JRST	DSEQ		;SK EQ RK

	;DATA, ONE WRD UNSIGNED
DC1U:	MOVM	AC0,@DAKBP(I12)	;
	MOVM	AC1,(AC10)	;
	CAMGE	AC0,AC1		;
	JRST	DSLT		;SK LT RK
	CAME	AC0,AC1		;
	JRST	DSGT		;SK GT RK
	JRST	DSEQ		;SK EQ RK

	;DATA, TWO WRD UNSIGNED
DC2U:	MOVM	AC0,@DAKBP(I12)	;
	MOVM	AC1,(AC10)	;
	CAMGE	AC0,AC1		;
	JRST	DSLT		;SK LT RK
	CAME	AC0,AC1		;
	JRST	DSGT		;SK GT RK
	MOVM	AC0,@DAKBP1(I12);
	MOVM	AC1,1(AC10)	;
	CAMGE	AC0,AC1		;
	JRST	DSLT		;SK LT RK
	CAME	AC0,AC1		;
	JRST	DSGT		;SK GT RK
	JRST	DSEQ		;SK EQ RK
	;GET A BLOCK, MAYBE THE TOP-BLOCK & CHECK VERSION NOS
GETOP:	MOVE LVL,MXLVL(I12)	;NOTE ITS TOP LVL
	SKIPA	AC1,TOPIBN(I12)	;THE BLOCK NO.

GETBLK:	MOVE	AC1,(AC4)	;NEXT BLKNO
	MOVE	AC2,@IOWRD0(I12)  ;CURRENT IOWRD
	MOVEM	AC2,CMDLST	;SET THE IOWD
	CAMN	AC1,@USOBJ0(I12)  ;IN CORE?
	JRST	GETB0A		;YES
GETB0E:	JUMPE	LVL,GETB0C	;JUMP IF DATA FILE
	XCT	ISETI		;INDEX FILE
	XCT	IIN		;[IN CH,CMDLST]
GETB1E:	SKIPA	AC2,2(AC2)	;GET NEW VERSION NO.
	  JRST	GBIER		;INPUT ERROR
GETB0D:	MOVEM	AC1,@USOBJ0(I12)  ;BLKNO TO USOBJ(I12)
	SKIPE	LVL		;DATA BLOCK ALWAYS HAS VERSION NO.
	CAME	AC1,TOPIBN(I12)	;TOPBLOCK HAS NO VERSION NO.
	CAMN	AC2,1(AC4)	;SAME VERNO?
	POPJ	PP,		;YES
	JRST	GETB0B		;VERSION ERROR

	;IGNORE THIS INDEX FILE INPUT ERROR?
GBIER:	MOVE	AC0,[E.MINP+E.FIDX+E.BIDX]	;NOTE IT WAS AN INPUT ERROR
	PUSHJ	PP,IGMI		;IGNORE THIS ERROR?
	 JRST	IINER		;NO, GIVE AN ERROR MESSAGE
	PUSHJ	PP,CLRIS	;YES, CLEAR THE INDEX FILE STATUS BITS
	JRST	GETB1E		;  AND IGNORE THE ERROR.

GETB0A:	TLNE	FLG1,RIVK!VERR	;FORCE INPUT?
	JRST	GETB0E		;YEP
	JUMPE	LVL,GETB0F	;LEVEL 0 IS A DATA FILE
	MOVE	AC2,2(AC2)	;
	CAME	AC1,TOPIBN(I12)	;TOP-BLOCK HAS NO VERNO
	CAMN	AC2,1(AC4)	;
	POPJ	PP,

GETB0B:	MOVEI	AC1,@USOBJ0(I12);GET ADR OF THIS LEVEL'S BLOCK #
	MOVE	AC1,1(AC1)	;GET BLOCK # OF PRECEDING LEVEL
	MOVEM	AC1,FS.BN	;SAVE THE OFFENDING BLOCK NUMBER
	TLNE	FLG1,SEQ	;SEQ READ?
	JRST	UDVERR		;SPECIAL CASE
	TLON	FLG1,VERR	;FIRST OR SECOND ERROR?
	JRST	IBSTOP		;FIRST, SO TRY AGAIN
	PUSHJ	PP,VNDE		;IF TOP BLOCK WAS SPLIT TRY AGAIN	[EDIT#307]
	  JRST	GBVER		;NO - SO ERROR MESSAGE AND QUIT		[EDIT#307]
	JRST	IBSTOP		;YES - TRY ONE MORE TIME		[EDIT#307]

	;IGNORE THIS ERROR?
GBVER:	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDA+E.BDAT+^D4]	;ERROR NUMBER
	CAIE	LVL,0		;SKIP IF DATA BLOCK
	MOVE	AC0,[E.FIDX+E.BIDX+^D4]	;ERROR NUMBER
	PUSHJ	PP,IGCV		;IGNORE ERROR?
	 JRST	GETB0G		;NO -- GIVE A ERROR MESSAGE
	POPJ	PP,		;YES -- TAKE A NORMAL EXIT

GETB0G:	TTCALL	3,[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:	XCT	USETI.	
	HRRI	AC0,CMDLST
	HRRM	AC0,UIN.
	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:	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

;[307] GETB0F+6 20-DEC-73
	;HERE ON "VERSION NUMBER DISCREPANCY ERROR"			[EDIT#307]
	; SEE IF THERE ARE MORE INDEX LEVELS THAN THE READER KNOWS ABOUT [EDIT#307]
	; I.E. WHEN A WRITER SPLITS THE TOP BLOCK AND CREATES A NEW	[EDIT#307]
	; INDEX LEVEL.							[EDIT#307]
	; IF SO GET ANOTHER BUFFER TO ACCOMMODATE THE NEW INDEX LEVEL(S) [EDIT#307]
	; AND TRY AGAIN.						[EDIT#307]
	; POPJ IF	OPNOUT OR NO NEW INDEX LEVEL OR SORT IN PROGRESS [EDIT#307]
	;		OR NO MORE CORE.				[EDIT#307]
	; ELSE TAKE A SKIP EXIT -- TRY AGAIN.				[EDIT#307]

VNDE:	TLZE	FLG1,TRYAGN	;BEEN HERE BEFORE ?			[EDIT#307]
	POPJ	PP,		;YES - CAN'T HELP			[EDIT#307]
	TLO	FLG1,TRYAGN	;REMEMBER YOU'VE BEEN HERE		[EDIT#307]

	; ENTRY POINT TO READ FRESH COPY OF STS BLOCK
VNDE1:	PUSHJ	PP,RSTBK	;NO - GET FRESH COPY OF STATISTICS BLOCK [EDIT#307]
	MOVN	AC5,MXLVL(I12)	;SEE IF SOMEONE HAS CREATED		[EDIT#307]
	SUB	AC5,OMXLVL(I12)	;  A NEW INDEX LEVEL			[EDIT#307]
	JUMPE	AC5,RET.1	;  EXIT HERE IF NOT			[EDIT#307]

	HRRZ	AC1,ISPB(I12)	;BUILD AN IOWRD IN AC6			[EDIT#307]
	IMULI	AC1,200		;  AND GET THE LENGTH IN AC1		[EDIT#307]
	MOVN	AC6,AC1		;  --					[EDIT#307]
	HRLZS	AC6		;  --					[EDIT#307]
	HRR	AC6,.JBFF	;  --					[EDIT#307]
	SUBI	AC6,1		;  --.					[EDIT#307]

	MOVEI	AC4,IOWRD+1(I12);GET LOCATION OF THE FIRST		[EDIT#307]
	SUB	AC4,OMXLVL(I12)	;  UNUSED IOWRD POINTER			[EDIT#307]
	HRL	AC4,AC5		;# OF NEW IOWRD'S REQUIRED		[EDIT#307]

VNDE10:	SKIPE	(AC4)		;IF IOWRD ALREADY EXIST			[EDIT#307]
	JRST	VNDE20		;  TRY TO LOOP				[EDIT#307]
	SKIPE	KEYCV.		;IF SORT IN PROGRESS			[EDIT#307]
	POPJ	PP,		;  QUIT -- CAN'T HANDLE THAT		[EDIT#307]
	HRRZ	AC0,AC1		;LENGTH OF THE BUFFER AREA		[EDIT#307]
	PUSHJ	PP,GETSPC	;GET SOME SPACE				[EDIT#307]
	  POPJ	PP,		;  NONE LEFT				[EDIT#307]
	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)	;MAKE A NEW IOWRD			[EDIT#307]
	ADD	AC6,AC1		;  AND SET UP FOR NEXT ONE		[EDIT#307]
VNDE20:	AOBJN	AC4,VNDE10	;LOOP IF MORE LEVELS			[EDIT#307]
;[V10]	MOVN	AC0,MXLVL(I12)	;UPDATE OMXLVL				[EDIT#307]
;[V10]	MOVEM	AC0,OMXLVL(I12)	;  AND THEN				[EDIT#307]
	JRST	RET.2		;TAKE SKIP EXIT + TRY AGAIN		[EDIT#307]

VNDERR:	EXCH	AC1,.JBFF	;FIRST GET OUT 
	SUBM	AC1,.JBFF	; OF OVL-AREA
	MOVEI	AC0,^D30	;PERMANENT ERROR
	MOVEM	AC0,FS.FS	;LOAD FILE-STATUS
	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+^D35];IDX-FLAG TOO
	PUSHJ	PP,OXITP	;DONT RET IF IGNORING ERRORS
	XCT	WOVLRX		;GIVE MESSAGE
	JRST	GETB0G		;FINISH UP
	;MARK THIS BLOCK SO IT WILL BE OUTPUT
WDBK:	SETOM	LIVE(I12)	;MARK IT
	SKIPE	BRISK(I12)	;SKIP IS SLOW BUT SAFE
	POPJ	PP,

	;WRITE A DATA BLOCK
WWDBK:	MOVE	AC1,USOBJ(I12)	;
	MOVE	AC0,IOWRD(I12)	;
WWDBK1:	MOVEI	AC2,CMDLST	;
	HRRM	AC2,UOUT.	;
	MOVEM	AC0,CMDLST	;
	SETZM	LIVE(I12)	;CLEAR THE LIVE FLAG
	AOS	IOUUOS(I12)	;
	XCT	USETO.		;
	XCT	UOUT.		;
	 JRST	.+2		;
	PUSHJ	PP,WDBER	;OUTPUT ERROR
	HLLZS	UOUT.		;
	POPJ	PP,

	;DATA FILE IO ERROR
WDBER:	MOVE	AC0,[E.MOUT+E.FIDA+E.BDAT];ERROR NUMBER
	PUSHJ	PP,IGMD		;IGNORE THIS ERROR?
	 JRST	UOUTER		;NO -- GIVE A ERROR MESSAGE
	JRST	CLRDS		;YES, CLEAR STATUS BITS

	;WRITE AN INDEX BLOCK
WIBK:	MOVE	AC1,@USOBJ0(I12)
	MOVE	AC0,@IOWRD0(I12)
WIBK1:	MOVEM	AC0,CMDLST	;
	AOS	IOUUOS(I12)	;
	XCT	ISETO		;
	XCT	IOUT		;
	 POPJ	PP,		;
WIBK2:	CAMN	AC0,IOWRD+13(I12);SAT BLOCK?
	MOVE	AC0,[E.BSAT]	;YES
	CAMN	AC0,IOWRD+14(I12);STATISTICS BLOCK?
	MOVE	AC0,[E.BSTS]	;YES
	CAIG	AC0,0		;NONE OF THE ABOVE?
	MOVE	AC0,[E.BIDX]	;MUST BE INDEX BLOCK
	ADD	AC0,[E.MOUT+E.FIDX];OUTPUT ERROR
	PUSHJ	PP,IGMI		;IGNORE ERROR?
	 JRST	IOUTER		;NO
	JRST	CLRIS		;CLEAR STATUS BITS AND RETURN

	;WRITE A SAT BLOCK
WSBK:	MOVE	AC1,USOBJ+13(I12)
	MOVE	AC0,IOWRD+13(I12)
	JRST	WIBK1		;

	;WRITE AUXILARY BLOCK
WABK:	MOVE	AC1,AUXBNO
	MOVE	AC0,AUXIOW
	HLL	AC0,IOWRD(I12)
	JUMPE	LVL,WWDBK1
	HLL	AC0,IOWRD+1(I12)
	JRST	WIBK1

	;WRITE STATISTICS BLOCK
WSTBK:	MOVEI	AC1,1
	MOVE	AC0,IOWRD+14(I12)
	JRST	WIBK1

	;READ A STATISTICS BLOCK
RSTBK:	MOVEI	AC1,1			;[EDIT#307]
	MOVE	AC2,IOWRD+14(I12)	;[EDIT#307]
	MOVEM	AC2,CMDLST		;[EDIT#307]
	XCT	ISETI			;[EDIT#307]
	XCT	IIN			;[EDIT#307]
	 POPJ	PP,			;[EDIT#307]
	MOVE	AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER
	PUSHJ	PP,IGMI4	;IGNORE THE ERROR?
	 JRST	RSTBK1		;NO
	PUSHJ	PP,CLRIS	;CLEAR STATUS BITS
	TLNN	AC16,READ	;IF NOT IREAD OR SREAD
	JRST	RET.2		;  SKIP EXIT ELSE
	POPJ	PP,
RSTBK1:	TTCALL	3,[ASCIZ /CANNOT READ STATISTICS BLOCK/]	;[EDIT#307]
	JRST	IINER			;[EDIT#307]

	;READ A SAT BLOCK
RSBK:	MOVEM	AC1,USOBJ+13(I12)
	MOVE	AC2,IOWRD+13(I12)
	MOVEM	AC2,CMDLST
	AOS	IOUUOS(I12)
	XCT	ISETI
	XCT	IIN
	 POPJ	PP,
	MOVE	AC0,[E.MINP+E.FIDX+E.BSAT] ;ERROR NUMBER
	PUSHJ	PP,IGMI2	;IGNORE ERROR?
	 JRST	RSBK1		;NO
	PUSHJ	PP,CLRIS	;CLEAR STATUS BITS
	JRST	RET.2		;TAKE A NORMAL EXIT
RSBK1:	TTCALL	3,[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
	TRZ	AC2,760000	;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
	TRZ	AC2,760000	;TURN EM OFF
	XCT	USETS.		; AND RESET THEM
	JRST	CLRIS1

	;MOVE BUFFER TO RECORD  (READ)
MOVBR:	LDB	AC0,F.BMRS	;MAX-REC-SIZ
	MOVE	AC6,RECBP(I12)	;REC BYTE-POINTER
;[V10]	MOVE	AC4,CNTRY(I12)	;POINTE TO DATA
	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
	CAMGE	AC0,AC3
	PUSHJ	PP,ERRMR0	;THE RECORD SIZE IS TOO BIG!
	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
;[335]	SOJE	AC3,RET.1
	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
IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
	PUSHJ	PP,LRDEQX##	; YES
	>
	POPJ	PP,

	;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
;[V10]	JUMPE	AC2,.+2
;[V10]	ADDI	AC1,1
;[V10]	HRLI	AC0,(AC4)	;FROM
;[V10]	HRR	AC0,AC6		;TO
;[V10]	ADDI	AC1,-1(AC6)	;UNTIL
;[V10]	BLT	AC0,(AC1)	;ZRAPPP!

;[V10] BLT ONLY THE FULL WORDS OF DATA AND THEN MOVE THE REST
;[V10]  CHARACTER BY CHARACTER.

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

BLTB8:	;[V10]

IFE	%%RPG,<
	SKIPE	F.WSMU(I16)	; SIMULTANEOUS - UPDATE?
	PUSHJ	PP,LRDEQX##	; YES
	>
	POPJ	PP,
	;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.	;
	CAMGE	AC0,AC3		;IS RECORD LEGAL SIZE?
	PUSHJ	PP,ERRMR0	;NO -- TOO BIG
	TLNN	FLG,CONNEC!DDMASC!DDMBIN
	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:	TLNE	AC16,DELET	;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:	TLNE	AC16,DELET	;DELETING?
	JRST	SHFR20		;YES
	TLNN	AC16,WADV!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)	;
	SKIPLE	D.RCL(I16)	;LAST REC THIS BLOCK?
	SETZM	1(AC2)		;NO, MAKE ZERO NEXT REC SIZ
	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
	JUMPE	AC0,RET.1	;ZERO = OLD-REC IS LAST-REC
	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]
	HRLI	AC6,(POPJ PP,)
	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)	;
	POPJ	PP,

	;SETUP TO DELETE A REC
SHFR20:	MOVNI	AC1,(AC3)	;RECSIZ + HEADER
	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
	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	;INIT THIS FLAG			[EDIT#307]
	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	;JUMP IF FOUND				[EDIT#271]

	;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)	;# OF SAT BLOCKS			[EDIT#271]
	SUBI	AC0,1		;ADJUST COUNT				[EDIT#271]
	IMUL	AC0,ISPB(I12)	;TIMES # SECTORS / SAT			[EDIT#271]
	ADD	AC0,SBLOC(I12)	;PLUS FIRST BLOCK #			[EDIT#271]
	CAMG	AC0,USOBJ+13(I12)  ;IS THERE A NEXT ONE?
	JRST	ALC20		;NO, TRY AGAIN, SEE IF ANY WERE DELETED
	TLZE	FLG1,WSB	;WRITE OUT THE SAT-BLK?			[EDIT#310]
	PUSHJ	PP,WSBK		;YES
	MOVE	AC1,ISPB(I12)	;SECTORS / SAT				[EDIT#271]
	ADDB	AC1,USOBJ+13(I12)  ;NEW USETI/O POINTER			[EDIT#271]
	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	;
	SUBI	AC0,-1(AC1)	;
	MOVE	AC1,USOBJ+13(I12)
	SUB	AC1,SBLOC(I12)	;
	PUSH	PP,AC2		;NEED TO SAVE AC2			[EDIT#271]
	IDIV	AC1,ISPB(I12)	;/ NUMBER OF SECTORS PER SAT		[EDIT#271]
	POP	PP,AC2		;...					[EDIT#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
	HRRZM	AC0,NEWBK1	;SAV THE FIRST BLKNO
	TLZN	FLG1,BLK2	;A TWO BLOCK REQ?
	JRST	WSBK		;ALLOCATE! WRITE OUT THE SAT BLOCK
	HRRZM	AC0,NEWBK2	;
	JRST	ALC07		;GO FOR NEXT ONE

	;START AT BEGINNING AND SEE IF ANY WERE DELETED
ALC20:	TLON	FLG1,TRYAGN	;FIRST RETRY?
	JRST	ALC01		;YES, TRY AGAIN
	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+E.BSAT+^D5]	;ERROR NUMBER
	PUSHJ	PP,IGCVR1	;IGNORE ERROR?
	  JRST	RET.2		;YES, RETURN TO CBL-PRGM.
	TTCALL	3,[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)	;TIMES SECTORS / SAT			[EDIT#271]
	ADD	AC1,SBLOC(I12)	;ABSOLUTE
	MOVEM	AC2,AC3		;SAVE RELATIVE BIT POSITION IN SATBLK
	CAME	AC1,USOBJ+13(I12)  ;IS IT IN CORE?
	PUSHJ	PP,RSBK		;NO,GO GET IT
	MOVEM	AC1,USOBJ+13(I12)  ;MAKE THIS BLK CURRENT
	IDIVI	AC3,^D36	;RELATIVE WORD POSITION
	ADD	AC3,IOWRD+13(I12)  ;ABSOLUTE WORD POSITION -2
	MOVN	AC4,AC4		;ROTATE TO THE RIGHT
	MOVEI	AC0,1		;THE MASK
	ROT	AC0,(AC4)	;
	SKIPN	AC4		;IF REMAINDER = 0
	SUBI	AC3,1		;  BACKUP A WORD
	ANDCAM	AC0,2(AC3)	;MARK IT FREE
	TLZ	FLG1,WSB
	SETZM	OLDBK		;
	JRST	WSBK
	;SETUP RECORD HEADER WORD
SRHW:	MOVE	AC4,CNTRY(I12)
	MOVE	AC1,IOWRD(I12)
	MOVE	AC1,1(AC1)
	MOVEM	AC1,-1(AC4)	;SET VERSION NUMBER & BIT35
	LDB	AC1,WOPRS.
	JUMPGE	FLG,SRHW1	;ASCII?
	ADDI	AC1,2		;ADD 2 FOR CR + LF
	MOVEI	AC0,1		;ASCII FLAG, BIT 35
	ORM	AC0,-1(AC4)	;
SRHW1:	DPB	AC1,RSBP(I12)	;THE RECORD SIZE IN CHARS
	POPJ	PP,

	;LOW-VALUE TEST
	;POPJ IF SYMKEY = LOW-VALUES, SKIP EXIT IF NOT
LVTST:	HLRZ	I12,D.BL(I16)	;SETUP I12
	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 ?
	JRST	RET.2		;NO
	TRNE	AC3,1		;TWO WORDS ?
	POPJ	PP,		;NO, EXIT
	CAME	AC2,1(AC1)	;LV ?
	JRST	RET.2		;NO
	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
	JUMPE	AC0,LVC310	; JUMP IF NOT SIGNED

	; HERE IF A SIGNED COMP3
	; LOW-VALUES = A SRTING OF 9'S FOLLOWED BY A SIGN
	SOJE	AC2,LVC302	; JUMP IF ONLY ONE BYTE
	ILDB	AC0,AC1		; GET FIRST TWO DIGITS
	TLNN	AC3,1		; IF ONLY ONE DIGIT IN THIS BYTE
	DPB AC0,[POINT 4,AC0,31]; DUPLICATE IT
	JRST	.+2		; SKIP INTO MAIN LOOP

LVC301:	ILDB	AC0,AC1		; GET NEXT TWO DIGITS
	CAIE	AC0,9B31+9B35	; LOW-VALUES?
	JRST	RET.2		; NO EXIT
	SOJG	AC2,LVC301	; LOOP

LVC302:	ILDB	AC0,AC1		; GET THE LAST BYTE
	CAIE	AC0,9B31+15B35	; 9 AND MINUS SIGN?
	CAIN	AC0,9B31+13B35	; THERE ARE TWO MINUS SIGNS
	POPJ	PP,		; LOW-VALUE RETURN
	JRST	RET.2		; NOT LV RET

	; HERE IF A UNSIGNED COMP3
	; LOW-VALUES = A SRTING OF 0'S FOLLOWED BY A SIGN
LVC310:	SOJE	AC2,LVC312	; JUMP IF ONLY ONE BYTE
	TLNN	AC3,1		; IF ONLY ONE DIGIT IN THIS BYTE
	JRST	LVC311		; SKIP INTO MAIN LOOP
	ILDB	AC0,AC1		; GET FIRST TWO DIGITS
	TRZA	AC0,360		; ZERO LEADING DIGIT

LVC311:	ILDB	AC0,AC1		; GET NEXT TWO DIGITS
	JUMPN	AC0,RET.2	; JUMP IF NOT LV
	SOJG	AC2,LVC311	; LOOP

LVC312:	ILDB	AC0,AC1		; GET THE LAST BYTE
	TRZ	AC0,17		; FORGET ABOUT THE SIGN
	JUMPN	AC0,RET.2	; JUMP IF NOT LV
	POPJ	PP,		; LOW-VALUE RETURN
	;INDEX FILE INPUT ERROR
IINER:	XCT	IGETS		;GET STATUS TO AC2
	TRNE	AC2,20000	;EOF?
	TTCALL	3,[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
	TRNE	AC2,20000	;EOF?
	TTCALL	3,[ASCIZ /FOUND AN EOF INSTEAD OF DATA BLOCK/]
	JRST	IINER1		;MESSAGE AND KILL

LVSKER:	TLNE	AC16,RERIT
	TTCALL	3,[ASCIZ /REWRITE, /]
	TLNE	AC16,DELET
	TTCALL	3,[ASCIZ /DELETE, /]
	TLNE	AC16,WRITE
	TTCALL	3,[ASCIZ /WRITE, /]
	TTCALL	3,[ASCIZ /SYMBOLIC-KEY MUST NOT EQUAL LOW-VALUES/]
	HRLZI	AC2,(BYTE (5) 10,31,20)
	PUSHJ	PP,MSOUT.	;KILL & DON'T RETURN

	;SEE IF THIS MESSAGE SHOULD BE IGNORED
LVERR:	SETOM	FS.IF		;IDX FILE
	MOVE	AC0,[E.FIDX+^D1]	;LOW-VALUES ILLEGAL
	PUSHJ	PP,IGCV		;FATAL ERROR OR IGNORE ERROR?
	 JRST	LVSKER		;FATAL!
	JRST	RET.2		;DONT PROCESS THIS VERB
				;JUST RETURN TO CBL-PRGM

	;INDEX FILE OUTPUT ERROR
IOUTER:	XCT	IWAIT
	XCT	IGETS
	TRNN	AC2,740000
	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
>
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
	TRNE	AC2,400000	;IMPROPER MODE?
	MOVEI	AC1,^D18
	TRNE	AC2,200000	;DEVICE ERROR
	MOVEI	AC1,^D19
	TRNE	AC2,100000	;DATA ERROR
	MOVEI	AC1,^D20
	TRNE	AC2,040000	;QUOTA EXCEEDED, FILE STR, OR RIB FULL
	MOVEI	AC1,^D21
	TRNE	AC2,020000	;EOF
	MOVEI	AC1,^D22
	ADD	AC0,AC1
	MOVEI	AC3,^D34	;ASSUME DSK FULL
	TRNE	AC2,040000	;IS IT?
	JRST	IGMD2		;YES
	SKIPN	AC3,FS.FS	;NO CHANGE IF NON ZERO
	MOVEI	AC3,^D30	;PERMANENT ERROR
IGMD2:	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:	TLNE	AC16,OPEN
	ADD	AC0,[EXP E.VOPE]
	TLNE	AC16,CLOSEF!CLOSER!CLOSEB
	ADD	AC0,[EXP E.VCLO]
	TLNE	AC16,WADV!WRITE
	ADD	AC0,[EXP E.VWRI]
	TLNE	AC16,RERIT
	ADD	AC0,[EXP E.VREW]
	TLNE	AC16,DELET
	ADD	AC0,[EXP E.VDEL]
	TLNE	AC16,READ
	ADD	AC0,[EXP E.VREA]
	;FALL THROUGH TO IGTST

	;BUT FIRST INCLUDE FILE TYPE IN ERROR STATUS
	TLNE	FLG,SEQFIL	;SEQUENTIAL?
	ADD	AC0,[E.FSEQ]	;YES
	TLNE	FLG,RANFIL	;RANDOM?
	ADD	AC0,[E.FRAN]	;YES
	MOVEM	AC0,FS.EN	;SAVE THE ERROR-NUMBER

	;AND THEN SETUP SEQ/IO FILE FS.BN AND FS.RN
IGBNRN:	TLNE	AC16,OPEN	;OPEN?
	JRST	IGSS		;YES
	TLNE	FLG,OPNIO	;IO-FILE?
	TLNN	FLG,SEQFIL	;SEQ-FILE?
	JRST	IGBNR1		;NOT SEQ-IO FILE.
	MOVE	AC3,D.IE(I16)	;NUMBER OF INPUTS EXECUTED
	IMUL	AC3,D.BPL(I16)	;TIMES BUFFERS/BLOCK
	SUB	AC3,D.BPL(I16)	;MINUS BUFFERS/BLOCK
	ADDI	AC3,1		;PLUS ONE
	SKIPG	AC3		;UNLESS ITS NEGATIVE
	SETZM	AC3		;WHICH MEANS NONE WERE DONE
	MOVEM	AC3,FS.BN	;SAVE THE BLOCK-NUMBER
	MOVE	AC3,D.RP(I16)	;RECORDS PROCESSED SO FAR
	ADDI	AC3,1		;BRING IT UP TO DATE
	MOVEM	AC3,FS.RN	;AND SAVE IT AWAY
	JRST	IGSS		;

	;SETUP SEQUENTIAL FILE BLOCK AND RECORD NUMBERS
IGBNR1:	TLNN	FLG,SEQFIL	;SEQ FILE?
	JRST	IGSS		;NO
	SKIPN	AC3,D.IE(I16)	;GET NUMBER OF INPUTS
	MOVE	AC3,D.OE(I16)	; OR OUTPUTS EXECUTED.
	MOVEM	AC3,FS.BN	;AND SAVE IT.
	MOVE	AC3,D.RP(I16)	;GET THE RECORD NUMBER
	ADDI	AC3,1		;UPDATE THE COUNT
	MOVEM	AC3,FS.RN	;AND SAVE IT.

	;HERE TO SETUP THE STATUS WORDS
IGSS:	SKIPN	AC1,F.WPFS(I16)		;GET FILE-STATUS POINTER
	JRST	IGTST			;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	IGTST			;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	IGTST			;DONE IF NO POINTER
	SETZM	(AC1)			;ZERO THE ACTION CODE

	MOVE	AC2,F.WPID(I16)		;GET VALUE-OF-ID POINTER
	JUMPE	AC2,IGTST		;DONE IF NO POINTER
IFN ISAM,<
	HLRZ	I12,D.BL(I16)		;RESTORE I12
	HRRI	AC1,DFILNM(I12)		;ADR OF IDA-FILE NAME
	HRLI	AC1,440600		;NOW ITS AN INPUT BYTE-PTR
	MOVE	FLG,-7(PP)		;RESTORE FLG
	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	IGTST			;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	IGTST			;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	IGTST			;DONE IF NONE
	MOVE	AC1,I16			;GET FILE-TBL FILE-NAME POINTER
	HRLI	AC1,440600		;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

	;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:	SKIPE	FS.IGE		;ANY ERRORS IGNORED YET?
	JRST	IGTST2		;YES - IGNORE ALL FOR DURATION OF THIS VERB
	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-PRO 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

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
IFE	%%RPG,<
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

	SKIPN	KEYCV.		; ARE WE SORTING?
	JRST	RRDMP7		; NO
	PUSHJ	PP,RRERR0	; COMPLAIN
	TTCALL	3,[ASCIZ / SORT IN PROGRESS.
/]
	JRST	RRXIT		; AND EXIT
RRDMP7:	SKIPN	OVRFN.		;IF OVERLAY FILE IS OPEN
	JRST	RRDMP6		;
	PUSHJ	PP,RRERR0	;    ABORT -- CHANNEL 1 IS IN USE
	TTCALL	3,[ASCIZ/ OVERLAY/]
	JRST	RRDMP9		;

RRDMP6:	CALLI	AC0,51		;SYSPHY UUO ;XIT IF LEVEL C
	JRST	RSTAC1		;EXIT
	HRRZ	AC16,FILES.	;POINT TO FIRST FILE TABLE
	SKIPA
RRDMP1:	HRRZ	AC16,F.RNFT(I16);POINTER TO NEXT FILE-TABLE
	JUMPE	AC16,RRDMP2	;
	MOVE	AC13,D.DC(I16)	;DEVCHR TO 13
	MOVE	FLG,F.WFLG(I16)	;FLAGS TO FLG
	TLC	FLG,OPNIN!OPNOUT
	TLCE	FLG,OPNIN!OPNOUT
	JRST	RRDMP5		;
RRDMP0:	PUSHJ	PP,RRERR0	;"DUMP ABORTED"
	TTCALL	3,[ASCIZ / IO/]
	JRST	RRDMP9		;EXIT, NO DUMP

	;SCAN FOR OPEN OUTPUT FILES
RRDMP2:	HRRZ	AC16,FILES.	;FIRST FILE-TABLE
	SKIPA
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:	TLNN	FLG,OPNOUT	;SKIP IF OPEN FOR OUTPUT
	JRST	RRDMP3		;LOOP
	MOVE	AC13,D.DC(I16)	;DEVCHR
	TLC	AC13,300000	;[321];IF IT'S A DSK AND A CARD READER
	TLCE	AC13,300000	;[321];  IT'S THE NULL DEVICE - SO SKIP
	TLNN	AC13,200020	;SKIP IF DSK OR MTA
	JRST	RRDMP3		;
	PUSHJ	PP,SETCN.	;SET CHAN NUMBER
	TLNN	FLG,OPNIO!RANFIL ;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
	XCT	USETI.		;
	JRST	RRDMP3		;CONT LOOP

RRDMP5:	TLNN	FLG,OPNIN!OPNOUT
	JRST	RRDMP1		;THIS FILE IS NOT OPEN = CONT
	TLC	AC13,300000	;[321];
	TLCN	AC13,300000	;[321];NULL DEVICE
	JRST	RRDMP1		;[321];YES -- GO ON

	SKIPE	F.WSMU(I16)	; ENQ'ING?
	JRST	[PUSHJ PP,RRERR0; "DUMP ABORTED"
		TTCALL 3,[ASCIZ/ SIMULTANEOUS UPDATE/]
		JRST RRDMP9]	; "FILE IS OPEN"

	TLNE	FLG,IDXFIL	;ISAM FILE?
	JRST	RRDMP8		;YES
	TLNN	AC13,140700	;CDR, CDP, PTP, PTR, DTA?
	JRST	RRDMP1		;NO, CONT SCAN
RRDMP8:	PUSHJ	PP,RRERR0	;DUMP ABORTED
	TLNE	FLG,IDXFIL	;INDEX-SEQ-ACCESS MODE?
	TTCALL	3,[ASCIZ / ISAM/]
	TLNE	AC13,100000	;CARDS?
	TTCALL	3,[ASCIZ / CARD/]
	TLNE	AC13,40000	;LINE-PRINTER?
	TTCALL	3,[ASCIZ / LPT/]
	TLNE	AC13,600	;PAPER TAPE?
	TTCALL	3,[ASCIZ / PAPER-TAPE/]
	TLNE	AC13,100	;
	TTCALL	3,[ASCIZ / DEC-TAPE/]
RRDMP9:	TTCALL	3,[ASCIZ / FILE IS OPEN.
/]
	JRST	RRXIT		;EXIT NO DUMP

	;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
	TLNE	AC13,100	;SKIP IF NOT DTA
	POPJ	PP,		;
RRCLE2:	PUSHJ	PP,OPNEID	;ENTER BLK
	XCT	UENTR.		;ENTER
	JRST	ENTRER		;ERROR
	POPJ	PP,		;

LOOKER:	PUSHJ	PP,LUPERR	;ERROR MESSAGE
	JRST	RRCLE1		;TRY AGAIN
ENTRER:	PUSHJ	PP,ENRERR	;
	JRST	RRCLE2		;

	;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
	TLNE	AC13,20		;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:	XCT	USETO.		;
	JRST	RRDMP3		;

	;MAG-TAPE, IF CLOSE GENERATED AN EOF BACK OVER IT
RRBUF5:	XCT	UOUT.		;DUMMY OUTPUT, ??? IT WORKS
	XCT	MBSPR.		;BACKUP ONE RECORD  (EOF)
	XCT	MWAIT.		;WAIT FOR TAPE MOTION TO STOP
	XCT	UGETS.		;GET STATUS INTO AC2
	TRNN	AC2,24000	;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-PTR
	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,(SIXBIT /DSK/)
	HRLZM	AC3,UOBLK.+1	;DEVICE NAME
	MOVEI	AC3,17		;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,3		;JBTPRG
	CALLI	AC3,41		;PROGRAM NAME TO AC3
	JRST	RRERR3		;ERROR RET ;HRLZI AC3,(SIXBIT /PKC/)
	MOVEM	AC3,UEBLK.	;LOW-SEG NAME
	HRLZI	AC3,(SIXBIT /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

	PUSH	PP,.JBFF	; SAVE .JBFF
	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		;
	CALLI	AC0,11		;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
	SETZ	AC2,		;TERMINATOR
	MOVE	AC6,[OUT AC1]	;FIRST RECORD	;TEMP.,,(.JBREL)
	DPB	AC5,[POINT 4,AC6,12]
	XCT	AC6
	 SKIPA
	JRST	RRERR2		;OUTPUT ERROR
	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
	 SKIPA
	JRST	RRERR2		;OUTPUT ERROR
	POP	PP,.JBFF	; RESTORE THE STACK AND JOBFF
	MOVE	AC6,[CLOSE ]
	DPB	AC5,[POINT 4,AC6,12]
	XCT	AC6
	TTCALL	3,[ASCIZ /DUMP COMPLETED.
/]
RRXIT:	AOSN	AC15		;SKIP IF NOT FORCED
	CALLI	1,12		;EXIT IF IT WAS FORCED
	JRST	RSTAC1		;RESTORE ACS AND POPJ
RRERR0:	TTCALL	3,[ASCIZ /DUMP ABORTED /]
	POPJ	PP,		;

		;OPEN FAILED
RRERR:	PUSHJ 	PP,RRERR0	;
	TTCALL	3,[ASCIZ /OPEN FAILED. /]
	JRST	RRXIT		;

		;ENTER FAILED
RRERR1:	PUSHJ	PP,RRERR0	;
	TTCALL	3,[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
	TTCALL	3,@LEMESS(AC2)	;COMPLAIN
	JRST	RRERRX		;ERROR EXIT

		;OUTPUT FAILED
RRERR2:	POP	PP,.JBFF	; RESTORE THE STACK AND JOBFF
	PUSHJ	PP,RRERR0	;
	TTCALL	3,[ASCIZ /OUTPUT ERROR, /]
	GETSTS	RC,AC2		;ERROR STATUS
	PUSHJ	PP,IOERM1	;COMPLAIN

RRERRX:	TTCALL	3,[ASCIZ /
/]
	CLOSE	RC,40		;CLOSE, BUT DONT SUPERCEDE
	JRST	RSTAC1		;EXIT

	;CAINT FIND THE PROGRAM NAME
RRERR3:	PUSHJ	PP,RRERR0	;
	TTCALL	3,[ASCIZ /CANNOT FIND PROGRAM NAME/]
	JRST	RRERRX		;

	;CORE UUO FAILED
RRERR4:	POP	PP,.JBFF	; RESTORE THE STACK AND JOBFF
	PUSHJ	PP,RRERR0
	TTCALL	3,[ASCIZ /CORE UUO FAILED/]
	JRST	RRERRX		;

	;NO IO CHANNELS FOR THE DUMP FILE
RRERR5:	PUSHJ	PP,RRERR0
	TTCALL	3,[ASCIZ /NO CHANNELS AVAILABLE/]
	JRST	RRERRX

	>	; END OF IFE %%RPG (STARTED AT RRDMP)
	;POINTERS AND THINGS

PAT:	BLOCK	10		;PATCH AREA
WOPRS.:	POINT	12,AC15,11	;RECORD SIZE IN CHARS
WOPCN:	POINT	3,AC15,17	;LPT CHANNEL NUMBER
STDLBP:	POINT	6,STDLB.	;STANDARD LABEL POINTER
DOPFS.:	POINT	10,(I16),17	;DISPLAY OPERAND FIELD-SIZE
OPNCBP:	POINT	1,OPNCH.,0	;[342]POINTER TO CHAN. STATUS

	;CONSTANTS FOR ISAM
IFN	ISAM,<
KY.TP:	POINT	18,1+KEYDES(AC1),17	; KEY TYPE
KY.MD:	POINT	2,1+KEYDES(AC1),19	; MODE OF FILE
KY.TYP:	POINT	18,KEYDES(I12),17	; KEY TYPE
KY.MOD:	POINT	2,KEYDES(I12),19	; MODE OF FILE
KY.SGN:	POINT	1,KEYDES(I12),20	; ONE IF SIGNED
KY.SIZ:	POINT	12,KEYDES(I12),35	; KEY SIZE
>

;DEVICE TABLE CONSTANTS
D.LBN=-32	; LAST BLOCK OF SEQIO FILE
D.FCPL=-31	; FREE CRARS PER LOG-BLOCK
D.TCPL=-30	; TOTAL CHARS PER LOG-BLOCK
D.WCNV=-27	; THE WRITE CONVERSION INSTRUCTION
D.RCNV=-26	; THE READ CONVERSION INSTRUCTION

D.BPW=-25	;BYTES PER WORD
D.RD=-24	;RERUN DEVICE NAME IN SIXBIT
D.F1=-23	;0-17 FLG1 
D.IBL=-23	; [377]  18-35	ISAM SAVE AREA FOR SHARED BUFFER
D.IE=-22	;# OF INPUTS EXECUTED
D.OE=-21	;# OF OUTPUTS EXECUTED
D.LRS=-20	;18-35 LABEL RECORD SIZE
D.BL=-20	;0-17 BUFFER LOCATION
D.RFLG=-17	; 18-35 FLAGS, SASCII=1
D.HF=-17	;BIT-17 HUF FLAG
D.LF=-17	;BIT-16 LOCK FLAG
D.CN=-17	;12-15 IO CHANNEL NUMBER
D.RN=-17	;0-11 MAGTAPE REEL NUMBER
D.CBN=-16	;CURRENT PHYSCIAL BLOCK NUMBER
D.BPL=-15	;# OF BUFFERS PER LOGICAL BLOCK
D.BCL=-14	;# OF BUFFERS TO FILL CURRENT LOGICAL BLOCK
D.RCL=-13	;# OF RECORDS TO FILL CURRENT LOGICAL BLOCK
D.ICD=-12	;IOWD FOR CURRENT DEVICE
D.OBH=-11	;OUTPUT BUFFER HEADER
D.OBB=-10	;OUTPUT BUFFER BYTE POINTER
D.OBC=-7	;OUTPUT BUFFER BYTE COUNT
D.IBH=-6	;INPUT BUFFER HEADER
D.IBB=-5	;INPUT BUFFER BYTE POINTER
D.IBC=-4	;INPUT BUFFER BYTE COUNT
D.RRD=-3	;# OF RECORDS TO A RERUN DUMP
D.RP=-2		;# OF RECORDS PROCESSED
D.DC=-1		;DEVICE CHARACTERISTICS
D.OPT=-1	;-1 IF A "NOT-PRESENT" OPTIONAL ISAM FILE

DTCN.:	POINT	4,D.CN(I16),15	; CHANNEL NUMBER
DTIBS.:	POINT	6,D.IBB(I16),11	; INPUT HEADER BYTE SIZE
DTOBS.:	POINT	6,D.OBB(I16),11	; OUTPUT HEADER BYTE SIZE
DTRN.:	POINT	12,D.RN(I16),11	; MTA REEL NUMBER
REPEAT 0,<
;FILE TABLE CONSTANTS

F.WFNM==0	; 30 CHARACTER PROGRAM NAME - SIXBIT
F.WCVR==5	; COMPILER'S VERSION NUMBER
F.WBLC==5	; BUFFER LOCATION IS ASSIGNED - BUFLOC
F.WSDF==5	; SORT-DESCRIPTION FILE FLAG - SRTFIL
F.WNOD==5	; NUMBER OF DEVICES ASSIGNED TO FILE
F.WDNM==5	; ADR OF FIRST DEVICE NAME - SIXBIT
F.WNFL==6	; NUMBER OF FILE LIMIT CLAUSES
F.WPMT==6	; FILE POSITION ON MAG-TAPE
F.RNFT==6	; LINK TO NEXT FILE TABLE
F.WNAB==7	; NUMBER OF ALTERNATE BUFFERS
F.WMRS==7	; MAXIMUM RECORD SIZE IN CHARS
F.RRRC==7	; NUMBER OF RECORDS BETWEEN RERUN DUMPS
F.WFLG==10	; FLAGS,,ADR OF RECORD AREA
F.LNLS==11	; SIZE OF NON-STANDARD LABEL
F.RFSD==11	; LINK TO FILE-TABLE THAT SHARES DEVICE
F.WBKF==12	; THE BLOCKING FACTOR
F.RACK==12	; ADR OF ACTUAL KEY TABLE
F.WVID==13	; BYTE POINTER TO VALUE OF ID
F.WVDW==14	; BYTE POINTER TO VALUE OF DATE WRITTEN
F.LSBA==15	; LINK TO FILE-TABLE THAT SHARES BUFFER AREA
F.REUP==15	; ADR OF ERROR USE PROCEDURE
F.LBBR==16	; BEFORE-BEGINNING-REEL USE PROCEDURE
F.RBBF==16	; BEFORE-BEGINNING-FILE USE PROCEDURE
F.LABR==17	; AFTER-BEGINNING-REEL USE PROCEDURE
F.RABF==17	; AFTER-BEGINNING-FILE USE PROCEDURE
F.LBER==20	; BEFORE-ENDING-REEL USE PROCEDURE
F.RBEF==20	; BEFORE-ENDING-FILE USE PROCEDURE
F.LAER==21	; AFTER-ENDING-REEL USE PROCEDURE
F.RAEF==21	; AFTER-ENDING-FILE USE PROCEDURE
F.WDNS==22	; MAG-TAPE DENSITY
F.WDIO==22	; DEFERRED ISAM OUTPUT FLAG
F.WOUP==22	; OPEN USE-PROCEDURE WHEN ENTER FAILS
F.RPPN==22	; ADR OF USER-NUMBER
F.WBSK==23	; BYTE POINTER TO SYMBOLIC KEY
F.WBRK==24	; BYTE POINTER TO RECORD KEY
F.WIKD==25	; ISAM KEY DESCRIPTION WORD
F.WSMU==26	; 0-8= OWNER ACCESS 9-17= OTHERS ACCESS
		; 18-35= RETAINED REC COUNT
F.WPFS==27	; POINTER TO FILE-STATUS DATA-ITEM
F.WPEN==30	; POINTER TO ERROR-NUMBER DATA-ITEM
F.WPAC==31	; POINTER TO ACTION-CODE DATA-ITEM
F.WPID==32	; POINTER TO VALUE-OF-ID DATA-ITEM
F.WPBN==33	; POINTER TO BLOCK-NUMBER DATA-ITEM
F.WPRN==34	; POINTER TO RECORD-NUMBER DATA-ITEM
F.WPFN==35	; POINTER TO FILE-NAME DATA-ITEM
F.WPFT==36	; POINTER TO FILE-TABLE ADR DATA-ITEM
F.WLHL==37	; POINTER TO LOW,,HIGH FILE LIMIT
>	;END OF REPEAT 0

F.BCVR:	F%BCVR	; COMPILER'S VERSION NUMBER
F.BBLC:	F%BBLC	; BUFFER LOCATION IS ASSIGNED - BUFLOC
F.BSDF:	F%BSDF	; SORT-DESCRIPTION FILE FLAG - SRTFIL
F.BNOD:	F%BNOD	; NUMBER OF DEVICES ASSIGNED TO FILE
F.BNFL:	F%BNFL	; NUMBER OF FILE LIMIT CLAUSES
F.BPMT:	F%BPMT	; FILE POSITION ON MAG-TAPE
F.BNAB:	F%BNAB	; NUMBER OF ALTERNATE BUFFERS
F.BMRS:	F%BMRS	; MAXIMUM RECORD SIZE IN CHARS
F.BBKF: F%BBKF	; THE BLOCKING FACTOR
F.BPAR:	F%BPAR	; MAG-TAPE PARITY
F.BDNS:	F%BDNS	; MAG-TAPE DENSITY
F.BDIO:	F%BDIO	; DEFERRED ISAM OUTPUT FLAG
F.BOUP:	F%BOUP	; OPEN USE-PROCEDURE WHEN ENTER FAILS

	;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
	XWD	400000,	400015	;CR
	XWD	0,	16	;
	XWD	0,	17	;
	XWD	400000,	400020	;PC
	XWD	400000,	400021	;PC
	XWD	400000,	400022	;PC
	XWD	400000,	400023	;PC
	XWD	400000,	400024	;PC
	XWD	0,	25	;
	XWD	0,	26	;
	XWD	0,	27	;
	XWD	0,	30	;
	XWD	0,	31	;
	XWD	400000,	400032	;TTY EOF
	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	0,	140	;
	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	20,	173	;	LEFT BRACE TO ZERO [326]
	XWD	0,	174	;
	XWD	32,	175	;ALT-MODE OR RIGHT BRACE TO : FOR -0 [326]
	XWD	0,	176	;ALT-MODE
	XWD	0,	177	;RUBOUT / HIGH-VALUE



C.END:	END