Google
 

Trailing-Edge - PDP-10 Archives - BB-D489E-SB - srtjss.mac
There are 16 other files named srtjss.mac in the archive. Click here to see a list.
SUBTTL	TOPS-20 SPECIFIC PART OF SORT/MERGE
SUBTTL	D.L. CAMPBELL/DZN/DMN/BRF	3-Jun-81


;	"JSYS SAVES"


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


IFE FTOPS20,<PRINTX ? SRTJSS should not be present in TOPS-10 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTJSS.MAC]]>
SUBTTL	TABLE OF CONTENTS FOR SRTJSS



;                    Table of Contents for SRTJSS
;
;
;                             Section                             Page
;
;   1  TOPS-20 SPECIFIC PART OF SORT/MERGE ......................   1
;   2  TABLE OF CONTENTS FOR SRTJSS .............................   2
;   3  DEFINITIONS
;        3.1  TOPS-20 Specific Parameters .......................   3
;        3.2  Impure Data .......................................   4
;   4  ENTRY POINTS
;        4.1  TOPS-20 Entry Vector ..............................   6
;   5  PSORT.
;        5.1  SETUPI - Set Up Input Files .......................   7
;   6  I/O ROUTINES
;        6.1  INIINP - Initialize Next Input File
;             6.1.1  Set Up .....................................   7
;             6.1.2  Disk .......................................   9
;             6.1.3  Magtape ....................................  11
;             6.1.4  Others .....................................  13
;        6.2  INIOUT - Initialize Next Output File
;             6.2.1  Set Up .....................................  17
;             6.2.2  Disk .......................................  18
;             6.2.3  Magtape ....................................  19
;        6.3  Magtape Utility Routines ..........................  20
;        6.4  File Utility Routines
;             6.4.1  Close Master Input/Output File .............  21
;             6.4.2  Delete a Temp File .........................  22
;             6.4.3  Unmap Buffer Pages For a File ..............  23
;             6.4.4  Initialize Output Temporary File ...........  26
;             6.4.5  Append to Temporary File ...................  27
;   7  TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE ............  30
;   8  GETREC
;        8.1  GETBUF - Input 1 Physical Buffer
;             8.1.1  Set Up .....................................  33
;             8.1.2  Terminal ...................................  34
;             8.1.3  Disk .......................................  35
;             8.1.4  Magtape ....................................  39
;   9  PUTREC
;        9.1  PUTBUF - Output 1 Physical Buffer
;             9.1.1  Set Up .....................................  40
;             9.1.2  Disk .......................................  41
;             9.1.3  Magtape ....................................  43
;  10  PSORT.
;       10.1  Memory Management Routines for TOPS-20 ............  44
;  11  COLLATING SEQUENCE ROUTINES ..............................  54
;  12  ERROR MESSAGES ...........................................  55
SUBTTL	DEFINITIONS -- TOPS-20 Specific Parameters

OUTSIZ==PGSIZ*3			;DESIRABLE SIZE FOR SINGLE OUTPUT BUFFER
PPTBUF==2			;MINIMUM PAGES PER TEMP FILE BUFFER
SUBTTL	DEFINITIONS -- Impure Data

	SEGMENT IMPURE		;[C20]
ZJ.BEG:!			;[427] FIRST DATUM TO DELETE

CBPTR:	BLOCK	1		;CANONICAL BYTE POINTER
INLST:	BLOCK	2		;I/O COMMAND LIST FOR MTA INPUT
OUTLST:	BLOCK	2		;I/O COMMAND LIST FOR MTA OUTPUT
PGTAB:	BLOCK	<1000/^D36>+1	;[C13] BIT TABLE OF MAPPED PAGES
LEANUM:	BLOCK	1		;ARGUMENT TO /LEAVES SWITCH
OBUFSZ:	BLOCK	1		;(MINIMUM) SIZE OF OUTPUT BUFFER
DFMTRS:	BLOCK	1		;DEFAULT MTA RECORD SIZE
DFMTMD:	BLOCK	1		;[C03] DEFAULT MTA HARDWARE MODE
MTTEMP:	BLOCK	2		;[C12] TEMPORARY MTOPR% BLOCK
MOUNTR:	BLOCK	1		;[C12] MOUNTR AROUND FLAG, 0=NO, -1=YES
AZTEMP:	BLOCK	^D20		;[405] TEMP TO HOLD FILESPEC AT XGTJFN
SOURCE:	BLOCK	1		;[464] AREA TO SAVE ARGS FOR PMAP
DEST:	BLOCK	1		;[464] ...
ACCESS:	BLOCK	1		;[464] ...
PGSATM:	BLOCK	1		;[464] THE # OF PAGES ATTEMPTED TO PMAP
GTJARG:	BLOCK	1		;ARG FOR GETJI JSYS
ZJ.END==.-1			;[427] LAST DATUM TO DELETE

	SEGMENT HPURE			;[C20]
	BLOCK	1			;[427] NEXT IN LIST
	ZJ.BEG,,ZJ.END			;[427] DATA TO ZERO
	.LINK	S.LNK,.-2		;[427] TELL LINK WHAT TO DO
;DEFINE MNEMONICS FOR I/O MODES AND TABLE OF CORRESPONDING BYTE POINTERS

DEFINE GENMOD,<
  ..INDX==1
  X MODSIXBIT,<440600,,0>
  X MODASCII,<440700,,0>
  X MODEBCDIC,<441100,,0>
  X MODBINARY,<444400,,0>
 PURGE ..INDX
>

DEFINE X(NAME,BPTR),<
NAME==..INDX
	BPTR
..INDX==..INDX+1
>

BYTTAB:	GENMOD

IFE FTCOBOL,<
 DEFINE	ENDMODULE<
	$PURGE
	END	<ENTVLN,,ENTVEC>>

 DEFINE	COMPARE (R,J)<
	JSP	P4,@.CMPAR	;;[OK]
 >
>

IF1,<
DEFINE	$JRST$ <BLOCK 1>	;KEEP MACRO HAPPY
>
SUBTTL	ENTRY POINTS -- TOPS-20 Entry Vector


IFE FTCOBOL,<
	SEGMENT	HPURE		;[C20]

ENTVEC:	JRST	START		;MAIN ENTRY POINT
	JRST	START		;REENTER ENTRY POINT
	EXP	V%SORT		;VERSION NUMBER
	USRVLN,,USRVEC		;USER ENTRY VECTOR

	ENTVLN==.-ENTVEC

USRVEC:	JRST	FORENT		;FORTRAN ENTRY POINT

	USRVLN==.-USRVEC
SUBTTL	PSORT. -- SETUPI - Set Up Input Files

;SETUPI - PASS OVER INPUT FILES, REMEMBER LARGEST BUFFER SIZE  REQUIRED,
;SET UP SOME RANDOM STUFF

SETUPI:	HRRZ T1,IOMODE		;[C20] GET I/O MODE
	MOVE T1,BYTTAB-1(T1)	;[OK] GET PROPER CANONICAL BYTE POINTER
	MOVEM T1,CBPTR		;SAVE FOR LATER
	SETZM PGTAB		;CLEAR TABLE OF MAPPED PAGES
	MOVE T1,[PGTAB,,PGTAB+1] ;SET UP FOR BLT
	BLT T1,PGTAB+<1000/^D36>	;[C13] CLEAR THE TABLE
	MOVE T1,F.INZR		;GET PTR TO INPUT FILESPEC CHAIN
	CALL SETUP2		;GET SIZE OF LARGEST BUFFER IN CHAIN
	MOVEM T1,MXDVSZ		;SAVE IT
	RET			;RETURN

SETUPO:	MOVE T1,F.OUZR		;GET PTR TO OUTPUT FILESPEC
	CALL SETUP2		;GET SIZE OF LARGEST BUFFER IN CHAIN
	MOVEM T1,OBUFSZ		;REMEMBER
	RET

;FIND SIZE OF LARGEST BUFFER IN CHAIN
; CALL WITH T1 POINTING TO X. BLOCK CHAIN
; RETURN WITH T1/ SIZE OF BUFFER

SETUP2:	PUSH P,P1		;GET A REG FOR PTR TO X. BLOCK
	PUSH P,P2		;GET REG TO HOLD MAX BUFFER SIZE
	SETZ P2,		;INIT MAX BUFFER SIZE
	MOVE P1,T1		;COPY HEAD OF X. BLOCK CHAIN

SETUP1:	SETZ T1,
	LDB T2,[POINT 9,X.DVCH(P1),17]	;[OK] GET DEVICE TYPE
	CAXN T2,.DVDSK		;DISK?
	MOVEI T1,PGSIZ		;YES, BUFFER WANTS TO BE 1 PAGE
	CAXN T2,.DVMTA		;MTA?
	CALL	[MOVEI F,FCBORG		;[C02] YES, SETUP MINIMAL FCB
		MOVE T1,X.FLG(P1)	;[OK] [C02]   ..
		MOVEM T1,FILFLG(F)	;[C02]   ..
		CALL MTBFSZ		;[C02] COMPUTE BUFFER SIZE
		TRZE T1,PGMSK		;[365] ROUND UP TO PAGE BOUNDARY
		ADDI T1,PGSIZ		;[365]   BECAUSE MTA BUFFERS GO ON PG BOUNDARY
		LSH T1,POW2(2)		;DOUBLE BECAUSE MTA IS DOUBLE BUFFERED
		RET]
	SKIPN T1		;ALL ELSE USES
	MOVEI T1,^D100		; 100 WORD BUFFERS
	CAML T1,P2		;BIGGEST SO FAR?
	MOVEM T1,P2		;YES, SAVE THIS
	SKIPE P1,X.NXT(P1)	;[OK] ARE THERE MORE FILESPECS IN LIST?
	JRST SETUP1		;YES, PROCESS NEXT
	MOVE T1,P2		;RETURN RESULT IN T1
	POP P,P2		;NO, RESTORE P REGISTERS
	POP P,P1		; ..
	RET			;AND RETURN
SUBTTL	I/O ROUTINES -- INIINP - Initialize Next Input File -- Set Up

;CALL WITH:	MOVEI F,<ADDRESS OF FCB>
;		PUSHJ P,INIINP

INIINP:	PUSH P,P1		;GET A REGISTER
	MOVE P1,FILXBK(F)	;GET POINTER TO X. BLOCK IN P1
	HRRZ T1,X.JFN(P1)	;[OK] GET JFN
	HRLZM T1,FILPGN(F)	;STORE IN FCB
	MOVE T3,X.FLG(P1)	;[OK] GET FILE FLAGS
	MOVEM T3,FILFLG(F)	;SAVE IN FCB
	MOVE T1,X.BLKF(P1)	;[OK] [C06] FETCH BLOCKING FACTOR
	HRRZM T1,FILBLK(F)	;[C06] STORE AS AOBJN WORD (TO FAIL FIRST TIME)
	SETZM FILSIZ(F)
	SETZM FILEOF(F)
	SETZM FILCNT(F)
	LDB T1,[POINT 9,X.DVCH(P1),17] ;[OK] GET DEVICE TYPE
	CAILE T1,.DVNET		;RANGE CHECK
	JRST E$$NSD		;NO SUCH DEVICE
	JUMPL T1,E$$NSD		;CAN'T BE NEGATIVE
	CALL	@[IFIW INDSK	;[C20] 0 - DISK
		  IFIW E$$NSD	;[C20] 1 - NO SUCH DEVICE
		  IFIW INMTA	;[C20] 2 - MAGTAPE
		  REPEAT 4,<IFIW E$$NSD> ;[C20] 3-6 - NO SUCH DEVICE
		  IFIW E$$CDL	;[C20] 7 - LINE PRINTER
		  IFIW INCDR	;[C20] 10 - CARD READER
		  IFIW E$$FED	;[C20] 11 - FRONT-END DEVICE
		  IFIW INTTY	;[C20] 12 - TERMINAL
		  IFIW INPTY	;[C20] 13 - PSEUDO-TERMINAL
		  IFIW E$$NSD	;[C20] 14 - NO SUCH DEVICE
		  IFIW INNUL	;[C20] 15 - NULL DEVICE
		  IFIW E$$AND](T1)	;[C20] 16 - ARPANET DEVICE
	POP P,P1		;RESTORE P1
	RET			;AND RETURN
SUBTTL	I/O ROUTINES -- INIINP - Initialize Next Input File -- Disk


;COMPUTES:	FILEOF(F)/ SIZE OF FILE, IN BYTES
;		FILBPB(F)/ NUMBER OF BYTES PER BUFFER
;		FILBUF(F)/ (LH) NUMBER OF PAGES IN A BUFFER
;		FILBUF(F)/ (RH) FIRST PAGE OF BUFFER

INDSK:	MOVX T1,FI.DSK		;SET DISK BIT FOR LATER USE
	IORM T1,FILFLG(F)	; ..
	SKIPE X.BLKF(P1)	;[OK] [305] IF BLOCKED FILE,
	CALL BLKSET		;[305]   SET UP FOR IT
	HLRZ T1,FILPGN(F)	;GET JFN
	MOVE T2,[2,,.FBBYV]	;GET BYTE SIZE AND FILE SIZE
	MOVEI T3,T3		;RETURN IN T3 AND T4
	GTFDB%			; ..
	LDB T1,[POINT 6,T3,11]	;GET BYTE SIZE ALONE
	JUMPE T1,INDSK2		;MAKE ZERO BYTE SIZE IMPLY 36-BIT BYTES
	CAIN T1,7		;7-BIT BYTES?
	JRST INDSK1		;YES, GO HANDLE
	CAIN T1,^D36		;36-BIT BYTES?
	JRST INDSK2		;YES
	CAIN T1,^D9		;[305] 9-BIT BYTES?
	JRST INDSK9		;[305] YES, HANDLE IT
	$ERROR (?,IBS,<Invalid byte size for >,+)
	HLRZ T2,FILPGN(F)
	$MORE (FILESPEC,T2)
	$DIE

INDSK9:	MOVX T1,MODEBCDIC	;[305] IF FILE HAS 9-BIT BYTES,
	CAME T1,IOMODE		;[305]   I/O MODE HAD BETTER BE EBCDIC
	JRST E$$FMC		;[305] FILE MODE CONFLICT
	MOVEM T4,FILEOF(F)	;[305] STUFF BYTE COUNT INTO FDB
	JRST INDSK3		;[305] REJOIN COMMON CODE

INDSK1:	MOVEI T1,MODASCII	;ARE WE SORTING ASCII RECORDS?
	CAME T1,IOMODE		; ..
	JRST E$$FMC		;[305] FILE'S MODE CONFLICTS WITH MODE SWITCH
	MOVE T1,T4		;YES, GET BYTE COUNT IN T1
	IDIVI T1,5		;ROUND TO WORD BOUNDARY
	SKIPE T2		;IF REMAINDER
	ADDI T1,1		; ONE MORE WORD
	IMULI T1,5		;CONVERT BACK TO BYTES
	MOVEM T1,FILEOF(F)	;SAVE IN FCB
	JRST INDSK3

;HERE IF FILE WRITTEN IN 36-BIT BYTES.  ANY I/O MODE IS LEGAL,
; SO MUST COMPUTE NUMBER OF N-BIT BYTES IN FILE GIVEN NUMBER
; OF 36-BIT BYTES

INDSK2:	MOVE T1,T4		;COPY WORD COUNT
	IMUL T1,IOBPW2		;[C03] MULTIPLY BY BYTES PER WORD
	MOVEM T1,FILEOF(F)	;SAVE AWAY

INDSK3:	MOVE T1,IBUFNO		;GET NO. OF PAGES PER INPUT BUFFER
	HRLM T1,FILBUF(F)	;STORE IT
	SKIPGE BUFALC		;HAS BUFFER BEEN ALLOCATED YET?
	JRST INDSK5		;YES
	LSH T1,POW2(PGSIZ)	;NO, CONVERT PAGES TO WORDS
	CALL ALCBPG		;ALLOCATE T1 WORDS ON PAGE BOUNDARY
	LSH T1,-<POW2(PGSIZ)>	;CONVERT ADDRESS TO PAGE NO.
	HRRM T1,FILBUF(F)	;STORE PAGE NO. OF BUFFER IN FCB
INDSK5:	CALL MRKPGS		;[326] MARK PAGES AS POSSIBLY MAPPED
	MOVE T1,FILBPK(F)	;[C17] GET BYTES PER BLOCK
	MOVEM T1,FILKCT(F)	;[C17] SAVE AS BLOCK BYTE COUNT
	HLRZ T1,FILBUF(F)	;[321] GET PAGES PER BUFFER
	LSH T1,POW2(PGSIZ)	;CONVERT TO WORDS
	IMUL T1,IOBPW2		;[C03] CONVERT TO APPROPRIATE NO. OF BYTES
	MOVEM T1,FILBPB(F)	;SAVE NO. OF BYTES PER BUFFER
	HLRZ T1,FILPGN(F)	;GET JFN
	MOVX T2,OF%RD		;OPEN FOR READ
	OPENF%			;[335]   ..
	  ERJMP E$$OPN		;OOPS
	RET
SUBTTL	I/O ROUTINES -- INIINP - Initialize Next Input File -- Magtape


;COMPUTES:	FILEOF(F)/ NOT USED FOR MAGTAPE
;		FILBPB(F)/ BYTES PER BUFFER 
;		FILBUF(F)/ (LH) WORDS PER BUFFER (NOT PAGES)
;		FILBUF(F)/ (RH) ADDRESS OF BUFFER (WORD ADDRESS, NOT PG)

INMTA:	MOVX T1,FI.MTA		;REMEMBER THIS IS A MAGTAPE
	IORM T1,FILFLG(F)	; ..
	CALL MTBFSZ		;COMPUTE BUFFER SIZE, IN WORDS
	SKIPN FILBUF(F)		;[N26] IS THERE A BUFFER FROM A PREVIOUS FILE?
	JRST INMTA1		;[N26] NO, ITS THE FIRST TIME
	HLRZ T2,FILBUF(F)	;[N26] GET THE PREVIOUS SIZE
	CAMN T1,T2		;[N26] IS IT THE SAME SIZE AS LAST TIME?
	JRST INMTA2		;[N26] YES, USE PREVIOUS BUFFERS
	SUB T2,T1		;[N26] GET THE DIFFERENCE
	CAIL T2,PGSIZ		;[N26] LESS THAN 1 PAGE?
	JRST INMTA1		;[N26] NO, ALLOCATE NEW BUFFERS FOR NOW
	HRLM T1,FILBUF(F)	;[N26] RESET THE BUFFER SIZE
	HRLM T1,FILBF2(F)	;[N26] BUT NOT THE BUFFER LOCATION
	JRST INMTA2		;[N26] AND CONTINUE WITH BUFFERS ALLOCATED
INMTA1:	HRLZM T1,FILBUF(F)	;[N26] SAVE SIZE OF BUFFER
	IMUL T1,IOBPW2		;[C03] MULTIPLE BY BYTES PER WORD
	MOVEM T1,FILBPB(F)	;SAVE IN FCB
	HLRZ T1,FILBUF(F)	;RECOVER WORDS PER BUFFER
	CALL ALCBPG		;ALLOCATE BUFFER ON PAGE BOUNDARY
	HRRM T1,FILBUF(F)	;SAVE ITS ADDRESS
	HLRZ T1,FILBUF(F)	;GET WORDS PER BUFFER
	CALL ALCBPG		;ALLOCATE SECOND BUFFER ON PG BOUNDARY
	HRRM T1,FILBF2(F)	;[C02] SAVE ITS ADDRESS
INMTA2:	HLRZ T1,FILPGN(F)	;[N26] GET JFN
	MOVX T2,OF%RD!FLD(17,OF%MOD) ;OPEN FOR READ, DUMP MODE
	OPENF%			;[335]   ..
	  ERJMP E$$OPN
	CALL SMTLBS		;[C12] SET MOUNTR AND FI.ATO
	CALL POSITF		;[C11] POSITION AT FILE
	CALL SMTDEN		;[C01] SET DENSITY
	CALL SMTPAR		;[C01] SET PARITY
	CALL SMTMOD		;[C01] SET HARDWARE MODE
	CALL LABSET		;SET UP TAPE LABEL STUFF
	CALL STRTIO		;START INPUT ON FIRST BUFFER
	CALLRET CHKLBL		;CHECK HEADER LABELS AND RETURN
;START I/O ON THE FIRST MAGTAPE BUFFER.  THE FIRST CALL TO GETBUF
; WILL START I/O ON THE SECOND BUFFER, RETURNING WHEN ALL
; I/O TO THE FIRST BUFFER IS COMPLETE

STRTIO:	HLRZ T1,FILPGN(F)	;GET JFN FOR TAPE
	GDSTS%			;[335] GET CURRENT STATUS
	TXZ T2,MT%IRL		;CLEAR POSSIBLE LEFTOVER ERROR BITS
	SDSTS%			;[335]   ..
	MOVEI T1,INLST		;[C02] LOAD PARAMETER FOR SWTBUF
	CALL SWTBUF		;[C02] SET BYTE POINTER AND IOWD BLOCK

;START I/O ON FIRST BUFFER

	HLRZ T1,FILPGN(F)	;GET JFN
	MOVX T2,DM%NWT		;LIGHT "DO NOT WAIT" BIT
	HRRI T2,INLST		;ADDRESS OF COMMAND LIST
	DUMPI%			;[335] INITIATE I/O
	  ERJMP E$$DME
	RET

SUBTTL	I/O ROUTINES -- INIINP - Initialize Next Input File -- Others


INNUL:
INTTY:
INPTY:
INCDR:	CALL SETUP7		;SET UP FOR 7-BIT TRIVIAL DEVICE
	HLRZ T1,FILPGN(F)	;GET JFN
	MOVX T2,OF%RD!FLD(7,OF%BSZ) ;OPEN FOR READ, 7-BIT BYTES
	OPENF%			;[335]   ..
	  ERJMP E$$OPN
	RET

;ROUTINES TO INITIALIZE SIMPLEMINDED DEVICES FOR OUTPUT

OUNUL:
OULPT:
OUTTY:
OUPTY:
OUCDP:	CALL SETUP7		;SET UP FOR SIMPLE 7-BIT DEVICE
	HLRZ T1,FILPGN(F)	;GET JFN
	MOVX T2,OF%WR!FLD(7,OF%BSZ) ;OPEN FOR WRITE, 7-BIT BYTES
	OPENF%			;[335]
	  ERJMP E$$OPN
	MOVE T1,FILBPB(F)	;GET BYTES PER BUFFER
	MOVEM T1,FILCNT(F)	;INDICATE BUFFER WAITING TO BE FILLED
	RET

;SETUP7 - SET UP FOR SIMPLEMINDED ASCII-ONLY DEVICES

SETUP7:	MOVE T1,IOMODE		;GET I/O MODE
	CAXE T1,MODASCII	;LEGAL?
	JRST E$$IDM		;NO, COMPLAIN
	MOVEI T1,^D100		;ARBITRARILY ALLOCATE 100-WD BUFFER
	HRLZM T1,FILBUF(F)	;SAVE WORDS PER BUFFER IN FCB
	CALL ALCBUF		;ALLOCATE BUFFER SPACE
	HRRM T1,FILBUF(F)	;SAVE ADDRESS OF BUFFER
	ADD T1,CBPTR		;CONSTRUCT BYTE POINTER
	MOVEM T1,FILPTR(F)	;SAVE IT
	MOVEI T1,^D100		;COMPUTE BYTES PER BUFFER
	IMUL T1,IOBPW2		;[C03]  ..
	MOVEM T1,FILBPB(F)	;SAVE IT
	RET
;COMPUTE BUFFER SIZE FOR MAGTAPE, ACCOUNTING FOR BLOCKING FACTOR

MTBFSZ:	CALL MTMODE		;[C03] DO MTA HARDWARE MODE CALCULATIONS
	SKIPN T3,X.BLKF(P1)	;[OK] BLOCKING FACTOR SPECIFIED?
	JRST MTBFS1		;UNBLOCKED, USE DEFAULT RECORD SIZE
	HRRZ T1,IOMODE		;[C20] DISPATCH ON I/O MODE
	JRST	@[IFIW MTB6BT	;[C20] SIXBIT
		  IFIW MTBASC	;[C20] ASCII
		  IFIW MTBBCD	;[C20] EBCDIC
		  IFIW MTBBIN]-1(T1)	;[C20] BINARY

MTB6BT:	MOVE T1,RECSIZ		;RECORD SIZE
	IMUL T1,T3		;TIMES BLOCKING FACTOR
	RET			;EQUALS BUFFER SIZE

MTBASC:	MOVE T1,RECORD		;RECORD SIZE IN BYTES
	ADDI T1,2		;PLUS CRILLIF
	IMUL T1,T3		;TIMES BLOCKING FACTOR
	IDIVI T1,5		;DIVIDED BY BYTES PER WORD
	SKIPE T2		;PLUS ONE
	ADDI T1,1		; IF ANY PARTIAL WORDS
	RET			;EQUALS BUFFER SIZE IN WORDS

MTBBCD:	MOVE T1,RECORD		;RECORD SIZE IN BYTES
	SKIPGE FILFLG(F)	;[C06] IF VARIABLE?
	ADDI T1,4		;[C06] ADD RECORD HEADER WORD
	IMUL T1,T3		;TIMES BLOCKING FACTOR
	IDIVI T1,4		;DIVIDED BY BYTES PER WORD
	SKIPE T2		;PLUS ONE
	ADDI T1,1		; IF ANY PARTIAL WORDS
	SKIPGE FILFLG(F)	;[C06] IF VARIABLE?
	ADDI T1,1		;[C06] ADD BLOCK HEADER WORD
	RET			;EQUALS BUFFER SIZE

MTBBIN:	MOVE T1,RECSIZ		;RECORD SIZE IN WORDS
	IMUL T1,T3		;TIMES BLOCKING FACTOR
	RET			;IS BUFFER SIZE


MTBFS1:	MOVE T1,DFMTRS		;GET DEFAULT MAGTAPE RECORD SIZE IN BYTES
	IDIV T1,FILHBW(F)	;[C06] COMPUTE NO. OF WORDS
	SKIPE T2		;[C06] COUNT PARTIAL WORDS
	ADDI T1,1		;[C06]  ..
	RET
;GET MAGTAPE HARDWARE MODE AND OTHER CALCULATIONS

MTMODE:	MOVE T2,FILFLG(F)	;[C03] A HARDWARE MODE REQUESTED?
	TXNE T2,FI.IND!FI.STA	;[C03]  ..
	JRST MTMOD1		;[C03] YES
	MOVE T3,DFMTMD		;[C03] NO, SET DEFAULT MODE
	CAIN T3,.SJDM8		;[C03] INDUSTRY COMPATIBLE?
	TXO T2,FI.IND		;[C03] YES, REMEMBER IT
	CAIN T3,.SJDMA		;[C03] ANSI-ASCII?
	TXO T2,FI.STA		;[C03] YES, REMEMBER IT
	MOVEM T2,FILFLG(F)	;[C03] SAVE NEW FLAGS
MTMOD1:	MOVEI T1,DFMTMD		;[C03] GET ACTUAL MODE
	TXNE T2,FI.IND		;[C03] INDUSTRY COMPATIBLE?
	MOVEI T1,.SJDM8		;[C03] YES, REMEMBER IT
	TXNE T2,FI.STA		;[C03] ANSI-ASCII?
	MOVEI T1,.SJDMA		;[C03] YES, REMEMBER IT
	MOVEI T2,1		;[C03] COMPUTE HARDWARE BYTES PER WORD
				;[C03] ASSUME 1-BYTE WORDS
	CAIN T1,.SJDM6		;[C03] SIXBIT MODE?
	MOVEI T2,6		;[C03] YES, 6-BYTE WORDS
	CAIN T1,.SJDMA		;[C03] ANSI-ASCII MODE?
	MOVEI T2,5		;[C03] YES, 5-BYTE WORDS
	CAIN T1,.SJDM8		;[C03] INDUSTRY COMPATIBLE MODE?
	MOVEI T2,4		;[C03] YES, 4-BYTE WORDS
	MOVEM T2,FILHBW(F)	;[C03] SAVE HARDWARE BYTES PER WORD
	RET			;[C03] DONE
;LABSET -- SET UP LABEL NAMES IN SIXBIT FOR LABEL PROCESSING


LABSET:	MOVE T1,X.LABL(P1)	;[OK] GET LABEL TYPE FOR THIS TAPE
	MOVE T2,FILFLG(F)	;[C12]  AND FLAGS
	CAXE T1,LABOMITTED	;ARE LABELS OMITTED?
	TXNE T2,FI.ATO		; OR IS PULSAR DOING LABELLING FOR US?
	RET			;YES TO EITHER, SKIP THIS
	PUSH P,P2		;GET A REG
	MOVEI T1,^D17		;ALLOCATE ENUF WORDS FOR FILENAME.EXT
	CALL GETSPC		; ..
	  JRST E$$NEC
	MOVE P2,T1		;SAVE ADDR OF STRING SPACE
	HRL T1,T1		;MAKE BLT POINTER
	HRRI T1,1(P2)		;[OK]  TO CLEAR STRING SPACE
	HRRZI T2,^D17-1(P2)	;[OK] END OF BLT
	SETZM 0(P2)		;[OK] CLEAR FIRST WORD
	BLT T1,0(T2)		;[OK] SPREAD IT AROUND
	SETZM X.RIB+.RBNAM(P1)	;[OK] CLEAR CELLS IN X. BLOCK
	SETZM X.RIB+.RBEXT(P1)	;[OK]  WHICH WILL RECEIVE SIXBIT NAME.EXT
	HRRO T1,P2		;CONSTRUCT STRING PTR TO SPACE
	HRRZ T2,X.JFN(P1)	;[OK] GET JFN OF THIS TAPE
	MOVX T3,<1B8+1B11+JS%PAF> ;GET FILENAME.EXT, WITH THE DOT
	JFNS%			;[335] GET THE NAME
	  ERJMP E$$NFS		;NO FILE NAME SPECIFIED FOR LABELED TAPE

;CONVERT THE ASCIZ STRING POINTED TO BY P2 (NAME.EXT) TO
; SIXBIT AND STUFF INTO X.RIB+.RBNAM AND X.RIB+.RBEXT

	HRLI P2,(POINT 7,)	;POINT TO ZEROTH BYTE
	MOVEI T4,6		;MAXIMUM CHARACTERS ALLOWED
	MOVE T3,[POINT 6,X.RIB+.RBNAM(P1)] ;[OK] WHERE TO PUT SIXBIT

LABST1:	ILDB T1,P2		;GET THE NEXT BYTE
	JUMPE T1,LABST2		;NULL TERMINATES FILENAME
	CAIN T1,"."		;CHECK FOR DOT
	JRST LABST3		;FOUND IT, GO ON TO TYPE
	SOJL T4,E$$FTL		;FILESPEC FIELD TOO LONG FOR LABELLED TAPE
	CAIL T1,"a"		;[C04] CONVERT LOWER CASE TO UPPER CASE
	CAILE T1,"z"		;[C04]  ..
	SKIPA			;[C04]  ..
	SUBI T1,"a"-"A"		;[C04]  ..
	SUBI T1,40		;CONVERT BYTE TO SIXBIT
	IDPB T1,T3		;PLUNK INTO X. BLOCK
	JRST LABST1		;ONCE MORE

LABST3:	MOVEI T4,3		;TYPE IS 3 CHARS MAX
	MOVE T3,[POINT 6,X.RIB+.RBEXT(P1)]	;[OK]
	JRST LABST1		;GO DO THE TYPE

LABST2:	MOVEI T1,^D17		;RETURN STRING SPACE TO FREE POOL
	CALL FRESPC		; ..
	POP P,P2		;RESTORE P2
	RET			;RETURN
SUBTTL	I/O ROUTINES -- INIOUT - Initialize Next Output File -- Set Up

;CALL:		PUSHJ P,INIOUT
;RETURNS:	+1/ ALWAYS

INIOUT:	MOVEI F,FCBORG		;OUTPUT FILE IS ALWAYS 1ST FCB
	PUSH P,P1		;GET A REGISTER
	MOVE P1,F.OUZR		;GET PTR TO X. BLOCK
	MOVEM P1,FILXBK(F)	;SAVE IN FCB
	SETZM FILSIZ(F)		;INIT FILE SIZE
	SETZM FILEOF(F)		; AND BYTE COUNT
	MOVE T1,X.FLG(P1)	;[OK] PUT FLAGS IN FCB
	TXO T1,FI.OUT		;[C06] REMEMBER THIS IS AN OUTPUT FILE
	MOVEM T1,FILFLG(F)	; ..
	MOVE T1,X.JFN(P1)	;[OK] GET JFN
	HRLZM T1,FILPGN(F)	;SAVE IT AND ZAP PAGE COUNT
	MOVE T1,X.BLKF(P1)	;[OK] [C06] FETCH BLOCKING FACTOR
	HRRZM T1,FILBLK(F)	;[C06] STORE AS AOBJN WORD (TO FAIL FIRST TIME)
	LDB T1,[POINT 9,X.DVCH(P1),17] ;[OK] GET DEVICE TYPE AND DISPATCH ON IT
	CAILE T1,.DVNET		;RANGE CHECK
	JRST E$$NSD		;NO SUCH DEVICE
	JUMPL T1,E$$NSD		;CAN'T BE NEGATIVE
	CALL	@[IFIW OUDSK	;[C20] 0 - DISK
		  IFIW E$$NSD	;[C20] 1 - NO SUCH DEVICE
		  IFIW OUMTA	;[C20] 2 - MAGTAPE
		  REPEAT 4,<IFIW E$$NSD> ;[C20] 3-6 - NO SUCH DEVICE
		  IFIW OULPT	;[C20] 7 - LPT
		  IFIW E$$CDC	;[C20] 10 - CDR
		  IFIW E$$FED	;[C20] 11 - FRONT-END DEVICE
		  IFIW OUTTY	;[C20] 12 - TERMINAL
		  IFIW OUPTY	;[C20] 13 - PSEUDO-TERMINAL
		  IFIW E$$NSD	;[C20] 14 - NO SUCH DEVICE
		  IFIW OUNUL	;[C20] 15 - NULL DEVICE
		  IFIW E$$AND](T1)	;[C20] 16 - ARPANET DEVICE
	POP P,P1		;RESTORE P1
	RET
SUBTTL	I/O ROUTINES -- INIOUT - Initialize Next Output File -- Disk


OUDSK:	MOVX T1,FI.DSK		;REMEMBER THIS IS A DISK FILE
	IORM T1,FILFLG(F)	; ..
	SKIPE X.BLKF(P1)	;[OK] [305] IF BLOCKED FILE,
	CALL BLKSET		;[305]   SET UP FOR IT
	HLRZ T1,FILPGN(F)	;GET JFN
	MOVX T2,OF%RD!OF%WR	;OPEN FOR READ AND WRITE
	MOVE T3,IOMODE		;GET I/O MODE
	CAXN T3,MODASCII	;IS THIS TO BE AN ASCII FILE?
	IORX T2,FLD(7,OF%BSZ)	;YES, SET BYTE SIZE TO 7
	OPENF%			;[335]
	  ERJMP E$$OPN
	MOVE T1,OBUFNO		;GET PAGES PER OUTPUT BUFFER
	HRLM T1,FILBUF(F)	;SAVE IN FCB
	LSH T1,POW2(PGSIZ)	;COMPUTE WORDS PER BUFFER
	CALL ALCBPZ		;[371] ALLOC BUFFER ON PG BOUNDRY AND ZERO IT
	LSH T1,-<POW2(PGSIZ)>	;COMPUTE BUFFER PAGE NUMBER
	HRRM T1,FILBUF(F)	;SAVE
	LSH T1,POW2(PGSIZ)	;CONVERT BACK TO ADDRESS
	ADD T1,CBPTR		;CONSTRUCT BYTE POINTER
	MOVEM T1,FILPTR(F)	;SAVE IT
	MOVE T1,FILBPK(F)	;[C17] GET BYTES PER BLOCK
	MOVEM T1,FILKCT(F)	;[C17] SAVE AS BLOCK BYTE COUNT
	HLRZ T1,FILBUF(F)	;GET PAGES PER BUFFER
	LSH T1,POW2(PGSIZ)	;COMPUTE WORDS
	IMUL T1,IOBPW2		;[C03] COMPUTE BYTES
	MOVEM T1,FILCNT(F)	;INDICATE BUFFER WAITING TO BE FILLED
	MOVEM T1,FILBPB(F)	;SAVE HOW MANY BYTES IN A BUFFER
	RET			;RETURN
SUBTTL	I/O ROUTINES -- INIOUT - Initialize Next Output File -- Magtape


OUMTA:	MOVX T1,FI.MTA		;REMEMBER THIS IS A MAGTAPE
	IORM T1,FILFLG(F)
	HLRZ T1,FILPGN(F)	;GET JFN
	MOVX T2,OF%WR!FLD(17,OF%MOD) ;OPEN FOR WRITE, DUMP MODE
	OPENF%			;[335]   ..
	  ERJMP E$$OPN		;OPEN ERROR
	CALL SMTLBS		;[C12] SET MOUNTR AND FI.ATO
	CALL MTBFSZ		;COMPUTE BUFFER SIZE (IN WORDS)
	HRLZM T1,FILBUF(F)	;SAVE IT
	IMUL T1,IOBPW2		;[C03] COMPUTE BYTES PER BUFFER
	MOVEM T1,FILBPB(F)	;SAVE IT
	MOVEM T1,FILCNT(F)	;INDICATE BUFFER EMPTY
	HLRZ T1,FILBUF(F)	;RECOVER WORDS PER BUFFER
	CALL ALCBPZ		;[371] ALLOCATE BUFFER ON A PAGE BOUNDARY AND ZERO IT
	HRRM T1,FILBUF(F)	;REMEMBER ITS ADDRESS
	HLRZ T1,FILBUF(F)	;GET BUFFER SIZE AGAIN, IN WORDS
	CALL ALCBPZ		;[371] ALLOCATE THE SECOND BUFFER
	HRRM T1,FILBF2(F)	;[C02] REMEMBER ITS ADDRESS
	CALL POSITF		;[C11] POSITION AT FILE
	CALL SMTDEN		;[C01] SET DENSITY
	CALL SMTPAR		;[C01] SET PARITY
	CALL SMTMOD		;[C01] SET HARDWARE MODE
	MOVEI T1,OUTLST		;[C02] LOAD PARAMETER FOR SWTBUF
	CALL SWTBUF		;[C02] SET BYTE POINTER AND IOWD BLOCK
	CALL LABSET		;SET UP LABEL PARAMETERS
	CALLRET WRTLBL		;WRITE HEADER LABEL AND RETURN
SUBTTL	I/O ROUTINES -- Magtape Utility Routines


;RWNDF - REWIND MAGTAPE POINTED TO BY F

RWNDF:	MOVX T1,FI.ATO		;[C12] NEED A VOLUME SWITCH?
	TDNN T1,FILFLG(F)	;[C12]  ..
	SKIPN MOUNTR		;[C12]  ..
	SKIPA			;[C12] NO
	CALL GMTVL1		;[C12] MAYBE
	MOVX T2,.MOREW		;[C12] FUNCTION TO REWIND TAPE
RWNDF1:	HLRZ T1,FILPGN(F)	;GET JFN
	MTOPR%			;[335] DO IT
	RET

;UNLDF - UNLOAD MAGTAPE POINTED TO BY F

UNLDF:	SKIPE MOUNTR		;[C12] MOUNTR AROUND?
	RET			;[C12] CAN'T DO UNLOAD
	MOVX T2,.MORUL		;[C12] GET FUNCTION CODE
	JRST RWNDF1		;JOIN COMMON CODE

;SKIPR - SKIP MAGTAPE ONE RECORD

SKIPR:	MOVX T2,.MOFWR		;LOAD FUNCTION CODE
	JRST RWNDF1		;JOIN COMMON CODE

;SKIPF - SKIP MAGTAPE ONE FILE

SKIPF:	MOVX T2,.MOFWF		;FUNCTION CODE
	JRST RWNDF1

;BKSPR - BACKSPACE MAGTAPE ONE RECORD

BKSPR:	MOVX T2,.MOBKR		;[C11] LOAD FUNCTION CODE
	JRST RWNDF1		;[C11] JOIN COMMON CODE

;BKSPF - BACKSPACE MAGTAPE ONE FILE

BKSPF:	MOVX T2,.MOBKF		;[C11] FUNCTION CODE
	JRST RWNDF1		;[C11] JOIN COMMON CODE

;WRTEOF - WRITE A TAPE MARK DURING LABEL PROCESSING

WRTEOF:	MOVX T2,.MOEOF		;[335] FUNCTION CODE FOR MTOPR%
	JRST RWNDF1		;DO IT

;SMTPAR - SET MAGTAPE PARITY POINTED TO BY F

SMTPAR:	MOVE T1,FILXBK(F)	;[C01] GET X. BLOCK
	SKIPGE T3,X.PAR(T1)	;[OK] [C01] GET PARITY PARAMETER FOR MTOPR%
	RET			;[C01] DON'T SET IF DEFAULT
	MOVX T2,.MOSPR		;[C01] FUNCTION CODE FOR MTOPR%
	JRST RWNDF1		;[C01] DO IT

;SMTDEN - SET MAGTAPE DENSITY POINTED TO BY F

SMTDEN:	MOVE T1,FILXBK(F)	;[C01] GET X. BLOCK
	SKIPGE T3,X.DEN(T1)	;[OK] [C12] [C01] GET DENSITY PARAMETER FOR MTOPR%
	RET			;[C12] DON'T SET IF DEFAULT
	MOVX T2,.MOSDN		;[C01] FUNCTION CODE FOR MTOPR%
	JRST RWNDF1		;[C01] DO IT

;SMTMOD - SET MAGTAPE HARDWARE MODE POINTED TO BY F

SMTMOD:	MOVE T1,FILFLG(F)	;[C01] GET FLAGS
	MOVX T2,.MOSDM		;[C01] FUNCTION CODE FOR MTOPR%
	TXNE T1,FI.IND		;[C01] INDUSTRY COMPATABLE?
	JRST   [MOVX T3,.SJDM8	;[C01] YES, GET PARAMETER FOR MTOPR%
		JRST RWNDF1]	;[C01] DO IT
	TXNE T1,FI.STA		;[C01] ANSI-ASCII?
	JRST   [MOVX T3,.SJDMA	;[C01] YES, GET PARAMETER FOR MTOPR%
		JRST RWNDF1]	;[C01] DO IT
	RET			;[C01] LEAVE AS DEFAULT

;ISITMT - CHECK TO SEE IF FILE POINTED TO BY F IS A MAGTAPE
;	  SKIP RETURN IF IT IS

ISITMT:	MOVX T1,FI.MTA
	TDNE T1,FILFLG(F)
	AOS (P)
	RET

;ISATBT - CHECK TO SEE IF MAGTAPE POINTED TO BY F IS AT BOT
;	  SKIP RETURN IF IT IS

ISATBT:	HLRZ T1,FILPGN(F)	;[C11] GET JFN
	GDSTS%			;[C11] GET DEVICE STATUS
	TXNE T2,MT%BOT		;[C11] BOT?
	AOS (P)			;[C11] YES, SKIP RETURN
	RET			;[C11]

;SMTLBS - SET MOUNTR AND FI.ATO (AUTO SYSTEM LABELING FLAGS)

SMTLBS:	HLRZ T1,FILPGN(F)	;[C12] GET JFN
	MOVX T2,.MORLI		;[C12] FUNCTION FOR LABEL TYPE
	MOVEI T3,MTTEMP		;[C12] GET MTOPR% BLOCK ADDRESS
	MOVEI T4,2		;[C12] SETUP MTOPR% BLOCK
	MOVEM T4,MTTEMP		;[C12]  ..
	MTOPR%			;[C12] DO IT
	  ERJMP [SETZM MOUNTR		;[C12] MOUNTR ISN'T AROUND
		RET]			;[C12]
	SETOM MOUNTR		;[C12] MOUNTR IS AROUND
	MOVX T1,FI.UNL		;[C12] UNLOAD REQUESTED?
	TDNE T1,FILFLG(F)	;[C12]  ..
	CALL [	ANDCAM T1,FILFLG(F)	;[C12] YES, CLEAR IT
		$ERROR (%,UIA,<Unloads illegal with MOUNTR.>) ;[C12] TELL USER
		RET]		;[C12] REJOIN MAIN FLOW
	MOVE T1,FILXBK(F)	;[C12] DENSITY REQUESTED?
	SKIPL X.DEN(T1)		;[OK] [C12]  ..
	CALL [	SETOM X.DEN(T1)	;[OK] [C12] YES, CLEAR IT
		$ERROR (%,DIA,<Setting DENSITY illegal with MOUNTR.>) ;[C12] TELL USER
		RET]		;[C12] REJOIN MAIN FLOW
	MOVE T1,MTTEMP+1	;[C12] GET LABEL TYPE
	CAXN T1,.LTUNL		;[C12] LABLED?
	RET			;[C12] NO
	MOVX T2,FI.ATO		;[C12] YES, SET FLAG
	IORM T2,FILFLG(F)	;[C12]  ..
	MOVE T2,FILXBK(F)	;[C22] NOT STANDARD LABELS REQUESTED?
	MOVX T3,LABSTANDARD	;[C22]  ..
	CAME T3,X.LABL(T2)	;[C22]  ..
	CALL [	MOVEM T3,X.LABL(T2)	;[C22] YES, FIX IT
		$ERROR (%,LIA,<Not standard labels illegal with MOUNTR.>) ;[C22] TELL USER
		RET]		;[C22] REJOIN MAIN FLOW
	MOVE T2,MODE		;[C12] GET MODE
	CAXN T1,.LTEBC		;[C12] EBCDIC LABELS?
	CAXE T2,MODEBCDIC	;[C12] AND NOT DEALING WITH EBCDIC?
	SKIPA			;[C12] NO
	JRST [$ERROR (?,ILT,<Inconsistent label type.>)] ;YES
	CAXN T1,.LTANS		;[C12] ANSI-ASCII LABELS?
	CAXE T2,MODASCII	;[C12] AND NOT DEALING WITH ASCII?
	SKIPA			;[C12] NO
	JRST E$$ILT		;[C12] YES
	RET			;[C12]

;GMTVOL - GET NEXT VOLUME FOR MAGTAPE POINTED TO BY F

GMTVOL:	MOVX T2,.MOVLS		;[C12] FUNCTION FOR VOLUME SWITCHING
	MOVEI T3,[	3		;[C12] GET ARGUMENT BLOCK, WORD COUNT
			.VSMRV		;[C12] RELATIVE VOLUME SUBFUNCTION
			1]		;[C12] NEXT RELATIVE REEL
	JRST RWNDF1		;[C12] JOIN COMMON CODE

;GMTVL1 - GET FIRST VOLUME FOR MAGTAPE POINTED TO BY F

GMTVL1:	MOVX T2,.MOVLS		;[C12] FUNCTION FOR VOLUME SWITCHING
	MOVEI T3,[	2		;[C12] GET ARGUMENT BLOCK, WORD COUNT
			.VSFST]		;[C12] FIRST VOLUME SUBFUNCTION
	JRST RWNDF1		;[C12] JOIN COMMON CODE

>;END IFE FTCOBOL
SUBTTL	I/O ROUTINES -- File Utility Routines -- Close Master Input/Output File

CLSMST:	TDZA T4,T4		;REMEMBER THIS IS A MASTER CLOSE
CLSFIL:	SETO T4,		;REMEMBER WE'RE CLOSING A TMP FILE
	MOVX T1,FI.OUT		;IS THIS AN OUTPUT FILE?
	TDNN T1,FILFLG(F)	; ..
	JRST CLSFL2		;NO, DON'T WRITE PARTIAL BUFFERS
	PUSH P,T4		;SAVE FLAG REG
	JSP T4,PUTBUF		;WRITE LAST PARTIAL BUFFER
	POP P,T4		;GET T4 BACK AGAIN
	MOVX T1,FI.DSK		;IS THIS A DISK FILE?
	TDNN T1,FILFLG(F)	; ..
	JRST CLSFL3		;NO, DON'T UPDATE FDB OR DO PMAPS
	JUMPN T4,CLSFL2		;[420] IF TEMP FILE CLOSE, DON'T UPDATE FDB
	MOVSI T1,.FBBYV(CF%NUD)	;SET FILE BYTE SIZE
	HLR T1,FILPGN(F)	;GET JFN
	MOVX T2,FB%BSZ		;MASK FOR BYTE SIZE FIELD
	MOVX T3,^D36B11		;DEFAULT IS 36-BIT BYTES
IFE FTCOBOL,<
	MOVE T0,IOMODE		;GET I/O MODE
	CAXN T0,MODASCII	;ASCII?
	MOVX T3,7B11		;YES, BYTES ARE 7 BITS LONG
	CAXN T0,MODEBCDIC	;EBCDIC?
	MOVX T3,9B11		;YES, BYTES ARE 9 BITS LONG
>
	CHFDB%			;[335] UPDATE FDB
	HRLI T1,.FBSIZ(CF%NUD)	;NOW UPDATE NO. OF BYTES IN FILE
	SETO T2,		;CHANGE ALL BITS
	MOVE T3,FILEOF(F)	;NO. OF BYTES WE WROTE
	CHFDB%			;[335]

CLSFL2:	MOVE T1,FILFLG(F)	;GET FILE FLAGS
	TXNE T1,FI.DSK		;DISK FILE?
	TXNE T1,FI.OUT		; AND INPUT?
	JRST CLSFL3		;NO TO EITHER, DON'T UNMAP BUFFER
	PUSH P,T4		;UNMAPF CALLS CLRBIT, WHICH TRASHES T4
	CALL UNMAPF		;UNMAP FILE PAGES
	POP P,T4

CLSFL3:	JUMPN T4,CPOPJ		;[420] TEMP FILE CLOSE?
	HLRZ T1,FILPGN(F)	;[420] GET JFN OF FILE
	CLOSF%			;[335] NO, CLOSE IT
	  ERJMP E$$CFF		;CLOSE FAILURE FOR FILE
	RET
SUBTTL	I/O ROUTINES -- File Utility Routines -- Delete a Temp File


;DELFIL - DELETE FILE POINTED TO BY F

DELFIL:	CALL UNMAPF		;FIRST UNMAP ANY BUFFER PAGES
	HLRZ T1,FILPGN(F)	;GET JFN
	TXO T1,CZ%ABT		;ABORT (I.E., EXPUNGE) FILE
	CLOSF%			;[335] CLOSE AND DELETE IT
	  ERJMP E$$CFF		;[357] CAN'T CLOSE FILE
	RET
SUBTTL	I/O ROUTINES -- File Utility Routines -- Unmap Buffer Pages For a File

UNMAPF:	SETO T1,		;PREPARE TO UNMAP BUFFER
	MOVSI T2,.FHSLF		;THIS FORK
	HRR T2,FILBUF(F)	;STARTING FROM THIS PAGE
	HLRZ T3,FILBUF(F)	;UNMAP THIS MANY PAGES
	IORX T3,PM%CNT		; ..
	PMAP%			;[335]
	PUSH P,P1		;GET A REG
	HLRZ P1,FILBUF(F)	;GET PAGES PER BUFFER
	MOVN P1,P1		;NEGATE
	HRLZ P1,P1		;CONSTRUCT AOBJN PTR
	HRR P1,FILBUF(F)	;PUT PG NO IN RH

UNMAP1:	HRRZ T1,P1		;GET BIT (PAGE) NUMBER
	MOVEI T2,PGTAB		;CLEAR BIT IN PGTAB TO INDICATE
	CALL CLRBIT		; THAT THIS PAGE IS NOW UNMAPPED
	AOBJN P1,UNMAP1		;LOOP FOR ALL PAGES
	POP P,P1		;RESTORE P1
	RET
;ERSET$ -  CLEAN UP THE MESS AFTER A FATAL ERROR; CALLED BY DIE
;RESET$ - DEALLOCATE CORE AND UNMAP BUFFER PAGES; CALLED BY ENDS.

RESET$:	TDZA P3,P3		;[335] INDICATE CALLED BY ENDS.
ERSET$:	SETO P3,		;[335] INDICATE CALLED BY DIE
	MOVSI P1,-<<1000/^D36>+1> ;[C13] SET UP AOBJN PTR TO PGTAB
	SETZ P2,		;INIT BIT NUMBER

RESET1:	HRRZ T1,P1		;[C20] GET NEXT WORD OF PGTAB
	MOVE T1,PGTAB(T1)	;[C20]   ..
	JFFO T1,RESET2		;ANY ONE BITS?
	ADDI P2,^D36		;NO, STEP BIT NUMBER
	AOBJN P1,RESET1		;KEEP LOOKING
	JRST RESETC		;NO MORE BITS, CLOSE FILES

RESET2:	ADD T2,P2		;COMPUTE BIT WITHIN TABLE
	MOVE T1,T2		;SET UP FOR CALL TO CLRBIT
	PUSH P,T2		;SAVE BIT NUMBER OVER CLRBIT
	MOVEI T2,PGTAB		; ..
	CALL CLRBIT		;CLEAR THIS BIT
	POP P,T2		;RECOVER BIT (PAGE) NUMBER
	HRLI T2,.FHSLF		; FROM THIS FORK
	SETO T1,		;INDICATE UNMAPPING
	SETZ T3,		;ONE PAGE ONLY
	PMAP%			;[335] UNMAP IT
	JRST RESET1

RESETC:	CALL RELSPC		;[C13] RELEASE ALL RETAINED SPACE
				;WERE WE CALLED BY DIE?
	JUMPE P3,CPOPJ		;NO, FILES SHOULD BE CLOSED ALREADY
	MOVEI F,FCBORG		;YES, CLOSE AND ABORT MASTER FILE
	HLRZ T1,FILPGN(F)	;GET JFN
	IORX T1,CZ%ABT		;ABORT IT
	CLOSF%			;[335]
	  ERJMP .+1
	MOVE P3,ACTTMP		;[C20] GET NO. OF ACTIVE TMP FILES
	MOVEI F,TMPFCB		;[C20] SETUP PTR TO TMP FCB BLOCKS

RESTC2:	HLRZ T1,FILPGN(F)	;GET JFN
	IORX T1,CZ%ABT		;ABORT FILE
	CLOSF%			;[335]
	  ERJMP .+1
	ADDI F,FCBLEN		;[C20] STEP TO NEXT FCB
	SOJG P3,RESTC2		; ..
	RET
;MRKPGS - MARK PAGES OF THIS FILE AS POSSIBLY BEING MAPPED
;	  SO ON A FATAL ERROR THEY WILL BE UNMAPPED BY RESET%

MRKPGS:	PUSH P,P1		;GET A REG
	HLRZ P1,FILBUF(F)	;GET PAGES PER BUFFER
	MOVN P1,P1		;NEGATE
	HRLZ P1,P1		;MAKE AOBJN PTR
	HRR P1,FILBUF(F)	;PUT PAGE NO. IN RH

MRKPG1:	HRRZ T1,P1		;GET PAGE (BIT) NUMBER
	MOVEI T2,PGTAB		;SET BIT IN PGTAB
	CALL SETBIT		; ..
	AOBJN P1,MRKPG1		;DO IT FOR ALL PAGES
	POP P,P1		;RESTORE P1
	RET

;SETBIT - SET A BIT IN A TABLE
;CALL WITH:	T1/ BIT NO.
;		T2/ TABLE ADDR.

SETBIT:	CALL BITSET		;COMPUTE WORD AND SET UP BIT IN T3
	TDNE T3,0(T1)		;[OK] IS BIT ALREADY SET?
	JRST E$$FPM		;YES
	IORM T3,0(T1)		;[OK] NO, SET IT AND RETURN
	RET

;CLRBIT - ANALOGOUS TO SETBIT

CLRBIT:	CALL BITSET		;COMPUTE WORD ADDR AND SET UP BIT
	TDNN T3,0(T1)		;[OK] ALREADY CLEAR?
	JRST E$$FPU		;YES
	ANDCAM T3,0(T1)		;[OK] NO, CLEAR IT
	RET

;BITSET - COMPUTE WORD IN T1 AND PLACE BIT IN T3

BITSET:	MOVE T4,T2		;COPY TABLE ADDR
	IDIVI T1,^D36		;COMPUTE WORD AND BIT WITHIN WORD
	MOVX T3,<1B0>		;GET ZEROTH BIT
	MOVN T2,T2		;NEGATE BIT NO. FOR LSH
	LSH T3,0(T2)		;[OK] PUT BIT IN RIGHT PLACE
	ADD T1,T4		;COMPUTE WORD WITHIN TABLE
	RET
SUBTTL	I/O ROUTINES -- File Utility Routines -- Initialize Output Temporary File


ENTFIL:	AOS T1,NUMTMP		;COUNT RUNS
	HRLM T1,FILRUN(F)	;FOR COMPAR = TEST
	AOS T1,NUMENT		;COUNT TEMP FILES
	CAMLE T1,MAXTMP		;WRAPPED AROUND YET?
	CALLRET APPFIL		;YES, APPEND TO THIS FILE
	MOVX T1,FI.DSK!FI.OUT!FI.TMP ;SET APPROPRIATE FLAGS
	IORM T1,FILFLG(F)	; ..
	CALL GENNAM		;GENERATE NEW TEMP FILE NAME
	HRRZ T2,TCBIDX		;GET INDEX TO TEMP FILE
	IDIV T2,STRNUM		;ROUND ROBIN DIR NUMBERS
	MOVE T2,STRNAM(T3)	;[OK] GET DIRECTORY NUMBER FOR TEMP FILE
	CALL XGTJFN		;MAKE ASCIZ FILESPEC AND DO GTJFN
	MOVX T2,OF%WR		;OPEN FOR WRITE
	OPENF%			;[335]
	  ERJMP E$$OPN
	HRLZM T1,FILPGN(F)	;SAVE JFN AND ZERO PAGE COUNTER
	SKIPGE BUFALC		;HAVE BUFFERS BEEN ALLOCATED YET?
	JRST	[HRRZ T1,FILBUF(F) ;YES, GET ADDRESS OF BUFFER
		 JRST ENTFL1]	;GO SET UP BYTE POINTER
	MOVE T1,TBUFNO		;GET PAGES PER TEMP FILE BUFFER
	HRLZM T1,FILBUF(F)	;SAVE IN FCB
	LSH T1,POW2(PGSIZ)	;COMPUTE WORDS IN BUFFER
	MOVEM T1,FILBPB(F)	;SAVE BYTES (=WORDS) PER BUFFER
	CALL ALCBPG		;ALLOCATE BUFFER ON PG BOUNDARY
	LSH T1,-<POW2(PGSIZ)>	;CONVERT ADDR OF BUFFER TO PAGE NO.
	HRRM T1,FILBUF(F)	;SAVE IN FCB

ENTFL1:	LSH T1,POW2(PGSIZ)	;CONVERT BACK TO ADDRESS
	ADD T1,CBPTR		;CONSTRUCT BYTE POINTER
	MOVEM T1,FILPTR(F)	;SAVE IT
	MOVE T1,FILBPB(F)	;GET BYTES PER BUFFER
	MOVEM T1,FILCNT(F)	;INDICATE BUFFER WAITING TO BE FILLED
	SETZM FILEOF(F)		;INDICATE NOTHING'S BEEN WRITTEN YET
	RET			;RETURN

;SETTMP - PLUG OUR CONNECTED DIRECTORY NUMBER INTO STRNAM
;         AS A DEFAULT IF USER DIDN'T TYPE ANY /TEMP SWITCHES

IFE FTCOBOL,<
SETTMP:	SKIPE STRNUM		;DID USER TYPE ANY /TEMP SWITCHES?
	RET			;YES, WE'RE ALL SET
	SETZ T1,		;GET DIRECTORY ASSOCIATED WITH DSK:
	HRROI T2,[ASCIZ /DSK:/]	; TO BE CONSISTENT WITH MOST EXEC COMMANDS
	RCDIR%			;[335]
	  ERJMP NODISK		;MIGHT BE DEFINED TO BE A NON-DISK DEV
	MOVEM T3,STRNAM		;SAVE IN TABLE
	AOS STRNUM		;INDICATE ONLY ONE TEMP FILE AREA
	RET			;AND RETURN

NODISK:	GJINF%			;[335] NO, GET CONNECTED DIRNUM IN T2
	MOVEM T2,STRNAM		;SAVE IN TABLE
	AOS STRNUM		;INDICATE ONLY ONE TEMP FILE AREA
	RET			;AND RETURN
>
SUBTTL	I/O ROUTINES -- File Utility Routines -- Append to Temporary File

APPFIL:	HRRZ T1,TCBIDX		;GET TMP FILE INDEX
	IMULI T1,DFBLEN		;FIND OFFSET OF DFB BLOCK FOR FILE
	ADDI T1,DFBORG		;ADD BASE ADDRESS OF DFB BLOCKS
	HRLZ T1,T1		;CONSTRUCT BLT POINTER
	HRR T1,F		;COPY TO CURRENT FCB
	HRRZI T2,DFBLEN(F)	;[C20] BLT LIMIT
	HLRZ T3,FILRUN(F)	;PRESERVE RUN NUMBER ENTFIL COMPUTED
	BLT T1,-1(T2)		;[OK] RESTORE INFORMATION TO FCB
	HRLM T3,FILRUN(F)	;RESTORE RUN NUMBER ENTFIL COMPUTED
	MOVE T3,FILEOF(F)	;GET FILE SIZE
	IDIVI T3,PGSIZ		;GET PAGE NUMBER OF LAST PAGE
	HRRM T3,FILPGN(F)	;[335] REMEMBER FOR PMAP%
	HRRZ T1,FILBUF(F)	;GET 1ST PG OF BUFFER
	LSH T1,POW2(PGSIZ)	;COMPUTE ADDRESS
	ADD T1,T4		;[C20] COMPUTE 1ST UNUSED WORD
	ADD T1,CBPTR		;CONSTRUCT BYTE POINTER
	MOVEM T1,FILPTR(F)	;SAVE IT
	JUMPE T4,APPFL1		;IF FILE ENDS ON PG. BOUNDARY, NO
				; NEED TO READ PARTIAL PAGE IN
	MOVE T1,FILPGN(F)	;[335] GET PMAP% SOURCE IDENT
	MOVSI T2,.FHSLF		;CONSTRUCT IDENT TO BUFFER
	HRR T2,FILBUF(F)	; ..
	MOVX T3,PM%RD!PM%CPY!PM%PLD ;COPY-ON-WRITE ACCESS
	PMAP%			;[335] GET THE PARTIALLY WRITTEN PAGE
	MOVE T1,FILEOF(F)	;GET WORDS WRITTEN SO FAR
	SUB T1,T4		;SUBTRACT PARTIAL PAGE (BECAUSE
	MOVEM T1,FILEOF(F)	; PUTBUF WILL COUNT THEM AGAIN)

APPFL1:	MOVE T2,FILBPB(F)	;GET BYTES PER BUFFER
	SUB T2,T4		;COMPUTE BYTES LEFT IN BUFFER
	MOVEM T2,FILCNT(F)	;REMEMBER
	HRRZ T1,FILPTR(F)	;GET ADDR OF FIRST WORD TO BE USED
	HLRO T2,FILRUN(F)	;FAKE SIXBIT WORD COUNT FOR EOF MARKER
	MOVEM T2,0(T1)		;[OK] SET EOF MARKER
	AOS FILPTR(F)		;BUMP BYTE PTR PAST EOF MARKER
	SOSG FILCNT(F)		;ACCOUNT FOR THE WORD WE WROTE
	JSP T4,PUTBUF		;COUNT EXPIRED, GET FRESH BUFFER
	RET
;LKPFIL - SET UP TO START READING FROM BEGINNING OF TEMP FILE

LKPFIL:	MOVX T1,FI.DSK!FI.TMP	;REMEMBER THIS IS A TEMP FILE
	IORM T1,FILFLG(F)	; ..
	MOVX T1,FI.OUT		;REMEMBER WE'RE NO LONGER
	ANDCAM T1,FILFLG(F)	; DOING OUTPUT TO THIS FILE
	SKIPGE BUFALC		;HAVE BUFFERS BEEN ALLOCATED YET?
	JRST LKPFL1		;YES, DON'T DO IT AGAIN
	MOVE T1,TBUFNO		;GET PAGES PER TEMP FILE BUFFER
	HRLZM T1,FILBUF(F)	;SAVE SIZE OF BUFFER IN FCB
	LSH T1,POW2(PGSIZ)	;CONVERT PAGES TO WORDS
	MOVEM T1,FILBPB(F)	;SAVE WORDS (=BYTES) PER BUFFER
	CALL ALCBPG		;ALLOCATE BUFFER ON PAGE BOUNDARY
	LSH T1,-<POW2(PGSIZ)>	;CONVERT ADDRESS TO PAGE
	HRRM T1,FILBUF(F)	;SAVE ADDR OF BUFFER IN FCB

LKPFL1:	CALL MRKPGS		;MARK PAGES AS POSSIBLY MAPPED
	SETZM FILCNT(F)		;SO FIRST CALL TO GETREC CAUSES PMAP
	HLLZS FILPGN(F)		;RESET PG COUNTER FOR PMAP
	RET
;XGTJFN - CONVERT DIRNUM AND SIXBIT FILE NAME TO ASCIZ FILESPEC
;CALL WITH:
;	T1/ SIXBIT FILENAME
;	T2/ DIRECTORY NUMBER
;RETURNS:
;	+1: WITH JFN IN T1

XGTJFN:	PUSH P,P1		;GET SOME REGS
	PUSH P,P2		; ..
	DMOVE P1,T1
	HRROI T1,AZTEMP		;[405] CONVERT ADDRESS TO STRING PTR
	PUSH P,T1		;SAVE PTR TO START OF STRING
	DIRST%			;[335] MAKE A STRING
	  ERJMP E$$IDN		;INVALID DIRECTORY NUMBER

;NOW CONVERT THE SIXBIT STRING IN P1 TO ASCII, USING BIS.  NOTE
; THAT THIS CODE ASSUMES THAT P1 ALWAYS CONTAINS 6 CHARACTERS.

	MOVE P2,T1		;COPY CURRENT BYTE PTR TO FILESPEC
	MOVEI T0,6		;SOURCE STRING LENGTH
	MOVE T1,[POINT 6,P1]	;BYTE PTR TO 6-BIT SOURCE STRING
	MOVEI T3,6		;DESTINATION STRING LENGTH
	MOVE T4,P2		;COPY BYTE PTR TO FILESPEC
	EXTEND T0,[MOVSO 40]	;ADD 40 TO EACH BYTE TO PRODUCE ASCII
	JRST E$$BIS		;ERROR

;ADD TYPE AND ;T ATTRIBUTE TO FILESPEC

	MOVEI T0,7		;MOVE 7 CHARACTERS (INCLUDING THE NULL)
	MOVE T1,[POINT 7,[ASCIZ /.TMP;T/]]
	MOVEI T3,7		;7 CHARS IN DEST
	EXTEND T0,[MOVSLJ]	;T4 ALREADY HAS GOOD DEST PTR
	JRST E$$BIS		;ERROR
	MOVX T1,GJ%SHT		;SHORT FORM
	POP P,T2		;GET BYTE PTR TO FILESPEC
	GTJFN%			;[335] GET THE JFN
	  ERJMP E$$GFT		;FAILED
	POP P,P2		;RESTORE P REGS
	POP P,P1		; ..
	RET			;ALL SET, RETURN WITH T1=JFN
SUBTTL	TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE

IFE FTCOBOL,<

;TSTDEV - CHECK TO SEE IF SINGLE TEMP FILE IS ON SAME STRUCTURE
;	 AS OUTPUT FILE.  IF SO, WE CAN RENAME INSTEAD OF COPY.

TSTDEV:	HRRZ T1,IOMODE		;GET I/O MODE INDEX
	CAXE T1,MODSIXBIT	;ONLY SIXBIT LOOKS LIKE TEMP FILE
	RET
	MOVE P1,F.OUZR		;[436] LOAD ADDRESS OF OUTPUT X.BLOCK
	MOVS T1,@EXTORG		;[OK] [C13] GET EXTRACT CODE
	CAIN T1,(JRST (P4))	;JUST A DUMMY?
	SKIPE X.BLKF(P1)	;[OK] CAN'T DO IF OUTPUT BLOCKED
	RET			;DO THE COPY
	LDB T1,[POINT 9,X.DVCH(P1),17] ;[OK] GET DEVICE TYPE OF OUTPUT FILE
	CAXE T1,.DVDSK		;DISK?
	RET			;NO, MUST COPY TO OUTPUT FILE
	PUSH P,P2		;GET A REGISTER
	MOVEI T1,2		;ALLOCATE ENOUGH WORDS TO BUILD
	CALL GETSPC		; DEVICE NAME STRING
	  JRST E$$NEC
	SETZM 0(T1)		;[OK] ZERO STRING SPACE
	SETZM 1(T1)		;[OK]  ..
	MOVE P2,T1		;SAVE STRING ADDRESS
	HRROS T1		;CONSTRUCT STRING PTR TO IT
	MOVEI T2,TMPFCB		;ONLY ONE TMP FILE, SO FCB IS AT TMPFCB
	HLRZ T2,FILPGN(T2)	;[OK] PICK UP JFN
	MOVX T3,<1B2>		;OUTPUT ONLY DEVICE FIELD
	JFNS%			;[335] GET IT
	  ERJMP E$$JFT		;FAILED
	MOVEI T1,2		;ALLOCATE SPACE FOR DEVICE NAME STRING
	CALL GETSPC		; OF OUTPUT FILE
	  JRST E$$NEC
	SETZM 0(T1)		;[OK] ZERO STRING SPACE
	SETZM 1(T1)		;[OK]  ..
	MOVE T4,T1		;SAVE ADDRESS
	HRROS T1		;CONSTRUCT STRING PTR
	HRRZ T2,X.JFN(P1)	;[OK] GET JFN OF OUTPUT FILE
	MOVX T3,<1B2>		;GET DEVICE FIELD ONLY
	JFNS%			;[335]   ..
	  ERJMP E$$JFO		;FAILED

; ..
; ..

;T4 NOW POINTS TO DEVICE STRING FOR OUTPUT FILE, P2 POINTS TO
; DEVICE STRING FOR TEMP FILE.  COMPARE USING BIS AND SET UP
; TO DO RENAME IF THEY ARE EQUAL.

	MOVEI T0,6		;SOURCE STRING LENGTH
	HRRZ T1,T4		;GET ADDR OF OUTPUT FILE DEVICE STRING
	HRLI T1,(POINT 7,)	;CONSTRUCT BYTE POINTER
	SETZ T2,		;NOT USED BY BIS
	MOVEI T3,6		;DEST STRING LENGTH
	HRRZ T4,P2		;GET ADDR OF TMP FILE DEVICE STRING
	POP P,P2		;RESTORE P2 NOW
	HRLI T4,(POINT 7,)	;CONSTRUCT BYTE POINTER
	EXTEND	T0,[CMPSE	;COMPARE STRINGS, SKIP IF EQUAL
		    0		; ZERO FILL IF EITHER
		    0]		; STRING RUNS OUT
	JRST	[MOVEI T1,4	;FREE STRING SPACE WE GRABBED
		 CALLRET FRESPC];NON-SKIP RETURN, MUST DO COPY
	MOVEI T1,4		;FREE STRING SPACE WE GRABBED
	CALL FRESPC		; ..
	MOVEI T1,RSTF		;ADDR OF ROUTINE TO RENAME OUTPUT FILE
	RETSKP			;SKIP RETURN TO INDICATE RENAME POSSIBLE
;RSTF - RENAME SOLITARY TEMP FILE TO BE SORT OUTPUT MASTER

RSTF:	MOVEI T3,TMPFCB		;ONLY ONE TEMP FILE, FCB LIVES AT TMPFCB
	HLRZ T1,FILPGN(T3)	;[OK] GET SOURCE JFN (OF TEMP FILE)
	IORX T1,CO%NRJ		;DON'T RELEASE JFN
	CLOSF%			;[335] CLOSE IT
	  ERJMP E$$CFR		;SOMETHING WRONG
	MOVE T4,F.OUZR		;GET ADDR OF X. BLOCK FOR OUTPUT FILE
	HRRZ T1,X.JFN(T4)	;[OK] GET JFN OF OUTPUT FILE
	IORX T1,CO%NRJ		;DON'T RELEASE JFN
	CLOSF%			;[335] CLOSE FILE
	  ERJMP E$$CFR		;OOPS
	HLRZ T1,FILPGN(T3)	;[OK] GET TEMP FILE JFN AGAIN
	HRRZ T2,X.JFN(T4)	;[OK] GET OUTPUT FILE JFN
	RNAMF%			;[335] DO THE RENAME
	  ERJMP E$$RFF		;FAILED
	MOVE T1,FILEOF(F)	;[437] TMPFCB #BYTES
	MOVEI F,FCBORG		;[437] CHANGE F TO WHAT IS EXPECTED
	MOVEM T1,FILEOF(F)	;[437] AND GIVE FCBORG CORRECT INFO
	MOVE T1,INPREC		;FAKE COPY OF FILE
	MOVEM T1,FILSIZ(F)	;[437] GIVE THIS INFO TOO FOR EOFOUT
	MOVE T1,T2(T4)		;[OK] [437] SET UP OPENF
	MOVE T2,[44B5+OF%RD+OF%WR];[437] BECAUSE CLSFIL
	OPENF%			;[437] NEEDS IT OPEN FOR CHFDB
	  ERJMP E$$OPN		;[437] FAILURE!
	CALLRET EOFOUT		;TOP LEVEL RETURN

E$$CFR:	$ERROR (?,CFR,<CLOSE failure at RSTF>,+)	;[357]
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO

E$$RFF:	$ERROR (?,RFF,<RENAME failed at RSTF>,+)	;[357]
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO
>;END IFE FTCOBOL
SUBTTL	GETREC -- GETBUF - Input 1 Physical Buffer -- Set Up

;CALL WITH:	JSP T4,GETBUF
;RETURNS:	+1/ END OF FILE
;		+2/ SUCCESS, T1 CONTAINS NO. OF BYTES READ

GETBUF:	PUSH P,T4		;PUSH RETURN ADDRESS
IFN FTCOBOL,<
	JRST	GETDSK		;[C03] ONLY GETDSK IN COBOL SORT
>
IFE FTCOBOL,<
	MOVE T1,FILFLG(F)	;[435] GET FILE FLAGS
	TXNE T1,FI.DSK		;[435] FILE ON DISK?
	JRST GETDSK		;YES
	TXNE T1,FI.MTA		;[435] MAGTAPE?
	JRST GETMTA		;YES
	MOVE T1,FILXBK(F)	;GET ADDR OF X. BLOCK FOR FILE
	LDB T1,[POINT 9,X.DVCH(T1),17] ;[OK] GET DEVICE TYPE
	CAXN T1,.DVTTY		;IS THIS A TTY?
	JRST GETTTY		;YES, HANDLE UNIQUELY
	HLRZ T1,FILPGN(F)	;GET JFN
	HRRO T2,FILBUF(F)	;STRING PTR TO BUFFER
	MOVE T3,FILBPB(F)	;LENGTH OF STRING
	SETZ T4,		;OR STOP ON NULL
	SIN%			;[335] GET IT
	  ERJMP [MOVX T1,.FHSLF	;[N15] [C02] GET MOST RECENT ERROR NUMBER
		GETER%		;[335]   ..
		HRRZ T1,T2	; ..
		CAXE T1,IOX4	;END OF FILE?
		JRST E$$BER	;NO, HARD INPUT ERROR
		CAMN T3,FILBPB(F) ;WAS BYTE COUNT ALTERED (I.E., WAS ANYTHING READ?)
		JRST GETEOF	;[C03] NO, GIVE EOF RETURN
		JRST .+1]	;[N15] [C03] YES, CONTINUE
	MOVE T1,FILBPB(F)	;GET BYTES PER BUFFER
	SUB T1,T3		;DEDUCT NO. OF BYTES NOT READ
	MOVEM T1,FILCNT(F)	;EQUALS NO. OF BYTES IN THIS BUFFERLOAD
	HRRZ T1,FILBUF(F)	;CONSTRUCT BYTE PTR TO BUFFER
	ADD T1,CBPTR		; ..
	MOVEM T1,FILPTR(F)	; ..
	MOVE T1,FILCNT(F)	;[C03] RETURN WITH BYTE COUNT IN T1
	RETSKP			;GIVE GOOD RETURN
SUBTTL	GETREC -- GETBUF - Input 1 Physical Buffer -- Terminal


GETTTY:	HRRZ T4,FILBUF(F)	;CONSTRUCT BYTE POINTER TO BUFFER
	ADD T4,CBPTR		; ..
	MOVEM T4,FILPTR(F)	;INIT BUFFER POINTER IN FCB
	SETZM FILCNT(F)		;INIT BYTE COUNTER
	MOVE T3,FILBPB(F)	;GET BYTES PER BUFFER FOR COUNTDOWN

GETTT1:	HLRZ T1,FILPGN(F)	;GET JFN
	BIN%			;[335] GET A BYTE
	CAXN T2,.CHCNZ		;CTRL-Z?
	JRST [	SKIPN FILCNT(F) ;[C03] WAS ANYTHING READ THIS TIME?
		JRST GETEOF	;[C03] NO, GIVE EOF RETURN
		BKJFN%		;[C03] YES, BACKUP OVER CTRL-Z
		  ERJMP E$$BER	;[C03] ERROR
		MOVE T1,FILCNT	;[C03] RETURN WITH BYTE COUNT IN T1
		RETSKP]		;AND GIVE GOOD RETURN
	AOS T1,FILCNT(F)	;COUNT DATA BYTES
	IDPB T2,T4		;PLUNK IT INTO THE BUFFER
	SOJG T3,GETTT1		;GET THE NEXT BYTE, UNLESS BUFFER FULL
	RETSKP			;RETURN WITH T1=NO. OF BYTES READ

>;END IFE FTCOBOL

GETEOF:	MOVE EF,PHYEOF		;[C03] GIVE EOF RETURN
	RET			;[C03]  ..
SUBTTL	GETREC -- GETBUF - Input 1 Physical Buffer -- Disk


GETDSK:	SKIPG T1,FILEOF(F)	;[C17] ANY BYTES LEFT?
	JRST GETEOF		;[C03] NO, GIVE EOF RETURN
	MOVE T2,FILBPB(F)	;GET NO. OF BYTES PER BUFFER
	CAMLE T1,T2		;MORE THAN 1 BUFFER'S WORTH LEFT?
	MOVE T1,T2		;YES, JUST READ ONE BUFFER'S WORTH
	MOVEM T1,FILCNT(F)	;SAVE NO. OF BYTES IN THIS BUFFERLOAD
	MOVE T3,FILEOF(F)	;GET NO. OF BYTES LEFT IN FILE
	SUB T3,T1		;SUBTRACT NO. WE'RE READING
	MOVEM T3,FILEOF(F)	;SAVE NEW NO. OF BYTES LEFT IN FILE
IFE FTCOBOL,<
	MOVN T2,T1		;[C17] DECRIMENT BLOCK BYTE COUNT
	ADDM T2,FILKCT(F)	;[C17]   ..
	MOVX T2,FI.TMP		;IS THIS A TEMP FILE?
	TDNE T2,FILFLG(F)	; IF SO, WORDS=BYTES
	JRST GETDS1		;YES, SKIP THE DIVIDE
	IDIV T1,IOBPW2		;[C03] COMPUTE NO. OF WORDS WE'RE READING
	SKIPE T2		;[C03] COUNT PARTIAL WORDS
	ADDI T1,1		;[C03]  ..
GETDS1:
>
	IDIVI T1,PGSIZ		;COMPUTE NO. OF PAGES WE'RE READING
	SKIPE T2		;COUNT PARTIAL PAGES
	ADDI T1,1		; ..
	MOVX T3,PM%CNT!PM%PLD	;[335] CONSTRUCT PAGE COUNT FOR PMAP%
	ADD T3,T1		; ..
	MOVE T1,FILPGN(F)	;GET JFN,,PAGE NO.
	HRLI T2,.FHSLF		;MAP TO THIS FORK
	HRR T2,FILBUF(F)	;PAGE INTO WHICH TO START MAPPING
	PMAP%			;[335] MAP THE FILE
IFE FTCOBOL,<			;[402] TEMP FILES DON'T HAVE HOLES
	  ERCAL FIXMAP		;[402] SEE WHICH SECTION PMAP% FAILED
  IF NOT A TEMP FILE
	MOVX T4,FI.TMP		;[402] LOAD TEMP FILE BIT
	TDNN T4,FILFLG(F)	;[402] TEMP FILE?
  THEN BEWARE OF HOLES IN INPUT FILES
	CALL FIXPGS		;[402] NO--MAY HAVE HOLES TO FIX
  FI;
> ;[402] END OF IFE FTCOBOL
	HLRZ T1,FILBUF(F)	;GET PAGES PER BUFFER
	HRRZ T2,FILPGN(F)	;GET CURRENT PAGE NUMBER
	ADD T1,T2		;COMPUTE NEXT PAGE NUMBER
	HRRM T1,FILPGN(F)	;SAVE IT

	HRRZ T1,FILBUF(F)	;GET 1ST PAGE OF BUFFER
	LSH T1,POW2(PGSIZ)	;TURN INTO ADDRESS
	ADD T1,CBPTR		;CONSTRUCT BYTE POINTER
	MOVEM T1,FILPTR(F)	;INITIALIZE BYTE PTR TO BUFFER
	MOVE T1,FILCNT(F)	;RETURN WITH T1=NO. OF BYTES READ
	RETSKP			;RETURN
IFE FTCOBOL,<

BEGIN
  PROCEDURE	(PUSHJ	P,FIXPGS)	;[402] MAKE HOLES INTO ZERO PAGES

;CERTAIN FILE FORMATS SUPPORTED BY SORT ARE ALLOWED TO CONTAIN HOLES, NAMELY,
;PAGES THAT DO NOT EXIST IN THE FILE. SINCE SORT IS ESSENTIALLY A SEQUENTIAL
;PROCESSOR, IT SHOULD TREAT THESE HOLES AS PAGES FULL OF ZEROS. THIS IS
;CONSISTENT WITH THE MONITOR'S HANDLING OF SIN% AND PRE-JSYSIZED VERSIONS OF
;SORT.
;
;SIMPLE HOLES ARE THOSE PAGES THAT DO NOT EXIST IN A FILE SECTION THAT DOES
;EXIST. IN THIS CASE, THE PMAP% JSYS THAT MAPS THE PAGES (ASSUMED FOR READ-ONLY
;FROM A FILE OPEN FOR READ-ONLY) WILL SUCCEED, BUT MEMORY REFERENCES INTO THE
;MAPPED PAGES WILL FAIL. THIS ROUTINE TESTS FOR THESE HOLES BY REFERENCING THE
;FIRST WORD IN EACH PAGE JUST MAPPED. ANY FAILURES (DETECTED BY AN ERJMP) THEN
;CAUSE THE OFFENDING PAGE TO BE UNMAPPED. THIS GIVES A ZERO-FILLED PAGE FOR SORT
;TO READ.
;
;CALL:
;	T1-T3/	ARGUMENTS GIVEN TO PMAP%
;	F/	POINTER TO THIS FILE'S FILE BLOCK
;RETURNS WITH T1-T4 DESTROYED, AND ALL HOLE PAGES UNMAPPED.

	PUSH	P,P1			;[C20] SAVE P1, NEED AN EXTRA AC
	HRRZ	T4,FILBUF(F)		;[C20] [402] BUILD POINTER FOR PAGES
	LSH	T4,POW2(PGSIZ)		;[402]   POINTING TO ADDRESS OF PAGE
	HRRZ	P1,T3			;[C20] [402] GET PAGE COUNT
	SETO	T1,			;[402] MAKE PMAP% ARGS SPECIFY UNMAPPING
	MOVX	T3,<PM%CNT+1>		;[402]   IN CASE WE HAVE TO
  WHILE THERE ARE PAGES TO CHECK
	BEGIN
		SKIP	(T4)		;[OK] [402] TOUCH THE PAGE
		  ERJMP	[PMAP%			;[402] FAILED--UNMAP IT
			 JRST .+1]		;[402]   AND CONTINUE LOOKING
		ADDI	T2,1		;[402] ADVANCE PMAP% ARGS
		ADDI	T4,PGSIZ	;[C20] [402] ADVANCE POINTER
		SOJG	P1,$B		;[C20] [402] LOOP UNTIL NO MORE PAGES
	END;
	POP	P,P1			;[C20] RESTORE P1
	RETURN				;[402] DONE
END;
;STILL IN IFE FTCOBOL

BEGIN
  PROCEDURE	(PUSHJ	P,FIXMAP)	;[402] MAKE ZERO PAGES WHEN PMAP% FAILS

;IF A PMAP% JSYS FAILS FOR AN INPUT FILE, THEN SOME OF THE REQUESTED PAGES WERE
;IN A FILE SECTION THAT HAS NO INDEX BLOCK. IN THIS CASE, THE MONITOR IS
;UNWILLING TO GIVE US ANYTHING, EVEN INFORMATION ON HOW MUCH OF THE REQUEST THE
;PMAP% JSYS WAS ABLE TO MAP BEFORE QUITTING. THEREFORE, WE MUST ANALYZE THE
;STATE OF THINGS OURSELVES TO PERFORM RECOVERY.
;
;THE METHOD USED IS IN TWO PARTS. IF THERE IS NO FILE SECTION BOUNDARY
;REPRESENTED IN THE PMAP% REQUEST, THEN ALL OF THE PAGES WERE FROM THE SAME NON-
;EXISTENT SECTION. IN THIS CASE, WE SIMPLY UNMAP THEM ALL. IF THERE IS A FILE
;SECTION BOUNDARY WITHIN THE PMAP% REQUEST, THEN EITHER PORTION OF THE REQUEST
;MAY HAVE CAUSED THE PMAP% TO FAIL. IN THIS CASE, WE MUST RETRY BOTH HALVES OF
;THE PMAP% REQUEST AGAIN (THOSE PAGES BEFORE THE SECTION BOUNDARY AND THOSE
;AFTER IT), BUT SEPARATELY. IF EITHER (OR BOTH) FAILS, THEN WE UNMAP THOSE
;PAGES. WE MAKE THE LIKELY ASSUMPTION THAT THERE IS AT MOST 1 SECTION BOUNDARY
;WITHIN THE REQUESTED GROUP OF PAGES.
;
;CALL:
;	T1-T3/	ARGUMENTS TO PMAP% THAT FAILED
;RETURNS WITH PAGES FROM NON-EXISTENT SECTIONS UNMAPPED, WITHOUT DESTROYING
;T1-T3.

	PUSH	P,P1			;[C20] SAVE P1
	PUSH	P,T1			;[402] SAVE T1-T3
	PUSH	P,T2			;[402]   ..
	PUSH	P,T3			;[402]   ..
  IF FAILING PMAP% REQUEST WAS CONTAINED IN 1 SECTION
	HRRZ	T4,T1			;[402] COMPUTE LAST PAGE OF
	IORX	T4,PGSIZ-1		;[402]   CURRENT FILE SECTION
	HRRZ	P1,T1			;[C20] COMPUTE # AGES TO THERE
	SUBI	T4,-1(P1)		;[C20] [402]   ..
	HRRZ	P1,T3			;[C20] MORE THAN WE ASKED FOR?
	CAMGE	T4,P1			;[C20] [402]   ..
	JRST	$T			;[402] NO-- REQUEST CROSSED SECTION BDY
  THEN ALL IN SAME NON-EXISTENT SECTION SO JUST UNMAP ALL PAGES
	PUSHJ	P,UNMAP			;[402] UNMAP MAPPED PAGES
	JRST	$F			;[402]
  ELSE EITHER OR BOTH SECTIONS MAY NOT EXIST SO TRY EACH ONE
	HRR	T3,T4			;[402] RETRY FIRST SECTION OF PMAP%
	PMAP%				;[402]   ..
	  ERCAL	UNMAP			;[402] DOESN'T EXIST--UNMAP IT
	ADD	T1,T4			;[402] TRY SECOND SECTION OF PMAP%
	ADD	T2,T4			;[402]   ..
	HRR	T3,0(P)			;[402]   ..
	SUB	T3,T4			;[402]   ..
	PMAP%				;[402]   ..
	  ERCAL	UNMAP			;[402] DOESN'T EXIST--UNMAP IT
  FI;
	POP	P,T3			;[402] RESTORE ACS FOR CALLER
	POP	P,T2			;[402]   ..
	POP	P,T1			;[402]   ..
	POP	P,P1			;[C20]   ..
	RETURN				;[402] DONE
END;
;STILL IN IFE FTCOBOL

BEGIN
  PROCEDURE	(PUSHJ	P,UNMAP)	;[402] UNMAP MAPPED PAGES

;UNMAP UNMAPPS THE PAGES SPECIFIED BY THE PMAP% ARGUMENTS IN T1-T3. DESTROYS NO ACS.

	PUSH	P,T1			;[402] SAVE SOURCE
	SETO	T1,			;[402]   SO WE CAN MAKE IT UNMAP ARG
	PMAP%				;[402] UNMAP THE PAGES
	POP	P,T1			;[402] RESTORE SOURCE
	RETURN				;[402] DONE
END;

> ;[402] END OF IFE FTCOBOL
SUBTTL	GETREC -- GETBUF - Input 1 Physical Buffer -- Magtape


IFE FTCOBOL,<
GETMTA:	MOVEI T1,INLST		;[C08] LOAD PARAMETER FOR SWTBUF
	CALL SWTBUF		;[C08] SWITCH BYTE POINTER AND IOWD BLOCK
	SETZM FILCNT(F)		;[C08] ZAP FILCNT

;START I/O ON NEXT BUFFER AND WAIT FOR I/O TO FINISH ON THIS ONE

	HLRZ T1,FILPGN(F)	;[C08] GET JFN
	MOVX T2,DM%NWT		;[C08] SET "DO NOT WAIT" BIT
	HRRI T2,INLST		;ADDR OF COMMAND LIST
	DUMPI%			;[335] DO IT
	  ERCAL [CAXN T1,IOX4		;[C08] END OF FILE?
		JRST [	HLRZ T1,FILPGN(F)	;YES, GET JFN
			GDSTS%			;[335] GET CURRENT STATUS
			TXZ T2,MT%EOF		;CLEAR EOF FLAG
			SDSTS%			;[335]   ..
			POP P,(P)		;[C03] FIX UP STACK
			JRST GETEOF]		;[C03] GIVE EOF RETURN
		CAXE T1,IOX5		;DEVICE OR DATA ERROR?
		JRST E$$DME		;NO, BUG SOMEWHERE
		HLRZ T1,FILPGN(F)	;GET JFN
		GDSTS%			;[335] GET DEVICE STATUS
		TXZN T2,MT%IRL		;RECORD LENGTH INCORRECT?
		JRST E$$DME		;NO, BUG SOMEWHERE
		SDSTS%			;[335] CLEAR MT%IRL
		HLRZ T3,T3		;YES, GET BYTES READ INTO RH(T3)
		IDIV T3,FILHBW(F)	;[C03] CONVERT HARDWARE BYTES TO WORDS
		SKIPE T4		;[C03] INCLUDING PARTIAL WORDS
		ADDI T3,1		;[C03]  ..
		IMUL T3,IOBPW2		;[C03] CONVERT TO BYTES
		MOVEM T3,FILCNT(F)	;SAVE IN FCB
		MOVX T2,DM%NWT		;[C08] RESTART I/O
		HRRI T2,INLST		;[C08]   ..
		DUMPI%			;[335]   ..
		  ERJMP E$$DME		;TROUBLE
		RET]			;[C03] REJOIN MAIN FLOW
	SKIPN T1,FILCNT(F)	;GET BYTES PER (FULL) BUFFER
	MOVE T1,FILBPB(F)	;[C03] UNLESS THE HAIRY LITERAL ABOVE
				; COMPUTED FILCNT FOR US,
	MOVEM T1,FILCNT(F)	;INDICATE BUFFER HAS BEEN FILLED
	RETSKP			;GIVE GOOD RETURN

;SWTBUF - SWITCH MAGTAPE BUFFERS
;         CALL WITH C(T1) = IOWD BLOCK ADDRESS

SWTBUF:	MOVE T4,FILFLG(F)	;[C02] GET FLAGS
	TXC T4,FI.BF2		;[C02] SWITCH FLAG
	MOVEM T4,FILFLG(F)	;[C02]  ..
	HRRZ T2,FILBF2(F)	;[C02] GET ADDRESS FOR IOWD WORD
	HRRZ T3,FILBUF(F)	;[C02] GET ADDRESS FOR BYTE POINTER
	TXNE T4,FI.BF2		;[C02] BUFFERS SWAPPED?
	EXCH T2,T3		;[C02] YES, SWITCH ADDRESES
	HLRZ T4,FILBUF(F)	;[C02] SET IOWD WORD
	MOVN T4,T4		;[C02]  ..
	HRL T2,T4		;[C02]  ..
	SUBI T2,1		;[C20] [C02]  ..
	MOVEM T2,0(T1)		;[OK] [C02]  ..
	SETZM 1(T1)		;[OK] [C02] TIE OFF END OF IOWD BLOCK
	MOVE T4,IOMODE		;[C02] INDUSTRY COMPATIBLE EBCDIC MAGTAPE?
	CAXE T4,MODEBCDIC	;[C02]  ..
	JRST SWTBF1		;[C02]  ..
	MOVE T4,FILFLG(F)	;[C02]  ..
	TXNE T4,FI.IND		;[C02]  ..
	TXNN T4,FI.MTA		;[C02]  ..
	JRST SWTBF1		;[C02]  ..
	HRLI T3,(POINT 8,)	;[C02] YES, BUILD 8-BIT BYTE POINTER
	SKIPA			;[C02]
SWTBF1:	ADD T3,CBPTR		;[C02] NO, BUILD DEFAULT BYTE POINTER
	MOVEM T3,FILPTR(F)	;[C02] STORE BYTE POINTER
	RET			;[C02]

>;END IFE FTCOBOL

SUBTTL	PUTREC -- PUTBUF - Output 1 Physical Buffer -- Set Up


;CALL:		JSP T4,PUTBUF
;RETURNS:	+1/ ALWAYS, T1 CONTAINS NO. OF BYTES IN BUFFER

PUTBUF:	PUSH P,T4		;PUSH RETURN ADDR ON STACK
	MOVE T1,FILCNT(F)	;[C03] EMPTY BUFFER?
	CAML T1,FILBPB(F)	;[C03]   ..
	RET			;[C03] YES, RETURN WITH BYTE COUNT IN T1
IFE FTCOBOL,<			;FALL THROUGH TO PUTDSK IN COBOL SORT
	MOVE T1,FILFLG(F)	;[435] GET FILE FLAGS
	TXNE T1,FI.DSK		;[435]  FILE ON DISK?
	JRST PUTDSK		;YES
	TXNE T1,FI.MTA		;[435] MAGTAPE?
	JRST PUTMTA		;YES, HANDLE IT

	HLRZ T1,FILPGN(F)	;JFN
	HRRO T2,FILBUF(F)	;STRING PTR TO BUFFER
	MOVE T3,FILCNT(F)	;[444] BYTES NOT WRITTEN
	SUB T3,FILBPB(F)	;[444]  MINUS BYTES PER BUFFER
				;[444]  EQUALS NEGATIVE BYTES WRITTEN THIS TIME
	SOUT%			;[335] MOVE IT OUT
	MOVE T1,FILBPB(F)	;INDICATE BUFFER WAITING
	MOVEM T1,FILCNT(F)	; TO BE FILLED
	HRRZ T1,FILBUF(F)	;GET ADDRESS OF BUFFER
	ADD T1,CBPTR		;CONSTRUCT BYTE POINTER TO BUFFER
	MOVEM T1,FILPTR(F)	; ..
	MOVE T1,FILCNT(F)	;[C03] RETURN WITH BYE COUNT IN T1
	RET			;RETURN

>;END IFE FTCOBOL
SUBTTL	PUTREC -- PUTBUF - Output 1 Physical Buffer -- Disk


PUTDSK:	HRLZI T1,.FHSLF		;[C17] MAP FROM THIS PROCESS
	HRR T1,FILBUF(F)	;STARTING AT THIS PAGE
	MOVE T2,FILPGN(F)	;TO THIS FILE
	HLRZ T3,FILBUF(F)	;GET PAGES PER BUFFER
	SKIPLE T4,FILCNT(F)	;WRITING PARTIAL BUFFER?
	CALL FIXUP		;YES, COMPUTE T3=PAGE COUNT
	MOVEM T3,PGSATM		;[464] SAVE # OF PAGES TO PMAP%
	IORX T3,PM%CNT!PM%RWX	;ALLOW ALL TYPES OF ACCESS TO FILE PG.
	PMAP%			;[335] MOVE THEM OUT TO THE FILE
	ERCAL BADMAP		;[457]  GO TO BADMAP IF PMAP% FAILURE.
	HRRZS T3		;GET PAGE COUNT
	HRRZ T2,FILPGN(F)	;GET CURRENT PAGE NUMBER
	ADD T3,T2		;COMPUTE NEXT
	HRRM T3,FILPGN(F)	;SAVE IN FCB
	MOVE T1,FILBPB(F)	;GET NO. OF BYTES PER BUFFER
	MOVE T2,T1		;IN T2 ALSO
	EXCH T1,FILCNT(F)	;FLAG BUFFER FULL, GET # OF  UNUSED BYTES
	SKIPLE	T1		;[465] IF THE # OF UNUSED BYTES IS 0 OR -1,
				;[465]  T2 ALREADY = # OF BYTES WRITTEN.
	SUB T2,T1		;COMPUTE BYTES WRITTEN THIS TIME
	ADDM T2,FILEOF(F)	;UPDATE TOTAL NO. OF BYTES WRITTEN
IFE FTCOBOL,<
	MOVE T4,FILFLG(F)	;[C20] A TEMP FILE?
	TXNE T4,FI.TMP		;[C20]   ..
>
	ADDM T2,TMPTOT		;[C20] YES, UPDATE TOTAL PAGES USED
IFE FTCOBOL,<
	MOVN T1,T2		;[C17] DESCRIMENT BLOCK BYTE COUNT
	ADDM T1,FILKCT(F)	;[C17]   ..
>
	HRRZ T1,FILBUF(F)	;GET STARTING PAGE OF BUFFER
	LSH T1,POW2(PGSIZ)	;COMPUTE ADDRESS
	ADD T1,CBPTR		;CONSTRUCT BYTE POINTER
	MOVEM T1,FILPTR(F)	;SAVE IT
IFE FTCOBOL,<
	TXNN T4,FI.TMP		;[371] IS IT A TEMP FILE?
	SKIPG SEQNO		;[371] OR OUTPUT NOT SEQUENCED
	JRST PUTDS1		;[C03] [371] YES
	HRRZ T2,FILPTR(F)	;[371] YES, MUST CLEAR BUFFER IN CASE
	HLRZ T3,FILBUF(F)	;[371]  ANY BIT 35'S ARE LEFT O
	LSH T3,POW2(PGSIZ)	;[371] GET SIZE OF BUFFER IN WORDS
	ADD T3,T2		;[C20] [371] END+1
	SETZM (T2)		;[C20] CLEAR FIRST WORD
	HRL T2,T2		;[371] FORM BLT POINTER
	ADDI T2,1		;[371] EVENTUALLY
	BLT T2,-1(T3)		;[OK] [371]  AND THE REST
PUTDS1:				;[C03]
>;END IFE FTCOBOL
	MOVE T1,FILCNT(F)	;[C03] RETURN WITH BYTE COUNT IN T1
	RET			;RETURN
SUBTTL	BADMAP -- HANDLE PMAP% FAILURE IF DISK FULL OR QUOTA EXCEEDED


;BADMAP is called, using ERCAL, after a PMAP% failure. This routine
;was written for case two of PMAP%(i.e. Mapping Process Pages to a
;File), but should work equally well for any of the first three cases
;of PMAP%ing(i.e. Mapping not unmapping or deleting). See the Monitor
;Calls Reference Manual.
;An appropriate error message is typed to the tty. If the failure was
;due to the disk being full or exceeding the users quota, then SORT
;may be continued after more disk space is made available. 
;The AC's are saved since they have not been altered from their
;initial state so that upon returning, the calling routine will not
;be aware of the occurrence of the error. The first three AC's are
;also moved into the following memory locations for use in this error
;routine.
;	SOURCE	------	Process handle ,, Page number
;
;	DEST	------	JFN ,, Page number
;
;	ACCESS	------	Access bits ,, Repetition count
;
;This routine checks the pages that were attempted to be PMAP%ed by
;using the RPACS% JSYS. Upon encountering a non-existent page, the
;AC's are reset to reflect the number of pages and the page numbers
;that did not get mapped and attempts to map them. If successful,
;then the old AC values are poped and control is returned to the
;caller. If not successful, then control is passed to BADMP2 and
;a loop is performed as many times as the user desires and is 
;necessary.


BADMAP:	PUSH	P,T3		;[457] SAVE SOME REGISTERS.
	PUSH	P,T4		;[464]
BADMP2:	DMOVEM	T1,SOURCE	;[464] SAVE THE ARG'S FOR THE LATEST PMAP%
	MOVEM	T3,ACCESS	;[464] SAVE THE ACCESS BITS AND REPETITION COUNT
	MOVEI	T1,.FHSLF	;[457] GET PROCESS HANDLE FOR SELF
	GETER%			;[457] GET LAST ERROR OF PROCESS.
	HRRZ	T1,T2		;[457] GET ERROR NUMBER
	CAIE	T1,PMAPX6	;[457] WAS THIS THE LAST ERROR?
	CAIN	T1,IOX11	;[457] OR THIS?
	JRST	VLDERR		;[457] YES!
	HRROI	T1,CRLF		;START MESSAGE ON NEW LINE
	PSOUT%			; INCASE BATCH
	MOVEI	T1,"?"		;PREFIX MESSAGE WITH ?
	PBOUT%
	MOVEI	T1,.PRIOU	;[457] GET READY FOR ERSTR CALL.
	ERSTR%			;[457] PUT OUT THE ERROR MESSAGE. 
	  HALTF%		;[457] SHOULD NOT GET HERE!
	  JRST	.-1		;[457] OR HERE!
	HALTF%			;[457] DIE!
	JRST	.-1		;[457] DO NOT ALLOW TO CONTINUE.

VLDERR:	PUSH	P,T2		;SAVE THE GETER ARGS
	PUSH	P,T3		;...
	SETO	T1,		;CURRENT JOB
	HRROI	T2,GTJARG	;1 WORD
	MOVEI	T3,.JIBAT	;BATCH CONTROL WORD
	GETJI%
	  SETZM	GTJARG		;ASSUME NOT BATCH
	HRROI	T1,CRLF		;START MESSAGE ON NEW LINE
	PSOUT%			; INCASE BATCH
	MOVEI	T1,"$"		;PREFIX MESSAGE WITH $ FOR BATCH
	SKIPL	GTJARG		;IS IT REALLY A BATCH JOB?
	MOVEI	T1,"%"		;NO, JUST GIVE WARNING
	PBOUT%
	POP	P,T3		;RESTORE ORIGINAL ERROR #
	POP	P,T2		;...
	MOVEI	T1,.PRIOU	;[457] GET READY FOR ERSTR CALL.
	ERSTR%			;[457] PUT OUT THE ERROR MESSAGE. 
	  HALTF%		;[457] SHOULD NOT GET HERE!
	  JRST	.-1		;[457] OR HERE!
	HRROI	T1,QEMSG	;[457] SET UP POINTER TO MESSAGE.
	PSOUT%			;[457] PUT OUT MESSAGE.
	HALTF%			;[457] WAIT FOR USER TO FIND MORE SPACE.
				;[457] SORT WILL RESUME AT THIS
				;[457] POINT AFTER BEING CONTINUED.
	SETZ	T3,		;[464] INITIALIZE THE PAGE ADDER.
	MOVE	T1,DEST		;[464] GET DESTINATION OF THE ATTEMPTED PMAP%
	MOVE	T4,PGSATM	;[464] GET THE # OF PAGES ATTEMPTED TO PMAP%
CHKPAG:	HRRZ	T2,DEST		;[464] GET # OF FIRST PAGE ATTEMPTED TO PMAP%
	ADD	T2,T3		;[464] CALCULATE THE PAGE TO SEARCH FOR.
	HRR	T1,T2		;[464] INSERT PAGE # TO SEARCH FOR.
	RPACS%			;[464] GET ACCESSIBILITY OF THIS PAGE.
	TXNN	T2,PA%PEX	;[464] DOES THIS PAGE EXIST?
	JRST	NOPAGE		;[464] NO!
	AOS	T3		;[464] YES, INCREMENT THE PAGE ADDER.
	SOJG	T4,CHKPAG	;[464] CHECK THE NEXT PAGE.
	JRST	FIN		;[464] IF YOU GET HERE, SOMETHING IS FLAKY!

NOPAGE:	DMOVE	T1,SOURCE	;[464] GET THE SOURCE AND DESTINATION FOR THE PMAP%
	ADD	T1,T3		;[464] PAGE # OF SOURCE TO START MAPPING FROM.
	ADD	T2,T3		;[464] PAGE # OF DEST TO START MAPPING INTO.
	MOVE	T4,PGSATM	;[464] GET # OF PAGES ATTEMPTED TO PMAP%
	SUB	T4,T3		;[464] GET # OF PAGES THAT DIDN'T MAKE IT.
	MOVE	T3,ACCESS	;[464] GET ACCESS BITS AND REPETITION COUNT.
	HRR	T3,T4		;[464] UPDATE # OF PAGES TO PMAP%
	PMAP%			;[464] TRY TO MAP THE REMAINDER OF THE PAGES!
	  ERJMP	BADMP2		;[464] DIDN'T GET 'EM ALL, KEEP TRYING!
FIN:	POP	P,T4		;[464] RESTORE ORIGINAL DATA FOR RETURN.
	POP	P,T3		;[457] RESTORE ACCUMULATORS.
	POPJ	17,		;[464][457] RETURN TO CALLING ROUTINE.

CRLF:	ASCIZ	/
/
QEMSG:	ASCIZ /.
Type CONTINUE after expunging deleted files.
/				;[464][457] THAT'S ALL FOLKS.
;FIXUP COMPUTES A PAGE COUNT FOR PMAP% WHEN WE'RE PMAPPING A PARTIAL BUFFERLOAD.
;RETURNS PAGE COUNT IN T3.  MUSTN'T DISTURB T1 OR T2, AND CAN ONLY BE CALLED
;DURING A CLOSE.

FIXUP:	MOVE T3,FILBPB(F)	;[C06] GET BYTES PER (FULL) BUFFER
	SUB T3,T4		;SUBTRACT # OF UNWRITTEN BYTES
IFE FTCOBOL,<
  IF THIS IS NOT A TEMP FILE
	MOVX T4,FI.TMP		;IS THIS A TEMP FILE?
	TDNE T4,FILFLG(F)	;[400]   ..
	JRST $T			;[430] [400] YES IT'S A TEMP FILE
  THEN FIND BYTES PER WORD
	SKIPA T4,IOBPW2		;[C03] [366] T4 = BYTES/WORD
  ELSE BYTES PER WORD IS 1
	MOVX T4,1		;[366] T4 = 1 BYTE/WORD
  FI;
	IMULI T4,PGSIZ		;[366] T4 = BYTES/PAGE
	IDIV T3,T4		;[366] T3 = WHOLE PAGES, T4 = REMAINING WORDS
>
IFN FTCOBOL,<
	IDIVI T3,PGSIZ		;[366] T3 = WHOLE PAGES, T4 = REMAINING WORDS
>				;END IFE FTCOBOL 
	SKIPE T4		;ROUND UP TO WHOLE PAGES
	ADDI T3,1		; ..
	RET
SUBTTL	PUTREC -- PUTBUF - Output 1 Physical Buffer -- Magtape


IFE FTCOBOL,<
PUTMTA:	PUSH P,FILPTR(F)	;[C03] SAVE OLD BYTE POINTER
	MOVEI T1,OUTLST		;[C02] LOAD PARAMETER FOR SWTBUF
	CALL SWTBUF		;[C02] SWITCH BYTE POINTER AND IOWD BLOCK
	POP P,T1		;[C03] RESTORE BYTE POINTER
	MOVE T2,FILBPB(F)	;[C02] GET BUFFER LENGTH IN BYTES
	SUB T2,FILCNT(F)	;[C02] SUBTRACT NO. OF BYTES WE DIDN'T WRITE
	IDIV T2,IOBPW2		;[C03] CONVERT TO WORDS
	JUMPE T3,PUTMT2		;[C03] ROUND UP TO A WHOLE WORD
	ADDI T2,1		; ..
	SUB T3,IOBPW2		;[C03] CLEAR REST OF WORD
	SETZ T4,		;[C03]  ..
	IDPB T4,T1		;[C03]  ..
	AOJL T3,.-1		;[C03]  ..
PUTMT2:	MOVN T2,T2		;[C03] [C02] NEGATE WORD COUNT
	HRLM T2,OUTLST		;[C02] CORRECT IOWD WORD
	HLRZ T1,FILPGN(F)	;GET JFN
	MOVX T2,DM%NWT		;DON'T WAIT ON I/O
	HRRI T2,OUTLST		;ADDR OF CMD LIST
	DUMPO%			;[335] START I/O
	  ERCAL [CAXE T1,IOX5		;DEVICE OR DATA ERROR?
		JRST E$$DME		;NO, BUG
		HLRZ T1,FILPGN(F)	;GET JFN
		GDSTS%			;[335] GET TAPE STATUS BITS
		TXZN T2,MT%EOT		;END OF TAPE?
		JRST E$$DME		;NO, COMPLAIN
		SDSTS%			;[335] YES, CLEAR THE BIT
		MOVX T2,FI.EOT		;[C08] SET EOT BIT IN FILFLG
		IORM T2,FILFLG(F)	;[C08]  ..
		MOVX T2,DM%NWT		;[C08] RESTART I/O
		HRRI T2,OUTLST		;[C08]  ..
		DUMPO%			;[C08]  ..
		  ERJMP E$$DME		;[C08] ERROR
		RET]			;REJOIN MAIN FLOW
	MOVX T1,FI.EOT		;[C08] AT EOT?
	TDNE T1,FILFLG(F)	;[C08]  ..
	CALL   [HLRZ T1,FILPGN(F)	;[C08] YES, GET JFN
		MOVX T2,.MONOP		;[C08] GET MTOPR% FUNCTION FOR WAITING
		MTOPR%			;[C08] WAIT FOR I/O TO COMPLETE
		  SKIPA			;[C08] SHOULD ALWAYS FAIL, STILL EOT
		JRST E$$DME		;[C08] NO, BUG SOMEWHERE
		MOVEI T1,.FHSLF		;[C08] GET ERROR CODE
		GETER%			;[C08]  ..
		HRRZ T1,T2		;[C08]  ..
		CAXE T1,IOX5		;[C08] DEVICE OR DATA ERROR?
		JRST E$$DME		;[C08] NO, BUG
		HLRZ T1,FILPGN(F)	;[C08] GET JFN
		GDSTS%			;[C08] GET TAPE STATUS BITS
		TXZN T2,MT%EOT		;[C08] END OF TAPE?
		JRST E$$DME		;[C08] NO, COMPLAIN
		SDSTS%			;[C08] YES, CLEAR THE BIT
		RET]			;[C08] REJOIN MAIN FLOW
	MOVE T1,FILBPB(F)	;GET BYTES PER BUFFER
	MOVEM T1,FILCNT(F)	;INDICATE BUFFER BEGGING TO BE FILLED
	SKIPG SEQNO		;[371] OUTPUT NOT SEQUENCED
	JRST PUTMT3		;[C03] [371] YES
	HRRZ T2,FILPTR(F)	;[371] YES, MUST CLEAR BUFFER IN CASE
	HLRZ T3,FILBUF(F)	;[371]  ANY BIT 35'S ARE LEFT O
	ADD T3,T2		;[C20] [371] END+1
	SETZM (T2)		;[C20] CLEAR FIRST WORD
	HRL T2,T2		;[371] FORM BLT POINTER
	ADDI T2,1		;[371] EVENTUALLY
	BLT T2,-1(T3)		;[OK] [371]  AND THE REST
PUTMT3:	MOVE T1,FILCNT(F)	;[C03] RETURN WITH BYTE COUNT IN T1
	RET

>;END IFE FTCOBOL
SUBTTL	PSORT. -- Memory Management Routines for TOPS-20


;CHKCOR - CHECK FOR MEMORY SWITCHS AND INSURE ARGUMENTS ARE REASONABLE

CHKCOR:	PUSH P,P1		;GET SOME REGS
	PUSH P,P2		; ..
	CALL MINBUF		;COMPUTE MINIMUM ALLOWABLE BUFFER AREA
	MOVE P1,T1		;SAVE
	CALL MAXBUF		;COMPUTE MAXIMUM ALLOWABLE BUFFER AREA
	CAMGE T1,P1		;[C20] IS MAX .LT. MIN?
	JRST E$$NEC		;YES, DIE
	MOVE P2,T1		;COPY MAXIMUM BUFFER SPACE USEABLE
IFE FTCOBOL,<
	CALL USRBUF		;DID USER SPECIFY A BUFFER AREA SIZE?
	JRST CHKCR1		;NO, USE DEFAULT
	CAMGE T1,P1		;[C20] IS USER'S SIZE .GE. MINIMUM?
	JRST [	$ERROR (%,NBS,<Not enough buffer space specified>)
		MOVE T1,P1	;[C20] USE MINIMUM INSTEAD
		JRST CHKTRE]	;AND RETURN
	CAML T1,P2		;[C20] IS USER'S SIZE .LT. MAXIMUM?
	JRST [	$ERROR (%,TMS,<Too much buffer space specified>)
		MOVE T1,P2	;[C20] USE MAXIMUM INSTEAD
		JRST CHKTRE]	;AND RETURN
	JRST CHKTRE		;USER'S SIZE OK, RETURN IT
>;END IFE FTCOBOL

CHKCR1:	CALL DEFBUF		;COMPUTE DEFAULT BUFFER SIZE
	CAMGE T1,P1		;[C20] RANGE CHECK
	MOVE T1,P1		;[C20]  AGAINST MINIMUM
	CAML T1,P2		;[C20]  AND MAXIMUM
	MOVE T1,P2		;[C09]  ..
;HERE WITH C(T1) = SIZE OF I/O BUFFER AREA TO ALLOCATE

CHKTRE:	ADDI T1,PGSIZ		;[C13] IN CASE NOT ON A PAGE BOUNDARY
	MOVEM T1,BUFSZ		;[C13] SAVE SIZE OF BUFFER AREA
	SKIPLE MRGSW		;MERGE COMMAND?
	JRST CHKRT1		;YES, SETTMP COMPUTED NUMRCB FOR US
	CALL MINTRE		;COMPUTE MINIMUM SIZE OF TREE
	MOVE P1,T1		;[C20] SAVE
	CALL MAXTRE		;COMPUTE MAXIMUM SIZE OF TREE
	CAMGE T1,P1		;[C20] INSURE .GE. MINIMUM
	JRST E$$NEC		;OOPS
	MOVE P2,T1		;[C20] SAVE FOR MORE TESTS
IFE FTCOBOL,<
	CALL USRTRE		;DID USER SPECIFY A TREE SIZE?
	JRST CHKCR2		;NO, USE DEFAULT
	CAMGE T1,P1		;[C20] IS USER .GE. MINIMUM?
	JRST [	$ERROR (%,NLS,<Not enough leaves specified>)
		MOVE T1,P1	;[C20] USE MINIMUM
		JRST CHKRET]	;AND FINISH UP
	CAMLE T1,P2		;[C20] IS USER .LE. MAXIMUM?
	JRST [	$ERROR (%,TML,<Too many leaves specified>)
		MOVE T1,P2	;[C20] USE MAXIMUM
		JRST CHKRET]	;AND FINISH UP
	JRST CHKRET		;USER SIZE IS GOOD, FINISH UP
>;END IFE FTCOBOL

CHKCR2:	CALL DEFTRE		;COMPUTE DEFAULT TREE SIZE
	CAMGE T1,P1		;[C20] RANGE CHECK
	MOVE T1,P1		;[C20]  ..
	CAMLE T1,P2		;[C20]  ..
	MOVE T1,P2		;[C20]  ..

;HERE WITH C(T1) = NUMBER OF WORDS TO ALLOCATE TO TREE

CHKRET:	MOVE T2,REKSIZ		;GET RECORD SIZE
	ADDI T2,RN.LEN		;ADD OVERHEAD WORDS
	IDIV T1,T2		;COMPUTE HOW MANY RECORDS CAN FIT IN TREE
	CAIGE T1,^D16		;MUST HAVE AT LEAST 16
	JRST [$ERROR (?,NET,<Not enough core for tree>)]
	MOVEM T1,NUMRCB		;SAVE FOR INITRE
CHKRT1:	POP P,P2		;RESTORE REGS
	POP P,P1
	RET			;[C13]
;MINBUF - COMPUTE MINIMUM BUFFER SPACE NEEDED FOR SORT

MINBUF:	SKIPLE MRGSW		;MERGE COMMAND?
	JRST MINBF1		;YES, HANDLE DIFFERENTLY

IFN FTCOBOL,<			;FOR COBOL, ONLY NEED 1 TEMP FILE BUFFER
	MOVEI T1,PGSIZ		; WHICH IS ONE PAGE
	RET
>

IFE FTCOBOL,<			;OTHERWISE, NEED 1 INPUT/OUTPUT PG AND 1 TMP PG
	MOVEI T1,PGSIZ		;FOR TEMP FILE INPUT
	MOVE T2,MXDVSZ		;[C05] PLUS BIGGEST INPUT DEVICE BUFFER
	CAMGE T2,OBUFSZ		;[C05] OR BIGGEST OUTPUT DEVICE BUFFER
	MOVE T2,OBUFSZ		;[C05]  ..
	ADD T1,T2		;[C05]  ..
	JRST RNDRET		;ROUND UP TO A PAGE AND RETURN
>

MINBF1:
IFN FTCOBOL,<			;FOR COBOL MERGE, JUST 1 TMP BUFFER
	MOVEI T1,PGSIZ		; ..
	RET
>

IFE FTCOBOL,<			;FOR REGULAR, NEED TMP PLUS INPUT/OUTPUT
	HRRZ T1,ACTTMP		;NUMBER OF ACTIVE TEMP FILES
	IMUL T1,MXDVSZ		;TIMES LARGEST BUFFER (JUST IN CASE)
	MOVE T2,MXDVSZ		;[C05] PLUS BIGGEST INPUT DEVICE BUFFER
	CAMGE T2,OBUFSZ		;[C05] OR BIGGEST OUTPUT DEVICE BUFFER
	MOVE T2,OBUFSZ		;[C05]  ..
	ADD T1,T2		;[C05]  ..
	JRST RNDRET		;ROUND UP TO A PAGE AND RETURN
>
;MAXBUF COMPUTES MAXIMUM BUFFER SPACE ALLOWABLE

MAXBUF:	SKIPLE MRGSW		;MERGE COMMAND?
	JRST MAXBF1		;YES, HANDLE DIFFERENTLY
	MOVEI T1,PGSIZ*8	;8 PAGES FOR TEMP FILE BUFFER
IFN FTCOBOL,<
	RET
>

IFE FTCOBOL,<			;IF LIBOL ISN'T DOING I/O FOR US,
	MOVE T2,MXDVSZ		;GET LARGEST INPUT BUFFER REQUIRED
	LSH T2,POW2(4)		;4 TIMES LARGEST BUFFER
	CAMGE T2,OBUFSZ		;[C05] BUT MUST BE GREATER THAN OUTPUT BUFFER
	MOVE T2,OBUFSZ		;[C05]  ..
	ADD T1,T2		;JUST MAKE SOME ARBITRARY LARGE NUMBER
	JRST RNDRET		;ROUND UP AND RETURN
>

MAXBF1:
IFN FTCOBOL,<			;FOR COBOL MERGE VERB
	MOVEI T1,PGSIZ*^D32	;JUST ALLOW A LARGE OUTPUT (TMP) BUFFER
	RET
>

IFE FTCOBOL,<			;FOR STAND ALONE MERGE
	HRRZ T1,ACTTMP		;GET NUMBER OF INPUT FILES
	IMUL T1,MXDVSZ		;TIMES BIGGEST KNOWN BUFFER
	LSH T1,POW2(20)		;ALLOW VERY LARGE BUFFER
	ADD T1,OBUFSZ		;[C05] PLUS ONE FOR OUTPUT
	JRST RNDRET		;ROUND UP AND RETURN
>

;USRBUF RETURNS USER'S DESIRED BUFFER AREA SIZE

IFE FTCOBOL,<
USRBUF:	SKIPG T1,CORSIZ		;DID HE TYPE ONE?
	RET			;NO, ERROR RETURN
	LSH T1,POW2(PGSIZ)	;YES, CONVERT TO WORDS
	RETSKP
>

;USRTRE - RETURN USER'S DESIRED NO. OF LEAVES ON TREE (/LEAVES:n)

IFE FTCOBOL,<
USRTRE:	SKIPG T1,LEANUM		;IS THERE ONE?
	RET
	MOVE T2,REKSIZ		;GET RECORD SIZE, IN WORDS
	ADDI T2,RN.LEN		; PLUS OVERHEAD WORDS
	IMUL T1,T2		;[C20] COMPUTE SPACE NEEDED FOR TREE
	RETSKP
>

;DEFBUF - COMPUTE DEFAULT BUFFER SPACE TO USE

DEFBUF:	SKIPLE MRGSW		;MERGE COMMAND?
	JRST DEFBF1		;YES, HANDLE DIFFERENTLY
	MOVEI T1,PGSIZ*4	;4 PAGES FOR TEMP FILE BUFFER
IFE FTCOBOL,<
	MOVE T2,MXDVSZ		;[C05] PLUS BIGGEST INPUT DEVICE BUFFER
	CAMGE T2,OBUFSZ		;[C05] OR BIGGEST OUTPUT DEVICE BUFFER
	MOVE T2,OBUFSZ		;[C05]  ..
	ADD T1,T2		;[C05]  ..
>
	JRST RNDRET		;ROUND UP AND RETURN

DEFBF1:	MOVE T1,ACTTMP		;GET NO. OF INPUT FILES
	LSH T1,POW2(PGSIZ*2)	;ALLOW 2 PGS FOR INPUT
IFE FTCOBOL,<			;[C05] IF NOT COBOL MERGE, ADD
	ADD T1,OBUFSZ		;[C05]   ROOM FOR OUTPUT FILE BUFFER
>
;	JRST RNDRET		;ROUND UP AND RETURN

RNDRET:	TRZE T1,PGMSK		;[365] ON PAGE BOUNDARY?
	ADDI T1,PGSIZ		;[365] NO, ROUND UP
	RET			;AND RETURN
;MINTRE COMPUTES MINIMUM SPACE NEEDED FOR SORT TREE

MINTRE:	MOVE T1,REKSIZ		;GET RECORD SIZE
	ADDI T1,RN.LEN		;PLUS OVERHEAD WORDS
	LSH T1,POW2(^D16)	;NEED AT LEAST 16 NODES
	RET

;MAXTRE - COMPUTE MAXIMUM ALLOWABLE SPACE FOR TREE

MAXTRE:	MOVE T1,FRECOR		;[C13] GET FREE CORE
	SUB T1,BUFSZ		;[C13] MINUS BUFFER POOL SPACE
	SUBI T1,1000		;[C13] MINUS ODD BUFFERS (I.E. LABELS ETC.)
	RET

;DEFTRE - COMPUTE DEFAULT SIZE FOR TREE

DEFTRE:	MOVEI T1,RN.LEN		;GET LENGTH OF A NODE
	ADD T1,REKSIZ		;PLUS LENGTH OF A RECORD
	IMULI T1,NRECS		;TIMES NO. OF RECORDS WE WANT TO HAVE
				; IN CORE BY DEFAULT
	RET
;RFMBFP -- REFORMAT BUFFER POOL FOR MERGE PHASE OF SORT

RFMBFP:	MOVE T1,BUFSZ		;GET SIZE OF BUFFER POOL
	CALL FRESPC		;DROP IT LIKE A HOT POTATO
	MOVE T1,RCBSZ		;[C13] GET SIZE OF RECORD POOL
	CALL FRESPC		;[C13] DEALLOCATE IT
	MOVE T1,TRESZ		;[C13] GET SIZE OF TREE AREA
	CALL FRESPC		;[C13] DEALLOCATE IT
	MOVEI T1,RN.LEN		;[313] SIZE OF A TREE NODE
	IMUL T1,NUMRCB		;[313]   TIMES NUMBER OF RECORDS
	MOVEM T1,TRESZ		;[C13] SAVE SIZE OF TREE
	CALL GETSPC		;ALLOCATE SPACE FOR TREE
	  JRST E$$RBP		;CONFUSION
	MOVEM T1,TREORG		;[313] TREE ORIGIN
	MOVE T1,REKSIZ		;[C13] GET SIZE OF RECORD
	IMUL T1,NUMRCB		;[C13]   TIMES NUMBER OF RECORDS
	MOVEM T1,RCBSZ		;[C13] SAVE SIZE OF RECORD POOL
	CALL GETSPC		;[C13] ALLOCATE SPACE FOR RECORD POOL
	  JRST E$$RBP		;[C13] FAILED
	MOVEM T1,RCBORG		;[C13] RECORD POOL ORIGIN
	HRRZ T1,ACTTMP		;GET NUMBER OF TEMP FILES
	LSH T1,POW2(PGSIZ)	;TIMES SIZE OF ONE BUFFER (1 PAGE)

IFN FTCOBOL,<			;IF COBOL SORT,
	SETZ T2,		;[C13] ASSUME NO OUTPUT BUFFER
	SKIPE NUMLFT		;IF WE NEED TO DO A MERGE PASS
	MOVEI T2,OUTSIZ		;[C13] GET DESIRABLE SIZE FOR OUTPUT BUFFER
	MOVEM T2,OBUFSZ		;[C13] SAVE IT
>

	ADD T1,OBUFSZ		;[C13] ADD SIZE OF OUTPUT BUFFER

	IMULI T1,PPTBUF*2	;DOUBLE BUFFERING WOULD BE NICE
	ADDI T1,PGSIZ		;[C13] IN CASE NOT ON A PAGE BOUNDARY
	PUSH P,P2		;GET A REG FOR FLAG
	SETZ P2,		;ASSUME DOUBLE BUFFERING
	PUSH P,T1		;SAVE UNIT BUFFER-POOL SIZE
	PUSH P,P1		;GET A REG
	MOVE P1,T1		;SAVE WHAT WE WANT TO ALLOCATE
	CALL GETSPC		;TRY FOR IT
	  CALL [SUBI P1,PGSIZ		;[C13] CAN'T GET IT, TRY FOR A SINGLE BUFFER
		LSH P1,-<POW2(2)>	;[C13]  ..
		ADDI P1,PGSIZ		;[C13]  ..
		MOVE T1,P1		; ..
		CALL GETSPC		;ALLOCATE IT
		  JRST E$$ICM		;INSUFFICIENT CORE
		PUSH P,T1		;$ERROR TRASHES T1
		$ERROR(%,CDB,<Can't double buffer merge pass>)
		POP P,T1
		SETO P2,		;FLAG DOUBLE BUFFERING
		RET]			;REJOIN MAIN FLOW
	MOVEM T1,BUFORG		;[C13] SAVE START OF BUFFER POOL
	MOVEM T1,BUFPTR		;REMEMBER WHERE BUFFER POOL STARTS
	MOVEM P1,BUFSZ		;REMEMBER SIZE OF BUFFER POOL
	TRZE T1,PGMSK		;[C13] CALCULATE USEFUL BUFFER SPACE
	ADDI T1,PGSIZ		;[C13]   ..
	SUB T1,BUFORG		;[C13]   ..
	SUB P1,T1		;[C13]   ..
	MOVEM P1,UBUFSZ		;[C13] SAVE IT
	POP P,P1		;RESTORE P1
	POP P,T1		;RESTORE UNIT BUFFER-POOL SIZE
	IDIVI T1,PPTBUF*2	;RECOVER UNIT BUFFER SIZE
	SUB T1,OBUFSZ		;[C13]  FOR TEMP FILES
;	JRST RFMBP1
;HERE WHEN WE HAVE ENOUGH CORE FOR BUFFERS - DIVIDE WHAT
; WE'VE GOT AMONG TEMP FILE AND OUTPUT FILE BUFFERS

RFMBP1:	MOVE T2,UBUFSZ		;[C13] GET USEFUL SIZE OF BUFFER POOL
	SUB T2,OBUFSZ		;[C13] RESERVE SPACE FOR OUTPUT BUFFER
	SKIPN P2		;IF DOUBLE BUFFERED,
	SUB T2,OBUFSZ		;[C13]  RESERVE SPACE FOR 2 OUTPUT BUFFERS
	IDIV T2,T1		;[C20] DIVIDE POOL SIZE BY UNIT BUFFER-POOL
				; SIZE TO GET DEGREE OF BUFFERING
	JUMPE T2,E$$FER		;CAN'T ALLOCATE THEM
	MOVEM T2,TBUFNO		;PAGES PER TEMP FILE BUFFER
	MOVE T1,UBUFSZ		;[C13] GET USEFUL SIZE OF BUFFER POOL
	IMUL T2,ACTTMP		;COMPUTE SPACE OCCUPIED BY TEMP
	LSH T2,POW2(PGSIZ)	; FILE BUFFERS
	SUB T1,T2		;WHAT'S LEFT IS FOR OUTPUT FILE

IFE FTCOBOL,<			;IF NOT COBOL, WE HAVE REAL OUTPUT
	MOVE T2,OBUFSZ		;GET OUTPUT BUFFER SIZE
	CAIGE T2,PGSIZ		;USE LARGE OF TEMP OR OUTPUT
	MOVEI T2,PGSIZ		; ..
>

IFN FTCOBOL,<			;IF COBOL, JUST TEMP FILE OUTPUT
	MOVEI T2,PGSIZ		; ..
>

	IDIV T1,T2		;DIVIDE SPACE BY SIZE OF BUFFERS
	CAIGE T1,2		;NEED AT LEAST 2 BUFFERS
	JRST E$$NRO		;NO ROOM
	MOVEM T1,OBUFNO		;SAVE NUMBER OF BUFFERS
	POP P,P2		;RESTORE P2
	RET			;AND RETURN
;FMTBFP -- SETUP MEMORY POOLS

BEGIN
  PROCEDURE	(PUSHJ	P,FMTBFP)
$1%	MOVE	T1,NUMRCB	;GET NO. OF RECORDS IN TREE
	IMULI	T1,RN.LEN	;COMPUTE SIZE OF TREE
	MOVEM	T1,TRESZ	;[C13] SAVE TREE SIZE
	CALL	GETSPC		;[C13] ALLOCATE SPACE FOR TREE
	  JRST	$2		;[C13] FAILED
	MOVEM	T1,TREORG	;[C13] SAVE ADDR OF START OF TREE
	MOVE	T1,NUMRCB	;[C13] GET NO. OF RECORDS IN TREE
	IMUL	T1,REKSIZ	;[C13]  TIMES SIZE OF RECORDS
	MOVEM	T1,RCBSZ	;[C13] SAVE SIZE OF RECORD POOL
	CALL	GETSPC		;[C13] ALLOCATE SPACE FOR RECORDS
	  JRST [MOVE	T1,TRESZ	;[C13] FAILED, DEALLOCATE TREE SPACE
		CALL	FRESPC		;[C13]   ..
		JRST	$2]		;[C13]
	MOVEM	T1,RCBORG	;[C13] SAVE ADDR OF START OF RECORD POOL
	JRST	$3		;[C13]
IFN FTCOBOL,<
$2%	MOVE T1,NUMRCB		;[C20] NOT ENOUGH SPACE, TRY FOR SMALLER TREE
	LSH T1,-<POW2(2)>	; BY ONE HALF
	CAIGE T1,^D64		;MAKE SURE TREE DOESN'T TURN
	JRST E$$NEC		; INTO A SHRUBBERY
	MOVEM T1,NUMRCB		; (APOLOGIES TO M. PYTHON)
	JRST $1			;[C13] GO TRY AGAIN
>
IFE FTCOBOL,<
$2%	  JRST E$$NEC		;IF STANDALONE, NO SECOND CHANCES
>
$3%	MOVE	T1,BUFSZ	;[C13] ALLOCATE SEPARATE AREA FOR BUFFER POOL
	CALL	GETSPC		; ..
	  JRST E$$NEC
	MOVEM	T1,BUFPTR	;REMEMBER WHERE IT STARTS
	MOVEM	T1,BUFORG	;[C13] SAVE START OF BUFFER POOL
	MOVE	T2,BUFSZ	;[C13] CALCULATE USEFUL BUFFER SPACE
	TRZE	T1,PGMSK	;[C13]   ..
	ADDI	T1,PGSIZ	;[C13]   ..
	SUB	T1,BUFORG	;[C13]   ..
	SUB	T2,T1		;[C13]   ..
	MOVEM	T2,UBUFSZ	;[C13] SAVE IT
	RETURN			;[C13]
END;
;ALCBPG -- ALLOCATE BUFFER ON A PAGE BOUNDARY
;CALL WITH:	T1/ NO. OF WORDS DESIRED
;RETURNS+1 WITH T1/ ADDRESS OF BUFFER

ALCBPG:	MOVE T2,BUFPTR		;GET FREE POINTER
	TRZE T2,PGMSK		;[365] ON PAGE BOUNDARY?
	ADDI T2,PGSIZ		;[365] NO, ROUND UP TO NEXT PAGE
	MOVEM T2,BUFPTR		; ..
ALCBP1:	MOVE T3,BUFORG		;[C13] GET START OF BUFFER AREA
	ADD T3,BUFSZ		;[C13] CALCULATE END OF BUFFER AREA
	SUB T3,BUFPTR		;SUBTRACT BOTTOM
	CAMLE T1,T3		;IS WHAT'S WANTED .GT. WHAT'S THERE?
	JRST E$$BAF		;ALLOCATION FAILURE
	ADDM T1,BUFPTR		;UPDATE PTR
	MOVE T1,T2		;RETURN ADDR OF SPACE
	RET

;ALCBUF - ALLOCATE BUFFER SPACE, NOT NECESSARILY ON PAGE BOUNDARY

ALCBUF:	MOVE T2,BUFPTR		;GET PTR TO BUFFER AREA
	CALLRET ALCBP1		;JOIN COMMON CODE
;[371] ALCBPZ--ALLOCATE BUFFER ON A PAGE BOUNDARY AND MAKE SURE BUFFER AREA IS ZERO
ALCBPZ:	PUSH	P,T1		;[371] SAVE SIZE REQUIRED
	CALL	ALCBPG		;[371] GET BUFFER SPACE
	HRLZ	T2,T1		;[371] BUILD BLT POINTERS
	HRRI	T2,1(T1)	;[OK] [371] ...
	POP	P,T3		;[371] GET SIZE BACK
	ADD	T3,T1		;[C20] [371] END+1
	SETZM	(T1)		;[OK] [371] ZERO FIRST WORD
	BLT	T2,-1(T3)	;[OK] [371] CLEAR ALL OF DATA
	RET			+;[371]
SUBTTL	COLLATING SEQUENCE ROUTINES

IFE FTCOBOL,<

BEGIN
  PROCEDURE	(PUSHJ	P,COLTRX)
	MOVE	T1,COLJFN	;GET JFN
	MOVX	T2,OF%RD!FLD(7,OF%BSZ) ;OPEN FOR READ, 7-BIT BYTES
	OPENF%			;[335]   ..
	  ERJMP	E$$OPN
	MOVE	T1,[IFIW COLBUF]	;[C20] GET THE ALT SEQ TABLE
	MOVEM	T1,COLSW	;STORE THE ADDRESS OF THE TABLE
	MOVEI	T2,COLCHR	;ADDRESS OF THE INPUT ROUTINE
	PUSHJ	P,BLDCOL	;BUILD THE TABLE
	  JRST	E$$ICS		;ILLEGAL COLLATING SEQUENCE SPECIFIED
	MOVE	T1,COLJFN
	CLOSF%			;[335]
	  JFCL
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,COLCHR)
	SOSGE	COLPTR+1	;REDUCE THE BYTE COUNT
	JRST	$1		;GET A BUFFER
	HRRZ	T1,COLPTR	;[C20] GET WORD
	MOVE	T1,(T1)		;[C20]   ..
	TRNE	T1,1		;CHECK FOR SEQUENCE NUMBER
	JRST	[AOS	COLPTR		;IT IS
		MOVNI	T1,5
		ADDM	T1,COLPTR+1	;ACCOUNT FOR 5 BYTES
		JRST	COLCHR]		;LOOP BACK
	ILDB	T1,COLPTR	;GET A BYTE
	TXNN	P1,COL.QU	;[467] ARE WE IN A QUOTE?
	CAILE	T1," "		;[467] NO, IGNORE SPACE AND ALL CONTROL CHARACTERS
	CAIGE	T1," "		;[467] YES, IGNORE  ALL CONTROL CHARACTERS
	JRST	$B		;GET THE NEXT CHARACTER
	PJRST	CPOPJ1		;SKIP RETURN WITH CHAR IN T1

  $1%	MOVE	T1,COLJFN	;GET JFN
	HRROI	T2,COLITB	;USE LIT BUFFER
	MOVEI	T3,COLITS	;NO. OF CHARS
	SETZ	T4,
	SIN%			;[335] GET IT
	  ERJMP	[MOVX	T1,.FHSLF	;GET MOST RECENT ERROR NUMBER
		GETER%			;[335]   ..
		HRRZ	T1,T2		; ..
		CAXE	T1,IOX4		;END OF FILE?
		JRST	[PUSHJ	P,E$$BER
			$MORE	(FILESPEC,COLJFN)
			JRST	LASTER]		;[357] TRY TO GIVE MORE INFO
		CAIN	T3,COLITS	;WAS BYTE COUNT ALTERED (I.E., WAS ANYTHING READ?)
		RETURN			;NO, ASSUME EOF
		JRST	.+1]		;CONTINUE, GET EOF AGAIN NEXT TIME
	MOVEI	T1,COLITS	;GET BYTES PER BUFFER
	SUB	T1,T3		;DEDUCT NO. OF BYTES NOT READ
	MOVEM	T1,COLPTR+1	;EQUALS NO. OF BYTES IN THIS BUFFERLOAD
	MOVE	T1,[POINT 7,COLITB]
	MOVEM	T1,COLPTR	;STORE NEW BYTE POINTER
	JRST	$B		;GET THE NEXT CHARACTER
END;
>;END IFE FTCOBOL
SUBTTL	ERROR MESSAGES

;.TOLEB - PRINT "LOOKUP/ENTER" BLOCK (FILESPEC STRING) FOR
; JFN IN T2 (USED BY $MORE MACRO)

.TOLEB:	MOVX T1,.PRIOU		;TYPE ON PRIMARY OUTPUT JFN
	MOVX T3,<1B2+1B5+1B8+1B11+1B14+1B17+1B20>!JS%PAF ;TYPE ALL FIELDS
	JFNS%			;[335]   TYPE IT
	RET

E$$OPN:	$ERROR (?,OPN,<OPENF failure for file >,+)
	HLRZ T2,FILPGN(F)	;GET JFN OF FILE
	$MORE (FILESPEC,T2)
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO

E$$CFF:	$ERROR (?,CFF,<CLOSE failure for file >,+)
	HLRZ T1,FILPGN(F)	;GET JFN
	$MORE (FILESPEC,T1)
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO

E$$FPM:	$ERROR (?,FPM,<File page already mapped>)

E$$FPU:	$ERROR (?,FPU,<File page already unmapped>)

E$$IDN:	$ERROR (?,IDN,<Invalid directory number for temp file>,+)	;[357]
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO

E$$BIS:	$ERROR (?,BIS,<Non-skip return from BIS>)

E$$GFT:	$ERROR (?,GFT,<GTJFN% failed for temp file>,+)	;[357]
LASTER:	$MORE	(TEXT,<
	>)
	MOVEI	T1,.PRIOU	;[357] PRINCIPAL OUPUT DEVICE
	HRLOI	T2,.FHSLF	;[357] CURRENT FORK,,LAST ERROR
	SETZB	T3,T4		;[357] NO LIMIT,,FULL MESSAGE
	ERSTR%			;[357] PRINT THE MESSAGE
	  JFCL			;[357] IGNORE UNDEFINED ERROR NUMBER
	  JFCL			;[357] IGNORE ERROR DURING EXECUTION OF ERSTR
	$DIE			;[357] GIVE UP

E$$RBP:	$ERROR (?,RBP,<Reformat of buffer pool failed>)

E$$ICM:	$ERROR (?,ICM,<Insufficient core for merge phase>)

E$$FER:	$ERROR (?,FER,<Can't allocate temp buffers at RFMBFP>)

E$$NRO:	$ERROR (?,NRO,<No room for output buffer in merge phase>)

E$$BAF:	$ERROR (?,BAF,<Buffer allocation failed>)

IFE FTCOBOL,<			;NON-COBOL ERROR MESSAGES
E$$CDL:	$ERROR (?,CDL,<Can't do input from the line printer>)

E$$CDC:	$ERROR (?,CDC,<Can't do output to the card reader>)

E$$AND:	$ERROR (?,AND,<ARPANET device illegal for SORT>)

E$$FED:	$ERROR (?,FED,<FRONT-END device illegal for SORT>)

E$$FMC:	$ERROR (?,FMC,<File's mode conflicts with mode switch for >,+)
	HRRZ T2,X.JFN(P1)	;[OK] [305] PRINT THE FILE SPEC
	$MORE (FILESPEC,T2)	;[305]   ..
	$DIE			;[305]

E$$IDM:	$ERROR (?,IDM,<Illegal data mode>)

E$$JFT:	$ERROR (?,JFT,<JFNS% failed for temp file>,+)	;[357]
	JRST	LASTER		;[357] TRY TO GIVE MORE INFORMATION

E$$NSD:	$ERROR (?,NSD,<No such device>)

E$$DME:	$ERROR (?,DME,<Error in DUMP MODE I/O to magtape>,+)	;[357]
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO

E$$NFS:	$ERROR (?,NFS,<No filename specified for labelled tape >,+)
	HRRZ T2,X.JFN(P1)	;[OK]
	$MORE (FILESPEC,T2)
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO

E$$FTL:	$ERROR (?,FTL,<Filespec field too long for labelled tape >,+)
	HRRZ T2,X.JFN(P1)	;[OK]
	$MORE (FILESPEC,T2)
	$DIE

E$$JFO:	$ERROR (?,JFO,<JFNS% failed for output file>,+)	;[357]
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO

E$$BER:	$ERROR (?,BER,<Hard input error for device >,+)
	HLRZ T2,FILPGN(F)	;GET JFN
	$MORE (FILESPEC,T2)
	JRST	LASTER		;[357] TRY TO GIVE MORE INFO

>;END IFE FTCOBOL