Google
 

Trailing-Edge - PDP-10 Archives - BB-4160E-BM - sort-development/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	29-Aug-79


;	"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, 1979 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  Low Segment Data ..................................   4
;   4  ENTRY POINTS
;        4.1  TOPS-20 Entry Vector ..............................   6
;        4.2  FORTRAN Entry .....................................   7
;   5  PSORT.
;        5.1  SETUPI - Set Up Input Files .......................   9
;   6  I/O ROUTINES
;        6.1  INIINP - Initialize Next Input File
;             6.1.1  Set Up .....................................  10
;             6.1.2  Disk .......................................  11
;             6.1.3  Magtape ....................................  13
;             6.1.4  Others .....................................  15
;        6.2  INIOUT - Initialize Next Output File
;             6.2.1  Set Up .....................................  18
;             6.2.2  Disk .......................................  19
;             6.2.3  Magtape ....................................  20
;        6.3  Magtape Utility Routines ..........................  21
;        6.4  File Utility Routines
;             6.4.1  Close Master Input/Output File .............  22
;             6.4.2  Delete, Rename a File ......................  23
;             6.4.3  Unmap Buffer Pages For a File ..............  24
;             6.4.4  Initialize Output Temporary File ...........  27
;             6.4.5  Append to Temporary File ...................  28
;   7  TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE ............  31
;   8  GETREC
;        8.1  GETBUF - Input 1 Physical Buffer
;             8.1.1  Set Up .....................................  34
;             8.1.2  Terminal ...................................  35
;             8.1.3  Disk .......................................  36
;             8.1.4  Magtape ....................................  40
;   9  PUTREC
;        9.1  PUTBUF - Output 1 Physical Buffer
;             9.1.1  Set Up .....................................  43
;             9.1.2  Disk .......................................  46
;             9.1.3  Magtape ....................................  48
;  10  PSORT.
;       10.1  Memory Management Routines for TOPS-20 ............  49
;  11  COLLATING SEQUENCE ROUTINES ..............................  59
;  12  ERROR MESSAGES ...........................................  60
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 -- Low Segment Data

	SEGMENT LOW
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
MAXFRE:	BLOCK	1		;FIRST UNUSABLE CORE LOC
PGTAB:	BLOCK	<400/^D36>+1	;BIT TABLE OF MAPPED PAGES
BUFPT1:	BLOCK	1		;INITIAL VALUE OF BUFPTR
LEANUM:	BLOCK	1		;ARGUMENT TO /LEAVES SWITCH
BUFSZ:	BLOCK	1		;SIZE OF I/O BUFFER AREA
BUFTOT:	BLOCK	1		;COPY OF BUFSZ FOR ENDS.
BUFTOP:	BLOCK	1		;TOP OF BUFFER AREA
OBUFSZ:	BLOCK	1		;(MINIMUM) SIZE OF OUTPUT BUFFER
DFMTRS:	BLOCK	1		;DEFAULT MTA RECORD SIZE
AZTEMP:	BLOCK	^D20		;[405] TEMP TO HOLD FILESPEC AT XGTJFN
ZJ.END==.-1			;[427] LAST DATUM TO DELETE

	SEGMENT HIGH
	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
 >
>

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


IFE FTCOBOL,<
	SEGMENT	HIGH

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	ENTRY POINTS -- FORTRAN Entry


BEGIN
  PROCEDURE	(PUSHJ	P,FORENT)
	MOVX	T1,.FHSLF	;[361] DEACTIVATE INTERRUPTS
	MOVX	T2,<1B<.ICNXP>>	;[361] ON PAGE CREATION
	DIC%			;[361] SO PA1050 WON'T BITCH AT US
	SETZM	KEYORG		;[361] CREATE LOW SEGMENT PAGES
	MOVE	T3,[KEYORG,,KEYORG+1]	;[361] AND CLEAR THEM
	BLT	T3,LOWEND	;[361]
	AIC%			;[361] REACTIVATE INTERRUPTS FOR PA1050
	MOVEM	P,FORTPP	;SAVE RETURN PP
	HRLZ	L,L		;BUILD BLT POINTER
	HRRI	L,FORARG	;TO SAVE ARG LIST
	BLT	L,FORARG+2	;SAVE LIST
	JSP	P4,INITIALIZE
	MOVE	L,FORARG	;RECOVER ORIGINAL L
	MOVEM	L,ARGLST	;STORE IT FOR SCANNER
	HLRE	T1,-1(L)	;GET ARG COUNT
	MOVMM	T1,ARGCNT	;STORE FOR SCANNER
	MOVEI	L,@0(L)		;GET FIRST ARG
	HRLI	L,(POINT 7,)	;FORM INPUT BYTE POINTER
	MOVE	T1,[POINT 7,BUFFER]	;OUTPUT BYTE POINTER
	MOVNI	T2,5*BUFSIZ-2	;NO. OF CHARACTERS (NOT INCLUDING CR,LF,NUL)
  $1%	ILDB	T3,L		;GET CHAR
	JUMPE	T3,$2		;END ON NUL
	IDPB	T3,T1		;STORE
	AOJL	T2,$1		;LOOP
	$ERROR	(?,CTL,<Command string too long>)

  $2%	MOVEI	T3,.CHLFD	;LF
	IDPB	T3,T1
	SETZ	T3,
	IDPB	T3,T1		;END WITH NUL
	ADDI	T2,5*BUFSIZ-1	;DONT COUNT THE NULL
	MOVEM	T2,CMDLEN	;STORE SIZE
	PUSHJ	P,CUTBAK	;[361] MAKE SURE WE HAVE AS MUCH FREE SPACE AS POSSIBLE
	JRST	LOOP		;GO TO SORT
END;
BEGIN
  PROCEDURE	(PUSHJ	P,FORXIT)
	PUSHJ	P,CUTBAK	;[361] GIVE SPACE BACK TO FOROTS
	SKIPN	TAKFLG		;SKIP IF TAKING
	MOVE	P,FORTPP	;RESTORE ORIGINAL PP
	RETURN			;RET IF FORTRAN OR LOOP IF TAKING
END;

BEGIN
  PROCEDURE	(PUSHJ	P,CUTBAK)
	MOVEI	L,1+[-3,,0		;[361] LOAD UP ARG BLOCK FOR FUNCT. CALL	
		     Z TP%INT,[F.CBC]
		     Z TP%LIT,[ASCIZ /SRT/]
		     Z TP%INT,STATUS]
	PJRST	FUNCT.			;[361] CUT BACK CORE IF POSSIBLE
END;


BEGIN
  PROCEDURE	(PUSHJ	P,FORERR)
	MOVE	P,FORTPP	;RESTORE ORIGINAL PP
	PUSHJ	P,CUTBAK	;[361] GIVE SPACE BACK TO FOROTS
  IF USERS WANTS CONTROL
	SKIPG	T1,ERRADR	;GET RETURN ADDRESS
	JRST	$T
  THEN RETURN TO FORTRAN
	HRRM	T1,-1(P)	;SET USERS RETURN ADDRESS
	RETURN

  ELSE DO FORTRAN EXIT 
	MOVEI	L,1+ERRARG	;ARG BLOCK FOR EXIT
	PUSHJ	P,@EXIT.	;GO TO FORTRAN EXIT
	MONRET			;GIVE UP
	JRST	.-1		;IN CASE OF CONTINUE
  FI;
END;

ERRARG:	EXP	0,0
	SEGMENT	LOW
FORTPP:	BLOCK	1		;SAVE RETURN PC (AC 17)
FORARG:	BLOCK	1		;ORIGINAL L
FUNCT.:	BLOCK	1		;ADDRESS OF FUNCT.
EXIT.:	BLOCK	1		;ADDRESS OF EXIT.
	SEGMENT	HIGH
SUBTTL	PSORT. -- SETUPI - Set Up Input Files

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

SETUPI:	MOVE T1,IOMODE		;GET I/O MODE
	MOVE T1,BYTTAB-1(T1)	;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+<400/^D36>	;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]	;GET DEVICE TYPE
	CAXN T2,.DVDSK		;DISK?
	MOVEI T1,PGSIZ		;YES, BUFFER WANTS TO BE 1 PAGE
	CAXN T2,.DVMTA		;MTA?
	CALL	[CALL MTBFSZ	;YES, 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)	;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)	;GET JFN
	HRLZM T1,FILPGN(F)	;STORE IN FCB
	MOVE T3,X.FLG(P1)	;GET FILE FLAGS
	MOVEM T3,FILFLG(F)	;SAVE IN FCB
	MOVN T1,X.BLKF(P1)	;GET NEGATIVE BLOCKING FACTOR
	SKIPE T1		;[312] ALREADY ZERO?
	SUBI T1,1		;[305] ADJUST FOR OFF-BY-ONE CODE
	HRLZM T1,FILBLK(F)	;STORE AS AOBJN WORD
	SETZM FILSIZ(F)
	SETZM FILEOF(F)
	SETZM FILCNT(F)
	LDB T1,[POINT 9,X.DVCH(P1),17] ;GET DEVICE TYPE
	CAILE T1,.DVNET		;RANGE CHECK
	JRST E$$NSD		;NO SUCH DEVICE
	JUMPL T1,E$$NSD		;CAN'T BE NEGATIVE
	CALL	@[INDSK		;0 - DISK
		  E$$NSD	;1 - NO SUCH DEVICE
		  INMTA		;2 - MAGTAPE
		  REPEAT 4,<E$$NSD> ;3-6 - NO SUCH DEVICE
		  E$$CDL	;7 - LINE PRINTER
		  INCDR		;10 - CARD READER
		  E$$FED	;11 - FRONT-END DEVICE
		  INTTY		;12 - TERMINAL
		  INPTY		;13 - PSEUDO-TERMINAL
		  E$$NSD	;14 - NO SUCH DEVICE
		  INNUL		;15 - NULL DEVICE
		  E$$AND](T1)	;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)	;[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
	MOVE T2,IOMODE		;UNLESS THIS IS A SIXBIT FILE,
	CAXE T2,MODSIXBIT	; ..
	IMUL T1,IOBPW		;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
	HRRZ T1,FILBUF(F)	;[326] [321] GET PAGE BUFFER STARTS ON
	LSH T1,POW2(PGSIZ)	;[321] COMPUTE ADDRESS
	HRLM T1,FILBSZ(F)	;[321] SAVE AS 1ST BLOCK BOUNDARY
	HLRZ T1,FILBUF(F)	;[321] GET PAGES PER BUFFER
	LSH T1,POW2(PGSIZ)	;CONVERT TO WORDS
	MOVE T2,IOMODE		;GET I/O MODE
	CAXE T2,MODSIXBIT	;IF SIXBIT, WORDS=BYTES
	IMUL T1,IOBPW		;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
	HRLZM T1,FILBUF(F)	;SAVE SIZE OF BUFFER
	IMUL T1,IOBPW		;COMPUTE BYTES PER BUFFER
	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
	HLRZ T1,FILPGN(F)	;GET JFN
	MOVX T2,OF%RD!FLD(17,OF%MOD) ;OPEN FOR READ, DUMP MODE
	OPENF%			;[335]   ..
	  ERJMP E$$OPN
	MOVX T1,FI.REW		;REWIND REQUESTED?
	TDNE T1,FILFLG(F)	; ..
	CALL RWNDF		;YES, DO IT
	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]   ..
	MOVX T1,FI.BF2+FI.EOF	;CLEAR RANDOM FLAGS
	ANDCAM T1,FILFLG(F)	; ..

;CONSTRUCT I/O COMMAND LIST

	HLRZ T1,FILBUF(F)	;GET WORDS PER BUFFER
	MOVN T1,T1		;NEGATE
	HRLZ T2,T1
	HRRZ T1,FILBUF(F)	;GET BUFFER ADDRESS
	MOVEI T1,-1(T1)		; MINUS ONE
	HRR T2,T1		;CONSTRUCT IOWD POINTER
	MOVEM T2,INLST		;SAVE IT
	SETZM INLST+1		;TIE OFF END OF COMMAND LIST

;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

;BLKSET - SET UP FOR BLOCKED FILE. COMPUTES NUMBER OF WORDS IN
;A BLOCK (ALWAYS AN INTEGRAL MULTIPLE OF 128 WORDS).

BLKSET:	MOVE T1,RECSIZ		;[344] [305] GET BYTES PER WORD
	IMUL T1,X.BLKF(P1)	;[305]   TIMES RECORDS PER BLOCK
	TRZE T1,177		;[435] [344] [305] LOSE LOW=ORD BITS. WORD/BLK. UNLESS ALREADY 0
	ADDI T1,200		;[305] ROUND UP TO NEXT WHOLE BLOCK SIZE
	HRRM T1,FILBSZ(F)	;[321] SAVE IN FCB
	RET			;[305] DONE
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,IOBPW		; ..
	MOVEM T1,FILBPB(F)	;SAVE IT
	RET
;COMPUTE BUFFER SIZE FOR MAGTAPE, ACCOUNTING FOR BLOCKING FACTOR

MTBFSZ:	SKIPN T3,X.BLKF(P1)	;BLOCKING FACTOR SPECIFIED?
	JRST MTBFS1		;UNBLOCKED, USE DEFAULT RECORD SIZE
	MOVE T1,IOMODE		;DISPATCH ON I/O MODE
	JRST	@[MTB6BT	;SIXBIT
		  MTBASC	;ASCII
		  MTBBCD	;EBCDIC
		  MTBBIN]-1(T1)	;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
	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
	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
	RET
;LABSET -- SET UP LABEL NAMES IN SIXBIT FOR LABEL PROCESSING


LABSET:	MOVE T1,X.LABL(P1)	;GET LABEL TYPE FOR THIS TAPE
	MOVE T2,X.FLG(P1)	; 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)		; TO CLEAR STRING SPACE
	HRRZI T2,^D17-1(P2)	;END OF BLT
	SETZM 0(P2)		;CLEAR FIRST WORD
	BLT T1,0(T2)		;SPREAD IT AROUND
	SETZM X.RIB+.RBNAM(P1)	;CLEAR CELLS IN X. BLOCK
	SETZM X.RIB+.RBEXT(P1)	; WHICH WILL RECEIVE SIXBIT NAME.EXT
	HRRO T1,P2		;CONSTRUCT STRING PTR TO SPACE
	HRRZ T2,X.JFN(P1)	;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)] ;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
	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)]
	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)	;PUT FLAGS IN FCB
	TXO T1,FI.OUT		;REMEMBER THIS IS AN OUTPUT FILE
	MOVEM T1,FILFLG(F)	; ..
	MOVE T1,X.JFN(P1)	;GET JFN
	HRLZM T1,FILPGN(F)	;SAVE IT AND ZAP PAGE COUNT
	MOVN T1,X.BLKF(P1)	;GET NEGATIVE BLOCKING FACTOR
	SKIPE T1		;[312] ALREADY ZERO?
	SUBI T1,1		;[305] ADJUST FOR OFF-BY-ONE CODE
	HRLZM T1,FILBLK(F)	;STORE AS AOBJN WORD
	LDB T1,[POINT 9,X.DVCH(P1),17] ;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	@[OUDSK		;0 - DISK
		  E$$NSD	;1 - NO SUCH DEVICE
		  OUMTA		;2 - MAGTAPE
		  REPEAT 4,<E$$NSD> ;3-6 - NO SUCH DEVICE
		  OULPT		;7 - LPT
		  E$$CDC	;10 - CDR
		  E$$FED	;11 - FRONT-END DEVICE
		  OUTTY		;12 - TERMINAL
		  OUPTY		;13 - PSEUDO-TERMINAL
		  E$$NSD	;14 - NO SUCH DEVICE
		  OUNUL		;15 - NULL DEVICE
		  E$$AND](T1)	;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)	;[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

	HRLM T1,FILBSZ(F)	;[321] SAVE BUFF ORG AS 1ST BLOCK BREAK
	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
	HLRZ T1,FILBUF(F)	;GET PAGES PER BUFFER
	LSH T1,POW2(PGSIZ)	;COMPUTE WORDS
	MOVE T2,IOMODE		;FOR SIXBIT FILES,
	CAXE T2,MODSIXBIT	; WORDS=BYTES
	IMUL T1,IOBPW		;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 MTBFSZ		;COMPUTE BUFFER SIZE (IN WORDS)
	HRLZM T1,FILBUF(F)	;SAVE IT
	MOVE T2,IOMODE		;[420] FOR SIXBIT FILES
	CAXE T2,MODSIXBIT	;[420] WORDS=BYTES
	IMUL T1,IOBPW		;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
	MOVX T1,FI.REW		;REWIND REQUESTED?
	TDNE T1,FILFLG(F)	; ..
	CALL RWNDF		;YES, DO IT
	HRRZ T1,FILBUF(F)	;GET ADDRESS OF BUFFER
	ADD T1,CBPTR		;MAKE BYTE POINTER
	MOVEM T1,FILPTR(F)	;SAVE IN FCB
	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 T2,.MOREW		;FUNCTION TO REWIND TAPE
RWNDF1:	HLRZ T1,FILPGN(F)	;GET JFN
	MTOPR%			;[335] DO IT
	RET

;UNLDF - UNLOAD MAGTAPE POINTED TO BY F

UNLDF:	MOVX T2,.MORUL		;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

;WRTEOF - WRITE A TAPE MARK DURING LABEL PROCESSING

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

;FORCBF - FORCE PARTIAL BUFFER OUT TO TAPE DURING LABEL PROCESSING

FORCBF:	MOVX T1,FI.CLZ		;PRETEND CLOSE IN PROGRESS
	IORM T1,FILFLG(F)	; ..
	JSP T4,PUTBUF		;WRITE THE BUFFER
	MOVX T1,FI.CLZ		;CLEAR THE BIT
	ANDCAM T1,FILFLG(F)
	RET

;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

>;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
	MOVX T1,FI.CLZ		;INDICATE CLOSE IN PROGRESS
	IORM T1,FILFLG(F)	; ..
	JSP T4,PUTBUF		;WRITE LAST PARTIAL BUFFER
	MOVX T1,FI.CLZ		;CLEAR CLOSE FLAG
	ANDCAM T1,FILFLG(F)	; ..
	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?
 IF FILE IS OUTPUT MTA WITH LABELS
	MOVE T1,FILFLG(F)	;[420] GET FLAGS
	TXC T1,FI.MTA!FI.OUT	;[420] 
	TXCE T1,FI.MTA!FI.OUT	;[420] OUTPUT MTA?
	JRST $T			;[420] NO
	TXNE T1,FI.ATO		;[420] TAPE LABEL PROCESSOR AVAIL?
	JRST $T			;[420] NO
	MOVE T1,FILXBK(F)	;[420] GET X.??? BLOCK FOR FILE
	MOVE T1,X.LABL(T1)	;[420] GET LABEL TYPE
  CASE LABEL TYPE OF (STANDARD,OMITTED,NON-STANDARD,DEC,ANSI,IBM)
	JRST @[EXP CPOPJ,$C,$C,CPOPJ,$C,$C]-1(T1)
  ESAC;
  THEN JUST RETURN WITH FILE STILL OPEN
  ELSE CLOSE FILE AND RELEASE JFN
	HLRZ T1,FILPGN(F)	;[420] GET JFN OF FILE
	CLOSF%			;[335] NO, CLOSE IT
	  ERJMP E$$CFF		;CLOSE FAILURE FOR FILE
  FI;
	RET
SUBTTL	I/O ROUTINES -- File Utility Routines -- Delete, Rename a 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

;*** TEMPORARY DUMMY ROUTINE TO RESOLVE UNDEFINED GLOBALS ***

RELFIL:	RET			;JUST RETURN

;*** END OF TEMPORARY DUMMY ROUTINE ***
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,-<<400/^D36>+1> ;SET UP AOBJN PTR TO PGTAB
	SETZ P2,		;INIT BIT NUMBER

RESET1:	MOVE T1,PGTAB(P1)	;GET NEXT WORD OF PGTAB
	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:	MOVE P1,CORSTK		;GET PTR TO ALLOCATION STACK

RESTC1:	HRRZ T1,P1		;SEE IF EMPTY YET
	CAIN T1,CSTACK-1	;IS IT?
	JRST RESTC3		;YES
	HLRZ T1,0(P1)		;NO, GET LENGTH OF TOP ENTRY
	CALL FRESPC		;FREE IT
	POP P1,T1		;DROP THE STACK DOWN
	JRST RESTC1		;KEEP GOING

RESTC3:	CAME P1,CORSTK		;FRESPC SHOULD MAKE THIS COME OUT RIGHT
	JRST E$$FCR		;FATAL MEMORY MANAGEMENT ERROR AT RESET%
				;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
	MOVN F,ACTTMP		;GET NO. OF ACTIVE TMP FILES
	HRLZ F,F		;CONSTRUCT AOBJN PTR
	HRRI F,TMPFCB		; TO TMP FCB BLOCKS

RESTC2:	HLRZ T1,FILPGN(F)	;GET JFN
	IORX T1,CZ%ABT		;ABORT FILE
	CLOSF%			;[335]
	  ERJMP .+1
	ADDI F,FCBLEN-1		;STEP TO NEXT FCB (ACCOUNTING FOR AOBJN)
	AOBJN F,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)		;IS BIT ALREADY SET?
	JRST E$$FPM		;YES
	IORM T3,0(T1)		;NO, SET IT AND RETURN
	RET

;CLRBIT - ANALOGOUS TO SETBIT

CLRBIT:	CALL BITSET		;COMPUTE WORD ADDR AND SET UP BIT
	TDNN T3,0(T1)		;ALREADY CLEAR?
	JRST E$$FPU		;YES
	ANDCAM T3,0(T1)		;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)		;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)	;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(T1)	;BLT LIMIT
	HLRZ T3,FILRUN(F)	;PRESERVE RUN NUMBER ENTFIL COMPUTED
	BLT T1,-1(T2)		;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
	ADDI T1,(T4)		;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)		;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
	MOVS T1,@EXTRCT		;GET EXTRACT CODE
	CAIN T1,(JRST (P4))	;JUST A DUMMY?
	SKIPE X.BLKF(P1)	;CAN'T DO IF OUTPUT BLOCKED
	RET			;DO THE COPY
	LDB T1,[POINT 9,X.DVCH(P1),17] ;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)		;ZERO STRING SPACE
	SETZM 1(T1)		; ..
	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)	;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)		;ZERO STRING SPACE
	SETZM 1(T1)		; ..
	MOVE T4,T1		;SAVE ADDRESS
	HRROS T1		;CONSTRUCT STRING PTR
	HRRZ T2,X.JFN(P1)	;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)	;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)	;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)	;GET TEMP FILE JFN AGAIN
	HRRZ T2,X.JFN(T4)	;GET OUTPUT FILE JFN
	RNAMF%			;[335] DO THE RENAME
	  ERJMP E$$RFF		;FAILED
	MOVE T1,INPREC		;FAKE COPY OF FILE
	MOVEM T1,OUTREC		;SO ENDS. IS HAPPY
	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
IFE FTCOBOL,<			;FALL THROUGH TO GETDSK IN COBOL SORT
	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
	TXNE T1,FI.EOF		;[435] WAS EOF DETECTED LAST TIME?
	JRST	[MOVE EF,PHYEOF	;YES, GIVE EOF RETURN NOW
		 RET]		; ..
	MOVE T1,FILXBK(F)	;GET ADDR OF X. BLOCK FOR FILE
	LDB T1,[POINT 9,X.DVCH(T1),17] ;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	;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 [	MOVE EF,PHYEOF	;NO, GIVE EOF RETURN
			RET]
		MOVX T1,FI.EOF	;YES, SET FLAG FOR NEXT TIME
		IORM T1,FILFLG(F)
		RETSKP]		;AND GIVE SKIP RETURN
	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)	; ..
	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 T1,FILCNT(F) ;WAS ANYTHING READ THIS TIME?
		JRST [	MOVE EF,PHYEOF	;NO, GIVE EOF RETURN
			RET]		; ..
		MOVX T2,FI.EOF	;YES, SET EOF FLAG FOR NEXT TIME
		IORM T2,FILFLG(F) ; ..
		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
SUBTTL	GETREC -- GETBUF - Input 1 Physical Buffer -- Disk


GETDSK:
IFE FTCOBOL,<
	MOVX T1,FI.BLK		;BLOCKING FACTOR HACK IN PROGRESS?
	TDNE T1,FILFLG(F)	; ..
	CALL [	ANDCAM T1,FILFLG(F)	;[435] [321] YES, CLEAR BLK HACK BIT
		CALL CLRBUF		;[321] ADVANCE TO NEXT BLOCK
		SKIPG FILCNT(F)		;[321] MORE LEFT IN BUFFER?
		RET			;[321] NO, REJOIN GETDSK FLOW
		POP P,T1		;[321] FIX UP STACK
		RETSKP]			; AND RETURN TO GETREC
>
	SKIPG T1,FILEOF(F)	;ANY BYTES LEFT?
	JRST [	MOVE EF,PHYEOF		;NO, GIVE EOF RETURN
		RET]			; ..
	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,<
	MOVX T2,FI.TMP		;IS THIS A TEMP FILE?
	TDNE T2,FILFLG(F)	; IF SO, WORDS=BYTES
	JRST GETDS1		;YES, SKIP THE DIVIDE
	MOVE T2,IOMODE		;GET I/O MODE
	CAXE T2,MODSIXBIT	;[435] IF SIXBIT, WORDS=BYTES, SO SKIP THE DIV
	IDIV T1,IOBPW		;COMPUTE NO. OF WORDS WE'RE READING
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.

	HRRZ	T4,FILBUF(F)		;[402] BUILD AOBJN POINTER FOR PAGES
	LSH	T4,POW2(PGSIZ)		;[402]   POINTING TO ADDRESS OF PAGE
	MOVNI	T1,(T3)			;[402]   ..
	HRL	T4,T1			;[402]   ..
	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)		;[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-1	;[402] PARTIALLY ADVANCE AOBJN COUNTER
		AOBJN	T4,$B		;[402] LOOP UNTIL NO MORE PAGES
	END;
	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,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
	SUBI	T4,-1(T1)		;[402] COMPUTE # PAGES TO THERE
	CAIGE	T4,(T3)			;[402] MORE THAN WE ASKED FOR?
	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]   ..
	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:	MOVE T1,FILFLG(F)	;[435] GET FILE FLAGS
	TXNE T1,FI.LAB		;[435] IS LABEL CHECKING IN PROGRESS?
	JRST GETMT1		;YES, IGNORE PREVIOUSLY DETECTED EOF
	TXNE T1,FI.EOF		;[435] DID WE ENCOUNTER EOF LAST TIME?
	JRST [	MOVE EF,PHYEOF	;YES, GIVE EOF RETURN
		RET]		; ..

GETMT1:	TXNE T1,FI.LAB		;[435] IF LABEL PROCESSING IN PROGRESS,
	TXNN T1,FI.EOF		; AND WE'RE PAST EOF,
	JRST GETMT2		; ..
	SETZM INLST		;THEN WE'VE ALREADY READ TRAILER LABEL.
				;[335]   BUILD DUMMY COMMAND LIST SO DUMPI%
				; WILL JUST INSURE THE READ FINISHED.
	TXC T1,FI.BF2		;ALSO FLIP BUFFER FLAG BECAUSE WE'RE
				; NOW SYNCHRONOUS WITH TAPE
	MOVEM T1,FILFLG(F)	; ..
	JRST GETMT3

GETMT2:	CALL ADVBUF		;ADVANCE BUFFERS AND GET ADDR OF NEXT
	MOVEI T1,-1(T1)		;GET BUFFER-1
	HLRZ T2,FILBUF(F)	;GET NO. OF WORDS PER BUFFER
	MOVN T2,T2		;NEGATE
	HRL T1,T2		;MAKE IOWD
	MOVEM T1,INLST		;FORM I/O COMMAND LIST
;NOW START I/O ON NEXT BUFFER AND WAIT FOR I/O TO FINISH ON THIS ONE
	SETZM INLST+1		;TIE OFF I/O COMMAND LIST
	MOVX T2,DM%NWT		;SET "DO NOT WAIT" BIT

GETMT3:	HLRZ T1,FILPGN(F)	;GET JFN
	HRRI T2,INLST		;ADDR OF COMMAND LIST
	SETZM FILCNT(F)		;ZAP FILCNT
	DUMPI%			;[335] DO IT
	  ERCAL [CAXN T1,IOX4		;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]   ..
			MOVX T2,DM%NWT		;STAY ASYNCHRONOUS
			HRRI T2,INLST		;GET PAST FILE MARK
			DUMPI%			;[335]   ..
			  ERJMP E$$DME
			POP P,T1		;POP USELESS RETURN
			MOVX T1,FI.EOF		;SET EOF FLAG
			IORM T1,FILFLG(F)	; ..
			MOVE EF,PHYEOF		;GIVE EOF RETURN TO
			RET]			; GUY WHO CALLED GETBUF
		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 WORDS READ INTO RH(T3)
		MOVE T4,IOMODE		;IF SIXBIT,
		CAXE T4,MODSIXBIT	; WORDS=BYTES
		IMUL T3,IOBPW		;COMPUTE BYTES READ
		MOVEM T3,FILCNT(F)	;SAVE IN FCB
		MOVX T2,FI.LAB		;TAPE LABELLING IN PROGRESS?
		TDNE T2,FILFLG(F)	; ..
		JRST [	MOVEI T2,INLST		;YES, RESTART I/O
			DUMPI%			;[335]   ..
			  ERJMP E$$DME		;TROUBLE
			RET]			;REJOIN MAIN FLOW
		MOVEI T2,INLST		;RETRY I/O OPERATION
		DUMPI%			;[335]   ..
		  JFCL			;ALWAYS SHOULD FAIL
		CAXE T1,IOX4		;END OF FILE?
		JRST E$$DME		;NO, BUG SOMEWHERE
		MOVX T1,FI.EOF		;FLAG EOF SEEN
		IORM T1,FILFLG(F)	; ..
		RET]
; ..

	MOVE T1,FILBPB(F)	;GET BYTES PER (FULL) BUFFER
	SKIPN FILCNT(F)		;UNLESS THE HAIRY LITERAL ABOVE
				; COMPUTED FILCNT FOR US,
	MOVEM T1,FILCNT(F)	;INDICATE BUFFER HAS BEEN FILLED
	HRRZ T1,FILBUF(F)	;GET ADDR OF FIRST BUFFER
	MOVX T2,FI.BF2		;SECOND BUFFER IN USE?
	TDNN T2,FILFLG(F)	; ..
	CALL [	HLRZ T2,FILBUF(F) ;NO, GET BUFFER LENGTH
		ADD T1,T2	;ADVANCE TO 2ND BUFFER
		TRZE T1,PGMSK	;ALWAYS ON PAGE BOUNDARY
		ADDI T1,PGSIZ	; ..
		RET]
	ADD T1,CBPTR		;FORM PROPER BYTE POINTER
	MOVEM T1,FILPTR(F)	;SAVE IT
	MOVE T1,FILCNT(F)	;RETURN WITH T1=NO. OF BYTES READ
	RETSKP			;GIVE GOOD RETURN


;ADVBUF - ADVANCE MAGTAPE BUFFERS
;	  RETURN WITH C(T1) = ADDR OF NEXT BUFFER

ADVBUF:	HRRZ T1,FILBUF(F)	;GET BUFFER ADDRESS
	MOVX T3,FI.BF2		;2ND BUFFER IN HAVE I/O IN PROGRESS?
	TDNE T3,FILFLG(F)	; ..
	JRST ADVBF1		;YES, USE FIRST BUFFER
	HLRZ T2,FILBUF(F)	;NO, GET LENGTH OF A BUFFER
	ADD T1,T2		;COMPUTE ADDRESS OF 2ND BUFFER
	TRZE T1,PGMSK		;ROUND UP TO A PAGE BOUNDARY
	ADDI T1,PGSIZ		; ..
	IORM T3,FILFLG(F)	;SET FLAG SAYING 2ND BUFFER BUSY
	RET			;ALL SET

ADVBF1:	ANDCAM T3,FILFLG(F)	;CLEAR FLAG SAYING 2ND BUFFER BUSY
	RET

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


;CALL:		JSP T4,PUTBUF
;RETURNS:	+1/ ALWAYS

PUTBUF:	PUSH P,T4		;PUSH RETURN ADDR ON STACK
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,FILBPB(F)	;BYTES PER BUFFER
	SUB T3,FILCNT(F)	; MINUS BYTES NOT WRITTEN
				; EQUALS BYTES WRITTEN THIS TIME
	SETZ T4,		;OR STOP ON NULL
	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)	; ..
	RET			;RETURN
;CLRBUF SIMULATES SKIPPING TO NEXT TOPS-10 DISK BLOCK. THIS IS FOR BLOCKING
;VARIABLE-LENGTH RECORDS FOR RANDOM FILES.  CALLED ONLY BY PUTREC AND GETDSK.

CLRBUF:	MOVE T1,FILFLG(F)	;[305] FILTER OUT BUGS
	TXNE T1,FI.MTA		;[401] IF MTA
	RET			;[401] RETURN
	TXNN T1,FI.DSK		;[305]   ..
	JRST E$$CCN		;NON-DISK DEVICE

CLRBF1:	HLRZ T1,FILBSZ(F)	;[321] GET ADDR OF LAST BLOCK BREAK
	HRRZ T2,FILBSZ(F)	;[321] GET BLOCK SIZE IN WORDS
	ADD T1,T2		;[321] COMPUTE NEXT BLOCK BREAK
	HRRZ T2,FILBUF(F)	;[321] GET PAGE NO. BUFFER STARTS ON
	LSH T2,POW2(PGSIZ)	;[321] COMPUTE BUFFER'S ADDRESS
	HLRZ T3,FILBUF(F)	;[321] GET SIZE OF BUFFER IN PAGES
	LSH T3,POW2(PGSIZ)	;[321] COMPUTE LENGTH IN WORDS
	ADD T2,T3		;[321] FIRST ADDRESS ABOVE BUFFER
	CAML T1,T2		;[321] IS BLOCK BREAK ABOVE BUFFER?
	SUB T1,T3		;[321] YES, MOD BUFFER SIZE
	ADD T1,CBPTR		;[321] CONSTRUCT NICE BYTE POINTER
	CALL ADJFCT		;[321] ADJUST FILCNT (HAIRY)
	MOVEM T1,FILPTR(F)	;[321] STUFF BYTE PTR INTO FCB
	HRLM T1,FILBSZ(F)	;[321] REMEMBER THIS BLOCK BOUNDARY
	SKIPN FILCNT(F)		;[321] ANY BYTES LEFT IN BUFFER?
	RET			;[321] NO, RETURN NOW
	MOVE T1,FILFLG(F)	;[321] YES, GET FILE FLAG BITS
	TXNE T1,FI.OUT		;[321] OUTPUT FILE?
	TXO T1,FI.BLK		;[321] YES, TELL PUTBUF NOT TO DO
	MOVEM T1,FILFLG(F)	;[321]  OUTPUT NEXT TIME
	RET
;STILL IN IFE FTCOBOL

;ADJUST FILCNT AFTER ADVANCING TO NEXT BLOCK BOUNDARY (BLOCKED DISK FILES ONLY).
;CALL:
;	MOVE T1,<NEW FILPTR>
;	CALL ADJFCT
;	UPDATES FILCNT WITHOUT DISTURBING T1

ADJFCT:	LDB T2,[POINT 6,FILPTR(F),5] ;[321] GET BYTE POSITION OF NEXT BYTE
	CAIN T2,44		;[321] FUNNY CASE?
	CALL [	SOS FILPTR(F)		;[321] YES, ADJUST FOR IT
		SETZ T2,		;[321]  ..
		RET]
	MOVE T3,IOMODE		;[321] IF SIXBIT,
	CAXE T3,MODSIXBIT	;[321] WORDS=BYTES
	IDIV T2,IOBPW		;[321] COUNT PARTIAL WORD BYTES
	AOS T3,FILPTR(F)	;[321] POINT AT FIRST FULL WORD
	HRRZ T3,T3		;[321] GET WORD ADDR OF FIRST FULL WORD
	HRRZ T4,T1		;[321] GET WORD ADDR OF NEXT BLOCK
	CAMGE T4,T3		;[435] [321] NEW BUFFERLOAD?
	JRST [	SETZM FILCNT(F)		;[321] YES, JUST ZAP FILCNT
		RET]			;[321] AND RETURN
	SUB T4,T3		;[321] COMPUTE WORDS BEING SKIPPED
	MOVE T3,IOMODE		;[321] IF SIXBIT,
	CAXE T3,MODSIXBIT	;[321] WORDS=BYTES
	IMUL T4,IOBPW		;[321] TIMES BYTES PER WORD
	ADD T4,T2		;[321] ADD PARTIAL WORD BYTES
	MOVE T2,FILCNT(F)	;[321] GET OLD FILCNT
	SUB T2,T4		;[321] SUBTRACT BYTES BEING SKIPPED
	MOVEM T2,FILCNT(F)	;[321] UPDATE FILCNT
	RET

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


PUTDSK:
IFE FTCOBOL,<
	MOVE T1,FILFLG(F)	;[435] GET FILE FLAGS
	TXZE T1,FI.BLK		;[435] BLOCKING FACTOR HACK IN PROGRESS?
	JRST [	MOVEM T1,FILFLG(F)	;[435] YES, RESET THE FLAG
		RET]			;AND RETURN TO CALLER OF PUTBUF
>
	HRLZI T1,.FHSLF		;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
IFE FTCOBOL,<
	MOVE T4,FILFLG(f)	;[371]	
	TXNE T4,FI.TMP		;[371] IS THIS A TMP FILE?
	ADDM T3,SUMTMP		;YES, UPDATE TOTAL PAGES USED
>
	IORX T3,PM%CNT!PM%RWX	;ALLOW ALL TYPES OF ACCESS TO FILE PG.
	PMAP%			;[335] MOVE THEM OUT TO THE FILE
	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
	SUB T2,T1		;COMPUTE BYTES WRITTEN THIS TIME
	ADDM T2,FILEOF(F)	;UPDATE TOTAL NO. OF BYTES WRITTEN
	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
	MOVE T1,FILCNT(F)	;RETURN WITH BYTE COUNT IN T1
IFE FTCOBOL,<
	TXNN T4,FI.TMP		;[371] IS IT A TEMP FILE?
	SKIPG SEQNO		;[371] OR OUTPUT NOT SEQUENCED
	RET			;[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
	ADDI T3,(T2)		;[371] END+1
	HRL T2,T2		;[371] FORM BLT POINTER
	ADDI T2,1		;[371] EVENTUALLY
	SETZM -1(T2)		;[371] CLEAR FIRST WORD
	BLT T2,-1(T3)		;[371]  AND THE REST
>;END IFE FTCOBOL
	RET			;RETURN
;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:	MOVX T3,FI.CLZ		;HAD BETTER BE CLOSING THE FILE
	TDNN T3,FILFLG(F)	;ARE WE?
	JRST E$$AWP		;ATTEMP TO WRITE PARTIAL OUTPUT BUFFER
	MOVE T3,FILBPB(F)	;GET BYTES PER (FULL) BUFFER
	SUB T3,T4		;SUBTRACT # OF UNWRITTEN BYTES
IFE FTCOBOL,<
  IF THIS IS NOT A TEMP FILE NOR A SIXBIT 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
	MOVE T4,IOMODE		;[400] NOW CHECK FOR SIXBIT
	CAXE T4,MODSIXBIT	;[400]   ..
  THEN FIND BYTES PER WORD
	SKIPA T4,IOBPW		;[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:	HRRZ T1,FILBUF(F)	;GET FIRST BUFFER'S ADDRESS
	MOVX T2,FI.BF2		;WHICH BUFFER DO WE WISH TO OUTPUT?
	TDNN T2,FILFLG(F)	; ?
	JRST PUTMT1		;BUFFER ONE, T1 HAS ITS ADDRESS
	HLRZ T2,FILBUF(F)	;BUFFER TWO - GET BUFFER LENGTH
	ADD T1,T2		;COMPUTE SECOND BUFFER'S ADDRESS
	TRZE T1,PGMSK		;ROUND UP TO PAGE BOUNDARY
	ADDI T1,PGSIZ		; ..

PUTMT1:	MOVEI T1,-1(T1)		;COMPUTE BUFFER ADDRESS-1
	HLRZ T2,FILBUF(F)	;GET BUFFER LENGTH
	SKIPLE T3,FILCNT(F)	;WRITING PARTIAL BUFFER?
	CALL [	MOVX T4,FI.CLZ		;YES, HAD BETTER BE CLOSING THE FILE
		TDNN T4,FILFLG(F)
		JRST E$$AWP		;ATTEMP TO WRITE PARTIAL BUFFER
		IMUL T2,IOBPW		;CONVERT BUFFER SIZE IN WORDS TO BYTES
		SUB T2,T3		;SUBTRACT NO.OF BYTES WE DIDN'T WRITE
		IDIV T2,IOBPW		;CONVERT BACK TO WORDS
		SKIPE T3		;ROUND UP TO A WHOLE WORD
		ADDI T2,1		; ..
		RET]			;AND RETURN
	MOVN T2,T2		;NEGATE IT
	HRL T1,T2		;MAKE IOWD
	MOVEM T1,OUTLST		;CONSTRUCT CMD LIST
	SETZM OUTLST+1		; ..
	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 T1,FI.EOT		;SET EOT BIT IN FILFLG
		IORM T1,FILFLG(F)	; ..
		RET]			;REJOIN MAIN FLOW
	MOVE T1,FILBPB(F)	;GET BYTES PER BUFFER
	MOVEM T1,FILCNT(F)	;INDICATE BUFFER BEGGING TO BE FILLED
	CALL ADVBUF		;ADVANCE BUFFERS
	ADD T1,CBPTR		;CONSTRUCT BYTE POINTER TO BUFFER
	MOVEM T1,FILPTR(F)	;SAVE IT
	SKIPG SEQNO		;[371] OUTPUT NOT SEQUENCED
	RET			;[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
	ADDI T3,(T2)		;[371] END+1
	HRL T2,T2		;[371] FORM BLT POINTER
	ADDI T2,1		;[371] EVENTUALLY
	SETZM -1(T2)		;[371] CLEAR FIRST WORD
	BLT T2,-1(T3)		;[371]  AND THE REST
	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
	CAIGE T1,(P1)		;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
	CAIGE T1,(P1)		;IS USER'S SIZE .GE. MINIMUM?
	JRST [	$ERROR (%,NBS,<Not enough buffer space specified>)
		MOVEI T1,(P1)	;USE MINIMUM INSTEAD
		JRST CHKTRE]	;AND RETURN
	CAIL T1,(P2)		;IS USER'S SIZE .LT. MAXIMUM?
	JRST [	$ERROR (%,TMS,<Too much buffer space specified>)
		MOVEI T1,(P2)	;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
	CAIGE T1,(P1)		;RANGE CHECK
	MOVEI T1,(P1)		; AGAINST MINIMUM
	CAIL T1,(P2)		; AND MAXIMUM
	MOVEI T1,(P2)		; ..
;HERE WITH C(T1) = SIZE OF I/O BUFFER AREA TO ALLOCATE

CHKTRE:	MOVEM T1,BUFSZ		;SAVE SIZE OF BUFFER AREA
	SKIPLE MRGSW		;MERGE COMMAND?
	JRST CHKRT1		;YES, SETTMP COMPUTED NUMRCB FOR US
	CALL MINTRE		;COMPUTE MINIMUM SIZE OF TREE
	MOVEI P1,(T1)		;SAVE
	CALL MAXTRE		;COMPUTE MAXIMUM SIZE OF TREE
	CAIGE T1,(P1)		;INSURE .GE. MINIMUM
	JRST E$$NEC		;OOPS
	MOVEI P2,(T1)		;SAVE FOR MORE TESTS
IFE FTCOBOL,<
	CALL USRTRE		;DID USER SPECIFY A TREE SIZE?
	JRST CHKCR2		;NO, USE DEFAULT
	CAIGE T1,(P1)		;IS USER .GE. MINIMUM?
	JRST [	$ERROR (%,NLS,<Not enough leaves specified>)
		MOVEI T1,(P1)	;USE MINIMUM
		JRST CHKRET]	;AND FINISH UP
	CAILE T1,(P2)		;IS USER .LE. MAXIMUM?
	JRST [	$ERROR (%,TML,<Too many leaves specified>)
		MOVEI T1,(P2)	;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
	CAIGE T1,(P1)		;RANGE CHECK
	MOVEI T1,(P1)		; ..
	CAILE T1,(P2)		; ..
	MOVEI T1,(P2)		; ..

;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
	CALLRET SETSIZ		;SET CORE SIZE
;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 PG AND 1 TMP PG
	MOVEI T1,PGSIZ		;FOR TEMP FILE INPUT
	ADD T1,MXDVSZ		;PLUS BIGGEST INPUT DEVICE BUFFER
	JRST RNDRET		;ROUND UP TO A PAGE AND RETURN
>

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

IFE FTCOBOL,<			;FOR REGULAR, NEED TMP PLUS INPUT
	HRRZ T1,ACTTMP		;NUMBER OF ACTIVE TEMP FILES
	ADDI T1,1		;PLUS ONE FOR OUTPUT
	IMUL T1,MXDVSZ		;TIMES LARGEST BUFFER (JUST IN CASE)
	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 BUFFER REQUIRED
	LSH T2,POW2(4)		;4 TIMES LARGEST BUFFER
	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
	ADDI T1,1		;PLUS ONE FOR OUTPUT
	IMUL T1,MXDVSZ		;TIMES BIGGEST KNOWN BUFFER
	LSH T1,POW2(20)		;ALLOW VERY LARGE BUFFER
	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
	IMULI T1,(T2)		;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,<
	ADD T1,MXDVSZ		;PLUS LARGEST FILE BUFFER
>
	JRST RNDRET		;ROUND UP AND RETURN

DEFBF1:	MOVE T1,ACTTMP		;GET NO. OF INPUT FILES
IFE FTCOBOL,<			;IF NOT COBOL MERGE, ADD
	ADDI T1,2		; ROOM FOR OUTPUT FILE BUFFER
>
	LSH T1,POW2(PGSIZ*2)	;ALLOW 2 PGS FOR INPUT, 4 FOR OUTPUT
;	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:	HRRZ T2,TREORG		;GET FIRST FREE
	ADD T2,BUFSZ		;ADD SIZE OF BUFFER AREA
	ADDI T2,PGSIZ		;ADD ROUNDING FACTOR
	MOVE T1,MAXFRE		;GET HIGHEST LOC AVAILABLE
	SUB T1,T2		;USE UP ALL THE SPACE FOR THE TREE
	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
	ADDI T1,PGSIZ		;ADD ROUNDING FACTOR
	CALL FRESPC		;DROP IT LIKE A HOT POTATO
	MOVE T1,CORSTK		;GET POINTER TO ENTRY IN CORE STACK FOR TREE
	HLRZ T1,0(T1)		;GET SIZE OF TREE ENTRY
	CALL FRESPC		;DEALLOCATE THE TREE AREA
	MOVEI T1,RN.LEN		;[313] SIZE OF A TREE NODE
	ADD T1,REKSIZ		;[313]   PLUS SIZE OF RECORD
	IMUL T1,NUMRCB		;[313]   TIMES NUMBER OF RECORDS
	CALL GETSPC		;ALLOCATE SPACE FOR TREE
	  JRST E$$RBP		;CONFUSION
	MOVEM T1,TREORG		;[313] TREE ORIGIN
	MOVE T1,NUMRCB		;[313] GET NUMBER OF MERGE FILES
	IMULI T1,RN.LEN		;[313]   TIMES SIZE OF TREE NODE
	ADD T1,TREORG		;[313]   + BASE
	MOVEM T1,TREEND		;[313]   END OF TREE POINTERS
	MOVE T1,NUMRCB		;[313] NUMBER OF RECORDS
	IMUL T1,REKSIZ		;[313]   TIMES THEIR SIZE
	ADD T1,TREEND		;[313]   + BASE
	MOVEM T1,RCBEND		;[313]
	HRRZ T1,ACTTMP		;GET NUMBER OF TEMP FILES
	LSH T1,POW2(PGSIZ)	;TIMES SIZE OF ONE BUFFER (1 PAGE)

IFE FTCOBOL,<			;IF NOT COBOL SORT,
	ADDI T1,OUTSIZ		;ADD SIZE OF OUTPUT BUFFER
>

IFN FTCOBOL,<			;IF COBOL SORT,
	SKIPE NUMLFT		;IF WE NEED TO DO A MERGE PASS
	ADDI T1,OUTSIZ		;ADD DESIRABLE SIZE FOR OUTPUT BUFFER
>

	IMULI T1,PPTBUF*2	;DOUBLE BUFFERING WOULD BE NICE
	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 [	LSH P1,-<POW2(2)>	;CAN'T GET IT, TRY FOR SINGLE BUFFERS
		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,BUFPTR		;REMEMBER WHERE BUFFER POOL STARTS
	MOVEM P1,BUFSZ		;REMEMBER SIZE OF BUFFER POOL
	POP P,P1		;RESTORE P1
	POP P,T1		;RESTORE UNIT BUFFER-POOL SIZE
	IDIVI T1,PPTBUF*2	;RECOVER UNIT BUFFER SIZE
	SUBI T1,OUTSIZ		; 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,BUFSZ		;GET SIZE OF BUFFER POOL
	SUBI T2,OUTSIZ		;RESERVE SPACE FOR OUTPUT BUFFER
	SKIPN P2		;IF DOUBLE BUFFERED,
	SUBI T2,OUTSIZ		; RESERVE SPACE FOR 2 OUTPUT BUFFERS
	IDIVI T2,(T1)		;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,BUFSZ		;GET 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
	SUBI T1,1		;TRUNCATE BECAUSE BUFFERS START ON PG
				; BOUNDARIES AND BUFPTR DOESN'T NECESSARILY
	CAIGE T1,2		;NEED AT LEAST 2 BUFFERS
	JRST E$$NRO		;NO ROOM
	MOVEM T1,OBUFNO		;SAVE NUMBER OF BUFFERS
	MOVE T1,BUFPTR		;PUT NEW CEILING ON BUFFER ALLOCATOR
	ADD T1,BUFSZ		; ..
	MOVEM T1,BUFTOP		; ..
IFN FTDEBUG,<
	TMSG <TBUFNO = >
	MOVE T1,TBUFNO
	CALL .TDECW
	TMSG <, OBUFNO = >
	MOVE T1,OBUFNO
	CALL .TDECW
	TMSG <
>
>
	POP P,P2		;RESTORE P2
	RET			;AND RETURN
;SETSIZ -- SET MEMORY SIZE - GET FOROTS IF REQUIRED - GO TO PSORT%

BEGIN
  PROCEDURE	(PUSHJ	P,SETSIZ)
IFE FTCOBOL,<
  IF FORTRAN FORMAT KEYS SPECIFIED
	MOVE	T1,MODEM
  IFN FTOPS20,<
	SKIPN	FORTPP		;WE ALREADY HAVE FOROTS IF FORTRAN CALL
  >
	TXNN	T1,RM.FPA
	JRST	$F
  THEN GET SYS:FOROTS.EXE
	MOVEI	T1,.FHSLF	;THIS PROCESS
	GEVEC%			;[335] GET ENTRY VECTOR
	PUSH	P,T2		;SAVE IT
	MOVX	T1,GJ%OLD+GJ%SHT;[335] DO A SHORT GTJFN%
	HRROI	T2,[ASCIZ	/SYS:FOROTS.EXE/]
	GTJFN%			;[335]
	  JRST	E$$CGF		;COMPLAIN IF WE CAN'T FIND FOROTS
	HRLI	T1,.FHSLF	;THIS PROCESS
	TRO	T1,GT%ADR	;CHECK ADDRESS LIMITS
	MOVE	T2,[400,,677]	;ALL OF HIGH SEGMENT
	GET%			;[335]
	MOVEI	T1,.FHSLF
	POP	P,T2
	SEVEC%			;[335] RESTORE ENTRY VECTOR
  FI;
>;END IFE FTCOBOL
$1%	MOVE	T1,NUMRCB	;GET NO. OF RECORDS IN TREE
	IMULI	T1,RN.LEN	;COMPUTE SIZE OF TREE
	MOVE	T3,NUMRCB	;GET NO. OF RECORDS IN TREE
	IMUL	T3,REKSIZ	; TIMES SIZE OF RECORDS
	ADD	T1,T3		;ADD SIZE OF RECORD AREA IN TREE
	CALL	GETSPC		;ALLOCATE SPACE FOR TREE AND RECORDS
IFN FTCOBOL,<
	  JRST [	SKIPN HLOVL.##		;NOT ENOUGH SPACE, MUST BE
		JRST E$$NEC		; BECAUSE OF OVERLAYS
		MOVE T1,NUMRCB		;IF SO, 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]		;GO TRY AGAIN
>
IFE FTCOBOL,<
	  JRST E$$NEC		;IF STANDALONE, NO SECOND CHANCES
>
	MOVEM	T1,TREORG	;SAVE ADDR OF START OF TREE
	MOVE	T1,BUFSZ	;ALLOCATE SEPARATE AREA FOR BUFFER POOL
	ADDI	T1,PGSIZ	;ROUND UP ONE PAGE BECAUSE DISK BUFFERS
				; ARE ON PG BOUNDARIES, SO WE'LL PROBABLY
				; THROW THE PARTIAL PAGE WE GET
	CALL	GETSPC		; ..
	  JRST E$$NEC
	MOVEM	T1,BUFPTR	;REMEMBER WHERE IT STARTS
	MOVEM	T1,BUFPT1	;SAVE INITIAL BUFPTR FOR MERGE0
	MOVE	T1,BUFSZ	;SAVE BUFFER AREA SIZE FOR ENDS.
	MOVEM	T1,BUFTOT	; ..
IFE FTCOBOL,<
	PJRST	PSORT%		;GO TO COMMON CODE
>
IFN FTCOBOL,<
	RETURN
>
END;

IFE FTCOBOL,<
E$$CGF:	$ERROR	(?,CGF,<Can not get SYS:FOROTS.EXE>)
>
;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,BUFTOP		;GET TOP 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)	;[371] ...
	POP	P,T3		;[371] GET SIZE BACK
	ADDI	T3,(T1)		;[371] END+1
	SETZM	(T1)		;[371] ZERO FIRST WORD
	BLT	T2,-1(T3)	;[371] CLEAR ALL OF DATA
	RET			+;[371]
SUBTTL	COLLATING SEQUENCE ROUTINES

IFE FTCOBOL,<
  IFN FTCOL,<

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
	MOVEI	T1,COLBUF	;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
	MOVE	T1,@COLPTR	;GET WORD
	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
	CAIG	T1," "		;IGNORE SPACE AND 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 IFN FTCOL
>;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$$FMC:	$ERROR (?,FMC,<File's mode conflicts with mode switch for >,+)
	HRRZ T2,X.JFN(P1)	;[305] PRINT THE FILE SPEC
	$MORE (FILESPEC,T2)	;[305]   ..
	$DIE			;[305]

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$$FCR:	$ERROR (?,FCR,<Fatal core management error at RESET%>)

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

E$$AWP:	$ERROR (?,AWP,<Attempted to write partial buffer for >,+)
	HLRZ T2,FILPGN(F)	;GET JFN
	$MORE (FILESPEC,T2)
	$DIE

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$$IDM:	$ERROR (?,IDM,<Illegal data mode>)

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

E$$CCN:	$ERROR (?,CCN,<CLRBUF called for non-disk device >,+)
	HLRZ T2,FILPGN(F)	;GET JFN
	$MORE (FILESPEC,T2)
	$DIE

>;END IFE FTCOBOL