Google
 

Trailing-Edge - PDP-10 Archives - BB-D489E-SB - srtuuo.mac
There are 7 other files named srtuuo.mac in the archive. Click here to see a list.
SUBTTL SRTUUO - TOPS-10 SPECIFIC PART OF SORT/MERGE
SUBTTL	D.M.NIXON/DMN/DZN/BRF	5-Jun-81



;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

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


;                    Table of Contents for SRTUUO
;
;
;                             Section                             Page
;
;   1  SRTUUO - TOPS-10 SPECIFIC PART OF SORT/MERGE .............   1
;   2  TABLE OF CONTENTS FOR SRTUUO .............................   2
;   3  DEFINITIONS
;        3.1  TOPS-10 Specific Parameters .......................   3
;   4  PSORT.
;        4.1  DEFCOR - Default Memory Allocation Algorithm ......   4
;        4.2  SETSTR - Set Up Temporary Disk Structures .........   6
;   5  GETREC
;        5.1  GETBUF - Input 1 Physical Buffer ..................   9
;   6  PUTREC
;        6.1  PUTBUF - Output 1 Physical Buffer .................  10
;   7  FILE UTILITY ROUTINES
;        7.1  Close Master Input/Output File ....................  11
;        7.2  Delete, Rename a File .............................  12
;        7.3  Open Output Temporary File ........................  13
;        7.4  Open Input Temporary File .........................  14
;        7.5  Enter a File ......................................  15
;        7.6  Append to Temporary File ..........................  16
;        7.7  Delete a Temporary Structure ......................  17
;        7.8  Lookup a Temporary File ...........................  18
;        7.9  Build a Buffer Ring ...............................  19
;        7.10 Reformat Buffer Pool for Next Merge ...............  20
;   8  CHANNEL MANAGEMENT
;	 8.1  SETCHN ............................................  21
;	 8.2  GETCHN ............................................  22
;	 8.3  FRECHN ............................................  23
;	 8.4  RETCHN ............................................  24
;   9  ERROR MESSAGES ...........................................  25
SUBTTL	DEFINITIONS -- TOPS-10 Specific Parameters

;PARAMETER DEFINITIONS NEEDED ONLY ON TOPS10

.TBS==203		;SIZE OF TEMP FILE BUFFERS

;SYMBOLS NOT YET IN FIELD IMAGE UUOSYM

.GTLBS==165		;[C18] DSK LARGE BUFFER GETTAB TABLE
.TFLNV==12		;[C25] NEW PULSAR LABEL TYPE NOT IN UUOSYM
FO.UOC==1B2		;[N12] USE ALREADY OPEN CHANNEL IN FILOP.

SEGMENT	IMPURE		;[C20]

FLPARG:	BLOCK .FOLEB+1	;[C19] FILOP. BLOCK
PTHARG:	BLOCK 3		;[404] PATH.
GOBARD:	BLOCK 5		;[404] GOBSTR DSK
GOBARS:	BLOCK 5		;[404] GOBSTR SYS
SYSARG:	BLOCK 1		;[404]
M7.00:	BLOCK 1		;[N12] SET NON-ZERO IF MONITOR IS 7 SERIES
XCHNO.:	BLOCK 1		;[N12] NO. OF EXTENDED CHANNELS AVAILABLE PER USER

SEGMENT	HPURE		;[C20]
SUBTTL	PSORT. -- MONSPC - Monitor Specific Tests

BEGIN
  PROCEDURE	(PUSHJ	P,MONSPC)
	MOVE	T1,[%CNVER]	;[N12] CONFIG TABLE
	GETTAB	T1,		;[N12]
	  SETZ	T1,		;[N12] MUST BE VERY OLD
	LDB	T2,[POINT 5,T1,23]	;[N24] [N12] MONITOR VERSION NO.
	CAIN	T2,7		;[N24] [N12] TEST FOR 7.00 SERIES MONITOR
	HRRZM	T1,M7.00	;[N24] [N12] SAVE VERSION # AS FLAG IF TRUE
	MOVE	T1,[%CNHXC]	;[N12] GETTAB FOR NO. OF EXTENDED CHANS
	GETTAB	T1,		;[N12]
	  SETZ	T1,		;[N12] NONE IF NOT IMPLEMENTED
	MOVEM	T1,XCHNO.	;[N12] NEEDED FOR CHANNEL ALLOCATION ROUTINE
	RETURN			;[N12]
END;
SUBTTL	PSORT. -- DEFCOR - Default Memory Allocation Algorithm

BEGIN
  PROCEDURE	(PUSHJ	P,DEFCOR)

COMMENT \
CALCULATE USER MINIMUM CORE SIZE FROM
DOUBLE BUFFERING + AT LEAST 16 RECORDS IN CORE
IF V/M SYSTEM THEN
	IF USER MIN. GREATER THAN USER VIRTUAL LIMIT THEN ERROR
	ELSE GET USER CORMAX
	IF USER CORE MAX. LESS THAN USER PHY. LIM. THEN USER PHY. LIM. = USER CORMAX
	IF USER MIN. GREATER THAN USER PHY. LIM.
		THEN DEFAULT SIZE = USER MIN.
		ELSE IF USER PHY LIM. LESS THAN 1/2 SYSTEM CORMAX
			THEN DEFAULT SIZE = USER PHY. LIM.
			ELSE IF USER MIN. GREATER THAN 1/2 SYSTEM CORMAX
				THEN DEFAULT SIZE = USER MIN
				ELSE DEFAULT SIZE = 1/2 SYSTEM CORMAX
	ELSE SYSTEM DOES NOT HAVE V/M THEN
	IF USER MIN. GREATER THAN USER CORMAX THEN ERROR
		ELSE IF USER MIN. GREATER THAN 1/2 SYSTEM CORMAX
			THEN DEFAULT SIZE = USER MIN
			ELSE IF USER CORMAX GREATER THAN 1/2 SYSTEM CORMAX
				THEN DEFAULT SIZE = 1/2 SYSTEM CORMAX
				ELSE DEFAULT SIZE = USER CORMAX
\

	PUSH	P,P1			;[C20] GET AN AC FOR CORE SIZE
	PUSH	P,P2			;[C20] GET AN AC FOR HIGH SEG SIZE
	HRRZ	P1,.JBFF##		;[C20] [C13] CURRENT SIZE OF LOW SEGMENT
	HRRZ	P2,.JBHRL##		;[C23] [C20] [C13] CALCULATE SIZE OF HIGH SEGMENT
	JUMPE	P2,$1			;[C23]   NONE
	TRZ	P2,400000		;[C23]   ASSUME IT STARTS AT 400000
	MOVE	T1,[XWD -2,.GTUPM]	;[C23]   IN CASE GETTAB FAILS
	GETTAB	T1,			;[C23]   ..
	  JRST	$1			;[C23]   ..
	HLRZS	T1			;[C23]   ..
	TRZ	T1,PGMSK		;[C23]   ..
	HRRZ	T2,T1			;MUST GUARD AGAINST EXECUTE-ONLY HIGH SEG
	LSH	T2,-<POW2(PGSIZ)>	; SUCH AS FOROTS
	HRLI	T2,.PAGCA		;SO USE PAGE. UUO TO FIND OUT
	PAGE.	T2,			; IF WE CAN READ THAT PAGE
	  TXO	T2,PA.GRD		;IF PAGE. UUO FAILED ASSUME WE CAN
	TXNN	T2,PA.GRD		;CAN WE READ IT?
	JRST	$2			;NO, USE .JBHRL
	HLRZ	P2,.JBHRN(T1)		;[C23]   ..
IFN FTFORTRAN,<
	JUMPN	P2,$2			;[N08] BUG IN FOROTS V6 MAKES THIS ZERO
	HRRZ	P2,.JBHRL		;[N08] USE WHATS IN JOBDAT INSTEAD
	SUBI	P2,(T1)			;[N08] REMOVE BASE TO GET LENGTH
  $2%>
	TRZE	P2,PGMSK		;[C20] [C13]   ..
	ADDI	P2,PGSIZ		;[C20] [C13]   ..
IFE FTKL10!FTKI10,<			;ROUND UP TO K BOUNDARY ON KA10
	TRNE	P2,PGSIZ		;[C20] [C13]   ..
	SKIPE	CPU			;[C13]   ..
	SKIPA				;[C13]   ..
	ADDI	P2,PGSIZ		;[C20] [C13]   ..
>
  $1%					;[C23]
IFN FTKI10!FTKL10,<			;[N08] CHECK FOR VMDDT ALSO
	  IF VMDDT IS LOADED
		HRRZ	T1,.JBDDT##		;[N08] GET START OF DDT
		JUMPE	T1,$F			;[N08] NOT LOADED
		CAMG	T1,.JBREL		;[N08] IS IT IN LOW SEGMENT
		JRST	$F			;[N08] YES, ALREADY COUNTED
		HRRZ	T2,.JBHRL		;[N08] GET TOP OF HIGH SEG
		CAMG	T1,T2			;[NO8] IS DDT IN HIGH SEG?
		JRST	$F			;[N08] YES, ALREADY COUNTED
	  THEN COUNT ITS SIZE AS PART OF THE MEMORY ALREADY OCCUPIED
		HLRZ	T2,.JBDDT		;[N08] GET TOP OF VMDDT
		SUB	T2,T1			;[N08] GET LENGTH -1
		ADDI	T2,1			;[N08] LENGTH
		ADD	P2,T2			;[N08] MAKE IT PART OF HIGH SEG FOR CALCULATIONS
	  FI;
>;END IFN FTKI10!FTKL10
IFN LOWORG,<
	ADDI	P1,<<LOWEND/PGSIZ>-<LOWORG/PGSIZ>+1>*PGSIZ	;[C29]
>
IFN FTVM,<
	SKIPE	FORRET			;CALLED BY FORTRAN?
	ADDI	P1,FSORTSZ		;YES, ADD IN SIZE OF FSORT
>
IFN FTKI10!FTKL10!FTDEBUG!FTCOBOL!FTFORTRAN,<	;[C29]
	ADD	P1,P2			;[C20] [C13] INCLUDE HI-SEGEMENT SIZE
>
  IF /MERGE
	SKIPG	MRGSW
	JRST	$T
  THEN ACCOUNT FOR UP TO 15 INPUT FILES
IFE FTCOBOL,<
	MOVE	T1,MXDVSZ		;[215] ALLOW FOR WORST CASE
	IMUL	T1,ACTTMP		;FOR EACH INPUT CHAN
	MOVE	T2,F.OXBK		;[215] GET OUTPUT BUFFER SIZE
	MOVE	T2,X.DVSZ(T2)		;[OK] [215]   ..
	CAIGE	T2,.TBS			;USE LARGER
	MOVEI	T2,.TBS
	ADD	T1,T2			;[C20] PLUS OUTPUT BUFFER
	LSH	T1,1			;DOUBLE BUFFERING
>
IFN FTCOBOL,<
	MOVEI	T1,2*.TBS		;DOUBLE BUFFER TEMP FILE
	IMUL	T1,MAXTMP		;* MAX. NO. OF THEM
>
	ADD	P1,T1			;[C20]
	MOVE	T2,REKSIZ
	ADDI	T2,RN.LEN
	IMUL	T2,NUMRCB		;NO. OF RECORDS
	JRST	$F
  ELSE ITS A REGULAR SORT
	MOVEI	T1,.TBS			;TEMP BUFFER
IFE FTCOBOL,<
	ADD	T1,MXDVSZ		;[215] PLUS LARGEST INPUT BUFFER
>
	LSH	T1,1			;AT LEAST DOUBLE BUFFERING
	ADD	P1,T1			;[C20] ADD THEM IN
	MOVE	T2,REKSIZ		;RECORD SIZE
	ADDI	T2,RN.LEN		;PLUS ASSOCIATED NODE
	LSH	T2,POW2(^D16)		;AT LEAST 16
  FI;
	ADD	P1,T2			;[C20] WE NEED AT LEAST THIS MUCH
	HRROI	T3,.GTCVL		;CURRENT VIRTUAL/PHYSICAL LIMITS
  IF	A V/M SYSTEM
	GETTAB	T3,
	  JRST	$T			;TRY CORMAX LIMITS
	TXZ	T3,1B18			;TURN OFF LIMIT BIT
	HLRZ	T4,T3			;VIRTUAL LIMIT
	HRRZ	T3,T3			;PHYSICAL LIMIT
	JUMPE	T4,$T			;NOT A V/M SYSTEM
	JUMPE	T3,$T			;[C24] OR DEFAULT PHYSICAL LIMIT
  THEN
	LSH	T3,POW2(1000)		;INTO WORDS
	LSH	T4,POW2(1000)		;...
	CAMLE	P1,T4			;[C20] LESS THAN VIRTUAL LIMIT?
	JRST	E$$NEC			;NO
	CAMLE	T3,T4			;[N08] IS VIRTUAL LIM .LT. PHYSICAL LIM?
	MOVE	T3,T4			;[N08] YES, SET PHYSICAL LIMIT DOWN
	  IF /CORE:N WAS SPECIFIED ON LOGIN (E.G., SUBMIT FOO/CORE:N)
		HRROI	T4,.GTLIM		;[334] GET BATCH LIMITS
		GETTAB	T4,			;[334]   ..
		  JSP	P4,E$$MGF		;[334] CAN'T
		LDB	T4,[POINTR T4,JB.LCR]	;[334] GET MEMORY LIMIT
		LSH	T4,POW2(1000)		;[334] CONVERT PAGES TO WORDS
		JUMPE	T4,$F			;[334] IF ZERO, NO LIMIT
	  THEN 'PHYSICAL LIMIT' IS REALLY MIN(.GTLIM,.GTCVL)
		CAMG	T4,T3			;[334] COMPUTE MINIMUM
		MOVE	T3,T4			;[334]   ..
	  FI;
	MOVE	T4,[%NSCMX]		;GET USER CORMAX
	GETTAB	T4,
	  JSP	P4,E$$MGF
	CAMLE	T3,T4			;PHYSICAL LIM .LE. TO CORMAX?
	MOVE	T3,T4			;NO, USE CORMAX INSTEAD
	CAML	P1,T3			;[C20] NEED MORE THAN PHYSICAL LIMIT?
	JRST	$F			;YES, USE WHAT WE NEED ONLY
	MOVE	T4,[%NSMXM]		;GET HOW MUCH SYSTEM HAS
	GETTAB	T4,
	  JSP	P4,E$$MGF
	LSH	T4,-1			;CUT IN HALF
	CAXLE	T4,700000		;SEE THAT NUMBER IS BELOW PFH
	MOVX	T4,700000		;  ..
	CAMG	T3,T4			;IS PHYLIM GT. 1/2 OF CORE
	SKIPA	P1,T3			;[C20] NO, GIVE USER PHYSICAL LIMIT
	CAML	P1,T4			;[C20] IS P1 GT. 1/2 OF CORE?
	JRST	$F			;YES, USE WHAT WE NEED
	MOVE	P1,T4			;[C20] NO, TAKE 1/2 OF CORE
	JRST	$F
  ELSE	HERE IF NOT V/M
	MOVE	T3,[%NSMXM]		;LARGEST CORMAX (SYSTEM SIZE)
	GETTAB	T3,
	  JSP	P4,E$$MGF
	SETZ	T4,
	CORE	T4,			;GET CORE USER CAN GET
	LSH	T4,POW2(2000)		;ALWAYS GIVES ERROR RETURN
	CAMLE	P1,T4			;[C20] ENOUGH CORE?
	JRST	E$$NEC			;NO
	LSH	T3,-1			;CUT IN HALF
	CAXLE	T3,700000		;SEE THAT NUMBER IS BELOW PFH
	MOVX	T3,700000		;  ..
	CAML	P1,T3			;[C20] WANT MORE THAN 1/2
	JRST	$F			;USE ALL OF WHAT WE NEED
	CAMG	T3,T4			;[C20] USE THE SMALLER OF THE TWO
	SKIPA	P1,T3			;[C20] T3 SMALLER
	MOVE	P1,T4			;[C20] T4 SMALLER
  FI;
IFN LOWORG,<
	SUBI	P1,<<LOWEND/PGSIZ>-<LOWORG/PGSIZ>+1>*PGSIZ	;[C29]
>
IFN FTVM,<
	SKIPE	FORRET			;CALLED BY FORTRAN?
	SUBI	P1,FSORTSZ		;YES, SUBTRACT SIZE OF FSORT
>
IFN FTKI10!FTKL10!FTDEBUG!FTCOBOL!FTFORTRAN,<	;[C29]
	SUB	P1,P2			;[C20] [C13] DISCOUNT HI-SEGMENT SIZE
>
	SKIPE	CPU			;KI10 OR KL10?
	SUBI	P1,PGSIZ		;[C20] YES, ACCOUNT FOR UPMP

	HRROI	T1,.GTPDB		;SEE HOW MUCH "FUNNY SPACE" IS IN USE
	GETTAB	T1,
	  TDZA	T1,T1			;NOT IN THIS MONITOR
	HLRZ	T1,T1
	ANDI	T1,777			;ISOLATE BITS WE WANT
	SKIPE	T1
	ADDI	T1,2			;ADD IN A FUDGE FACTOR
	LSH	T1,POW2(PGSIZ)		;CONVERT TO WORDS
	SUB	P1,T1			;REMOVE FROM AVAILABLE POOL

	SUBI	P1,1			;[N22] TURN INTO HIGHEST LEGAL ADDRESS
	CAILE	P1,377777		;FOR NOW, DON'T ALLOW HUGE LOWSEGS,
	MOVEI	P1,377777		;  SINCE TOO MANY BUGS WITH THEM

	MOVE	T1,P1			;[C13] CALCULATE NEW AVAILABLE MEMORY
	SUB	T1,OLDFF		;[C13]   ..
	PUSHJ	P,RSTSPC		;[C13] RE-SETUP AVAILABLE MEMORY
	POP	P,P2			;[C20] RESTORE P2
	POP	P,P1			;[C20] RETSORE P1
	RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,TSTSIZ)
	MOVE	P1,FRECOR		;[C13] GET WORKING COPY
  IF /MERGE
	SKIPG	MRGSW
	JRST	$T
  THEN COUNT ALL INPUT FILES
IFE FTCOBOL,<
	MOVE	T1,MXDVSZ		;[215] ASSUME WORST CASE
	IMUL	T1,ACTTMP		;* NUMBER OPEN AT ONE TIME
	MOVE	T2,F.OXBK		;[215] GET OUTPUT BUFFER SIZE
	MOVE	T2,X.DVSZ(T2)		;[OK] [215]   ..
	CAIGE	T2,.TBS			;USE MAX
	MOVEI	T2,.TBS
	ADD	T1,T2			;[C20] + OUTPUT BUFFER
	LSH	T1,1			;DOUBLE BUFFERING
>
IFN FTCOBOL,<
	MOVEI	T1,2*.TBS		;DOUBLE BUFFER TEMP FILE
	IMUL	T1,MAXTMP		;* MAX. NO. OF THEM
>
	MOVE	T2,REKSIZ
	ADDI	T2,RN.LEN		;RECORD+HEADER
	IMUL	T2,NUMRCB		;TOTAL WE NEED
	SUB	P1,T1			;[C20]
	SUB	P1,T2			;[C20]
	JUMPL	P1,$3			;[323] NOT ENOUGH CORE
	LSH	T1,-1			;PER SINGLE BUFFER
	MOVNI	T3,4			;TRY TO ALLOCATE UP TO SIX
  $4%	SUB	P1,T1			;[C20]
	JUMPL	P1,$5			;NO MORE
	AOJL	T3,$4			;TRY AGAIN
  $5%	ADDI	T3,6			;GET ACTUAL NO.
	TRZ	T3,1			;[C18] MAKE EVEN
IFE FTCOBOL,<
	MOVEM	T3,IBUFNO
>
	MOVEM	T3,TBUFNO
	MOVEM	T3,OBUFNO
	IMUL	T3,T1			;[C20] [C13] TOTAL NEEDED FOR BUFFERS
	MOVEM	T3,BUFSZ		;[C13] SAVE BUFFER POOL SIZE
	RETURN

  ELSE DO NORMAL SORT
	MOVEI	T1,.TBS			;SIZE OF TEMP BUFFER
IFE FTCOBOL,<
	ADD	T1,MXDVSZ		;[215] SIZE OF LARGEST INPUT BUFFER
>
	LSH	T1,1			;DOUBLE BUFFER REQUIRED
	MOVE	T2,REKSIZ		;SIZE OF 1 RECORD
	ADDI	T2,RN.LEN		;PLUS ASSOCIATED NODE
	LSH	T2,POW2(^D16)		;16 IS ABSOLUTE SMALLEST NO.
	SUB	P1,T1			;[C20]
	SUB	P1,T2			;[C20]
	JUMPL	P1,$3			;[C13] NOT ENOUGH SPECIFIED
	ADD	P1,T2			;[C20]
	LSH	T2,3			;NOW  TRY FOR 128.
	SUB	P1,T2			;[C20]
	LSH	T1,-1			;HOW MUCH FOR ONE BUFFER EACH
	MOVNI	T3,4			;TRY TO ALLOCATE UP TO SIX (4 MORE) BUFFERS
  $1%	SUB	P1,T2			;[C20] TRY FOR 128 MORE RECORDS
	JUMPL	P1,$2			;FAILED
	SUB	P1,T1			;[C20]
	JUMPL	P1,$2			;NO MORE
	AOJL	T3,$1			;1 MORE, TRY AGAIN
  $2%	ADDI	T3,6			;ACTUAL BUFFERS WE CAN USE
	TRZ	T3,1			;[C18] MAKE EVEN
IFE FTCOBOL,<
	MOVEM	T3,IBUFNO		;FOR INPUT
>
	MOVEM	T3,TBUFNO		;FOR TMPBUF
	IMUL	T3,T1			;[C20] TOTAL NEEDED FOR BUFFERS
	MOVEM	T3,BUFSZ		;[C13] SAVE BUFFER POOL SIZE
	MOVE	T1,FRECOR		;[C13] WHAT IS FREE
	SUB	T1,T3			;[C20] MINUS BUFFERS
	MOVE	T2,REKSIZ		;
	ADDI	T2,RN.LEN		;[C20]
	IDIV	T1,T2			;[C20] IS FOR RECORDS
	  IF /LEAVES WAS NOT SPECIFIED
		SKIPG	NUMRCB
	  THEN STORE NUMBER OF RECORDS THAT WILL FIT IN CORE
		MOVEM	T1,NUMRCB		;RECORDS IN CORE
	  FI;
		RETURN				;RETURN TO CALLING PROGRAM
  FI;

  $3%	MOVN	T1,P1			;[C13] CALCULATE NEW AVAILABLE MEMORY
	ADD	T1,OLDCOR		;[C13]   ..
	PUSHJ	P,RSTSPC		;[C13] RE-SETUP AVAILABLE MEMORY
	JRST	TSTSIZ			;[C13] TRY AGAIN
END;
SUBTTL	PSORT. -- SETSTR - Set Up Temporary Disk Structures

	SEGMENT	LPURE			;[C20]

BEGIN
  PROCEDURE	(PUSHJ	P,SETSTR)
	SETZB	U,S			;[C20] [214] FILL ENTIRE TABLE JUST IN CASE
					;[C20] [214] PTR FOR USER'S STRS
  FOR EACH USER SPECIFIED STR DO
	BEGIN
		MOVE	T1,STRNAM(U)		;[214] GET DSK STR
		MOVEM	T1,DSKARG+.DCNAM	;STORE NAME
		MOVE	T1,[.DCUPN,,DSKARG]
		DSKCHR	T1,			;DO UUO
		  JSP	P4,E$$MUF
		TXNN	T1,DC.TYP		;GENERIC DSK IF ALL ZERO
		JRST	[PUSHJ	P,GENSTR		;YES, TREAT IT SPECIALLY
			CAML	U,MAXTMP		;[N20] [C20]
			JRST	$B			;[C20] OK, SO TRY AGAIN
			JRST	$E]			;RAN OUT
		TXNE	T1,DC.HWP!DC.SWP	;WRITE PROTECTED
		JRST	E$$SWP			;[214] WRITE-PROTECTED--DIE
		HLRZ	T1,T1			;GET TYPE IN RHS
		ANDI	T1,(DC.TYP)		;ONLY BITS WE NOW NEED
		MOVE	T2,DSKARG+.DCULN	;GET UNIT #
		MOVEM	T2,STRNAM(U)		;STORE AS NAME
	  CASE	STR OF .DCTYP
		JRST	@[IFIWS	<$3,$3,$4,$3,$3,$4>]-1(T1)	;[C20]
	  $3%	MOVEM	T2,STRULN(S)
		MOVE	T2,DSKARG+.DCSNM	;GET STRUCTURE NAME
		MOVEM	T2,STRSNM(S)		;SAVE IT
	  $4%	ADDI	S,1			;[C20] [424] [214] ADVANCE USER'S STR TABLE
		CAML	S,STRNUM		;[C20] DONE?
		JRST	$E			;[C20] YES
		ADDI	U,1			;[N20] DO ADDITION BEFORE TEST
		CAMGE	U,MAXTMP		;[N20] [C20] [424] LOOP
		JRST	$B			;[N20] [C20]   ..
		RETURN				;STRNAM IS FULL
	  ESAC;
	END;

	SETOM	STRULN(S)		;MARK END OF LIST
	ADDI	U,1			;[C20] [214] NEED TO ADVANCE
	CAML	U,MAXTMP		;[N20] [C20] AND CHECK
	JRST	$6			;[C20]   ..
	SETZ	S,			;START AT FRONT AGAIN
  WHILE	STRS TO CONSIDER DO
	BEGIN
		PUSHJ	P,NXTUNI		;GET NEXT UNIT #
		JUMPE	T1,$E			;ALL DONE IF NO STR LEFT
		MOVEM	T1,STRULN(S)		;FOR NEXT TIME
		MOVEM	T1,DSKARG+.DCNAM	;STORE IT
		MOVE	T1,[.DCUPN,,DSKARG]
		DSKCHR	T1,
		  JRST	[SETZM	STRULN(S)		;REMOVE FROM LIST
			AOJA	S,$B]			;AND TRY NEXT
		MOVE	T1,DSKARG+.DCULN
		MOVEM	T1,STRNAM(U)		;STORE 
		AOS	STRNUM			;COUNT ONE MORE
		ADDI	U,1			;[C20]
		CAML	U,MAXTMP		;[N20] [C20] FULL?
		JRST	$E			;[C20] YES, DONE
		ADDI	S,1			;[C20] LOOP
		CAML	S,STRNUM		;[C20]   ..
		JRST	$B			;[C20]   ..
	END;
  $6%	RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,GENSTR)
	PUSH	P,STRNAM(U)		;SAVE CURRENT GENERIC
	MOVE	T1,STRNAM(U)		;[404]
	MOVEM	T1,PTHARG+.PTFCN	;[C19] [404]
	SETZM	STRNAM(U)		;IN CASE WE DON'T FIND A REPLACEMENT
	MOVE	T4,STRNUM		;[C20] NO. IN USE ALREADY
	SETOM	GOBARD+.DFGNM		;[404]
	SETOM	GOBARD+.DFGJN		;[404]
	SETOM	GOBARS+.DFGNM		;[404]
	SETZM	GOBARS+.DFGJN		;[447]
	SETZM	SYSARG			;[404]
	MOVE	T3,[XWD 3,PTHARG]	;[404]
	PATH.	T3,			;[404] FIND WHICH SEARCH LIST IS WANTED
	  JSP	P4,E$$MUF		;[404]
	BEGIN
	  CASE	PATH. RETURN OF (NOLIST,DSK,ALL,SYS)
;The 0 return that follows should actually jump to the
;commented-out error routine ERRSII. We are assuming that
;the return is really a 1 until the PATH. UUO is fixed.
;The first jump to $1 will be replaced by the call to the
;error routine when PATH. is fixed. This method will work
;under all circumstances.
		LDB	T3,[POINTR(PTHARG+.PTSWT,PT.SLT)]	;[404] TO CORRECT PATH
		JRST	@[IFIWS	<$1,$1,$2,$3>](T3)	;[C20] [404] BY THIS BIT
	  $1%	MOVE	T3,[XWD 5,GOBARD]	;[447] [404] JOB
		GOBSTR	T3,			;[404] GET FSNAME
		  JSP	P4,E$$MUF		;[404]
		MOVE	T2,GOBARD+.DFGNM	;[404] FROM HERE
		MOVE	T3,GOBARD+.DFGST	;[447] GET STATUS
		JRST	$C			;[404]
	  $2%	MOVE	T3,SYSARG		;[404] ALL
		SYSSTR	T3,			;[404] GET FSNAME
		  JSP	P4,E$$MUF		;[404] 
		MOVEM	T3,SYSARG		;[404] SET UP FOR NEXT
		MOVE	T2,T3			;[404]
		SETZ	T3,			;[447] ASSUME STATUS OK
		JRST	$C			;[404]
	  $3%	MOVE	T3,[XWD 5,GOBARS]	;[404] SYS
		GOBSTR	T3,			;[404] GET FSNAME
		  JSP	P4,E$$MUF		;[404]
		MOVE	T2,GOBARS+.DFGNM	;[404]
		MOVE	T3,GOBARS+.DFGST	;[447] GET STATUS
;		JRST	$C			;[404]
	  ESAC;
		JUMPE	T2,$E			;[404] 0 AT FENCE
		CAMN	T2,[-1]			;OR AT END
		JRST	$E			;[404] RETURN
		TXNE	T3,DF.SWL!DF.SNC	;[447] CHECK STATUS
		JRST	$B			;[404] DON'T USE THIS ONE
		MOVEM	T2,DSKARG+.DCNAM	;STORE NAME FOR DSKCHR
		MOVE	T3,[.DCFCT,,DSKARG]	;JUST GET USERS QUOTA
		DSKCHR	T3,
		  JSP	P4,E$$MUF
		TXNE	T3,DC.HWP!DC.SWP	;PROTECTED?
		JRST	$B			;[404] YES, DON'T USE IT
		SKIPN	STRNAM(U)		;ALREADY FOUND REPLACEMENT?
		JRST	[MOVEM	T2,STRNAM(U)		;NO, SO DO IT NOW
			CAMGE	T4,MAXTMP		;[N20] [C20] DO WE HAVE ANY ROOM?
			JRST	$B			;[404] YES, GET NEXT STR
			JRST	$E]			;[404] NO, GIVE UP
		MOVEM	T2,STRNAM(T4)		;[OK] STORE NAME
		AOS	STRNUM			;COUNT ONE MORE
		ADDI	T4,1			;[N20] INCREMENT BEFORE TEST
		CAMGE	T4,MAXTMP		;[N20] [C20] [404] ADVANCE POINTER
		JRST	$B			;[N20] [C20]   ..
	END;
	POP	P,T2			;GET GENERIC NAME BACK
	SKIPE	STRNAM(U)		;DID WE FIND A REPLACEMENT?
	RETURN				;YES
	MOVEM	T2,STRNAM(U)		;NO, SO USE GENERIC AGAIN
	ADDI	U,1			;[C20] MOVE ON TO NEXT
	RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,NXTUNI)
  $1%	SKIPN	T1,STRULN(S)		;GET UNIT NAME
	AOJA	S,$1			;DOES NOT EXIST ANYMORE
	CAMN	T1,[-1]			;-1 IS END OF LIST
	JRST	$5			;[N20] [C20] SEE IF LIST IS EXHAUSTED YES
	ANDCM	T1,STRSNM(S)		;GET JUST THE UNIT #
	SETZ	T3,			;COUNTER
  $2%	TRNE	T1,77			;RIGHT JUSTIFIED?
	JRST	$4			;YES
	LSH	T1,-6			;NO, SHIFT RIGHT 1 CHAR
	AOJA	T3,$2			;LOOP
  $4%	TRC	T1,7			;SEE IF LEAST SIGNIFICANT UNIT IS FULL
	TRCE	T1,7
	AOJA	T1,$3			;ITS NOT
	ADDI	T1,100			;INCREMENT
	IORI	T1,'00'			;INCASE WE OVERFLOWED
  $3%	IMULI	T3,6			;SHIFT COUNTER
	LSH	T1,(T3)			;[OK] PUT BACK
	IOR	T1,STRSNM(S)		;FORM NEW NAME
	RETURN

  $5%	SETZ	S,			;[N20] START LIST AGAIN
	SKIPN	T1,STRULN(S)		;[N20] GET UNIT NAME
	AOJA	S,.-1			;[N20] DOES NOT EXIST ANYMORE
	AOJN	T1,$1			;[N20] FOUND SOMETHING TO TRY
	RETURN				;[N20] LIST IS EMPTY, RETURN T1 =0
END;
SUBTTL	GETREC -- GETBUF - Input 1 Physical Buffer

BEGIN
  PROCEDURE	(JSP	T4,GETBUF)		;GET PHYSICAL I/O BUFFER

;RETURNS
;	MOVE	EF,PHYEOF
;	JRST	0(T4)			;ERROR
;OR
;	JRST	1(T4)			;NORMAL

  IF 7-SERIES MONITOR
	SKIPN	M7.00			;[N12] 7-SERIES?
	JRST	$T			;[N12] NO
  THEN USE FILOP. FOR ALL I/O
	HRLZ	T1,FILCHN(F)		;[N12] GET CHANNEL
	HRRI	T1,.FOINP		;[N12] INPUT FUNCTION
	MOVEM	T1,FLPARG+.FOFNC	;[N12] ONLY ONE ARG
	MOVE	T1,[1,,FLPARG]		;[N12]
	FILOP.	T1,			;[N12]
	  JRST	$F			;[N12] ERROR, T1 = STATUS
GETOK:	MOVE	T1,[440000,,1]
	ADDM	T1,FILPTR(F)		;ADVANCE BYTE PTR TO FIRST WORD OF BUFFER
  IFE FTCOBOL,<
	MOVN	T1,FILCNT(F)		;[C18] DECREMENT BLOCK BYTE COUNT
	ADDM	T1,FILKCT(F)		;[C18]   ..
  >
	MOVE	T1,FILCNT(F)		;BUFFER WORD COUNT TO T1
	JRST	1(T4)			;[OK] GIVE OK RETURN

  ELSE USE OLD I/O UUOs
	MOVE	T1,FILCHN(F)		;[C19] GET CHANNEL
	LSH	T1,27			;[C19]   ..
	TLO	T1,(IN)			;COMPLETE  IN   CHN,0
	XCT	T1			;ADVANCE TO NEXT BUFFER
	  JRST	GETOK			;UNEVENTFUL INPUT !
	TLC	T1,(<IN>^!<GETSTS>)
	HRRI	T1,T1			;FORM [GETSTS  CHN,T1]
	XCT	T1			;RETRIEVE FILE STATUS
  FI;

  	TXNN	T1,IO.ERR		;I/O ERRORS ?
	JRST	GETEOF			;NO, MUST BE END OF FILE
	PUSH	P,T1			;SAVE STATUS
	JRST	E$$IRE			;[353] PRINT REASON FOR ERROR

GETEOF:	MOVE	EF,PHYEOF		;GET PHYSICAL E-O-F ROUTINE
	JRST	0(T4)			;[OK] GIVE ERROR RETURN
END;
SUBTTL	PUTREC -- PUTBUF - Output 1 Physical Buffer

BEGIN
  PROCEDURE	(JSP	T4,PUTBUF)
	MOVE	T1,FILBPB(F)		;[C20] [C18] GET BYTES WRITTEN
	SKIPLE	T2,FILCNT(F)		;[C20] [C03]   ..
	SUB	T1,T2			;[C20] [C03]   ..
  IFE FTCOBOL,<
	MOVE	T2,FILFLG(F)		;[C20] A TEMP FILE?
	TXNE	T2,FI.TMP		;[C20]   ..
  >
	ADDM	T1,TMPTOT		;[C20] YES, UPDATE TEMP BYTES WRITTEN
  IFE FTCOBOL,<
	MOVN	T2,T1			;[C18] DECREMENT BLOCK BYTE COUNT
	ADDM	T2,FILKCT(F)		;[C18]   ..
	IDIV	T1,IOBPW2		;[C03] DIVIDE BY BYTES PER WORD
	JUMPE	T2,$1			;[C03] CLEAR REST OF WORD
	SUB	T2,IOBPW2		;[C03]  ..
	SETZ	T1,			;[C03]  ..
	IDPB	T1,FILPTR(F)		;[C03]  ..
	AOJL	T2,.-1			;[C03]  ..
  $1%					;[C03]
  >
	SKIPGE	FILPTR(F)		;HAS BYTE PTR BEEN ADVANCED?
	SOS	FILPTR(F)		;YES, RETARD IT
  IF 7-SERIES MONITOR
	SKIPN	M7.00			;[N12] 7-SERIES?
	JRST	$T			;[N12] NO
  THEN USE FILOP. FOR ALL I/O
	HRLZ	T1,FILCHN(F)		;[N12] GET CHANNEL
	HRRI	T1,.FOOUT		;[N12] OUTPUT FUNCTION
	MOVEM	T1,FLPARG+.FOFNC	;[N12] ONLY ONE ARG
	MOVE	T1,[1,,FLPARG]		;[N12]
	FILOP.	T1,			;[N12]
	  JRST	$2			;[N12] ERROR, T1 = STATUS
	JRST	$F			;[N12] OK
  ELSE USE OLD I/O UUOs
	MOVE	T1,FILCHN(F)		;[C19] GET CHANNEL
	LSH	T1,27			;[C19]   ..
	TLO	T1,(OUT)
  IF OUT UUO SUCCEEDS
	XCT	T1			;OUT   CHN,0
  THEN ALL IS DANDY--RETURN
	  JRST	$F			;[215] UNEVENTFUL OUTPUT
  ELSE CHECK ERROR CONDITIONS
	TLC	T1,(<OUT>^!<GETSTS>)
	HRRI	T1,T1
	XCT	T1			;GETSTS CHN,T1
  $2%	PUSH	P,T1			;[N12] [215] SAVE STATUS
IFE FTFORTRAN!FTCOBOL,<
	  IF THIS IS A MAGTAPE END-OF-TAPE ERROR
		MOVE	T1,FILXBK(F)		;[215] GET DEVCHR WORD
		MOVE	T1,X.DVCH(T1)		;[OK] [215]   ..
		CAXE	T1,DVCHNL		;[215] IF NUL:, NOT A MAGTAPE
		TXNN	T1,DV.MTA		;[215] NOW CHECK IF REALLY A TAPE
		JRST	$T			;[215] NO--JUST PRINT ERROR STATUS
		MOVE	T1,(P)			;[353] GET GETSTS FLAGS BACK
		TXNN	T1,IO.EOT		;[353] END-OF-TAPE ERROR?
		JRST	$T			;[353] NO--REAL ERROR
	  THEN JUST SIGNAL EOT FOR PUTREC
		MOVX	T1,FI.EOT		;[215] REMEMBER EOT
		ORM	T1,FILFLG(F)		;[215]   ..
		JRST	$F			;[215] DONE HERE
	  ELSE PRINT ERROR STATUS
>
		JRST	E$$OWE			;[353] PRINT REASON FOR ERROR
IFE FTFORTRAN!FTCOBOL,<
	  FI;
>
	  POP	P,(P)				;[414] CLEAN UP STACK
  FI;
  FI;
	MOVE	T1,[440000,,1]
	ADDM	T1,FILPTR(F)		;ADVANCE BYTE PTR TO FIRST WORD OF BUFFER
	MOVE	T1,FILCNT(F)		;BUFFER WORD COUNT TO T1
	RETURN
END;
SUBTTL	FILE UTILITY ROUTINES -- Close Master Input/Output File

BEGIN
  PROCEDURE	(PUSHJ	P,CLSMST)	;CLOSE FILE INDICATED BY F
;USES T1, T2, AND T4
;CALLS CLRBUF
	TDZA	T4,T4			;FINAL CLOSE FOR MASTER INPUT/OUTPUT
  PROCEDURE	(PUSHJ	P,CLSFIL)
	MOVX	T4,CL.ACS!CL.DLL	;DON'T DELETE ALLOCATED BLOCKS
	MOVE	T1,FILHDR(F)		;GET BUFFER RING HEADER
	TXNE	T1,BF.IBC		;BUFFER CLEAR INHIBITED?
	PUSHJ	P,CLRBUF		;YES, SO CLEAR JUNK
	SKIPGE	FILPTR(F)		;HAS BYTE PTR BEEN ADVANCED?
	SOS	FILPTR(F)		;YES, RETARD IT
	HRL	T1,FILCHN(F)		;[C19] BUILD FILOP. BLOCK, GET CHANNEL
	HRRI	T1,.FOCLS		;[C19] GET CLOSE FUNCTION
	MOVEM	T1,FLPARG+.FOFNC	;[C19] STORE THEM
	MOVEM	T4,FLPARG+.FOIOS	;[C19] STORE THE CLOSE BITS
	SETZM	FLPARG+.FOLEB		;[C19] NO LOOKUP BLOCK FOR ERRORS
	MOVE	T1,[XWD .FOIOS+1,FLPARG]	;[C19] DO CLOSE FILOP.
	FILOP.	T1,			;[C19]   ..
	  JRST	ERRFUF			;[C19] FAILED
	MOVE	T1,FILCHN(F)		;[C19] RELEASE CHANNEL
	PJRST	RELCHN			;[C19]   ..
END;

BEGIN
  PROCEDURE	(PUSHJ	P,CLRBUF)	;CLEAR JUNK FROM END OF BUFFER
	SKIPG	T2,FILCNT(F)		;GET BYTE COUNT
	JRST	$3			;BUFFER MUST BE FULL (OR VIRGIN)
	SKIPL	T1,FILPTR(F)		;GET BYTE PTR
	ADDI	T1,1			;BYPASS PARTIAL WORD
	TXNE	T1,<POINT ^O40,,35>	;[131] SIXBIT OR BINARY?
	JRST	$2			;[123] YES
	TXNE	T1,<POINT ^O10,,35>	;[123] EBCDIC?
	LSH	T2,-2			;[123] YES
	TXNE	T1,<POINT 4,,35>	;[123] ASCII?
	IDIVI	T2,5			;GET WORDS LEFT IF ASCII
	JUMPL	T1,$2			;JUMP IF ON A NEW WORD
	SETZ	T3,			;GET A NULL
	SUBI	T1,1			;BACKUP BYTE PTR
  $1%	IDPB	T3,T1			;CLEAR OUT LAST PARTIAL WORD
	TXNE	T1,7B2			;[123] SEE IF DONE
	JRST	$1			;NOT YET
	ADDI	T1,1			;ADVANCE TO NEXT WORD AGAIN
  $2%	JUMPE	T2,$3			;BUFFER IS FULL
	HRRZS	T1			;[C20] CLEAN T1 FOR INDEXING
	SETZM	(T1)			;[OK] CLEAR FIRST WORD
	SOJLE	T2,$3			;ONLY ONE WORD TO CLEAR
	ADD	T2,T1			;[C20] END OF BLT
	HRL	T1,T1
	ADDI	T1,1
	BLT	T1,(T2)			;[OK] CLEAR REST OF BUFFER
  $3%	RETURN
END;
SUBTTL	FILE UTILITY ROUTINES -- Delete, Rename a File

BEGIN
  PROCEDURE	(PUSHJ	P,DELFIL)	;DELETE FILE INDICATED BY F
  IF 7-SERIES MONITOR
	SKIPN	T2,M7.00		;[N24] [N12] 7-SERIES?
	JRST	$T			;[N12] NO
  THEN USE FILOP. FOR ALL I/O
	HRLZ	T1,FILCHN(F)		;[C19] BUILD FILOP. BLOCK, GET CHANNEL
	HRRI	T1,.FODLT		;[C19] GET DELETE FUNCTION
	CAILE	T2,70100		;[N24] NEED FO.UOC BIT IN 7.02
	TXO	T1,FO.UOC		;[N12] USE ALREADY OPEN CHANNEL
	MOVEM	T1,FLPARG+.FOFNC	;[C19] STORE THEM
	MOVSI	T1,T2			;[N12] NEED A RENAME BLOCK
	HLLM	T1,FLPARG+.FOLEB	;[N12] LOOKUP BLOCK IS NOT REALLY USED
	SETZ	T2,			;[N12] MONITOR WILL ZERO IT ANYWAY
	MOVE	T1,[.FOLEB+1,,FLPARG]		;[N12] DO DELETE FILOP.
	FILOP.	T1,			;[C19]   ..
	  JRST	ERRFUF			;[C19] FAILED
	JRST	$F			;[N12] OK
  ELSE USE OLD I/O UUOs
	SETZB	T1,T2			;[C20] ZERO FILE.EXT
	SETZ	T4,			;[C20] ZERO PPN
	MOVE	T3,FILCHN(F)		;[C20] [C19] GET CHANNEL
	LSH	T3,27			;[C20] [C19]   ..
	IOR	T3,[RENAME T1]		;[C20]
	XCT	T3			;[C20]
	  JRST [HRRZ	T1,T2		;[C19] DELETE FAILED
		JRST	ERRFUF]		;[C19]   ..
  FI;
	MOVE	T1,FILCHN(F)		;[C19] RELEASE CHANNEL
	PJRST	RELCHN			;[C19]   ..

END;
SUBTTL	FILE UTILITY ROUTINES -- Enter a File

BEGIN
  PROCEDURE	(PUSHJ	P,ENTFIL)
	PUSH	P,P1			;[C19] SAVE AND SETUP P1
	MOVEI	P1,T.BLK		;[C19]   ..
	MOVX	T1,FI.TMP!FI.DSK!FI.OUT	;[C19] SETUP FILE FLAGS
	MOVEM	T1,FILFLG(F)		;[C19]   ..
  IF BUFFERS ALREADY SETUP
	SKIPL	BUFALC			;[C19] NEED TO SETUP BUFFERS?
	JRST	$T			;[C19] YES
  THEN MAKE SURE ITS USED
	MOVX	T1,BF.VBR		;[C19] SET VIRGIN BUFFER RING HEADER
	IORM	T1,FILHDR(F)		;[C19]   ..
	JRST	$F			;[C19]
  ELSE SET THE BUFFERS UP
	PUSH	P,P2			;[C19] SAVE P2
	MOVE	P2,TBUFNO		;[C19] GET BUFFER COUNT
	PUSHJ	P,BUFRNG		;[C19] CREATE BUFFER RING
	POP	P,P2			;[C19] RESTORE P2
  FI;
	HLLZS	FILPTR(F)		;[C19] CLEAR RH OF BYTE POINTER
	SETZM	FILCNT(F)		;[C19] CLEAR FILE COUNT
	PUSHJ	P,GENNAM		;[C19] GENERATE FILE NAME
	MOVEM	T1,X.RIB+.RBNAM(P1)	;[OK] [C19] INSERT FOR ENTER UUO
	PUSHJ	P,GETCHN		;[C19] GET A WORKING CHANNEL
	  JRST	E$$NEH			;[C19] FAILED
	MOVEM	T1,FILCHN(F)		;[C19] SAVE IT
  $1%	HRRZ	T1,TCBIDX		;[C19] GET INDEX TO TEMP STRUCTURE
	IDIV	T1,STRNUM		;[C19] ROUND ROBIN
	MOVE	T1,STRNAM(T2)		;[OK] [C19] 
	MOVEM	T1,X.OPN+.OPDEV(P1)	;[OK] [C19] STORE .TMP DEVICE
	MOVEI	T2,FILHDR(F)		;[C19] 
	HRLZM	T2,X.OPN+.OPBUF(P1)	;[OK] [C19] POINT TO BUFFER HEADERS
	SETZM	X.RIB+.RBPPN(P1)	;[OK] [C19] ALWAYS USE DEFAULT PATH
	HLLZS	X.RIB+.RBEXT(P1)	;[OK] [C19] CLEAR EXTENDED DATE
	SETZM	X.RIB+.RBPRV(P1)	;[OK] [C19]   ETC
	SETZM	X.RIB+.RBSIZ(P1)	;[OK] [C19]   ..
	SETZM	X.RIB+.RBVER(P1)	;[OK] [C19]   ..
	SETZM	X.RIB+.RBEST(P1)	;[OK] [C19]   ..
	SETZM	X.RIB+.RBALC(P1)	;[OK] [C19] 
	HRL	T1,FILCHN(F)		;[C19] BUILD FILOP. BLOCK, GET CHANNEL
	HRRI	T1,.FOWRT		;[C19] GET WRITE FUNCTION
	TXO	T1,FO.PRV		;[N14] BYPASS CHECKS IF [1,2] OR JACCT
	SKIPE	XCHNO.			;[N17] CAN WE USE EXTENDED CHANNELS?
	TXO	T1,FO.ASC		;[N17] YES, DO SO
	MOVEM	T1,FLPARG+.FOFNC	;[C19] STORE THEM
	HRLI	T1,X.OPN(P1)		;[OK] [C19] TRANSFER OPEN BLOCK
	HRRI	T1,FLPARG+.FOIOS	;[C19]   ..
	BLT	T1,FLPARG+.FOIOS+2	;[C19]   ..
	SETZM	FLPARG+.FONBF		;[C19] NO BUFFERS
	HRRZI	T1,X.RIB(P1)		;[OK] [C19] GET LOOKUP BLOCK ADDRESS
	MOVEM	T1,FLPARG+.FOLEB	;[C19] STORE IT
	AOS	T2,NUMTMP		;[C19] COUNT NUMBER OF RUNS
	HRLM	T2,FILRUN(F)		;[C19] FOR COMPAR = TEST
	AOS	T2,NUMENT		;[C19] HOW MANY ENTERS DONE
	CAMLE	T2,MAXTMP		;[C19] WRAPPED ROUND YET?
	JRST	APPFIL			;[C19] YES, JUST APPEND TO PREVIOUS 
	MOVE	T1,[.FOLEB+1,,FLPARG]	;[C19] DO WRITE FILOP.
	FILOP.	T1,			;[C19]   ..
	  JRST [PUSHJ	P,DELSTR	;[C19] FAILED, DELETE BAD STRUCTURE
	        SOS	NUMTMP		;[C26] DONT COUNT IT TWICE
	        SOS	NUMENT		;[C26]   ..
		JRST	$1]		;[C19] AND TRY AGAIN
	MOVS	T1,FLPARG+.FOFNC	;[N17] GET CHANNEL BACK
	ANDI	T1,777			;[N17]
	HRRM	T1,FILCHN(F)		;[N17] INCASE WE HAD AN EXTENDED CHAN
  IFE FTCOBOL,<
	PUSHJ	P,DSKPRI		;[C19] SET DSK PRIORITY
  >
	HRRZ	T1,TCBIDX		;[C19] MARK THAT WE USED THE NEXT STR
	IDIV	T1,STRNUM		;[C19]   ..
	ADDI	T2,1			;[C19]   (STRUSE IS FIRST *NOT* USED)
	CAMLE	T2,STRUSE		;[C19]   BUT ONLY IF WE HAVN'T ALREADY
	MOVEM	T2,STRUSE		;[C19]   ..
	POP	P,P1			;[C19] RESTORE P1
	RETURN
END;
SUBTTL	FILE UTILITY ROUTINES -- Append to Temporary File

BEGIN
  PROCEDURE	(PUSHJ	P,APPFIL)	;APPEND TO TEMPORARY FILE
	HRRI	T1,.FOAPP		;[C19] SELECT APPEND FILOP.
	HRRM	T1,FLPARG+.FOFNC	;[C19]   ..
	MOVX	T1,FO.PRV		;[N14] BYPASS CHECKS IF [1,2] OR JACCT
	IORM	T1,FLPARG+.FOFNC	;[N14]
	MOVE	T1,[XWD .FOLEB+1,FLPARG]	;[C19] DO APPEND FILOP.
	FILOP.	T1,			;[C19]   ..
	  JRST	ERRFUF			;[C19] FAILED
	MOVS	T1,FLPARG+.FOFNC	;[N17] GET CHANNEL BACK
	ANDI	T1,777			;[N17]
	HRRM	T1,FILCHN(F)		;[N17] INCASE WE HAD AN EXTENDED CHAN
  IFE FTCOBOL,<
	PUSHJ	P,DSKPRI		;[C19] SET DSK PRIORITY AND RETURN
  >
	MOVE	T1,FILCNT(F)		;[C19] NEW BUFFER?
	CAMGE	T1,FILBPB(F)		;[C19]   ..
	JSP	T4,PUTBUF		;[C19] NO, GET ONE
	HLRO	T1,FILRUN(F)		;FAKE SIXBIT WORD COUNT
	IDPB	T1,FILPTR(F)		;STORE IT
	MOVE	T1,[440000,,1]		;WE WANT PTR TO HAVE
	ADDM	T1,FILPTR(F)		;ADDRESS OF NEXT WORD IN RHS
	SOS	FILCNT(F)
	POP	P,P1			;[C19] RESTORE P1
	RETURN
END;
SUBTTL	FILE UTILITY ROUTINES -- Delete a Temporary Structure
BEGIN
  PROCEDURE (PUSHJ P,DELSTR)		;DELETE CURRENT STRUCTURE IN STRNAM

;DELSTR IS CALLED WHENEVER AN ATTEMPT TO INITIALIZE AN OUTPUT .TMP FILE FAILED.
;THIS CAN HAPPEN, FOR INSTANCE, IF THE USER SPECIFIES DSK:/TEMP, AND ONE OF THE
;STRUCTURES IN THE SEARCH LIST FOR DSK: IS WRITE-ENABLED, BUT HAS NO DIRECTORY
;FOR THE USER. WE DELETE THE STRUCTURE FROM STRNAM WITH POSSIBLY A WARNING
;MESSAGE, THEN RETURN. HOWEVER, IF WE DELETE THE LAST STRUCTURE IN STRNAM OR IF
;THE STRUCTURE HAS ALREADY BEEN SUCCESSFULLY USED (SO THAT OTHERS DEPEND ON THE
;ORDERING OF STRNAM), THEN WE DIE WITH A FATAL ERROR MESSAGE.
;
;ENTER WITH:
;	T1/		FILOP. ERROR CODE
;	RH(TCBIDX)/	CURRENT .TMP FILE INDEX
;	STRNAM/		TABLE OF STRUCTURES
;	STRNUM/		NUMBER OF ENTRIES IN STRNAM
;	STRUSE/		NUMBER OF FIRST NOT-YET-USED ENTRY IN STRNAM

  IF THIS STR HAS NOT YET BEEN REFERENCED
	HRRZ	T2,TCBIDX		;[214] GET CURRENT .TMP INDEX
	PUSH	P,STRNAM(T2)		;[OK] [214] SAVE STR NAME FOR MESSAGE
	IDIV	T2,STRNUM		;[214] GET INDEX INTO STRNAM
	CAIGE	T2,1			;[214] PASSED OVER ENTIRE TABLE
	CAMGE	T3,STRUSE		;[214]   OR OVER USED PART?
	JRST	$T
  THEN DELETE THE STRUCTURE
	MOVE	T1,STRNUM		;GET NUMBER OF STRS
	HRLZI	T2,STRNAM+1(T3)		;[OK] [214] COPY END OF TABLE
	HRRI	T2,STRNAM(T3)		;[OK] [214]   DOWN TO FRONT OF TABLE
	CAIE	T1,STRNAM+1(T3)		;[C20] [214]   UNLESS NO END OF TABLE
	BLT	T2,STRNAM-2(T1)		;[OK] [214]   ..
	SOSLE	STRNUM			;[214] NOW 1 LESS STR IN STRNAM
	PJRST	ERRATD			;[214] PRINT WARNING
	JRST	E$$NSW			;[214] NO TEMPORARY DEVICE IS WRITABLE
  ELSE DIE (STRUCTURE IN USE SO CAN'T DELETE IT)
	JRST	ERRFUF			;[C19] FILOP. FAILED THIS TIME
  FI;
END;
SUBTTL	FILE UTILITY ROUTINES -- Lookup a Temporary File

BEGIN
  PROCEDURE	(PUSHJ	P,LKPFIL)	;LOOKUP TEMPORARY FILE
	PUSH	P,P1			;[C19] SAVE AND SETUP P1
	MOVEI	P1,T.BLK		;[C19]   ..
	MOVX	T1,FI.TMP!FI.DSK	;[C19] SETUP FILE FLAGS
	MOVEM	T1,FILFLG(F)		;[C19]   ..
  IF BUFFERS ALREADY SETUP
	SKIPL	BUFALC			;[C19] NEED TO SETUP BUFFERS?
	JRST	$T			;[C19] YES
  THEN MAKE SURE ITS USED
	MOVX	T1,BF.VBR		;[C19] SET VIRGIN BUFFER RING HEADER
	IORM	T1,FILHDR(F)		;[C19]   ..
	JRST	$F			;[C19]
  ELSE SET THE BUFFERS UP
	PUSH	P,P2			;[C19] SAVE P2
	MOVE	P2,TBUFNO		;[C19] GET BUFFER COUNT
	PUSHJ	P,BUFRNG		;[C19] CREATE BUFFER RING
	POP	P,P2			;[C19] RESTORE P2
  FI;
	HLLZS	FILPTR(F)		;[C19] CLEAR RH OF BYTE POINTER
	SETZM	FILCNT(F)		;[C19] CLEAR FILE COUNT
	HRRZ	T1,FILNAM(F)		;[C19] FILE NAME
	ANDI	T1,77			;[C19] 
	SUBI	T1,'A'			;[C19] STRUCTURE INDEX
	IDIV	T1,STRNUM		;[C19] 
	MOVE	T1,STRNAM(T2)		;[OK] [C19] 
	MOVEM	T1,X.OPN+.OPDEV(P1)	;[OK] [C19] SAVE .TMP STRUCTURE
	MOVEI	T1,FILHDR(F)		;[C19] 
	HRRZM	T1,X.OPN+.OPBUF(P1)	;[OK] [C19] POINT TO BUFFER HEADER
	HRRZ	T1,FILNAM(F)		;[C19] GET FILE NAME
	HRRM	T1,X.RIB+.RBNAM(P1)	;[OK] [C19] SET VARIABLE PART
	SETZM	X.RIB+.RBPPN(P1)	;[OK] [C19] ALWAYS USE DEFAULT PATH
	PUSHJ	P,GETCHN		;[C19] GET A WORKING CHANNEL
	  JRST	E$$NEH			;[C19] FAILED
	MOVEM	T1,FILCHN(F)		;[C19] SAVE IT
	HRLS	T1			;[C19] BUILD FILOP. BLOCK, GET CHANNEL
	HRRI	T1,.FORED		;[C19] GET READ FUNCTION
	TXO	T1,FO.PRV		;[N14] BYPASS CHECKS IF [1,2] OR JACCT
	SKIPE	XCHNO.			;[N17] CAN WE USE EXTENDED CHANNELS?
	TXO	T1,FO.ASC		;[N17] YES, DO SO
	MOVEM	T1,FLPARG+.FOFNC	;[C19] STORE THEM
	HRLI	T1,X.OPN(P1)		;[OK] [C19] TRANSFER OPEN BLOCK
	HRRI	T1,FLPARG+.FOIOS	;[C19]   ..
	BLT	T1,FLPARG+.FOIOS+2	;[C19]   ..
	SETZM	FLPARG+.FONBF		;[C19] NO BUFFERS
	HRRZI	T1,X.RIB(P1)		;[OK] [C19] GET LOOKUP BLOCK ADDRESS
	MOVEM	T1,FLPARG+.FOLEB	;[C19] STORE IT
	MOVE	T1,[XWD .FOLEB+1,FLPARG]	;[C19] DO READ FILOP.
	FILOP.	T1,			;[C19]   ..
	  JRST	ERRFUF			;[C19] FAILED
	MOVS	T1,FLPARG+.FOFNC	;[N17] GET CHANNEL BACK
	ANDI	T1,777			;[N17]
	HRRM	T1,FILCHN(F)		;[N17] INCASE WE HAD AN EXTENDED CHAN
IFE FTCOBOL,<
	PUSHJ	P,DSKPRI		;[C19] SET DISK PRIORITY LEVEL
>
	POP	P,P1			;[C19] RESTORE P1
	RETURN
END;
SUBTTL	FILE UTILITY ROUTINES -- Build a Buffer Ring

BEGIN
  PROCEDURE	(PUSHJ	P,BUFRNG)	;CREATE BUFFER RING

;ENTER WITH:
;	P1/	POINTER TO X. BLOCK FOR THIS FILE
;	P2/	NUMBER OF BUFFERS TO BUILD IN RING
;	F/	POINTER TO FCB FOR THIS FILE
;	BUFPTR/	ADDRESS WHERE BUFFERS SHOULD START; UPDATED TO END OF
;		NEW BUFFERS
;
;ON RETURN, STORES ORIGINAL BUFPTR IN FILBUF(F) SO BUFFER AREA MAY BE
;REUSED. IF THIS IS AN OUTPUT FILE (CHECKS WHICH SIDE FILE WAS OPENED
;ON), THEN SET BF.IBC, INHIBIT BUFFER CLEAR.

	MOVE	T1,BUFPTR		;START OF BUFFER AREA
	MOVEM	T1,FILBUF(F)		;STORE IT
	ADDI	T1,1			;HEADER POINTS TO 2ND WORD
	MOVE	T2,X.OPN+.OPBUF(P1)	;[OK] [215] GET BUFFER HEADER WORD FROM INIT
	TLNN	T2,-1			;OUTPUT OR INPUT?
	TXOA	T1,BF.VBR		;INPUT, JUST SET VIRGIN RING BIT
	TXO	T1,BF.VBR!BF.IBC	;OUTPUT, SET INHIBIT BUFFER CLEAR ALSO
	MOVEM	T1,FILHDR(F)		;STORE IN FCB
  IF DSK AND LARGE BUFFERS ALLOWED
	MOVE	T4,FILFLG(F)		;[C18] DSK?
	TXNN	T4,FI.DSK		;[C18]   ..
	JRST	$T			;[C18] NO
	HRROI	T4,.GTLBS		;[C18] LARGE BUFFERS ALLOWED?
	GETTAB	T4,			;[C18]   ..
	  JRST	$T			;[C18] NO
  THEN MAKE TWO LARGE BUFFERS
	MOVE	T4,P2			;[C18] CALCULATE THE BUFFER SIZE
	LSH	T4,-1			;[C18]   ..
	IMULI	T4,200			;[C18]   ..
	ADDI	T4,3			;[C18]   ..
	MOVEI	T3,2-1			;[C18] USE TWO BUFFERS (DONT INCLUDE LAST)
	JRST	$F			;[C18]
  ELSE USE NORMAL BUFFER SIZE AND COUNT SPECIFIED
	MOVEI	T3,-1(P2)		;[OK] [215] # OF BUFFERS REQUIRED (NOT INCLUDING LAST)
	HRRZ	T4,X.DVSZ(P1)		;[OK] [215] GET BUFFER SIZE
  FI;
	MOVEI	T2,-3(T4)		;[OK] [C18] CALCULATE BYTES PER BUFFER
	IMUL	T2,IOBPW2		;[C18]   ..
	MOVEM	T2,FILBPB(F)		;[C18] STORE BYTES PER BUFFER
	HRRZS	T1			;[C20] CLEAN T1 FOR INDEXING
	HRLI	T2,-2(T4)		;[C20] DATA COUNT
  $1%	HRR	T2,T1			;[C20] GET TO NEXT
	ADD	T2,T4			;[C20]    ..
	MOVEM	T2,(T1)			;[OK] DATA COUNT,,LINK TO NEXT
	SETZM	1(T1)			;[OK] [131] ZERO BOOKKEEPING AND COUNT WORD
	HRRZ	T1,T2			;[C20] ADVANCE
	SOJG	T3,$1			;FOR ALL BUFFERS
	HRR	T2,FILHDR(F)		;LAST ONE IS LINKED TO FIRST
	MOVEM	T2,(T1)			;[OK] TO COMPLETE THE RING
	SETZM	1(T1)			;[OK] [210] ZERO LAST BOOKKEEPING AND COUNT WORD
	ADDI	T1,-1(T4)		;[OK] ALLOCATE SPACE FOR BUFFER
	HRRZM	T1,BUFPTR		;BETTER SAVE IT
	RETURN
END;
SUBTTL	FILE UTILITY ROUTINES -- Format Buffer Pool

BEGIN
  PROCEDURE	(PUSHJ	P,FMTBFP)
	MOVE	T1,NUMRCB	;[C13] GET NO. OF RECORDS IN TREE
	IMULI	T1,RN.LEN	;[C13] COMPUTE SIZE OF TREE
	MOVEM	T1,TRESZ	;[C13] SAVE TREE SIZE
	CALL	GETSPC		;[C13] ALLOCATE SPACE FOR TREE
	  JRST	E$$NEC		;[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	E$$NEC		;[C13] FAILED
	MOVEM	T1,RCBORG	;[C13] SAVE ADDR OF START OF RECORD POOL
	MOVE	T1,BUFSZ	;[C13] ALLOCATE SEPARATE AREA FOR BUFFER POOL
	CALL	GETSPC		;[C13]  ..
	  JRST E$$NEC		;[C13] FAILED
	MOVEM	T1,BUFPTR	;[C13] REMEMBER WHERE IT STARTS
	MOVEM	T1,BUFORG	;[C13] SAVE START OF BUFFER POOL
	MOVE	T2,BUFSZ	;[C13] CALCULATE USEFUL BUFFER SPACE
	MOVEM	T2,UBUFSZ	;[C13] SAVE IT
	RETURN			;[C13]
END;
SUBTTL	FILE UTILITY ROUTINES -- Reformat Buffer Pool for Next Merge

BEGIN
  PROCEDURE	(PUSHJ	P,RFMBFP)		;REFORMAT BUFFER POOL FOR MERGE PHASE

	MOVE	T1,ACTTMP		;NO. OF TMP FILES
	IMULI	T1,.TBS			;TIMES SIZE
IFE FTCOBOL,<
	MOVE	T2,F.OXBK		;[215] SIZE OF OUTPUT BUFFER
	MOVE	T2,X.DVSZ(T2)		;[OK] [215]   ..
	CAIGE	T2,.TBS			;USE LARGER OF REAL OR TEMP
	MOVEI	T2,.TBS			; SINCE WE DON'T KNOW WHICH TO USE YET
	ADD	T1,T2			;[C20] PLUS 1 OUTPUT BUFFER
>
IFN FTCOBOL,<
	SKIPE	NUMLFT			;IF WE NEED TO DO A MERGE PASS
	ADDI	T1,.TBS			;NEEDED FOR MERGE OUTPUT
>
  IF ENOUGH ROOM 
	MOVE	T2,UBUFSZ		;[C13] GET USEFUL BUFFER POOL SIZE
	IDIV	T2,T1			;[C20] GIVES NO. OF BUFFERS EACH
	CAIGE	T2,2			;DOUBLE BUFFERING AT LEAST REQUIRED
	JRST	$T
  THEN JUST RESET PARAMETERS
	TRZ	T2,1			;[C18] MAKE EVEN
	MOVEM	T2,TBUFNO		;NO. FOR MERGE FILES
	MOVE	T1,UBUFSZ		;[C13] GET USEFUL BUFFER POOL SIZE
	IMUL	T2,ACTTMP		;TIMES NO. OF TEMP FILES
	IMULI	T2,.TBS			;TIMES SIZE OF EACH
	SUB	T1,T2			;[C20] GET HOW MUCH IS LEFT FOR OUTPUT
IFE FTCOBOL,<
	MOVE	T2,F.OXBK		;[215] GET OUTPUT BUFFER SIZE
	MOVE	T2,X.DVSZ(T2)		;[OK] [215]   ..
	CAIGE	T2,.TBS
	MOVEI	T2,.TBS
	IDIV	T1,T2			;[C20] GET NO. OF OUTPUT BUFFERS
>
IFN FTCOBOL,<
	IDIVI	T1,.TBS
>
	TRZ	T1,1			;[C18] MAKE EVEN
	MOVEM	T1,OBUFNO		;STORE
	MOVE	T1,BUFORG		;[C13] RESET BUFFER POOL ADDRESS
	MOVEM	T1,BUFPTR		;[C13]   ..
	RETURN

  ELSE EXPAND CORE
	LSH	T1,1			;DOUBLE SIZE WE NEED
	MOVEM	T1,UBUFSZ		;[C13] STORE NEW USEFUL BUFFER POOL SIZE
	EXCH	T1,BUFSZ		;[C13] STORE NEW BUFFER POOL SIZE
	PUSHJ	P,FRESPC		;[C13] AND DROP OLD BUFFER POOL
	MOVE	T1,RCBSZ		;[C21] GET SIZE OF RECORD POOL
	PUSHJ	P,FRESPC		;[C21] DEALLOCATE IT
	MOVE	T1,TRESZ		;[C21] GET SIZE OF TREE AREA
	PUSHJ	P,FRESPC		;[C21] DEALLOCATE IT
	MOVE	T1,NUMRCB		;[C21] GET NO. OF RECORDS IN TREE
	IMULI	T1,RN.LEN		;[C21] COMPUTE SIZE OF TREE
	MOVEM	T1,TRESZ		;[C21] SAVE TREE SIZE
	CALL	GETSPC			;[C21] ALLOCATE SPACE FOR TREE
	  JRST	E$$NEC			;[C21] FAILED
	MOVEM	T1,TREORG		;[C21] SAVE ADDR OF START OF TREE
	MOVE	T1,NUMRCB		;[C21] GET NO. OF RECORDS IN TREE
	IMUL	T1,REKSIZ		;[C21]  TIMES SIZE OF RECORDS
	MOVEM	T1,RCBSZ		;[C21] SAVE SIZE OF RECORD POOL
	CALL	GETSPC			;[C21] ALLOCATE SPACE FOR RECORDS
	  JRST	E$$NEC			;[C21] FAILED
	MOVEM	T1,RCBORG		;[C21] SAVE ADDR OF START OF RECORD POOL
	MOVE	T1,BUFSZ		;[C13] ALLOCATE NEW BUFFER POOL
	PUSHJ	P,GETSPC		;[C13]   ..
	  JRST	E$$NEC			;[C13] FAILED
	MOVEM	T1,BUFPTR		;[C21] REMEMBER WHERE IF STARTS
	MOVEM	T1,BUFORG		;[C13] SAVE NEW BUFFER POOL ADDRESS
	JRST	$B			;TRY AGAIN
  FI;
END;
SUBTTL	CHANNEL MANAGEMENT -- SETCHN

;SETCHN - SETUP CHANNEL MANAGEMENT ROUTINES

BEGIN
  PROCEDURE	(PUSHJ	P,SETCHN)
	SKIPE	XCHNO.		;[N20] DO WE HAVE EXTENDED CHANS.?
	JRST	$6		;[N20] YES, USE 26 OF THEM
IFE FTCOBOL!FTFORTRAN,<
	SKIPN	FORRET		;[C20] [C19] CALLED BY FORTRAN?
	JRST	$4		;[C19] NO, STANDALONE
>
  IFN FTCOBOL,<
	MOVEI	T1,MX.T15	;[C19] GET MAX TEMP FILES
  >
  IFE FTCOBOL,<
	MOVEI	T1,MX.T15+1	;[C19] GET MAX TEMP FILES PLUS INPUT/OUTPUT FILE
  >
	MOVEM	T1,CHNFRE	;[C19] STORE IT
	PUSH	P,[-1]		;[C19] MARK END OF STACK
  $1%	PUSHJ	P,GETCHN	;[C19] TRY FOR A CHANNEL
	  JRST	$2		;[C19] CAN'T
	PUSH	P,T1		;[C19] SAVE IT
	JRST	$1		;[C19] LOOP AROUND
  $2%	SETOM	CHNFRE		;[N09] [C19] THAT'S ALL WE GET, BUT KEEP ONE FOR MERGE
  $3%	POP	P,T1		;[C19] GET CHANNEL ALLOCATED
	JUMPL	T1,$5		;[C19] NO MORE
	PUSHJ	P,FRECHN	;[C19] FREE CHANNEL
	JRST	$3		;[C19] LOOP AROUND

  $5%				;[C19]
  IFN FTCOBOL,<
	SKIPG	T1,UR.CHN	;[C19] DID USER WANT CHANNELS RESERVED?
	MOVEI	T1,U.CHN	;[C19] NO, GET DEFAULT
	MOVNS	T1		;[C19] REDUCE MAX AVAILABLE
	ADDM	T1,CHNFRE	;[C19]   ..
>
	RETURN			;[N20]

;HERE IF STANDALONE (NEITHER FORTRAN NOR COBOL)
IFE FTCOBOL!FTFORTRAN,<
  $4%	SKIPA	T1,[MX.T15]	;[N20] [C19] USE THEM ALL (EXCEPT 0)
>
  $6%	MOVEI	T1,MX.TMP	;[N20] USE 26 OF THEM.
IFE FTCOBOL,<
	SKIPG	MAXTMP		;[N20] DID USE SPECIFY /MAXTMP?
	JRST	$7		;[N20] NO, USE DEFAULT
	CAMLE	T1,MAXTMP	;[N20] YES, DO WE HAVE ENOUGH CHANS.?
	SKIPA	T1,MAXTMP	;[N20] YES, JUST USE WHAT USER SPECIFIED
  $7%>
	MOVEM	T1,MAXTMP	;[N20]
IFE FTCOBOL,<
	ADDI	T1,1		;[N20] EXTRA CHANNEL FOR INPUT/OUTPUT FILE
>
	MOVEM	T1,CHNFRE	;[C19]   ..
	RETURN			;[C19]
END;
SUBTTL	CHANNEL MANAGEMENT -- GETCHN

;GETCHN ALLOCATES A CHANNEL AND RETURNS IT IN T1
;RETURNS IF OK, ERROR RETURNS IF NO MORE CHANNELS AVAILABLE.

BEGIN
  PROCEDURE	(PUSHJ	P,GETCHN)

	SKIPGE	CHNFRE		;[N09] [C19] ALLOCATING TOO MANY CHANNELS?
	RETURN			;[C19] YES, NOT ENOUGH

	SETZM	CHANEL		;[N17] ANTICIPATE 7.01
	SKIPE	XCHNO.		;[N17]  WITH EXTENDED CHANNELS
	JRST	$3		;[N17] YES IT IS

IFE FTCOBOL!FTFORTRAN,<
	SKIPN	FORRET		;[C20] [C19] CALLED BY FORTRAN?
	JRST	$1		;[C19] NO, STANDALONE
>
	MOVEI	L,1+[-4,,0	;[C19] LOAD UP ARG BLOCK FOR FUNCT. CALL
		     Z TP%INT,[F.GCH]	;[C19]
		     Z TP%LIT,[ASCIZ /SRT/]	;[C19]
		     Z TP%INT,STATUS	;[C19]
		     Z TP%INT,CHANEL]	;[C19]
	PUSHJ	P,FUNCT.	;[C19] ALLOCATE THE CHANNEL
	SKIPE	STATUS		;[C19] NON-ZERO STATUS IS AN ERROR
	RETURN			;[C19] GIVE ERROR RETURN
	JRST	$3		;[C19]

;HERE IF STANDALONE (NEITHER FORTRAN NOR COBOL)
IFE FTCOBOL!FTFORTRAN,<
  $1%
  $2%	AOS	T1,CHANEL	;[C19] GET A CHANNEL TO TRY
	CAILE	T1,17		;[C19] RUN OUT OF CHANNELS?
	RETURN			;[C19] YES
	DEVNAM	T1,		;[C19] AN UNUSED CHANNEL?
	  SKIPA			;[C19] YES
	JRST	$2		;[C19] NO, LOOP AROUND
>
  IFN FTDEBUG,<
	$ERROR	([,ACN,<Allocating I/O channel >,+)
	$MORE	(OCTAL,CHANEL)
	$CRLF
  >
  $3%	SOS	CHNFRE		;[C19] SUBTRACT CHANEL REQUESTED
	MOVE	T1,CHANEL	;[C19] RETURN CHANEL TO CALLER
	PJRST	CPOPJ1		;[C19] GIVE SKIP RETURN
END;
SUBTTL	CHANNEL MANAGEMENT -- FRECHN

;FRECHN - FREE CHANNEL C(T1)

BEGIN
  PROCEDURE	(PUSHJ	P,FRECHN)
	MOVEM	T1,CHANEL	;[C19] SAVE CHANEL

IFE FTCOBOL!FTFORTRAN,<
	SKIPE	FORRET		;[N17] [C20] [C19] NOT CALLED BY FORTRAN?
>
	SKIPE	XCHNO.		;[N17] OR 7.01 WITH EXTENDED CHANNELS
	JRST	$1		;[N17] YES IT IS

	MOVEI	L,1+[-4,,0	;[C19] LOAD UP FUNCT. ARG BLOCK
		     Z TP%INT,[F.RCH]	;[C19]
		     Z TP%LIT,[ASCIZ /SRT/]	;[C19]
		     Z TP%INT,STATUS	;[C19]
		     Z TP%INT,CHANEL]	;[C19]
	PUSHJ	P,FUNCT.	;[C19] RELEASE THE CHANNEL
	SKIPE	STATUS		;[C19] OK?
	JRST	E$$FCN		;[C19] NO, COMPLAIN
	JRST	$2		;[C19]

  $1%	DEVNAM	T1,		;[C19] CHANNEL RELEASED YET?
  $2%	  AOSA	CHNFRE		;[C19] YES,  SUBTRACT WHAT WE'VE FREED
	JRST	E$$FCN		;[C19] NO
  IFN FTDEBUG,<
	$ERROR	([,DCN,<Returning I/O channel >,+)
	$MORE	(OCTAL,CHANEL)
	$CRLF
  >
	RETURN			;[C19]
END;
SUBTTL	CHANNEL MANAGEMENT -- RELCHN

;RELCHN - RELEASE AND FREE CHANNEL C(T1)

BEGIN
  PROCEDURE	(PUSHJ	P,RELCHN)
  IF 7-SERIES MONITOR
	SKIPN	M7.00			;[N12] 7-SERIES?
	JRST	$T			;[N12] NO
  THEN USE FILOP. FOR ALL I/O
	MOVSS	T2,T1			;[N12] MAKE A COPY OF CHAN # IN LEFT HALF
	HRRI	T1,.FOREL		;[N12] RELEASE FUNCTION
	MOVEM	T1,FLPARG+.FOFNC	;[N12] ONLY ONE ARG
	MOVE	T1,[1,,FLPARG]		;[N12]
	FILOP.	T1,			;[N12]
	  JRST	ERRFUF			;[N12] ERROR
	MOVS	T1,T2			;[N12] GET CHAN BACK
	JRST	FRECHN			;[N12] OK

  ELSE USE OLD I/O UUOs
	MOVE	T2,T1			;[C19] BUILD RELEASE UUO
	LSH	T2,27			;[C19]   ..
	TLO	T2,(RELEAS)		;[C19]   ..
	XCT	T2			;[C19] DO IT
	PJRST	FRECHN			;[C19] FREE THE CHANNEL
  FI;
END;
SUBTTL	ERROR MESSAGES

;FILE FILOP. ERRORS
;ENTER WITH
;	T1 = ERROR CODE
;	FLPARG = FILOP. BLOCK

ERRFUF:	PUSH	P,T1			;[C19] SAVE ERROR CODE
	$ERROR	(?,FUF,<FILOP. >,+)	;[C19] TYPE PREFIX
	MOVEI	T1,FLPTAB		;[C20] [C19] SEARCH FOR FILOP. FUNC
	HRRZ	T2,FLPARG+.FOFNC	;[C19] GET FUNC TO SEARCH FOR
ERRFU1:	HLRZ	T3,(T1)			;[OK] [C19] GET TABLE ENTRY FUNC
	CAMN	T2,T3			;[C19] ARE THEY THE SAME?
	JRST	ERRFU2			;[C19] YES
	CAIGE	T1,FLPTAB+FLPLEN-1	;[C20] NO, ANY MORE?
	AOJA	T1,ERRFU1		;[C20] [C19] YES, TRY NEXT
	$MORE	(OCTAL,T2)		;[C19] NO MATCH, JUST TYPE NUMBER
	JRST	ERRFU3			;[C19]
ERRFU2:	HRRZ	T1,(T1)			;[OK] [C19] TYPE TEXT
	$MORE	(ASCII,T1)		;[C19]    ..
ERRFU3:	$MORE	(TEXT,< failed>)	;[C19]
	HRRZ	T1,FLPARG+.FOLEB	;[C19] A FILENAME?
	JUMPE	T1,ERRFU4		;[C19] NO
	$MORE	(TEXT,< for >)		;[C19] YES
	HRRZ	T1,FLPARG+.FOLEB	;[C19] TYPE FILENAME
	$MORE	(FILESPEC,T1)		;[C19]
ERRFU4:	$MORE	(TEXT,< error >)	;[C19]
	POP	P,T1			;[C19] RESTORE ERROR CODE
	CAIG	T1,LRELEN		;[C19] KNOWN CODE?
	JRST	ERRFU5			;[C19] YES
	$MORE	(OCTAL,T2)		;[C19] NO, JUST TYPE NUMBER
	JRST	ERRFU6			;[C19]
ERRFU5:	MOVE	T1,LRETAB(T1)		;[OK] [C19] TYPE TEXT
	$MORE	(ASCII,T1)		;[C19]    ..
ERRFU6:	$DIE				;[C19] DONE

LRETAB:	[ASCIZ	\(0) file was not found \]
	[ASCIZ	\(1) no directory for project-programmer number \]
	[ASCIZ	\(2) protection failure \]
	[ASCIZ	\(3) file was being modified \]
	[ASCIZ	\(4) rename file name already exists \]
	[ASCIZ	\(5) illegal sequence of UUOs \]
	[ASCIZ	\(6) bad UFD or bad RIB \]
	[ASCIZ	\(7)\]; not a SAV file \]
	[ASCIZ	\(10)\]; not enough core \]
	[ASCIZ	\(11) device not available \]
	[ASCIZ	\(12) no such device \]
	[ASCIZ	\(13) illegal monitor call \]
	[ASCIZ	\(14) no room or quota exceeded \]
	[ASCIZ	\(15) write lock error \]
	[ASCIZ	\(16) not enough monitor table space \]
	[ASCIZ	\(17) partial allocation only \]
	[ASCIZ	\(20) block not free on allocation \]
	[ASCIZ	\(21)\]; can't supersede (enter) an existing directory \]
	[ASCIZ	\(22)\]; can't delete (rename) a non-empty directory \]
	[ASCIZ	\(23) SFD not found \]
	[ASCIZ	\(24) search list empty \]
	[ASCIZ	\(25) SFD nested too deeply \]
	[ASCIZ	\(26) no-create on for specified SFD path \]
	[ASCIZ	\(27)\]; segment not on swap space \]
	[ASCIZ	\(30) can't update file \]
	[ASCIZ	\(31)\]; low segment overlaps high segment \]
	[ASCIZ	\(32)\]; user not logged in \]
	[ASCIZ	\(33)\]; file has outstanding locks set \]
	[ASCIZ	\(34)\]; bad EXE directory \]
	[ASCIZ	\(35)\]; bad EXE extersion \]
	[ASCIZ	\(36)\]; EXE directory too big \]
	[ASCIZ	\(37)\]; network capacity exceeded \]
	[ASCIZ	\(40)\]; task not available \]
	[ASCIZ	\(41)\]; unknown network node specified \]
	[ASCIZ	\(42)\]; rename-SFD is in use \]
	[ASCIZ	\(43)\]; delete-file has an NDR block \]
	[ASCIZ	\(44)\]; job count too high \]

LRELEN==.-LRETAB

FLPTAB:	XWD .FORED,[ASCIZ /READ/]		;[C19]
	XWD .FOCRE,[ASCIZ /CREATE/]		;[C19]
	XWD .FOWRT,[ASCIZ /WRITE/]		;[C19]
	XWD .FOAPP,[ASCIZ /APPEND/]		;[C19]
	XWD .FOCLS,[ASCIZ /CLOSE/]		;[C19]
	XWD .FORNM,[ASCIZ /RENAME/]		;[C19]
	XWD .FODLT,[ASCIZ /DELETE/]		;[C19]
	XWD .FOINP,[ASCIZ /INPUT/]		;[N12]
	XWD .FOOUT,[ASCIZ /OUTPUT/]		;[N12]
	XWD .FOREL,[ASCIZ /RELEASE/]		;[N12]
	XWD .FOWAT,[ASCIZ /WAIT/]		;[N12]
FLPLEN==.-FLPTAB				;[C19]
E$$IRE:	$ERROR	(?,IRE,<Input>,+)	;[353] INPUT ERROR
	JRST	IREOWE			;[353] PRINT WHY

E$$OWE:	$ERROR	(?,OWE,<Output>,+)	;[353] OUTPUT ERROR
;	JRST	IREOWE			;[353] PRINT WHY

BEGIN
  PROCEDURE	(PUSHJ	P,IREOWE)	;[353] TYPE I/O ERROR

;IREOWE IS AN INTERNAL ROUTINE FOR THE E$$IRE AND E$$OWE ERROR MESSAGE HANDLERS.
;ITS FUNCTION IS TO PRINT THE PROPER REASON FOR AN IN OR OUT UUO FAILURE.
;
;CALL:
;	0(P)/	<GETSTS WORD>
;	F/	<POINTER TO FCB FOR FILE>
;RETURNS VIA $DIE.
;
;WE PRINT ALL ASSOCIATED MESSAGES FOR GETSTS ERROR BITS THAT ARE ON, UNLESS ALL
;ARE ON. IN THIS CASE, WE MUST DO A DEVOP. TO FIND OUT THE REAL ERROR AND PRINT
;A MORE SPECIFIC MESSAGE.

	PUSH	P,P1			;[353] SAVE AC FOR X. BLOCK
	MOVE	P1,FILXBK(F)		;[353] GET ADDR OF X. BLOCK FOR FILE
	$MORE	(TEXT,< error for >)
  IF THIS IS A TEMPORARY FILE
	JUMPN	P1,$T			;[353] NO X. BLOCK?
  THEN X. BLOCK DOESN'T EXIST, SO NO FILE BLOCK
	$MORE	(TEXT,<temporary file >);[374]
	LDB	T1,[POINT 6,FILNAM(F),35] ;[374] GET STRUCTURE INDEX
	SUBI	T1,'A'			;[374]   ..
	IDIV	T1,STRNUM		;[374]   MOD NUMBER OF STRUCTURES
	MOVE	T1,STRNAM(T2)		;[OK] [374] GET STRUCTURE NAME
	$MORE	(SIXBIT,T1)		;[374] TYPE DEVICE
	$CHAR	(":")			;[374] COLON
	HLLZ	T1,JOBNUM		;[374] CONSTRUCT FILE NAME
	HRR	T1,FILNAM(F)		;[374]   ..
	$MORE	(SIXBIT,T1)		;[374] TYPE IT
	$MORE	(TEXT,<.TMP>)		;[374] ADD EXTENSION
	JRST	$F			;[353]
  ELSE PRINT FILE SPEC
	MOVEI	T2,X.RIB(P1)		;[OK] [353] GET POINTER TO LOOKUP BLOCK
	$MORE	(FILESPEC,T2)		;[353]
  FI;
	POP	P,P1			;[353] DONE WITH X. BLOCK--RESTORE AC
  IF ALL ERROR BITS NOT ON
	MOVE	T4,(P)			;[353] GET GETSTS BITS BACK
	TXC	T4,IO.ERR		;[353] SEE IF ALL ERROR BITS ARE ON
	TXCN	T4,IO.ERR		;[353]   ..
	JRST	$T			;[353] ALL BITS ARE ON
  THEN PRINT JUST RESULTS OF GETSTS WORD
	$MORE	(TEXT,<, GETSTS code is:>)
	TXNN	T4,IO.IMP		;[353] IMPROPER MODE
	JRST	$1			;[353] NO
	$CRLF				;[353] NEW LINE FOR REASON
	$MORE	(TEXT,<Device write-locked or improper mode.>)
  $1%	TXNN	T4,IO.DER		;[353] DEVICE DATA ERROR?
	JRST	$2			;[353] NO
	$CRLF				;[353] NEW LINE FOR REASON
	$MORE	(TEXT,<Device data error.>)
  $2%	TXNN	T4,IO.DTE		;[353] HARD DATA ERROR?
	JRST	$3			;[353] NO
	$CRLF				;[353] NEW LINE FOR REASON
	$MORE	(TEXT,<Parity or hard data error.>)
  $3%	TXNN	T4,IO.BKT		;[353] BLOCK TOO LARGE?
	JRST	$F			;[353] DONE PRINTING GETSTS RESULTS
	$CRLF				;[353] NEW LINE FOR REASON
	$MORE	(TEXT,<Quota exceeded or block too large.>)
	JRST	$F			;[353] DONE PRINTING GETSTS RESULTS
  ELSE PRINT DEVOP. STATUS
	$MORE	(TEXT,<, DEVOP. code is:>)
	$CRLF				;[353] NEW LINE FOR REASON
	DMOVE	T1,[2,,T2		;[353] BUILD DEVOP. UUO FOR FILE'S CHANNEL
		    .DFRES]		;[353]   ..
	MOVE	T3,FILCHN(F)		;[C19] GET CHANNEL
	DEVOP.	T1,			;[353] GET THE REASON
	  JSP	P4,E$$MUF		;[353] ?! DEVOP. EXISTS IF ALL BITS ON
	  IF CODE IS IN RANGE OF TABLE
		CAXLE	T1,DVPLEN		;[353] RANGE-CHECK AGAINST OUR TABLE
		JRST	$T			;[353] NO GOOD--SAY UNKNOWN
	  THEN PRINT USEFUL MESSAGE
		MOVE	T1,DVPTBL-1(T1)		;[OK] [353] LOAD ADDR OF PROPER MESSAGE
		$MORE	(TEXT,T1)		;[353] PRINT IT
		JRST	$F			;[353]
	  ELSE JUST PRINT THE CODE
		PUSH	P,T1			;[353] SAVE CODE FOR A WHILE
		$CHAR	"("			;[353] PRINT CODE
		POP	P,T1			;[353]   ..
		$MORE	(OCTAL,T1)		;[353]   ..
		$MORE	(TEXT,<) Unknown cause.>)
	  FI;
  FI;
	POP	P,(P)			;[353] CLEAN UP STACK
	$DIE				;[353] THIS IS A FATAL ERROR
END;
DVPTBL:	[ASCIZ	/(1) Line printer page limit exceeded./]
	[ASCIZ	/(2) Line printer VFU format error./]
	[ASCIZ	/(3) Magtape label type error./]
	[ASCIZ	/(4) Magtape header label error./]
	[ASCIZ	/(5) Magtape trailer label error./]
	[ASCIZ	/(6) Magtape volume label error./]
	[ASCIZ	/(7) Hard device error./]
	[ASCIZ	/(10) Parity error./]
	[ASCIZ	/(11) Write lock error./]
	[ASCIZ	/(12) Magtape illegal positioning operation./]
	[ASCIZ	/(13) Magtape beginning of tape./]
	[ASCIZ	/(14) Magtape illegal operation./]
	[ASCIZ	/(15) Reserved for tape labeling./]
	[ASCIZ	/(16) Reserved for tape labeling./]
	[ASCIZ	/(17) Reserved for tape labeling./]
	[ASCIZ	/(20) Network node is down./]
	[ASCIZ	/(21) LP20 undefined character interrupt./]
	[ASCIZ	/(22) LP20 memory parity error./]
	[ASCIZ	/(23) LP20 RAM parity error./]
	[ASCIZ	/(24) LP20 master sync or timeout error./]
DVPLEN==.-DVPTBL
E$$MGF:	$ERROR	(?,MGF,<Monitor GETTAB failed at >,+)	;[C20]
	XMOVEI	T1,-2(P4)		;[C20] CALLED VIA JSP P4,E$$MGF
	$MORE	(OCTAL,T1)
	$DIE
E$$MUF:	$ERROR	(?,MUF,<Monitor UUO failed at >,+)	;[C20]
	XMOVEI	T1,-2(P4)		;[C20] CALLED VIA JSP P4,E$$MUF
	$MORE	(OCTAL,T1)
	$DIE
;Uncomment this routine and call it from GENSTR after PATH.
;is fixed.
;ERRSII:	$ERROR	(?,SII,<Search list information inconsistant for >,+)
;	$MORE	(SIXBIT,PTHARG+.PTFCN)	;[C19]
;	$DIE
E$$SWP:	$ERROR	(?,SWP,<Temporary structure >,+)
	$MORE	(SIXBIT,DSKARG)
	$MORE	(TEXT,<: is write-locked.>)
	$DIE
E$$NSW:	$ERROR	(?,NSW,<No temporary device is writable.>)
ERRATD:	SKIPE	STRDEF			;[214] IF JUST GENERIC DSK: DON'T BOTHER
	JRST	ATDONE			;[214]   THE USER WITH THE MESSAGE
	$ERROR	(%,ATD,<Attempt to use temporary device >,+)
	MOVE	T1,(P)			;[214] GET BACK STR NAME
	$MORE	(SIXBIT,T1)		;[214] TYPE IT
	$MORE	(TEXT,<: failed--ignoring it.>)
	$CRLF				;[214] FINISH LINE
ATDONE:	POP	P,(P)			;[214] CLEAR STACK
	POPJ	P,			;[214] RETURN

E$$FEA:	$ERROR	(?,FEA,<Formal arg exceeds actual arg count>)