Google
 

Trailing-Edge - PDP-10 Archives - AP-D489C-SB - sort.new
There are no other files named sort.new in the archive.
SUBTTL	D.M.NIXON/DZN/DLC	10-APR-78
IFN FTOPS20,<
TITLE	SORT - SORT/MERGE for DECSYSTEM-20
>
IFE FTOPS20,<
TITLE	SORT - SORT/MERGE for DECsystem-10
>



;COPYRIGHT (C) 1975, 1978 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SUBTTL	TABLE OF CONTENTS FOR SORT


;                     Table of Contents for SORT
;
;
;                             Section                             Page
;
;   1  TABLE OF CONTENTS FOR SORT ...............................   2
;   2  CALLING SEQUENCE CONVENTIONS .............................   3
;   3  DEFINITIONS
;        3.1  Low Segment Data ..................................   5
;   4  PSORT.
;        4.1  Prior Initialization ..............................   6
;        4.2  PSORT% - Initialization Continued .................   7
;   5  CHECK MONITOR AND CPU TYPES ..............................   8
;   6  ZERO ALL LOW SEGMENT DATA ................................  10
;   7  RELES.
;        7.1  RELES% - Add Record to Tree .......................  11
;   8  TREE MANIPULATION
;        8.1  Initialization ....................................  12
;        8.2  Insert Next Record ................................  13
;   9  MERGE.
;        9.1  MERGE% - Begin a Merge Cycle ......................  16
;        9.2  MERGE0 - 0 Temporary Files ........................  22
;        9.3  MERGE1 - 1 Temporary File .........................  23
;        9.4  MERGE2 - Final Merge of 2 or More Temporary Files .  24
;  10  RETRN.
;       10.1  RETRN% - Return Record From Tree to Output File ...  25
;       10.2  RETRN0 - 0 Temporary Files ........................  26
;       10.3  RETRN1 - 1 Temporary File .........................  27
;       10.4  RETRN2 - Final Merge of 2 or More Temporary Files .  28
;  11  GETREC
;       11.1  GETREC - Get Next Record From Input File ..........  30
;       11.2  GETSXR - Get SIXBIT Record ........................  31
;       11.3  GETASR - Get ASCII Record .........................  33
;       11.4  GETEBR - Get EBCDIC Record ........................  39
;       11.5  GETBNR - Get Binary Record ........................  46
;       11.6  GTTREC - Get Next Record From Temporary File ......  49
;  12  PUTREC
;       12.1  PUTREC - Put Next Record to Output File ...........  50
;       12.2  PUTSXR - Put SIXBIT Record ........................  51
;       12.3  PUTASR - Put ASCII Record .........................  52
;       12.4  PUTEBR - Put EBCDIC Record ........................  58
;       12.5  PUTBNR - Put Binary Record ........................  65
;       12.6  PTTREC - Put Next Record to Temporary File ........  68
;  13  MEMORY MANAGEMENT ........................................  70
;  14  ERROR MESSAGE SUPPRESSION CONTROL ........................  73
;  15  ERROR MESSAGES ...........................................  74
SUBTTL	CALLING SEQUENCE CONVENTIONS

COMMENT	\

SORT/MERGE USES THE FOLLOWING 3 CALLING CONVENTIONS

1.0	JSP	T4,SUBROUTINE

	THIS IS USED ONLY IN THE FOLLOWING 3 PLACES

1.1	JSP	T4,GETBUF
	CALL TO GET THE NEXT INPUT BUFFER
	MAKES NO FURTHER SUBROUTINE CALLS
	RETURNS EITHER
	JRST	(T4)		NORMAL CASE
	OR
	JRST	@PHYEOF		ON END OF FILE

1.2	JSP	T4,PUTBUF
	CALL TO WRITE THE NEXT OUTPUT BUFFER
	MAKES NO FURTHER SUBROUTINE CALLS
	RETURNS EITHER
	JRST	(T4)		NORMAL CASE
	OR
	JRST	@PHYEOF		ON END OF FILE

1.3	JSP	P4,@EXTRCT
	CALL TO EXTRACT THE NUMERIC KEYS FROM THE RECORD
	JUST READ IN BY GETREC ROUTINE.
	EXTRCT CONTAINS RUN TIME GENERATED CODE OF THE FOLLOWING FORM
	JSP	T4,SUBROUTINE
	LDB	BYTE POINTER TO LOAD KEY
	BYTE COUNT
	IDPB	BYTE POINTER TO STORE EXTRACTED KEY

	ALL THESE ROUTINES RETURN
	JRST	3(T4)
	AT THE END OF THE CODE SEQUENCE IS
	JRST	(P4)
2.0	JSP	P4,SUBROUTINE

	USED ONLY IN THE FOLLOWING 4 PLACES

2.1	JSP	P4,@EXTRCT
	SEE 1.3 ABOVE
	RETURN IS
	JRST	(P4)

2.3	JSP	P4,GETREC
	TO GET THE NEXT INPUT RECORD
	MAY MAKE CALL TO GETBUF THEREFORE MAY NOT RETURN
	SEE 1.1 ABOVE
	NORMAL RETURN IS
	JRST	(P4)

2.4	JSP	P4,PUTREC
	TO WRITE OUT THE NEXT RECORD
	MAY MAKE CALL TO PUTBUF, THEREFORE MAY NOT RETURN
	SEE 1.2 ABOVE
	NORMAL RETURN IS
	JRST	(P4)


3.0	PUSHJ	P,SUBROUTINE

	THIS IS USED WHEN ROUTINE ALWAYS RETURNS TO CALLER

	RETURNS MAY BE EITHER

	SINGLE RETURN TO CALLER +1
	POPJ	P,

	OR SKIP RETURN TO EITHER CALLER+1 OR CALLER+2
	AOS	(P)
	POPJ	P,

2.2	JSP	P4,@.CMPAR
	.CMPAR CONTAINS RUN TIME GENERATED CODE WHICH CONTAINS
	CALL TO SUBROUTINE TO COMPARE RECORDS IN
	(R) AND (J)
	THIS ROUTINE (WHICH IS COMPILED AT RUN TIME)
	HAS THREE RETURNS
	JRST	0(P4)		KEY(R) = KEY(J)
	JRST	1(P4)		KEY(R) > KEY(J)
	JRST	2(P4)		KEY(R) < KEY(J)


\
SUBTTL	DEFINITIONS -- Low Segment Data

	SEGMENT	LOW

;LOCATIONS IN SORT THAT SHOULD BE INITIALIZED TO 0 AT STARTUP TIME
;(I.E., EACH NEW COMMAND LINE) SHOULD BE BETWEEN Z.BEG AND Z.END FOR
;ZDATA TO FIND.

Z.BEG:!
CPU:	BLOCK	1		;0 = KA10, 1 = KI10, 2 = KL10
NUMRCB:	BLOCK	1		;NUMBER OF RECORDS IN TREE (ALSO IN MEMORY)
TBUFNO:	BLOCK	1		;NUMBER OF BUFFERS PER TEMPORARY FILE
OBUFNO:	BLOCK	1		;NUMBER OF BUFFERS FOR OUTPUTOR MERGE FILE
TCBIDX:	BLOCK	1		;INDEX INTO TCB TABLE
RECORD:	BLOCK	1		;INPUT RECORD SIZE IN BYTES
REKSIZ:	BLOCK	1		;NUMBER OF WORDS IN RECORD + EXTRACTED KEYS
XTRWRD:	BLOCK	1		;[207] # OF WORDS OF EXTRACTED KEYS
NUMTMP:	BLOCK	1
ACTTMP:	BLOCK	1		;NO. OF TEMP FILES CURRENTLY OPEN FOR INPUT
STRNUM:	BLOCK	1
STRNAM:	BLOCK	MX.TMP		;STRUCTURES FOR TEMPORARY FILES
MAXTMP:	BLOCK	1		;MAX. NO. OF TEMP FILES IN USE DURING MERGE
BUFALC:	BLOCK	1
JOBNUM:	BLOCK	1		;SIXBIT JOB NUMBER ,, OCTAL JOB NUMBER
RUNTOT:	BLOCK	1		;NUMBER OF RUNS
NUMLFT:	BLOCK	1		;NUMBER OF TEMP FILES STILL TO MERGE
NUMENT:	BLOCK	1		;NUMBER OF ENTERS DONE (FOR APPEND CODE)
MRGNUM:	BLOCK	1		;NUMBER OF MERGE PASS
NUMINP:	BLOCK	1		;NUMBER OF INPUT FILES
BUFPTR:	BLOCK	1
TREORG:	BLOCK	1		;FIRST LOCATION OF NODE TREE
TREEND:	BLOCK	1		;END OF TREE OF RECORD NODES
RCBEND:	BLOCK	1		;END OF IN-MEMORY RECORDS
LSTREC:	BLOCK	1		;PTR TO LAST RECORD JUST OUTPUT
RQ:	BLOCK	1
RC:	BLOCK	1
FSTNOD:	BLOCK	1
LOGEOF:	BLOCK	1		;LOGICAL END OF FILE INTERCEPT
PHYEOF:	BLOCK	1		;PHYSICAL END OF FILE INTERCEPT
RSAV:	BLOCK	1
PSAV:	BLOCK	1
$RETRN:	BLOCK	1
INPREC:	BLOCK	1		;NO. OF INPUT RECORDS SEEN
OUTREC:	BLOCK	1		;NO. OF OUTPUT RECORDS SEEN
IOBPW:	BLOCK	1		;[201] BYTES-PER-WORD IN EXTERNAL FILE
CURSEQ:	BLOCK	1		;SEQUENCE # OF RECORD IN THIS RUN
NXTSEQ:	BLOCK	1		;SEQUENCE # OF RECORD IN NEXT RUN
SEQOVF:	BLOCK	1		;-1 IF SEQUENCE NUMBERS OVERFLOW
SRTDN:	BLOCK	1		;-1 WHEN SORT PHASE OVER
MRGDN:	BLOCK	1		;-1 WHEN MERGE PHASE OVER (FINAL OUTPUT STARTED)
MRGSW:	BLOCK	1		;-1, 0 MEANS NO MERGE, 1 MEANS /MERGE
WSCSW:	BLOCK	1		;1 IF WITH SEQUENCE CHECK (/CHECK) FOR MERGE
SUPFLG:	BLOCK	1		;SEVERITY OF ERRORS TO SUPPRESS
ARGCNT:	BLOCK	1		;NUMBER OF ARGS IN FORTRAN CALL
ARGLST:	BLOCK	1		;POINTER TO ARG LIST IN USERS AREA
ERRADR:	BLOCK	1		;ERROR RETURN ADDRESS FOR USER CONTROL
FERCOD:	BLOCK	1		;ADDRESS OF WHERE TO STORE ERROR CODE
ADDR:	BLOCK	1		;ADDRESS OF MEMORY BLOCK (FOR FUNCT.)
SIZE:	BLOCK	1		;SIZE OF MEMORY BLOCK (DITTO)
STATUS:	BLOCK	1		;RETURN STATUS FROM FUNCT.
CORSTK:	BLOCK	1		;PTR TO STACK OF MEMORY ALLOCATION WORDS
CSTACK:	BLOCK	100		;STACK OF MEMORY ALLOCATION WORDS
IFE FTOPS20,<			;ONLY ON TOPS10
MYPPN:	BLOCK	1		;[115] LOGGED-IN PPN
DSKARG:	BLOCK	.DCUPN		;ARGS FOR DSKCHR UUO
STRUSE:	BLOCK	1		;[214] # OF FIRST UNUSED STRNAM ENTRY
STRDEF:	BLOCK	1		;[214] -1 IF WE DEFAULTED STRNAM TO DSK:
STRARG:	BLOCK	3		;ARGS FOR JOBSTR UUO
>				;END IFE FTOPS0
FCBORG:	BLOCK	FCBLEN
TMPFCB:	BLOCK	MX.TMP*FCBLEN	;DO NOT SPLIT
DFBORG:	BLOCK	MX.TMP*DFBLEN
	
	STRSNM==DFBORG
	STRULN==DFBORG+MX.TMP
Z.END==.-1

;LOCATIONS WHICH NEED NOT OR SHOULD NOT BE SET TO 0 ON STARTUP
;SHOULD BE PLACED HERE.

T.BLK:	BLOCK	LN.X		;[215] ONE BLOCK MULTIPLEXED FOR ALL .TMP FILES
SUBTTL	PSORT. -- Prior Initialization
	
COMMENT	\
ENTER PSORT% WITH:
ALL DATA ZEROED INITIALLY
THEN SET THESE LOCATIONS SPECIFICALLY
OFFSET:		1 IF ENTERED FROM CCL (SRTSCN ONLY)
CPU:		SET FOR KA10=0, KI10=1 OR KL10=2
MAXTMP:		MAX. NO. OF TEMP FILES TO OPEN (NO. OF CHAN#)
TCBIDX:		AOBJN WORD OF -MAXTMP,,0
JOBNUM:		VALUE FROM PJOB UUO
MODE:		LHS BITS OF RM.???, RHS INDEX TO DATA TYPE
		SIXBIT=0, ASCII=1, EBCDIC=2, BINARY=3 INDEX
STRNUM:		NO. OF TEMP STRUCTURES TO USE
RECORD:		NO. OF BYTES IN RECORD
RECSIZ:		SIZE OF RECORD IN WORDS (NOT COBOL)
REKSIZ:		SIZE OF RECORD IN WORDS + EXTRACTED KEYS
NUMRCB:		NO. OF RECORDS TO HOLD IN MEMORY DURING SORT
IBUFNO:		NO. OF INPUT BUFFERS (NOT COBOL)
TBUFNO:		NO. OF TEMP BUFFERS FOR SORT PHASE
\
SUBTTL	PSORT. -- PSORT% - Initialization Continued

	SEGMENT	HIGH20

BEGIN
  PROCEDURE	(PUSHJ	P,PSORT%)
	MOVE	P1,NUMRCB		;NO. OF RECORDS
IFE FTCOBOL,<
	MOVEM	P1,RCBTOT		;FOR ENDS.
>
	IMULI	P1,RN.LEN		;LENGTH OF EACH NODE
	ADD	P1,TREORG		;PLUS BASE
	MOVEM	P1,TREEND		;END OF NODE TREE
	MOVE	P1,NUMRCB		;NO. OF RECORDS
	IMUL	P1,REKSIZ		;* SIZE OF EACH
	ADD	P1,TREEND		;PLUS BASE
	MOVEM	P1,RCBEND		;ADDRESS OF START OF BUFFER POOL
IFE FTOPS20,<				;DONE BY SETSIZ ON TOPS20
	MOVEM	P1,BUFPTR		;SAVE IT
>
IFN FTOPS20,<
	MOVE	P1,BUFPTR		;GET START OF BUFFER POOL
	ADD	P1,BUFSZ		;ADD IN SIZE OF BUFFER AREA
	ADDI	P1,PGSIZ		;ADD PG FOR ROUNDOFF ERROR
	MOVEM	P1,BUFTOP		;PUT A CEILING OVER BUFFERS
  IFE FTCOBOL,<
	MOVE	T1,BUFSZ		;GET SIZE OF BUFFER POOL
	LSH	T1,-1			;1/2 FOR TMP, 1/2 FOR INPUT
	IDIV	T1,MXDVSZ		;COMPUTE # OF INPUT BUFFERS
	MOVEM	T1,IBUFNO		; ..
  IF /MERGE
	SKIPG	MRGSW
	JRST	$F
  THEN DIVIDE BUFFER AREA BY NO. OF INPUT FILES
	PUSH	P,T1
	IDIV	T1,ACTTMP		;NO. OF ACTUAL FILES OVEN AT THIS TIME
	MOVEM	T1,IBUFNO		;NO. PER FILE
	POP	P,T1
  FI;
	SKIPN	T1			;T1 WILL BE ZERO IF INPUT
	ADDI	T1,1			; IS FROM MTA, BECAUSE MXDVSZ
					; HOLDS TWICE MTA BUFFER SIZE
	IMUL	T1,MXDVSZ		;REST IS FOR TEMP FILE BUFFERS
	MOVE	T2,BUFSZ		;GET SIZE OF POOL AGAIN
	SUB	T2,T1			;SUBTRACT INPUT BUFFERS
  >
  IFN FTCOBOL,<
	MOVE	T2,BUFSZ		;GET SIZE OF BUFFER POOL
  >
	IDIVI	T2,PGSIZ		;COMPUTE PAGES PER TMP BUFFER
	MOVEM	T2,TBUFNO		;SAVE
>
IFE FTOPS20,<
	PUSHJ	P,SETSTR		;SET UP TEMP DSK UNITS
>
	PUSHJ	P,INITRE		;INITIALIZE TREE WITH NULL RECORDS
	HRROS	LSTREC			;-1 SIGNALS THAT ITS JUST A DUMMY
	RETURN
END;
SUBTTL	CHECK MONITOR AND CPU TYPES

	SEGMENT	HIGH
BEGIN
  PROCEDURE	(JSP	T4,CPUTST)	;[134] MAY NOT HAVE STACK WHEN CALLED

;CPUTST IS CALLED AS A PART OF SORT'S INITIALIZATION TO CHECK WHETHER IT IS
;BUILT FOR THE MONITOR AND CPU ON WHICH IT FINDS ITSELF RUNNING. IF ANY
;INCOMPATIBILITIES ARE FOUND, THEN APPROPRIATE MESSAGES ARE TYPED. ALSO, THE CPU
;TYPE IS SAVED FOR LATER, SINCE MANY OF THE COMPARISON GENERATION ROUTINES
;COMPILE BETTER CODE IF THEY SEE THAT SORT IS RUNNING ON A KI OR KL CPU. NOTE THAT FOR THE MONITOR INCOMPATIBILITY MESSAGES TO GET PRINTED PROPERLY, **NO**
;MONITOR CALLS SHOULD BE DONE UNTIL CPUTST IS CALLED, SO THAT THE FIRST GETTAB
;IS SORT'S FIRST MONITOR CALL.

	MOVE	T1,[%CNMNT]		;[134] THIS IS **SIMULATED** BY TOPS-20 MONITOR
					;[134] I.E. DOES NOT CALL COMPAT. PAK.
	GETTAB	T1,			;SEE WHICH MONITOR
	  SETZ	T1,			;NOT IMPLEMENTED
	LDB	T1,[POINTR (T1,CN%MNT)]	;GET TYPE BYTE
	CAILE	T1,4			;[134] DEFINED MONITOR TYPE?
	MOVEI	T1,2			;[134] NO--CALL IT 'ITS' THEN
IFE FTOPS20,<	;[134] BRANCH DEPENDING ON MONITOR TYPE AND ASM SWITCHES
  CASE	%CNMNT OF (.+1,.+1,E$$SRM,E$$SRM,E$$1N2) ;[134]
	JRST	@[EXP	.+1,.+1,E$$SRM,E$$SRM,E$$1N2](T1) ;[134]
>
IFN FTOPS20,<
  CASE	%CNMNT OF (E$$SRM,E$$2N1,E$$SRM,,E$$SRM,.+1) ;[134]
	JRST	@[EXP	E$$SRM,E$$2N1,E$$SRM,E$$SRM,.+1](T1) ;[134]
>
  ESAC;
	SETZ	T2,			;[134] BUILD CPU TYPE HERE
	SETO	T1,			;FOR STANDARD KA/KI TEST
	AOBJN	T1,.+1
	JUMPN	T1,$1			;KA10
	ADDI	T2,1			;[134] KI10 OR KL10
	BLT	T1,0			;KL10 WILL STORE 1,,1
	JUMPE	T1,$1			;KI10
	ADDI	T2,1			;[134] KL10
  $1%
IFN FTKL10,<
	CAIGE	T2,KL.CPU		;[134] ARE WE RUNNING ON A KL10?
	JRST	E$$LNI			;[134] NO--QUIT BEFORE DMOVES, BIS CODE
>
IFN FTKI10&<FTKL10-1>,<			;[134] ASSEMBLE ONLY IF KI10
	CAIGE	T2,KI.CPU		;[134] ARE WE RUNNING ON A KI10?
	JRST	E$$INA			;[134] NO--QUIT BEFORE DMOVES, ETC.
>
	MOVEM	T2,CPU			;[134] SAVE CPU TYPE FOR CODE GEN
IFE FTOPS20,<
	GETPPN	T1,			;[115] GET LOGGED IN PPN
	  JFCL				;[115] JUST IN CASE
	MOVEM	T1,MYPPN		;[115] STORE IT
	MOVE	T1,[-2,,.GTADR]		;GET PROTECTION RELOCATION
	GETTAB	T1,
	SETO	T1,			;ASSUME NO HIGH SEG.
	HLRE	T1,T1			;PROTECTION = LENGTH
>
IFN FTOPS20,<
	HLRZ	T1,.JBHRL		;GET LENGTH OF HIGH SEGMENT
	SUBI	T1,1			;INCASE NONE
	IORI	T1,777			;FORCE ON PAGE BOUNDARY
>
	ADDI	T1,1			;IN P OR K
	MOVEM	T1,HISIZE
	RETURN
END;
;THESE ARE MESSAGES THAT ARE PRINTED ONLY IF WE FIND OURSELVES ON THE
;WRONG CPU. HOST SYSTEM MONITOR CALLS (OR REASONABLE ASSUMPTIONS) ARE
;USED TO PRINT THE MESSAGES, TO MAXIMIZE THE POSSIBILITY THAT THE USER
;WILL SEE THEM. THUS, THE $ERROR MACRO IS NOT USED, AND SORT EXITS
;IMMEDIATELY AFTER PRINTING.

IFE FTOPS20,<
	OPDEF	PSOUT[JSYS 76]		;[134] NEED THESE ON TOPS-10
	OPDEF	HALTF[JSYS 170]
>

	DEFINE	$ERR1(C,CODE,MSG)<	;;[134] PRINT ON TOPS-10
	OUTSTR	[ASCIZ \
C'SRT'CODE MSG
\]
	EXIT
>
	DEFINE	$ERR2(C,CODE,MSG)<	;;[134] PRINT ON TOPS-20
	HRROI	T1,[ASCIZ \
C'SRT'CODE MSG
\]
	PSOUT
	HALTF
	JRST	.-1			;;[134] HALTF CONTINUES
>

E$$SRM:	$ERR1	(?,SRM,<SORT/MERGE will not run on this machine.>)
IFE FTOPS20,<
E$$1N2:	$ERR2	(?,1N2,<TOPS-10 version of SORT/MERGE will not run on TOPS-20.>)
>
IFN FTOPS20,<
E$$2N1:	$ERR1	(?,2N1,<TOPS-20 version of SORT/MERGE will not run on TOPS-10.>)
>
IFN FTKL10,<
E$$LNI:	$ERR1	(?,LNI,<KL version of SORT/MERGE will not run on KI or KA CPU.>)
>
IFN FTKI10&<FTKL10-1>,<	;[134] ASSEMBLE ONLY IF KI10
E$$INA:	$ERR1	(?,INA,<KI version of SORT will not run on KA CPU.>)
>
SUBTTL	ZERO ALL LOW SEGMENT DATA

BEGIN
  PROCEDURE	(JSP	T4,ZDATA)	;ZERO AND INITIALIZE DATA AREAS
IFN FTKI10,<
	DMOVE	T1,[ZCOR,,ZCOR+1
		Z.BEG,,Z.BEG+1]
>
IFE FTKI10,<
	MOVE	T1,[ZCOR,,ZCOR+1]
	MOVE	T2,[Z.BEG,,Z.BEG+1]
>
	SETZM	ZCOR			;CLEAR FIRST WORD
	BLT	T1,EZCOR		;  AND REST OF DATA AREA
	SETZM	Z.BEG
	BLT	T2,Z.END
IFE FTOPS20,<
	MOVX	T1,UU.IBC+.IOBIN	;[215] INITIALIZE T.BLK
	MOVEM	T1,T.BLK+X.OPN+.OPMOD	;[215]   ..
	MOVX	T1,.TBS			;[215]   ..
	MOVEM	T1,T.BLK+X.DVSZ		;[215]   ..
	MOVX	T1,.RBDEV		;[215]   ..
	MOVEM	T1,T.BLK+X.RIB+.RBCNT	;[215]   ..
	MOVX	T1,'TMP   '		;[215]   ..
	HLLZM	T1,T.BLK+X.RIB+.RBEXT	;[215]   ..
	SETZM	T.BLK+X.RIB+.RBSPL	;[215]   ..
>;END IFE FTOPS20
	RETURN
END;



BEGIN
  PROCEDURE	(PUSHJ	P,GETJOB)		;GET JOB NUMBER

;GETJOB SETS LOCATION JOBNUM TO <SIXBIT JOB NUMBER PADDED WITH ZEROS>,,JOB
;NUMBER. THIS IS USED LATER BY THE TEMPORARY FILE ROUTINES TO GENERATE JOB-
;UNIQUE FILE NAMES FOR THE TEMPORARY FILES.

IFE FTOPS20,<
	PJOB	T1,			;GET JOB NUMBER
>
IFN FTOPS20,<
	GJINF
	MOVE	T1,3			;JOB NUMBER
>
	MOVEM	T1,JOBNUM		;SAVE IT
	IDIVI	T1,^D100		;GET HUNDREDS
	IDIVI	T2,^D10			;GET TENS
	LSH	T1,2*6			;SHIFT INTO POSITION
	LSH	T2,6			;...
	ADDI	T2,(T3)
	ADDI	T1,'000'(T2)		;MAKE SIXBIT
	HRLM	T1,JOBNUM		;SIXBIT OCTAL JOB NUMBER
	RETURN
END;

	SEGMENT LOW10
SUBTTL	RELES. -- RELES% - Add Record to Tree

BEGIN
  PROCEDURE	(PUSHJ	P,RELES%)
				;SEE IF IN THIS RUN OR NOT
	SKIPGE	J,LSTREC	;GET PREVIOUS
	JRST	$2		;STILL ON DUMMY RUN, WE CANNOT DO COMPARE
	COMPARE (R,J)
	  JRST	$1		;KEY(R) = KEY(J)	;OK
	  JRST	$1		;KEY(R) > KEY(J)	;OK
	  JRST	$2		;KEY(R) < KEY(J)	;TOO BIG

$2%	AOS	RQ		;BUMP RUN NUMBER
	AOSA	T1,NXTSEQ	;BELONGS TO NEXT SEQUENCE
$1%	AOS	T1,CURSEQ	;BELONGS TO THIS RUN
	TLNE	T1,-1		;WILL WE OVERFLOW A HALFWORD?
	PUSHJ	P,[	SKIPE	SEQOVF	;YES, TYPED MESSAGE ALREADY?
			POPJ	P,	;YES, ONLY TYPE IT ONCE
			SETOM	SEQOVF	;REMEMBER WE TYPED IT
			$ERROR	(%,SNO,<Sequence number overflow - SORT may be unstable>)
			POPJ P,]	;WARN OF INSTABILITY AND GO ON
	HRLM	T1,RN.SEQ(S)	;STORE FOR EQUAL TEST
	PUSHJ	P,SETTRE	;SET NEW RECORD IN TREE
	MOVEI	F,TMPFCB	;FCB OF TEMP FILE
	MOVE	T1,RQ		;GET RUN #
	CAMN	T1,RC		;SAME AS CURRENT?
	PJRST	RELOUT		;YES, OUTPUT IT
	MOVEM	T1,RC		;RESET
	PUSHJ	P,RELOUT	;OUTPUT RECORD IN LSTREC FIRST
	MOVE	T1,NXTSEQ	;PREPARE TO RESET SEQ #
	MOVEM	T1,CURSEQ
	SETZM	NXTSEQ
	SKIPN	NUMTMP		;IF FIRST RUN
	PJRST	FSTRUN		;THEN INITIALIZE FIRST RUN
	PJRST	CLSRUN		;ELSE CLOSE THE RUN, AND OPEN A NEW ONE
END;
BEGIN
  PROCEDURE	(PUSHJ	P,RELOUT)
	SKIPN	RQ		;A "REAL" OUTPUT?
	JRST	[HRRZ	R,RN.REC(S)	;NO, SET UP RECORD PTR
		RETURN]			;SINCE 0 IS A DUMMY
	SKIPL	R,LSTREC	;HOWEVER WHAT WE ACTUALLY OUTPUT IS LSTREC
	JSP	P4,PTTREC	;EXCEPT FIRST TIME
	HRRZ	R,RN.REC(S)	;THIS WAS ONE USER THOUGHT WE OUTPUT
	EXCH	R,LSTREC	;KEEP IT FOR NEXT TIME, GET R FOR NEXT INPUT
	HRRZS	R		;KEEP LH(R) ZERO SO @RSAV WORKS
	HRRZM	R,RN.REC(S)	;CHANGE PTR ALSO
	RETURN
END;
SUBTTL	TREE MANIPULATION -- Initialization

BEGIN
  PROCEDURE	(PUSHJ	P,INITRE)

;INITIALIZE THE RECORD TREE WITH NULL RECORD
;SET WITH
;RUN NO. = 0
;LOSER(R) = R

	SETZM	RC
	SETZM	RQ
	SOS	NUMRCB		;USE ONE RCB TO HOLD LAST RECORD TO OUTPUT
	MOVN	J,NUMRCB
	HRLZ	J,J		;AOBJN PTR
	MOVE	U,TREORG	;WHERE THE NODES START
	MOVEI	T1,RN.LEN(U)	;LOCATION OF NODE #1
	MOVEM	T1,FSTNOD	;USED IN COMPARES LATER
	MOVE	R,TREEND	;WHERE THE RECORDS START
$1%	MOVEM	U,RN.LSR(U)	;POINT TO ITSELF, RUN NO. = 0
	MOVEI	T1,(J)		;GET THIS INDEX
	LSH	T1,-1		;J/2
	IMULI	T1,RN.LEN	;DISTANCE FROM START
	ADD	T1,TREORG	;ABS LOCATION
	HRLZM	T1,RN.FI(U)	;PTR TO INTERNAL FATHER
	MOVE	T1,NUMRCB	;
	ADDI	T1,(J)
	LSH	T1,-1
	IMULI	T1,RN.LEN
	ADD	T1,TREORG
	HRRM	T1,RN.FE(U)
	MOVEM	R,RN.REC(U)	;PTR TO RECORD
	ADD	R,REKSIZ	;INCREMENT RECORD PTR
	ADDI	U,RN.LEN	;INCREMENT NODE
	AOBJN	J,$1		;LOOP
	HRRZM	R,LSTREC	;PLACE TO HOLD RECORD JUST OUTPUT
				;-1 SIGNALS JUST A DUMMY
	MOVE	S,TREORG	;INITIALIZE WITH NODE #0
	HRRZ	R,RN.REC(S)	;AND ITS RECORD
	RETURN
END;
SUBTTL	TREE MANIPULATION -- Insert Next Record

BEGIN
  PROCEDURE	(PUSHJ	P,SETTRE)
	HRRZ	U,RN.FE(S)		;GET NODE JUST ABOVE
$1%	HLRZ	T1,RN.RUN(U)		;GET ITS RUN NUMBER
	CAMGE	T1,RQ			;IF ITS LESS
	JRST	$3			;SWAP
	JUMPE	T1,$4			;DON'T TRY COMPARE IF DUMMY RUN
	CAMN	T1,RQ			;OR IF EQUAL
	CAIN	T1,-1			;AND END DUMMY RUN
	JRST	$4
	HRRZ	J,RN.LSR(U)		;EQUAL, TEST IF  LOSER(U) < R
	HRRZ	J,RN.REC(J)
	COMPARE (R,J)
	  JRST	$2			;KEY(R) = KEY(J)	;TEST
	  JRST	$3			;KEY(R) > KEY(J)	;SWAP
	  JRST	$4			;KEY(R) < KEY(J)	;OK

$2%	SKIPGE	SRTDN			;SEE WHICH  VERSION OF TEST REQUIRED
	JRST	$5			;IN MERGE PHASE
	HRRZ	T2,RN.LSR(U)		;GET LOSER AGAIN
	HLRZ	T1,RN.SEQ(S)		;GET SEQ(R)
	HLRZ	T2,RN.SEQ(T2)		;GET SEQ(LOSER(U))
	CAMG	T1,T2			;SEE WHICH CAME FIRST
	JRST	$4			;KEY(R) < KEY(J)
	JRST	$3			;KEY(R) > KEY(J)

$5%	HRRZ	T2,RN.LSR(U)		;GET LOSER AGAIN
	HLRZ	T2,RN.FCB(T2)		;GET FILE IT CAME FROM
	HLRZ	T1,RN.FCB(S)
	HLRZ	T1,FILRUN(T1)		;GET RUN # OF RECORD IN R
	HLRZ	T2,FILRUN(T2)		;GET RUN # OF RECORD IN J
	CAMG	T1,T2			;SEE WHICH CAME FIRST
	JRST	$4			;KEY(R) < KEY(J)
;	JRST	$3			;KEY(R) > KEY(J)

$3%	MOVE	T1,<RN.RUN+RN.LSR>/2(U)	;GET RUN# AND LOSER
	HRRM	S,RN.LSR(U)		;SET NEW LOSER
	HRRZ	S,T1			;SWAPED WITH S
	HRRZ	R,RN.REC(S)		;RESET RECORD PTR SO WE MATCH
	MOVE	T2,RQ			;CURRENT RUN#
	HRLM	T2,RN.RUN(U)		;SWAP
	HLRZM	T1,RQ			;...
$4%
;NOW SEE IF AT TOP YET
	CAMG	U,FSTNOD		;AT NODE #1?
	RETURN				;YES
	HLRZ	U,RN.FI(U)		;RESET CURRENT WINNER AND TRY AGAIN
	JRST	$1			;AND CONTINUE
END;
BEGIN
  PROCEDURE	(PUSHJ	P,CLSRUN)
	;HERE TO OPEN NEW TEMP FILE
	PUSHJ	P,CLSFIL		;CLOSE FILE
	PUSHJ	P,SETPAS		;RENDER FILE PASSIVE
IFE FTOPS20,<
	PUSHJ	P,OPOFIL		;OPEN NEW FILE
>
	PUSHJ	P,ENTFIL		;ENTER NEW FILE NAME
	SETZM	FILSIZ(F)
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,FSTRUN)
	;INITIALIZE TEMP FILE FOR FIRST RUN
	;USES	P1, P2

	SETZM	FILSIZ(F)		;CLEAR NUMBER OF RECORDS IN FILE
IFE FTOPS20,<
	PUSHJ	P,OPOFIL		;OPEN FILE FOR OUTPUT
	MOVEI	P1,T.BLK		;[215] SET UP CALL TO BUFRNG
	SKIPE	SRTDN			;IF ON MERGE PHASE
	SKIPA	P2,OBUFNO		;[215]   THEN USE OUTPUT #
	MOVE	P2,TBUFNO		;[215]   ELSE USE .TMP #
	PUSHJ	P,BUFRNG		;CREATE BUFFER RING
>
	SETZM	BUFALC			;FIRST TIME, SO ALLOCATE BUFFER
	PUSHJ	P,ENTFIL		;ENTER FILE
	SETOM	BUFALC			;REUSE BUFFERS FROM NOW ON
	RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,SETMRG)
	MOVE	T1,NUMINP		;GET NO. OF INPUT FILES
	CAIG	T1,1			;NEED AT LEAST 2 INPUT FILES
	JRST	E$$ATF			;ERROR
	CAMLE	T1,MAXTMP		;MORE THAN WE CAN HANDLE
	MOVE	T1,MAXTMP		;YES, USE MAX
	MOVEM	T1,ACTTMP
	MOVEM	T1,NUMRCB		;THIS IS NO. OF RECORDS IN MEMORY
	MOVN	T1,T1
	ADDB	T1,NUMINP		;NO. LEFT FOR NEXT TIME
IFE FTCOBOL,<
	CAIE	T1,1			;CHECK FOR SPECIAL CASE
>
	AOSA	NUMRCB			;PLUS ONE FOR LASTREC
	AOSA	NUMINP			;YES, MAKE IT 2 FOR NEXT TIME
	FASTSKIP
	SOS	ACTTMP			;AND ONE LESS THIS TIME
	RETURN
END;
SUBTTL	MERGE. -- MERGE% - Begin a Merge Cycle

BEGIN
  PROCEDURE	(PUSHJ	P,MERGE%)
  IF HERE FOR FIRST TIME (NOT A MERGE CYCLE) AND NOT /MERGE
	SKIPG	MRGSW
	SKIPGE	SRTDN			;-1 ON MERGE CYCLES
	JRST	$T
  THEN THE OUTPUT FILE IS AT TMPFCB
	MOVEI	F,TMPFCB		;PTR TO FCB OF TEMPORARY OUTPUT FILE
	JRST	$F
  ELSE ON MERGE CYCLE OUTPUT FILE IS AT FCBORG
	MOVEI	F,FCBORG		;FCB OF MERGE OUTPUT FILE
  FI;

	SKIPLE	MRGSW			;ALREADY SETUP IF /MERGE
	JRST	$3			;YES, JUST CLOSE RUN
  IF WE HAVE NO OUTPUT FILE
	SKIPN	NUMTMP			;ANY OUTPUT FILES?
  THEN	SET RETRN. ADDRESS AND RETURN TO CALLER
	JRST	MERGE0
  FI;
				;DUMP IN MEMORY TREE
  IF FIRST TIME THROUGH
	SKIPGE	SRTDN		;0 ON FIRST TIME
	JRST	$F		;NOT
  THEN	OUTPUT RECORD STORED IN LSTREC TO CURRENT RUN
	HRRZ	R,LSTREC	;FLUSH LAST RECORD FIRST
	JSP	P4,PTTREC	;WE KNOW IT IS IN THIS RUN
	HRRZ	R,RN.REC(S)	;RESET RECORD PTR
  FI;
  $1%	HLLOS	RQ		;MAKE SURE NOT IN THIS RUN
	PUSHJ	P,SETTRE	;SET DUMMY RECORD IN TREE
	SKIPN	T1,RQ		;GET RUN NUMBER OF RECORD IN (R)
	JRST	$1		;STILL ON DUMMY RUN
	CAIN	T1,-1		;TEST FOR END CONDITION
	JRST	$3		;ALL DONE
	CAMN	T1,RC
	JRST	$2		;STILL IN CURRENT RUN
	MOVEM	T1,RC		;RESET CURRENT RUN (ONLY HAPPENS AFTER DUMMY)
	PUSHJ	P,CLSRUN	;CLOSE THIS RUN
  $2%	JSP	P4,PTTREC	;WRITE IT OUT
	JRST	$1		;LOOP FOR ALL IN-MEMORY RECORDS
  $3%
  IF	FIRST TIME
	SKIPGE	SRTDN
	JRST	$F
  THEN	STORE NO. OF RUNS
	MOVE	T1,NUMTMP	;GET NUMBER OF RUNS ON SORT PASS
	MOVEM	T1,RUNTOT	;SAVE FOR ENDS. CODE
	SETOM	SRTDN		;SIGNAL THAT WE'VE BEEN HERE
	SETZM	WSCSW		;CLEAR CHECK FLAG SINCE ITS ALL DONE WITH
  FI;
					;CLOSE OUT LAST TEMP FILE
	PUSHJ	P,CLSFIL		;CLOSE FILE
	PUSHJ	P,SETPAS		;RENDER FILE PASSIVE
  IF ONLY ONE TEMP FILE
	MOVE	T1,NUMTMP		;GET NO. OF TEMP FILES
  THEN COPY (OR RENAME) IT
	SOJLE	T1,MERGE1		;ONLY ONE, COPY IT
  FI;
IFN FTCOBOL&<1-FTOPS20>,<	;ONLY FOR TOPS-10 COBOL SORT
  IF /MERGE FOR FIRST TIME NEEDING REAL MERGE PASSES
	SKIPLE	MRGSW
	SKIPE	MRGNUM
	JRST	$F			;NO
  THEN SETUP EXTRA CHANNELS NOW
	MOVE	T1,CHNMAP+0		;DONE WITH OUTPUT CHAN
	MOVEM	T1,CHNMAP+1		;SO MAKE IT FIRST INPUT
	SETZM	CHNMAP+0		;AVOID CONFUSION
	MOVN	P1,NUMTMP		;GET NUMBER OF FILES NEEDED
	HRLZI	P1,1(P1)		;WE ALREADY HAVE ONE
  $5%	PUSHJ	P,GTMCHN		;GET CHANNEL
	MOVEM	T1,CHNMAP+2(P1)		;STORE IT
	AOBJN	P1,$5			;LOOP
  FI;
>
IFE FTKI10!FTKL10,<
	MOVE	T1,[DFBORG,,TMPFCB]
	MOVE	T2,[DFBLEN,,DFBLEN]
>
IFN FTKI10!FTKL10,<
	DMOVE	T1,[DFBORG,,TMPFCB
		    DFBLEN,,DFBLEN]
>
	MOVE	T3,MAXTMP		;NO. TO COPY BACK
  $4%	MOVE	T4,T1			;GET TEMP COPY
	ADD	T1,T2			;ADVANCE TO NEXT
	BLT	T4,-1(T1)		;COPY PART WE NEED
	ADDI	T1,FCBLEN-DFBLEN	;ADVANCE RHS TO NEXT ALSO
	SOJG	T3,$4			;LOOP
	MOVE	T1,NUMTMP		;NUMBER OF TEMPORARY FILES
	MOVEM	T1,NUMLFT		;STILL TO DO
	SETZM	NUMTMP			;START COUNTING AGAIN IF WE HAVE TO
	CAMLE	T1,MAXTMP		;MORE THAN MAXTMP ?
	MOVE	T1,MAXTMP		;YES, INITIALIZE ONLY LOWEST ONES
	MOVEM	T1,ACTTMP		;NO. ACTIVE THIS TIME
	MOVEM	T1,NUMRCB
	AOS	NUMRCB			;ONE FOR LSTREC TO HOLD AT EOF TIME
	IMULI	T1,RN.LEN		;SIZE OF TREE
	ADD	T1,TREORG		;+ BASE
	MOVEM	T1,TREEND
	MOVE	T1,NUMRCB
	IMUL	T1,REKSIZ
	ADD	T1,TREEND		;+ BASE
	MOVEM	T1,RCBEND		;TOP OF RECORDS
IFE FTOPS20,<
	MOVEM	T1,BUFPTR		;SAVE START OF BUFFER POOL
>
	SETZM	BUFALC			;MAKE SURE WE ALLOCATE
	PUSHJ	P,RFMBFP		;REFORMAT BUFFER POOL FOR MERGE
	PUSHJ	P,INITRE		;INITIALIZE THE TREE WITH NULLS
	PUSHJ	P,GETACT		;SETUP AT MOST MAXTMP FILES
  IF NOT MORE THAN MAXTMP FILE
	SKIPN	T1,NUMLFT		;MORE THAN MAXTMP TMP FILES ?
  THEN DO IN ONE PASS
	JRST	MERGE2			;NO, FINAL MERGE PASS NOW
  FI;
					;MERGE AT MAXTMP TO 1 RATE
	MOVN	T1,MAXTMP		;-NO. OF TEMP FILES ALLOWED
	HRLZM	T1,TCBIDX		;RESET NAME INDEX
	SETZM	NUMENT			;START ENTERS AGAIN
IFN FTCOBOL&<1-FTOPS20>,<	;ONLY FOR TOPS-10 COBOL SORT
  IF FIRST TIME
	SKIPE	MRGNUM			;IF FIRST TIME
	JRST	$F
  THEN GET EXTRA CHANNEL
	PUSHJ	P,GTMCHN		;GET EXTRA CHANNEL FOR MERGE
	MOVEM	T1,CHNMAP+0		;SAVE IT
  FI;
>
	AOS	MRGNUM			;INCREMENT MERGE PASS NUMBER
	MOVEI	T1,DELEOF		;
	MOVEM	T1,PHYEOF		;DELETE FILE IF PHYSICAL EOF
	MOVEI	T1,MRGEOF
	MOVEM	T1,LOGEOF		;GET NEXT RUN
	MOVEI	F,FCBORG
	PUSHJ	P,FSTRUN		;OPEN NEW OUTPUT FILE
	JSP	P4,PTTREC		;OUTPUT CURRENT WINNER TO FREE UP
					;SPACE FOR NEXT RECORD
	BEGIN
	  ;LOOP TO READ FROM ALL TEMP FILES AND OUTPUT TO NEW TEMP FILE
	  ;NOTE THIS LOOP EXITS VIA END-OF-FILE EXITS
	
	  $1%	HLRZ	F,RN.FCB(S)	;GET FCB OF RECORD JUST OUTPUT
		JSP	P4,GTTREC	;GET NEXT RECORD FROM SAME FILE
		  PUSHJ	P,@EF		;HANDLE E-O-F
		PUSHJ	P,SETTRE	;SET NEW RECORD IN TREE
		MOVEI	F,FCBORG	;FCB OF OUTPUT FILE
		MOVE	T1,RQ		;GET RUN #
		CAMN	T1,RC		;SAME AS CURRENT?
		JRST	$2		;YES, OUTPUT IT
		MOVEM	T1,RC		;RESET
		PUSHJ	P,CLSRUN	;CLOSE THE RUN
	
	  $2%	JSP	P4,PTTREC
		JRST	$1			;LOOP
	END;
END;
BEGIN
  PROCEDURE (PUSHJ	P,DELEOF)
	PUSHJ	P,DELFIL		;DELETE TEMP FILE NOW
	PUSHJ	P,RELFIL		;AND RELEASE THE DEVICE
	SOSG	T1,ACTTMP		;LAST RUN YET?
	JRST	MERGE%			;YES, TRY AGAIN
	HLLOS	RQ			;NO, SO RETURN WITH DUMMY RECORD
	SKIPLE	NUMLFT			;ON THE LAST CYCLE?
	RETURN				;NOT YET
	MOVE	T2,NUMENT		;GET NUMBER OF NEW RUNS
	ADDI	T2,(T1)			;TOTAL RUNS LEFT TO DO
	CAMG	T2,MAXTMP		;CAN WE GO STRAIGHT TO OUTPUT?
	JRST	MRGLST			;YES
REPEAT 0,<	;NOT WORKING YET
	MOVE	T2,NUMENT		;GET NEW RUNS AGAIN
	IDIV	T2,MAXTMP		;SEE HOW MANY PASSES
	JUMPE	T3,$1			;WITH ANY LUCK WE WON'T GET ANY MORE RUNS
	ADDI	T1,(T3)			;REMAINDER+ WHATS LEFT FROM THIS
	CAMG	T1,MAXTMP		;CAN WE DO IT IN 1 PASS?
	JRST	MRGNXT			;YES, START NEXT MERGE PASS
>;END REPEAT 0
  $1%	RETURN				;NO, CONTINUE UNTIL WE CAN
END;


BEGIN
  PROCEDURE (PUSHJ	P,MRGEOF)
	JSP	P4,GTTREC		;GET FIRST RECORD OF NEXT RUN
	  JRST	E$$RIE			;SOMETHING WRONG
	SOS	NUMLFT			;1 LESS LEFT TO READ NOW
	MOVE	T1,RQ			;GET RUN #
	CAIN	T1,-1			;INCASE JUST RETURNED FROM DELEOF
	RETURN				;YES, RETURN TO CALLER
	PUSH	P,S			;SAVE WHO WE ARE
	PUSHJ	P,SETTRE		;GET NEW WINNER
	POP	P,U			;GET BACK ORIGINAL RECORD
	CAMN	S,U			;WAS IT THE WINNER?
	AOS	RQ			;YES, SO FORSE INTO NEXT RUN
	RETURN				;RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,MRGLST)

;HERE WHEN WE CAN FINISH MERGE IN THIS PASS. COMPLICATED BY THE FACT THAT SOME
;FILES (ACTTMP) ARE STILL OPEN, WHILE OTHERS (NUMTMP) ARE NOT YET. FIRST SEE IF
;WE HAVE MORE THAN ONE RUN IN MEMORY.

	MOVN	U,NUMRCB		;NO. OF NODES
	HRLZ	U,U
	HRR	U,TREORG		;AOBJN PTR
  $1%	HLRZ	T1,RN.RUN(U)		;GET RUN #
	CAIN	T1,-1			;IGNORE DUMMY AT END
	JRST	$2
	CAMLE	T1,RC			;IN CURRENT RUN?
	JRST	$3			;NO, WE MUST FLUSH THIS RUN OUT
  $2%	ADDI	U,RN.LEN-1
	AOBJN	U,$1			;LOOP
	JRST	$4			;DID N'T FIND ANYTHING TO DO
  $3%	PUSHJ	P,SETTRE		;OUTPUT RECORD TO TREE
	MOVEI	F,FCBORG		;FCB OF OUTPUT FILE
	MOVE	T1,RQ			;GET RUN #
	CAME	T1,RC			;SAME AS CURRENT?
	JRST	$4			;NO, SO WE ARE THROUGH
	JSP	P4,PTTREC		;OUTPUT THE RECORD
	HLRZ	F,RN.FCB(S)		;GET FCB OF RECORD JUST OUTPUT
	JSP	P4,GTTREC		;GET NEXT RECORD FROM SAME FILE
	  PUSHJ	P,@EF			;HANDLE E-O-F
	JRST	$3			;PUT IN TREE

  $4%	MOVEI	F,FCBORG		;OUTPUT CHAN
	PUSHJ	P,CLSFIL		;CLOSE IT
	PUSHJ	P,SETPAS		;RENDER FILE PASSIVE
	HRRZS	TCBIDX		;GET NO. OF DORMANT FILES
	SOS	TCBIDX		;BACKUP TO POINT TO LAST FILE WRITTEN
IFE FTCOBOL,<
  IFE FTOPS20,<
	MOVE	T1,FILBUF(F)		;GET WHERE BUFFERS START
  >
  IFN FTOPS20,<
	HRRZ	T1,FILBUF(F)		;GET PTR TO START OF BUFFERS
	MOVX	T2,FI.DSK		;IS THIS A DISK FILE?
	TDNE	T2,FILFLG(F)		; ..
	LSH	T1,POW2(PGSIZ)		;IF SO, CONVERT PG TO ADDR
  >
	MOVEM	T1,BUFPTR		;SO WE CAN REALLOCATE FOR OUTPUT
	PUSHJ	P,INIOUT		;OPEN OUTPUT MASTER FILE
>
IFN FTCOBOL&<1-FTOPS20>,<	;ONLY FOR TOPS-10 COBOL SORT
	PUSHJ	P,RTMCHN		;RETURN THE EXTRA MERGE CHAN
>
	BEGIN
		MOVN	U,NUMRCB		;GET AOBJN PTR AGAIN
		HRLZ	U,U
		HRR	U,TREORG
	  $1%	HLRZ	T1,RN.RUN(U)		;GET RUN # OF LOSER
		CAIN	T1,-1			;IGNORE IF NOT DUMMY
		SUBI	T1,2			;REDUCE BY 2 SO DUMMY IS NOW 777775
		HRLM	T1,RN.RUN(U)		;REPLACE IN TREE
		ADDI	U,RN.LEN-1
		AOBJN	U,$1			;LOOP
		SOS	RQ			;REDUCE CURRENT RUN #
		SOS	RQ			;...
	END;
	BEGIN
		;NOW READ ALL RECORDS FROM TREE
		;IF RECORD IS A REAL ONE PUT IT BACK WITH RUN # 777776
		;IF RQ = 777775 THEN IT WAS A DUMMY
		;OPEN A NEW TEMP FILE AND PUT NEW RECORD IN TREE
	  $1%	MOVE	T1,RQ		;GET RUN #
		CAIN	T1,-2		;SEE IF END OF CONVERSION
		JRST	$E		;YES
		CAIE	T1,-3		;SEE IF A NEW DUMMY
		JRST	$2		;NO
		SKIPGE	TCBIDX		;ANY MORE DORMANT FILES?
		JRST	[HLLOS	RQ		;NO
			JRST	$3]		;PUT REAL DUMMY BACK
		HLRZ	F,RN.FCB(S)	;GET FILE THAT WAS LAST USED
		PUSHJ	P,SETACT	;GET A PASSIVE FILE
		SETZM	FILCNT(F)	;CLEAR COUNT
IFE FTOPS20,<
		PUSHJ	P,OPIFIL	;OPEN DEVICE FOR INPUT AGAIN
>
		PUSHJ	P,LKPFIL	;LOOKUP NEW FILE
		AOS	ACTTMP		;ONE MORE FILE NOW
		JSP	P4,GTTREC	;GET FIRST RECORD
		  JRST	E$$RIE
	  $2%	MOVEI	T1,-2
		MOVEM	T1,RQ		;PUT RECORD BACK WITH TERMINAL #
	  $3%	PUSHJ	P,SETTRE	;PUT IN TREE
		JRST	$1		;SEE WHAT POPPED UP
	END;
	BEGIN
		;INCREASE REAL RUN NUMBERS BY 3 (TO +1)
		MOVN	U,NUMRCB		;GET AOBJN PTR AGAIN
		HRLZ	U,U
		HRR	U,TREORG
	  $1%	HLRZ	T1,RN.RUN(U)		;GET RUN # OF LOSER
		CAIE	T1,-1			;LEAVE REAL DUMMY ALONE
		ADDI	T1,3			;INCREMENT SO DUMMY IS NOW 777777
		HRLM	T1,RN.RUN(U)		;REPLACE IN TREE
		ADDI	U,RN.LEN-1
		AOBJN	U,$1			;LOOP
		SETZM	RQ
		AOS	RQ			;INCREMENT CURRENT RUN #
	END;
	BEGIN
		;SETUP END-OF-FILE TRAPS AND RETURN TO TOP LEVEL
		SETOM	MRGDN		;SIGNAL DONE WITH TEMP MERGES
		MOVEI	T1,EOF15
		HRRZM	T1,LOGEOF
		HRRZM	T1,PHYEOF
IFE FTCOBOL,<
		MOVEI	F,FCBORG
		JSP	P4,PUTREC	;WE ALREADY HAVE FIRST RECORD IN R
>
		MOVEI	T1,RETRN2	;WHICH RETRN. ROUTINE TO USE
		MOVEM	T1,$RETRN
		MOVE	P,PSAV
	END;
	RETURN
END;
;INITIALIZE AT MOST MAXTMP ACTIVE RUNS FOR INPUT

BEGIN
  PROCEDURE	(PUSHJ	P,GETACT)
	PUSH	P,NUMTMP		;SAVE NUMTMP
	MOVN	T1,ACTTMP		;MINUS THE RUNS WE WILL DO THIS TIME
	ADDM	T1,NUMLFT		;RESIDUAL RUNS
	MOVEI	F,FCBORG+1		;PTR TO FIRST FCB FOR INPUT FILE
	HRL	F,T1			;AOBJN PTR
	MOVE	S,TREORG		;GET FIRST "WINNER"
	HRRZ	R,RN.REC(S)		;AND RECORD
$1%	ADDI	F,FCBLEN-1		;NEXT FILE
	SKIPN	BUFALC			;ALREADY ALLOCTED BUFFER RING ?
	PUSHJ	P,OBLFIL		;NO, SET IT UP FOR INPUT
	JSP	P4,GTTREC		;GET FIRST RECORD OF TEMP FILE
	  JRST	E$$RIE			;SOMETHING WRONG
	AOS	RQ			;WILL BE RUN #1
	HRLM	F,RN.FCB(S)		;INDICATE WHICH FILE RECORD CAME FROM
	AOS	T1,NUMTMP		;RE-INITIALIZE THE RUN NUMBERS
	HRLM	T1,FILRUN(F)		;SAVE IN DFBORG BLOCK
	PUSHJ	P,SETTRE		;SET NEW RECORD IN TREE
	HRRZ	R,RN.REC(S)		;SET UP RECORD PTR
	AOBJN	F,$1			;GET NEXT RECORD
	POP	P,NUMTMP		;RESTORE NUMTMP
	AOS	RC			;SET CURRENT RUN TO #1
	SETOM	BUFALC			;INDICATE BUFFER RNGS FORMED
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,OBLFIL)
;SETUP FILE FOR INPUT -- DO OPEN, SET UP BUFFERS, AND LOOKUP
	SETZM	FILCNT(F)		;CLEAR BUFFER COUNT
IFE FTOPS20,<
	PUSHJ	P,OPIFIL		;OPEN FILE FOR INPUT
	MOVEI	P1,T.BLK		;[215] SET UP CALL TO BUFRNG
	MOVE	P2,TBUFNO		;[215]   ..
	PUSHJ	P,BUFRNG		;FORM BUFFER RING
>
	PJRST	LKPFIL			;PERFORM LOOKUP
END;
SUBTTL	MERGE. -- MERGE0 - 0 Temporary Files

BEGIN
  PROCEDURE	(PUSHJ	P,MERGE0)
	MOVEI	T1,RETRN0		
	MOVEM	T1,$RETRN		;WHERE TO GO
IFE FTCOBOL,<
 IFE FTOPS20,<
	MOVE	T2,RCBEND		;START OF BUFFERS
	MOVEM	T2,BUFPTR		;POINT TO THEM
	MOVE	T1,.JBREL		;TOP OF MEMORY
	SUB	T1,T2			;SEE WHATS FREE
	MOVE	T2,F.OXBK		;[215] GET OUTPUT BUFFER SIZE
	IDIV	T1,X.DVSZ(T2)		;[215] DIVIDE BY BUFFER SIZE
>
IFN FTOPS20,<
	MOVE	T1,BUFPT1		;GET ORIGINAL BUFPTR
	MOVEM	T1,BUFPTR		;RESET BUFPTR
	MOVE	T1,BUFSZ		;GET SIZE OF BUFFER POOL
	IDIV	T1,OBUFSZ		;DIVIDE BY OUTPUT BUFFER SIZE
	JUMPE	T1,E$$NRO
>
	MOVEM	T1,OBUFNO		;RESET NUMBER OF OUTPUT BUFFERS
	PUSHJ	P,INIOUT		;INIT OUTPUT MASTER
>
	SKIPG	LSTREC			;LSTREC TO FLUSH FIRST?
IFE FTCOBOL,<
	RETURN
>
IFN FTCOBOL,<
	PJRST	RETRN0			;GET FIRST RECORD FOR COBOL
>
	MOVE	R,LSTREC		;YES, GET RECORD PTR
IFE FTCOBOL,<
	JSP	P4,PUTREC		;OUTPUT IT
>
	RETURN				;RETURN WITH RECORD IN (R)
END;
SUBTTL	MERGE. --  MERGE1 - 1 Temporary File

BEGIN
  PROCEDURE	(PUSHJ	P,MERGE1)
IFN FTCOBOL&<1-FTOPS20>,<	;ONLY FOR TOPS-10 COBOL SORT
	SKIPE	MRGNUM			;DID WE DO ANY MERGE PASSES?
	PUSHJ	P,RTMCHN		;YES, THEN RETURN EXTRA CHAN
>
IFE FTCOBOL!FTFORTRAN,<
	PUSHJ	P,TSTDEV		;SEE IF SAME DEVICE
>
	MOVEI	T1,RETRN1		;WE WILL HAVE TO COPY
	MOVEM	T1,$RETRN		;SET RETRN. ADDRESS
	MOVEI	T1,EOFSNG		;END OF FILE TRAP
	MOVEM	T1,LOGEOF
	MOVEM	T1,PHYEOF
	MOVE	T2,RCBEND		;START OF BUFFERS
	MOVEM	T2,BUFPTR		;POINT TO THEM
IFE FTOPS20,<
	MOVE	T1,LOSIZE		;TOP OF MEMORY
	SUB	T1,T2			;SEE WHATS FREE
  IFE FTCOBOL,<
	MOVE	T2,F.OXBK		;[215] GET OUTPUT BUFFER SIZE
	MOVE	T2,X.DVSZ(T2)		;[215] SIZE OF OUTPUT BUFFER
	IDIVI	T1,.TBS(T2)		;DIVIDE BY COMBINED BUFFER SIZE
  >
  IFN FTCOBOL,<
	IDIVI	T1,.TBS			;INPUT TEMP BUFFERS ONLY
  >
	MOVEM	T1,TBUFNO		;RESET NUMBER
  IFE FTCOBOL,<
	MOVEM	T1,OBUFNO		;RESET NUMBER OF OUTPUT BUFFERS
	PUSHJ	P,INIOUT		;INIT OUTPUT MASTER
  >;END IFE FTCOBOL
>;END IFE FTOPS20
IFN FTOPS20,<
	MOVE	T1,BUFSZ		;GET SIZE OF BUFFER POOL
  IFE FTCOBOL,<				;IF NOT COBOL, WE HAVE OUTPUT FILE
	MOVE	T2,OBUFSZ		;GET OUTPUT FILE BUFFER SIZE
	IDIVI	T1,PGSIZ(T2)		;DIVIDE BY COMBINED BUFFER SIZE
  >
  IFN FTCOBOL,<				;IF COBOL, WE ONLY HAVE TEMP FILE
	LSH	T1,-<POW2(PGSIZ)>	;DIVIDE BY TEMP BUFFER SIZE
  >
	MOVEM	T1,TBUFNO		;SAVE NO. OF TEMP AND OUTPUT BUFFERS
  IFE FTCOBOL,<
	MOVEM	T1,OBUFNO
	SETZM	BUFALC			;FORCE BUFFER ALLOCATION
	PUSHJ	P,INIOUT		;OPEN THE OUTPUT FILE
  >
>;END IFE FTOPS20
	SETZM	TCBIDX			;SO WE GET FIRST FILE AGAIN
	MOVEI	F,TMPFCB
	PUSHJ	P,OBLFIL		;LOOKUP TEMP FILE AGAIN
IFN FTCOBOL,<
	MOVEI	F,TMPFCB
	JSP	P4,GTTREC		;GET FIRST RECORD FROM TEMP FILE
	  JRST	@EF			;E-O-F
>
	MOVE	P,PSAV
	RETURN
END;
SUBTTL	MERGE. -- MERGE2 - Final Merge of 2 or More Temporary Files

BEGIN
  PROCEDURE	(PUSHJ	P,MERGE2)
	SETOM	MRGDN			;SIGNAL DONE WITH TEMP MERGES
	MOVEI	T1,EOF15
	HRRZM	T1,LOGEOF
	HRRZM	T1,PHYEOF
IFN FTCOBOL&<1-FTOPS20>,<
	SKIPE	MRGNUM			;DID WE DO ANY MERGE PASSES?
	PUSHJ	P,RTMCHN		;YES, THEN RETURN EXTRA CHAN
>
IFE FTCOBOL,<
	PUSHJ	P,INIOUT		;OPEN SORT.OUT
	JSP	P4,PUTREC		;WE ALREADY HAVE FIRST RECORD IN R
>
	MOVEI	T1,RETRN2		;WHICH RETRN. ROUTINE TO USE
	MOVEM	T1,$RETRN
	MOVE	P,PSAV
	RETURN
END;
SUBTTL	RETRN. -- RETRN% - Return Record From Tree to Output File

IFE FTCOBOL,<
BEGIN
  PROCEDURE	(PUSHJ	P,RETRN.)
	MOVEM	P,PSAV
	SETOM	MRGDN		;SO WE GO TO PUTREC
$1%	PUSHJ	P,RETRN%	;READ A RECORD 
	MOVEI	F,FCBORG	;POINT TO OUTPUT FILE
	JSP	P4,PUTREC	;WRITE IT OUT
	JRST	$1		;LOOP
	RETURN
END;
>

BEGIN
  PROCEDURE	(PUSHJ	P,RETRN%)
	PJRST	@$RETRN		;GO TO RIGHT ROUTINE
END;
SUBTTL	RETRN. -- RETRN0 - 0 Temporary Files

BEGIN
  PROCEDURE	(PUSHJ	P,RETRN0)
	;HERE TO WRITE ALL IN-MEMORY RECORDS TO OUTPUT MASTER FILE

	HLLOS	RQ		;MAKE SURE NOT IN THIS RUN
	HRRZ	U,RN.FE(S)	;GET NODE JUST ABOVE
	PUSHJ	P,SETTRE	;SET DUMMY RECORD IN TREE
	SKIPN	T1,RQ		;GET RUN NUMBER OF RECORD IN (R)
	JRST	RETRN0		;STILL ON DUMMY RUN
	CAIN	T1,-1		;TEST FOR END CONDITION
	JRST	EOFOUT		;ALL DONE
	CAME	T1,RC
	MOVEM	T1,RC		;RESET CURRENT RUN (ONLY HAPPENS AFTER DUMMY)
	RETURN
END;
SUBTTL	RETRN. -- RETRN1 - 1 Temporary File

BEGIN
  PROCEDURE	(PUSHJ	P,RETRN1)
	;HERE TO COPY SINGLE TEMP FILE TO OUTPUT FILE
	MOVEI	F,TMPFCB
	JSP	P4,GTTREC		;GET A RECORD FROM TEMP FILE
	  JRST	@EF			;E-O-F
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,EOFSNG)
	PUSHJ	P,DELFIL		;DELETE TEMP FILE
	PUSHJ	P,RELFIL		;RELEASE DEVICE
	JRST	EOFOUT			;FORCE OUT LAST RECORD
END;
SUBTTL	RETRN. -- RETRN2 - Final Merge of 2 or More Temporary Files

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



BEGIN
  PROCEDURE	(PUSHJ	P,EOF15)
	PUSHJ	P,DELFIL		;DELETE TEMP FILE
	PUSHJ	P,RELFIL		;RELEASE CHAN
	SOSG	ACTTMP			;ALL DONE?
	JRST	EOFOUT			;YES
	HLLOS	RQ			;SET TERMINATING RUN#
	RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,SETPAS)
	HRRZ	T1,TCBIDX		;GET CURRENT POS
	IMULI	T1,DFBLEN
	ADDI	T1,DFBORG		;POSITION IN MEMORY
	HRL	T1,F
	HRRZI	T2,DFBLEN(T1)		;BLT PTR LIMIT
	BLT	T1,-1(T2)		;COPY FILE
	MOVE	T1,TCBIDX
	AOBJN	T1,$1			;INCREMENT PTR
	MOVN	T1,T1			;GET NUMBER
	HRLZ	T1,T1			;START AGAIN
  $1%	MOVEM	T1,TCBIDX		;STORE BACK
	RETURN
END;

BEGIN
  PROCEDURE	(PUSHJ	P,SETACT)
	HRRZ	T1,TCBIDX		;GET CURRENT POS
	IMULI	T1,DFBLEN
	ADDI	T1,DFBORG		;POSITION IN MEMORY
	HRLZ	T1,T1			;FROM
	HRR	T1,F			;TO
	HRRZI	T2,DFBLEN(T1)		;BLT PTR LIMIT
	BLT	T1,-1(T2)		;COPY FILE
	SOS	TCBIDX			;REDUCE INDEX
	RETURN
END;
SUBTTL	GETREC -- GETREC - Get Next Record From Input File

IFE FTCOBOL,<
BEGIN
  PROCEDURE	(JSP	P4,GETREC)

;GETREC RETURNS THE NEXT RECORD FROM THE INPUT FILE (OR NEXT ONE IF MERGING).
;FIRST, HANDLE ANY BLOCKING FACTOR FOR THIS FILE BY COUNTING DOWN THE RECORDS
;READ IN THIS BLOCK AND SKIPPING TO THE NEXT BLOCK IF IT'S TIME. THEN, RETURN
;THROUGH THE PROPER GET-RECORD ROUTINE BASED ON THE FILE'S I/O MODE. ALL OF THE
;LOWER-LEVEL GET-RECORD ROUTINES GETREC CALLS RETURN THROUGH THE KEY EXTRACTION
;CODE.
;
;CALL WITH:
;	F/	POINTER TO FCB
;	R/	POINTER TO RCB
;	JSP	P4,GETREC
;
;RETURNS EITHER:
;	MOVE	EF,PHYEOF!LOGEOF
;	JRST	0(P4)			;END-OF-FILE
;OR:
;	JRST	1(P4)			;NORMAL

	MOVEM	R,RSAV
  IFE FTFORTRAN,<
  $1%	SKIPE	T1,FILBLK(F)		;BLOCKED FILE?
	AOBJP	T1,[MOVN T1,T1			;RESET BLOCKING FACTOR
		HRLZM	T1,FILBLK(F)		;REFORM AOBJN PTR
    IFN FTOPS20,<
		MOVX	T1,FI.BLK		;TELL GETBUF TO BLOCK FILE
		IORM	T1,FILFLG(F)		; AS IF ON TOPS-10
    >;END IFN FTOPS20
		JSP	T4,GETBUF		;FILL BUFFER
		  RETURN			;EOF
		HRRZ	T3,IOMODE		;[201] FETCH I/O MODE
		CAIN	T3,MODEBCDIC		;IF EBCDIC
		SKIPL	FILFLG(F)		;AND VARIABLE
		JRST	$1			;NO
		AOS	FILPTR(F)		;BYPASS FILE DESCRIPTOR WORD
		MOVNI	T3,4
		ADDM	T3,FILCNT(F)
		JRST	$1]
	MOVEM	T1,FILBLK(F)		;STORE BLOCKING FACTOR BACK
  >
	SKIPE	T1,FILCNT(F)		;NUMBER WORDS REMAINING IN CURRENT BUFFER
	JRST	$2			;STILL SOME
	JSP	T4,GETBUF		;BUFFER EXHAUSTED, ADVANCE TO NEXT
	  RETURN			;GIVE ERROR RETURN
  $2%
  CASE MODE OF (GETSXR,GETASR,GETEBR,GETBNR)
	HRRZ	T3,IOMODE		;[201] FETCH I/O MODE INDEX
	JRST	@[EXP GETSXR,GETASR,GETEBR,GETBNR]-1(T3)
  ESAC;
END;
SUBTTL	GETREC -- GETSXR - Get SIXBIT Record

;STILL IN IFE FTCOBOL
  IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(JSP	P4,GETSXR)
	HRRZ	T3,FILPTR(F)		;ADDRESS OF NEXT RECORD
	HRRZ	T2,(T3)			;CHECK SIXBIT COUNT WORD
	MOVX	T1,FI.MTA		;IS THIS A MAGTAPE?
	TDNE	T1,FILFLG(F)		;IF SO, L.H. MIGHT HAVE JUNK
	HRRZS	0(T3)			; SO CLEAR IT OUT
	AOS	FILPTR(F)		;ACCOUNT FOR WORD READ
	SOS	T1,FILCNT(F)		; ..
	JUMPE	T2,GETREC		;SIMPLY IGNORE NULL RECORDS
	MOVEM	T2,RC.CNT(R)		;COPY BYTE COUNT
	CAMGE	T2,MINKEY		;IS IT BIG ENOUGH?
	PUSHJ	P,ERRKNR		;NO
	ADD	R,XTRWRD		;LEAVE SPACE FOR EXTRACTED KEYS
	ADDI	T2,5+6			;ACOUNT FOR REMAINDER AND BYTE COUNT WORD
	IDIVI	T2,6
	CAMLE	T2,RECSIZ		;LEGITIMTE COUNT ?
	PUSHJ	P,GETTRC		;NO, TRUNCATE RECORD
	SUBI	T2,1			;BUT WE HAVE ALREADY MOVED THE BYTE COUNT
  IF RECORD IS CONTAINED IN CURRENT I/O BUFFER
	CAIGE	T1,(T2)			;IS RECORD CONTAINED IN CURRENT BUFFER ?
	JRST	$T			;NO, RECORD SPANS BUFFERS
  THEN
	HRL	T3,FILPTR(F)		;YES, SET ORIGIN ADDRESS OF RECORD
	HRRI	T3,RC.KEY(R)		;SET DESTINATION ADDRESS
	ADDI	R,(T2)			;PTR TO LAST WORD IN RECORD DESTINATION
	BLT	T3,0(R)			;TRANSFER RECORD
	SUBI	T1,(T2)
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	JRST	$F

  ELSE COPY PIECEMEAL
	MOVEI	P1,(T2)			;SIZE OF RECORD (WORDS)
  WHILE MORE WORDS STILL WORDS TO READ DO
	BEGIN
		SKIPE	T1,FILCNT(F)		;NUMBER OF WORDS LEFT IN CURRENT BUFFER
		JRST	$1			;STILL SOME
		JSP	T4,GETBUF		;CURRENT BUFFER EXHAUSTED, ADVANCE TO NEXT
		  JRST	E$$RIE			;WARN USER
	  $1%	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
		CAILE	T2,(T1)			;CONTAINED WITHIN CURRENT BUFFER ?
		MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
		HRL	T3,FILPTR(F)		;PTR TO ORIGIN OF RECORD RESIDUE
		HRRI	T3,RC.KEY(R)		;PTR TO DESTINATION OF RECORD FRAGMENT
		ADDI	R,(T2)			;PTR TO END OF RECORD FRAGMENT
		BLT	T3,0(R)			;TRANSFER RECORD FRAGMENT
		SUBI	T1,(T2)
		MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
		ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
		SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
		JUMPN	P1,$B			;FINISHED ?
		END;
  FI;
	MOVE	R,RSAV			;RESTORE R
	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	AOJA	P4,@EXTRCT		;EXTRACT KEYS AND GIVE OK RETURN
END;
BEGIN
  PROCEDURE	(PUSHJ	P,GETTRC)		;TRUNCATE RECORD ON INPUT
	SUB	T2,RECSIZ		;REMOVE WHATS OK
	MOVEM	T2,RECSAV		;SAVE DIFFERENCE
	MOVEM	P4,P4SAV		;FINAL RETURN
	MOVEI	P4,GOTTRC		;RETURN HERE
	MOVE	T2,RECORD		;GET MAX. RECORD COUNT
	MOVEM	T2,@RSAV		;STORE IT IN RECORD
	MOVE	T2,RECSIZ		;JUST COPY THIS MUCH
	RETURN
END;

BEGIN
  PROCEDURE	(JSP	P4,GOTTRC)	;HERE WHEN FIRST PART OF RECORD COPIED
				;HERE TO DELETE REST

	  JRST	E$$RIE			;TRAP NON-SKIP RETURN
	AOS	P4,P4SAV		;RESTORE SKIP RETURN
	MOVE	T2,RECSAV		;HOW MUCH MORE TO DELETE
  $1%	CAMLE	T2,FILCNT(F)		;ALL IN THIS BUFFER?
	MOVE	T2,FILCNT(F)		;NO, USE IT ALL
	ADDM	T2,FILPTR(F)		;ADVANCE BYTE PTR
	MOVN	T2,T2
	ADDM	T2,RECSAV		;COUNT IT DOWN
	ADDB	T2,FILCNT(F)		;SAME FOR BYTE COUNT
	JUMPG	T2,$2			;BUFFER EMPTY?
	JSP	T4,GETBUF		;YES, GET NEXT
	  JRST	$3			;[105] AT E-O-F
  $2%	SKIPE	T2,RECSAV		;MORE TO DO?
	JRST	$1			;YES
  $3%	PUSHJ	P,ERRRTI		;[105] WARN USER
	RETURN
END;

>;END IFE FTFORTRAN
SUBTTL	GETREC -- GETASR - Get ASCII Record

;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,GETASR)		;HERE TO GET NEXT ASCII RECORD
  IF FIRST RECORD
	SKIPE	SEQNO			;[110] FIRST TIME ITS ZERO
	JRST	$F			;[110] ITS NOT
  THEN CHECK FOR SEQUENCE NUMBER
	MOVE	T1,@FILPTR(F)		;[110] GET FIRST WORD
	TRNE	T1,1			;[110] SEQUENCE NUMBER PRESENT?
	AOSA	T1,SEQNO		;[110] YES
	SOSA	SEQNO			;[110] NO
	MOVEM	T1,ALIGN		;[110] FORCE WORD ALIGNMENT
  FI;
	MOVE	T2,FILPTR(F)		;GET COPY OF BYTE PTR
	ILDB	T1,T2			;READ FIRST BYTE (WE KNOW ITS IN MEMORY)
  IF LINE STARTS WITH NULLS OR LINE TERMINATORS
	CAIG	T1,.CHCRT		;CHECK FOR NUL LINE
	CAIGE	T1,.CHLFD		;I.E. LF, FF, VT OR CR ONLY
	JUMPN	T1,$F			;NO, A REAL LINE IF NOT NULL
  THEN EAT IT UP
	BEGIN
		TLNN	T2,760000		;AT NEW WORD
		ADD	T2,[430000,,1]		;YES
		MOVEM	T2,FILPTR(F)		;STORE BACK
		SOSLE	FILCNT(F)		;COUNT DOWN
		JRST	GETASR			;AND TRY AGAIN
		JSP	T4,GETBUF		;RAN OUT, RELOAD NEW BUFFER
		  JRST	0(P4)			;OK, END OF FILE
		JRST	GETASR
	END;
  FI;

  IF FIRST CHAR IS ^Z FROM A TTY
	CAIE	T1,.CHCNZ		;TEST FOR ^Z
	JRST	$F			;NOT
	MOVE	T2,FILXBK(F)		;[215] GET DEVCHR BITS
  IFE FTOPS20,<				;ON TOPS10,
	MOVE	T2,X.DVCH(T2)		;[215]   ..
	TXZ	T2,DVCHMD		;[215] CLEAR I/O MODE BITS
	CAXE	T2,DVCHNL		;[215] NOT TTY: IF NUL:
	TXNN	T2,DV.TTY		;[215] NOW CHECK FOR TTY:
	JRST	$F			;[215] NOT--CONTINUE
  >;END IFE FTOPS20
  IFN FTOPS20,<				;ON TOPS20,
	LDB	T2,[POINT 9,X.DVCH(T2),17]	;GET DEVICE TYPE
	CAXE	T2,.DVTTY		;TTY?
	JRST	$F			;NO, CONTINUE
  >;END IFN FTOPS20
  THEN RETURN EOF
	JRST	[MOVE	EF,PHYEOF		;SET EOF RETURN
		JRST	0(P4)]			;AND RETURN
  FI;

	MOVE	T1,RECORD		;[147] GET RECORD SIZE IN BYTES
	MOVEM	T1,RC.CNT(R)		;[147] STORE BYTE COUNT
	ADD	R,XTRWRD		;[147] LEAVE SPACE FOR EXTRACTED KEYS
	SKIPGE	FILFLG(F)		;HOPE ITS NOT VARIABLE?
	JRST	GETAVR			;TOO BAD
	SKIPL	FILPTR(F)		;SEE IF ON A WORD BOUNDARY
	JRST	GETASN			;ITS NOT
	IDIVI	T1,5
	PUSH	P,T2			;SAVE REMAINDER
	MOVE	T2,T1
	IMULI	T2,5			;INTERGRAL NO. OF BYTES
	CAMLE	T2,FILCNT(F)		;ALL IN THIS BUFFER?
	JRST	GETAML			;NO
	HRLZ	T3,FILPTR(F)		;GET BYTE PTR
	HRRI	T3,RC.KEY(R)		;DESTINATION
	ADDI	R,0(T1)			;END OF BLT
	SKIPE	T1			;DON'T DO BLT IF NO FULL WORDS
	BLT	T3,(R)			;MOVE ALL BUT LAST PARTIAL WORD
	ADDM	T1,FILPTR(F)		;ADJUST BYTE PTR
	MOVN	T2,RECORD		;NO. OF BYTES USED
	ADDM	T2,FILCNT(F)		;ACCOUNT FOR THEM
;	PJRST	GETALW			;NEXT PAGE
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE (JSP	P4,GETALW)	;GET ASCII LAST WORD OF RECORD
	SKIPG	FILCNT(F)		;WILL LAST WORD FIT?
	JRST	[JSP	T4,GETBUF		;GET NEW BUFFER
		  JRST	E$$RIE			;WARN USER
		MOVN	T2,(P)			;REMAINDER
		ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
		JRST	.+1]
  $2%	POP	P,T2			;GET REMAINDER BACK
	JUMPE	T2,GETCRL		;ALL DONE
	MOVE	T1,@FILPTR(F)		;GET FULL WORD
	AND	T1,ASCMSK(T2)		;ONLY WHAT WE REALLY NEED
	MOVEM	T1,RC.KEY(R)		;STORE IT
  IFE FTKL10,<
	IBP	FILPTR(F)		;ADJUST BYTE PTR
	SOJG	T2,.-1
  >
  IFN FTKL10,<
	ADJBP	T2,FILPTR(F)
	MOVEM	T2,FILPTR(F)
  >
;	PJRST	GETCRL			;BELOW
END;


BEGIN
  PROCEDURE (JSP	P4,GETCRL)	;GET A CRLF
	PUSHJ	P,RDASBT		;READ AN ASCII BYTE (CR)
GETLF:	PUSHJ	P,RDASBT		; ... (LF)
	MOVE	T1,FILPTR(F)
	TLNE	T1,760000		;IS IT ON WORD BOUNDARY?
	JRST	$3			;NO, EXTRACT KEYS AND RETURN
	ADD	T1,[430000,,1]		;YES,
	MOVEM	T1,FILPTR(F)		;ADVANCE TO NEXT WORD
  $3%	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	MOVE	R,RSAV			;RESTORE R
	MOVE	T1,(R)			;GET CHAR COUNT
	CAMGE	T1,MINKEY		;IS IT BIG ENOUGH?
	PUSHJ	P,ERRKNR		;NO
	AOJA	P4,@EXTRCT		;EXTRACT KEYS AND GIVE OK RETURN
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(PUSHJ	P,RDASBT)	;READ ASCII BYTE FROM INPUT BUFFER

  IF BUFFER IS EMPTY
	SOSL	FILCNT(F)		;ANYTHING IN BUFFER?
	JRST	$F			;YES, STILL NOT EMPTY
  THEN GET NEXT
	JSP	T4,GETBUF		;BUFFER EMPTY GET NEXT
	  JRST	E$$RIE			;WARN USER
	SOS	FILCNT(F)		;COUNT DOWN BYTE WE WILL PICKUP
  FI;
	ILDB	T1,FILPTR(F)		;GET BYTE
	JUMPE	T1,RDASBT		;IGNORE NULLS
	CAIG	T1,.CHCRT
	CAIGE	T1,.CHLFD
	FASTSKIP
	RETURN
	SKIPGE	FILFLG(F)		;FIXED OR VARIABLE?
	JRST	E$$JAL			;VARIABLE
E$$ARL:	$ERROR	(?,ARL,<ASCII record length incorrect>)
E$$JAL:	$ERROR	(?,JAL,<Junk in ASCII line>)
END;

ASCMSK:	BYTE	(7)
	BYTE	(7)	177
	BYTE	(7)	177,177
	BYTE	(7)	177,177,177
	BYTE	(7)	177,177,177,177
	BYTE	(7)	177,177,177,177,177
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,GETAML)	;HERE WHEN RECORD CROSSES BLOCK BOUNDARY

	MOVEI	P1,(T1)			;SIZE OF RECORD (WORDS)
$1%	SKIPE	T1,FILCNT(F)		;NUMBER OF WORDS LEFT IN CURRENT BUFFER
	JRST	$2			;STILL SOME
	JSP	T4,GETBUF		;EMPTY, GET NEXT
	  JRST	E$$RIE			;WARN USER
$2%	IDIVI	T1,5			;WORDS IN CURRENT BUFFER
	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
	CAILE	T2,(T1)			;CONTAINED WITHIN CURRENT BUFFER
	MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
	HRL	T3,FILPTR(F)		;PTR TO ORIGIN OF RECORD RESIDUE
	HRRI	T3,RC.KEY(R)		;PTR TO DESTINATION OF RECORD FRAGMENT
	ADDI	R,0(T2)			;PTR TO END OF RECORD FRAGMENT -1
	BLT	T3,1(R)			;TRANSFER RECORD FRAGMENT
	MOVNI	T1,5			;5 BYTES PER WORD
	IMUL	T1,T2			;- NO. OF WORDS
	ADDM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$1			;FINISHED ?
	MOVN	T2,(P)			;REMAINDER BYTES
	ADDM	T2,FILCNT(F)		;ACCOUNT FOR THEM
	PJRST	GETALW			;GET LAST WORD, SEE IF IN BUFFER
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,GETASN)	;HERE FOR ASCII RECORD NOT ON A WORD BOUNDARY
  IFE FTKL10,<
	LDB	T1,[POINT 6,FILPTR(F),5]	;GET BYTE POSITION
	MOVNS	P1,T1			;-NO. OF BITS LEFT
	ADDI	P1,^D36			;LSHC COUNTER TO RIGHT JUSTIFY 5 BYTES
	IDIVI	T1,7			;CONVERT TO BYTES
	ADDM	T1,FILCNT(F)		;ACCOUNT FOR THEM
	ADD	T1,RECORD		;NO. OF BYTES TO FOLLOW
	IDIVI	T1,5			;NO. OF WORDS
	PUSH	P,T2			;SAVE REMAINDER
	MOVN	T1,T1			;-NO. OF FULL WORDS TO COPY
	HRL	R,T1			;AOBJN PTR
	MOVN	T3,P1			;NO. OF BITS TO SHIFT LEFT
	ADDI	T3,^D35			;LSHC COUNTER FOR REMAINDER
	AOS	T2,FILPTR(F)		;ADVANCE BYTE PTR
	HRLI	T2,(POINT 7,)		; TO BEFORE FIRST BYTE
	MOVEM	T2,FILPTR(F)		; SO BOTH ILDB AND MOVE @ WORK
	MOVE	T1,-1(T2)		;GET FIRST WORD
	LSH	T1,-1			;RIGHT JUSTIFY
  IF THERE ARE FULL WORDS TO MOVE
	JUMPGE	R,$F			;NO
  THEN LOOP FOR REMAINING FULL WORDS
	BEGIN
		SKIPG	FILCNT(F)		;ROOM IN THIS BUFFER?
		JRST	[PUSH	P,T1			;SAVE PARTIAL
			PUSH	P,T3			;LSHC -COUNT
			JSP	T4,GETBUF		;GET NEW BUFFER
			  JRST	E$$RIE			;WARN USER
			POP	P,T3
			POP	P,T1
			JRST	$1]
	  $1%	MOVE	T2,@FILPTR(F)		;GET IT
		LSHC	T1,(P1)			;35 BITS IN T1
		LSH	T1,1			;LEFT JUSTIFY
		MOVEM	T1,RC.KEY(R)		;STORE
		LSHC	T1,(T3)			;MOVE REMAINDER INTO T1
		MOVNI	T2,5
		ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
		AOS	FILPTR(F)		;AND BYTE PTR
		AOBJN	R,$B			;LOOP FOR ALL FULL WORDS
	END;
  FI;

;NOW FOR LAST WORD
	SKIPLE	FILCNT(F)		;IS BUFFER EMPTY?
	JRST	$3			;NO
	PUSH	P,T1			;SAVE PARTIAL WORD
	JSP	T4,GETBUF		;YES, FILL IT
	  JRST	E$$RIE			;WARN USER
	POP	P,T1			;RESTORE PARTIAL WORD
  $3%	POP	P,T3			;GET REMAINDER
	JUMPE	T3,$4			;NONE
	SKIPA	T2,@FILPTR(F)		;GET IT
  $4%	TDZA	T2,T2			;NO REMAINDER
	AND	T2,ASCMSK(T3)		;ONLY WHAT WE NEED
	LSHC	T1,(P1)			;FORM 35 BITS
	LSH	T1,1
	MOVEM	T1,RC.KEY(R)		;STORE FIRST WORD
	SKIPE	T2			;ONLY ONE WORD
	MOVEM	T2,RC.KEY+1(R)		;STORE SECOND WORD
	JUMPE	T3,$5			;NO REMAINDER
	MOVN	T3,T3
	ADDM	T3,FILCNT(F)		;ADJUST BYTE COUNT
	IBP	FILPTR(F)
	AOJL	T3,.-1			;AND BYTE PTR
  $5%
  >;END OF IFE FTKL10
  IFN FTKL10,<
	MOVE	T0,RECORD		;NO. OF BYTES TO COPY
	MOVEI	T4,7			;BYTE SIZE
	PUSHJ	P,GETEX			;GET RECORD WITH COMMON BIS CODE
  >;END IFN FTKL10
	PJRST	GETCRL			;ALL DONE
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,GETAVR)		;GET VARIABLE LENGTH ASCII RECORD
	HRLZI	T1,1(R)			;FORM  BLT PTR
	HRRI	T1,2(R)			; TO CLEAR ALL OF BUFFER
	SETZM	1(R)			;WE MUST DO THIS AT LEAST ONCE
					; TO CLEAR BIT 35 IN EACH WORD
	MOVE	T2,REKSIZ		;[147] BYTE COUNT WORD + KEYS + WORDS IN USER'S RECORD
	SUB	T2,XTRWRD		;[147] GET JUST COUNT WORD AND REC LEN
	CAIG	T2,2			;CHECK FOR SPECIAL CASE OF 1 DATA WORD
	JRST	$1			;IF SO BYPASS BLT
	ADDI	T2,(R)			;END OF BLT
	BLT	T1,-1(T2)		;CLEAR IT ALL
  $1%
  IFE FTKL10,<
	HRLI	R,(POINT 7,,35)		;DEPOSIT BYTE PTR
	MOVE	P1,RECORD		;NO. OF CHARACTERS MAX. TO STORE
	SKIPG	SEQNO			;[110] CHECK FOR SEQUENCE NO.
	JRST	$3			;NOT
	MOVE	T1,@FILPTR(F)		;GET FULL WORD
	MOVEM	T1,RC.KEY(R)		;STORE IT WITH BIT 35 ON
	AOS	FILPTR(F)		;BYPASS SEQ NO.
	MOVNI	T1,5			;NO. OF BYTES
	ADDM	T1,FILCNT(F)		;WE'VE USED UP
	SUBI	P1,5			;ACCOUNT FOR SEQ NO.
	AOJA	R,$3			;GET NEXT REAL BYTE

  $2%	JSP	T4,GETBUF		;GET NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
  $3%	SOSGE	FILCNT(F)		;BUFFER EMPTY?
	JRST	$2			;YES
	ILDB	T1,FILPTR(F)		;GET NEXT BYTE
	JUMPE	T1,$3			;IGNORE NULLS
	CAIG	T1,.CHCRT		;SEE IF ONE OF
	CAIGE	T1,.CHLFD		;LF, VT, FF, CR
	JRST	[IDPB	T1,R			;NO
		SOJG	P1,$3			;GET NEXT
		TLZN	R,(POINT 7,0,35)	;MAKE NULL BYTE PTR 
		PUSHJ	P,ERRRTI		;WARN USER FIRST TIME
		JRST	$3]			;LOOP UNTIL END OF LINE
	SKIPGE	P1			;ONLY COUNT CHAR WE REALLY STORED
	SETZ	P1,
	SUB	P1,RECORD		;- NO. OF CHAR. STORED
	MOVMM	P1,@RSAV		;[147] STORE AS + BYTE COUNT
	PJRST	GETLF			;READ THE LF
  >;END OF IFE FTKL10
  IFN FTKL10,<
	MOVE	T3,RECORD		;MAX. NO. OF BYTES TO COPY
	MOVE	T0,FILCNT(F)		;NO. WE ACTUALLY HAVE IN BUFFER
	CAMGE	T0,T3			;ENUF IN BUFFER?
	MOVE	T3,T0			;NO, USE WHAT WE HAVE
	MOVEM	T3,@RSAV		;[147] WILL TRY TO STORE THIS MANY
	MOVEI	T4,(R)			;DESTINATION ADDRESS
	HRLI	T4,(POINT 7,,35)	;DESTINATION BYTE PTR
	SKIPG	SEQNO			;[110] CHECK FOR SEQUENCE NO.
	JRST	$7			;[110] NO
	MOVE	T2,@FILPTR(F)		;GET FIRST WORD
	MOVEM	T2,RC.KEY(T4)		;STORE SEQ. NO.
	MOVNI	T2,5
	ADDM	T2,FILCNT(F)		;COUNT DOWN
	AOS	FILPTR(F)		;INCREMENT SOURCE
	SUBI	T0,5
	SUBI	T3,5			;FIVE LESS BYTES TO COPY
	ADDI	T4,1			;INCREMENT DESTINATION
  $7%	SETZ	T2,			;JUST INCASE
  $2%	MOVE	T1,FILPTR(F)		;SOURCE BYTE PTR
	TXO	T0,S.FLAG		;SET SIGNIFICANCE FLAG
  $3%	EXTEND	T0,[MOVST AVRTBL
		EXP	0]		;COPY AND ZERO FILL
	  JRST	$4			;EITHER COUNT RAN OUT OR CRLF SEEN
	PUSH	P,T2			;NO, SAVE WORK ACS
	PUSH	P,T4			;  ..
	JSP	T4,GETBUF		;GET NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
	POP	P,T4			;RESTORE WORK ACS
	POP	P,T2			;  ..
	MOVE	T0,FILCNT(F)		;GET COUNT POSSIBLE
	MOVE	T1,FILPTR(F)		;[127] RELOAD BYTE POINTER
	TXNN	T4,77B11		;WERE WE JUST THROWING CHAR AWAY?
	JRST	$6			;YES, KEEP DOING IT
	MOVE	T3,RECORD		;MAX. WE NEED
	SUB	T3,@RSAV		;[147] - WHAT WE ALREADY HAVE
	JUMPE	T3,$5			;ALL IS DONE REALLY
	CAMGE	T0,T3			;CHECK AGAIN FOR FIT
	MOVE	T3,T0			;JUST USE WHAT WE HAVE
	ADDM	T3,@RSAV		;[147] WHAT WE EXPECT TO COPY
	JRST	$2			;COPY REST

  $4%	TXZ	T0,S.FLAG!M.FLAG
	TXZN	T0,N.FLAG		;SEEN ABORT BIT?
	JRST	$5			;NO
	MOVEM	T1,FILPTR(F)		;RESTORE BYTE PTR
	MOVEM	T0,FILCNT(F)		;WE DIDN'T USE THEM ALL
	MOVN	T3,T3
	ADDM	T3,@RSAV		;[147] UPDATE COUNT PROPERLY
	PJRST	GETLF			;ALL DONE, READ LF NOW

  $5%	JUMPE	T0,[HALT .]		;BUFFER RAN OUT
	AOS	@RSAV			;[147] FEATURE OF MICRO CODE
	TXZE	T4,77B11		;CLEAR BYTE POINTER
	PUSHJ	P,ERRRTI		;REPORT RECORD TRUNCATION
	AOJA	T3,$3			;READ UNTIL CR-LF SEEN

  $6%	MOVEI	T3,1			;INCASE IT WENT TO ZERO
	JRST	$3

AVRTBL:	ZZ==0
	REPEAT 12/2,<ZZ,,ZZ+1
		ZZ==ZZ+2>
	E.SBIT!E.ABRT,,E.SBIT!E.ABRT	;LF,,VT
	E.SBIT!E.ABRT,,E.SBIT!E.ABRT	;FF,,CR
		ZZ=ZZ+4
	REPEAT <177-15>/2,<ZZ,,ZZ+1
		ZZ==ZZ+2>
  >;END IFN FTKL10

END;
SUBTTL	GETREC -- GETEBR - Get EBCDIC Record

;STILL IN IFE FTCOBOL
IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(JSP	P4,GETEBR)		;HERE TO GET NEXT EBCDIC RECORD
;FIRST SEE IF REST OF BUFFER IS NULL
	BEGIN
		DMOVE	T2,FILPTR(F)		;GET COPY OF BYTE PTR AND COUNT
	  $1%	ILDB	T1,T2			;READ FIRST BYTE (WE KNOW ITS IN MEMORY)
		JUMPN	T1,$E			;A NON-NULL FOUND
		SOJG	T3,$1			;TRY AGAIN
		JSP	T4,GETBUF		;TRY FOR NEXT BLOCK
		  JRST	(P4)			;HOPE WE GOT HERE
		JRST	GETEBR			;NO TRY AGAIN
	END;

	MOVE	T2,RECORD		;[150] GET BYTE COUNT
	MOVEM	T2,RC.CNT(R)		;[150] STORE BYTE COUNT
	ADD	R,XTRWRD		;[150] LEAVE SPACE FOR EXTRACTED KEYS
	SKIPGE	FILFLG(F)		;IS IT VARIABLE?
	JRST	GETEVR			;YES
	MOVE	T1,FILFLG(F)
	TXNE	T1,FI.IND		;INDUSTRY COMPATIBLE MODE?
	JRST	GETICR			;YES
	SKIPL	FILPTR(F)		;SEE IF ON A WORD BOUNDARY
	JRST	GETEBN			;ITS NOT
	MOVE	T1,RECORD		;SEE HOW MANY ACTUAL CHARS
	IDIVI	T1,4
	PUSH	P,T2			;SAVE REMAINDER
	MOVE	T2,T1
	LSH	T2,2			;INTERGRAL NO. OF BYTES
	CAMLE	T2,FILCNT(F)		;ALL IN THIS BUFFER?
	JRST	GETEML			;NO
	HRLZ	T3,FILPTR(F)		;GET BYTE PTR
	HRRI	T3,RC.KEY(R)		;DESTINATION
	ADDI	R,0(T1)			;END OF BLT
	SKIPE	T1			;DON'T DO BLT IF NO FULL WORDS
	BLT	T3,(R)			;MOVE ALL BUT LAST PARTIAL WORD
	ADDM	T1,FILPTR(F)		;ADJUST BYTE PTR
	MOVN	T2,RECORD		;NO. OF BYTES USED
	ADDM	T2,FILCNT(F)		;ACCOUNT FOR THEM
;	PJRST	GETELW			;NEXT PAGE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE (JSP	P4,GETELW)	;GET EBCDIC LAST WORD
	SKIPG	FILCNT(F)		;WILL LAST WORD FIT?
	SKIPN	0(P)			;OR NO LAST WORD?
	JRST	$2			;OK
	JSP	T4,GETBUF		;GET NEW BUFFER
	  JRST	E$$RIE			;WARN USER
	MOVN	T2,(P)			;REMAINDER
	ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
  $2%	POP	P,T2			;GET REMAINDER BACK
	JUMPE	T2,GETEBZ		;ALL DONE
	MOVE	T1,@FILPTR(F)		;GET FULL WORD
	AND	T1,EBCMSK(T2)		;ONLY WHAT WE REALLY NEED
	MOVEM	T1,RC.KEY(R)		;STORE IT
    IFE FTKL10,<
	IBP	FILPTR(F)		;ADJUST BYTE PTR
	SOJG	T2,.-1
    >
    IFN FTKL10,<
	ADJBP	T2,FILPTR(F)
	MOVEM	T2,FILPTR(F)
    >
;	PJRST	GETEBZ			;BELOW
END;


BEGIN
  PROCEDURE (JSP	P4,GETEBZ)
	MOVE	T2,FILPTR(F)
	TLNE	T2,700000		;IS IT ON WORD BOUNDARY?
	JRST	$3			;NO, EXTRACT KEYS AND RETURN
	TLO	T2,440000		;YES, REFORM BYTE PTR
	ADDI	T2,1			;INCREMENT IT TO NEXT WORD
	MOVEM	T2,FILPTR(F)		;ADVANCE TO NEXT WORD
  $3%	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	MOVE	R,RSAV			;RESTORE R
	AOJA	P4,@EXTRCT		;EXTRACT KEYS AND GIVE OK RETURN
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,RDEBBT)	;READ EBCDIC BYTE FROM INPUT BUFFER
  IF BUFFER IS EMPTY
	SOSL	FILCNT(F)		;ANYTHING IN BUFFER?
	JRST	$F			;YES, STILL NOT EMPTY
  THEN GET NEXT
	JSP	T4,GETBUF		;BUFFER EMPTY GET NEXT
	  JRST	[POP	P,(P)			;POP RETURN OFF STACK
		MOVE	EF,LOGEOF		;RAN OUT OF RECORDS
		JRST	0(P4)]			;GIVE ERROR RETURN
	SOS	FILCNT(F)		;COUNT DOWN BYTE WE WILL PICKUP
  FI;
	ILDB	T1,FILPTR(F)		;GET BYTE
	RETURN
END;

EBCMSK:	BYTE	(9)
	BYTE	(9)	377
	BYTE	(9)	377,377
	BYTE	(9)	377,377,377
	BYTE	(9)	377,377,377,377
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,GETEML)	;HERE WHEN RECORD CROSSES BLOCK BOUNDARY

	MOVEI	P1,(T1)			;SIZE OF RECORD (WORDS)
$1%	SKIPE	T1,FILCNT(F)		;NUMBER OF WORDS LEFT IN CURRENT BUFFER
	JRST	$2			;STILL SOME
	JSP	T4,GETBUF		;EMPTY, GET NEXT
	  JRST	E$$RIE			;WARN USER
$2%	IDIVI	T1,4			;WORDS IN CURRENT BUFFER
	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
	CAILE	T2,(T1)			;CONTAINED WITHIN CURRENT BUFFER
	MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
	HRL	T3,FILPTR(F)		;PTR TO ORIGIN OF RECORD RESIDUE
	HRRI	T3,RC.KEY(R)		;PTR TO DESTINATION OF RECORD FRAGMENT
	ADDI	R,0(T2)			;PTR TO END OF RECORD FRAGMENT -1
	BLT	T3,0(R)			;[304] TRANSFER RECORD FRAGMENT
	MOVNI	T1,4			;4 BYTES PER WORD
	IMUL	T1,T2			;- NO. OF WORDS
	ADDM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$1			;FINISHED ?
	MOVN	T2,(P)			;REMAINDER BYTES
	ADDM	T2,FILCNT(F)		;ACCOUNT FOR THEM
	PJRST	GETELW			;GET LAST WORD, SEE IF IN BUFFER
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,GETEBN)	;HERE FOR EBCDIC RECORD NOT ON A WORD BOUNDARY
    IFE FTKL10,<
	LDB	T1,[POINT 6,FILPTR(F),5]	;GET BYTE POSITION
	MOVNS	P1,T1			;-NO. OF BITS LEFT
	ADDI	P1,^D36			;LSHC COUNTER TO RIGHT JUSTIFY 5 BYTES
	IDIVI	T1,9			;CONVERT TO BYTES
	ADDM	T1,FILCNT(F)		;ACCOUNT FOR THEM
	ADD	T1,RECORD		;NO. OF BYTES TO FOLLOW
	IDIVI	T1,4			;NO. OF WORDS
	PUSH	P,T2			;SAVE REMAINDER
	MOVN	T1,T1			;-NO. OF FULL WORDS TO COPY
	HRL	R,T1			;AOBJN PTR
	MOVN	T3,P1			;NO. OF BITS TO SHIFT LEFT
	ADDI	T3,^D36			;LSHC COUNTER FOR REMAINDER
	AOS	T2,FILPTR(F)		;ADVANCE BYTE PTR
	HRLI	T2,(POINT 9,)		; TO BEFORE FIRST BYTE
	MOVEM	T2,FILPTR(F)		; SO BOTH ILDB AND MOVE @ WORK
	MOVE	T1,-1(T2)		;GET FIRST WORD
  IF THERE ARE FULL WORDS TO MOVE
	JUMPGE	R,$F			;NO
  THEN LOOP FOR REMAINING FULL WORDS
	BEGIN
		SKIPG	FILCNT(F)		;ROOM IN THIS BUFFER?
		JRST	[PUSH	P,T1			;SAVE PARTIAL
			PUSH	P,T3			;LSHC -COUNT
			JSP	T4,GETBUF		;GET NEW BUFFER
			  JRST	E$$RIE			;WARN USER
			POP	P,T3
			POP	P,T1
			JRST	$1]
	  $1%	MOVE	T2,@FILPTR(F)		;GET IT
		LSHC	T1,(P1)			;36 BITS IN T1
		MOVEM	T1,RC.KEY(R)		;STORE
		LSHC	T1,(T3)			;MOVE REMAINDER INTO T1
		MOVNI	T2,4
		ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
		AOS	FILPTR(F)		;AND BYTE PTR
		AOBJN	R,$B			;LOOP FOR ALL FULL WORDS
	END;
  FI;

;NOW FOR LAST WORD IF IT EXISTS
	SKIPG	FILCNT(F)		;[122] IS BUFFER EMPTY?
	SKIPN	0(P)			;[122] YES, AND DO WE NEED ANY MORE?
	JRST	$3			;NO
	PUSH	P,T1			;SAVE PARTIAL WORD
	JSP	T4,GETBUF		;YES, FILL IT
	  JRST	E$$RIE			;WARN USER
	POP	P,T1			;RESTORE PARTIAL WORD
$3%	POP	P,T3			;GET REMAINDER
	SKIPE	T2,T3			;NO REMAINDER, GET 0
	SKIPA	T2,@FILPTR(F)		;GET IT
	AND	T2,ASCMSK(T3)		;ONLY WHAT WE NEED
	LSHC	T1,(P1)			;FORM 36 BITS
	MOVEM	T1,RC.KEY(R)		;STORE FIRST WORD
	SKIPE	T2			;ONLY ONE WORD
	MOVEM	T2,RC.KEY+1(R)		;STORE SECOND WORD
	JUMPE	T3,$5			;NO REMAINDER
	MOVN	T3,T3
	ADDM	T3,FILCNT(F)		;ADJUST BYTE COUNT
	IBP	FILPTR(F)
	AOJL	T3,.-1			;AND BYTE PTR
  $5%
    >;END OF IFE FTKL10
    IFN FTKL10,<
	MOVE	T0,RECORD		;NO. OF BYTES TO COPY
	MOVEI	T4,^D9			;BYTE SIZE
	PUSHJ	P,GETEX			;GET RECORD WITH COMMON BIS CODE
    >;END IFN FTKL10
	JRST	GETEBZ			;ALL DONE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,GETEVR)		;GET VARIABLE LENGTH EBCDIC RECORD
	PUSHJ	P,RDEBBT		;READ A BYTE
	LSH	T1,8
	MOVE	P1,T1			;STORE HIGH ORDER BYTE
	PUSHJ	P,RDEBBT
	ADDI	P1,(T1)			;ADD LOW ORDER BYTE
	PUSHJ	P,RDEBBT		;BYPASS JUNK
	JUMPN	T1,E$$SRS		;CHECK FOR IBM SPANNED RECORDS
	PUSHJ	P,RDEBBT		;...
	SUBI	P1,4			;ACCOUNT FOR 4 BYTE HEADER
	CAMGE	P1,MINKEY		;IS IT BIG ENOUGH?
	PUSHJ	P,ERRKNR		;NO
  IF RECORD IS TOO BIG
	CAML	P1,RECORD
	JRST	$T
  THEN	STORE ONLY MAX SIZE
	PUSHJ	P,ERRRTI		;TELL USER
	SUB	P1,RECORD		;GET DIFF
	PUSH	P,P1			;STORE IT
	MOVE	P1,RECORD		;MAX SIZE
	JRST	$F
  ELSE USE IT
	PUSH	P,[0]			;NO EXCESS
  FI;
	MOVEM	P1,@RSAV		;[150] STORE BYTE COUNT
    IFE FTKL10,<
	HRLI	R,(POINT 9,,35)		;DEPOSIT BYTE PTR & BYPASS BYTE COUNT
	JRST	$2			;FIRST TIME

  $1%	JSP	T4,GETBUF		;GET NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
  $2%	SOSGE	FILCNT(F)		;BUFFER EMPTY?
	JRST	$1			;YES
	ILDB	T1,FILPTR(F)		;GET NEXT BYTE
	IDPB	T1,R			;STORE
	SOJG	P1,$2			;GET NEXT
	POP	P,P1			;GET POSSIBLE EXCESS
	JUMPE	P1,$3			;OK
	TLZE	R,(POINT 9,0,35)	;MAKE NULL BYTE PTR 
	PUSHJ	P,ERRRTI		;WARN USER FIRST TIME
	PUSH	P,[0]			;TERMINATE CORRECTLY THIS TIME
	JRST	$2			;LOOP UNTIL END OF RECORD

  $3%	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	MOVE	R,RSAV
	AOJA	P4,@EXTRCT
    >;END OF IFE FTKL10
    IFN FTKL10,<
	MOVEI	T0,(P1)			;NO. OF BYTES TO COPY
	MOVEI	T4,^D9			;BYTE SIZE
	PUSHJ	P,GETEX			;GET RECORD WITH COMMON BIS CODE
  $2%	POP	P,T1			;GET EXCESS
	JUMPE	T1,GETEBZ		;ALL DONE
	MOVN	T2,T1
	ADDB	T2,FILCNT(F)		;ADJUST BYTE COUNT
	JUMPGE	T2,$3			;OK
	PUSH	P,T2
	JSP	T4,GETBUF		;READ NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
	JRST	$2			;TRY AGAIN

  $3%	ADJBP	T1,FILCNT(F)		;ADJUST BYTE PTR
	MOVEM	T1,FILPTR(F)
	PJRST	GETEBZ
    >;END IFN FTKL10
END;

E$$SRS:	$ERROR	(?,SRS,<Spanned records not supported.>)
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,GETICR)		;GET INDUSTRY COMPATIBLE FIXED LENGTH EBCDIC RECORD
    IFE FTKL10,<
	MOVE	P1,RECORD		;SIZE
	MOVEM	P1,@RSAV		;[150] STORE BYTE COUNT
	HRLI	R,(POINT 9,,35)		;DEPOSIT BYTE PTR & BYPASS BYTE COUNT
	JRST	$2			;FIRST TIME

  $1%	JSP	T4,GETBUF		;GET NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
  $2%	SOSGE	FILCNT(F)		;BUFFER EMPTY?
	JRST	$1			;YES
	ILDB	T1,FILPTR(F)		;GET NEXT BYTE
	IDPB	T1,R			;STORE
	SOJG	P1,$2			;GET NEXT
	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	MOVE	R,RSAV
	AOJA	P4,@EXTRCT
    >;END OF IFE FTKL10
    IFN FTKL10,<
	MOVE	T0,RECORD		;NO. OF BYTES TO COPY
	MOVEI	T4,^D9			;BYTE SIZE
	PUSHJ	P,GETEX			;GET RECORD WITH COMMON BIS CODE
	JRST	GETEBZ			;ALL DONE
    >;END IFN FTKL10
END;

  >;END IFE FTFORTRAN
SUBTTL	GETREC -- GETBNR - Get Binary Record

;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,GETBNR)
	MOVE	T2,RECSIZ		;GET RECORD SIZE
	MOVEM	T2,RC.CNT(R)		;STORE WORD COUNT
	ADD	R,XTRWRD		;BYPASS EXTRACTED KEYS
	HRRZ	T3,FILPTR(F)		;ADDRESS OF RECORD
	MOVE	T4,MODE
	TXNE	T4,RM.FOR		;FORTRAN BINARY?
	PJRST	GETFBR			;YES
  IF	RECORD IS CONTAINED IN CURRENT I/O BUFFER
	CAIGE	T1,(T2)			;IS RECORD CONTAINED IN CURRENT BUFFER ?
	JRST	$T			;NO, RECORD SPANS BUFFERS
  THEN
	HRL	T3,FILPTR(F)		;YES, SET ORIGIN ADDRESS OF RECORD
	HRRI	T3,RC.KEY(R)		;SET DESTINATION ADDRESS
	ADDI	R,(T2)			;PTR TO LAST WORD IN RECORD DESTINATION
	BLT	T3,0(R)			;TRANSFER RECORD
	SUBI	T1,(T2)
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	JRST	$F
  ELSE	COPY PIECEMEAL
	MOVEI	P1,(T2)			;SIZE OF RECORD (WORDS)
  $2%	SKIPE	T1,FILCNT(F)		;NUMBER OF WORDS LEFT IN CURRENT BUFFER
	JRST	$3			;STILL SOME
	JSP	T4,GETBUF		;CURRENT BUFFER EXHAUSTED, ADVANCE TO NEXT
	  JRST	[MOVE	R,RSAV			;RESTORE R
		RETURN]				;GIVE EOF RETURN
  $3%	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
	CAILE	T2,(T1)			;CONTAINED WITHIN CURRENT BUFFER ?
	MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
	HRL	T3,FILPTR(F)		;PTR TO ORIGIN OF RECORD RESIDUE
	HRRI	T3,RC.KEY(R)		;PTR TO DESTINATION OF RECORD FRAGMENT
	ADDI	R,(T2)			;PTR TO END OF RECORD FRAGMENT
	BLT	T3,0(R)			;TRANSFER RECORD FRAGMENT
	SUBI	T1,(T2)
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$2			;FINISHED ?
  FI;
	MOVE	R,RSAV			;RESTORE R
	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	AOJA	P4,@EXTRCT		;EXTRACT KEYS AND GIVE OK RETURN
END;
;GET NEXT FORTRAN BINARY RECORD

;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,GETFBR)
	MOVE	P1,@FILPTR(F)		;GET START LSCW
	AOS	FILPTR(F)
	SOS	T1,FILCNT(F)		;ACCOUNT FOR IT
	MOVE	P2,RECSIZ		;GET MAX RECORD SIZE
	HLRZ	T2,P1			;GET LSCW
	CAIE	T2,S.LSCW		;IS IT WHAT WE EXPECT
	JRST	E$$FCI			;ERROR
	MOVEI	P1,-1(P1)		;NO. OF DATA WORDS TO FOLLOW
  IF RECORD IS CONTAINED IN CURRENT I/O BUFFER
  $1%	CAIGE	T1,(P1)
	JRST	$T			;NO
  THEN COPY ALL EXCEPT LSCW AT EITHER END
	HRL	T3,FILPTR(F)		;ORIGIN OF DATA
	HRRI	T3,RC.KEY(R)		;DESTINATION
	CAIG	P1,(P2)			;TOO BIG?
	SKIPA	T2,P1			;NO, USE ALL
	MOVE	T2,P2			;YES, JUST USE MAX.
	JUMPLE	P2,$6			;DON'T COPY TOO MUCH
	ADDI	R,(T2)			;NO. TO COPY
	BLT	T3,0(R)			;COPY THEM
	SUBI	P2,(T2)			;COUNT DOWN
  $6%	MOVNI	T1,(P1)			;MINUS THOSE WE HAVE READ
	ADDM	T1,FILCNT(F)
	ADDM	P1,FILPTR(F)		;ADVANCE READ POINTER
	JRST	$F			;READ LSCW
  ELSE COPY PIECEMEAL
  $2%	SKIPE	T1,FILCNT(F)		;NUMBER OF WORDS LEFT IN CURRENT BUFFER
	JRST	$3			;STILL SOME
	JSP	T4,GETBUF		;CURRENT BUFFER EXHAUSTED, ADVANCE TO NEXT
	  JRST	E$$RIE			;WARN USER
	HLRZ	T2,@FILPTR(F)		;GET LSCW
  $3%	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
	CAILE	T2,(T1)			;CONTAINED WITHIN CURRENT BUFFER ?
	MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
	MOVEI	T1,(T2)			;[203] REMEMBER HOW MUCH TOWARD LSCW WE'RE READING
	CAILE	T2,(P2)			;[203] ENOUGH ROOM TO HOLD IT?
	MOVEI	T2,(P2)			;[203] NO--COPY ONLY WHAT'LL FIT
	JUMPLE	T2,$7			;[203]   WHICH MAY BE NOTHING
	HRL	T3,FILPTR(F)		;PTR TO ORIGIN OF RECORD RESIDUE
	HRRI	T3,RC.KEY(R)		;PTR TO DESTINATION OF RECORD FRAGMENT
	ADDI	R,(T2)			;PTR TO END OF RECORD FRAGMENT
	BLT	T3,0(R)			;TRANSFER RECORD FRAGMENT
	SUBI	P2,(T2)			;[203] ACCOUNT FOR FILLING UP RECORD
  $7%	SUBI	P1,(T1)			;[203] UPDATE WORDS LEFT
	ADDM	T1,FILPTR(F)		;[203]   AND LEAVE IN T1
	EXCH	T1,FILCNT(F)		;[203]   ..
	SUBB	T1,FILCNT(F)		;[203]   ..
	JUMPN	P1,$2			;FINISHED ?
  FI;
	SKIPE	FILCNT(F)		;LSCW IN BUFFER?
	JRST	$4			;YES
	JSP	T4,GETBUF
	  JRST	E$$RIE			;WARN USER
  $4%	HLRZ	T2,@FILPTR(F)		;GET LSCW
	HRRZ	P1,@FILPTR(F)		;GET WORD COUNT
	AOS	FILPTR(F)
	SOS	T1,FILCNT(F)		;ACCOUNT FOR IT
	CAIN	T2,E.LSCW		;END?
	JRST	$5			;YES
	CAIN	T2,C.LSCW		;CONTINUE
	SOJA	P1,$1			;YES, GET NO. OF DATA WORDS
E$$FCI:	$ERROR	(?,FCW,<Fortran binary control word incorrect>)

  $5%	HRRZ	T1,R
	MOVE	R,RSAV
	SUBI	T1,(R)
	JUMPE	T1,GETREC		;[203] IGNORE 0-LENGTH RECORDS
	MOVEM	T1,RC.CNT(R)		;NO. OF DATA WORDS USED
	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	AOJA	P4,@EXTRCT
END;
;STILL IN IFE FTCOBOL
  IFN FTKL10,<
BEGIN
  PROCEDURE (PUSHJ P,GETEX)	;GET NEXT RECORD USING BIS

;CALL WITH:
;	T0/	NUMBER OF BYTES TO COPY
;	T4/	BYTE SIZE
;	F/	INDEX TO FILE TABLE (FOR BUFFER HEADER)
;	R/	INDEX TO WORD BEFORE DATA IN RECORD

	LSH	T4,^D24		;MOVE BYTE SIZE TO BYTE POINTER POS
	HRRI	T4,(R)		;FINISH POINTER WITH ADDR OF RECORD
	MOVE	T3,FILCNT(F)	;FILL UP ACS FOR EXTEND INSTRUCTION
  $1%	SETZ	T2,		;UNUSED AC IN BIS
	CAMGE	T0,T3		;DO ALL CHARS FIT?
	MOVE	T3,T0		;YES
	MOVN	T1,T0
	ADDM	T1,FILCNT(F)	;ACCOUNT FOR BYTES READ
	MOVE	T1,FILPTR(F)	;SOURCE BYTE POINTER
	EXTEND	T0,[MOVSLJ
		    EXP 0]	;COPY AND 0 FILL
	  JRST	$2
	MOVEM	T1,FILPTR(F)	;RESTORE BYTE POINTER
	RETURN			;ALL DONE

  $2%	MOVEM	T1,FILPTR(F)	;RESTORE BYTE POINTER
	PUSH	P,T0		;SAVE WORK ACS
	PUSH	P,T4		;  ..
	JSP	T4,GETBUF	;GET NEXT BUFFER
	  JRST	E$$RIE		;FAILED
	POP	P,T4		;RESTORE WORK ACS
	POP	P,T0		;  ..
	MOVE	T3,FILCNT(F)	;GET NEW SOURCE BYTE POINTER
	JRST	$1		;FINISH COPYING THE RECORD
  >;END IFN FTKL10

>;END IFE FTCOBOL
SUBTTL	GETREC -- GTTREC - Get Next Record From Temporary File

BEGIN
  PROCEDURE	(JSP	P4,GTTREC)

;GTTREC GETS THE NEXT RECORD FROM A TEMPORARY FILE. RECORDS IN TEMPORARY FILES
;CONTAIN A CHARACTER COUNT WORD, FOLLOWED BY ANY EXTRACTED KEYS, FOLLOWED BY THE
;ACTUAL USER RECORD. RUN MARKERS, WHICH *SEPARATE* RUNS IN A TEMPORARY FILE, ARE
;COUNT WORDS WITH NEGATIVE LEFT HALVES. IN THIS CASE, THE RIGHT HALF IS THE
;NUMBER OF THE FOLLOWING RUN RATHER THAN A COUNT WORD. ALSO, IF THE RECORD FITS
;IN THE BUFFER THEN THERE IS NO NEED TO MOVE IT, SINCE THE RECORD WILL BE OUTPUT
;BEFORE THE BUFFER IS EMPTY. ON ENTRY, IF (R) POINTS TO AN I/O BUFFER, RESTORE R
;FROM LSTREC. ON EXIT, IF BUFFER FULLY ENCLOSES THE RECORD AND ALL OF THE KEYS
;FIT IN THE RECORD (SO THAT WE DON'T HAVE TO PROVIDE ZERO PADDING), SET R TO
;POINT TO IT.
;
;CALL WITH:
;	F/	POINTER TO FCB
;	R/	POINTER TO RCB OR MIDDLE OF AN INPUT BUFFER
;	JSP	P4,GTTREC
;
;RETURNS:
;	MOVE	EF,PHYEOF
;	JRST	0(P4)		;END OF FILE
;OR
;	JRST	1(P4)		;NORMAL
;

  IF R POINTS TO AN I/O BUFFER
	CAMGE	R,RCBEND		;DOES R POINT TO AN I/O BUFFER?
	JRST	$F			;NO
  THEN RESET R WITH A VALID RCB 
	MOVE	R,@LSTREC		;GET NEXT NEXT RCB
	EXCH	R,LSTREC		;GET NEXT RCB
	HRRM	R,RN.REC(S)		;MAKE SURE PTR AGREES
  FI;
	SKIPE	T1,FILCNT(F)		;NUMBER WORDS REMAINING IN CURRENT BUFFER
	JRST	$1			;STILL SOME
	JSP	T4,GETBUF		;BUFFER EXHAUSTED, ADVANCE TO NEXT
	  JRST	0(P4)			;GIVE E-O-F RETURN
  $1%
	HRRZ	T3,FILPTR(F)		;ADDRESS OF NEXT RECORD
  IF WE HAVE A NORMAL WORD COUNT
	SKIPG	T2,(T3)			;CHECK BYTE OR WORD COUNT
	JRST	$T			;MIGHT BE LOGICAL END-OF-FILE
  THEN COPY RECORD
IFE FTCOBOL,<
	  IF RECORD IS VARIABLE
		SKIPG	P.VARF
		JRST	$T
	  THEN CALCULATE EXACT SIZE
>
			SUBI	T2,1			;[201] COUNT ALL BUT LAST DATA WORD
			IDIV	T2,IOBPW		;[201]   ..
			ADDI	T2,2			;[201] COUNT LAST AND COUNT WORDS
			ADD	T2,XTRWRD		;[201] COUNT EXTRACTED KEYS
IFE FTCOBOL,<
		  	CAMLE	T2,MAXKEY		;WILL ALL KEYS FIT?
			JRST	$F			;YES
			MOVEI	T1,1(R)
			HRLI	T1,0(R)			;BUILT BLT PTR
			MOVE	T3,MAXKEY
			ADDI	T3,(R)			;END OF KEYS
			SETZM	(R)			;ZERO FIRST WORD
			BLT	T1,(T3)			;ZERO THEM ALL
			SETZ	T1,			;FORCE COPY
			JRST	$F
	  ELSE
		MOVE	T2,REKSIZ		;FIXED RECORD SIZE NOW
	  FI;
>;END IFE FTCOBOL
	  IF RECORD WILL FIT IN CURRENT BUFFER
		CAIGE	T1,(T2)			;IS RECORD CONTAINED IN CURRENT BUFFER ?
		JRST	$T			;NO, RECORD SPANS BUFFERS
	  THEN
		EXCH	R,LSTREC		;YES, STORE THIS R IN LIST
		MOVEM	R,@LSTREC		;AND LINK IN
		HRRZ	R,FILPTR(F)		;FIRST DATA WORD
		HRRM	R,RN.REC(S)		;MAKE SURE PTR AGREES
		SUBI	T1,(T2)
		MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
		ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
		JRST	1(P4)			;RETURN WITH KEYS ALREADY EXTRACTED

	  ELSE COPY PIECEMEAL
		MOVEM	R,RSAV
		MOVEI	P1,(T2)			;SIZE OF RECORD (WORDS)
	  $3%	SKIPE	T1,FILCNT(F)		;NUMBER OF WORDS LEFT IN CURRENT BUFFER
		JRST	$6			;STILL SOME
		JSP	T4,GETBUF		;CURRENT BUFFER EXHAUSTED, ADVANCE TO NEXT
		  JRST	E$$RIE			;WARN USER
	  $6%	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
		CAILE	T2,(T1)			;CONTAINED WITHIN CURRENT BUFFER ?
		MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
		HRL	T3,FILPTR(F)		;PTR TO ORIGIN OF RECORD RESIDUE
		HRRI	T3,RC.CNT(R)		;PTR TO DESTINATION OF RECORD FRAGMENT
		ADDI	R,(T2)			;ADVANCE RECORD DEPOSIT POINTER
		BLT	T3,-1(R)		;TRANSFER RECORD FRAGMENT
		SUBI	T1,(T2)
		MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
		ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
		SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
		JUMPN	P1,$3			;FINISHED ?
		MOVE	R,RSAV
						;KEYS ALREADY EXTRACTED
		JRST	1(P4)
	  FI;

  ELSE CHECK FOR NEXT RUN MARKER OR EOF
	JUMPE	T2,$5			;NOT SURE IF 0, TRY NEXT BLOCK
	HRLM	T2,FILRUN(F)		;STORE GENERATION NO. FOR = TEST
	SOS	FILCNT(F)		;BYPASS MARKER
	AOS	FILPTR(F)
	MOVE	EF,LOGEOF		;LOAD EOF ROUTINE
	JRST	0(P4)			;GIVE ERROR RETURN

  $5%	SETZM	FILCNT(F)		;SET TO READ NEXT BLOCK, WILL GET E-O-F
	JRST	GTTREC			;OR RETURN WITH L-E-O-F MARKER
  FI;
END;
SUBTTL	PUTREC -- PUTREC - Put Next Record to Output File

IFE FTCOBOL,<
BEGIN
  PROCEDURE	(JSP	P4,PUTREC)	;OUTPUT NEXT RECORD
	MOVEM	R,RSAV
  IFE FTFORTRAN,<
  $1%	SKIPE	T1,FILBLK(F)		;BLOCKED FILE?
	AOBJP	T1,[MOVN T1,T1			;RESET BLOCKING FACTOR
		HRLZM	T1,FILBLK(F)		;IN FCB
		PUSHJ	P,CLRBUF		;CLEAR JUNK FROM BUFFER
		JSP	T4,PUTBUF		;GET NEW BUFFER
		MOVE	T2,FILFLG(F)		;[215] ARE WE AT EOT?
		TXNE	T2,FI.EOT		;[215]   ..
		PUSHJ	P,MSTEOT		;[215] YES--GO HANDLE LABELS
		HRRZ	T2,IOMODE		;[201] FETCH I/O MODE INDEX
		CAIN	T2,MODEBCDIC		;IF EBCDIC
		SKIPL	FILFLG(F)		;AND VARIABLE
		JRST	$1			;NO
		MOVE	T2,RECORD		;YES, GET RECORD SIZE
		HLRE	T1,FILBLK(F)		;GET BLOCKING FACTOR
		SETCM	T1,T1			;AS POSS NO.
		IMULI	T1,4(T2)		;NO. OF BYTES + 4 BYTE OVERHEAD
		ADDI	T1,4			;PLUS THIS WORD
		LSHC	T1,-8			;SHIFT OUT LOW ORDER BYTE
		LSH	T1,1			;THEY ARE 9 BIT BYTES
		LSHC	T1,8
		HRLZM	T1,@FILPTR(F)		;STORE COUNT
		AOS	FILPTR(F)
		MOVNI	T1,4
		ADDM	T1,FILCNT(F)
		JRST	$1]			;TRY AGAIN
	MOVEM	T1,FILBLK(F)		;STORE BLOCKING FACTOR BACK
  >
	SKIPN	T1,FILCNT(F)		;NUMBER WORDS REMAINING IN CURRENT BUFFER
	JSP	T4,PUTBUF		;BUFFER FILLED, WRITE IT
  IFE FTFORTRAN,<
	MOVE	T2,FILFLG(F)		;[215] CHECK IF EOT HAPPENED
	TXNE	T2,FI.EOT		;[215] YES--WE'D BETTER
	PUSHJ	P,MSTEOT		;[215]   WORRY ABOUT LABELS
  >
  CASE I/O MODE OF (EXP PUTSXR,PUTASR,PUTEBR,PUTBNR)
	HRRZ	T2,IOMODE		;[201] FETCH I/O MODE INDEX
	JRST	@[EXP PUTSXR,PUTASR,PUTEBR,PUTBNR]-1(T2)
  ESAC;
END;
SUBTTL	PUTREC -- PUTSXR - Put SIXBIT Record

;STILL IN IFE FTCOBOL
  IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(JSP	P4,PUTSXR)
	HRRZ	T2,RC.CNT(R)		;SIXBIT COUNT WORD
  IF THIS IS A MAGTAPE
	PUSHJ	P,ISITMT		;IS IT A MAGTAPE?
	  JRST	$F			;NO
  THEN WE MUST SET UP RECORD COUNT IN LEFT HALF OF COUNT WORD
	HRL	T2,FILSIZ(F)		;GET RECORD NUMBER
  FI;
	MOVEM	T2,@FILPTR(F)		;STORE IT
	HRRZ	T2,T2			;BYTE COUNT ONLY
	AOS	FILSIZ(F)		;INCREMENT SIZE OF FILE
	ADD	R,XTRWRD		;BYPASS EXTRACTED KEYS
	AOS	FILPTR(F)		;BYPASS BYTE COUNT
	SOS	T1,FILCNT(F)		;AND ACCOUNT FOR IT
	ADDI	T2,5			;ACOUNT FOR REMAINDER
	IDIVI	T2,6
  IF RECORD WILL FIT IN CURRENT BUFFER
	CAIGE	T1,(T2)			;WILL RECORD FIT IN CURRENT BUFFER ?
	JRST	$T			;NO, RECORD MUST SPAN BUFFERS
  THEN COPY IT
	HRLZI	T3,RC.KEY(R)		;YES, SET ORIGIN ADDRESS
	HRR	T3,FILPTR(F)		;SET DESTINATION ADDRESS
	HRRZ	T4,T3
	ADDI	T4,(T2)			;ADDRESS OF END OF RECORD DESTINATION
	BLT	T3,-1(T4)		;TRANSFER RECORD
	SUBI	T1,(T2)
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNTER
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	MOVE	R,RSAV
	RETURN	
  ELSE COPY IT PIECEMEAL
	MOVEI	P1,(T2)			;RECORD SIZE (WORDS)
  WHILE STILL SOME WORDS TO COPY DO
	BEGIN
		SKIPN	T1,FILCNT(F)		;NUMBER WORDS REMAINING IN CURRENT BUFFER
		JSP	T4,PUTBUF		;BUFFER FILLED, WRITE IT
		MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
		CAILE	T2,(T1)			;WILL RESIDUE FIT IN CURRENT BUFFER ?
		MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
		HRLZI	T3,RC.KEY(R)		;PTR TO ORIGIN OF RECORD FRAGMENT
		HRR	T3,FILPTR(F)		;PTR TO DESTINATION OF RECORD FRAGMENT
		HRRZ	T4,T3
		ADDI	T4,(T2)			;ADVANCE RECORD RETRIEVAL PTR
		BLT	T3,-1(T4)		;TRANSFER RECORD FRAGMENT
		SUBI	T1,(T2)
		MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNTER
		ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
		ADDI	R,(T2)			;ADVANCE RECORD RETRIEVAL PTR
		SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
		JUMPN	P1,$B			;NOT FINISHED 
	END;
	MOVE	R,RSAV
	RETURN	
  FI;
END;
  >;END IFE FTFORTRAN
SUBTTL	PUTREC -- PUTASR - Put ASCII Record

;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,PUTASR)	;HERE TO PUT NEXT ASCII RECORD INTO OUTPUT FILE

	AOS	FILSIZ(F)		;INCREMENT SIZE OF FILE
	ADD	R,XTRWRD		;BYPASS EXTRACTED KEYS
	SKIPGE	FILFLG(F)		;VARIABLE LENGTH OUTPUT?
	JRST	PUTAVR			;YES
	SKIPL	FILPTR(F)		;SEE IF ON A WORD BOUNDARY
	JRST	PUTASN			;NOT
	MOVE	T1,RECORD		;SEE HOW MANY ACTUAL CHARS
	IDIVI	T1,5
	PUSH	P,T2			;SAVE REMAINDER
	MOVE	T2,T1
	IMULI	T2,5			;INTERGRAL NO. OF BYTES
	CAMLE	T2,FILCNT(F)		;ALL IN THIS BUFFER?
	JRST	PUTAML			;NO
	HRRZ	T3,FILPTR(F)		;GET BYTE PTR
	HRLI	T3,RC.KEY(R)		;ORIGIN
	ADDI	R,(T1)			;ADVANCE READ PTR
	ADDB	T1,FILPTR(F)		;ADJUST BYTE PTR
	BLT	T3,-1(T1)		;MOVE ALL BUT LAST PARTIAL WORD
	MOVN	T2,T2			;NO. OF BYTES USED BY FULL WORDS
	ADDM	T2,FILCNT(F)		;ACCOUNT FOR THEM
;	PJRST	PUTALW			;NEXT PAGE
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE (JSP	P4,PUTALW)	;PUT ASCII LAST WORD
	SKIPG	FILCNT(F)		;WILL LAST WORD FIT?
	JSP	T4,PUTBUF		;NO, WRITE OUT BUFFER
	POP	P,T2			;GET REMAINDER BACK
	JUMPE	T2,PUTCRL		;END WITH CR-LF
	MOVE	T1,RC.KEY(R)		;GET LAST PARTIAL WORD
	AND	T1,ASCMSK(T2)		;ONLY WHAT WE REALLY NEED
	MOVEM	T1,@FILPTR(F)		;STORE FULL WORD
	MOVN	T1,T2			;-NO. OF BYTES LEFT
	ADDM	T1,FILCNT(F)		;SUBTRACT FROM TOTAL
  IFE FTKL10,<
	IBP	FILPTR(F)		;ADJUST BYTE PTR
	SOJG	T2,.-1
  >
  IFN FTKL10,<
	ADJBP	T2,FILPTR(F)
	MOVEM	T2,FILPTR(F)
  >
;	PJRST	PUTCRL			;BELOW
END;


BEGIN
  PROCEDURE (JSP	P4,PUTCRL)	;PUT A CRLF
	MOVE	R,RSAV			;RESTORE R
	MOVEI	T1,.CHCRT		;CR
	PUSHJ	P,WRASBT		;WRITE ASCII BYTE
	MOVEI	T1,.CHLFD		;LF
	PUSHJ	P,WRASBT
	MOVE	T1,FILPTR(F)		;NOW SEE IF ALREADY ON WORD BOUNDARY
	TLNE	T1,760000		;IF SO CHANGE BYTE PTR
	JRST	PUTALN			;NOT, SEE IF WE WANT TO WORD ALIGN
	ADD	T1,[430000,,1]		;YES, MAKE IT POINT TO WORD
	MOVEM	T1,FILPTR(F)
	RETURN
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(PUSHJ	P,WRASBT)	;WRITE ASCII BYTE TO OUTPUT FILE
  IF BUFFER IS ALREADY FULL
	SOSL	FILCNT(F)		;ENOUGH ROOM?
	JRST	$F
  THEN EMPTY IT
	PUSH	P,T1			;VE CURRENT BYTE
	JSP	T4,PUTBUF		;WRITE OUT BUFFER
	POP	P,T1			;RESTORE BYTE
	SOS	FILCNT(F)		;ACCOUNT FOR BYTE WE WILL NEXT STORE
  FI;
	IDPB	T1,FILPTR(F)		;YES, STORE BYTE
	RETURN
END;


BEGIN
  PROCEDURE	(JSP	P4,PUTALN)	;ALIGN ON WORD BOUNDARY IF REQUIRED
	SKIPG	ALIGN			;WANT TO WORD ALIGN ON OUTPUT?
	RETURN				;NO, DONE
	SETZ	T2,			;GET A NULL
$1%	SOS	FILCNT(F)		;DECREMENT BYTE COUNT
	IDPB	T2,T1			;STORE NULL
	TLNE	T1,760000		;GOT THERE YET?
	JRST	$1			;NO
	ADD	T1,[430000,,1]		;YES
	MOVEM	T1,FILPTR(F)		;CHANGE BYTE PTR
	RETURN
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,PUTAML)	;HERE WHEN RECORD CROSSES BLOCK BOUNDARY
	MOVEI	P1,(T1)			;SIZE OF RECORD (WORDS)
$1%	SKIPN	T1,FILCNT(F)		;NUMBER OF BYTES LEFT IN CURRENT BUFFER
	JSP	T4,PUTBUF		;FULL, DUMP IT
	IDIVI	T1,5			;WORDS IN CURRENT BUFFER
	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
	CAILE	T2,(T1)			;WILL RESIDUE FIT IN CURRENT BUFFER
	MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
	HRLZI	T3,RC.KEY(R)		;PTR TO ORIGIN  OF RECORD FRAGMENT
	HRR	T3,FILPTR(F)		;PTR TO DESTINATION OF RECORD RESIDUE
	ADDI	R,(T2)			;ADVANCE RECORD RETRIEVAL PTR
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	MOVE	T1,FILPTR(F)
	BLT	T3,-1(T1)		;TRANSFER RECORD FRAGMENT
	MOVNI	T1,5			;5 BYTES PER WORD
	IMULI	T1,(T2)			;- NO. OF WORDS
	ADDM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$1			;FINISHED ?
	PJRST	PUTALW			;HANDLE LAST PARTIAL WORD
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,PUTASN)	;HERE FOR ASCII RECORD NOT ON A WORD BOUNDARY
  IFE FTKL10,<
	LDB	P1,[POINT 6,FILPTR(F),5]	;GET BYTE POSITION
	SOS	T1,P1			;NO. OF BITS LEFT -1
	IDIVI	T1,7			;CONVERT TO BYTES
	MOVN	T1,T1			;-NO. THATS LEFT
	ADDI	T1,5			;+ NO. ALREADY USED
	ADDM	T1,FILCNT(F)		;ACCOUNT FOR THEM
	MOVE	T2,RECORD		;NO. OF BYTES TO FOLLOW
	IDIVI	T2,5			;NO. OF WORDS
	ADDI	T1,(T3)			;THOSE IN FRONT + THOSE BEHIND
	PUSH	P,T1			;SAVE REMAINDER
	PUSH	P,T3			;SAVE NO. OF BYTES IN (R)
	MOVN	T2,T2			;-NO. OF FULL WORDS TO COPY
	HRL	R,T2			;AOBJN PTR
	MOVN	T3,P1			;NO. OF BITS TO SHIFT LEFT
	ADDI	T3,^D35			;LSHC COUNTER FOR REMAINDER
	MOVSI	T2,(POINT 7,)		;RETARD BYTE POINTER TO BEFORE FIRST BYTE
	HLLM	T2,FILPTR(F)		; SO BOTH ILDB AND MOVE @ WORK
	MOVE	T1,@FILPTR(F)		;GET PARTIAL WORD
	MOVN	T2,P1			;NO. OF BYTES -1 IT IS LEFT SHIFTED
	LSH	T1,-1(T2)		;RIGHT JUSTIFY

;LOOP FOR REMAINING WORDS
  $1%	SKIPG	FILCNT(F)		;ROOM IN THIS BUFFER?
	JRST	[PUSH	P,T1			;SAVE PARTIAL
		PUSH	P,T3			;LSHC -COUNT
		JSP	T4,PUTBUF		;GET NEW BUFFER
		POP	P,T3
		POP	P,T1
		JRST	$5]
  $5%	MOVE	T2,RC.KEY(R)		;GET IT
	LSHC	T1,(P1)			;35 BITS IN T1
	LSH	T1,1			;LEFT JUSTIFY
	MOVEM	T1,@FILPTR(F)		;STORE
	LSHC	T1,(T3)			;MOVE REMAINDER INTO T1
	MOVNI	T2,5
	ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
	AOS	FILPTR(F)		;AND BYTE PTR
	AOBJN	R,$1			;LOOP FOR ALL FULL WORDS

;NOW FOR LAST WORD
	SKIPLE	FILCNT(F)		;BUFFER FULL?
	JRST	$6			;NO
	PUSH	P,T1			;SAVE PARTIAL WORD
	JSP	T4,PUTBUF		;YES, EMPTY IT
	POP	P,T1			;RESTORE PARTIAL WORD
  $6%	POP	P,T3			;GET REMAINDER
	JUMPE	T3,$2			;NONE
	SKIPA	T2,RC.KEY(R)		;GET IT
  $2%	TDZA	T2,T2			;NO REMAINDER
	AND	T2,ASCMSK(T3)		;ONLY WHAT WE NEED
	LSHC	T1,(P1)			;FORM 35 BITS
	LSH	T1,1
	MOVEM	T1,@FILPTR(F)		;STORE FIRST WORD
	POP	P,T3			;GET TOTAL REMAINDER
	CAIGE	T3,5			;ONLY ONE WORD?
	JRST	$3			;YES
	AOS	FILPTR(F)		;ADVANCE BYTE PTR
	MOVNI	T1,5			;COUNT DOWN NO. OF BYTES LEFT
	ADDB	T1,FILCNT(F)
	SUBI	T3,5			;...
	JUMPG	T1,$4			;ENOUGH ROOM IN THIS BUFFER
	PUSH	P,T2			;NO, SAVE REMAINDER
	PUSH	P,T3			;BYTE COUNT
	JSP	T4,PUTBUF		;GET NEW BUFFER
	POP	P,T3
	POP	P,T2
  $4%	MOVEM	T2,@FILPTR(F)		;STORE 2ND WORD
	JUMPE	T3,$7			;NO REMAINDER LEFT BY NOW?
  $3%	MOVN	T3,T3
	ADDM	T3,FILCNT(F)		;ADJUST BYTE COUNT
	IBP	FILPTR(F)
	AOJL	T3,.-1			;AND BYTE PTR
  $7%
  >;END OF IFE FTKL10
  IFN FTKL10,<
	MOVE	T0,RECORD		;NO. OF BYTES TO COPY
	MOVEI	T1,7			;BYTE SIZE
	PUSHJ	P,PUTEX			;PUT RECORD WITH COMMON BIS CODE
  >;END IFN FTKL10
	JRST	PUTCRL			;ALL DONE
END;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,PUTAVR)	;WRITE VARIABLE LENGTH ASCII RECORD
;TERMINATE WITH CR-LF
  IFE FTKL10,<
	HRLI	R,(POINT 7,,35)		;FORM BYTE PTR
	MOVE	P1,@RSAV		;[147] NO. OF CHARACTERS TO STORE
	SKIPG	SEQNO			;[110] SEQUENCE NO.?
	JRST	$1			;NO
	MOVE	T1,RC.KEY(R)		;GET FIRST WORD
	MOVEM	T1,@FILPTR(F)		;STORE SEQ NO.
	AOS	FILPTR(F)		;INCREMENT STORE PTR
	MOVNI	T1,5
	ADDM	T1,FILCNT(F)		;GET BYTE COUNT RIGHT
	SUBI	P1,5			;CORRECT THE NUMBER OF CHARACTERS TO STORE
	ADDI	R,1			;AND INPUT PTR
  $1%	ILDB	T1,R			;GET CHARACTER
  $2%	SOSGE	FILCNT(F)		;ANY ROOM IN BUFFER?
	JRST	[JSP	T4,PUTBUF		;NO, EMPTY IT
		LDB	T1,R			;GET BYTE AGAIN
		JRST	$2]			;TRY AGAIN
	IDPB	T1,FILPTR(F)		;STORE
	SOJG	P1,$1			;LOOP
  $3%
  >;END OF IFE FTKL10
  IFN FTKL10,<
	MOVE	T0,@RSAV		;NO. OF BYTES TO COPY
	SKIPG	SEQNO			;[110] SEQUENCE NO.?
	JRST	$3			;NO
	MOVE	T1,1(R)			;GET FIRST WORD
	MOVEM	T1,@FILPTR(F)		;YES, STORE IT
	AOS	FILPTR(F)		;ADVANCE
	ADDI	R,1			;[216] ADVANCE RECORD POINTER TOO
	MOVNI	T1,5
	ADDM	T1,FILCNT(F)		;ACCOUNT FOR BYTES
	SUBI	T0,5			;  ..
  $3%	MOVEI	T1,7			;BYTE SIZE
	PUSHJ	P,PUTEX			;PUT RECORD WITH COMMON BIS CODE
  >;END IFN FTKL10
	JRST	PUTCRL			;ALL DONE
END;
SUBTTL	PUTREC -- PUTEBR - Put EBCDIC Record

;STILL IN IFE FTCOBOL
  IFE FTFORTRAN,<
BEGIN
  PROCEDURE	(JSP	P4,PUTEBR)	;HERE TO PUT NEXT EBCDIC RECORD INTO OUTPUT FILE
	AOS	FILSIZ(F)		;INCREMENT SIZE OF FILE
	ADD	R,XTRWRD		;[150] BYPASS EXTRACTED KEYS
	SKIPGE	T1,FILFLG(F)		;VARIABLE LENGTH OUTPUT?
	JRST	PUTEVR			;YES
	TXNE	T1,FI.IND		;INDUSTRY COMPATIBLE MODE?
	JRST	PUTICR			;YES
	SKIPL	FILPTR(F)		;SEE IF ON A WORD BOUNDARY
	JRST	PUTEBN			;NOT
	MOVE	T1,RECORD		;SEE HOW MANY ACTUAL CHARS
	IDIVI	T1,4
	PUSH	P,T2			;SAVE REMAINDER
	MOVE	T2,T1
	LSH	T2,2			;INTERGRAL NO. OF BYTES
	CAMLE	T2,FILCNT(F)		;ALL IN THIS BUFFER?
	JRST	PUTEML			;NO
	HRRZ	T3,FILPTR(F)		;GET BYTE PTR
	HRLI	T3,RC.KEY(R)		;ORIGIN
	ADDI	R,(T1)			;ADVANCE READ PTR
	ADDB	T1,FILPTR(F)		;ADJUST BYTE PTR
	BLT	T3,-1(T1)		;MOVE ALL BUT LAST PARTIAL WORD
	MOVN	T2,T2			;NO. OF BYTES USED BY FULL WORDS
	ADDM	T2,FILCNT(F)		;ACCOUNT FOR THEM
;	PJRST	PUTELW			;NEXT PAGE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE (JSP	P4,PUTELW)	;PUT EBCDIC LAST WORD
	SKIPG	FILCNT(F)		;WILL LAST WORD FIT?
	JSP	T4,PUTBUF		;NO, WRITE OUT BUFFER
	POP	P,T2			;GET REMAINDER BACK
	JUMPE	T2,PUTEBZ		;END
	MOVE	T1,RC.KEY(R)		;GET LAST PARTIAL WORD
	AND	T1,EBCMSK(T2)		;ONLY WHAT WE REALLY NEED
	MOVEM	T1,@FILPTR(F)		;STORE FULL WORD
	MOVN	T1,T2			;-NO. OF BYTES LEFT
	ADDM	T1,FILCNT(F)		;SUBTRACT FROM TOTAL
    IFE FTKL10,<
	IBP	FILPTR(F)		;ADJUST BYTE PTR
	SOJG	T2,.-1
    >
    IFN FTKL10,<
	ADJBP	T2,FILPTR(F)
	MOVEM	T2,FILPTR(F)
    >
;	PJRST	PUTEBZ			;BELOW
END;


BEGIN
  PROCEDURE (JSP	P4,PUTEBZ)	;PUT EBCDIC, FIX UP BYTE-POINTER
	MOVE	R,RSAV			;RESTORE R
	MOVE	T1,FILPTR(F)		;NOW SEE IF ALREADY ON WORD BOUNDARY
	TLNE	T1,700000		;IF SO CHANGE BYTE PTR
	RETURN				;NOT
	TLO	T1,440000		;MAKE IT POINT TO START OF WORD
	ADDI	T1,1			;NEXT WORD
	MOVEM	T1,FILPTR(F)
	RETURN
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,PUTEML)	;HERE WHEN RECORD CROSSES BLOCK BOUNDARY
	MOVEI	P1,(T1)			;SIZE OF RECORD (WORDS)
  $1%	SKIPN	T1,FILCNT(F)		;NUMBER OF BYTES LEFT IN CURRENT BUFFER
	JSP	T4,PUTBUF		;FULL, DUMP IT
	IDIVI	T1,4			;WORDS IN CURRENT BUFFER
	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
	CAILE	T2,(T1)			;WILL RESIDUE FIT IN CURRENT BUFFER
	MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
	HRLZI	T3,RC.KEY(R)		;PTR TO ORIGIN  OF RECORD FRAGMENT
	HRR	T3,FILPTR(F)		;PTR TO DESTINATION OF RECORD RESIDUE
	ADDI	R,(T2)			;ADVANCE RECORD RETRIEVAL PTR
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	MOVE	T1,FILPTR(F)
	BLT	T3,-1(T1)		;TRANSFER RECORD FRAGMENT
	MOVNI	T1,4			;5 BYTES PER WORD
	IMULI	T1,(T2)			;- NO. OF WORDS
	ADDM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$1			;FINISHED ?
	PJRST	PUTELW			;HANDLE LAST PARTIAL WORD
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,PUTEBN)	;HERE FOR EBCDIC RECORD NOT ON A WORD BOUNDARY
    IFE FTKL10,<
	LDB	P1,[POINT 6,FILPTR(F),5]	;GET BYTE POSITION
	MOVE	T1,P1			;NO. OF BITS LEFT 
	IDIVI	T1,9			;CONVERT TO BYTES
	MOVN	T1,T1			;-NO. THATS LEFT
	ADDI	T1,4			;+ NO. ALREADY USED
	ADDM	T1,FILCNT(F)		;ACCOUNT FOR THEM
	MOVE	T2,RECORD		;NO. OF BYTES TO FOLLOW
	IDIVI	T2,4			;NO. OF WORDS
	ADDI	T1,(T3)			;THOSE IN FRONT + THOSE BEHIND
	PUSH	P,T1			;SAVE REMAINDER
	PUSH	P,T3			;SAVE NO. OF BYTES IN (R)
	MOVN	T2,T2			;-NO. OF FULL WORDS TO COPY
	HRL	R,T2			;AOBJN PTR
	MOVN	T3,P1			;NO. OF BITS TO SHIFT LEFT
	ADDI	T3,^D36			;LSHC COUNTER FOR REMAINDER
	MOVEI	T2,44			;RETARD BYTE POINTER TO BEFORE FIRST BYTE
	DPB	T2,[POINT 6,FILPTR(F),5]	; SO BOTH ILDB AND MOVE @ WORK
	MOVE	T1,@FILPTR(F)		;GET PARTIAL WORD
	MOVN	T2,P1			;NO. OF BYTES  IT IS LEFT SHIFTED
	LSH	T1,(T2)			;RIGHT JUSTIFY

;LOOP FOR REMAINING WORDS
  $1%	SKIPG	FILCNT(F)		;ROOM IN THIS BUFFER?
	JRST	[PUSH	P,T1			;SAVE PARTIAL
		PUSH	P,T3			;LSHC -COUNT
		JSP	T4,PUTBUF		;GET NEW BUFFER
		POP	P,T3
		POP	P,T1
		JRST	$5]
  $5%	MOVE	T2,RC.KEY(R)		;GET IT
	LSHC	T1,(P1)			;36 BITS IN T1
	MOVEM	T1,@FILPTR(F)		;STORE
	LSHC	T1,(T3)			;MOVE REMAINDER INTO T1
	MOVNI	T2,4
	ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
	AOS	FILPTR(F)		;AND BYTE PTR
	AOBJN	R,$1			;LOOP FOR ALL FULL WORDS

;NOW FOR LAST WORD
	SKIPLE	FILCNT(F)		;BUFFER FULL?
	JRST	$6			;NO
	PUSH	P,T1			;SAVE PARTIAL WORD
	JSP	T4,PUTBUF		;YES, EMPTY IT
	POP	P,T1			;RESTORE PARTIAL WORD
  $6%	POP	P,T3			;GET REMAINDER
	JUMPE	T3,$2			;NONE
	SKIPA	T2,RC.KEY(R)		;GET IT
  $2%	TDZA	T2,T2			;NO REMAINDER
	AND	T2,EBCMSK(T3)		;ONLY WHAT WE NEED
	LSHC	T1,(P1)			;FORM 36 BITS
	MOVEM	T1,@FILPTR(F)		;STORE FIRST WORD
	POP	P,T3			;GET TOTAL REMAINDER
	CAIGE	T3,4			;ONLY ONE WORD?
	JRST	$3			;YES
	AOS	FILPTR(F)		;ADVANCE BYTE PTR
	MOVNI	T1,4			;COUNT DOWN NO. OF BYTES LEFT
	ADDB	T1,FILCNT(F)
	SUBI	T3,4			;...
	JUMPG	T1,$4			;ENOUGH ROOM IN THIS BUFFER
	PUSH	P,T2			;NO, SAVE REMAINDER
	PUSH	P,T3			;BYTE COUNT
	JSP	T4,PUTBUF		;GET NEW BUFFER
	POP	P,T3
	POP	P,T2
  $4%	MOVEM	T2,@FILPTR(F)		;STORE 2ND WORD
	JUMPE	T3,$7			;NO REMAINDER LEFT BY NOW?
  $3%	MOVN	T3,T3
	ADDM	T3,FILCNT(F)		;ADJUST BYTE COUNT
	IBP	FILPTR(F)
	AOJL	T3,.-1			;AND BYTE PTR
  $7%
    >;END OF IFE FTKL10
    IFN FTKL10,<
	MOVE	T0,RECORD		;NO. OF BYTES TO COPY
	MOVEI	T1,^D9			;BYTE SIZE
	PUSHJ	P,PUTEX			;PUT RECORD WITH COMMON BIS CODE
    >;END IFN FTKL10
	JRST	PUTEBZ			;ALL DONE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,PUTEVR)	;WRITE VARIABLE LENGTH EBCDIC RECORD

	MOVE	P1,@RSAV		;[150] GET BYTE COUNT
	MOVEI	T1,4(P1)		;BYTE COUNT PLUS 4 BYTE OVERHEAD
	ROT	T1,-4			;RIGHT JUST HIGH ORDER BITS
	PUSHJ	P,WREBBT		;WRITE IT
	LSH	T1,-^D32		;RIGHT JUSTIFY LOW ORDER BIT
	PUSHJ	P,WREBBT		;WRITE IT
	SETZ	T1,
	PUSHJ	P,WREBBT		;WRITE JUNK
	PUSHJ	P,WREBBT		;...
    IFE FTKL10,<
	HRLI	R,(POINT 9,,35)		;FORM BYTE PTR
  $1%	ILDB	T1,R			;GET CHARACTER
  $2%	SOSGE	FILCNT(F)		;ANY ROOM IN BUFFER?
	JRST	[JSP	T4,PUTBUF		;NO, EMPTY IT
		LDB	T1,R			;GET BYTE AGAIN
		JRST	$2]			;TRY AGAIN
	IDPB	T1,FILPTR(F)		;STORE
	SOJG	P1,$1			;LOOP
    >;END OF IFE FTKL10
    IFN FTKL10,<
	MOVEI	T0,(P1)			;NO. OF BYTES TO COPY
	MOVEI	T1,^D9			;BYTE SIZE
	PUSHJ	P,PUTEX			;PUT RECORD WITH COMMON BIS CODE
    >;END IFN FTKL10
	JRST	PUTEBZ			;ALL DONE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(PUSHJ	P,WREBBT)	;WRITE EBCDIC BYTE TO OUTPUT FILE
  IF BUFFER IS ALREADY FULL
	SOSL	FILCNT(F)		;ENOUGH ROOM?
	JRST	$F
  THEN EMPTY IT
	PUSH	P,T1			;SAVE CURRENT BYTE
	JSP	T4,PUTBUF		;WRITE OUT BUFFER
	POP	P,T1			;RESTORE BYTE
	SOS	FILCNT(F)		;ACCOUNT FOR BYTE WE WILL NEXT STORE
  FI;
	IDPB	T1,FILPTR(F)		;YES, STORE BYTE
	RETURN
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,PUTICR)	;WRITE  INDUSTRY COMPATIBLE FIXED LENGTH EBCDIC RECORD
    IFE FTKL10,<
	MOVE	P1,RECORD		;GET BYTE COUNT
	HRLI	R,(POINT 9,,35)		;FORM BYTE PTR
  $1%	ILDB	T1,R			;GET CHARACTER
  $2%	SOSGE	FILCNT(F)		;ANY ROOM IN BUFFER?
	JRST	[JSP	T4,PUTBUF		;NO, EMPTY IT
		LDB	T1,R			;GET BYTE AGAIN
		JRST	$2]			;TRY AGAIN
	IDPB	T1,FILPTR(F)		;STORE
	SOJG	P1,$1			;LOOP
    >;END OF IFE FTKL10
    IFN FTKL10,<
	MOVE	T0,RECORD		;NO. OF BYTES TO COPY
	MOVEI	T1,^D9			;BYTE SIZE
	PUSHJ	P,PUTEX			;PUT RECORD WITH COMMON BIS CODE
    >;END IFN FTKL10
	JRST	PUTEBZ			;ALL DONE
END;

  >;END IFE FTFORTRAN
SUBTTL	PUTREC -- PUTBNR - Put Binary Record


;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,PUTBNR)
	AOS	FILSIZ(F)	;INCREMENT SIZE OF FILE
	MOVE	T2,RECSIZ	;RECORD SIZE
	ADD	R,XTRWRD	;BYPASS EXTRACTED KEYS
	MOVE	T3,MODE
	TXNE	T3,RM.FOR	;FORTRAN BINARY FILE
	PJRST	PUTFBR		;YES
  IF	RECORD WILL FIT IN CURRENT BUFFER
	CAIGE	T1,(T2)		;WILL RECORD FIT IN CURRENT BUFFER ?
	JRST	$T		;NO, RECORD MUST SPAN BUFFERS
  THEN	COPY IT
	HRLZI	T3,RC.KEY(R)	;YES, SET ORIGIN ADDRESS
	HRR	T3,FILPTR(F)	;SET DESTINATION ADDRESS
	HRRZ	T4,T3
	ADDI	T4,(T2)		;ADDRESS OF END OF RECORD DESTINATION
	BLT	T3,0(T4)	;TRANSFER RECORD
	SUBI	T1,(T2)
	MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
	ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
	MOVE	R,RSAV
	RETURN	

  ELSE	COPY IT PIECEMEAL
	MOVEI	P1,(T2)		;RECORD SIZE (WORDS)
	BEGIN
		SKIPN	T1,FILCNT(F)	;NUMBER WORDS REMAINING IN CURRENT BUFFER
		JSP	T4,PUTBUF	;BUFFER FILLED, WRITE IT
		MOVEI	T2,(P1)		;SIZE OF RECORD RESIDUE
		CAILE	T2,(T1)		;WILL RESIDUE FIT IN CURRENT BUFFER ?
		MOVEI	T2,(T1)		;NO, TRANSFER ONLY FILCNT WORDS
		HRLZI	T3,RC.KEY(R)	;PTR TO ORIGIN OF RECORD FRAGMENT
		HRR	T3,FILPTR(F)	;PTR TO DESTINATION OF RECORD FRAGMENT
		HRRZ	T4,T3
		ADDI	T4,(T2)		;ADVANCE RECORD RETRIEVAL PTR
		BLT	T3,0(T4)	;TRANSFER RECORD FRAGMENT
		SUBI	T1,(T2)
		MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
		ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
		ADDI	R,(T2)		;ADVANCE RECORD RETRIEVAL PTR
		SUBI	P1,(T2)		;DECREMENT LENGTH OF RECORD RESIDUE
		JUMPN	P1,$B		;NOT FINISHED 
	END;
	MOVE	R,RSAV
	RETURN	
  FI;
END;
;STILL IN IFE FTCOBOL

;FIRST DEFINE A MACRO TO COMPUTE THE CONTENTS OF AN AC MOD 129. THIS IS
;NECESSARY BECAUSE FORTRAN LSCW'S CARE ABOUT TOPS-10 DISK BLOCK BOUNDARIES,
;EVEN ON TOPS20.  THEREFORE WE MUST IMAGINE WHERE THE DISK BLOCK BOUNDARIES
;WOULD HAVE FALLEN BY ALWAYS LOOKING AT FILCNT MOD 129.

DEFINE MOD129(AC),<
	SUBI	AC,1
	ANDI	AC,177
	ADDI	AC,1
>

BEGIN
  PROCEDURE	(JSP	P4,PUTFBR)
	MOVE	T2,@RSAV	;[203] GET THIS RECORD'S LENGTH IN WORDS
	MOVE	P3,T1		;COPY FILCNT AND CONVERT IT
	MOD129	(P3)		;  TO FILCNT MOD 129
  IF RECORD WILL FIT IN CURRENT BUFFER
	CAIGE	P3,2(T2)	;WILL RECORD FIT IN CURRENT "BUFFER" ?
	JRST	$T		;NO, RECORD MUST SPAN BUFFERS
  THEN COPY IT
	MOVEI	T3,1(T2)	;WORDS TO LSCW
	HRLI	T3,S.LSCW
	MOVEM	T3,@FILPTR(F)	;STORE START LSCW
	AOS	T3,FILPTR(F)
	HRLI	T3,RC.KEY(R)	;FORM BLT PTR
	HRRZ	T4,T3
	ADDI	T4,(T2)		;ADDRESS OF END OF RECORD DESTINATION
	BLT	T3,0(T4)	;TRANSFER RECORD
	MOVEI	T3,2(T2)	;TOTAL WORDS
	HRLI	T3,E.LSCW
	MOVEM	T3,0(T4)	;STORE END CONTROL WORD
	SUBI	T1,2(T2)
	MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
	ADDI	T2,1
	ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
	MOVE	R,RSAV
	RETURN	

  ELSE COPY IT PIECEMEAL
	  IF MODE IS RANDOM
		SKIPGE	FILFLG(F)	;RANDOM IS FIXED SIZE
		JRST	$T		;MUST BE SEQUENTIAL
	  THEN
		MOVEI	P1,(T2)		;RECORD SIZE (WORDS)
		MOVEI	T3,1(T2)	;WORDS TO LSCW
		HRLI	T3,S.LSCW
		MOVEM	T3,@FILPTR(F)	;STORE START LSCW
		AOS	T3,FILPTR(F)
		SOS	FILCNT(F)
		BEGIN
			SKIPN	T1,FILCNT(F)	;NUMBER WORDS REMAINING IN CURRENT BUFFER
			JSP	T4,PUTBUF	;BUFFER FILLED, WRITE IT
			MOVEI	T2,(P1)		;SIZE OF RECORD RESIDUE
			CAILE	T2,(T1)		;WILL RESIDUE FIT IN CURRENT BUFFER ?
			MOVEI	T2,(T1)		;NO, TRANSFER ONLY FILCNT WORDS
			HRLZI	T3,RC.KEY(R)	;PTR TO ORIGIN OF RECORD FRAGMENT
			HRR	T3,FILPTR(F)	;PTR TO DESTINATION OF RECORD FRAGMENT
			HRRZ	T4,T3
			ADDI	T4,(T2)		;ADVANCE RECORD RETRIEVAL PTR
			BLT	T3,0(T4)	;TRANSFER RECORD FRAGMENT
			SUBI	T1,(T2)
			MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
			ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
			ADDI	R,(T2)		;ADVANCE RECORD RETRIEVAL PTR
			SUBI	P1,(T2)		;DECREMENT LENGTH OF RECORD RESIDUE
			JUMPN	P1,$B		;NOT FINISHED 
		END;
		SKIPN	FILCNT(F)	;ROOM FOR LSCW
		JSP	T4,PUTBUF	;NO
		MOVE	T3,RECSIZ	;NO. OF DATA WORDS
		ADD	T3,[E.LSCW,,2]
		MOVEM	T3,@FILPTR(F)
		AOS	FILPTR(F)
		SOS	FILCNT(F)
		JRST	$F

	  ELSE ITS SEQUENTIAL
		MOVEI	P1,(T2)		;RECORD SIZE (WORDS)
		MOVE	P2,P1		;USED TO COUNT EXTRA LSCWS
		MOVEI	T3,0(P3)	;WORDS TO LSCW
		HRLI	T3,S.LSCW
		MOVEM	T3,@FILPTR(F)	;STORE START LSCW
		AOS	T3,FILPTR(F)
		SOS	FILCNT(F)
		SUBI	P3,1		;DECREMENT "PSEUDO"-BUFFER COUNT
		BEGIN
			SKIPLE	FILCNT(F)	;NUMBER WORDS REMAINING IN CURRENT BUFFER
			JRST	$2		;STILL SOME
			JSP	T4,PUTBUF	;BUFFER FILLED, WRITE IT
			MOVE	P3,FILCNT(F)	;GET PSEUDO-BUFFER-COUNT
			MOD129	(P3)		;MAKE IT MOD 129
		  $2%	SKIPLE	T1,P3		;WORDS REMAINING IN "BUFFER"
			JRST	$1		;STILL SOME
			MOVEI	T1,200		;PRETEND NEW "BUFFER"
			ADDI	P2,1		;ONE MORE LSCW TO COUNT
			MOVEI	T2,1(P1)	;SIZE OF RECORD RESIDUE + LSCW
			CAILE	T2,(T1)		;WILL RESIDUE FIT IN CURRENT BUFFER ?
			MOVEI	T2,(T1)		;NO, TRANSFER ONLY FILCNT WORDS
			HRLI	T2,C.LSCW
			MOVEM	T2,@FILPTR(F)
			AOS	FILPTR(F)
			SOS	T1,FILCNT(F)
			MOD129	(T1)		;COMPUTE C(T1) MOD 129
		  $1%	MOVEI	T2,(P1)		;SIZE OF RECORD RESIDUE
			CAILE	T2,(T1)		;WILL RESIDUE FIT IN CURRENT BUFFER ?
			MOVEI	T2,(T1)		;NO, TRANSFER ONLY FILCNT WORDS
			HRLZI	T3,RC.KEY(R)	;PTR TO ORIGIN OF RECORD FRAGMENT
			HRR	T3,FILPTR(F)	;PTR TO DESTINATION OF RECORD FRAGMENT
			HRRZ	T4,T3
			ADDI	T4,(T2)		;ADVANCE RECORD RETRIEVAL PTR
			BLT	T3,-1(T4)	;TRANSFER RECORD FRAGMENT
			MOVE	T1,FILCNT(F)	;GET REAL BYTE COUNT
			SUBI	T1,(T2)		;SUBTRACT WHAT WE'VE WRITTEN SO FAR
			MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
			SUBI	P3,(T2)		;COUNT DOWN PSEUDO-BUFFER
			ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
			ADDI	R,(T2)		;ADVANCE RECORD RETRIEVAL PTR
			SUBI	P1,(T2)		;DECREMENT LENGTH OF RECORD RESIDUE
			JUMPN	P1,$B		;NOT FINISHED 
		END;
		MOVE	T1,FILCNT(F)	;GET FILCNT
		MOD129	(T1)		; MOD 129
		JUMPN	T1,$1		;PLENTY OF ROOM FOR LSCW
		SKIPE	FILCNT(F)	;ROOM FOR LSCW
		JRST	$2		;YES
		JSP	T4,PUTBUF	;NO
	  $2%	MOVE	T1,[C.LSCW,,1]
		MOVEM	T1,@FILPTR(F)	;STORE CONTINUE WORD
		AOS	FILPTR(F)
		SOS	FILCNT(F)
		ADDI	P2,1		;COUNT ONE MORE LSCW
	  $1%	MOVEI	T3,2(P2)	;NO. OF DATA WORDS + LSCWS
		HRLI	T3,E.LSCW
		MOVEM	T3,@FILPTR(F)
		AOS	FILPTR(F)
		SOS	FILCNT(F)
	  FI;
  FI;
	MOVE	R,RSAV
	RETURN	
END;
;STILL IN IFE FTCOBOL
  IFN FTKL10,<
BEGIN
  PROCEDURE (PUSHJ P,PUTEX)

;CALL WITH:
;	T0/	NUMBER OF BYTES TO COPY
;	T1/	BYTE SIZE
;	F/	INDEX TO FILE TABLE (FOR BUFFER HEADER)
;	R/	INDEX TO WORD BEFORE DATA IN RECORD

	LSH	T1,^D24		;MOVE SIZE TO BYTE POINTER POSITION
	HRRI	T1,(R)		;FINISH BY STUFFING IN ADDR
	MOVE	T3,FILCNT(F)	;FILL UP REST OF ACS FOR EXTEND
  $1%	SETZ	T2,		;UNUSED BIS AC
	CAMGE	T0,T3		;DO THEY ALL FIT?
	MOVE	T3,T0		;YES
	MOVN	T4,T0
	ADDM	T4,FILCNT(F)	;ACCOUNT FOR BYTES READ
	MOVE	T4,FILPTR(F)	;DESTINATION BYTE POINTER
	EXTEND	T0,[MOVSLJ
		    EXP 0]	;COPY AND 0 FILL
	  JRST	$2
	MOVEM	T4,FILPTR(F)	;RESTORE BYTE POINTER
	RETURN			;ALL DONE

  $2%	SETZM	FILCNT(F)	;DON'T UPSET PUTBUF
	MOVEM	T4,FILPTR(F)	;UPDATE BYTE POINTER
	PUSH	P,T0		;SAVE TEMPS OVER PUTBUF CALL
	PUSH	P,T1		;  ..
	JSP	T4,PUTBUF	;SEND THIS FULL BUFFER
	POP	P,T1		;RESTORE TEMPS
	POP	P,T0		;  ..
	MOVE	T3,FILCNT(F)	;SET UP NEW DESTINATION
	JRST	$1		;LOOP 'TIL RECORD IS SENT
END;
  >;END IFN FTKL10

>;END IFE FTCOBOL
SUBTTL	PUTREC -- PTTREC - Put Next Record to Temporary File

BEGIN
  PROCEDURE	(JSP	P4,PTTREC)
	AOS	FILSIZ(F)		;INCREMENT SIZE OF FILE
	SKIPN	T1,FILCNT(F)		;NUMBER WORDS REMAINING IN CURRENT BUFFER
	JSP	T4,PUTBUF		;BUFFER FILLED, WRITE IT
	MOVE	T2,REKSIZ		;FIXED RECORD SIZE NOW
IFE FTCOBOL,<
  IF RECORD IS VARIABLE SIZE
	SKIPG	P.VARF
	JRST	$F		;NO
  THEN ONLY SAVE AS MUCH AS WE NEED
>
	MOVE	T2,RC.CNT(R)	;GET NO. OF BYTES
	SUBI	T2,1			;[201] COUNT ALL BUT LAST DATA WORD
	IDIV	T2,IOBPW		;[201]   ..
	ADDI	T2,2			;[201] COUNT LAST AND COUNT WORD
	ADD	T2,XTRWRD		;[201] COUNT EXTRACTED KEYS
IFE FTCOBOL,<
  FI;
>;END IFE FTCOBOL
  IF RECORD WILL FIT IN CURRENT BUFFER
	CAIGE	T1,(T2)			;WILL RECORD FIT IN CURRENT BUFFER ?
	JRST	$1			;NO, RECORD MUST SPAN BUFFERS
  THEN	COPY IT
	HRLZI	T3,RC.CNT(R)		;YES, SET ORIGIN ADDRESS
	HRR	T3,FILPTR(F)		;SET DESTINATION ADDRESS
	HRRZ	T4,T3
	ADDI	T4,(T2)			;END OF BLT
	BLT	T3,-1(T4)		;TRANSFER RECORD
	SUBI	T1,(T2)
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNTER
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	RETURN
  ELSE
  $1%	MOVEM	R,RSAV
	MOVEI	P1,(T2)			;RECORD SIZE (WORDS)
  $2%	SKIPN	T1,FILCNT(F)		;NUMBER WORDS REMAINING IN CURRENT BUFFER
	JSP	T4,PUTBUF		;BUFFER FILLED, WRITE IT
	MOVEI	T2,(P1)			;SIZE OF RECORD RESIDUE
	CAILE	T2,(T1)			;WILL RESIDUE FIT IN CURRENT BUFFER ?
	MOVEI	T2,(T1)			;NO, TRANSFER ONLY FILCNT WORDS
	HRLZI	T3,RC.CNT(R)		;PTR TO ORIGIN OF RECORD FRAGMENT
	HRR	T3,FILPTR(F)		;PTR TO DESTINATION OF RECORD FRAGMENT
	HRRZ	T4,T3
	ADDI	T4,(T2)			;END OF BLT
	BLT	T3,-1(T4)		;TRANSFER RECORD FRAGMENT
	SUBI	T1,(T2)
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNTER
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	ADDI	R,(T2)			;ADVANCE RECORD RETRIEVAL PTR
	SUBI	P1,(T2)			;DECREMENT LENGTH OF RECORD RESIDUE
	  IF NOT FINISHED
	  THEN	COPY SOME MORE
		JUMPN	P1,$2		;NOT FINISHED 
	  ELSE	RETURN
		MOVE	R,RSAV
		RETURN
	  FI;
 FI;
END;
BEGIN
  PROCEDURE	(PUSHJ	P,GENNAM)

;GENNAM GENERATES A SIXBIT FILE NAME OF FORM ###Sxy, WHERE ### IS OUR OCTAL JOB
;NUMBER, x IS THE RUN NUMBER, y IS THE FILE NUMBER IN THE RUN. NOTE THAT SINCE
;WE ALLOW ONLY ONE LETTER FOR THE FILE NUMBER, THERE IS A LIMIT OF 26 TEMPORARY
;FILES PER MERGE PASS. TOPS-20 REACHES THIS LIMIT, WHILE TOPS-10 IS FURTHER
;LIMITED BY I/O CHANNELS.
;
;CALL WITH:
;	F/	POINTER TO FCB
;
;RETURN WITH:
;	T1/	NAME ON RETURN

	MOVE	T1,MRGNUM	;GET MERGE PASS NO.
	LSH	T1,6		;MAKE ROOM FOR FILE NUMBER
	ADD	T1,TCBIDX	;ADD FILE NAME INDEX
	ADDI	T1,'S0A'	;FORM ALPHABETIC
	HRRM	T1,FILNAM(F)	;STORE NUMERIC FILE NAME
	HLL	T1,JOBNUM	;PLACE OCTAL JOB NUMBER IN LEFT HALF
	RETURN
END;

SUBTTL	MEMORY MANAGEMENT

BEGIN
  PROCEDURE	(PUSHJ	P,GETSPC)

;GETSPC ALLOCATES C(T1) WORDS AND RETURNS THE ADDRESS OF THE BLOCK IN T1. SKIP
;RETURNS IF OK, ERROR RETURNS IF NO MORE MEMORY AVAILABLE.

	MOVEM	T1,SIZE		;SAVE REQUESTED SIZE
IFE FTCOBOL!FTFORTRAN,<
  IFN FTOPS20,<
	SKIPN	FORTPP		;CALLED BY FORTRAN?
  >
	JRST	GETSP1		;NO, STANDALONE
>
	MOVEI	L,1+[-5,,0	;LOAD UP ARG BLOCK FOR FUNCT. CALL
		     Z TP%INT,[F.GOT]
		     Z TP%LIT,[ASCIZ /SRT/]
		     Z TP%INT,STATUS
		     Z TP%INT,ADDR
		     Z TP%INT,SIZE]
	PUSHJ	P,FUNCT.	;ALLOCATE THE MEMORY
	SKIPE	STATUS		;NON-ZERO STATUS IS AN ERROR
	RETURN			;GIVE ERROR RETURN
	MOVE	T3,CORSTK	;GET PTR TO STACK OF ALLOCATION ENTRIES
	HRLZ	T1,SIZE		;CONSTRUCT XWD SIZE, ADDRESS
	HRR	T1,ADDR		; FOR ALLOCATION STACK
	PUSH	T3,T1		;PUSH THIS ENTRY ONTO STACK
	MOVEM	T3,CORSTK	;SAVE STACK POINTER
	HRRZ	T1,ADDR		;RETURN ADDRESS OF BLOCK TO CALLER
	PJRST	CPOPJ1		;GIVE SKIP RETURN

;HERE IF STANDALONE (NEITHER FORTRAN NOR COBOL)
IFE FTCOBOL!FTFORTRAN,<
GETSP1:	HRLZ	T3,T1		;BUILD ALLOCATION STACK ENTRY IN T3
	HRRZ	T2,.JBFF##	;GET ADDR OF FIRST FREE WORD
	HRR	T3,T2		;MAKE XWD LENGTH, ADDRESS OF BLOCK
	ADD	T1,T2		;COMPUTE NEW FREE POINTER
  IFN FTOPS20,<
	CAML	T1,MAXFRE	;RANGE CHECK
	RETURN			;OUT OF RANGE
  >
	HRRM	T1,.JBFF##	;UPDATE IT
  IFE FTOPS20,<
  IF THERE'S NOT ENOUGH MEMORY
	CAMG	T1,.JBREL##	;SEE IF WE HAVE ENOUGH
	JRST	$F		;YES--GO FINISH
  THEN GET SOME WITH CORE UUO
	CORE	T1,		;TRY TO ALLOCATE SOME MORE ROOM
	  JRST	E$$NEC		;CAN'T
  FI;
  >
	MOVE	T1,T3		;COPY ALLOCATION ENTRY TO T1
	MOVE	T3,CORSTK	;GET ALLOCATION STACK PTR
	PUSH	T3,T1		;PUSH ENTRY ONTO STACK
	MOVEM	T3,CORSTK	;SAVE STACK PTR
	MOVE	T1,T2		;RETURN ADDRESS OF BLOCK IN T1
	MOVEM	T1,ADDR		;  AND SAVE IT IN ADDR
	PJRST	CPOPJ1		;OK RETURN
>
END;
;FRESPC - FREE C(T1) WORDS

BEGIN
  PROCEDURE	(PUSHJ	P,FRESPC)
IFE FTCOBOL!FTFORTRAN,<
  IFN FTOPS20,<
	SKIPN	FORTPP		;CALLED BY FORTRAN?
  >
	JRST	FRESP1		;NO, DO STANDALONE THING
>
	MOVE	T4,CORSTK	;GET ALLOCATION STACK POINTER
	MOVE	T3,0(T4)	;GET SIZE AND ADDR OF LAST BLOCK ALLOCATED
	HLRZM	T3,SIZE		;SAVE FOR FUNCT. CALL
	HRRZM	T3,ADDR		;SAVE FOR FUNCT.
	MOVEI	L,1+[-5,,0	;LOAD UP FUNCT. ARG BLOCK
		     Z TP%INT,[F.ROT]
		     Z TP%LIT,[ASCIZ /SRT/]
		     Z TP%INT,STATUS
		     Z TP%INT,ADDR
		     Z TP%INT,SIZE]
	PUSHJ	P,FUNCT.	;RELEASE THE MEMORY
	SKIPE	STATUS		;OK?
	JRST	E$$FMR		;NO, COMPLAIN
	POP	T4,T1		;REMOVE ALLOCATION ENTRY FROM STACK
	MOVEM	T4,CORSTK	;SAVE STACK POINTER
	SUB	T1,T3		;SUBTRACT WHAT WE FREED FROM
				; WHAT CALLER WANTED FREED
	JUMPG	T1,FRESPC	;IF SOME STILL LEFT, FREE SOME MORE
	RETURN			;ALL DONE

IFE FTCOBOL!FTFORTRAN,<
FRESP1:	MOVE	T4,CORSTK	;GET ALLOCATION STACK PTR
FRESP2:	HLRZ	T3,0(T4)	;GET SIZE OF TOP BLOCK
	CAMGE	T1,T3		;FREEING LESS THAN TOP BLOCK'S SIZE
	JRST	E$$FMR		; IS AN ERROR
	HRRZ	T2,.JBFF##	;GET FREE POINTER
	SUB	T2,T3		;FREE UP TOP BLOCK
	HRRM	T2,.JBFF##	;REMEMBER NEW FREE POINTER
	SUB	T1,T3		;SUBTRACT WHAT WE'VE FREED
	POP	T4,T2		;THROW AWAY TOP STACK ENTRY
	MOVEM	T4,CORSTK	;MAINTAIN COPY OF MEMORY STACK PTR
	JUMPG	T1,FRESP2	;IF SOME LEFT TO DUMP, DO IT
	RETURN
>
END;
BEGIN
  PROCEDURE (PUSHJ	P,CLRSPC)

;CLRSPC CLEARS MEMORY GOTTEN FROM GETSPC. RETURNS WITH ADDRESS OF SPACE CLEARED
;IN T1.

	SKIPN	T1,SIZE			;LOAD SIZE INTO T1
	RETURN				;  AND RETURN IF ZERO
	MOVE	T3,ADDR			;GET ADDR OF SPACE
	HRL	T2,T3			;GET 'FROM' ADDR
	HRRI	T2,1(T3)		;GET 'TO' ADDR
	SETZM	(T3)			;CLEAR FIRST LOC
	ADD	T3,SIZE			;GET 'UNTIL' ADDR
	CAIE	T3,(T2)			;SKIP IF SIZE = ONE
	BLT	T2,-1(T3)		;CLEAR SPACE
	MOVE	T1,ADDR
	RETURN
END;
SUBTTL	ERROR MESSAGE SUPPRESSION CONTROL

BEGIN
  PROCEDURE	(PUSHJ	P,%ERMSG)
	HRRZS	SUPFLG		;CLEAR LAST CALL
	HLRZ	T3,T2		;GET ERROR CODE
	CAIN	T3,"?"		;FATAL?
	MOVEI	T3,SUPFATAL
	CAIN	T3,"%"		;WARNING?
	MOVEI	T3,SUPWARN
	CAIN	T3,"["		;INFORMATION?
	MOVEI	T3,SUPINFO
	CAIE	T3,SUPFATAL	;IS THIS ERROR FATAL?
	JRST	$1		;NO
	SKIPLE	FERCOD		;DOES USER WANT CODE RETURNED?
	MOVEM	T1,@FERCOD	;YES
  $1%	CAMLE	T3,SUPFLG	;ARE WE ALLOWED TO PRINT IT?
	PJRST	.ERMSG		;YES
	HRROS	SUPFLG		;NO, AND NOT FOR $MORE EITHER
	RETURN
END;

%TOCTW:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TOCTW		;NO
	POPJ	P,

%TDECW:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TDECW		;NO
	POPJ	P,

%TSTRG:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TSTRG		;NO
	POPJ	P,

%TSIXN:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TSIXN		;NO
	POPJ	P,

%TOLEB:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TOLEB		;NO
	POPJ	P,

%TCORW:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TCORW		;NO
	POPJ	P,

%TCRLF:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TCRLF		;NO
	POPJ	P,

%TRBRK:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TRBRK		;NO
	POPJ	P,

%TCHAR:	SKIPL	SUPFLG		;SUPPRESS IT?
	PJRST	.TCHAR		;NO
	POPJ	P,
SUBTTL	ERROR MESSAGES

E$$NEC:	$ERROR	(?,NEC,<Not enough core for SORT/MERGE.>)

E$$FMR:	$ERROR	(?,FMR,<Attempt to free more memory than was originally retained.>)
E$$TMT:	$ERROR	(%,TMT,<Too many temporary structures specified>)
	POPJ	P,
E$$RIE:	$ERROR	(?,RIE,<Record incomplete at E-O-F>)
E$$RNI:	$ERROR	(%,RNI,<Record number inconsistent, >,+)
	$MORE	(DECIMAL,INPREC)
	$MORE	(TEXT,< read, >)
	$MORE	(DECIMAL,OUTREC)
	$MORE	(TEXT,< written>)
	$CRLF
	POPJ	P,

ERRKNR:	PUSH	P,T1
	PUSH	P,T2
	$ERROR	(%,KNR,<Key not fully contained in record >,+)
	$MORE	(DECIMAL,FILSIZ(F))
	$CRLF
	POP	P,T2
	POP	P,T1
	POPJ	P,

CPOPJ1:	AOS	(P)			;STANDARD SKIP-RETURN MECHANISM
CPOPJ:	POPJ	P,			;  ..

ENDMODULE;