Google
 

Trailing-Edge - PDP-10 Archives - AP-D489C-SB - srtsta.mac
There are 10 other files named srtsta.mac in the archive. Click here to see a list.
SUBTTL	SRTSTA - NON-COBOL ROUTINES FOR SORT
SUBTTL	D.M.NIXON/DMN/DZN/DLC	10-Apr-78



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1975, 1978 BY DIGITAL EQUIPMENT CORPORATION
SUBTTL	TABLE OF CONTENTS FOR SRTSTA


;                    Table of Contents for SRTSTA
;
;
;                             Section                             Page
;
;   1  SRTSTA - NON-COBOL ROUTINES FOR SORT .....................   1
;   2  TABLE OF CONTENTS FOR SRTSTA .............................   2
;   3  DEFINITIONS
;        3.1  Flags .............................................   3
;        3.2  Low Segment Data ..................................   4
;   4  START ADDRESS AND OUTER LOOP .............................   5
;   5  INITIALIZATION PROCEDURE .................................   6
;   6  SCAN CONTROL ROUTINES ....................................   8
;   7  SWITCH HANDLING
;        7.1  /FORMAT:xn.m ......................................  11
;   8  COLLATING SEQUENCE TABLE ROUTINES ........................  12
;   9  PSORT.
;        9.1  SORT Initialization Following Command Scanning ....  17
;        9.2  SETMOD - Set Up Recording Mode for SORT ...........  18
;        9.3  KEYEXT - Generate Key Extraction Code .............  20
;        9.4  Dispatch Tables for Key Extraction ................  21
;        9.5  KEYGEN - Generate Key Comparison Code .............  22
;  10  HIGH SEGMENT ERROR MESSAGES ..............................  24
;  11  FATAL ERROR CLEAN-UP ROUTINES ............................  25
;  12  RELES.
;       12.1  Add Input Record to Tree ..........................  26
;       12.2  End of Input File
;            12.2.1  SORT Case ..................................  28
;            12.2.2  MERGE Case .................................  29
;            12.2.3  Check End Lables ...........................  30
;  13  MERGE. ...................................................  31
;  14  RETRN.
;       14.1  End of Output File ................................  32
;       14.2  MSTEOT - EOT Detected on Output Tape ..............  33
;       14.3  RETRNM - Return Record From First-pass Merge Files   34
;  15  TAPE LABEL ROUTINES
;       15.1  CHKLBL - Check Header Labels ......................  35
;       15.2  WRTLBL - Write Header Labels ......................  39
;       15.3  CHKEND - Check End Labels .........................  42
;       15.4  WRTEND - Write End-of-file Labels .................  45
;       15.5  WRTEOT - Write End-of-tape Labels .................  46
;  16  ENDS.
;       16.1  Clean Up After SORT ...............................  47
;  17  TYPE-OUT ROUTINES
;       17.1  Floating-point Number .............................  48
;  18  LOW SEGMENT ERROR MESSAGES ...............................  49
SUBTTL	DEFINITIONS -- Flags 


LOW.SZ==261+100			;SIZE OF FOROTS'S DATA BASE
FRE.DY==101			;OFFSET OF FREE CORE LIST
SA.ADR==253			;OFFSET, STARTING ADR OF CALLER
FRE.SZ==200			;SIZE OF FREE MEMORY LIST

IFN FTFORTRAN,<	EXTERN DEC.,IOLST.>
IFE FTFORTRAN,<

LOC	137
EXP	V%SORT
RELOC

;DEFINITIONS FROM FORPRM
	FOROT%==400010
	DEC.==FOROT%+12
	IOLST.==FOROT%+15
	
  IFE FTOPS20,<FUNCT.==0>	;TO KEEP MACRO HAPPY
>;END IFE FTFORTRAN

DEFINE	COMPARE	(R,J)<
	JSP	P4,@.CMPAR
>
IF1,<
DEFINE	$JRST$	<BLOCK	1>	;KEEP MACRO HAPPY
>
SUBTTL	DEFINITIONS -- Low Segment Data


	SEGMENT	LOW

OFFSET:	BLOCK	1		;ENTRY OFFSET
IFE FTFORTRAN,<			;ONLY IN STAND-ALONE SORT
STACK:	BLOCK	PDLEN		;PUSHDOWN STACK
>

ZCOR:!				;START OF DATA TO CLEAR
FSTKEY:	BLOCK	1		;POINTER TO LIST OF KEYS & ORDER
LSTKEY:	BLOCK	1		;POINTER TO LAST BLOCK OF KEYS
TEMPSW:	BLOCK	1		;THIS IS A TEMP FILE SPEC
IFN FTCOL,<
COLSW:	BLOCK	1		;THIS IS A COLLATING SEQUENCE FILE SPEC
				;FORM= FLAGS1B12,27B17,LABEL ADDRSSB35
COLCHN:	BLOCK	1		;CHANNEL IN THE AC FIELD FOR  READING
COLPTR:	BLOCK	4		;POINTER TO INPUT BUFFER FOR ALT COL SEQ
>
F.OXBK:	BLOCK	1		;[215] WHERE TO FIND X. BLOCK FOR OUTPUT
F.OUZR:	BLOCK	1		;START OF SCAN OUTPUT CHAIN
F.INZR:	BLOCK	1		;START OF SCAN INPUT CHAIN
F.TMZR:	BLOCK	1		;START OF SCAN TEMP SPEC CHAIN
F.SPC==.-1			;START OF TEMP SWITCHES
F.BLKF:	BLOCK	1		;BLOCKING FACTOR
F.LABL:	BLOCK	1		;STANDARD, OMITTED, NONSTANDARD
F.VARI:	BLOCK	1		;VARIABLE RECORD SIZE
F.INDU:	BLOCK	1		;INDUSTRY COMPATIBLE MODE
F.STDA:	BLOCK	1		;STANDARD ASCII MODE
F.REW:!	BLOCK	1		;REWIND BEFORE USE
F.UNL:!	BLOCK	1		;UNLOAD AFTER USE
F.FMT:!	BLOCK	0		;FORMAT STATEMENT

P.BLKF:	BLOCK	1		;DEFAULT BLOCKING FACTOR
P.LABL:	BLOCK	1		;STANDARD, OMITTED, NONSTANDARD
P.VARF:	BLOCK	1		;DEFAULT VARIABLE/FIXED RECORD SIZE
				;-1=UNKNOWN, 0=FIXED, +1=VARIABLE
P.INDU:	BLOCK	1		;INDUSTRY COMPATIBLE MODE
P.STDA:	BLOCK	1		;STANDARD ASCII MODE
BPWORD:	BLOCK	1		;NO. OF BYTES PER WORD
CPUTIM:	BLOCK	1
ORGTIM:	BLOCK	1
SUMTMP:	BLOCK	1		;TOTAL PAGES WRITTEN TO TMP FILES
RCBTOT:	BLOCK	1		;NUMBER OF RECORDS IN MEMORY FOR SORT PHASE
CORSIZ:	BLOCK	1		;SIZE IF /CORE SEEN
ALIGN:	BLOCK	1		;+1 IF OUTPUT TO BE WORD ALIGNED (ASCII)
IBUFNO:	BLOCK	1		;NUMBER OF BUFFERS FOR INPUT FILE
RECSIZ:	BLOCK	1		;NUMBER OF WORDS IN RECORD
RECOUT:	BLOCK	1		;OUTPUT RECORD SIZE IN BYTES
MODE:	BLOCK	1		;RECORDING MODE BITS ,, INDEX
MODEM:	BLOCK	1		;MASK (SET BY SCAN)
IOMODE:	BLOCK	1		;[201] = RH OF MODE UNLESS /BIN, THEN = MODBINARY
P4SAV:	BLOCK	1
RECSAV:	BLOCK	1
INSREC:	BLOCK	1
RTRUNC:	BLOCK	1		;-1 IF TRUNCATION MESSAGE ALREADY TYPED
CMPCNT:	BLOCK	1
.CMPAR:	BLOCK	1		;POINTER TO COMPARE CODE SEQUENCES
EXTRCT:	BLOCK	1		;POINTER TO EXTRACT CODE SEQUENCES
XTRBYT:	BLOCK	1		;NO. OF EXTRA BYTES IN RECORD
MAXKEY:	BLOCK	1		;MIN. NO. OF WORDS TO HOLD ALL KEYS IN RECORD
MINKEY:	BLOCK	1		;MINIMUM SIZE VAR. LEN. REC. MUST BE
IFE FTOPS20,<
PRIORI:	BLOCK	1		;GLOBAL DSK PRIORITY
>
;
;	NOTE THAT BLT IN SCNSLT RUNS TO HERE!!!!!
SEQNO:	BLOCK	1		;[110] -1 = NO SEQ NO. ,+1 = SEQUENCE NO.
HISIZE:	BLOCK	1		;SIZE OF HIGH SEGMENT
MXDVSZ:	BLOCK	1		;MAX. OF I.DVSZ FOR ALL INPUT FILES
IFN FTCOL,<
COLITS==5*200			;ALLOW 128 WORDS FOR LITERAL
COLITB:	BLOCK COLITS/5		;BUFFER FOR COLLATE SEQUENCE LITERAL
COLBUF:	BLOCK	200		;HOLD THE ALTERNATE COLLATING SEQUENCE
>;END IFN FTCOL
EZCOR==.-1			;END OF DATA AREA TO ZERO

LOSIZE==.JBREL##

KEYZ	LAB,<STANDARD,OMITTED,NONSTANDARD,DEC,ANSI,IBM>
KEYZ	COL,<ASCII,EBCDIC,FILESPEC,LITERAL,ADDRESS,UASCII,UEBCDIC>
KEYZ	MOD,<SIXBIT,ASCII,EBCDIC,BINARY>
KEYZ	SUP,<NONE,INFORMATION,WARNING,FATAL,ALL>
SUBTTL	START ADDRESS AND OUTER LOOP

IFE FTFORTRAN,<
	SEGMENT	HIGH

BEGIN
  PROCEDURE	(,START)
	PORTAL	.+2		;NORNAL ENTRY
	PORTAL	.+2		;CCL ENTRY
	TDZA	P1,P1		;NORMAL OFFSET
	MOVEI	P1,1		;CCL OFFSET
  	MOVEM	P1,OFFSET	;STORE ENTRY OFFSET
  IFN FTOPS20,<
	RESET			;THE KNOWN UNIVERSE
	MOVE	T1,[SIXBIT /SORTV4/]
	MOVE	T2,T1
	SETSN			;COLLECT PAGING STATISTICS
	SETZM	FORTPP		;DID NOT GET CALLED BY FORTRAN
  >
  IFE FTOPS20,<
	MOVEM	.SGNAM,RUNNAM	;SAVE INITIAL ACCS FOR RUN UUO
	MOVEM	.SGPPN,RUNDIR
	MOVEM	.SGDEV,RUNDEV
  >
	JSP	P4,INITIALIZE	;INITIALIZE
  IFE FTOPS20,<
	MOVE	T1,.ISBLK	;DATA BLOCK FOR ISCAN
	PUSHJ	P,.ISCAN##	;INITIALIZE SCANNER
	JRST	LOOP		;GO TO LOW SEGMENT
  >
END;

	SEGMENT	LOW10
>;END IFE FTFORTRAN

BEGIN
  PROCEDURE	(PUSHJ	P,LOOP)
	MOVE	T1,[IOWD 100,CSTACK]
	MOVEM	T1,CORSTK	;INIT MEMORY ALLOCATION STACK
  	PUSHJ	P,SCAN		;CALL SCAN
				;  OR FORTRAN SCAN WHICH DOESN'T RETURN
	PUSHJ	P,PSORT.	;INITIALIZE SORT
	PUSHJ	P,RELES.	;READ INPUT FILES
	PUSHJ	P,MERGE.	;MERGE TEMP FILES
	PUSHJ	P,RETRN.	;WRITE OUTPUT FILES
	PUSHJ	P,ENDS.		;CLEAN UP
IFE FTOPS20!FTFORTRAN,<
	JSR	GETSCN		;GET HIGH SEG AGAIN
>
IFN FTFORTRAN,<
	SKIPG	ATSFLG		;
	RETURN
>
	JSP	P4,INITIALIZE	;DATA
	JRST	$B		;GET NEXT LINE
END;

	SEGMENT	HIGH
SUBTTL	INITIALIZATION PROCEDURE

BEGIN
  PROCEDURE	(JSP	P4,INITIALIZE)
IFE FTFORTRAN,<
  IFN FTOPS20,<
	SKIPN	FORTPP			;IF TOPS-20 FORTRAN SORT, WE HAVE STACK
  >
	MOVE	P,[IOWD PDLEN,STACK]	;SET UP STACK
>
	JSP	T4,ZDATA		;[134] ZERO COMMON DATA AREAS
	JSP	T4,CPUTST		;[134] MAKE SURE IF CPU OK
IFE FTOPS20,<
  IFE FTFORTRAN,<
	RESET				;DO RESET AFTER CALL TO CPUTST
	BEGIN				;GET WHERE WE REALLY CAME FROM
		HRROI	T1,.GTRDV
		GETTAB	T1,		;GET DEVICE
		  JRST	$E		;PRE 6.03
		MOVEM	T1,RUNDEV	;SAVE ACTUAL DEVICE
		HRROI	T1,.GTRDI
		GETTAB	T1,		;GET DIRECTORY
		  JRST	$E
		MOVEM	T1,RUNDIR	;SAVE ACTUAL PPN
		HRROI	T1,.GTRS0
		GETTAB	T1,		;GET SFD #1
		  JRST	$E		;PRE 6.04
		JUMPE	T1,$E		;NO SFD
		MOVEM	T1,RUNSFD	;SAVE SFD
		MOVEI	T1,RUNPTH	;GET POINTER
		EXCH	T1,RUNDIR	;SWAP WITH PPN
		MOVEM	T1,RUNPPN	;SAVE PPN
		HRROI	T1,.GTRS1
		GETTAB	T1,		;NEXT SFD
		  JRST	$E
		MOVEM	T1,RUNSFD+1
		JUMPE	T1,$E		;ALL DONE
		HRROI	T1,.GTRS2
		GETTAB	T1,		;NEXT SFD
		  JRST	$E
		MOVEM	T1,RUNSFD+2
		JUMPE	T1,$E		;ALL DONE
		HRROI	T1,.GTRS3
		GETTAB	T1,		;NEXT SFD
		  JRST	$E
		MOVEM	T1,RUNSFD+3
		JUMPE	T1,$E		;ALL DONE
		HRROI	T1,.GTRS4
		GETTAB	T1,		;NEXT SFD
		  JRST	$E
		MOVEM	T1,RUNSFD+4
		SETZM	RUNSFD+5	;TERMINATE WITH ZERO
	END;
  >;END IFE FTFORTRAN
	MOVE	T1,.JBREL##		;GET INITIAL .JBREL
	MOVEM	T1,RUNCOR		;SO WE CAN CALCULATE MEMORY REQUIRED
>;END IFE FTOPS20
IFN FTOPS20,<
	MOVE 	T1,.JBFF##		;GET FIRST FREE
	MOVEI	T1,400000		;*** TEMPORARY ***
	HRRZM	T1,MAXFRE		;MAX LOC TO BE USED
	SETO	T1,			;GET JOB INFO FOR THIS JOB
	HRROI	T2,T2			;ONE WORD RETURNED IN T2
	MOVX	T3,.JIRS		;GET DEFAULT MTA RECORD SIZE
	GETJI				; ..
	 ERJMP	[$ERROR (?,GJF,<GETJI failure at initialization time>)]
	MOVEM	T2,DFMTRS		;SAVE DEFAULT MTA RECORD SIZE
>
	BEGIN				;SETUP INITIAL VALUES
		MOVSI	T1,-MX.TMP	;NO. OF POSSIBLE TEMP STRS
		MOVEM	T1,TCBIDX	;...
		MOVEI	T1,MX.TMP	;USE ALL POSSIBLE TEMP FILES
		MOVEM	T1,MAXTMP	;IF STAND-ALONE SORT
		SETOM	P.BLKF		;BLOCKING FACTOR
		SETOM	P.VARF		;VARIABLE/FIXED RECORDS
		SETOM	P.INDU		;[143] /INDUSTRY
IFN FTFORTRAN,<
		PUSHJ	P,ALCHN		;GET A CHANNEL FOR FORTRAN
>
		SETOM	RTRUNC		;FOR TRUNCATION MESSAGE
	END;
	BEGIN
	;DETERMINE AND RECORD CPU TIME AND TIME OF DAY AT START OF SORT
IFE FTOPS20,<
		SETZ	T1,		;SELECT CURRENT JOB
		RUNTIM	T1,
>
IFN FTOPS20,<
		HRROI	T1,-5		;WHOLE JOB
		RUNTM
>
		MOVEM	T1,CPUTIM	;INITIAL CPU TIME IN MS
IFE FTOPS20,<
		MSTIME	T1,
>
IFN FTOPS20,<
		TIME
>
		MOVEM	T1,ORGTIM	;INITIAL TIME OF DAY IN MS
		PUSHJ	P,GETJOB	;GET JOB NUMBER
	END;
	RETURN
END;

SUBTTL	SCAN CONTROL ROUTINES

IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(PUSHJ	P,CLRFIL)
	SETOM	TEMPSW		;RESET NOT SEEN FLAG
	SKIPGE	T1,P.BLKF	;ALREADY SEEN A DEFAULT?
	SKIPL	T1,F.BLKF	;NO, TRY TEMP  BLOCKING FACTOR?
	MOVEM	T1,P.BLKF	;YES, USE THIS AS IT
	SKIPG	T1,P.LABL	;ALREADY SEEN LABEL?
	SKIPL	T1,F.LABL	;NO, TRY TEMP
	MOVEM	T1,P.LABL	;AS DEFAULT
	SKIPGE	T1,P.VARF	;[143] ALREADY SEEN DEFAULT?
	SKIPL	T1,F.VARI	;[143] NO--TRY FILE VAR/FIX
	MOVEM	T1,P.VARF	;[143] YES--USE THIS AS IT
	SKIPGE	T1,P.INDU	;ALREADY GOT A DEFAULT
	SKIPL	T1,F.INDU	;NO, DO WE NOW?
	MOVEM	T1,P.INDU	;YES
	SKIPGE	T1,P.STDA
	SKIPL	T1,F.STDA
	MOVEM	T1,P.STDA
	PJRST	CLRLOC		;FALL INTO CLRLOC
END;

>;END IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,CLRANS)
	;SET ALL FULL WORD QUANTITIES TO NULL
	; THAT IS -1 (FOR SCAN)
	;CALLED FROM SCAN BEFORE EACH "*" ONLY
	SETZM	F.INZR
	SETZM	F.OUZR
	SETZM	F.TMZR
	SETZM	FSTKEY
	SETZM	LSTKEY
IFE FTOPS20,<
	SETZM	PRIORI
>
IFN FTCOL,<
	SETZM	COLSW
>
	SETOM	CORSIZ	
	SETOM	ALIGN
	SETOM	RECORD
	SETOM	MRGSW
	SETOM	WSCSW
	SETOM	NUMRCB
	SETOM	ERRADR
	SETOM	FERCOD
;	PJRST	CLRLOC		;COMMON RETURN
END;


BEGIN
  PROCEDURE	(PUSHJ	P,CLRLOC)
	SETOM	F.BLKF
	SETOM	F.LABL
	SETOM	F.VARI
	SETOM	F.INDU
	SETOM	F.STDA
	SETOM	F.REW
	SETOM	F.UNL
	RETURN
END;
IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(PUSHJ	P,MEMSTK)
	;ROUTINE TO MEMORIZE STICKY DEFAULTS
	;STORE RESULTS IN P.????

	SKIPL	T1,F.BLKF	;GET BLOCKING FACTOR
	MOVEM	T1,P.BLKF
	SKIPL	T1,F.LABL	;GET LABEL
	MOVEM	T1,P.LABL
	SKIPL	T1,F.VARI	;[143] GET FIX/VAR
	MOVEM	T1,P.VARF	;[143] STORE IF IT WAS SET
	SKIPL	T1,F.INDU
	MOVEM	T1,P.INDU
	SKIPL	T1,F.STDA
	MOVEM	T1,P.STDA
	RETURN
END;

DEFINE	APPLY (X,Y)<
	MOVE	T1,X		;DEFAULT
	SKIPGE	Y		;PARTICULAR SET
	MOVEM	T1,Y		;NO, APPLY DEFAULT
>
BEGIN
  PROCEDURE	(PUSHJ	P,APPSTK)
	APPLY	P.BLKF,F.BLKF
	APPLY	P.LABL,F.LABL
	APPLY	P.VARF,F.VARI
	APPLY	P.INDU,F.INDU
	APPLY	P.STDA,F.STDA
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,CLRSTK)	;ROUTINE TO CLEAR STICKY DEFAULTS
				;JUST A NO-OP FOR NOW
	RETURN
END;
SUBTTL	SWITCH HANDLING -- /FORMAT:xn.m

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,USRFMT)	;STORE THE /FORMAT ARGUMENT
	SKIPN	T1,LSTKEY		;GET POINTER TO KEY BLOCK
	JRST	E$$FSM			;/KEY BEFORE /FORMAT
	SKIPE	KY.FMT(T1)		;ONLY ONE /FORMAT PER /KEY
	JRST	E$$OOF			;COMPLAIN
	MOVE	T2,.NMUL		;GET FORMAT ARGUMENT
	MOVE	T3,.NMUL+1		;
	DMOVEM	T2,KY.FMT(T1)		;TO KEY BLOCK
	MOVX	T1,RM.FPA	;[203] MODE IS FLOATING POINT ASCII
	IORM	T1,MODE		;
	IORM	T1,MODEM	;REMEMBER TO GETSEG DECODE
	MOVE	T0,[POINT 6,.NMUL]	;POINT AT FORMAT TYPE

	ILDB	T4,T0		;GET FORMAT TYPE
	CAIL	T4,'D'		;
	CAILE	T4,'G'		;
	JRST	E$$FSA		;MUST BE D, E, F OR G

	ILDB	T4,T0		;GET FIRST WIDTH DIGIT
	CAIL	T4,'0'		;
	CAILE	T4,'9'		;
	JRST	E$$FSA		;NOT A DIGIT

	ILDB	T3,T0		;GET SECOND DIGIT
	JUMPE	T3,$1		;SKIP IF NULL
	CAIN	T3,'.'		; OR A PERIOD
	JRST	$1		;
	CAIL	T3,'0'		;
	CAILE	T3,'9'		;
	JRST	E$$FSA		;NOT A DIGIT
	ILDB	T3,T0		;GET NEXT

	LDB	T4,[POINT 10,.NMUL,17];GET THE TWO DIGIT WIDTH
  $1%	PUSH	P,T4		;SAVE FOR RANGE CHECK
	JUMPE	T3,$2		;NULL SO NO DECIMAL PLACES
	CAIE	T3,'.'		;1 OR 2 DIGITS PLUS "."?
	JRST	E$$FSA		;NO, COMPLAIN

	ILDB	T4,T0		;GET FIRST DIGIT
	CAIL	T4,'0'		;
	CAILE	T4,'9'		;
	JRST	E$$FSA		;NOT A DIGIT

	ILDB	T3,T0		;GET SECOND DIGIT
	JUMPE	T3,$2		;SKIP IF NULL
	CAIL	T3,'0'		;
	CAILE	T3,'9'		;
	JRST	E$$FSA		;NOT A DIGIT
	ILDB	T2,T0		;GET TERMINATOR
	JUMPN	T2,E$$FSA	;MUST BE A NULL

	LSH	T4,6		;MAKE ROOM FOR LOW ORDER DIGIT
	XORI	T4,'0 '(T3)	;GET IT AND ZERO BIT25
  $2%	POP	P,T2		;GET TOTAL WIDTH
	CAMGE	T2,T4		;SKIP IF WIDTH GE TO DECIMAL PLACES
	JRST	E$$FSA		;OOPS - COMPLAIN

	LDB	T0,[POINT 4,T2,29] ;CONVERT SIXBIT WIDTH TO BINARY
	IMULI	T0,^D10		;
	LDB	T3,[POINT 4,T2,35]
	ADD	T0,T3		;
	MOVE	T3,LSTKEY	;INDEX TO LAST KEY BLOCK
	CAME	T0,KY.SIZ(T3)	;MUST EQUAL KEY SIZE
	JRST	E$$FSA		;
	RETURN
END;
>;END IFE FTFORTRAN
SUBTTL	COLLATING SEQUENCE TABLE ROUTINES

IFN FTCOL,<
BEGIN
  PROCEDURE	(PUSHJ	P,CHKCOL)
	HRRZ	T1,COLSW	;GET INDEX
  CASE COLLATING SEQUENCE OF (ASCII,EBCDIC,FILESPEC,LITERAL,ADDRESS)
	JRST	@[EXP $1,$2,COLTRX,COLTRL,COLTRA]-1(T1)	;DISPATCH ON KEY WORD

  $1%	;ASCII
	  CASE I/O MODE OF (ASCII,SIXBIT,EBCDIC,BINARY)
		HRRZ	T1,MODE
		MOVE	T1,[EXP 0,0,ALP.97,0]-1(T1)
	  ESAC;
	JRST	$C

  $2%	;EBCDIC
	  CASE I/O MODE OF (ASCII,SIXBIT,EBCDIC,BINARY)
		HRRZ	T1,MODE
		MOVE	T1,[EXP ALP.69,ALP.79,0,0]-1(T1)
	  ESAC;
;	JRST	$C

  ESAC;
	MOVEM	T1,COLSW	;STORE POINTER
	RETURN
END;
;STILL IN IFN FTCOL
BEGIN
  PROCEDURE	(PUSHJ P,BLDCOL)
;CALL	MOVE	T1,LOCATION OF THE NEW TABLE
;	MOVEI	T2,GET THE NEXT CHARACTER ROUTINE
;	PUSHJ	P,BLDCOL
;RETURN	CPOPJ			;ILLEGAL ARGUMENTS (TABLE INVALID)
;	CPOPJ1			;TABLE IS BUILT

;	AC USAGE	P1=XWD LOCAL FLAGS,CURRENT COLLATING INDEX
			COL.MI==1B1	;PENDING MINUS SIGN
			COL.EQ==1B2	;PENDING EQUAL SIGN
;			P2=LAST CHARACTER VALUE SEEN
;			P3=ADDRESS OR ROUTINE TO GET THE NEXT CHARACTER
;			P4=LOCATION OF THE COLLATING BLOCK
	PUSHJ	P,.SAVE4	;SAVE THE P'S
	MOVEI	P4,(T1)		;COPY THE TABLE ADDRESS
	MOVEI	P3,(T2)		;COPY NEXT CHARACTER ROUTINE
	MOVE	T1,[XWD 707070,707070]
	MOVEM	T1,(P4)		;INITIALIZE THE TABLE
	HRLZI	T1,(P4)		;MAKE A BLT POINTER
	HRRI	T1,1(P4)
	BLT	T1,177(P4)	;SET THE TABLE TO 707070,707070
	SETZ	P1,		;START AT COL. INDEX =0
  $1%	TLZE	P1,(COL.MI)	;PENDING MINUS SIGN
	JRST	$6			;YES,
	TLZE	P1,(COL.EQ)	;PENDING EQUAL SIGN
	JRST	$3			;YES
	PUSHJ	P,(P3)		;GET THE NEXT ALT SEQ CHARACTER
	  JRST	BLDCOE		;END OF INPUT GO FILL THE TABLE
	CAIN	T1,"-"		;IS IT A RANGE OF VALUES
	JRST	$6			;YES
	CAIN	T1,"="		;CHECK FOR AN EQUAL
	JRST	$3			;YES
	CAIN	T1,""""		;IS IT A QUOTE
	JRST	$2		;YES, PROCESS A QUOTED STRING
	CAIE	T1,","		;SEPERATOR
	CAIN	T1," "		;TOP LEVEL BLANK
	JRST	$1			;YES SKIP IT
	CAIL	T1,"0"		;CHECK FOR A DIGIT
	CAILE	T1,"7"		;IN THE OCTAL RANGE
	POPJ	P,		;NO, ERROR NOTHING LEFT TO LOOK AT
	PUSHJ	P,BLDIGT	;GET THE DIGITS
	  POPJ	P,		;ILLEGAL DIGITS
	PUSHJ	P,BLDCOS	;STORE THE VALUE
	AOJA	P1,$1		;UPDATE THE INDEX AND TRY AGAIN
	JRST	$1			;GET THE NEXT CHARACTER
  $2%	PUSHJ	P,(P3)		;GET THE NEXT CHARACTER
	  POPJ	P,		;END OF DATA WITH NO ENDING QUOTE
	CAIN	T1,""""		;IS THE A QUOTE IE ENDING
	JRST	$1			;YES, GET THE NEXT CHARACTER
	PUSHJ	P,BLDCOS	;STORE THE INDEX VALUE FOR THE CHARACTER
	AOJA	P1,$2		;INCREMENT THE INDEX GET NEXT CHARACTER

  $3%	SOJL	P1,CPOPJ	;BAKUP THE INDEX TO THE PREVIOUS VALUE
				;(ERROR IF NO PREVIOUS VALUE)
	PUSHJ	P,(P3)		;GET THE NEXT CHARACTER
	  POPJ	P,		;ILLEGAL SEQUENCE
	CAIE	T1,""""		;A SRING
	JRST	$5			;NO
  $4%	PUSHJ	P,(P3)		;GET THE NEXT CHARACTER OF THE STRING
	  POPJ	P,		;ILLEGAL SEQUENCE
	CAIN	T1,""""		;END OF STRING
	AOJA	P1,$1		;YES, RESTORE THE INDEX GET NEXT CHARACTER
	PUSHJ	P,BLDCOS	;STORE THE CHARACTER
	JRST	$4			;NO, GET THE NEXT STRING CHARACTER
  $5%	PUSHJ	P,BLDIGT	;GET THE DIGITS
	  POPJ	P,		;ILLEGAL DIGITS
	PUSHJ	P,BLDCOS	;STORE THE INDEX
	AOJA	P1,$1		;RETURN FOR NEXT CHARACTER

  $6%	PUSHJ	P,(P3)		;GET THE SECOND VALUE
	  POPJ	P,		;ILLEGAL STRING
	CAIE	T1,""""		;QUOTED STRING
	JRST	$7			;NOPE
	PUSHJ	P,(P3)		;YES, GET THE CHARACTER
	  POPJ	P,		;ILLEGAL STRING
	PUSH	P,T1		;SAVE THE CHARACTER
	PUSHJ	P,(P3)		;GET THE NEXT CHARACTER
	  CAIA			;SKIP ON ERROR
	CAIE	T1,""""	;MUST END WITH QUOTE
	  JRST	[POP	P,(P)	;ILLEGAL STRING REMOVE THE SAVED CHARACTER
		POPJ	P,]	;RETURN
	POP	P,T1		;RESTORE THE CHARACTER
	JRST	$8		;CONTINUE
  $7%	PUSHJ	P,BLDIGT	;CHECK FOR A DIGIT
	  POPJ	P,		;ILLEGAL DIGIT
  $8%	MOVEI	T4,(T1)		;SAVE THE ENDING CHARACTER
  $9%	AOS	T1,P2		;INCREMENT LAST CHARACTER STORED
	CAMLE	T1,T4		;CHECK THE RANGE
	JRST	$1			;END OF RANGE
	PUSHJ	P,BLDCOS	;STORE IN THE TABLE
	AOS	P1		;INCREMENT THE INDEX
	JRST	$9		;CONTINUE UNTIL EQUAL
END;
;STILL IN IFN FTCOL
BEGIN
  PROCEDURE	(PUSHJ	P,BLDCOS)
;SUBROUTINE BLDCOS - STORE THE CURRENT CHARACTER IN THE TABLE
;CALL	PUSHJ	P,LDCOS
;RETURN	CPOPJ
	MOVEI	P2,(T1)		;SAVE THE CHARACTER
	IDIVI	T1,2		;GET THE TABLE INDEX AND WHICH HALF
	ADDI	T1,(P4)		;TABLE OFFSET
	XCT	[HRLM	P1,(T1)	     ;STORE IN THELEFT HALF (EVEN)
		HRRM	P1,(T1)](T2) ;STORE IN THE RIGHT HALF (ODD)
	RETURN
END;

;SUBROUTINE BLDCOE - WILL IN THE MISSING ELEMNET OF THE TABLE
;CALL	PJRST	BLDCOE WHIN END OF THE COLLATING STRING
;RETURN	CPOPJ1

BEGIN
  PROCEDURE	(PUSHJ	P,BLDCOE)
	MOVSI	T4,-200		;SIZE OF THE TABLE
	HRRI	T4,(P4)		;ADDRESS OF THE TABLE
  $1%	HLRZ	T1,(T4)		;GET THE LEFT HALF ENTRY
	CAIE	T1,707070	;CHECK FOR A NULL ENTRY
	JRST	$2			;NO, IT WAS USED
	HRLM	P1,(T4)		;STORE THE CURRECT INDEX
	AOS	P1		;INCREMENT THE INDEX
  $2%	HRRZ	T1,(T4)		;GE THE RIGHT HALF
	CAIE	T1,707070	;IS IT EMPTY
	JRST	$3			;NO
	HRRM	P1,(T4)		;YES, SET THE INDEX
	AOS	P1		;STEP THE INDEX
  $3%	AOBJN	T4,$1		;CONTINUE THRU THE TABLE
	AOS	(P)		;SKIP RETURN
	RETURN
END;
;STILL IN IFN FTCOL
BEGIN
;SUBROUTINE BLDIGT - CONVERT A STRING OF DIGITS
;CALL	MOVEI	T1,FIRST DIGIT
;	PUSHJ	P,BLDIGT
;RETURN	CPOPJ			;NOT DIGITS
;	CPOPJ1			;T1=BINARY DIGITS
  PROCEDURE	(PUSHJ	P,BLDIGT)
	SETZ	T2,		;CLEAR THE OUTPUT WORD
	JRST	$1		;CONTINUE BELOW
  $5%	PUSHJ	P,(P3)		;GET THE CHARACTER
	  JRST	$2			;END OF INPUT
  $1%	CAIN	T1,"="		;CHECK FOR SEPERATORS
	JRST	$3			;YES
	CAIN	T1,"-"
	JRST	$4		;YES
	CAIE	T1," "		;OR BLANKS (FORTRAN LITERALS)
	CAIN	T1,","		;MUST END WITH A COMMA
	JRST	$2			;YES, END OF STRING
	CAIL	T1,"0"		;DID A DIGIT ARRIVE
	CAILE	T1,"7"
	POPJ	P,		;ERROR ILLEGAL SEPERATOR
	LSH	T2,3		;YES, MAKE ROOM FOR THE DIGITS
	ADDI	T2,-<"0">(T1)	;ACCUMLATE THE SUM
	JRST	$5		;GET THE NEXT DIGITS
  $3%	TLOA	P1,(COL.EQ)
  $4%	TLO	P1,(COL.MI)
  $2%	MOVE	T1,T2		;COPY THE RESULT
	AOS	(P)		;SKIP RETURN
	RETURN
END;
BEGIN
 PROCEDURE	(PUSHJ	P,COLTRL)
	MOVE	T1,[POINT 7,COLITB]	;FORM BYTE POINTER
	MOVEM	T1,COLPTR+2
	MOVEI	T1,COLBUF
	MOVEM	T1,COLSW	;POINT TO TABLE
	MOVEI	T2,COLLCH	;INPUT ROUTINE
	PUSHJ	P,BLDCOL	;BUILD THE TABLE
	  JRST	E$$ICS
	RETURN
END;

BEGIN
 PROCEDURE	(PUSHJ	P,COLTRA)
	MOVE	T1,COLBUF	;GET ADDRESS OF USERS TABLE
	HRLI	T1,(POINT 7,)	;FORM BYTE POINTER
	MOVEM	T1,COLPTR+2
	MOVEI	T1,COLBUF
	MOVEM	T1,COLSW	;POINT TO TABLE
	MOVEI	T2,COLLCH	;INPUT ROUTINE
	PUSHJ	P,BLDCOL	;BUILD THE TABLE
	  JRST	E$$ICS
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,COLLCH)
	ILDB	T1,COLPTR+2	;GET A CHAR
	JUMPE	T1,CPOPJ	;STOP ON NULL
	CAIGE	T1," "		;IGNORE CONTROL CHAR
	JRST	$B
	AOS	(P)		;SKIP RETURN
	RETURN
END;
>;END IFN FTCOL
SUBTTL	PSORT. -- SORT Initialization Following Command Scanning

BEGIN
  PROCEDURE	(PUSHJ	P,PSORT.)
	SKIPN	T1,LSTKEY	;GET LAST KEY SEEN
	JRST	E$$OKR		;AT LEAST ONE KEY REQUIRED
	MOVE	T2,MODE		;GET MODE OF LAST KEY
	MOVEM	T2,KY.MOD(T1)	;STORE IT
	MOVE	T2,MODEM	;GET MASK OF ALL MODE BITS
	ANDX	T2,RM.ASC!RM.SIX!RM.EBC!RM.BIN!RM.FOR!RM.FPA
	MOVEM	T2,MODE		;CLEAR TEMP BITS AND RHS
	PUSHJ	P,SETMOD	;SETUP SORT MODE
IFN FTCOL,<
	SKIPE	COLSW		;COLLATING SWITCH SEEN?
	PUSHJ	P,CHKCOL	;YES, SEE WHAT IT WAS
>
	SKIPLE	T1,RECORD	;NUMBER OF BYTES IN RECORD
	JRST	$2		;SPECIFIED
	SKIPG	T1,RECOUT	;SEE IF ON OUTPUT SIDE
	JRST	E$$RSR		;ERROR
	MOVEM	T1,RECORD	;STORE IT
  $2%	IDIV	T1,BPWORD	;GET NO. OF WORDS
	SKIPE	T2		;RESIDUE ?
	ADDI	T1,1		;YES, INCREMENT NUMBER OF WORDS
	MOVEM	T1,RECSIZ	;SET RECORD SIZE
	MOVEM	T1,REKSIZ	;INITIAL IN-MEMORY RECORD SIZE
  IF I/O MODE IS SIXBIT OR VARIABLE EBCDIC
	HRRZ	T1,IOMODE	;[201] FETCH EXTERNAL I/O MODE INDEX
	CAXN	T1,MODSIXBIT	;[201] SIXBIT?
	JRST	$1		;[201] YES--GO INCLUDE COUNT WORD IN RECSIZ
	CAXN	T1,MODEBCDIC	;[201] EBCDIC?
	SKIPG	P.VARF		;[201] SO FAR SO GOOD. VARIABLE TOO?
	JRST	$F		;[201] NO--NO COUNT WORD THEN
  $1%
  THEN EXTERNAL RECORD INCLUDES A COUNT WORD TOO
	AOS	RECSIZ		;[201] REALLY 4 BYTES (= 1 WORD) FOR EBCDIC
  FI;
	PUSHJ	P,SETTMP	;[214] GET ALL TEMP FILES USER SPECIFIED
IFE FTOPS20,<
	PUSHJ	P,PRUNE		;[214] PRUNE NULL FILES FROM LISTS
>
	PUSHJ	P,SETUPO	;SETUP OUTPUT FILES
	PUSHJ	P,SETUPI	;SETUP INPUT FILES
IFE FTFORTRAN,<
  IF S/A SORT & FORTRAN FLOATING-POINT ASCII WAS SPECIFIED
	MOVE	T1,MODEM	;GET MASK OF ALL MODE SWITCHES TYPED
  IFN FTOPS20,<
	SKIPN	FORTPP		;IGNORE IF CALLED BY FORTRAN
  >
	TXNN	T1,RM.FPA	;FORTRAN FLOATING-POINT ASCII?
	JRST	$F		;NO--SKIP THIS
  THEN BUILD A LOW SEGMENT DATA BASE FOR FOROTS
	MOVX	T1,FRE.SZ+LOW.SZ;STATIC AREA + JUST ENOUGH FOR US
	PUSHJ	P,GETSPC	;GO ALLOCATE THAT MUCH
	  JRST	E$$NEC		;NOT ENUF MEMORY
	HRRM	T1,.JBOPS##	;STORE WHERE FOROTS LOOKS FOR IT
	MOVEI	T2,LOW.SZ(T1)	;BUILD FREE MEMORY LIST WITH 1 BLOCK
	MOVEM	T2,FRE.DY(T1)	;  ..
	MOVSI	T2,FRE.SZ	;LENGTH OF THIS BLOCK
	MOVEM	T2,LOW.SZ(T1)	;STORE AT BEGINNING OF BLOCK
  IFN FTOPS20,<
	MOVEI	T2,ENTVEC	;GET ADDR OF CALLING ROUTINE FOR TRACE
  >
  IFE FTOPS20,<
	MOVEI	T2,START	;...
  >
	MOVEM	T2,SA.ADR(T1)	; ..
  FI;
>;END IFE FTFORTRAN
	MOVX	T1,2000		;PLENTY TO BUILD EXTRACT AND COMPARE CODE
	PUSHJ	P,GETSPC	;GO ALLOCATE IT
	  JRST	E$$NEC		;FAILED
	HRRZM	T1,EXTRCT	;WHERE EXTRACT KEY CODE WILL GO
	PUSHJ	P,KEYEXT	;GENERATE CODE TO EXTRACT KEYS
	PUSHJ	P,KEYGEN	;GENERATE CODE FOR KEY COMPARES
	MOVEI	T1,1		;ACCOUNT FOR HEADER WORD
	ADD	T1,XTRWRD	;PLUS EXTRACTED KEYS
	ADDM	T1,REKSIZ	;NEW RECORD SIZE IN MEMORY
	MOVE	T1,MAXKEY	;GET NO. OF BYTES WE REALLY NEED
	IDIV	T1,BPWORD	;IN WORDS
	SKIPE	T2
	ADDI	T1,1		;COUNT REMAINDER
	ADD	T1,XTRWRD	;ACCOUNT FOR EXTRACTED KEYS
	MOVEM	T1,MAXKEY	;STORE BACK FOR GTTREC
	MOVEI	T1,MSTEOF	;END OF FILE INTERCEPT ADDRESS
	MOVEM	T1,LOGEOF	;LOGICAL EOF
	MOVEM	T1,PHYEOF	;PHYSICAL EOF
  IF /MERGE
	SKIPLE	MRGSW
  THEN INITIALIZE UP TO MX.TMP OF THE INPUT FILES
	PUSHJ	P,SETMRG	;SETUP DIFFERENTLY
  FI;
	PJRST	CHKCOR		;CHECK AND SET MEMORY SIZE, GOTO LOSEG
END;
SUBTTL	PSORT. -- SETMOD - Set Up Recording Mode for SORT

BEGIN
  PROCEDURE	(PUSHJ	P,SETMOD)
	HLLZ	U,MODEM		;GET MASK OF ALL MODE BITS
  IF RECORDING MODE IS BINARY AND NOT FORTRAN
	TXNN	U,RM.FOR	;FORTRAN BINARY IS OK
	TXNN	U,RM.BIN	;BINARY IS SPECIAL
	JRST	$F
  THEN CHECK /FIX /VARIABLE SETTINGS
	SKIPLE	P.VARF		;CANNOT HAVE /VARIABLE WITH BINARY
	JRST	E$$BNV
	SETZM	P.VARF		;FORCE FIXED LENGTH
  FI;
	LDB	T1,[POINT 3,U,^L<RM.EBC>]	;GET ASCII/SIXBIT/EBCDIC SWITCH
	JRST	@.+1(T1)	;DISPATCH
		SETMU		;UNDEFINED
		SETME		;EBCDIC
		SETMS		;SIXBIT
		E$$MSC		;ERROR
		SETMA		;ASCII
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR

SETMU:	TXNE	U,RM.BIN	;BINARY ONLY?
	JRST	SETMB		;YES
	TXNN	U,RM.COM!RM.PAC	;COMPUTATIONAL?
	JRST	SETMA		;NO, SO USE ASCII BY DEFAULT
	TXNE	U,RM.PAC	;COMP-3?
	JRST	SETME		;YES, EBCDIC BY DEFAULT
SETMS:	TXNE	U,RM.PAC	;/SIX /PAC
	JRST	E$$MSC		;ERROR
	HRRI	U,MODSIXBIT	;SIXBIT
	TXNN	U,RM.BIN	;[203] UNLESS FILE IS ALREADY BINARY,
	HRRZM	U,P.VARF	;[105] FORCE SIXBIT TO BE VARIABLE
	JRST	RETMOD

SETMA:	TXNE	U,RM.PAC	;/ASC /PAC ?
	JRST	E$$MSC		;ERROR
	MOVX	T1,RM.ASC	;TURN ON ASCII BIT INCASE BY DEFAULT
	IORM	T1,MODE		;AND STORE BACK IN MODE
	HRRI	U,MODASCII	;ASCII
	SKIPGE	P.VARF		;DID USER SPECIFY FIXED LENGTH
	HRRZM	U,P.VARF	;[105] NO, ASSUME VARIABLE SIZE
	TXNE	U,RM.FOR	;FORTRAN ASCII?
	HRRZM	U,ALIGN		;[105] YES, FORCE WORD ALIGNMENT
	JRST	RETMOD

SETME:	HRRI	U,MODEBCDIC
	JRST	RETMOD

SETMB:	SKIPGE	P.VARF		;DID USER SPECIFY FIXED LENGTH
	HRRZM	U,P.VARF	;[105] NO, ASSUME VARIABLE SIZE
	HRRI	U,MODBINARY
;	JRST	RETMOD

RETMOD:	HRRM	U,MODE		;STORE MODE BACK
	MOVE	T2,[EXP 6,5,4,1]-1(U)
	MOVEM	T2,BPWORD	;NO. OF BYTES PER WORD
  IF RECORDING MODE IS BINARY
	TXNE	U,RM.BIN	;[201] LEAVE MODE ALONE UNLESS /BINARY
  THEN I/O MODE IS BINARY
	HRRI	U,MODBINARY	;[201] /BINARY FORCES BINARY I/O
  FI;
	HRRM	U,IOMODE	;[201] SAVE SO I/O ROUTINES WILL KNOW
	MOVE	T2,[EXP 6,5,4,1]-1(U) ;[300] NUMBER OF I/O BYTES PER WORD
	MOVEM	T2,IOBPW	;[201] SAVE FOR I/O ROUTINES
	RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,JMODES)
	;ENTER WITH 
	;J = MODES + INDEX
	;RETURN WITH
	;J = TYPE INDEX
	MOVE	T1,J
	HLLZ	J,J		;LEAVE ROOM FOR NEW INDEX
	JRST	@.(T1)		;DISPATCH
		SETKS		;SIXBIT
		SETKA		;ASCII
		SETKE		;EBCDIC
		SETKB		;BINARY

SETKS:	LDB	T1,[POINT 3,J,^L<RM.NUM>]	;GET NEXT BITS
	JRST	@.+1(T1)	;DISPATCH
		SETMSU		;UNDEFINED
		SETMSN		;NUMERIC
		SETMSC		;COMPUTATIONAL
		E$$MSC		;ERROR
		SETMSA		;ALPHANUMERIC
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR

SETMSU:	TXNN	J,RM.SGN!RM.UNS	;SIGN SPECIFIED?
	JRST	SETMSA		;NO, ALPHANUMERIC BY DEFAULT
SETMSN:	TXNN	J,RM.UNS	;SPECIFICALLY UNSIGNED?
	TROA	J,IX.NSS	;NO, NUMERIC SIGNED SIXBIT
	HRRI	J,IX.NUS	;YES, NUMERIC UNSIGNED SIXBIT
	RETURN

SETMSC:	TXNN	J,RM.UNS	;SPECIFICALLY UNSIGNED?
	TROA	J,IX.CSS	;NO, COMPUTATIONAL SIGNED SIXBIT
	HRRI	J,IX.CUS	;YES, COMPUTATIONAL UNSIGNED SIXBIT
	RETURN


SETKA:	LDB	T1,[POINT 3,J,^L<RM.NUM>]	;GET NEXT BITS
	JRST	@.+1(T1)	;DISPATCH
		SETMAU		;UNDEFINED
		SETMAN		;NUMERIC
		SETMAC		;COMPUTATIONAL
		E$$MSC		;ERROR
		SETMAA		;ALPHANUMERIC
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR

SETMAU:	TXNE	J,RM.FPA	;FORTRAN FLOATING POINT ASCII?
	JRST	SETMAF		;YES
	TXNN	J,RM.SGN!RM.UNS	;SIGNED?
	JRST	SETMAA		;NO, ALPHANUMERIC BY DEFAULT
SETMAN:	TXNN	J,RM.UNS	;SPECIFICALLY SIGNED?
	TROA	J,IX.NSA	;NO, NUMERIC SIGNED ASCII
	HRRI	J,IX.NUA	;YES, NUMERIC UNSIGNED ASCII
	RETURN

SETMAC:	TXNN	J,RM.UNS	;SPECIFICALLY SIGNED?
	TROA	J,IX.CSA	;NO, COMPUTATIONAL SIGNED ASCII
	HRRI	J,IX.CUA	;YES, COMPUTATIONAL UNSIGNED ASCII
	RETURN

SETKE:	LDB	T1,[POINT 4,J,^L<RM.PAC>]	;GET NEXT BITS
	JRST	@.+1(T1)	;DISPATCH
		SETMEU		;UNDEFINED
		SETMEP		;COMP-3 PACKED
		SETMEN		;NUMERIC
		SETMEP		;NUMERIC & COMP-3
		SETMEC		;COMPUTATIONAL
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ALPHANUMERIC
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR
		E$$MSC		;ERROR

SETMEU:	TXNN	J,RM.SGN!RM.UNS	;SIGNED?
	JRST	SETMEA		;NO, ALPHANUMERIC BY DEFAULT
SETMEN:	TXNN	J,RM.UNS	;SPECIFICALLY UNSIGNED?
	TROA	J,IX.NSE	;NO, NUMERIC SIGNED EBCDIC
	HRRI	J,IX.NUE	;YES, NUMERIC UNSIGNED EBCDIC
	RETURN

SETMEC:	TXNN	J,RM.UNS	;SPECIFICALLY UNSIGNED?
	TROA	J,IX.CSE	;NO, COMPUTATIONAL SIGNED EBCDIC
	HRRI	J,IX.CUE	;YES, COMPUTATIONAL UNSIGNED EBCDIC
	RETURN

SETMEA:	HRRI	J,IX.ALE	;ALPHANUMERIC
	RETURN

SETMEP:	TXNN	J,RM.UNS	;SPECIFICALLY UNSIGNED?
	TROA	J,IX.C3S	;NO, COMP-3 SIGNED
	HRRI	J,IX.C3U	;YES, COMP-3 UNSIGNED
	RETURN

SETMAA:	TROA	J,IX.ALA	;ALPHANUMERIC LOGICAL ASCII
SETMSA:	HRRI	J,IX.ALS	;ALPHANUMERIC LOGICAL SIXBIT
	RETURN

SETKB:	TXNE	J,RM.FPA	;FORTRAN FLOATING POINT ASCII?
	JRST	SETMAF		;YES
	TXNN	J,RM.UNS	;SPECIFICALLY UNSIGNED?
	TROA	J,IX.CSB	;NO, SIGNED BINARY
	HRRI	J,IX.CUB	;YES, UNSIGNED BINARY
	RETURN

SETMAF:	HRRI	J,IX.FPA	;FORTRAN FLOATING POINT ASCII
	RETURN

END;
SUBTTL	PSORT. -- KEYEXT - Generate Key Extraction Code

BEGIN
  PROCEDURE	(PUSHJ	P,KEYEXT)
	;GENERATE CODE TO EXTRACT KEYS AT RUN TIME
	MOVE	U,EXTRCT	;ADDRESS OF EXTRACT CODE
	SKIPN	R,FSTKEY	;MUST HAVE SEEN ONE
	JRST	E$$OKR		;ERROR
	MOVE	T1,[POINT 36,1(R)]
	MOVEM	T1,XTRWRD	;SETUP DEPOSIT BYTE PTR
  FOR EACH KEY DO
	BEGIN
		MOVE	J,KY.MOD(R)	;GET THIS MODE
		IOR	J,MODE		;ADD DEFAULTS
		PUSHJ	P,JMODES	;GET KEY MODE INDEX
		DMOVE	P1,KY.INI(R)	;GET FIRST BYTE AND LENGTH
		MOVE	T2,P1		;GET COPY
	  IF MODE IS NUMERIC OR COMP-3
		TXNE	J,RM.NUM!RM.PAC
	  THEN CHECK FOR TOO MANY DIGITS
		CAIG	P2,^D18
		JRST	$F
E$$TMD:		$ERROR	(?,TMD,<Too many digits in key>)
	  FI;
	  IF MODE IS COMP OR COMP-3
		TXNN	J,RM.COM!RM.PAC	;COMP IS SPECIAL
		JRST	$T
	  THEN	CALCULATE NO. OF WORDS FROM DIGITS GIVEN
		  IF COMP
			TXNN	J,RM.COM
			JRST	$T
		  THEN
			MOVE	T3,MODE
			ADD	T2,[EXP 6,5,4,1]-1(T3)	;ASSUME SINGLE PRECISION
			CAILE	P2,^D10		;IS IT
			ADD	T2,[EXP 6,5,4,1]-1(T3)	;NO
			JRST	$F
		  ELSE MUST BE COMP-3
			MOVEI	T1,2(P2)	;NO. OF DIGITS + SIGN + ROUNDING
			LSH	T1,-1		;CUT IN HALF
			ADDI	T2,(T1)		;NEW LAST BYTE
		  FI;
		JRST	$F
	  ELSE
		ADDI	T2,(P2)		;LAST BYTE
	  FI;
		CAMLE	T2,RECORD	;SEE IF IN RANGE
		JRST	E$$KOR		;NO
IFN FTKL10,<
		PUSHJ	P,@K.KLX(J)
>
IFE FTKL10,<
		MOVE	T1,CPU		;GET CPU TYPE (KL USES BIS)
		PUSHJ	P,@[EXP <Z @K.EXT(J)>,<Z @K.EXT(J)>,<Z @K.KLX(J)>](T1)	;AND PROCESS IT
>
		SKIPE	R,KY.NXT(R)	;NEXT KEY
		JRST	$B		;MORE TO DO
	END;
	$JRST$			;NO, ALL DONE
	MOVEM	U,.CMPAR	;MARK END OF EXTRACT CODE
	SOS	XTRWRD		;BACKUP BYTE PTR
	HRRZS	XTRWRD		;NO. OF EXTRA WORDS EXTRACTED
  IF ANY EXTRACTED KEYS
	SKIPN	P1,XTRBYT
	RETURN
  THEN ADJUST OTHER KEYS FOR INSERTED EXTRACTED ONES
	MOVE	R,FSTKEY	;START AT FRONT
  FOR EACH KEY DO
	BEGIN
		MOVE	J,KY.MOD(R)	;GET THIS MODE
		IOR	J,MODE		;ADD DEFAULTS
		PUSHJ	P,JMODES	;GET KEY MODE INDEX
		PUSHJ	P,@K.ADJ(J)	;PROCESS IT
		  ADDM	P1,KY.INI(R)	;ADJUST  FIRST BYTE
		SKIPE	R,KY.NXT(R)	;GET NEXT
		JRST	$B
	END;
  FI;

;NOW ADJUST EXTRACTED KEYS TO COMPENSATE FOR MOVING ACTUAL RECORD

	MOVE	R,FSTKEY	;START AT FRONT
	MOVE	U,EXTRCT
  FOR EACH KEY DO
	BEGIN
		MOVE	J,KY.MOD(R)	;GET THIS MODE
		IOR	J,MODE		;ADD DEFAULTS
		PUSHJ	P,JMODES	;GET KEY MODE INDEX
		XCT	K.ADX(J)	;PROCESS IT
		SKIPE	R,KY.NXT(R)	;GET NEXT
		JRST	$B
	END;
	RETURN
END;
SUBTTL	PSORT. -- Dispatch Tables for Key Extraction

DEFINE XX(AA,B)<
 IFIDN <B><N>,<CPOPJ>
 IFIDN <B><A>,<AA'EXT>
 IFN FTCOL,<
  IFIDN <B><C>,<AA'EXT>
 >
 IFE FTCOL,<
  IFIDN <B><C>,<CPOPJ>
 >
>

K.EXT:	IXMODE

DEFINE XX(AA,B)<
 IFIDN <B><N>,<CPOPJ>
 IFIDN <B><A>,<AA'KLX>
 IFN FTCOL,<
  IFIDN <B><C>,<AA'EXT>
 >
 IFE FTCOL,<
  IFIDN <B><C>,<CPOPJ>
 >
>

K.KLX:	IXMODE

DEFINE XX(AA,B)<
 IFIDN <B><A>,<CPOPJ1>
 IFIDN <B><N>,<CPOPJ>
 IFIDN <B><C>,<CPOPJC>
>

K.ADJ:	IXMODE

IFN FTCOL,<
CPOPJC:	SKIPE	COLSW		;CONDITIONAL COLLATING SEQUENCE
	AOS	(P)
	POPJ	P,
>
IFE FTCOL,<CPOPJC==CPOPJ>

DEFINE XX(AA,B)<
 IFIDN <B><A>,<PUSHJ	P,AA'ADX>
 IFIDN <B><N>,<NOOP>
 IFE FTCOL,<
  IFIDN <B><C>,<NOOP>
 >
 IFN FTCOL,<
  IFIDN <B><C>,<PUSHJ	P,AA'ADX>
 >
>

K.ADX:	IXMODE
SUBTTL	PSORT. -- KEYGEN - Generate Key Comparison Code

BEGIN
  PROCEDURE	(PUSHJ	P,KEYGEN)
	;GENERATE CODE TO COMPARE KEYS AT RUN TIME
	MOVE	U,.CMPAR	;ADDRESS OF COMPARE/EXTRACT CODE
	MOVE	T1,[AOS	CMPCNT]	;YES, LOAD FIRST INST
	MOVEM	T1,(U)		;INTO GENERATED CODE
	ADDI	U,1		;AND PRESERVE AOS CMPCNT INSTRUCTION
	MOVE	R,FSTKEY	;MUST HAVE SEEN ONE
  FOR EACH KEY DO
	BEGIN
		MOVE	J,KY.MOD(R)	;GET THIS MODE
		IOR	J,MODE		;PLUS DEFAULTS
		PUSHJ	P,JMODES	;GET INDEX
		DMOVE	P1,KY.INI(R)	;GET ORIGIN & LENGTH
		MOVE	S,KY.ORD(R)	;GET ORDER
		PUSHJ	P,KEYADJ	;SEE IF NEXT KEY IS ADJACENT
		PUSHJ	P,@K.GEN(J)	;AND PROCESS IT
		SKIPE	R,KY.NXT(R)	;MORE TO DO
		JRST	$B		;YES
	END;
	$JRST$			;NO, ALL DONE
	MOVEM	U,TREORG	;MARK END OF COMPAR CODE
IFN FTOPS20,<
	SKIPN	FORTPP		;CAN'T TOUCH .JBFF IF FORTRAN
>
IFE FTFORTRAN,<
	MOVEM	U,.JBFF		;RESET FREE SPACE
>
	RETURN
END;

DEFINE XX(AA,B)<
 IFIDN <B><A>,<CNVGEN>
 IFIDN <B><C>,<AA'GEN>
 IFIDN <B><N>,<AA'GEN>
>

K.GEN:	IXMODE
BEGIN
  PROCEDURE	(PUSHJ	P,KEYADJ)
	;SEE IF NEXT KEY IS ADJACENT
	HRREI	T1,-IX.ALE(J)	;ALPHANUMERICS COME FIRST IN TABLE
	JUMPG	T1,$1		;ONLY CHECK FOR ALPHANUMERIC
	SKIPE	T1,KY.NXT(R)	;ANY MORE TO DO?
	CAME	S,KY.ORD(T1)	;YES, CHECK FOR SAME ORDER
  $1%	RETURN			;GIVE UP
	MOVE	T2,KY.INI(T1)	;GET ORIGIN OF THIS KEY
	SUBI	T2,0(P2)	;SUBTRACT LENGTH OF PREVIOUS
	CAIE	T2,(P1)		;SAME ORIGIN?
	RETURN			;NO
	PUSH	P,J		;YES, NOW TEST MODE
	MOVE	J,KY.MOD(T1)
	IOR	J,MODE
	PUSHJ	P,JMODES	;SET MODE IN J
	MOVE	T1,J
	POP	P,J		;GET BACK PREVIOUS
	CAME	T1,J		;ALL THE SAME?
	RETURN			;NO
	MOVE	T1,KY.NXT(R)
	ADD	P2,KY.SIZ(T1)	;INCREMENT SIZE
	MOVEM	P2,KY.SIZ(R)	;REMEMBER THAT WE INCREMENTED
	MOVE	T2,KY.NXT(T1)
	MOVEM	T2,KY.NXT(R)	;REMOVE KEY
	JRST	$B		;TRY AGAIN
END;
SUBTTL	HIGH SEGMENT ERROR MESSAGES

E$$RSR:	$ERROR	(?,RSR,<Record size required>)
E$$KLR:	$ERROR	(?,KLR,<Key length required>)
E$$KOR:	$ERROR	(?,KOR,<Key outside of record>)
E$$KAI:	$ERROR	(?,KAI,<Key argument incorrect>)
E$$OKR:	$ERROR	(?,OKR,<At least one key is required>)
E$$MSC:	$ERROR	(?,MSC,<Mode switch conflict>)
E$$INS:	$ERROR	(?,INS,<Input file not specified>)
E$$ONS:	$ERROR	(?,ONS,<Output file not specified>)
E$$MOM:	$ERROR	(?,MOM,<Multiple output specs only on magtapes>)
E$$DMS:	$ERROR	(?,DMS,<Data mode not supported>)
E$$CWB:	$ERROR	(?,CWB,<Computational key must be on word boundary>)
E$$BNV:	$ERROR	(?,BNV,<BINARY mode does not support variable length records>)
E$$ATF:	$ERROR	(?,ATF,<At least two input files required for MERGE>)
E$$FSM:	$ERROR	(?,FSM,</FORMAT switch must be preceded by /KEY switch>)
E$$FSA:	$ERROR	(?,FSA,</FORMAT switch argument error>)
E$$OOF:	$ERROR	(?,OOF,<Only one /FORMAT switch per /KEY switch>)
IFN FTCOL,<
E$$MCS:	$ERROR	(?,MCS,<Multiple collating sequences not allowed.>)
E$$CND:	$ERROR	(?,CND,<Collating sequence not defined>)
E$$CFS:	$ERROR	(?,CFS,<Collating sequence file specification in error.>)
E$$CLS:	$ERROR	(?,CLS,<Collating sequence literal specification in error.>)
E$$CFA:	$ERROR	(?,CFA,<Collating sequence input file not available or does not exist.>)
E$$CFE:	$ERROR	(?,CFE,<Collating sequence input file error.>)
E$$ICS:	$ERROR	(?,ICS,<Illegal user supplied collating sequence>)
>
SUBTTL	FATAL ERROR CLEAN-UP ROUTINES

	SEGMENT	LOW10

BEGIN
  PROCEDURE	(,DIE)		;HERE ON FATAL ERROR

	$CRLF			;CLOSE OUT LINE

IFE FTOPS20,<
 IFE FTFORTRAN,<
	JRST	RSTART		;TRY AGAIN
 >
 IFN FTFORTRAN,<
	MOVE	P,SAVEP	;RESTORE ORIGINAL PP
  IF USERS WANTS CONTROL
	SKIPG	T1,ERRADR	;GET RETURN ADDRESS
	JRST	$T
  THEN RETURN TO FORTRAN
	HRRM	T1,0(P)		;SET USERS RETURN ADDRESS
	POPJ	P,		;RETURN TO FORTRAN

  ELSE DO FORTRAN EXIT 
	MOVEI	L,1+[EXP 0,0]
	PUSHJ	P,EXIT.##
	HALT
 >
>
IFN FTOPS20,<
	SKIPE	TAKFLG		;ARE WE TAKING FROM A FILE?
	CALL	TAKEX		;YES, CLOSE TAKE SOURCE AND LOG FILES
	CALL	ERSET%		;CLEAN UP THE MESS
	SKIPE	FORTPP		;CALLED FROM FORTRAN?
	JRST	FORERR		;YES
	MOVE	T1,OFFSET	;GET ENTRY OFFSET
	JRST	START(T1)	;AND TRY AGAIN
>
END;
SUBTTL	RELES. -- Add Input Record to Tree

BEGIN
  PROCEDURE	(PUSHJ	P,RELES.)
	MOVEM	P,PSAV		;SO WE CAN RECOVER FROM EOF
  IF /MERGE NOT SEEN
	SKIPLE	MRGSW		;MERGE ONLY?
	JRST	$T		;YES
  THEN SETUP FOR SORT
	MOVEI	F,FCBORG	;[215] SET INPUT FILE'S FILE BLOCK
	MOVE	T1,@F.INZR	;[215] GET AND REMOVE FIRST FILE'S X. BLOCK
	EXCH	T1,F.INZR	;[215]   ..
	MOVEM	T1,FILXBK(F)	;[215] SAVE IN FILE'S FILE BLOCK
	PUSHJ	P,INIINP	;[215] INITIALIZE FIRST INPUT FILE
	SETOM	BUFALC		;[215] REMEMBER WE SET BUFFERS UP
  $1%	MOVEI	F,FCBORG	;INPUT CHAN#
	JSP	P4,GETREC	;GET RECORD INTO (R)
	  PUSHJ	P,@EF		;HANDLE E-O-F
	PUSHJ	P,RELES%	;GIVE IT TO TREE
	JRST	$1		;LOOP
  ELSE SETUP FOR MERGE
	PUSHJ	P,GETMRG		;SETUP AT MOST MAXTMP FILES
	  IF IT CAN BE DONE IN 1 PASS
		SKIPE	NUMINP		;ANY LEFT TO DO
		JRST	$T		;YES, NEED MULTIPLE PASSES
	  THEN SETUP TO MERGE TO OUTPUT FILE
		MOVEI	T1,EOFMRG
		MOVEM	T1,LOGEOF
		MOVEM	T1,PHYEOF
		PUSHJ	P,INIOUT	;OPEN OUTPUT FILE
		JSP	P4,PUTREC	;WE ALREADY HAVE FIRST RECORD IN R
		MOVEI	T1,RETRNM
		SKIPLE	WSCSW		;/CHECK REQUIRED?
		MOVEI	T1,RETWSC	;YES
		MOVEM	T1,$RETRN
		HRRZS	LSTREC		;USED IF /CHECK ON
		MOVE	P,PSAV
		RETURN

	  ELSE SETUP TO DO MULTIPLE MERGE CYCLES
		MOVEI	T1,EOFMNY
		MOVEM	T1,LOGEOF
		MOVEM	T1,PHYEOF
		MOVEI	F,FCBORG
		PUSHJ	P,FSTRUN	;OPEN TEMP FILE
		FASTSKIP		;WE ALREADY HAVE FIRST RECORD IN R
	  $2%	PUSHJ	P,RETRNM	;GET NEXT RECORD
		MOVEI	F,FCBORG
		JSP	P4,PTTREC	;OUTPUT IT
		JRST	$2		;LOOP UNTIL EOF
	  FI;
  FI;
END;
;	INITIALIZE AT MOST MAXTMP INPUT FILES FOR /MERGE

BEGIN
  PROCEDURE	(PUSHJ	P,GETMRG)
	PUSH	P,ACTTMP		;ITERATION COUNT
	MOVN	T1,ACTTMP		;MINUS THE RUNS WE WILL DO THIS TIME
	ADDM	T1,NUMLFT		;RESIDUAL RUNS
	MOVEI	F,FCBORG		;PTR TO FIRST FCB FOR INPUT FILE
	MOVE	S,TREORG		;GET FIRST "WINNER"
	HRRZ	R,RN.REC(S)		;AND RECORD
  WHILE THERE ARE MERGE FILES TO INITIALIZE
	BEGIN
		ADD	F,[1,,FCBLEN]		;NEXT FILE
		MOVE	T1,@F.INZR		;[215] GET NEXT INPUT FILE
		EXCH	T1,F.INZR		;[215] SAVE NEXT, GET THIS ONE
		MOVEM	T1,FILXBK(F)		;[215] REMEMBER X. BLOCK LOC
		PUSHJ	P,INIINP		;OPEN FILE
		JSP	P4,GETREC		;GET FIRST RECORD OF MERGE FILE
		  JRST	E$$RIE			;SOMETHING WRONG
		AOS	RQ			;WILL BE RUN #1
		HRLM	F,RN.FCB(S)		;INDICATE WHICH FILE RECORD CAME FROM
		PUSHJ	P,SETTRE		;SET NEW RECORD IN TREE
		HRRZ	R,RN.REC(S)		;SET UP RECORD PTR
		SOSLE	0(P)			;IF MORE TO DO
		JRST	$B			;[215] GET NEXT RECORD
	END;
	POP	P,(P)			;GET JUNK OFF STACK
	AOS	RC			;SET CURRENT RUN TO #1
	SETOM	BUFALC			;INDICATE BUFFER RNGS FORMED
	RETURN
END;
SUBTTL	RELES. -- End of Input File -- SORT Case

BEGIN
  PROCEDURE (PUSHJ	P,MSTEOF)	;[215] MASTER INPUT FILE EOF

;[215] CALLED IN ERROR RETURN OF CALL TO GETREC WITH:
;[215] F/	POINTER TO FCB BLOCK FOR THIS FILE

	PUSHJ	P,CHKMTA		;[215] CHECK EOT IF MAGTAPE
	  RETURN			;[215] ANOTHER REEL--CONTINUE
	MOVE	T1,FILSIZ(F)		;[215] UPDATE INPUT RECORD COUNT
	ADDM	T1,INPREC		;[215]   ..
	PUSHJ	P,CLSMST		;CLOSE THE CURRENT MASTER FILE
  IF ANY MORE INPUT FILES
	SKIPN	F.INZR			;[215] LIST EMPTY?
	JRST	$T			;[215] YES--NO MORE INPUT FILES
  THEN INITIALIZE THE NEXT ONE
	MOVE	T1,@F.INZR		;[215] GET POINTER TO NEXT
	EXCH	T1,F.INZR		;[215] SWAP NEXT WITH THIS
	MOVEM	T1,FILXBK(F)		;[215] STORE IN X. BLOCK POINTER
	PUSHJ	P,INIINP		;[215] OPEN FILE AND SET MODES
	JSP	P4,GETREC		;[215] FINISH PENDING RECORD REQUEST
	  JRST	MSTEOF			;[107,215] IGNORE NULL FILES
	JRST	$F			;[215]
  ELSE RELEASE CHANNEL AND UNBIND STACK TO START MERGE
	PUSHJ	P,RELFIL		;[215] RELEASE CHANNEL
	MOVE	P,PSAV			;[215] UNBIND STACK
  FI;
	RETURN				;[215] ALL DONE
END;
SUBTTL	RELES. -- End of Input File -- MERGE Case

BEGIN
  PROCEDURE	(PUSHJ	P,EOFMNY)
	PUSHJ	P,CHKMTA		;[215] THIS MIGHT BE MULTI-REEL FILE
	  RETURN			;[215] YES--CONTINUE AS IF NOTHING HAPPENED 
	MOVE	T1,FILSIZ(F)
	ADDM	T1,INPREC		;KEEP COUNT OF INPUT RECORDS
	PUSHJ	P,RELFIL		;RELEASE CHAN
  IF NOT LAST FILE
	SOSG	ACTTMP			;ALL DONE?
	JRST	$T
  THEN TERMINATE THIS RUN AND CONTINUE
	HLLOS	RQ			;SET TERMINATING RUN#
	RETURN
  ELSE TERMINATE CYCLE AND START AGAIN
	  IF NO MORE TO DO
		SKIPE	NUMINP		;ANY MORE
		JRST	$T		;TOO BAD
	  THEN JUST RETURN
		MOVE	P,PSAV
		RETURN
	  ELSE TRY AGAIN
		MOVEI	F,FCBORG	;SET ON OUTPUT FILE
		PUSHJ	P,CLSRUN	;CLOSE THIS, OPEN NEXT RUN
		PUSHJ	P,SETMRG	;SETUP MERGE NO. AGAIN
		PUSHJ	P,INITRE	;SETUP NUL TREE AGAIN
		PUSHJ	P,GETMRG	;SETUP TEMP FILES AGAIN
		MOVEI	F,FCBORG
		JSP	P4,PTTREC	;WE ALREADY HAVE FIRST RECORD IN R
		POP	P,(P)		;GET TOP CALL OFF STACK
		PJRST	RETRNM		;CONTINUE
	  FI;
  FI;
END;
SUBTTL	RELES. -- End of Input File -- Check End Lables

BEGIN
  PROCEDURE (PUSHJ	P,CHKMTA)	;[215] SEE IF EOT OF MULTI-REEL FILE OR EOF
	PUSH	P,P1			;[215] SAVE TEMP FOR X. BLOCK
  IF WE HAVE A MAGTAPE
	PUSHJ	P,ISITMT		;IS THIS A MAGTAPE?
	JRST	$T			;NO, SKIP LABEL STUFF
  THEN CHECK END LABEL (IF ANY) AND SEE IF MULTI-REEL
	MOVE	P1,FILXBK(F)		;GET ADDR OF X. BLOCK
IFE FTFORTRAN,<
  $1%	PUSHJ	P,CHKEND		;[215] PROCESS LABEL
>
	  IF TAPE NEEDS UNLOADING
		MOVE	T1,FILFLG(F)		;[215] SEE IF USER ASKED FOR IT
		TXNE	T1,FI.UNL!FI.EOT	;[215]   OR ANOTHER REEL TO FILE
	  THEN UNLOAD TAPE
		PUSHJ	P,UNLDF			;[215] YES--UNLOAD TAPE
	  FI;
IFE FTFORTRAN,<
	  IF FILE IS MULTI-REEL
		MOVE	T1,FILFLG(F)		;[215] GET FLAGS BACK
		TXNN	T1,FI.EOT		;[215] EOT RATHER THAN EOF?
		JRST	$T			;[215] NO--WE'RE DONE
	  THEN ASK USER OR OPERATOR TO MOUNT NEXT REEL
		CLEARO				;[215] CLEAR ^O
E$$LRI:		$ERROR	($,LRI,<Load reel >,+)	;[215] ASK FOR TAPE
		MOVE	T1,X.REEL(P1)		;[215] PRINT REEL # WE WANT
		ADDI	T1,1			;[215]   ..
		$MORE	(DECIMAL,T1)		;[215]   ..
		$MORE	(TEXT,< of input file >);[215] NOW PRINT WHICH FILE
  IFE FTOPS20,<
		MOVEI	T1,X.RIB(P1)		;  ..
  >
  IFN FTOPS20,<
		HLRZ	T1,FILPGN(F)		;GET JFN
  >
		$MORE	(FILESPEC,T1)		;[215] TYPE FILESPEC
		$MORE	(TEXT,<, type CONTINUE when ready.>) ;[215]
		$CRLF				;[215] ALL DONE
		MONRET				;[215] EXIT TO ALLOW USER TO MOUNT TAPE
  IFN FTOPS20,<
		PUSHJ	P,STRTIO		;START I/O
  >
		MOVX	T1,FI.EOT		;CLEAR EOT FLAG
		ANDCAM	T1,FILFLG(F)		; ..
		PUSHJ	P,CHKLBL		;[215] CHECK NEW REEL
		PUSHJ	P,GETREC		;[215] FINISH PENDING GETREC
		  JRST	$1			;[215] WHAT?? ANOTHER LABEL SO QUICK??
		JRST	$F			;[215] WE HAVE NEW REEL SET UP NOW
	  ELSE WE'RE REALLY DONE WITH FILE, SO GIVE EOF RETURN
>
		AOS	-1(P)			;[215] EOF IS SKIP RETURN
IFE FTFORTRAN,<
	  FI;
>
	JRST	$F			;[215] NOW DONE CHECKING EOT
  ELSE NOT A TAPE, JUST GIVE EOF RETURN
	AOS	-1(P)			;[215] EOF IS SKIP RETURN
  FI;
	POP	P,P1			;[215] RESTORE TEMP
	RETURN				;[215] DONE
END;
SUBTTL	MERGE.

BEGIN
  PROCEDURE	(PUSHJ	P,MERGE.)
	MOVEM	P,PSAV			;SAVE P INCASE NEEDED
  IF NOT 1 PASS /MERGE
	SKIPLE	MRGSW
	SKIPE	NUMTMP
  THEN DO MERGE
	PJRST	MERGE%
  ELSE JUST RETURN
	RETURN
  FI;
END;
SUBTTL	RETRN. -- End of Output File

BEGIN
  PROCEDURE	(PUSHJ	P,EOFOUT)

;THIS ROUTINE IS CALLED FROM VARIOUS PLACES WHEN WE ARE FINALLY
;DONE WITH THE OUTPUT FILE.  ANY FINAL MAGTAPE PROCESSING IS DONE
;AND WE RETURN TO THE TOP LEVEL OF SORT.

	MOVEI	F,FCBORG
	PUSHJ	P,CLSMST		;CLOSE MASTER FILE
	MOVE	T1,FILSIZ(F)		;[215] REMEMBER HOW MUCH WE
	MOVEM	T1,OUTREC		;[215]   WROTE FOR ENDS.
  IF OUTPUT FILE IS A MAGTAPE
	PUSHJ	P,ISITMT		;IS IT A MAGTAPE?
	JRST	$F			;NO
  THEN WRITE EOF LABEL, AND UNLOAD TAPE IF NECESSARY
	PUSHJ	P,WRTEND		;[215] WRITE LABEL
	MOVE	T1,FILFLG(F)		;[215] CHECK FOR UNLOAD
	TXNE	T1,FI.UNL		;[215]   ..
	PUSHJ	P,UNLDF			;[215] YES--UNLOAD TAPE
  FI;
	MOVE	P,PSAV			;UNBIND STACK
	RETURN
END;
SUBTTL	RETRN. -- MSTEOT - EOT Detected on Output Tape

IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(PUSHJ	P,MSTEOT)	;[215] CONTINUE MULTI-REEL FILE

;THIS ROUTINE IS CALLED BY PUTREC WHEN AN END-OF-TAPE ERROR HAS BEEN
;DETECTED BY PUTBUF. SINCE THERE IS A PENDING RETURN FROM PUTREC IN
;P4, WE MUST SAVE IT. END-OF-TAPE PROCESSING FOLLOWS, BY WRITING
;LABELS AND UNLOADING THE OLD TAPE. IF THE NEXT DRIVE TO BE USED IS
;DIFFERENT FROM THE ONE WE JUST FINISHED WITH, A BOILED-DOWN COPY OF
;THE INIOUT ROUTINE IS USED TO SET UP ALL PROPER TAPE PARAMETERS.
;THEN, USER IS ASKED TO MOUNT THE NEXT TAPE. FINALLY, A HEADER LABEL
;IS WRITTEN.

	PUSH	P,P1			;[215] SAVE TEMP FOR X. BLOCK
	PUSH	P,P4			;[215] SAVE ORIGINAL CALLER
	MOVE	P1,FILXBK(F)		;[215] SET UP X. BLOCK
	PUSHJ	P,WRTEOF		;WRITE EOF MARK
	PUSHJ	P,WRTEOT		;[215] WRITE END LABEL
	PUSHJ	P,WRTEOF		;WRITE SECOND TAPE MARK
	PUSHJ	P,UNLDF			;[215] DONE WITH THIS TAPE
  IFE FTOPS20,<
  IF NEXT DRIVE IS DIFFERENT THAN CURRENT
	SKIPN	T1,@F.OUZR		;[215] GET NEXT DEVICE
	MOVE	T1,X.NXT(P1)		;[215] LIST ENDED--START OVER
	MOVEM	T1,F.OUZR		;[215] REMEMBER FOR NEXT TIME
	MOVE	T1,OM.DEV(T1)		;[215] GET DEVICE
	CAMN	T1,X.OPN+.OPDEV(P1)	;[215] SAME AS LAST ONE?
	JRST	$F			;[215] YES--WE'RE ALL SET
  THEN WE MUST INITIALIZE IT TO LOOK LIKE LAST DRIVE
	MOVEM	T1,X.OPN+.OPDEV(P1)	;[215] STORE DEVICE FOR OPEN
	HLLZ	T1,CHNMAP+0		;[215] GET OUTPUT CHANNEL
	ADD	T1,[OPEN X.OPN(P1)]	;[215] TURN INTO OPEN UUO
	DMOVE	T2,FILHDR(F)		;[215] SAVE HEADER AND BYTE POINTER
	XCT	T1			;[215] OPEN NEW DRIVE
	  JRST	ERROFF			;[215] FAILED?!!?
	DMOVEM	T2,FILHDR(F)		;[215] RESTORE HEADER AND POINTER
	PUSHJ	P,STAPF			;[215] SET UP DENSITY, ETC.
  FI;
  >;END IFE FTOPS20
	CLEARO				;[215] CLEAR ANY ^O
E$$LRO:	$ERROR	($,LRO,<Load reel >)	;[215] ASK USER FOR NEXT TAPE
	MOVE	T1,X.REEL(P1)		;[215] SAY WHICH REEL
	ADDI	T1,1			;[215]   ..
	$MORE	(DECIMAL,T1)		;[215]   ..
	$MORE	(TEXT,< of output file >)
  IFE FTOPS20,<
	MOVEI	T1,X.RIB(P1)		;LOAD ADDR OF RIB
  >
  IFN FTOPS20,<
	HLRZ	T1,FILPGN(F)		;LOAD JFN
  >
	$MORE	(FILESPEC,T1)		;[215] SAY WHICH FILE
	$MORE	(TEXT,<, type CONTINUE when ready.>)
	MONRET				;[215] WAIT FOR REEL
	PUSHJ	P,WRTLBL		;[215] WRITE HEADER ON NEW REEL
	POP	P,P4			;[215] RESTORE TEMPS
	POP	P,P1			;[215]   ..
	RETURN				;[215] DONE
END;
>
SUBTTL	RETRN. -- RETRNM - Return Record From First-pass Merge Files

BEGIN
  PROCEDURE	(PUSHJ	P,RETRNM)
	HLRZ	F,RN.FCB(S)	;GET WHICH FILE
	JSP	P4,GETREC	;GET A RECORD
	  PUSHJ	P,@EF		;E-O-F RETURN
	PUSHJ	P,SETTRE	;SET NEW RECORD IN TREE
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,RETWSC)
	EXCH	R,LSTREC	;SAVE RECORD JUST OUTPUT
	HRRM	R,RN.REC(S)	;GET SPARE RECORD AREA
	HLRZ	F,RN.FCB(S)	;GET WHICH FILE
	JSP	P4,GETREC	;GET A RECORD
	  JRST	[PUSHJ	P,@EF		;E-O-F RETURN
		JRST	$1]		;DON'T TEST SINCE RECORD NOT READ
	HRRZ	J,LSTREC	;GET PREVIOUS FROM SAME FILE
	COMPARE	(R,J)
	  JRST	$1		;KEY(R) = KEY(J)	;OK
	  JRST	$1		;KEY(R) > KEY(J)	;OK
				;KEY(R) > KEY(J)	;OUT OF SEQUENCE
E$$MRS:	$ERROR	(%,MRS,<MERGE record >,+)
	$MORE	(DECIMAL,FILSIZ(F))
	$MORE	(TEXT,< not in sequence for >)
	HLRZ	T2,RN.FCB(S)	;GET POINTER TO FILE BLOCK
	HRRZ	T2,FILNAM(T2)	;...
	ADDI	T2,X.RIB	;COMPENSATE FOR FOLLOWING MACRO
	$MORE	(FILESPEC,T2)
	$CRLF

$1%	PUSHJ	P,SETTRE	;SET NEW RECORD IN TREE
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,EOFMRG)
	MOVE	T1,FILSIZ(F)
	ADDM	T1,INPREC		;KEEP COUNT OF INPUT RECORDS
	PUSHJ	P,RELFIL		;RELEASE CHAN
	SOSG	ACTTMP			;ALL DONE?
	JRST	EOFOUT			;YES
	HLLOS	RQ			;SET TERMINATING RUN#
	RETURN
END;
SUBTTL	TAPE LABEL ROUTINES -- CHKLBL - Check Header Labels

IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(PUSHJ	P,CHKLBL)	;[215] CHECK TAPE HEADER LABELS
	PUSH	P,P1			;[215] SAVE A TEMP
	MOVE	P1,FILXBK(F)		;[215] NEED X. BLOCK A LOT HERE
  IFN FTOPS20,<
	MOVX	T1,FI.LAB		;FLAG THAT LABELLING
	IORM	T1,FILFLG(F)		;IS IN PROGRESS
  >
  IFE FTOPS20,<
  IF TAPE LABEL HANDLER IS NOT CHECKING THIS TAPE
	MOVE	T1,FILFLG(F)		;[215] FETCH TAPE'S FLAG BITS
	TXNE	T1,FI.ATO		;[215] TAPE LABELER DOING THE WORK?
	JRST	$F			;[215] YES--DONE
  THEN WE MUST DO IT OURSELVES
  >
	  CASE LABEL TYPE OF (STANDARD,OMITTED,NON-STANDARD,DEC,ANSI)
		MOVE	T1,X.LABL(P1)		;[215] FETCH LABEL TYPE
		JRST	@[EXP $1,$C,$2,$1,$3,$4]-1(T1) ;[215] CHECK PROPER LABELS

	  $1%	;[215] STANDARD OR DEC LABELS (SYNONYMOUS)
		SKIPN	X.RIB+.RBNAM(P1)	;[215] DID USER GIVE A NAME?
		JRST	E$$NRL			;TELL USER
		JSP	T4,GETBUF		;READ THE LABEL
		  JRST	E$$RIE			;SHOULD NOT HAPPEN
		SETZM	FILCNT(F)		;SO WE IGNORE BLOCK WHEN DONE
		MOVE	T4,FILPTR(F)		;GET BYTE PTR
		  CASE I/O MODE OF (SIXBIT,ASCII,EBCDIC,BINARY)
			HRRZ	T1,MODE		;[215] GET MODE OF FILE
			PUSHJ	P,@[EXP CHKSIX,CHKASC,E$$ELN,CHKBIN]-1(T1)
		  ESAC;
		JRST	$C			;[215] DONE WITH DEC LABELS

	  $2%	;[215] NON-STANDARD LABELS
E$$NSL:		$ERROR	(%,NSL,<Non-standard label not checked.>)
		PUSHJ	P,SKIPR			;[215] SKIP LABEL
		JRST	$C			;[215] DONE WITH NON LABELS

	  $3%	;[215] ANSI LABELS
E$$ANL:		$ERROR	(%,ANL,<ANSI label not checked.>)
		PUSHJ	P,SKIPF			;[215] SKIP LABEL
		JRST	$C			;[215] DONE WITH ANSI LABELS

	  $4%	;[215] IBM LABELS
E$$IBL:		$ERROR	(%,IBL,<IBM label not checked.>)
		PUSHJ	P,SKIPF			;[215] SKIP LABEL
;		JRST	$C			;[215] FALL THROUGH

	  ESAC;
  IFE FTOPS20,<
  FI;
  >
	POP	P,P1			;[215] RESTORE TEMP
   IFN FTOPS20,<
	MOVX	T1,FI.LAB		;INDICATE WE'RE DONE
	ANDCAM	T1,FILFLG(F)		; PROCESSING LABELS
   >
	RETURN				;[215] ALL DONE
END;
;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,CHKSIX)	;CHECK SIXBIT LABEL
	MOVE	T1,0(T4)		;GET HEADER BYTES
	LSHC	T1,-2*6			;BYTES 1-4
	CAME	T1,['HDR1']		;IS IT CORRECT?
	JRST	E$$LNC
	LSHC	T1,2*6			;RESTORE BYTES 5-6
	MOVE	T2,1(T4)		;GET BYTES 7-12
	LSHC	T1,4*6			;LEFT JUSTIFY
	LSH	T2,-6			;SHIFT INTO BYTES 1-2
	HLR	T2,2(T4)		;GET LAST CHARACTER
	LSH	T2,6			;BYTES 11, 12, 13 IN LHS
	CAME	T1,X.RIB+.RBNAM(P1)	;[215] CHECK NAME
	JRST	E$$LNC
	HLLZS	X.RIB+.RBEXT(P1)	;[215] CLEAR RHS JUNK
	HLLZ	T2,T2			;...
	CAME	T2,X.RIB+.RBEXT(P1)	;[215] MATCH
	JRST	E$$LNC
	HRLZ	T3,4(T4)		;GET REEL NUMBER
	HLR	T3,5(T4)		;...
	ANDCMI	T3,7777			;IN BYTES 0-4
	SETZ	T1,			;WHERE TO BUILD NUMBER
  $1%	SETZ	T2,
	LSHC	T2,6			;MOVE IN NEXT DIGIT
	IMULI	T1,^D10			;MAKE SPACE FOR IT
	ADDI	T1,-'0'(T2)		;ADD IN
	JUMPN	T3,$1			;MORE TO DO
	SKIPN	X.REEL(P1)		;[116,215] REEL #0 SAME AS #1
	JUMPE	T1,$2			;[116] FOR FIRST MULTI-FILE REEL
	MOVEI	T3,-1(T1)		;[116] PUT REEL NO. -1 IN T3
	CAME	T3,X.REEL(P1)		;[116,215] ONE WE EXPECTED?
	JRST	ERRROS			;NO
  $2%	AOS	X.REEL(P1)		;[116,215] INCREMENT PREVIOUS REEL ID
	RETURN
END;
;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,CHKBIN)
	MOVE	T1,0(T4)		;GET HEADER BYTES
	LSH	T1,-8			;TRY ASCII BYTES
	CAMN	T1,["HDR1"]		;IS IT ASCII?
	JRST	CHKASC			;YES
	LSH	T1,-4			;NO, TRY SIXBIT BYTES
	CAMN	T1,['HDR1']		;IS IT SIXBIT?
	JRST	CHKSIX			;YES
	JRST	E$$LNC			;ERROR
END;
;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,CHKASC)	;CHECK ASCII LABEL
	MOVE	T1,(T4)		;GET 1ST WORD
	LSHC	T1,-8			;RIGHT JUST
	CAME	T1,["HDR1"]		;
	JRST	E$$LNC			;ERROR
	SETZ	T1,			;BUILD NAME HERE
	LSH	T2,-4*7-1		;RIGHT JUSTIFY
	MOVEI	T3,6			;SIX CHARS
	AOJA	T4,$2			;INCREMENT BYTE PTR
$1%	ILDB	T2,T4			;GET NEXT BYTE
$2%	LSH	T1,6			;MAKE SPACE
	ADDI	T1,-" "(T2)		;ADD IN (SIXBITIZED)
	SOJG	T3,$1			;LOOP
	CAME	T1,X.RIB+.RBNAM(P1)	;[215] MATCH
	JRST	E$$LNC
	MOVEI	T3,3			;GET EXT
$3%	ILDB	T2,T4
	LSH	T1,6
	ADDI	T1,-" "(T2)		;SAME AS ABOVE
	SOJG	T3,$3
	HRLZ	T1,T1			;PUT IN LHS
	HLLZS	X.RIB+.RBEXT(P1)	;[215] CLEAR POSSIBLE JUNK
	CAME	T1,X.RIB+.RBEXT(P1)	;[215]
	JRST	E$$LNC
	DMOVE	T2,3(T4)		;PICKUP REEL ID
	LSH	T2,-1			;DROP BIT 35
	LSHC	T2,2*7+1		;LEFT JUSTIF
	ANDCMI	T2,377			;CLEAR JUNK
	SETZ	T3,			;WHERE TO BUILD NUMBER
  $4%	SETZ	T1,
	LSHC	T1,7			;MOVE IN NEXT DIGIT
	IMULI	T3,^D10			;MAKE SPACE FOR IT
	ADDI	T3,-"0"(T1)		;ADD IN
	JUMPN	T2,$4			;MORE TO DO
	SKIPN	X.REEL(P1)		;[116,215] REEL #0 SAME AS #1
	JUMPE	T3,$5			;[116] FOR FIRST MULTI-FILE REEL
	MOVEI	T1,-1(T3)		;[116] PUT REEL NO. -1 IN T3
	CAME	T1,X.REEL(P1)		;[116,215] ONE WE EXPECTED?
	JRST	ERRROS			;NO
  $5%	AOS	X.REEL(P1)		;[116,215] INCREMENT PREVIOUS REEL ID
	RETURN
END;
SUBTTL	TAPE LABEL ROUTINES -- WRTLBL - Write Header Labels

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,WRTLBL)		;HERE TO WRITE MAGTAPE LABEL
	PUSH	P,P1			;[215] SAVE TEMP FOR X. BLOCK
	MOVE	P1,FILXBK(F)		;[215] SET UP X. BLOCK
  IFE FTOPS20,<
  IF TAPE LABEL HANDLER IS NOT CHECKING THIS TAPE
	MOVE	T1,FILFLG(F)		;[215] GET FILE'S FLAGS
	TXNE	T1,FI.ATO		;[215] LABELER DOING THE WORK?
	JRST	$F			;[215] YES--NO PROBLEM
  THEN WE MUST DO IT OURSELVES
  >
	AOS	X.REEL(P1)		;[215] WE'RE NOW ON NEXT REEL
	  CASE LABEL TYPE OF (STANDARD,OMITTED,NON-STANDARD,DEC,IBM)
		MOVE	T1,X.LABL(P1)		;[215] GET LABEL TYPE
		JRST	@[EXP $1,$C,$2,$1,$3,$4]-1(T1)

	  $1%	;[215] STANDARD OR DEC LABELS (SYNONYMOUS)
  IFE FTOPS20,<
		SKIPGE	FILHDR(F)		;VIRGIN RING?
		JSP	T4,PUTBUF		;YES, DUMMY OUTPUT NEEDED
  >;END IFE FTOPS20
		MOVE	T4,FILPTR(F)		;GET BYTE POINTER
		  CASE I/O MODE OF (SIXBIT,ASCII,EBCDIC,BINARY)
			HRRZ	T2,MODE		;[215] GET MODE OF TAPE
			MOVE	T1,[EXP 'HDR1',"HDR1 ",0,'HDR1']-1(T2) ;[215] SET UP LABEL
			PUSHJ	P,@[EXP WRTSIX,WRTASC,WRTEBC,WRTBIN]-1(T2)
		  ESAC;
		JRST	$C			;[215] DONE WITH DEC LABELS

	  $2%	;[215] NON-STANDARD LABELS
E$$NLN:		$ERROR	(%,NLN,<Non-standard label not written.>)
		JRST	$C			;[215] CONTINUE

	  $3%	;[215] ANSI LABELS
E$$ALN:		$ERROR	(%,ALN,<ANSI label not written.>)
		JRST	$C			;[215] CONTINUE

	  $4%	;[215] IBM LABELS
E$$ILN:		$ERROR	(%,ILN,<IBM label not written.>)
;		JRST	$C			;[215] FALL THROUGH
	  ESAC;
  IFE FTOPS20,<
  FI;
  >
	POP	P,P1			;[215] RESTORE TEMP
	RETURN				;[215] ALL DONE
END;
;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,WRTSIX)	;WRITE SIXBIT LABEL
	;WRITE SIXBIT LABEL
	DMOVE	T2,X.RIB+.RBNAM(P1)	;[215] GET NAME, EXT
	JUMPE	T2,E$$NRL
	HRRI	T3,'   '		;FILL WITH SPACES
	LSHC	T1,2*6
	MOVEM	T1,0(T4)		;FIRST WORD
	LSH	T2,-2*6
	LSHC	T2,2*6
	MOVEM	T2,1(T4)		;SECOND WORD
	HRRI	T3,'   '
	MOVEM	T3,2(T4)		;THIRD WORD
	HRLZM	T3,3(T4)		;FOURTH WORD
	MOVE	T1,X.REEL(P1)		;[215] GET REEL NUMBER
	SETZ	T3,			;WHERE TO BUILD ID
  $1%	IDIVI	T1,^D10			;GET LEAST DIGIT
	ADDI	T2,'0'			;SIXBITIZE
	LSHC	T2,-6			;SHIFT IN
	TRNN	T3,770000		;GOT 4 CHARS YET?
	JRST	$1			;NO
	HLRZM	T3,4(T4)
	HRLI	T3,'00 '
	ADDI	T3,' 00'	
	MOVSM	T3,5(T4)		;STORE IT AS X0000
	DATE	T1,			;GET CURRENT DATE
	IDIVI	T1,^D31
	ADDI	T2,1
	IDIVI	T2,^D10			;GET DAYS
	LSH	T2,6
	ADDI	T2,'00'(T3)		;SIXBITIZE
	LSH	T2,6
	HRRZM	T2,7(T4)		;STORE DAYS
	IDIVI	T1,^D12			;GET MONTH
	ADDI	T2,1
	IDIVI	T2,^D10
	LSH	T2,6
	ADDI	T3,'00'(T2)		;PUT MONTH IN T3
	ADDI	T1,^D64			;ADD IN YEAR BASE
	IDIVI	T1,^D10
	LSH	T2,2*6
	ADDI	T2,'0  '(T3)		;YMM
	HRLM	T2,7(T4)
	ADDI	T1,'0'
	MOVEM	T1,6(T4)		;COMPLETE DATE
	MOVE	T1,['PDP10 ']
	MOVEM	T1,^D10(T4)
	MOVEI	T1,^D80/6
	ADDM	T1,FILPTR(F)		;ADVANCE BYTE PTR
	MOVN	T1,T1
	ADDM	T1,FILCNT(F)
  IFE FTOPS20,<
	JSP	T4,PUTBUF		;FORCE IT OUT
  >
  IFN FTOPS20,<
	PUSHJ	P,FORCBF		;FORCE IT OUT
  >
	RETURN
END;

WRTEBC:	JRST	E$$ELN

WRTBIN==WRTSIX
;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,WRTASC)
	;WRITE ASCII LABEL
	SETZ	T2,
	SKIPN	T3,X.RIB+.RBNAM(P1)	;[215] GET NAME
	JRST	E$$NRL
	LSHC	T2,6			;SHIFT IN T2
	ADDI	T1,0(T2)		;ADD IN
	LSH	T1,1			;LEFT JUST
	MOVEM	T1,0(T4)		;FIRST WORD
	SETZ	T1,			;HOLD NAME
$1%	SETZ	T2,
	LSHC	T2,6			;GET NEXT CHAR
	LSH	T1,7			;MAKE SPACE
	ADDI	T1," "(T2)		;ADD IN
	TXNN	T1,177B7		;DONE?
	JRST	$1			;NOT YET
	LSH	T1,1			;LEFT JUSTIFY
	MOVEM	T1,1(T4)		;STORE
	SETZ	T1,
	HLLZ	T3,X.RIB+.RBEXT(P1)	;[215] GET EXTENSION
$2%	SETZ	T2,
	LSHC	T2,6			;SHIFT IN
	LSH	T1,7			;MAKE SPACE
	ADDI	T1," "(T2)		;ADD IN
	TXNN	T1,177B7		;DONE
	JRST	$2
	LSH	T1,1			;LEFT JUSTIFY
	MOVEM	T1,2(T4)		;STORE EXT
	MOVE	T1,[ASCII /     /]	;5 SPACES
	MOVEM	T1,3(T4)
	MOVEM	T1,4(T4)		;MORE SPACES
	MOVEM	T1,7(T4)
	MOVEM	T1,^D10(T4)
	MOVE	T2,[ASCII /PDP10/]
	DMOVEM	T1,^D11(T4)
	MOVEM	T1,^D13(T4)
	MOVEM	T1,^D14(T4)
	TRC	T1,<BYTE (7) 40,40,40,40,40>^!<BYTE (7) 40,40,40,15,12>
	MOVEM	T1,^D15(T4)		;END WITH CR-LF
	MOVE	T1,X.REEL(P1)		;[215] GET REEL NUMBER
	SETZ	T3,			;WHERE TO BUILD ID
  $3%	IDIVI	T1,^D10			;GET LEAST DIGIT
	LSHC	T2,-7			;SHIFT IN
	TXNN	T3,<BYTE (7) 0,0,0,177>	;GOT 4 CHARS YET
	JRST	$3			;NO
	LSHC	T2,3*7			;PUT 3 CHARS IN FIRST WORD
	LSH	T2,1
  IFE FTKL10,<
	ADD	T2,[ASCII /  000/]	;MAKE ASCII
	ADD	T3,[ASCII /00000/]	;COBOL FILLS WITH 0
  >
  IFN FTKL10,<
	DADD	T2,[ASCII /  00000000/]
  >
	DMOVEM	T2,5(T4)
	DATE	T1,			;GET CURRENT DATE
	IDIVI	T1,^D31
	ADDI	T2,1
	IDIVI	T2,^D10			;GET DAYS
	LSH	T2,7
	ADDI	T2,"00"(T3)		;ASCIIZE
	LSH	T2,1+3*7			;SHIFT OFF BIT 35
	IOR	T2,[BYTE (7) 0,0,40,40,40]
	MOVEM	T2,^D9(T4)		;STORE DAYS
	IDIVI	T1,^D12			;GET MONTH
	ADDI	T2,1
	IDIVI	T2,^D10
	LSH	T2,7
	ADDI	T3,"00"(T2)		;PUT MONTH IN T3
	ADDI	T1,^D64			;ADD IN YEAR BASE
	IDIVI	T1,^D10
	LSH	T1,7
	ADDI	T1,"00"(T2)		;YY
	LSH	T1,2*7+1		;YY
	LSH	T3,1			;MM
	IOR	T1,T3			; YYMM
	TXO	T1,ASCII / /
	MOVEM	T1,8(T4)
	MOVEI	T1,^D82/5+1
	ADDM	T1,FILPTR(F)
	MOVN	T1,T1
	ADDM	T1,FILCNT(F)
  IFE FTOPS20,<
	JSP	T4,PUTBUF		;FORCE IT OUT
  >
  IFN FTOPS20,<
	PUSHJ	P,FORCBF		;FORCE IT OUT
  >
	RETURN
END;
SUBTTL	TAPE LABEL ROUTINES -- CHKEND - Check End Labels

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE (PUSHJ	P,CHKEND)	;HERE TO CHECK END MAGTAPE LABEL
	PUSH	P,P1			;[215] SAVE TEMP FOR X. BLOCK
	MOVE	P1,FILXBK(F)		;[215]   ..
  IFE FTOPS20,<
  IF TAPE LABEL HANDLER IS NOT CHECKING THIS TAPE
	MOVE	T1,FILFLG(F)		;[215] GET TAPE'S FILE FLAGS
	TXNE	T1,FI.ATO		;[215] LABELER DOING THE WORK?
	JRST	$F			;[215] YES--NO PROBLEM
  THEN WE MUST DO IT OURSELVES
  >
	  CASE LABEL TYPE OF (STANDARD, OMITTED,NON-STANDARD,DEC,ANSI,IBM)
		MOVE	T1,X.LABL(P1)		;[215] GET LABEL TYPE
		JRST	@[EXP $1,$C,$2,$1,$2,$2]-1(T1) ;[215] CASE BY LABEL TYPE

	  $1%	;[215] STANDARD OR DEC LABELS (SYNONYMOUS)
		MOVX	T1,FI.LAB		;INDICATE LABEL PROCESSING
		IORM	T1,FILFLG(F)		; IN PROGRESS
		JSP	T4,GETBUF		;READ THE LABEL
		  JRST	E$$RIE			;SHOULD NOT HAPPEN
		MOVX	T1,FI.LAB		;CLEAR LABELLING FLAG
		ANDCAM	T1,FILFLG(F)		; ..
		SETZM	FILCNT(F)		;SO WE IGNORE BLOCK WHEN DONE
		MOVE	T2,@FILPTR(F)		;[215] GET LABEL DESIGNATOR
		  CASE MODE OF (SIXBIT,ASCII,EBCDIC,BINARY)
			HRRZ	T1,MODE		;[215] GET MODE OF TAPE
			PUSHJ	P,@[EXP CHKESX,CHKEAS,E$$ELN,CHKEBN]-1(T1)
		  ESAC;
		JRST	$C			;[215] DONE HERE NOW

	  $2%	;[215] NON-STANDARD, ANSI, OR IBM LABELS
		PUSHJ	P,SKIPF			;[215] IGNORE LABEL (USER WARNED ALREADY)
;		JRST	$C			;[215] FALL THROUGH
	  ESAC;
  IFE FTOPS20,<
  FI;
  >
	POP	P,P1			;[215] RESTORE TEMP
	RETURN				;[215] DONE
END;
;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE (PUSHJ	P,CHKESX)	;[215] CHECK SIXBIT END LABEL
	LSH	T2,-^D12		;[215] SHIFT OUT GARBAGE
  IF EOV1 LABEL (FILE IS CONTINUED ON ANOTHER REEL)
	CAXE	T2,'EOV1'		;[215] LOOK AT JUST DESIGNATOR
	JRST	$T			;[215] NOT EOV--TRY EOF
  THEN REMEMBER FOR LATER
	MOVX	T1,FI.EOT		;[215] SET UP EOT BIT FOR LATER
	ORM	T1,FILFLG(F)		;[215] REMEMBER EOT CONDITION PENDING
	JRST	$F			;[215] NOW GO EAT LABEL
  ELSE CHECK IF EOF1 (END-OF-FILE)
	CAXE	T2,'EOF1'		;[215] LOOK AT JUST DESIGNATOR
	JRST	E$$LNC			;[215] NO GOOD--TELL USER
	SETZM	X.REEL(P1)		;[215] OK--RESET COUNT TO INDICATE NO MORE TAPES
  FI;
	PJRST	SKIPF			;[215] SKIP OVER LABEL
END;


BEGIN
  PROCEDURE (PUSHJ	P,CHKEAS)	;[215] CHECK ASCII END LABELS
	LSH	T2,-^D8			;[215] SHIFT OUT GARBAGE
  IF EOV1 LABEL (FILE CONTINUED ON ANOTHER REEL)
	CAXE	T2,"EOV1"		;[215] LOOK AT JUST DESIGNATOR
	JRST	$T			;[215] NOT EOV--TRY EOF
  THEN REMEMBER FOR LATER
	MOVX	T1,FI.EOT		;[215] SET UP EOT BIT FOR LATER
	ORM	T1,FILFLG(F)		;[215] REMEMBER EOT CONDITION PENDING
	JRST	$F			;[215] NOW GO EAT LABEL
  ELSE CHECK IF EOF1 (END-OF-FILE)
	CAXE	T2,"EOF1"		;[215] LOOK AT JUST DESIGNATOR
	JRST	E$$LNC			;[215] NO GOOD--TELL USER
	SETZM	X.REEL(P1)		;[215] OK--RESET COUNT TO INDICATE NO MORE TAPES
  FI;
	PJRST	SKIPF			;[215] SKIP OVER LABEL
END;
;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE (PUSHJ	P,CHKEBN)	;[215] CHECK BINARY END LABELS
	MOVE	T1,T2			;[215] GET TEMP COPY OF DESIGNATOR
	LSH	T1,-^D8			;[215] SET UP TO TRY ASCII
	CAXE	T1,"EOV1"		;[215] END-OF-VOLUME
	CAXN	T1,"EOF1"		;[215]   OR END-OF-FILE?
	PJRST	CHKEAS			;[215] YES--MUST BE ASCII
	LSH	T1,-4			;[215] NO--THEN TRY FOR SIXBIT
	CAXE	T1,'EOV1'		;[215] END-OF-VOLUME
	CAXN	T1,'EOF1'		;[215]   OR END-OF-FILE?
	PJRST	CHKESX			;[215] YES--MUST BE SIXBIT
	JRST	E$$LNC			;[215] NEITHER--NO GOOD
END;
SUBTTL	TAPE LABEL ROUTINES -- WRTEND - Write End-of-file Labels

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,WRTEND)
	PUSH	P,P1			;[215] SAVE TEMP FOR X. BLOCK
	MOVE	P1,FILXBK(F)		;[215] LOAD UP X. BLOCK
  IFE FTOPS20,<
  IF TAPE LABEL HANDLER IS NOT DOING THIS TAPE
	MOVE	T1,FILFLG(F)		;[215] TEST AUTO-LABELING BIT
	TXNE	T1,FI.ATO		;[215]   ..
	JRST	$F			;[215] NO PROBLEM
  THEN WE MUST DO IT OURSELVES
  >
	  CASE LABEL TYPE OF (STANDARD,OMITTED,NON-STANDARD,DEC,ANSI,IBM)
		MOVE	T1,X.LABL(P1)		;[215] GET LABEL TYPE
		JRST	@[EXP $1,$C,$C,$1,$C,$C]-1(T1) ;[215] CASE ON LABEL TYPE

	  $1%	;[215] STANDARD OR DEC LABELS (SYNONYMOUS)
  IFE FTOPS20,<
		MOVX	T1,BF.VBR
		ANDCAM	T1,FILHDR(F)		;CLEAR THE VIRGIN RING BIT
		MOVE	T4,[440000,,1]
		ADDB	T4,FILPTR(F)		;ADVANCE BYTE POINTER
  >;END IFE FTOPS20
		  CASE I/O MODE OF (SIXBIT,ASCII,EBCDIC,BINARY)
			HRRZ	T2,MODE		;[215] GET TAPE'S I/O MODE
			MOVE	T1,[EXP 'EOF1',"EOF1 ",0,'EOF1']-1(T2) ;[215] SET UP LABEL
			PUSHJ	P,@[EXP WRTSIX,WRTASC,WRTEBC,WRTBIN]-1(T2)
		  ESAC;
		PUSHJ	P,WRTEOF		;[215] WRITE EOF AFTER LABEL
;		JRST	$C			;[215] FALL THROUGH
	  ESAC;
  IFE FTOPS20,<
  FI;
  >
	POP	P,P1			;[215] RESTORE TEMP
	RETURN				;[215] ALL DONE
END;
SUBTTL	TAPE LABEL ROUTINES -- WRTEOT - Write End-of-tape Labels

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,WRTEOT)
	PUSH	P,P1			;[215] SAVE TEMP FOR X. BLOCK
	MOVE	P1,FILXBK(F)		;[215] LOAD UP X. BLOCK
  IFE FTOPS20,<
  IF TAPE LABEL HANDLER IS NOT DOING THIS TAPE
	MOVE	T1,FILFLG(F)		;[215] TEST AUTO-LABELING BIT
	TXNE	T1,FI.ATO		;[215]   ..
	JRST	$F			;[215] NO PROBLEM
  THEN WE MUST DO IT OURSELVES
  >
	  CASE LABEL TYPE OF (STANDARD,OMITTED,NON-STANDARD,DEC,ANSI,IBM)
		MOVE	T1,X.LABL(P1)		;[215] GET LABEL TYPE
		JRST	@[EXP $1,$2,$2,$1,$2,$2]-1(T1) ;[215] CASE ON LABEL TYPE

	  $1%	;[215] STANDARD OR DEC LABELS (SYNONYMOUS)
  IFE FTOPS20,<
		MOVX	T1,BF.VBR
		ANDCAM	T1,FILHDR(F)		;CLEAR THE VIRGIN RING BIT
		MOVE	T4,[440000,,1]
		ADDB	T4,FILPTR(F)		;ADVANCE BYTE POINTER
  >;END IFE FTOPS20
		  CASE I/O MODE OF (SIXBIT,ASCII,EBCDIC,BINARY)
			HRRZ	T2,MODE		;[215] GET TAPE'S I/O MODE
			MOVE	T1,[EXP 'EOV1',"EOV1 ",0,'EOV1']-1(T2) ;[215] SET UP LABEL
			PUSHJ	P,@[EXP WRTSIX,WRTASC,WRTEBC,WRTBIN]-1(T2)
		  ESAC;
		PUSHJ	P,WRTEOF		;[215] WRITE EOF AFTER LABEL
		JRST	$C			;[215] DONE

	  $2%	;[215] OMITTED, NON-STANDARD, ANSI, OR IBM LABELS
E$$MSD:		$ERROR	(?,MSD,<Multi-reel tape files with other than STANDARD or DEC labels not supported.>)
;		JRST	$C			;[215] FALL THROUGH
	  ESAC;
  IFE FTOPS20,<
  FI;
  >
	POP	P,P1			;[215] RESTORE TEMP
	RETURN				;[215] ALL DONE
END;
SUBTTL	ENDS. -- Clean Up After SORT

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,ENDS.)
  IFE FTOPS20,<
	MOVE	T1,RUNCOR	;GET ORIGINAL MEMORY SIZE
	CORE	T1,		;REDUCE BACK TO IT
	  NOOP			;IGNORE ERROR RETURN
  >
  IFN FTOPS20,<
	PUSHJ	P,RESET%	;CLEAN UP MEMORY
	SKIPE	FORTPP		;FORTRAN?
	JRST	FORXIT		;YES, RETURN TO USER
  >
	HRRZ	T1,.JBFF##	;ZERO FREE MEMORY
	CAMG	T1,.JBREL	;
	SETZM	(T1)		;
	HRL	T1,T1		;
	ADDI	T1,1		;
	HRRZ	T2,.JBREL	;
	CAIL	T2,(T1)		;
	BLT	T1,(T2)		;DOIT
	MOVE	T1,INPREC	;NUMBER OF RECORDS SORTED
	CAME	T1,OUTREC	;SAME NUMBER AS WE OUTPUT?
	PUSHJ	P,E$$RNI	;RECORD NUMBER INCONSISTENT
  IF SORT
	SKIPLE	MRGSW
	JRST	$T
  THEN PRINT <SORTED>
	TYPE	(<Sorted >)
	JRST	$F
  ELSE PRINT <MERGED>
	TYPE	(<Merged >)
  FI;
	MOVE	T1,INPREC
	PUSHJ	P,.TDECW	;TYPE #
	TYPE	(< records
>)
	AOSG	T1,RTRUNC	;ANY RECORDS TRUNCATED
	JRST	$2		;NO
	PUSHJ	P,.TDECW	;YES
	TYPE	(< records truncated
>)
  $2%
	MOVE	T1,CMPCNT	;NUMBER OF KEY COMPARISONS
	PUSHJ	P,.TDECW
	TYPE	(< KEY comparisons, >)
	MOVE	T1,CMPCNT	;NO. OF COMPARISONS
	MOVE	T2,INPREC	;NO. OF RECORDS READ
	MOVEI	T3,2		;NO. OF PLACES AFTER DECIMAL PT.
	PUSHJ	P,.TFLPW	;PRINT IT
	TYPE	(< per record
>)
	MOVE	T1,RCBTOT	; ..
	CAMGE	T1,OUTREC	;IF WE NEVER ENTIRELY FILLED THE TREE,
	MOVE	T1,OUTREC	; TELL HIM HOW MANY RECORDS THERE WERE
	PUSHJ	P,.TDECW	; ..
  IFE FTOPS20,<
	TYPE	(< record leaves in memory>)	;TELL HIM WHAT NUMRCB WAS
  >
  IFN FTOPS20,<
	TYPE	(< record leaves in memory, >)	;TELL HIM WHAT NUMRCB WAS
	MOVE	T1,BUFTOT	;GET SIZE OF BUFFER POOL
	LSH	T1,-<POW2(PGSIZ)> ;CONVERT TO NUMBER OF PAGES
	PUSHJ	P,.TDECW	;TYPE IT
	TYPE	(< buffer pages>)
  >
	PUSHJ	P,.TCRLF	;NEW LINE
	MOVE	T1,RUNTOT	;TYPE NUMBER OF RUNS
	PUSHJ	P,.TDECW
  IF JUST ONE RUN
	MOVE	T1,RUNTOT
	SOJN	T1,$T
  THEN PRINT SINGULAR RUN
	TYPE	(< run>)
	JRST	$F
  ELSE PRINT PLURAL RUNS
	TYPE	(< runs>)
  FI;
  IF MEANINGFUL BIAS VALUE
	SKIPG	MRGSW		;NOT MEANINGFUL IN /MERGE
	SKIPN	T2,RUNTOT	;NO. OF RUNS
	JRST	$F		;NOT MEANINGFUL IF 0 RUNS
  THEN TYPE IT OUT
	TYPE	(<, bias >)
	MOVE	T1,INPREC	;TOTAL NO. OF RECORDS
	IDIV	T1,T2		;NO. OF RECORDS PER RUN
	MOVE	T2,RCBTOT	;NO. OF RECORDS IN MEMORY
	MOVEI	T3,2		;2 DECIMAL PLACES
	PUSHJ	P,.TFLPW	;OUTPUT BIAS
  FI;
	PUSHJ	P,.TCRLF
  IFN FTOPS20,<
  IF ANY TEMPORARY PAGES WERE USED
	SKIPN	SUMTMP			;ANY TEMPORARY PAGES USED?
	JRST	$F			;NO, DON'T BOTHER PRINTING ANYTHING
  THEN TYPE HOW MANY WE USED
		TYPE	(<Total of >)
		MOVE	T1,SUMTMP
		PUSHJ	P,.TDECW
	  IF JUST ONE TEMPORARY PAGE USED
		MOVE	T1,SUMTMP
		SOJN	T1,$T
	  THEN TYPE SINGULAR PAGE
		TYPE	(< page>)
		JRST	$F
	  ELSE TYPE PLURAL FORM
		TYPE	(< pages>)
	  FI;
		TYPE	(< in temporary files used
	>)
  FI;
  >
  IFE FTOPS20,<
	SETZ	T1,		;SELECT CURRENT JOB
	RUNTIM	T1,		;DETERMINE TOTAL CPU TIME IN MS
  >
  IFN FTOPS20,<
	HRROI	T1,-5		;WHOLE JOB
	RUNTM
  >
	SUB	T1,CPUTIM	;CALCULATE INCREMENTAL CPU TIME
  IFN FTOPS20,<
	IMULI	T1,^D1000
	IDIVI	T1,(T2) 	;TIME IN MILLISECS
  >
	PUSH	P,T1		;SAVE IT
	PUSHJ	P,.TTIME	;TYPE TIME
	TYPE	(< CPU time, >)
	POP	P,T1		;GET MS BACK
	MOVE	T2,INPREC	;NO. OF RECORDS
	MOVEI	T3,2		;NO. OF DECIMAL PLACES
	PUSHJ	P,.TFLPW
	TYPE	(< MS per record
>)
  IFE FTOPS20,<
	MSTIME	T1,		;CURRENT TIME OF DAY IN MS
  >
  IFN FTOPS20,<
	TIME
  >
	SUB	T1,ORGTIM	;CALCULATE INCREMENTAL ELAPSED TIME
  IFE FTOPS20,<
	SKIPGE	T1		;GONE PAST MIDNIGHT?
	ADD	T1,[^D<24*60*60*1000>]	;YES, ADD 1 DAY OF MILLISECS.
  >
  IFN FTOPS20,<
	IMULI	T1,^D1000
	IDIVI	T1,(T2)		;TIME IN MILLISECS
  >
	PUSHJ	P,.TTIME	;TYPE TIME
	TYPE	(< elapsed time
>)
	RETURN
END;
SUBTTL	TYPE-OUT ROUTINES -- Floating-point Number

;STILL IN IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,.TFLPW)
	;TYPE OUT SIGNED FLOATING POINT NUMBER
	;CALL:	MOVE	T1,NUMBER
	;	MOVE	T2,DIVISOR
	;	MOVEI	T3,NO. OF DIGITS AFTER DECIMAL PT.
	;	PUSHJ	P,.TFLPW
	;USES T1, T2, T3, T4

	PUSH	P,P1		;[112] GET A SAFE ACC
  IFE FTKL10,<
	HRRZI	T4,1(T3)	;[112] NO. OF DECIMAL PLACES + 1
	HRLI	T4,1(T3)	;[112] ...
	ADD	P,T4		;[112] ADJUST STACK POINTER
  >
  IFN FTKL10,<
	ADJSP	P,1(T3)		;[112] ADJUST STACK POINTER
  >
	MOVE	T4,T2		;[112] SAVE DIVISOR
	IDIV	T1,T2		;[112] GET NUMBER BEFORE DECIMAL PT.
	MOVE	P1,P		;[112] GET BASE OF STACK
	PUSH	P,T3		;[112] SAVE COUNT
	MOVEM	T1,0(P1)	;[112] SAVE REMAINDER
  $1%	MOVE	T1,T2		;[112] GET REMAINDER
	IMULI	T1,^D10		;[112] 
	IDIV	T1,T4		;[112] GET NEXT DIGIT
	SUBI	P1,1		;[112] BACKUP STACK
	MOVEM	T1,0(P1)	;[112] SAVE DIGIT
	SOJG	T3,$1		;[112] LOOP
	MOVE	T3,0(P)		;[112] GET COUNT AGAIN
	LSH	T2,1		;[112] DOUBLE REMAINDER
	CAMGE	T2,T4		;[112] NEED TO ROUND UP?
	JRST	$3		;[112] NO
  $2%	AOS	T1,0(P1)	;[112] ROUND UP
	CAIG	T1,9		;[112] TOO BIG?
	JRST	$3		;[112] NO, ROUNDING DONE
	SOJL	T3,$3		;[112] OK IF BEFORE DECIMAL POINT
	SETZM	0(P1)		;[112] MAKE IT ZERO
	AOJA	P1,$2		;[112] AND ROUND UP NEXT DIGIT

  $3%	POP	P,P1		;[112] GET COUNT
	POP	P,T1		;[112] GET WHOLE NUMBER
	PUSHJ	P,.TDECW	;[112] PRINT IT
	MOVEI	T1,"."		;[112] GET DECIMAL PT.
	PUSHJ	P,.TCHAR	;[112] PRINT IT
  $4%	POP	P,T1		;[112] GET NEXT DIGIT
	ADDI	T1,"0"		;[112] CONVERT TO ASCII
	PUSHJ	P,.TCHAR	;[112] TYPE IT
	SOJG	P1,$4		;[112] LOOP
	POP	P,P1		;[112] RESTORE P1
	RETURN
END;
>;END IFE FTFORTRAN
SUBTTL	LOW SEGMENT ERROR MESSAGES

E$$ELN:	$ERROR	(?,ELN,<EBCDIC tape labels not supported.>)
ERRRTI:	AOSLE	RTRUNC		;ALREADY SEEN MESSAGE
	POPJ	P,		;YES
	PUSH	P,T1
	PUSH	P,T2
	$ERROR	(%,RTI,<Record truncation on input>)
	POP	P,T2
	POP	P,T1
	POPJ	P,
IFE FTOPS20,<
E$$SAT:	$ERROR	(?,SAT,<Standard ASCII requires TU70 drive>)
>
IFE FTFORTRAN,<
E$$NRL:	$ERROR	(?,NRL,<Name required with labeled magtape>)
E$$LNC:	$ERROR	(?,LNC,<LABEL not correct for >,+)
  IFE FTOPS20,<
	MOVEI	T2,X.RIB(P1)		;[215] TYPE OFFENDING FILE SPEC
  >
  IFN FTOPS20,<
	HLRZ	T2,X.JFN(P1)		;$MORE WANTS JFN ON TOPS20
  >
	$MORE	(FILESPEC,T2)
	$DIE

ERRROS:	PUSH	P,T1			;SAVE BAD REEL #
	$ERROR	(?,ROS,<Reel no. >,+)
	POP	P,T1
	$MORE	(DECIMAL,T1)
	$MORE	(TEXT,< out of sequence for >,+)
  IFE FTOPS20,<
	MOVEI	T2,X.RIB(P1)		;[215] PRINT OFFENDING FILE SPEC
  >
  IFN FTOPS20,<
	MOVE	T2,X.JFN(P1)
  >
	$MORE	(FILESPEC,T2)
	$DIE
>;END IFE FTFORTRAN