Google
 

Trailing-Edge - PDP-10 Archives - cobol12c - srtscn.mac
There are 14 other files named srtscn.mac in the archive. Click here to see a list.
SUBTTL	SRTSCN - INTERFACE TO SCAN FOR TOPS-10 COMMAND SCANNER
SUBTTL	D.M.NIXON/DMN/DZN/BRF/CLRH/GCS/PY	22-Jun-83
SEARCH COPYRT


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

	SALL

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


;                    Table of Contents for SRTSCN
;
;
;                             Section                             Page
;
;   1  SRTSCN - INTERFACE TO SCAN FOR TOPS-10 COMMAND SCANNER ...   1
;   2  TABLE OF CONTENTS FOR SRTSCN .............................   2
;   3  DEFINITIONS
;        3.1  TOPS-10 Specific Parameters .......................   3
;        3.2  Prototype SCAN Block ..............................   4
;        3.3  Impure Data .......................................   5
;   4  RESTART CODE .............................................   6
;   5  SCAN INTERFACE
;        5.1  Interface Procedure ...............................   7
;        5.2  Switch Table ......................................   8
;        5.3  Control Routines
;             5.3.1  ALLOUT .....................................  11
;             5.3.2  ALLIN ......................................  12
;        5.4  Switch Handling
;             5.4.1  /PRIORITY:n ................................  13
;             5.4.2  /KEY:n:m:x .................................  14
;             5.4.3  /COLLATE:x[:y] .............................  15
;   6  TYPE-IN ROUTINES
;        6.1  Format Descriptor .................................  18
;   7  PSORT.
;        7.1  SETTMP - Set up Temporary Files ...................  19
;        7.2  PRUNE - Prune Null SCAN Blocks from I/O Lists .....  20
;        7.3  SETUPO - Set Up Output Files ......................  21
;        7.4  SETUPI - Set Up Input Files .......................  22
;        7.5  STOPB - Convert SORT/SCAN To OPEN/ENTER/PATH Blocks  23
;        7.6  SETMTA - Set Up Buffer Sizes for Magtapes .........  24
;        7.7  Memory Management Routines for TOPS-10 ............  25
;   8  HPURE SEGMENT ERROR MESSAGES .............................  28
;   9  I/O ROUTINES
;        9.1  INIINP - Initialize Next Input File ...............  29
;        9.2  INIOUT - Initialize Next Output File ..............  31
;        9.3  RENOUT - Rename Temporary File to Output File .....  33
;        9.4  Magtape Utility Routines ..........................  34
;        9.5  STAPF - Set Magtape File Parameters ...............  36
;  10  TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE ............  37
;  11  SET DISK PRIORITY LEVEL ..................................  39
SUBTTL	DEFINITIONS -- TOPS-10 Specific Parameters


;PARAMETER DEFINITIONS NEEDED ONLY ON TOPS10

DVCHMD==177777		;MODE BIT PORTION OF DEVCHR VALUE
DVCHNL==757777,,0	;DEVCHR FOR NUL: MINUS MODE BITS

IFE FTFORTRAN,<
;DEFINITIONS FOR INTERFACE TO SCAN

N==P3
C==P4
;**;[500] @EXTERN  Replace 1 line.   GCS   13-APR-82
EXTERN	.SWDEC,.SWOCT,.DECNW,.SWCOR,.SIXSW,.SWSIX,.NMUL,.SAVE4,.PSH4T,.POP4T  ;[500]
EXTERN	.ERMSG,.TOCTW,.TDECW,.TSTRG,.TSIXN,.TOLEB,.TCORW,.TRBRK,.TCRLF,.TCHAR,.TTIME

;DEFINITIONS FOR FORTRAN-SCAN INTERFACE

BUFSIZ==200		;[C20] SIZE OF INPUT/OUTPUT TEXT BUFFERS

;TAPOP. FUNCTIONS AND ARGS

.TFDEN==1001
.TFKTP==1002
.TFMOD==1007

.TFD80==3
.TFD16==4

.TFKTC==2
.TFKTX==3

.TFM7B==4

 DEFINE	ENDMODULE<
	$PURGE
	END	START>
>;END IFE FTFORTRAN
SUBTTL	DEFINITIONS -- Prototype SCAN Block

;THIS DEFINITION FOR THE S.xxxx BLOCK IS USED BY SORT AND SCAN TO KEEP TRACK OF
;FILE SPECS. AS SCAN READS FILE SPECS, IT ASKS SORT FOR MEMORY IN WHICH TO STORE
;THEM. SCAN REQUIRES ONLY THOSE LOCATIONS FROM S.DEV ON, SO THE REST IS FOR SORT
;TO LINK THE BLOCKS TOGETHER AND TO STORE SORT'S SWITCH ARGUMENTS IN.

	LOC	0

S.SPC:!	BLOCK	1		;START OF SCAN FILE SPEC BLOCK
S.BLKF:!BLOCK	1		;BLOCKING FACTOR
S.LABL:!BLOCK	1		;STANDARD, OMITTED, NONSTANDARD
S.VARI:!BLOCK	1		;VARIABLE RECORD SIZE
S.INDU:!BLOCK	1		;INDUSTRY COMPATIBLE MODE
S.STDA:!BLOCK	1		;STANDARD ASCII MODE
S.REW:!	BLOCK	1		;REWIND BEFORE USE
S.POSI:!BLOCK	1		;/POSITION: VALUE
S.UNL:!	BLOCK	1		;UNLOAD AFTER USE

S.DEV:!	BLOCK	1		;DEVICE
S.NAME:!BLOCK	1		;NAME
S.NAMM:!BLOCK	1		;NAME MASK
S.EXT:!	BLOCK	1		;EXT,,MASK
S.MOD:!				;MODIFIER WORD
S.PROT:!BLOCK	1		;OUTPUT PROTECTION
S.MODM:!BLOCK	1		;MODIFIER MASK
S.DIR:!	BLOCK	1		;DIRECTORY
S.DIRM:!BLOCK	1		;DIRECTORY MASK
S.SFD:!	BLOCK	2*<.FXLND-1>	;SFDS + MASKS
S.BFR:!	BLOCK	1		;/BEFORE
S.SNC:!	BLOCK	1		;/SINCE
S.ABF:!	BLOCK	1		;/ABEFORE
S.ASN:!	BLOCK	1		;/ASINCE
S.FLI:!	BLOCK	1		;FILE MIN SIZE (WORDS)
S.FLM:!	BLOCK	1		;FILE MAX SIZE (WORDS)
S.EST:!	BLOCK	1		;/ESTIMATE
S.VER:!	BLOCK	1		;/VERSION
S.LEN==.-S.SPC			;LENGTH TO HOLD FULL SCAN BLOCK
S.SCNL==.-S.DEV			;LENGTH SCAN THINKS IT HAS

	RELOC
SUBTTL	DEFINITIONS -- Impure Data

SEGMENT	IMPURE				;[C20]
OFFSET:	BLOCK	1			;[C20] ENTRY OFFSET
COLSCN:	BLOCK	S.LEN			;[355] SCAN BLOCK FOR COLLATE SPEC
IFE FTFORTRAN,<
BUFFER:	BLOCK	BUFSIZ			;[C20] FORTRAN COMMAND BUFFER
CMDPTR:	BLOCK	1			;[C20] FORTRAN COMMAND BYTE PTR
CMDLEN:	BLOCK	1			;[C20] FORTRAN COMMAND BYTE CNT
QBUFER:	BLOCK	1			;[C20] FORTRAN ERROR TYPE,,STATUS
CBUFER:	BLOCK	1			;[C20] FORTRAN ERROR CODE
TBUFER:	BLOCK	BUFSIZ			;[C20] FORTRAN ERROR TEXT BUFFER
FERPTR:	BLOCK	1			;[C20] FORTRAN ERROR BYTE PTR
FERCNT:	BLOCK	1			;[C20] FORTRAN ERROR BYTE CNT
>
SUBTTL	GETSEG CODE

IFE FTFORTRAN,<
IFE FTVM,<

SEGMENT	LPURE				;[C20]

BEGIN
  PROCEDURE	(PUSHJ	P,GETSCN)	;[C20] GET HIGH SEG SCANNER AGAIN
  IFE FTDEBUG,<
	MOVEM	P,RUNACS	;[C20] SAVE ACS DURING GETSEG
	MOVEI	T1,RUNDEV	;GET ARG LIST
	GETSEG	T1,
	  HALT			;FAILED
	MOVE	P,RUNACS	;[C20] RESTORE ACS AFTER GETSEG
  >
	RETURN			;[C20] RETURN
END;

SEGMENT	IMPURE				;[C20]

RUNDEV:	BLOCK	1			;DEVICE
RUNNAM:	BLOCK	1			;NAME
RUNEXT:	EXP	0			;EXTENSION
	EXP	0
RUNDIR:	BLOCK	1			;DIRECTORY

RUNPTH:	EXP	0			;NOT USED (BUT MUST BE ALLOCATED)
	EXP	0
RUNPPN:	BLOCK	1			;PPN
RUNSFD:	BLOCK	5			;SFD LIST
	EXP	0			;TERMINATOR

RUNACS:	BLOCK	1			;[C20] BLOCK TO SAVE ACS DURING GETSEG

>;END IFE FTVM

SEGMENT	HPURE				;[C20]
SUBTTL	SCAN INTERFACE -- Interface Procedure

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,SCAN)		;SCAN INTERFACE
	PORTAL	.+1		;INCASE EXECUTE ONLY
	AOS	QBUFER		;[C20] DEFER TTY OUTPUT FOR FORTRAN
	MOVE	T1,.TSBLK	;DATA BLOCK FOR TSCAN
	PUSHJ	P,.TSCAN##	;SCAN A LINE
	SETZM	QBUFER		;[C20] UN-DEFER TTY OUTPUT FOR FORTRAN
	PUSHJ	P,CLRFIL	;SEE IF ANY DEFAULTS TO SETUP
	MOVE	T1,.OSBLK	;DATA FOR OSCAN
	SKIPN	FORRET		;[C20] NOT FOR FORTRAN
	PUSHJ	P,.OSCAN##	;READ SWITCH.INI
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,FORINP)
	SOSGE	CMDLEN		;[C20] GET A BYTE FOR SCAN
	JRST	[$ERROR	(?,FCE,Fortran command error)]	;[C20] FAILED
	ILDB	C,CMDPTR	;[C20]   ..
	RETURN			;[C20]
END;

BEGIN
  PROCEDURE	(PUSHJ	P,FOROUT)
	SKIPN	QBUFER		;[C20] STORE AN ERROR BYTE FOR SCAN
	JRST   [OUTCHR	T1	;[C20] JUST TYPE CHAR IF NOT DEFERED
		RETURN]		;[C20]   ..
	PUSH	P,T1		;[C20] SAVE THE TEMP ACS
	PUSH	P,T2		;[C20]   ..
	PUSH	P,T3		;[C20]   ..
	PUSH	P,T4		;[C20]   ..
	ANDI	T1,177		;[C20] CLEAN UP BYTE
	HRRZ	T2,QBUFER	;[C20] GET STATUS
	SETZ	T3,		;[C20] CLEAR FLAGS
	CAIL	T1,"A"		;[C20] A LETTER?
	CAILE	T1,"Z"		;[C20]   ..
	SKIPA			;[C20]   NO
	TLO	T3,(1B0)	;[C20]   YES
	CAIL	T1,"a"		;[C20]   ..
	CAILE	T1,"z"		;[C20]   ..
	SKIPA			;[C20]   NO
	TLO	T3,(1B0)	;[C20]   YES
	CAIL	T1,"0"		;[C20] A DIGIT?
	CAILE	T1,"9"		;[C20]   ..
	SKIPA			;[C20]   NO
	TLO	T3,(1B1)	;[C20]   YES
	CAIE	T1," "		;[C20] A SPACING CHARACTER?
	CAIN	T1,"	"	;[C20]   ..
	TLO	T3,(1B2)	;[C20]   YES
	CAIE	T1,.CHCRT	;[C20] END OF LINE CHARACTER?
	CAIN	T1,.CHLFD	;[C20]   ..
	TLO	T3,(1B3)	;[C20]   YES
  $1%	JRST	@[IFIWS <$2,$3,$4,$5,$6,$7>]-1(T2)	;[C20] DISPTCH
  $2%	TLNE	T3,(1B0!1B1!1B3)	;[C20] LOOK FOR PREFIX BYTE
	JRST   [HRRZS	QBUFER	;[C20] A LETTER, DIGIT, OR EOL, NO PREFIX BYTE
		MOVEI	T2,2	;[C20] ADVANCE TO ERROR CODE
		JRST	$1]	;[C20]
	TLNE	T3,(1B2)	;[C20] A SPACING CHARACTER?
	JRST	$8		;[C20] YES, IGNORE IT
	HRLM	T1,QBUFER	;[C20] A PREFIX BYTE, STORE IT
	MOVEI	T2,2		;[C20] ADVANCE TO ERROR CODE
	JRST	$8		;[C20]
  $3%	TLNE	T3,(1B2)	;[C20] LOOK FOR ERROR CODE
	JRST	$8		;[C20] A SPACING CHARACTER, IGNORE IT
	TLNN	T3,(1B0)	;[C20] A LETTER?
	JRST   [SETZM	CBUFER	;[C20] NO, NO ERROR CODE
		MOVEI	T2,4	;[C20] ADVANCE TO TEXT
		JRST	$1]	;[C20]
	MOVEI	T2,3		;[C20] SETUP FOR ERROR CODE
	SETZM	CBUFER		;[C20]   ..
	MOVE	T4,[POINT 6,CBUFER]	;[C20]   ..
	MOVEM	T4,FERPTR	;[C20]   ..
	MOVEI	T4,6		;[C20]   ..
	MOVEM	T4,FERCNT	;[C20]   ..
	JRST	$1		;[C20]
  $4%	TLNE	T3,(1B0!1B1)	;[C20] STILL IN ERROR CODE?
	SOSGE	FERCNT		;[C20]   ..
	JRST   [MOVEI	T2,4	;[C20] NO, ADVANCE TO TEXT
		JRST	$1]	;[C20]
	SUBI	T1,40		;[C20]   ..
	IDPB	T1,FERPTR	;[C20]   ..
	JRST	$8		;[C20]
  $5%	TLNE	T3,(1B2)	;[C20] LOOK FOR TEXT
	JRST	$8		;[C20] A SPACING CHARACTER, IGNORE IT
	MOVEI	T2,5		;[C20] SETUP FOR ERROR CODE
	MOVE	T4,[POINT 7,TBUFER]	;[C20]   ..
	MOVEM	T4,FERPTR	;[C20]   ..
	MOVEI	T4,5*BUFSIZ-3	;[C20]   ..
	MOVEM	T4,FERCNT	;[C20]   ..
	JRST	$1		;[C20]
  $6%	TLNN	T3,(1B3)	;[C20] STILL IN TEXT?
	SOSGE	FERCNT		;[C20]   ..
	JRST   [MOVEI	T2,6	;[C20] NO, ADVANCE TO EOL
		JRST	$1]	;[C20]
	IDPB	T1,FERPTR	;[C20]   ..
	JRST	$8		;[C20]
  $7%	CAIE	T1,.CHLFD	;[C20] EOL, A <LF>?
	JRST	$8		;[C20] NO, IGNORE IT FOR NOW
	MOVEI	T4,.CHCRT	;[C20] YES, FINISH TEXT WITH <CR><LF><NULL>
	IDPB	T4,FERPTR	;[C20]   ..
	MOVEI	T4,.CHLFD	;[C20]   ..
	IDPB	T4,FERPTR	;[C20]   ..
	SETZ	T4,		;[C20]   ..
	IDPB	T4,FERPTR	;[C20]   ..
	HLRZ	T1,QBUFER	;[C20] SAVE PREFIX BYTE
	PUSH	P,T1		;[C20]   ..
	MOVE	T1,CBUFER	;[C20] TYPE THE MESSAGE
	HLL	T2,QBUFER	;[C20]   ..
	HRRI	T2,TBUFER	;[C20]   ..
	PUSHJ	P,%ERMSG	;[C20]   ..
	POP	P,T1		;[C20] A FATAL ERROR?
	CAIN	T1,"?"		;[C20]  ..
	JRST	DIE		;[C20] YES, FALL INTO DIE
	AOSA	QBUFER		;[C20] DEFER TTY OUTPUT AGAIN
  $8%	HRRM	T2,QBUFER	;[C20] SAVE STATUS
	POP	P,T4		;[C20] RESTORE ACS
	POP	P,T3		;[C20]   ..
	POP	P,T2		;[C20]   ..
	POP	P,T1		;[C20]   ..
	RETURN			;[C20]
END;

;SCAN ARG BLOCKS

.ISBLK:	3,,.+1
	1				;[114] FORCE A RESCAN
	OFFSET,,'SRT'
	0

.ISFBK:	5,,.+1				;[C20] FORTRAN ISCAN BLOCK
	0				;[C20] NO RESCAN
	0				;[C20] NO CCL FILES
	XWD FORINP,FOROUT		;[C20] I/O ROUTINES
	0				;[C20] NO INDIRECT FILE
	XWD CPOPJ,E$$FCE		;[C20] NO EXITING OR PROMPTING

.TSBLK: 9,,.+1
	IOWD SRTSWL,SRTSWN
	SRTSWD,,SRTSWM
	0,,SRTSWP
	-1
	CLRANS,,CLRFIL
	ALLIN,,ALLOUT
	MEMSTK,,APPSTK
	CLRSTK,,FS.MOT
	0,,STRSWT

.OSBLK:	4,,.TSBLK+1
SUBTTL	SCAN INTERFACE -- Switch Table

;STILL IN IFE FTFORTRAN

DEFINE SWTCHS<
SS	AFTER,ADVFLG,ADV.A,FS.NFS!FS.NUE		;[N11]
SN	ALIGNED,ALIGN,FS.NFS!FS.NUE
SS	ALPHANUMERIC,<POINTR (MODE,RM.ALP)>,1,FS.NFS!FS.NUE
SS	*ASCII,<POINTR (MODE,RM.ASC)>,1,FS.NFS!FS.NUE
SS	BEFORE,ADVFLG,ADV.B,FS.NFS!FS.NUE		;[N11]
SS	BINARY,<POINTR (MODE,RM.BIN)>,1,FS.NFS!FS.NUE
SP	*BLOCKED,F.BLKF,.SWDEC,BLK,FS.NUE
SS	CHECK,WSCSW,1,FS.NFS!FS.NUE
SL	COLLATING,COLSW,COL,COLASCII,FS.NFS
SS	COMP,<POINTR (MODE,RM.COM)>,1,FS.NFS!FS.NUE
SS	COMP1,<POINTR (MODE,RM.COM)>,1,FS.NFS!FS.NUE
SS	COMP3,<POINTR (MODE,RM.PAC)>,1,FS.NFS!FS.NUE
SS	COMPUTATIONAL,<POINTR (MODE,RM.COM)>,1,FS.NFS!FS.NUE
SP	*CORE,CORSIZ,.SWCOR,COR,FS.NUE!FS.NFS
SS	*EBCDIC,<POINTR (MODE,RM.EBC)>,1,FS.NFS!FS.NUE
SP	ERROR,ERRADR,.SWFOR,ZRO,FS.NFS!FS.NUE!FS.VRQ	;[C20] [351]
SP	FATAL,FERCOD,.SWFOR,ZRO,FS.NFS!FS.NUE!FS.VRQ	;[C20] [351]
SS	*FIXED,F.VARI,0,FS.NFS!FS.NUE
SP	FORMAT,F.FMT,.SWASF,ZRO,FS.NFS!FS.VRQ		;[351]
SS	FORTRAN,<POINTR (MODE,RM.FOR)>,1,FS.NFS!FS.NUE
SN	INDUSTRY,F.INDU,FS.NUE
SP	*KEY,FSTKEY,.SWDEC,KEY,FS.VRQ!FS.NFS
SL	*LABEL,F.LABL,LAB,LABSTANDARD,FS.NFS!FS.NUE
SP	LEAVES,NUMRCB,.SWDEC,ZRO,FS.NUE!FS.NFS!FS.VRQ	;[351]
SP	MAXTEMPFILES,MAXTMP,.SWDEC,ZRO,FS.NFS!FS.LRG	;[N20]
SS	*MERGE,MRGSW,1,FS.NUE!FS.NFS
SS	NOCRLF,NOCRLF,1,FS.NUE!FS.NFS			;[N11]
SS	*NUMERIC,<POINTR (MODE,RM.NUM)>,1,FS.NFS!FS.NUE
SS	PACKED,<POINTR (MODE,RM.PAC)>,1,FS.NFS!FS.NUE
SP	POSITION,F.POSI,POSIIN,ZRO,FS.NUE!FS.VRQ	;[C11]
SP	PRIORITY,PRIORI,.SWDEC,ZRO,FS.NFS!FS.LRG
SS	RANDOM,F.VARI,0,FS.NFS!FS.NUE
SP	*RECORD,RECORD,.SWDEC,REC,FS.VRQ!FS.NUE
SS	REWIND,F.REW,1,FS.NUE
SS	SEQUENTIAL,F.VARI,1,FS.NFS!FS.NUE
SS	SIGNED,<POINTR (MODE,RM.SGN)>,1,FS.NFS!FS.NUE
SS	*SIXBIT,<POINTR (MODE,RM.SIX)>,1,FS.NFS!FS.NUE
SS	STANDARD,F.STDA,1,FS.NUE
SN	STATISTICS,STATSW,FS.NFS!FS.NUE				;[C20]
SL	SUPPRESS,SUPFLG,SUP,SUPNONE,FS.NFS!FS.NUE!FS.VRQ	;[351]
SS	*TEMP,TEMPSW,1,FS.NUE!FS.NFS
SS	UNLOAD,F.UNL,1,FS.NUE
SS	*UNSIGNED,<POINTR (MODE,RM.UNS)>,1,FS.NFS!FS.NUE
SS	*VARIABLE,F.VARI,1,FS.NFS!FS.NUE
>
;NOW FOR KEYWORDS

KEYS	LAB,<STANDARD,OMITTED,NONSTANDARD,DEC,ANSI,IBM>
>;END IFE FTFORTRAN

KEYS	COL,<ASCII,EBCDIC,FILESPEC,LITERAL,ADDRESS>
KEYS	SUP,<NONE,INFORMATION,WARNING,FATAL,ALL>

IFE FTFORTRAN,<

;DEFAULT VALUES
DM	REC,^D4096,0,0
DM	KEY,377777,0,0
DM	COR,377777,0,0
DM	BLK,377777,0,0
DM	ZRO,0,0,0
;STILL IN IFE FTFORTRAN

XALL

DOSCAN	(SRTSW)

SALL

IF2,<PURGE ..TEMP,..TEMR>
SUBTTL	SCAN INTERFACE -- Switch Processors -- POSIIN

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,POSIIN)	;[C11]
	PUSHJ	P,.DECNW##		;[C11] GET A NUMBER
	JUMPGE	N,$1			;[C11] A BACKSPACE?
	MOVN	N,N			;[C11] YES, NEGATE
	TXO	N,1B1			;[C11] AND MARK AS BACKSPACE
$1%	RETURN				;[C11] DONE
END;
SUBTTL	SCAN INTERFACE -- Control Routines -- ALLOUT

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,ALLOUT)	;ALLOCATE OUTPUT FILE SPEC

;ALLOUT IS CALLED BY SCAN WHEN IT HAS FULLY PASSED OVER AN OUTPUT FILE SPEC
;(I.E., WHEN IT HAS DETECTED A ',', '=', OR EOL) AND NEEDS MEMORY IN WHICH TO
;STORE THE FILE SPEC PARAMETERS. WE LINK THE MEMORY BLOCK INTO THE OUTPUT LIST
;AT THE FRONT OF F.OUZR, COPY ALL OF SORT'S SWITCH ARGUMENTS INTO THE BLOCK,
;THEN RETURN THE ADDRESS OF SCAN'S PORTION OF THE BLOCK.
;
;RETURNS:
;	T1/	<ADDR OF SCAN'S PART OF S.xxxx BLOCK>
;	T2/	<LENGTH OF SCAN'S PART OF S.xxxx BLOCK>

	MOVE	T1,RECORD	;SEE IF SPECIFIED ON OUTPUT SIDE
	MOVEM	T1,RECOUT	;SAVE IN CASE DIFFERENT ON OUTPUT
	SETOM	RECORD		;SET INPUT SIZE AS NULL
	MOVX	T1,S.LEN	;TOTAL SPACE WE NEED
	PUSHJ	P,GETSPC	;GET IT
	  JRST	E$$NEC		;FAILED
	SETZM	S.SPC(T1)	;[OK] [212] ZERO POINTER TO NEXT BLOCK
	MOVE	T2,F.OUZR	;PREVIOUS BLOCK (OR 0)
	MOVEM	T2,0(T1)	;[OK] LINK
	MOVEM	T1,F.OUZR	;NEW BLOCK
	HRLZI	T2,F.SPC+1	;SWITCHES
	HRRI	T2,1(T1)	;[OK] BLT PTR
	MOVEI	T1,S.DEV(T1)	;[OK] END OF BLT + 1
	BLT	T2,-1(T1)	;[OK] COPY TO SAFE PLACE
	MOVEI	T2,S.SCNL	;LENGTH SCAN THINKS IT HAS
	RETURN
END;
SUBTTL	SCAN INTERFACE -- Control Routines -- ALLIN

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,ALLIN)	;ALLOCATE INPUT FILE SPEC

;ALLIN IS CALLED BY SCAN WHEN IT HAS FULLY PASSED OVER AN INPUT FILE SPEC (I.E.,
;WHEN IT HAS DETECTED A ',' OR EOL) AND NEEDS MEMORY IN WHICH TO STORE THE FILE
;SPEC PARAMETERS. WE LINK THE MEMORY BLOCK INTO THE INPUT LIST AT THE FRONT OF
;F.INZR, COPY ALL OF SORT'S SWITCH ARGUMENTS INTO THE BLOCK, THEN RETURN THE
;ADDRESS OF SCAN'S PORTION OF THE BLOCK.
;
;RETURNS:
;	T1/	<ADDR OF SCAN'S PART OF S.xxxx BLOCK>
;	T2/	<LENGTH OF SCAN'S PART OF S.xxxx BLOCK>

	MOVX	T1,S.LEN	;TOTAL SPACE WE NEED
	PUSHJ	P,GETSPC	;GET IT
	  JRST	E$$NEC		;FAILED
	SETZM	S.SPC(T1)	;[OK] [212] ZERO POINTER TO NEXT BLOCK
  IF A TEMP DEVICE
	SKIPGE	TEMPSW
	JRST	$T
  THEN LINK INTO TEMP CHAIN AT END
	MOVEI	T2,F.TMZR	;ADDRESS OF BLOCK
  $1%	HRL	T2,(T2)		;[OK] GET POINTER TO NEXT
	TLNN	T2,-1		;IS THERE A NEXT?
	JRST	$2		;NO
	HLRZ	T2,T2		;COPY IT
	JRST	$1		;TRY AGAIN
  $2%	HRRZS	T2		;[C20] LINK IN
	MOVEM	T1,(T2)		;[C20]   ..
	JRST	$F
  ELSE LINK INTO INPUT CHAIN AT FRONT
	MOVE	T2,F.INZR	;PREVIOUS BLOCK (OR 0)
	MOVEM	T2,0(T1)	;[OK] LINK
	MOVEM	T1,F.INZR	;NEW BLOCK
  FI;
	HRLZI	T2,F.SPC+1	;SWITCHES
	HRRI	T2,1(T1)	;[OK] BLT PTR
	MOVEI	T1,S.DEV(T1)	;[OK] END OF BLT + 1
	BLT	T2,-1(T1)	;[OK] COPY TO SAFE PLACE
	MOVEI	T2,S.SCNL	;LENGTH SCAN THINKS IT HAS
	RETURN
END;
SUBTTL	SCAN INTERFACE -- Switch Handling -- /PRIORITY:n

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,STRSWT)

;STRSWT IS THE USER-EXIT ROUTINE FOR SWITCH PROCESSING. ALL SWITCHES DEFINED IN
;THE SWTCHS MACRO WITHOUT THE FS.NUE FLAG CAUSE SCAN TO TRANSFER HERE AFTER THE
;FIRST SWITCH ARGUMENT HAS BEEN READ. THUS, ALL OF SORT'S MORE COMPLEX SWITCHES
;ARE HANDLED HERE. WE SIMPLY BRANCH TO THE PROPER SWITCH ROUTINE.

	HRRZ	T1,T2		;GET STORAGE LOCATION
	CAIN	T1,FSTKEY	;WAS IT /KEY?
	PJRST	USRKEY		;YES
	CAIN	T1,PRIORI	;WAS IT /PRIORITY?
	PJRST	USRPRI		;YES
	CAIN	T1,F.FMT	;WAS IT /FORMAT?
	PJRST	USRFMT		;YES
	CAIN	T1,COLSW	;WAS IT /COLLATE:
	JRST	USRCOL		;YES
	CAIN	T1,MAXTMP	;[N20] WAS IT /MAXTEMPFILES?
	JRST	USRMTF		;[N20] YES
E$$SSE:	$ERROR	(?,SSE,<Switch scanning error>)
END;

BEGIN
  PROCEDURE	(PUSHJ	P,USRPRI)	;STORE THE /PRIORITY SWITCH
	MOVM	T1,N		;GET MAGNITUDE
	CAILE	T1,3		;ALLOW -3 TO +3 ONLY
	JRST	E$$PRI
	MOVEM	N,PRIORI	;STORE IT
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,USRMTF)	;[N20] STORE THE /MAXTEMPFILES SWITCH
	MOVE	T1,N		;[N20] GET MAGNITUDE
	CAIL	T1,3		;[N20] ALLOW 3 TO
	CAILE	T1,MX.TMP	;[N20] MAX. FILES
	JRST	E$$MTE		;[N20]
	SKIPE	XCHNO.		;[N20] UNLESS NO EXTRA CHANNELS
	JRST	$1		;[N20]
	CAILE	T1,MX.T15	;[N20] IN WHICH CASE ONLY ALLOW ORIGINAL 15
	JRST	E$$MTE		;[N20]
  $1%	MOVEM	N,MAXTMP	;[N20] STORE IT
	RETURN			;[N20]
END;
SUBTTL	SCAN INTERFACE -- Switch Handling -- /KEY:n:m:x

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,USRKEY)	;STORE THE /KEY VALUES
	MOVE	T2,MODE		;GET MODE
	SKIPE	T1,LSTKEY	;PTR TO PREVIOUS KEY
	MOVEM	T2,KY.MOD(T1)	;[OK] STORE MODE FOR PREV KEY
	MOVX	T1,KY.LEN	;GET SPACE
	PUSHJ	P,GETSPC	; TO HOLD SWITCH
	  JRST	E$$NEC		;FAILED
  IF	FIRST TIME
	SKIPE	FSTKEY		;FIRST TIME
	JRST	$T
  THEN
	MOVEM	T1,FSTKEY	;INITIALIZE LIST
	JRST	$F
  ELSE
	MOVE	T2,LSTKEY	;[C20] CHAIN INTO LIST
	MOVEM	T1,(T2)		;[C20]   ..
  FI;
	MOVEM	T1,LSTKEY	;POINT TO NEW END
	SETZM	KY.NXT(T1)	;[OK] CLEAR FORWARD POINTER
	SOJL	N,E$$KOR	;CHECK FOR INVALID RELATIVE TO 0
	MOVEM	N,KY.INI(T1)	;[OK] STORE INITIAL BYTE
	CAIE	C,":"		;LENGTH TO FOLLOW
	JRST	E$$KLR		;ERROR
	PUSHJ	P,.DECNW	;GET IT
	JUMPE	N,E$$KLR	;ZERO IS NOT VALID EITHER
	MOVE	T1,LSTKEY	;POINT TO BLOCK
	MOVEM	N,KY.SIZ(T1)	;[OK] STORE LENGTH
;**;[517] Change 1 Line at USRKEY+26		DMN	22-Jun-83
	MOVX	T2,RM.ASC!RM.SIX!RM.EBC!RM.BIN!RM.FOR	;[517]
	ANDM	T2,MODE		;ONLY BITS WE CARE ABOUT
;**;[506] Insert 1 Line after USRKEY+28 Lines	PY	13-Sep-82
	ANDM	T2,MODEM	;[506] CLEAR THE MASK TOO
	SETZM	KY.ORD(T1)	;[OK] SET DEFAULT TO BE ASCENDING
	CAIE	C,":"		;ORDER FOLLOWING?
	RETURN
	PUSHJ	P,.SIXSW	;YES, GET IT
	LSH	N,-^D30		;RIGHT JUSTIFY
	MOVE	T1,LSTKEY	;POINT TO KEY BLOCK
	SKIPE	N		;DEFAULT IS ASCENDING
	CAIN	N,'A'		;ASCENDING?
	RETURN			;YES
	CAIE	N,'D'		;DESCENDING?
	JRST	E$$KAI		;ERROR
	SETOM	KY.ORD(T1)	;[OK] CHANGE TO DESCENDING
	RETURN
END;
>;END IFE FTFORTRAN
SUBTTL	SCAN INTERFACE -- Switch Handling -- /COLLATE:x[:y]

IFE FTFORTRAN,<

BEGIN
  PROCEDURE	(PUSHJ	P,USRCOL)
	SKIPE	COLSW		;HERE BEFORE
	JRST	E$$MCS		;YES, HERE BEFORE ONLY ONE ALT SEQ ALLOWED
	HRLI	N,(IFIW)	;[C20]
	MOVEM	N,COLSW		;STORE THE INDEX
	HRRZS	N		;[C20]
	CAIN	N,COLFILE	;CHECK FOR SPECIAL EXTERNAL FILE SPEC.
	JRST	COLEFS		;CALL THE FILE ROUTINE
	CAIN	N,COLLIT	;CHECK FOR IN-CORE LITERAL
	JRST	COLICL		;CALL THE LITERAL ROUTINE
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,COLEFS)
	CAIE	C,":"			;STOP ON A COLON
	JRST	E$$CFS			;BAD COLLATING SEQUENCE FILE SPEC.
	MOVE	T1,[F.NAM##-1,,COLSCN+S.DEV] ;[355] F.DEV=F.NAM-1 BUT NOT GLOBAL IN SCAN
	BLT	T1,COLSCN+S.LEN-1	;[355] SAFE PLACE TO STORE CURRENT FILE SPEC
	PUSHJ	P,.FILIN##		;[355] SCAN THE FILE SPEC
	AOJN	T1,E$$CFS		;[355] SCAN RETURNS -1 IF FILE SPEC FOUND
;**;[504] @COLEFS) + 7L.  Replace 1 line.	GCS	8-Jul-82
	MOVEI	T2,S.SCNL		;[504] SOJG COUNT TO EXCH FILE SPECS
;**;[512] @COLEFS) + 9L,  Replace 3 lines.	GCS	1-Nov-82
	MOVE	T1,F.NAM##-2(T2)	;[512] GET COLLATE FILE SPEC WORD
	EXCH	T1,COLSCN+S.DEV-1(T2)	;[512] EXCHANGE WITH WAITING SPEC
	MOVEM	T1,F.NAM##-2(T2)	;[512]   ..
	SOJG	T2,.-3			;[C20] [355] LOOP FOR ALL OF FILE SPEC
	MOVX	T1,'DSK   '		;[355] DEFAULT TO DSK: IF FILIN. GAVE
	SKIPN	S.DEV+COLSCN		;[355]   NO DEVICE
	MOVEM	T1,S.DEV+COLSCN		;[355]   ..
	RETURN				;[355] DONE
END;

BEGIN
  PROCEDURE	(PUSHJ	P,COLICL)
	CAIE	C,":"		;STOP ON A COLON?
	JRST	E$$CLS		;ERROR
	PUSHJ	P,.TIALT##	;GET THE NEXT CHAR.
	PUSHJ	P,.TISQT##	;SET IT AS THE QUOTE CHAR.
	PUSHJ	P,.ASCQC##	;GET THE QUOTED STRING
	MOVE	T1,[.NMUL,,COLITB]	;STORE THE STRING
	BLT	T1,COLITB+.NMUE-.NMUL	;MINUS THE QUOTES
	SETZM	COLITB+.NMUE-.NMUL+1	;GUARANTEE A NUL AT THE END
	RETURN
END;

>;END IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,COLTRX)
	SETZ	T4,			;[355] INDICATE INPUT FILE TO STOPB
	MOVEI	U,COLSCN		;[355]   AND SCAN BLOCK
	PUSHJ	P,STOPB			;[355] CONVERT SCAN BLOCK TO X. BLOCK
	PUSHJ	P,GETCHN		;[C19] GET A WORKING CHANNEL
	  JRST	E$$NEH			;[C19] FAILED
	MOVEM	T1,COLCHN		;[355] SAVE CHANNEL #
	HRL	T1,COLCHN		;[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
	MOVX	T1,.IODMP		;[355] USE DUMP MODE FOR COLLATE FILE
	MOVEM	T1,FLPARG+.FOIOS	;[C19] STORE IT
	MOVE	T1,X.OPN+1(P1)		;[OK] [C19] GET DEVICE
	MOVEM	T1,FLPARG+.FODEV	;[C19] STORE IT
	SETZM	FLPARG+.FOBRH		;[C19] NO BUFFERS
	SETZM	FLPARG+.FONBF		;[C19]   ..
	HRRZI	T1,X.RIB(P1)		;[OK] [C19] GET LOOKUP BLOCK ADDRESS
	MOVEM	T1,FLPARG+.FOLEB	;[C19] STORE IT
	MOVE	T1,[.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,COLCHN		;[N17] INCASE WE HAD AN EXTENDED CHAN
	MOVE	T3,[IOWD 200,COLITB]	;MAKE AN IOWD TO READ THE FILE
	MOVEM	T3,COLPTR		;STORE IOWD
	SETZM	COLPTR+1		;TERMINATE
	SETZM	COLPTR+2		;CLEAR BYTE POINTER
	SETZM	COLPTR+3		;CLEAR BYTE COUNTER
	MOVE	T1,[IFIW COLBUF]	;[C20] GET THE ALT SEQ TABLE
	MOVEM	T1,COLSW		;STORE THE ADDRESS OF THE TABLE
	MOVEI	T2,COLCHR		;ADDRESS OF THE INPUT ROUTINE
	PUSHJ	P,BLDCOL		;BUILD THE TABLE
	  JRST	E$$ICS			;ILLEGAL COLLATING SEQUENCE SPECIFIED
	MOVE	T1,COLCHN		;[C19] RELEASE CHANNEL
	PUSHJ	P,RELCHN		;[C19]   ..
	RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,COLCHR)
	SOSGE	COLPTR+3	;REDUCE THE BYTE COUNT
	JRST	$1		;GET A BUFFER
;**;[500] @COLCHR + 3L  Replace 2 lines.  GCS  13-APR-82
	IBP	COLPTR+2	;[500] POINT TO NEXT BYTE
	MOVE	T1,@COLPTR+2	;[500] GET WORD
	TRNE	T1,1		;CHECK FOR SEQUENCE NUMBER
	JRST	[AOS	COLPTR+2	;IT IS
		MOVNI	T1,5
		ADDM	T1,COLPTR+3	;ACCOUNT FOR 5 BYTES
		JRST	COLCHR]		;LOOP BACK
;**;[500] @COLCHR + 11L  Replace 1 line.   GCS   13-APR-82
	LDB	T1,COLPTR+2	;[500] GET A BYTE
	CAIG	T1," "		;IGNORE SPACE AND ALL CONTROL CHARACTERS
	JRST	$B		;GET THE NEXT CHARACTER
	JRST	CPOPJ1		;SKIP RETURN, T1=CHAR

  $1%
  IF 7-SERIES MONITOR
	SKIPN	M7.00			;[N12] 7-SERIES?
	JRST	$T			;[N12] NO
  THEN USE FILOP. FOR ALL I/O
	HRLZ	T1,COLCHN		;[N12] GET CHANNEL
	HRRI	T1,.FOINP		;[N12] INPUT FUNCTION
	MOVEM	T1,FLPARG+.FOFNC	;[N12] TWO ARGS FOR DUMP MODE
	MOVEI	T1,COLPTR		;[N12] ADDRESS OF IOWD
	MOVEM	T1,FLPARG+.FOIOS	;[N12]
	MOVE	T1,[2,,FLPARG]		;[N12]
	FILOP.	T1,			;[N12]
	  JRST	$2			;[N12] ERROR, T1 = STATUS
	JRST	$F			;[N12] OK
  ELSE USE OLD I/O UUOs
	MOVE	T1,COLCHN		;[C20] GET THE CHANNEL NUMBER
	LSH	T1,27			;[C20] [C19]   ..
	IOR	T1,[IN 0,COLPTR]	;[OK]
	XCT	T1			;[C20]
	  JRST	$F			;UNEVENTFUL INPUT !
	TLC	T1,(<IN>^!<GETSTS>)
	HRRI	T1,T1			;FORM [GETSTS  CHN,T1]
	XCT	T1			;RETRIEVE FILE STATUS
  $2%	TXNN	T1,IO.ERR		;[N12] I/O ERRORS ?
	RETURN				;NO, MUST BE END OF FILE
	PUSH	P,T1			;SAVE STATUS
	JRST	E$$IRE			;[353] PRINT REASON FOR ERROR
  FI;

	MOVE	T1,COLPTR	;GET THE BUFFER ADDRESS
	HRLI	T1,(POINT 7,0,35)	;MAKE AN ASCII BYTE POINTER
	MOVEM	T1,COLPTR+2	;STORE NEW BYTE POINTER
	MOVEI	T1,200*5	;NUMBER OF CHARACTERS/BUFFER
	MOVEM	T1,COLPTR+3	;STORE
	JRST	$B		;GET THE NEXT CHARACTER
END;

SUBTTL	TYPE-IN ROUTINES -- Format Descriptor

IFE FTFORTRAN,<

BEGIN
  PROCEDURE	(PUSHJ	P,.SWASF)
;.SWASF -- INPUT ASCII MULTIPLE WORD
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;FOR THIS ROUTINE PERIOD IS CONSIDERED TO BE ALPHA-NUMERIC
;THROWS AWAY ANY CHARACTERS BEYOND THE BUFFER
;	RETURN WITH STRING IN .NMUL
;USES T1	UPDATES C (SEPARATOR)

	PUSHJ	P,.TIALT##	;PRIME THE PUMP
	SETZM	.NMUL##		;CLEAR ACCUMULATOR
	MOVE	T1,[.NMUL##,,.NMUL##+1]
	BLT	T1,.NMUE##	; ..
	HRROI	T1,.TSTRG##	;SET ASCII STRING FORMAT
	MOVEM	T1,.LASWD##	; FOR ERROR PRINTING
	MOVE	T1,[POINT 6,.NMUL##]	;INITIALIZE BYTE POINTER

  $1%	PUSHJ	P,.TICAN##	;SEE IF LEGITIMATE ALPHA-NUMERIC
	  JRST	$3		;NO--MAY BE DONE
	CAIL	C,"A"+40	;[432] IS THE ARGUMENT
	CAILE	C,"Z"+40	;[432] LOWERCASE
	FASTSKIP		;[432] NO.
	SUBI	C,40		;[432] YES. MAKE UPPER.
  $2%	SUBI	C,40		;CONVERT TO SIXBIT
	CAME	T1,[POINT 6,.NMUE##,35]	;SEE IF OVERFLOW
	IDPB	C,T1		;NO--STORE
	PUSHJ	P,.TIALT##	;GET NEXT CHARACTER
	JRST	$1		;LOOP BACK TO PROCESS IT

  $3%	CAIE	C,"."		;IF PERIOD?
	POPJ	P,		;NO--DONE
	JRST	$2		;YES--CONTINUE SCAN
END;
>;END IFE FTFORTRAN
SUBTTL	TYPE-IN ROUTINES -- Formal FORTRAN arguments

IFE FTFORTRAN,<

BEGIN
  PROCEDURE	(PUSHJ	P,.SWFOR)

;.SWFOR -- INPUT FORMAL FORTRAN ARGUMENT
;AS EITHER AN OCTAL ADDRESS OR AN ARGUMENT NUMBER WHEN PREFIXED BY "^"

	PUSHJ	P,.TIALT##	;[C20] GET A CHAR
	CAIE	C,"^"		;[C20] AN ARGUMENT?
	PJRST	.OCTNC##	;[C20] NO, JUST GET AN OCTAL NUMBER
	PUSHJ	P,.DECNW##	;[C20] YES, GET THE ARGUMENT NUMBER
	CAILE	N,1		;[C20] IS IT IN RANGE?
	CAMLE	N,FORCNT	;[C20]   ..
	JRST	E$$FEA		;[C20] NO
	ADD	N,FORARG	;[C20] ADD IN BASE
	XMOVEI	N,@-1(N)	;[C20] GET ACTUAL
	RETURN			;[C20]
END;

>;END IFE FTFORTRAN
SUBTTL	PSORT. -- SETTMP - Set up Temporary Files

BEGIN
  PROCEDURE	(PUSHJ	P,SETTMP)
	;THIS LIST IS STORED IN FORWARD ORDER
  IF NO TEMP DEVICES SPECIFIED
	SKIPE	U,F.TMZR
	JRST	$T
  THEN USE DSK
	MOVSI	T1,'DSK'
	MOVEM	T1,STRNAM+0		;PUT IN FIRST SLOT
	AOS	STRNUM			;COUNT ONE TEMP DEVICE
	SETOM	STRDEF			;[214] REMEMBER THAT WE DEFAULTED TO DSK:
	JRST	$F
  ELSE COPY FIRST MAXTMP FROM LIST
	SETZ	T2,			;[C20] SETUP INDEX
  $1%	SKIPE	S.NAME(U)		;[214] DID USER SPECIFY FILNAM/TEMP?
	JRST	E$$FNT			;[214] YES--DIE
	MOVE	T3,S.DEV(U)		;GET DEVICE
	MOVEM	T3,STRNAM(T2)		;[OK] PUT IN LIST
	DEVCHR	T3,
	JUMPE	T3,E$$DNE		;NON-EXISTENT DEVICE
	TXZ	T3,DVCHMD		;[215] CLEAR MODE BITS
	CAXE	T3,DVCHNL		;[215] IF NUL:, NOT A DISK
	TXNN	T3,DV.DSK		;[215] ONLY ALLOW .TMP FILES ON DISK
	JRST	E$$DND			;NO
	AOS	STRNUM			;COUNT ONE MORE
	HRRZ	U,(U)			;[C20] GET NEXT
	JUMPE	U,$F			;[C20] ALL DONE
	CAMG	T2,MAXTMP		;[N20] [C20] TOO MANY
	AOJA	T2,$1			;[C20] NO, LOOP AROUND
 	PUSHJ	P,E$$TMT		;[N20] WARN USER
  FI;
	RETURN
END;
SUBTTL	PSORT. -- PRUNE - Prune Null SCAN Blocks from I/O Lists

BEGIN
  PROCEDURE	(PUSHJ	P,PRUNE)
	MOVE	U,F.OUZR	;DO OUTPUT FIRST
	MOVEI	T1,F.OUZR	;[C20]
	PUSHJ	P,PRUNEL	;[214] PRUNE OUTPUT LIST
	SKIPN	F.OUZR		;[214] IS OUTPUT LIST NOW NULL?!
	JRST	E$$ONS		;[214] YES--ERROR
	MOVE	U,F.INZR	;NOW FOR INPUT
	MOVEI	T1,F.INZR	;[C20]
	PUSHJ	P,PRUNEL	;[214] PRUNE INPUT LIST
	SKIPN	F.INZR		;[214] IS INPUT LIST NOW NULL?!
	JRST	E$$INS		;[214] YES--ERROR
	RETURN
END;


BEGIN
  PROCEDURE	(PUSHJ	P,PRUNEL)	;[214] PRUNE NULL SCAN BLOCKS FROM LIST
;	U/	<ADDR OF FIRST BLOCK>
;	T1/	<ADDR OF LIST HEADER>
  FOR ALL INPUT FILES DO
	BEGIN
		TRNN	U,-1		;[214] AT END?
		JRST	$E		;[214] YES--QUIT
		MOVE	T2,S.MOD(U)	;[C20] [214] DEVICE NOT SPECIFIED?
		TXNE	T2,FX.NDV	;[C20] [214]   ..
		SKIPE	S.NAME(U)	;[214]   OR NO FILE NAME?
		JRST	$1		;NO, OK
		MOVE	T2,S.SPC(U)	;[C20] GET NEXT
		EXCH	U,T1		;[C20] GET PREVIOUS AND REMEMBER IT
		MOVEM	T2,S.SPC(U)	;[C20] FORGET ABOUT THIS
	  $1%	HRRZ	T1,S.SPC(U)	;[C20] GET NEXT
		EXCH	U,T1		;[C20]
		TRNE	U,-1		;AT END?
		JRST	$B		;NOT YET
	END;
	RETURN
END;
SUBTTL	PSORT. -- SETUPO - Set Up Output Files

BEGIN
  PROCEDURE	(PUSHJ	P,SETUPO)	;SET UP THE OUTPUT SPECS

;SETUPO IS CALLED BY PSORT. FOLLOWING CALLS TO SCAN TO READ THE USER'S COMMAND.
;WE ARE CONCERNED HERE ONLY WITH VERIFYING THE GOODNESS OF THE FILE SPECS IN THE
;LIST AT F.OUZR (SET UP BY ALLOUT DURING THE COMMAND SCANNING), AND STORING
;COMMAND INFORMATION FOR LATER. ACTUAL INITIALIZATION OF THE FILE IS PERFORMED
;IN INIOUT, DURING THE SORT OR MERGE.
;
;THERE ARE TWO OPERATIONS PERFORMED HERE. FIRST, THE FILE SPEC LIST IS SCANNED,
;CREATING OM.xxx BLOCKS FOR *EVERY* SPEC IN THE LIST. ALL BUT THE FIRST FILE
;SPEC (LAST IN THE LIST) MUST BE A MAGTAPE. THEN, THE FIRST SPEC IS HANDLED IN
;DETAIL, BY CALLING STOPB. WHEN PROCESSING IS COMPLETED HERE, THE S.xxxx BLOCKS
;HAVE BEEN DELETED FROM THE F.OUZR LIST, AND REPLACED WITH AN X.xxxx BLOCK WHICH
;HAS A LIST OF THE OM.xxx BLOCKS ATTACHED.

	SKIPN	U,F.OUZR		;GET LIST PTR
	JRST	E$$ONS
	SETZM	F.OUZR			;CLEAR IT
  WHILE FILE SPEC BLOCKS TO LOOK AT
	BEGIN
		MOVX	T1,OM.LEN		;[215] ALLOCATE OUTPUT MAGTAPE BLOCK
		PUSHJ	P,GETSPC		;[215]   ..
		  JRST	E$$NEC			;FAILED
		MOVE	T2,F.OUZR		;[215] LINK INTO FRONT OF LIST
		MOVEM	T2,OM.NXT(T1)		;[OK] [215]   ..
		MOVEM	T1,F.OUZR		;[215]   ..
		MOVE	T3,S.DEV(U)		;[215] REMEMBER DEVICE
		MOVEM	T3,OM.DEV(T1)		;[OK] [215]   ..
		DEVCHR	T3,			;[215] GET DEVICE CHARACTERSTICS
		JUMPE	T3,E$$DNE		;[215] DEVICE DOES NOT EXIST
		TXZ	T3,DVCHMD		;[215] CLEAR I/O MODE BITS
		SKIPN	S.SPC(U)		;[215] DONE IF FIRST SPEC
		JRST	$E			;[215] YES--EXIT LOOP
		CAXE	T3,DVCHNL		;[215] IF NUL:, NOT A MAGTAPE
		TXNN	T3,DV.MTA		;[215] NOW CHECK IF REALLY A MAGTAPE
		JRST	E$$MOM			;[215] MULTIPLE OUTPUT FILES MUST BE TAPES
		HRRZ	U,S.SPC(U)		;[C20] [215] ADVANCE TO NEXT SPEC
		JRST	$B			;[215] CONTINUE
	  END;
	SETO	T4,			;[353] INDICATE OUTPUT FILE SPEC
	PUSHJ	P,STOPB			;[353]   TO SCAN BLOCK CONVERTER
	MOVE	T1,F.OUZR		;[215] LINK TO FRONT OF DEVICE LIST
	MOVEM	T1,X.NXT(P1)		;[OK] [215]   ..
	MOVEM	P1,F.OXBK		;[215]   ..
	RETURN
END;
SUBTTL	PSORT. -- SETUPI - Set Up Input Files

BEGIN
  PROCEDURE	(PUSHJ	P,SETUPI)	;SET UP ALL INPUT SPECS

;SETUPI IS CALLED BY PSORT. FOLLOWING CALLS TO SCAN TO READ THE USER'S COMMAND.
;WE ARE CONCERNED HERE ONLY WITH VERIFYING THE GOODNESS OF THE FILE SPECS IN THE
;LIST AT F.INZR (SET UP BY ALLIN DURING THE COMMAND SCANNING), AND STORING
;COMMAND INFORMATION FOR LATER. ACTUAL INITIALIZATION OF THE FILE IS PERFORMED
;IN INIINP, DURING THE SORT OR MERGE.
;
;WE LOOP OVER EVERY FILE SPEC IN THE LIST AT F.INZR, CREATING X.xxxx BLOCKS FOR
;EACH SPEC IN THE LIST BY THE CALL TO STOPB. WHEN PROCESSING IS COMPLETED HERE,
;THE S.xxxx BLOCKS HAVE BEEN DELETED FROM THE F.OUZR LIST, AND REPLACED WITH A
;LIST OF X.xxxx BLOCKS. SINCE F.INZR WAS IN REVERSE ORDER TO BEGIN WITH, WE
;FINISH WITH THE X.xxxx BLOCK LIST IN FORWARD ORDER.

	SKIPN	U,F.INZR		;GET LIST PTR
	JRST	E$$INS			;MUST BE INPUT FILE
	SETZM	F.INZR			;CLEAR PTR
  WHILE FILE SPEC BLOCKS TO LOOK AT
	BEGIN
		AOS	NUMINP			;[215] COUNT INPUT FILE
		SETZ	T4,			;[353] INDICATE INPUT FILE SPEC
		PUSHJ	P,STOPB			;[353]   TO SCAN BLOCK CONVERTER
		MOVE	T1,F.INZR		;[353] GET PREVIOUS BLOCK
		MOVEM	T1,X.NXT(P1)		;[OK] [353]
		MOVEM	P1,F.INZR		;SAVE THIS
		HRRZ	U,(U)			;[C20] GET NEXT BLOCK
		JUMPN	U,$B			;[C20] TRY NEXT
	END;
	RETURN				;[215] END OF INPUT LIST
END;
SUBTTL	PSORT. -- STOPB - Convert SORT/SCAN To OPEN/ENTER/PATH Blocks

BEGIN
  PROCEDURE	(PUSHJ	P,STOPB)	;[353] CONVERT SCAN TO OPEN BLOCKS

;STOPB ALLOCATES AN X.xxxx BLOCK THEN CONVERTS A SORT/SCAN BLOCK TO THE OPEN,
;LOOKUP/ENTER AND PATH BLOCKS IN THE X.xxxx BLOCK. THIS CODE IS VERY SIMILAR TO
;THE CODE IN .STOPB IN SCAN.MAC, BUT SORT SWITCHES ARE ALSO HANDLED.
;
;CALLING SEQUENCE:
;	T4/	<0 IF INPUT, -1 IF OUTPUT>
;	U/	<ADDR OF SORT/SCAN BLOCK>
;RETURNS:
;	U/	(UNCHANGED)
;	P1/	<ADDR OF NEW X.xxxx BLOCK>

	MOVX	T1,LN.X			;[353] ALLOCATE NEW X.xxxx BLOCK
	PUSHJ	P,GETSPC		;[353]   ..
	  JRST	E$$NEC			;[353]
	MOVE	P1,T1			;[353] PUT WHERE WE WILL REMEMBER IT

;BUILD THE OPEN BLOCK.
	MOVE	T1,S.MOD(U)		;[353] GET SCAN'S MODE WORD
	LDB	T2,[POINTR (T1,FX.DEN)]	;[353] GET DENSITY FOR TAPE
	MOVEM	T2,X.DEN(P1)		;[OK] [353] SAVE FOR TAPOP. IN INIINP
	LSH	T2,^D35-<POS (IO.DEN)>	;[353] PUT IN POSITION FOR OPEN UUO
	ANDX	T2,IO.DEN		;[353] CLEAR 1600, 6250 BITS
	TXNE	T1,FX.PHY		;[353] /PHYSICAL TYPED?
	TXO	T2,UU.PHS		;[353] YES--SET PHONLY BIT
	TXNE	T1,FX.PAR		;[353] /PARITY:EVEN TYPED?
	TXO	T2,IO.PAR		;[353] YES--PRESERVE IN OPEN BLOCK
	HRRZ	T3,IOMODE		;[353] COMPUTE MODE FOR OPEN UUO
	OR	T2,[EXP .IOBIN,.IOASC,.IOBIN,.IOBIN]-1(T3) ;[OK] [353]   ..
	SKIPE	T4			;[353] OUTPUT FILE?
	TXO	T2,UU.IBC		;[353] YES--INHIBIT BUFFER CLEAR
	MOVEM	T2,X.OPN+.OPMOD(P1)	;[OK] [353] STORE IN OPEN BLOCK
	MOVE	T1,S.DEV(U)		;[353] GET DEVICE
	MOVEM	T1,X.OPN+.OPDEV(P1)	;[OK] [353]   ..

;GET DEVICE CHARACTERISTICS.
	DEVCHR	T1,			;[353] GET DEVICE CHARACTERISTICS
	JUMPE	T1,E$$DNE		;[353] NON-EXISTENT DEVICE
	TXZ	T1,DVCHMD		;[353] CLEAR I/O MODE BITS
	MOVEM	T1,X.DVCH(P1)		;[OK] [353] SAVE CHARACTERISTICS

;SET EBCDIC MAGTAPE DEFAULTS
IFE FTFORTRAN,<
  IF WE HAVE AN EBCDIC MAGTAPE
;	MOVE	T1,X.DVCH(P1)		;[OK] [C09] GET DEVICE TYPE
	CAXE	T1,DVCHNL		;[C09] IF NUL:, NOT A MAGTAPE
	TXNN	T1,DV.MTA		;[C09] NOW CHECK IF REALLY A TAPE
	JRST	$F			;[C09] NO
	MOVX	T1,RM.EBC		;[C09] EBCDIC?
	TDNN	T1,MODE			;[C09]  ..
	JRST	$F			;[C09] NO
  THEN SET DEFAULTS
	MOVEI	T1,1			;[C09] /BLOCKED:0?
	SKIPG	S.BLKF(U)		;[C09]  ..
	MOVEM	T1,S.BLKF(U)		;[C09] YES, MAKE /BLOCKED:1
	MOVEI	T1,1			;[C09] FORCE /INDUSTRY
	MOVEM	T1,S.INDU(U)		;[C09]  ..
  FI;
>

;COMPUTE BUFFER SIZE.
IFE FTFORTRAN,<
  IF WE HAVE A MAGTAPE
	MOVE	T1,X.DVCH(P1)		;[OK] [C09] GET DEVICE TYPE
	CAXE	T1,DVCHNL		;[353] IF NUL:, NOT A MAGTAPE
	TXNN	T1,DV.MTA		;[353] NOW CHECK IF REALLY A TAPE
	JRST	$T			;[353] NO
  THEN COMPUTE BLOCKING FACTOR
	PUSHJ	P,SETMTA		;[353] GO FIND BLOCKING FACTOR
	  FASTSKIP			;[353] NOT BLOCKED
	JRST	$F			;[353] BLOCKED--BUFFER SIZE IN T2
  ELSE ASK MONITOR FOR DEFAULT
>
	MOVEI	T2,X.OPN(P1)		;[OK] [353] SET UP FOR DEVSIZ
	DEVSIZ	T2,			;[353] FIND OUT DEFAULT
	  MOVEI	T2,.TBS			;[353] NONE--USE DISK'S
IFE FTFORTRAN,<
  FI;
>
	HRRZM	T2,X.DVSZ(P1)		;[OK] [353] BUFFER SIZE
	HRRZ	T2,T2			;[353] GET JUST BUFFER SIZE
	CAMLE	T2,MXDVSZ		;[353] BIGGEST YET?
	MOVEM	T2,MXDVSZ		;[353] YES

;BUILD THE LOOKUP/ENTER AND MAYBE PATH. BLOCK.
	MOVX	T1,.RBALC		;[353] INITIALIZE LOOKUP/ENTER BLOCK
	MOVEM	T1,X.RIB+.RBCNT(P1)	;[OK] [353]   ..
	MOVE	T1,S.NAME(U)		;[353] GET FILE NAME
  	MOVEM	T1,X.RIB+.RBNAM(P1)	;[OK] [353] STORE FILE NAME
	DMOVE	T1,S.EXT(U)		;[353] GET EXTENSION & MOD WORD
	HLLZM	T1,X.RIB+.RBEXT(P1)	;[OK] [353] JUST SAVE EXTENSION
	MOVE	T1,S.DIR(U)		;[353] GET PPN
  IF DIRECTORY WE BUILD INDICATES SFD'S
	TXNN	T2,FX.DIR		;[353] DIRECTORY SPECIFIED
	JRST	$F			;[353] NO OR [-], USE 0
	TLNN	T1,-1			;[353] CHECK FOR [,PN]
	HLL	T1,MYPPN		;[353] FILL IN LHS
	TRNN	T1,-1			;[353] CHECK FOR [P,]
	HRR	T1,MYPPN		;[353] FILL IN RHS
	SKIPN	S.SFD(U)		;[353] SFD'S SPECIFIED?
	JRST	$F			;NO
  THEN COPY THEM AND SET UP PATH. BLOCK
	MOVEM	T1,X.PTH+.PTPPN(P1)	;[OK] [353] STORE PATH POINTER
	MOVEI	T2,X.PTH+.PTSFD(P1)	;[C20] [353] FIRST IN PATH. BLOCK
	MOVEI	T3,S.SFD(U)		;[353] FIRST IN S.xxxx BLOCK
	PUSH	P,T4			;[C20] SAVE T4
	MOVEI	T4,.FXLND		;[C20] MAX # OF SFD'S
  WHILE SFD'S TO COPY
	BEGIN
		MOVE	T1,(T3)			;[OK] [353] GET IT
		MOVEM	T1,(T2)			;[OK] [353] STORE IT
		ADDI	T2,1			;[C20] ADVANCE
		ADDI	T3,2			;[353] ADVANCE
		SOJG	T4,$B			;[C20] [353] LOOP
	END;
	POP	P,T4			;[C20] RESTORE T4
	MOVEI	T1,X.PTH(P1)		;[OK] [353] STORE PATH. POINTER INSTEAD OF PPN
  FI;
	MOVEM	T1,X.RIB+.RBPPN(P1)	;[OK] [353] STORE POINTER OR PPN
  IF THIS IS AN OUTPUT FILE
	SKIPN	T4			;[353] CALLED WITH AN OUTPUT SPEC?
	JRST	$F			;[353] NO--NOTHING TO DO HERE
  THEN SET UP PROTECTION, /ESTIMATE, /VERSION, /ERSUPERCEDE
	MOVE	T1,S.PROT(U)		;[353] GET PROTECTION FIELD
	LSH	T1,<ALIGN. (RB.PRV)>	;[353]   IN PROPER PLACE
	MOVEM	T1,X.RIB+.RBPRV(P1)	;[OK] [353] STORE PROT, CLEAR DATES
	SETZM	X.RIB+.RBSIZ(P1)	;[OK] [353] CLEAR INITIAL FILE SIZE
	  IF USER GAVE A USEFUL /ESTIMATE
		SKIPG	T1,S.EST(U)		;[353] NON-ZERO NON-DEFAULT /EST?
;**;[510] @STOPB)+130 lines, Change some lines.	GCS	25-Oct-82
		JRST	$T			;[510][353]NOT SPECIFIED
	  THEN TURN INTO BLOCKS FOR ENTER
		ADDI	T1,177			;[353] ROUND UP TO DISK BLOCK
		LSH	T1,-<POW2(200)>		;[353]   ..
		MOVEM	T1,X.RIB+.RBEST(P1)	;[OK] [353] SAVE FOR ENTER
		JRST	$F			;[510]
	  ELSE CLEAR IT				;[510]
		SETZM	X.RIB+.RBEST(P1)	;[510]
	  FI;
	SETZM	X.RIB+.RBSPL(P1)	;[510] CLEAR OUT ANY JUNK.
	SETZM	X.RIB+.RBVER(P1)	;[510] CLEAR OUT ANY JUNK.
	SETCM	T1,S.VER(U)		;[353] COMPLEMENT SO WE CAN
	SKIPE	T1			;[353]   IGNORE IF -1 (SCAN DEFAULT)
	SETCAM	T1,X.RIB+.RBVER(P1)	;[OK] [353] STORE ORIGINAL IN MEMORY
  FI;

;REMEMBER SORT'S FILE SWITCHES.
	SKIPGE	T1,S.BLKF(U)		;[353] BLOCKING FACTOR SET?
	MOVE	T1,P.BLKF		;[353] NO--USE STICKY DEFAULT
	SKIPGE	T1			;[353] STILL NOT SET?
	SETZ	T1,			;[353] NO--ASSUME NO BLOCKING FACTOR
	MOVEM	T1,X.BLKF(P1)		;[OK] [353] STORE RESULT
	MOVE	T1,S.POSI(U)		;[C11] GET /POSITION: VALUE
	MOVEM	T1,X.POSI(P1)		;[OK] [C11] STORE RESULT
	SKIPGE	T4,S.LABL(U)		;[353] LABEL TYPE SPECIFIED TO SORT?
	MOVE	T4,P.LABL		;[353]   OR BY DEFAULT?
IFE FTFORTRAN,<
  IF THIS IS A TAPE MOUNTED WITH NON-BLP PULSAR LABEL PARAMETER
	MOVE	T3,[3,,T1]		;[353] READ PULSAR LABEL TYPE
	MOVX	T1,.TFLBL		;[353]   ..
	MOVE	T2,X.OPN+.OPDEV(P1)	;[OK] [353]   ..
	TAPOP.	T3,			;[353]   ..
	  JRST	$T			;[353] EITHER NO PULSAR OR NOT A TAPE
	CAXN	T3,.TFLBP		;[353] OR BYPASSING LABELS
	JRST	$T			;[353]   ..
	CAXN	T3,.TFLNL		;[C25]   ..
	JRST	$T			;[C25]   ..
	CAXN	T3,.TFLNV		;[C25]   ..
	JRST	$T			;[C25]   ..
  THEN SET AUTO-LABEL AND VERIFY SORT AND PULSAR /LABEL SWITCHES
	MOVX	T1,FI.ATO		;[353] START FILE FLAGS WITH AUTO-LABEL
	  IF SORT'S /LABEL SWITCH WAS SPECIFIED
		SKIPGE	T4			;[353] NON-NEGATIVE?
		JRST	$F			;[353] NO--NOT SPECIFIED
	  THEN MAKE SURE IT AGREES WITH PULSAR'S /LABEL
		CAIL	T3,LBLLEN		;[353] RANGE-CHECK AGAINST TABLE
		JRST	ERRUTL			;[353] MUST BE NEW LABEL TYPE
		CAME	T4,LBLTBL(T3)		;[OK] [353] SEE IF VALUES MATCH
		JRST	ERRLNL			;[353] NO--COMPLAIN
	  FI;
	JRST	$F			;[353] NOTHING ELSE TO DO
  ELSE REMEMBER LABEL TYPE TO HANDLE IN CASE THIS IS A TAPE
>
	SETZ	T1,			;[353] START FILE FLAGS WITH NO AUTO-LABEL
	SKIPG	T4			;[353] /LABEL SPECIFIED TO SORT?
	MOVX	T4,LABOMITTED		;[353] NO--DEFAULT TO /LABEL:OMITTED
	MOVEM	T4,X.LABL(P1)		;[OK] [353] REMEMBER WHAT LABEL TYPE TO DO
IFE FTFORTRAN,<
  FI;
>
	SKIPGE	T2,S.VARI(U)		;[353] VARIABLE LENGTH RECORDS?
	MOVE	T2,P.VARF		;[353]   OR BY DEFAULT
	SKIPLE	T2			;[353]   ..
	TXO	T1,FI.VAR		;[353] YES
	SKIPGE	T2,S.INDU(U)		;[353] INDUSTRY COMPATIBLE MODE?
	MOVE	T2,P.INDU		;[353]   OR BY DEFAULT?
	SKIPLE	T2			;[353]   ..
	TXO	T1,FI.IND		;[353] YES
	SKIPGE	T2,S.STDA(U)		;[353] STANDARD ASCII MODE
	MOVE	T2,P.STDA		;[353]   OR BY DEFAULT?
	SKIPLE	T2			;[353]   ..
	TXO	T1,FI.STA		;[353] YES
	SKIPLE	S.REW(U)		;[353] REWIND?
	TXO	T1,FI.REW		;[353] YES
	SKIPLE	S.UNL(U)		;[353] UNLOAD?
	TXO	T1,FI.UNL		;[353] YES
	MOVEM	T1,X.FLG(P1)		;[OK] [353] SAVE FLAG SETTINGS
	RETURN				;[353] DONE
END;

LBLTBL:	LABOMITTED			;[353] .TFLBP	BLP
	LABANSI				;[353] .TFLAL	ANSI
	LABANSI				;[353] .TFLAU	ANSI WITH USER LABELS
	LABIBM				;[353] .TFLIL	IBM
	LABIBM				;[353] .TFLIU	IBM WITH USER LABELS
	LABNONSTANDARD			;[353] .TFLTM	LEADING TAPE MARK
	LABNONSTANDARD			;[353] .TFLNS	NON-STANDARD
	LABOMITTED			;[353] .TFLNL	NO LABELS
	LABDEC				;[C25] .TFCBA	DEC COBOL ASCII
	LABDEC				;[C25] .TFCBS	DEC COBOL SIXBIT
	LABOMITTED			;[C25] .TFLNV	NO LABELS, USER EOV
LBLLEN==.-LBLTBL			;[353] LENGTH OF PULSAR-TO-SORT LABEL TABLE
SUBTTL	PSORT. -- SETMTA - Set Up Buffer Sizes for Magtapes

IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(PUSHJ	P,SETMTA)		;SET UP FOR MTA
	;HERE IF DEVICE IS A MAGTAPE
	;SET BUFFER SIZE IF FILE IS BLOCKED
	;RETURNS WITH
	;T2 = BUFFER SIZE IF BLOCKED MTA

  IF FILE IS BLOCKED
	SKIPG	S.BLKF(U)		;[C06] FILE BLOCKED?
	JRST	$F			;NO
  THEN
	HRRZ	T2,IOMODE		;[201] GET I/O MODE
	  CASE MODE OF SIXBIT,ASCII,EBCDIC,BINARY
		JRST	@[IFIWS <$1,$2,$3,$4>]-1(T2)	;[C20]

	  $1%	MOVE	T2,RECSIZ		;SIZE OF RECORD
		IMUL	T2,S.BLKF(U)		;SIZE OF BUFFER
		JRST	$C			;ADD IN HEADER WORDS

	  $2%	MOVE	T2,RECORD		;SIZE OF RECORD IN CHARS
		SKIPG	NOCRLF			;[N11] SKIP IF NO CRLF WANTED
		ADDI	T2,2			;CR-LF
		IMUL	T2,S.BLKF(U)		;TOTAL IN CHARS
		ADDI	T2,4			;FOR OVERFLOW
		IDIVI	T2,5			;NO. OF WORDS
		JRST	$C			;ADD IN HEADER WORDS

	  $3%	MOVE	T2,RECORD		;SIZE OF RECORD IN CHARS
		SKIPGE	T1,S.VARI(U)		;[C06] VARIABLE LENGTH RECORDS?
		MOVE	T1,P.VARF		;[C06]   OR BY DEFAULT
		SKIPLE	T1			;[C06]   ..
		ADDI	T2,4			;[C06] ADD RECORD HEADER WORD
		IMUL	T2,S.BLKF(U)		;TOTAL IN CHARS
		ADDI	T2,3			;FOR OVERFLOW
		IDIVI	T2,4			;NO. OF WORDS
		SKIPLE	T1			;[C06] IF VARIABLE?
		ADDI	T2,1			;[C06] ADD BLOCK HEADER WORD
		JRST	$C			;ADD IN HEADER WORDS

	  $4%	MOVE	T2,RECSIZ		;[C06] SIZE IN WORDS
		IMUL	T2,S.BLKF(U)		;* BLOCKING FACTOR
	  ESAC;
	ADDI	T2,3			;ADD IN HEADER WORDS
	AOS	(P)			;SKIP RETURN
  FI;
	RETURN
END;
>;END IFE FTFORTRAN
SUBTTL	PSORT. -- Memory Management Routines for TOPS-10

;ROUTINE TO CHECK FOR /CORE SWITCH AND INSURE ARGUMENT IS REASONABLE

BEGIN
  PROCEDURE	(PUSHJ	P,CHKCOR)
  IF USER SPECIFIED /CORE
	SKIPG	T1,CORSIZ	;[C20] SIZE SPECIFIED
	JRST	$T		;NO
  THEN
	CAIGE	T1,1000		;[C20] YES, BUT MAKE SURE REASONABLE
	LSH	T1,POW2(2000)	;[C20] CONVERT NUMBER TO K
	SUB	T1,OLDFF	;[C20] [C13] CALCULATE NEW AVAILABLE MEMORY
	JUMPLE	T1,$2		;ARG IS TOO SMALL
	PUSHJ	P,RSTSPC	;[C13] RE-SETUP AVAILABLE MEMORY
	JRST	$F

  $2%	SETZM	CORSIZ		;VALUE IS TOO SMALL TO USE
	PUSHJ	P,E$$NCS	;WARN USER
				; AND USE THE DEFAULT ALGORITHM
  ELSE USE DEFAULT
	PUSHJ	P,DEFCOR	;USE DEFAULT ALGORITHM
  FI;
	PUSHJ	P,TSTSIZ	;GO CHECK SIZE
	PUSHJ	P,SMALL		;SEE IF INPUT IS 1 SMALL FILE
IFE FTDEBUG!FTFORTRAN!FTVM,<
	JRST	$1		;[C13] GET RID OF HIGH SEGMENT

	SEGMENT	LPURE		;[C20]
  $1%	MOVSI	T1,1		;[C20] [C13] REMOVE HIGH SEGMENT
	CORE	T1,		;[C13]   ..
	  NOOP			;[C13] SHOULD NEVER FAIL
	RETURN			;[C20] [C13] JOIN COMMON CODE

	SEGMENT	HPURE		;[C20]
>;END IFE FTDEBUG!FTFORTRAN!FTVM
IFN FTDEBUG!FTFORTRAN!FTVM,<
	RETURN			;[C13]
>;END IFN FTDEBUG!FTFORTRAN!FTVM
END;
BEGIN
  PROCEDURE	(PUSHJ	P,SMALL)
	SKIPE	LEAVES		;[N11] IF USER SPECIFIED SIZE
	RETURN			;[N11] LEAVE IT ALONE
	MOVE	P1,F.INZR	;GET FIRST INPUT FILE
	MOVE	T1,X.DVCH(P1)	;[OK] GET DEVCHR BITS
	TXNE	T1,DV.DSK	;IS IT A DSK?
	SKIPE	X.NXT(P1)	;[OK] AND ONLY ONE FILE?
	RETURN			;NO
	MOVEI	T1,LN.X		;SIZE OF DATA BLOCK
	PUSHJ	P,GETSPC	;GET SPACE
	  JRST	E$$NEC		;FAILED
	HRL	T1,P1		;FROM - TO
	HRRZ	P1,T1		;POINT TO IT
	BLT	T1,LN.X-1(P1)	;[OK] COPY BLOCK
	PUSHJ	P,GETCHN	;[C19] GET A FREE CHANNEL
	  JRST	E$$NEH		;[C19] FAILED
	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
	MOVX	T1,.IODMP	;[C19] SET DUMP MODE
	MOVEM	T1,FLPARG+.FOIOS	;[C19]   ..
	MOVE	T1,X.OPN+1(P1)	;[OK] [C19] GET DEVICE
	MOVEM	T1,FLPARG+.FODEV	;[C19] STORE IT
	SETZM	FLPARG+.FOBRH	;[C19] NO BUFFERS
	SETZM	FLPARG+.FONBF	;[C19]   ..
	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		;[N05] GIVE ERROR MESSAGE AND GIVE UP
	MOVE	T1,X.RIB+.RBSIZ(P1)	;[OK] GET SIZE IN WORDS
	SKIPLE	P.VARF		;VARIABLE RECORD SIZE?
	SKIPA	T3,MAXKEY	;YES, USE WORST CASE (ALMOST)
	MOVE	T3,RECSIZ	;NO, USE FIXED SIZE
	SOSLE	T3		;ALLOW FOR PARTIAL WORD ONLY WORST CASE
	IDIV	T1,T3		;[C20] NO. OF RECORDS
	IMULI	T1,3		;MULTIPLY BY 1.5 TO GIVE
	LSH	T1,-1		; 50% FUDGE FACTOR
	CAIGE	T1,^D16		;GUARANTEE A MINIMUM
	MOVEI	T1,^D16		;IN CASE USER IS CONFUSED
	CAML	T1,NUMRCB	;LESS THAN WE ALLOWED FOR?
	JRST	$1		;NO
	MOVEM	T1,NUMRCB	;[C13] STORE BACK
	MOVE	T2,X.RIB+.RBSIZ(P1)	;[OK]
	IDIVI	T2,.TBS		;SEE HOW MANY BUFFERS WE ACTUALLY NEED
	SKIPE	T3
	ADDI	T2,1
	CAIGE	T2,2		;AT LEAST DOUBLE
	MOVEI	T2,2
	TRZE	T2,1		;[C18] MAKE EVEN
	ADDI	T2,2		;[C18]   ..
	CAML	T2,IBUFNO	;LESS THAN WE ALLOWED?
	JRST	$2		;NO, USE WHAT WE CALCULATED PREVIOUSLY
	EXCH	T2,IBUFNO	;YES, REDUCE NO.
	SUB	T2,IBUFNO	;GET DIFF
	IMULI	T2,.TBS
	MOVNS	T2		;[C13] ADJUST BUFFER POOL SIZE
	ADDM	T2,BUFSZ	;[C13]   ..
  $2%	MOVEI	T2,2		;JUST IN CASE THING GO WRONG
	EXCH	T2,TBUFNO	;ALLOW DOUBLE BUFFERING FOR TEMP FILE
	SUB	T2,TBUFNO
	IMULI	T2,.TBS
	MOVNS	T2		;[C13] REDUCE BUFFER POOL SIZE
	ADDM	T2,BUFSZ	;[C13]   ..
  $1%	MOVS	T1,FLPARG+.FOFNC	;[N17] GET CHANNEL BACK
	ANDI	T1,777		;[N17]
	PUSHJ	P,RELCHN	;[C19]   ..
	MOVEI	T1,LN.X		;GIVE BACK SPACE
	PUSHJ	P,FRESPC	;TO POOL
	RETURN
END;
SUBTTL	HPURE SEGMENT ERROR MESSAGES

E$$FNT:	$ERROR	(?,FNT,<File name may not be specified with /TEMP device.>)
E$$DND:	$ERROR	(?,DND,<Device >,+)
	$MORE	(SIXBIT,S.DEV(U))
	$MORE	(TEXT,< is not a disk.  All scratch devices must be disks.>)
	$DIE
E$$DNE:	$ERROR	(?,DNE,<Device >,+)
	$MORE	(SIXBIT,S.DEV(U))
	$MORE	(TEXT,< does not exist>)
	$DIE
E$$PRI:	$ERROR	(?,PRI,<Priority must be in range -3 to +3.>)
E$$MTE:	$ERROR	(?,MTE,<Max Temp Files must be in the range 3 to >,+)	;[N20]
	SKIPN	XCHNO.			;[N20] EXTRA CHANNELS?
	JRST	[$MORE	(TEXT,<15.>)	;[N20]
		JRST	.+2]		;[N20]
	$MORE	(TEXT,<26.>)		;[N20]
	$DIE				;[N20]
IFE FTFORTRAN,<
ERRUTL:	$ERROR	(?,UTL,<Unknown tape label type detected on >,+)
	MOVEI	T2,X.RIB(P1)		;[OK] [353] SET UP PTR TO LOOKUP BLOCK
	$MORE	(FILESPEC,T2)		;[353] PRINT TAPE WITH ERROR
	$DIE				;[353] FATAL ERROR
ERRLNL:	PUSH	P,T4			;[353] SAVE SORT'S /LABEL ARG
	$ERROR	(?,LNL,</LABEL:>,+)
	POP	P,T1			;[353] GET /LABEL ARG BACK
	MOVE	T1,LAB.T-1(T1)		;[OK] [353] GET SIXBIT /LABEL ARG
	$MORE	(SIXBIT,T1)		;[353] PRINT IT
	$MORE	(TEXT,< does not match tape's label type on >)
	MOVEI	T2,X.RIB(P1)		;[OK] [353] SET UP PTR TO LOOKUP BLOCK
	$MORE	(FILESPEC,T2)		;[353] PRINT TAPE WITH ERROR
	$DIE
>
SUBTTL	I/O ROUTINES -- INIINP - Initialize Next Input File

	SEGMENT	LPURE			;[C20]

BEGIN
  PROCEDURE (PUSHJ	P,INIINP)	;INITIALIZE NEXT INPUT FILE
;ENTER WITH:
;	F/	FCBORG PTR
	PUSH	P,P1			;[215] SAVE A TEMP FOR X. BLOCK
	MOVE	P1,FILXBK(F)		;[215] SET UP PTR TO X. BLOCK
	SETZM	FILSIZ(F)		;INITIALIZE FILE SIZE TO 0
	SKIPE	X.BLKF(P1)		;[OK] [C18] BLOCKED FILE?
	PUSHJ	P,BLKSET		;[C18] YES, SETUP FOR IT
	MOVE	T1,X.BLKF(P1)		;[OK] [215] GET BLOCKING FACTOR
	HRRZM	T1,FILBLK(F)		;STORE AS AOBJN WORD (TO FAIL FIRST TIME)
	MOVE	T1,FILBPK(F)		;[C18] GET BYTES PER BLOCK
	MOVEM	T1,FILKCT(F)		;[C18] SAVE AS BLOCK BYTE COUNT
	MOVE	T1,X.FLG(P1)		;[OK] [215] GET FILE FLAGS
	MOVE	T2,X.DVCH(P1)		;[OK] [C18] GET DEVCHR WORD
	CAXN	T2,DVCHNL		;[C18] NUL?
	SETZ	T2,			;[C18] YES, DONT GET CONFUSED
	TXNE	T2,DV.MTA		;[C18] MAGTAPE?
	TXO	T1,FI.MTA		;[C18] YES, SET FILE FLAG
	TXNE	T2,DV.DSK		;[C18] DSK?
	TXO	T1,FI.DSK		;[C18] YES, SET FILE FLAG
	MOVEM	T1,FILFLG(F)		;SET IN FCB
  IF BUFFERS HAVE ALREADY BEEN SET UP
	SKIPL	BUFALC			;[C19] SET IN RELES. AND GETMRG WHEN FIRST
	JRST	$T			;[C19]   PASS OF BUFFERS HAVE BEEN SET UP
  THEN USE SAME BUFFER AREA AGAIN
	MOVE	T1,FILBUF(F)		;[C19] POINTER TO BEGINNING OF BUFF AREA
	MOVEM	T1,BUFPTR		;[C19] TELL BUFRNG TO START THERE
	MOVE	P2,IBUFNO		;[C19] SET UP CALL TO BUFRNG
	PUSHJ	P,BUFRNG		;[C19] BUILD NEW BUFFERS, SAME AREA
	JRST	$F			;[C19]
  ELSE ALLOCATE MAXIMUM BUFFER AREA FOR WORST CASE
	MOVE	P2,IBUFNO		;[C19] SET UP CALL TO BUFRNG
	PUSHJ	P,BUFRNG		;[C19] ALLOCATE AT CURRENT BUFPTR
	MOVE	T1,IBUFNO		;[C19] INCREMENT BUFPTR BY
	IMUL	T1,MXDVSZ		;[C19]   WORST CASE SIZE
	ADD	T1,FILBUF(F)		;[C19]   IN CASE WE NEED IT
	MOVEM	T1,BUFPTR		;[C19]   ..
  FI;
	HLLZS	FILPTR(F)		;[C19] CLEAR RH OF BYTE POINTER
	SETZM	FILCNT(F)		;[C19] CLEAR FILE COUNT
	MOVEI	T1,FILHDR(F)
	HRRZM	T1,X.OPN+.OPBUF(P1)	;[OK] [215] SETUP INPUT BUFFER PTR
	PUSHJ	P,GETCHN		;[C19] GET A WORKING CHANNEL
	  JRST	E$$NEH			;[C19] FAILED
	MOVEM	T1,FILCHN(F)		;[C19] STORE 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
	MOVE	T2,X.DVCH(P1)		;[OK] [215] GET DEVCHR UUO
	TXNN	T2,DV.DSK		;DSK?
	ADDI	T1,2			;NO
	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

;  ..
  IF I/O MODE IS EBCDIC
	HRRZ	T2,IOMODE		;[215] [201] CHECK FILE'S MODE
	CAXE	T2,MODEBCDIC		;[215] [201] CHECK FOR EBCDIC
	JRST	$F			;[215] NOT--BYTE POINTER IS OK
  THEN USE EBCDIC 9-BIT BYTES
	MOVX	T2,<POINT 9>		;[215] SET UP DUMMY POINTER
	HLLM	T2,FILPTR(F)		;[215] MODIFY REAL POINTER
  FI;
  IF THIS IS A MAGTAPE
	MOVE	T1,X.DVCH(P1)		;[OK] [215] GET BACK DEVCHR WORD
	CAXE	T1,DVCHNL		;[215] IF NUL:, NOT A MAGTAPE
	TXNN	T1,DV.MTA		;[215] NOW CHECK FOR REAL MTA
	JRST	$F			;[215] NOT A MAGTAPE
  THEN DO ADDITIONAL MAGTAPE SETUP (REWIND, DENSITY, ETC.)
	PUSHJ	P,POSITF		;[C11] POSITION FILE ON MAGTAPE
	  IF MODE IS EBCDIC INDUSTRY
		HRRZ	T2,MODE
		MOVE	T4,FILFLG(F)		;[C11] [215] GET FLAG BITS
		CAIN	T2,MODEBCDIC		;[215] FILE'S MODE EBCDIC?
		TXNN	T4,FI.IND		;[215]   AND INDUSTRY?
		JRST	$F
	  THEN CHANGE BYTE POINTER TO 8-BIT
		MOVX	T2,<POINT 8>		;[215] YES
		HLLM	T2,FILPTR(F)		;RESET BYTE SIZE
	  FI;
	PUSHJ	P,STAPF			;[215] SET TAPE PARAMETERS
	PUSHJ	P,CHKLBL		;[215] GO CHECK ON LABELS
  FI;
	POP	P,P1			;[215] RESTORE TEMP
IFE FTCOBOL,<
	PJRST	DSKPRI			;SET DISK PRIORITY LEVEL
>
IFN FTCOBOL,<
	RETURN				;DONE
>
END;
SUBTTL	I/O ROUTINES -- INIOUT - Initialize Next Output File

BEGIN
  PROCEDURE	(PUSHJ	P,INIOUT)		;INITIALIZE SORT OUTPUT FILE
	MOVEI	F,FCBORG		;SORT OUTPUT FILE HAS FIRST FCB
	PUSH	P,P1			;[215] SAVE TEMP FOR X. BLOCK
	MOVE	P1,F.OXBK		;[215] LOAD SAVED X. BLOCK
	MOVEM	P1,FILXBK(F)		;[215] REMEMBER HERE TOO FOR LATER
	SETZM	FILSIZ(F)		;[215] START WITH NO RECS WRITTEN
	SKIPE	X.BLKF(P1)		;[OK] [C18] BLOCKED FILE?
	PUSHJ	P,BLKSET		;[C18] YES, SETUP FOR IT
	MOVE	T1,X.BLKF(P1)		;[OK] [215] FETCH BLOCKING FACTOR
	HRRZM	T1,FILBLK(F)		;STORE AS AOBJN WORD (TO FAIL FIRST TIME)
	MOVE	T1,FILBPK(F)		;[C18] GET BYTES PER BLOCK
	MOVEM	T1,FILKCT(F)		;[C18] SAVE AS BLOCK BYTE COUNT
	MOVE	T1,X.FLG(P1)		;[OK] GET FILE FLAGS
	TXO	T1,FI.OUT		;[C06] REMEMBER THIS IS AN OUTPUT FILE
	MOVE	T2,X.DVCH(P1)		;[OK] [C18] GET DEVCHR WORD
	CAXN	T2,DVCHNL		;[C18] NUL?
	SETZ	T2,			;[C18] YES, DON'T GET CONFUSED
	TXNE	T2,DV.MTA		;[C18] MAGTAPE?
	TXO	T1,FI.MTA		;[C18] YES, SET FILE FLAG
	TXNE	T2,DV.DSK		;[C18] DSK?
	TXO	T1,FI.DSK		;[C18] YES, SET FILE FLAG
	MOVEM	T1,FILFLG(F)		;SET IN FCB
	MOVE	T1,BUFPTR		;[C19] WHERE BUFFERS WILL START FROM
	HRLI	T2,0(T1)		;[C20] [C19]
	HRRI	T2,1(T1)		;[C20]
	SETZM	(T1)			;[OK] [C19]
	MOVE	T3,OBUFNO		;[C20] [C19] CLEAR ONLY TO END OF
	IMUL	T3,X.DVSZ(P1)		;[C20] [C19]   THIS FILE'S BUFFER AREA
	ADD	T3,T1			;[C20] [C19]   FOR ASCII OR INDUSTRY
	BLT	T2,-1(T3)		;[C20] [C19]   ..
	MOVE	P2,OBUFNO		;[C19] SET UP BUFFERS
	PUSHJ	P,BUFRNG		;[C19]   ..
	HLLZS	FILPTR(F)		;[C19] CLEAR RH OF BYTE POINTER
	SETZM	FILCNT(F)		;[C19] CLEAR FILE COUNT
	SETZM	X.RIB+.RBALC(P1)	;[445] CLEAR CONTIGUOUS STORAGE REQUEST
  IF USER DIDN'T GIVE OUTPUT ESTIMATE
	SKIPE	X.RIB+.RBEST(P1)	;[OK] [215] BELIEVE USER IF SET
	JRST	$F			;[215] IT IS
  THEN COMPUTE ONE
	MOVE	T1,INPREC		;GET NO. OF RECORDS READ
	MOVE	T2,RECSIZ		;SIZE +1 IN WORDS
	SUBI	T2,1			;[C20] MINUS 1
	IMUL	T1,T2			;[C20] NO. OF WORDS READ
	ADDI	T1,177			;ROUND UP ONE BLOCK
	LSH	T1,-<POW2(^D128)>	;IN BLOCKS
	MOVEM	T1,X.RIB+.RBEST(P1)	;[OK] [215] ALLOCATE SAME NO. FOR OUTPUT
  FI;
	MOVEI	T1,FILHDR(F)		;[215] MAKE OPEN BLOCK POINT
	HRLZM	T1,X.OPN+.OPBUF(P1)	;[OK] [215]   TO BUFFER HEADER
	PUSHJ	P,GETCHN		;[C19] GET A WORKING CHANNEL
	  JRST	E$$NEH			;[C19] FAILED
	MOVEM	T1,FILCHN(F)		;[C19] STORE IT
	HRLS	T1			;[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
	MOVE	T2,X.DVCH(P1)		;[OK] [215] GET DEVCHR
	TXNN	T2,DV.DSK		;IS IT A DSK?
	ADDI	T1,2			;NO, USE 4 WORD ENTER
	MOVEM	T1,FLPARG+.FOLEB	;[C19] STORE IT
	MOVE	T1,[.FOLEB+1,,FLPARG]	;[C19] DO WRITE 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
	MOVE	T1,FILBPB(F)		;[C18] GET BYTES PER BUFFER
	SKIPG	FILCNT(F)		;[C19] VIRGIN RING?
	ADDM	T1,FILKCT(F)		;[C18] YES, ADD TO BLOCK FOR DUMMY OUTPUT

;  ..
  IF I/O MODE IS EBCDIC
	HRRZ	T2,IOMODE		;[215] [201] FETCH FILE'S MODE
	CAXE	T2,MODEBCDIC		;[215] [201] EBCDIC?
	JRST	$F			;[215] NO--BYTE POINTER OK
  THEN USE EBCDIC 9-BIT BYTES
	MOVX	T2,<POINT 9,,35>	;[215] [124] SET UP DUMMY POINTER
	HLLM	T2,FILPTR(F)		;[215] CHANGE REAL POINTER
	MOVE	T2,FILBPB(F)		;[C19] FIX UP BYTE COUNT
	SKIPLE	FILCNT(F)		;[C19] IF NECESSARY
	MOVEM	T2,FILCNT(F)		;[C19]   ..
  FI;
  IF THIS IS A MAGTAPE
	MOVE	T2,X.DVCH(P1)		;[OK] [215] GET DEVCHR WORD BACK
	CAXE	T2,DVCHNL		;[215] IF NUL:, NOT A MAGTAPE
	TXNN	T2,DV.MTA		;[215] NOW CHECK FOR REAL MTA
	JRST	$F			;[215] NOT A MAGTAPE
  THEN DO ADDITIONAL MAGTAPE SETUP (REWIND, DENSITY, ETC.)
	PUSHJ	P,POSITF		;[C11] POSITION FILE ON MAGTAPE
	  IF MODE IS EBCDIC INDUSTRY
		HRRZ	T2,MODE
		MOVE	T4,FILFLG(F)		;[C11] [215] GET FLAG BITS
		CAIN	T2,MODEBCDIC		;[215] FILE'S MODE EBCDIC?
		TXNN	T4,FI.IND		;[215]   AND INDUSTRY?
		JRST	$F
	  THEN CHANGE BYTE POINTER TO 8-BIT
		MOVX	T2,<POINT 8,,35>	;[215] [124] YES
		HLLM	T2,FILPTR(F)		;RESET BYTE SIZE
	  FI;
	PUSHJ	P,STAPF			;[215] SET TAPE PARAMETERS
	PUSHJ	P,WRTLBL		;[215] WRITE LABELS IF ANY
  FI;
	POP	P,P1			;[215] RESTORE TEMP
IFE FTCOBOL,<
	PJRST	DSKPRI			;SET DISK PRIORITY LEVEL
>
IFN FTCOBOL,<
	RETURN				;DONE
>
END;
SUBTTL	I/O ROUTINES -- RENOUT - Rename Temporary File to Output File

BEGIN
  PROCEDURE	(PUSHJ	P,RENOUT)
	;RENAME FILE POINTED TO BY F TO BE SORT OUTPUT MASTER

	PUSH	P,P1			;[C19] SAVE AND SETUP P1
	MOVE	P1,F.OXBK		;[C19]   ..
  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)		;[C19] BUILD FILOP. BLOCK, GET CHANNEL
	HRRI	T1,.FORNM		;[C19] GET RENAME FUNCTION
	MOVEM	T1,FLPARG+.FOFNC	;[C19] STORE THEM
	SETZM	FLPARG+.FOIOS		;[C19] NO DATA MODE
	MOVE	T1,X.OPN+.OPDEV(P1)	;[OK] [C19] TRANSFER DEVICE
	MOVEM	T1,FLPARG+.FODEV	;[C19]   ..
	SETZM	FLPARG+.FOBRH		;[C19] NO BUFFERS
	SETZM	FLPARG+.FONBF		;[C19]   ..
	HRLZI	T1,X.RIB(P1)		;[OK] [C19] GET RENAME BLOCK ADDRESS
	MOVEM	T1,FLPARG+.FOLEB	;[C19] STORE IT
	MOVE	T1,[XWD .FOLEB+1,FLPARG]	;[C19] DO RENAME FILOP.
	FILOP.	T1,			;[C19]   ..
	  JRST	ERRFUF			;[C19] FAILED
	JRST	$F			;[N12] OK
  ELSE USE OLD I/O UUOs
	MOVE	T1,FILCHN(F)		;[C19] GET CHANNEL
	LSH	T1,27			;[C19]   ..
	HRRI	T1,X.RIB(P1)		;[OK] [C19] [342] [215]   ..
	TLO	T1,(RENAME)
	XCT	T1
	  JRST [HRRZ	T1,T2		;[C19] FAILED
		JRST	ERRFUF]		;[C19]   ..
  FI;
	MOVE	T1,FILCHN(F)		;[C19] RELEASE CHANNEL
	PUSHJ	P,RELCHN		;[C19]   ..
	POP	P,P1			;[C19] RESTORE P1
	RETURN
END;
SUBTTL	I/O ROUTINES -- Magtape Utility Routines

BEGIN
  PROCEDURE (PUSHJ	P,SKIPR)	;[215] SKIP 1 RECORD ON TAPE POINTED TO BY F
	MOVEI	T1,.TFFSB		;[C19] SKIP RECORD
	PJRST	TAPOPX			;[C19] DO THE TAPOP.
END;

BEGIN
  PROCEDURE (PUSHJ	P,SKIPF)	;[215] SKIP 1 FILE ON TAPE POINTED TO BY F
	MOVEI	T1,.TFFSF		;[C19] SKIP FILE
	PJRST	TAPOPX			;[C19] DO THE TAPOP.
END;

BEGIN					;[414]
  PROCEDURE (PUSHJ	P,BKSPR)	;[414] BACKSPACE ONE RECORD ON MAGTAPE
	MOVEI	T1,.TFBSB		;[C19] BACKSPACE RECORD
	PJRST	TAPOPX			;[C19] DO THE TAPOP.
END;					;[414]

BEGIN
  PROCEDURE (PUSHJ	P,BKSPF)	;[C11] BACKSPACE ONE FILE ON MAGTAPE
	MOVEI	T1,.TFBSF		;[C19] BACKSPACE FILE
	PJRST	TAPOPX			;[C19] DO THE TAPOP.
END;

BEGIN
  PROCEDURE	(PUSHJ	P,WRTEOF)	;WRITE A TAPE MARK DURING LABEL PROCESSING
	MOVEI	T1,.TFWTM		;[C19] WRITE TAPE MARK
	PJRST	TAPOPX			;[C19] DO THE TAPOP.
END;

BEGIN
  PROCEDURE (PUSHJ	P,RWNDF)	;[215] REWIND FILE POINTED TO BY F
	MOVEI	T1,.TFREW		;[C19] REWIND
	PJRST	TAPOPX			;[C19] DO THE TAPOP.
END;

BEGIN
  PROCEDURE	(PUSHJ	P,UNLDF)	;UNLOAD FILE POINTED TO BY F
	MOVEI	T1,.TFUNL		;[C19] UNLOAD
	PJRST	TAPOPX			;[C19] DO THE TAPOP.
END;

BEGIN
  PROCEDURE	(PUSHJ	P,TAPOPX)	;DO THE TAPOP. UUOS, C(T1)=FUNC
	MOVE	T2,T1			;[C19] SETUP TAPOP. BLOCK, GET FUNC
	MOVE	T3,FILCHN(F)		;[C19] GET CHANNEL
	MOVE	T1,[XWD 2,T2]		;[C19] DO THE TAPOP.
	TAPOP.	T1,			;[C19]   ..
	  SETZ	T1,			;[C19] FAILED, NOT A TAPE
	RETURN				;[C19]
END;

BEGIN
   PROCEDURE	(PUSHJ	P,ISITMT)
   ;CHECK TO SEE IF FILE POINTED TO BY F IS A MAGTAPE
	SKIPN	T1,FILXBK(F)		;GET X. BLOCK ADDRESS
	RETURN				;TEMP FILE, CAN'T BE MAGTAPE
	MOVE	T1,X.DVCH(T1)		;[OK] GET DEVCHR WORD
	CAXE	T1,DVCHNL		;IF NUL:, NOT A MAGTAPE
	TXNN	T1,DV.MTA		;NOW CHECK IF REALLY A TAPE
	RETURN
	AOS	0(P)			;A TAPE, SKIP RETURN
	RETURN
END;

BEGIN
   PROCEDURE	(PUSHJ	P,ISATBT)	;[C11]
   ;CHECK TO SEE IF MAGTAPE POINTED TO BY F IS AT BOT
	MOVEI	T1,.TFWAT		;[C19] WAIT FOR I/O
	PUSHJ	P,TAPOPX		;[C19] DO THE TAPOP.
	MOVEI	T1,.TFSTS		;[C19] GET TAPE STATUS
	PUSHJ	P,TAPOPX		;[C19] DO THE TAPOP.
	TXNE	T1,TF.BOT		;[C19] NOW CHECK IF AT BOT
	AOS	0(P)			;[C11] YES, SKIP RETURN
	RETURN				;[C11]
END;
SUBTTL	I/O ROUTINES -- STAPF - Set Magtape File Parameters

BEGIN
  PROCEDURE (PUSHJ	P,STAPF)	;[215] SET TAPE FILE PARAMETERS

;STAPF IS CALLED FROM INIINP AND INIOUT TO SET UP ANY MAGTAPE PARAMETERS
;REQUIRED FOR THE FILE. WE ASSUME THAT OUR CALLERS HAVE VERIFIED THAT THE FILE
;IS ACTUALLY A MAGTAPE.

;ENTER WITH:
;	P1/	POINTER TO X. BLOCK FOR FILE
;	F/	FCB POINTER FOR FILE

	PUSH	P,P2			;[215] SAVE TEMP FOR FILE FLAGS
	MOVE	P2,FILFLG(F)		;[215]   ..
  IF INDUSTRY COMPATIBLE MODE REQUIRED
	TXNN	P2,FI.IND		;[215] CHECK FOR INDUSTRY MODE
	JRST	$F			;[215] NO--TRY OTHERS
  THEN SET IT
	MOVX	T0,.TFMOD+.TFSET	;[C19] DO TAPOP.
	MOVE	T1,FILCHN(F)		;[C19]   ..
	MOVX	T2,.TFM8B		;[C19]   ..
	MOVX	T3,<XWD 3,T0>		;[C19]   ..
	TAPOP.	T3,			;[C19]   ..
	  JRST	ERRCSM			;[C19] FAILED
  FI;
	MOVX	T0,.TFKTP		;[215] CONTROLLER FUNCTION
	MOVE	T1,FILCHN(F)		;[C19] CHANNEL
	MOVX	T3,<XWD 2,T0>		;[C19] LENGTH,,ADDR
	TAPOP.	T3,			;[215] FETCH TYPE
	  SETZ	T2,			;[215] IN CASE IT FAILS
	MOVE	T4,T2			;[215] SAVE IN SAFE AC
  IF STANDARD ASCII MODE REQUIRED
	TXNN	P2,FI.STA		;[215] DO WE NEED IT?
	JRST	$F			;[215] NO--DON'T DO IT
  THEN SET IT IF CONTROLLER SUPPORTS IT
	CAIGE	T4,.TFKTX		;[215] CHECK FOR GOOD CONTROLLER
	JRST	E$$SAT			;[215]   ..
	MOVX	T3,<XWD 3,T0>		;[C19] LENGTH,,ADDR
	MOVX	T0,.TFMOD+.TFSET	;[215] FUNCTION
	MOVE	T1,FILCHN(F)		;[C19] CHANNEL
	MOVX	T2,.TFM7B		;[215] 7-BIT MODE
	TAPOP.	T3,			;[215] SET IT
	  JRST	ERRCSM			;[C19] FAILED
  FI;
  IF DENSITY CHANGE REQUIRED
	SKIPN	T2,X.DEN(P1)		;[OK] [215] NON-DEFAULT DENSITY?
	JRST	$F			;[215] NO--FORGET IT
  THEN TRY TO SET IT
	  IF CONTROLLER IS A TC10C OR A TX01
		CAIGE	T4,.TFKTC		;[215] CHECK FOR THEM
		JRST	$T			;[215] NO--CHECK FOR OTHERS
	  THEN DENSITY MAY ONLY BE 800 OR 1600 BPI
		CAIGE	T2,.TFD80		;[215] AT LEAST 800 BPI?
		JRST	ERRCSD			;[215] NO--ERROR
		JRST	$F			;[215] OK--SET DENSITY
	  ELSE FOR TM10A OR TM10B, DENSITY MAY NOT BE 1600 BPI
		CAILE	T2,.TFD80		;[215] CHECK FOR 800 OR LESS
		JRST	ERRCSD			;[215] NO--ERROR
	  FI;
	MOVX	T3,<XWD 3,T0>		;[C19] LENGTH,,ADDR
	MOVX	T0,.TFDEN+.TFSET	;[215] FUNCTION
	MOVE	T1,FILCHN(F)		;[C19] CHANNEL
	TAPOP.	T3,			;[215] SET DENSITY
	  NOOP				;[215] EARLY MONITOR--OPEN UUO OK
  FI;
	POP	P,P2			;[215] RESTORE TEMP
	RETURN				;[215] ALL DONE
END;

ERRCSD:	PUSH	P,T1		;SAVE CHAN #
	PUSH	P,T2		;SAVE DENSITY
	$ERROR	(?,CSD,<Cannot set density to >,+)
	POP	P,T1
	MOVE	T1,[DEC 200,556,800,1600,6250]-1(T1)	;[OK]
	$MORE	(DECIMAL,T1)
	$MORE	(TEXT,< on >)
	POP	P,T1
	DEVNAM	T1,
	  NOOP
	$MORE	(SIXBIT,T1)
	$DIE

ERRCSM:	PUSH	P,T1		;[C19] SAVE CHAN #
	$ERROR	(?,CSM,<Cannot set hardware data mode on >,+)	;[C19]
	POP	P,T1		;[C19]
	DEVNAM	T1,		;[C19]
	  MOVSI T1,'MTA'	;[C19] FAILED
	$MORE	(SIXBIT,T1)	;[C19]
	$DIE			;[C19]
SUBTTL	TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE

IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(PUSHJ	P,TSTDEV)
	;SEE IF TEMP DEVICE IS A SUBSET OF OUTPUT DEVICE
	PUSH	P,P1			;[324] JUST IN CASE
	MOVE	P1,F.OXBK		;[324] RESTORE ADDRESS OF X.BLOCK-OUTPUT

	HRRZ	T1,IOMODE		;[201] FETCH I/O MODE INDEX
	CAXE	T1,MODSIXBIT		;[201] ONLY SIXBIT LOOKS LIKE A TEMP FILE
	JRST	$1			;NO, CANNOT RENAME IT
	MOVS	T1,@EXTORG		;[OK] [C13] GET EXTRACT CODE
	CAIN	T1,(JRST (P4))		;[117] JUST A DUMMY?
	SKIPE	X.BLKF(P1)		;[OK] [215] [117] CAN'T DO IF OUTPUT BLOCKED
	JRST	$1			;NO DO IT THE HARD WAY
	MOVE	T1,TMPFCB+FILCHN	;[C19] GET TEMP CHANNEL
	DEVNAM	T1,			;SEE WHAT IT REALLY WAS
	  JRST	$1			;FAILED
	MOVEM	T1,DSKARG+.DCNAM
	MOVE	T1,[.DCUPN,,DSKARG]
	DSKCHR	T1,			;SEE WHAT IT BELONGS TO
	  JRST	$1			;GIVE UP
	MOVE	T1,DSKARG+.DCSNM	;GET STRUCTURE
	MOVE	T2,X.OPN+.OPDEV(P1)	;[OK] [215] GET DESIRED OUTPUT DEVICE
	MOVEM	T2,DSKARG+.DCNAM
	MOVE	T2,[.DCUPN,,DSKARG]
	DSKCHR	T2,			;SEE WHAT OUTPUT IS
	  JRST	$1			;FAILED
  IF OUTPUT DEVICE IS GENERIC DSK
	TXNE	T2,DC.TYP		;ALL ZERO IF GENERIC DSK
	JRST	$T			;NO, ITS NOT
  THEN SEE IF FILE ALREADY EXISTS ON DSK
	PUSH	P,T1			;[404] SAVE FROM 1ST DSKCHR
	MOVEI	F,TMPFCB		;[113]
	PUSHJ	P,GETCHN		;[C19] GET A WORKING CHANNEL
	  JRST	E$$NEH			;[C19] FAILED
	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]   ..
	  TDZA	T2,T2			;[C19] [113] FAILED, FILE DOES NOT EXIST
	MOVE	T2,X.RIB+.OPDEV(P1)	;[OK] [C19] [215] [113] FILE EXISTS, GET DEVICE
	MOVS	T1,FLPARG+.FOFNC	;[N17] GET CHANNEL BACK
	ANDI	T1,777			;[N17]
	PUSH	P,T2			;[C19] SAVE T2
	PUSHJ	P,RELCHN		;[C19] RELEASE CHANNEL
	POP	P,T2			;[C19] RESTORE T2
	POP	P,T1			;[404] RESTORE NEEDED FOR STRUCT FROM 1ST DSKCHR
	JUMPE	T2,$2			;[113] LOOKUP FAILED
	MOVEM	T2,DSKARG+.DCNAM	;[113] STORE UNIT
	MOVE	T2,[.DCUPN,,DSKARG]	;[113]
	DSKCHR	T2,			;[113] SEE WHAT OUTPUT IS
	  JRST	$1			;[113] FAILED
	MOVE	T2,DSKARG+.DCSNM	;[113] GET STRUCTURE
	MOVEM	T2,X.OPN+.OPDEV(P1)	;[OK] [215] [113] STORE IT
	JRST	$T			;[113] NOW NOT GENERIC

  $2%	SETOM	STRARG			;[113] LIST IS STARTED WITH -1
	MOVE	T2,[3,,STRARG]		;ARG LIST FOR UUO
  FOR EACH STRUCTURE UNTIL A MATCH DO
	BEGIN
		JOBSTR	T2,		;GET NEXT STR
		  JRST	$1		;FAILED, GIVE UP
		SKIPE	T3,STRARG+.DFJNM
		CAMN	T3,[-1]		;ENDS WITH 0 OR -1
		JRST	$1		;[324]
		CAME	T1,T3		;[324] MATCH
		JRST	$B		;[324] NOT YET
		JRST	$E		;[324]
	  $1%	POP	P,P1		;[324]
		RETURN			;FAILED TO FIND MATCH
	END;
	JRST	$F			;GOT MATCH
  ELSE COMPARE STRUCTURE NAMES
	CAME	T1,DSKARG+.DCSNM	;IF SAME GIVE SKIP RETURN
	JRST	$1			;NOT SAME
  FI;
	AOS	-1(P)			;[342] SET SKIP RETURN
	MOVEI	T1,RSTF			;TO RENAME SOLITARY FILE
  $1%	POP	P,P1			;[324] GO DO COPY
  	RETURN
END;
;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,RSTF)
;RENAME SOLITARY TMP FILE TO BE SORT OUTPUT MASTER
	PUSH	P,P1			;[215] SAVE TEMP FOR X. BLOCK
	MOVE	P1,F.OXBK		;[215] NO FCB FOR IT YET
	MOVEI	F,TMPFCB
	PUSHJ	P,GETCHN		;[C19] GET A WORKING CHANNEL
	  JRST	E$$NEH			;[C19] FAILED
	HRLS	T1			;[C19] BUILD FILOP. BLOCK, GET CHANNEL
	HRRI	T1,.FODLT		;[C19] GET DELETE FUNCTION
	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
	MOVE	T2,X.DVCH(P1)		;[OK] [215] GET DEVCHR
	TXNN	T2,DV.DSK		;IS IT A DSK?
	ADDI	T1,2			;NO, USE 4 WORD ENTER
	MOVEM	T1,FLPARG+.FOLEB	;[C19] STORE IT
	MOVE	T1,[XWD .FOLEB+1,FLPARG]	;[C19] DO DELETE FILOP.
	FILOP.	T1,			;[C19]   ..
	  JRST	$1			;[C19] FAILED
	SETZM	X.RIB+.RBALC(P1)	;[OK] [423] CLEAR BEFORE RENAME TRIES TO USE
$1%	MOVS	T1,FLPARG+.FOFNC	;[N17] GET CHANNEL BACK
	ANDI	T1,777			;[N17]
	PUSHJ	P,RELCHN		;[C19]   ..
	PUSHJ	P,RENOUT		;[C19] RENAME FILE TO OUTPUT FILE NAME
	MOVEI	F,FCBORG		;[342] FCB IS A FCBORG FOR A RENAME
	MOVE	T1,INPREC		;FAKE COPY OF FILE
	MOVEM	T1,FILSIZ(F)		;[342] CONVENTIONAL EOFOUT CALL
	POP	P,P1			;[215] RESTORE TEMP
	PJRST	EOFOUT			;TOP LEVEL RETURN
END;
>;END IFE FTFORTRAN
SUBTTL	SET DISK PRIORITY LEVEL

BEGIN
  PROCEDURE	(PUSHJ	P,DSKPRI)

;F HAS PTR TO FCB OF RELEVANT FILE
;PRIORI HAS GLOBAL DSK PRIORITY LEVEL

	SKIPN	T1,PRIORI
	RETURN			;IF 0 LEVEL
	HRL	T1,FILCHN(F)	;[C19] GET CHANNEL
	MOVX	T2,<.DUPRI,,T1>	;[C19] SETUP AC
	DISK.	T2,		;SET DISK PRIORITY LEVEL
	  NOOP			;IGNORE ERROR RETURN
	RETURN
END;