Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/srtsrc/sort.mac
There are 18 other files named sort.mac in the archive. Click here to see a list.
; UPD ID= 98 on 2/6/84 at 4:14 PM by FONG                               
SUBTTL	D.M.NIXON/DZN/DLC/BRF/KWS	10-Feb-83

	SEARCH COPYRT
	SALL

COPYRIGHT (C) 1975, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


;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.


	SEARCH	SRTPRM
	XSEARCH			;SEARCH OTHER UNIVERSALS
IFN FTPRINT,<PRINTX [Entering SORT.MAC]>

	.COPYRIGHT		;Put standard copyright statement in REL file
	SEGMENT	HPURE

IFN FTOPS20,<
TITLE	SORT - SORT/MERGE for DECSYSTEM-20
>
IFE FTOPS20,<
TITLE	SORT - SORT/MERGE for DECsystem-10
>
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  Impure 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 IMPURE 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  GETFBR - Get FORTRAN Binary Record ................  47
;       11.7  GTTREC - Get Next Record From Temporary File ......  53
;  12  PUTREC
;       12.1  PUTREC - Put Next Record to Output File ...........  54
;       12.2  PUTSXR - Put SIXBIT Record ........................  55
;       12.3  PUTASR - Put ASCII Record .........................  56
;       12.4  PUTEBR - Put EBCDIC Record ........................  62
;       12.5  PUTBNR - Put Binary Record ........................  69
;       12.6  PTTREC - Put Next Record to Temporary File ........  72
;  13  MEMORY MANAGEMENT ........................................  74
;  14  STATISTICS ...............................................  80
;  15  TYPE-OUT ROUTINES ........................................  81
;  16  ERROR MESSAGE SUPPRESSION CONTROL ........................  82
;  17  ERROR MESSAGES ...........................................  83
SUBTTL	CALLING SEQUENCE CONVENTIONS

;
;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
;	RETURNS EITHER
;	JRST	1(T4)		NORMAL CASE
;	OR
;	MOVE	EF,PHYEOF	ON END OF FILE
;	JRST	0(T4)
;
;1.2	JSP	T4,PUTBUF
;	CALL TO WRITE THE NEXT OUTPUT BUFFER
;	RETURNS
;	JRST	0(T4)
;
;1.3	JSP	P4,@EXTORG
;	CALL TO EXTRACT THE NUMERIC KEYS FROM THE RECORD
;	JUST READ IN BY GETREC ROUTINE.
;	EXTORG CONTAINS RUN TIME GENERATED CODE
;	RETURNS
;	JRST	0(P4)
;2.0	JSP	P4,SUBROUTINE
;
;	USED ONLY IN THE FOLLOWING 3 PLACES
;
;2.1	JSP	P4,@EXTORG
;	SEE 1.3 ABOVE
;	RETURN IS
;	JRST	0(P4)
;
;2.2	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	0(P4)
;
;2.3	JSP	P4,PUTREC
;	TO WRITE OUT THE NEXT RECORD
;	SEE 1.2 ABOVE
;	NORMAL RETURN IS
;	JRST	0(P4)
;
;
;3.0	PUSHJ	P,SUBROUTINE
;
;	RETURNS MAY BE EITHER
;
;	SINGLE RETURN TO CALLER+1
;	POPJ	P,
;
;	OR SKIP RETURN TO CALLER+2
;	AOS	0(P)
;	POPJ	P,
;
;4.0	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	INTERNAL/EXTERNAL DEFINITIONS

;GLOBAL ROUTINES
INTERN	BLKSET,CLRSPC,E$$NEC,FRECOR,FRESPC,GENNAM,GETSPC,RELSPC,%ERMSG,%TCRLF,%TOCTW,%TOLEB,%TSTRG,%TDECW,%TSIXN
INTERN	STATS,SSTATS,ZDATA,GETJOB,CLSRUN,SETMRG,DOEOF,FSTRUN,RELES%,SETTRE
INTERN	PSORT%,CPUTST,SETSPC,GETREC,INITRE,MERGE%,PTTREC,PUTREC,E$$RNI,E$$RIE
INTERN	CPOPJ,CPOPJ1,E$$TMT,RETRN%,RETRN0,RETRN1,RSTSPC

;GENERATE STRUCTURE MACROS
;NOW GENERATE THEM MAX = 10 FOR NOW
	RADIX	10
$TEMPORARY (10,10)
	RADIX	8

;EXTERNALS

;DEFINED IN SRTSTA
EXTERN	ADVFLG,ALIGN,EXTORG,F.OXBK,FORFUN,FORHI,FORPDP,FORRET,IBUFNO,IOMODE,MAXKEY,MINKEY,MODE,MXDVSZ
EXTERN	NOCRLF,P.VARF,P4SAV,RECSAV,RECSIZ,SEQNO,STATSW,.CMPAR
EXTERN	DIE,EOFOUT,ERRRTI,FUNCT.,MSTEOT

;DEFINED IN SRTCMD

;DEFINED IN SRTJSS
EXTERN	CLSFIL,DELFIL,ENTFIL,E$$NRO,FMTBFP,GETBUF,INIOUT,ISITMT,LKPFIL,PUTBUF,RFMBFP
EXTERN	RMSGET,RMSPUT,TSTDEV,.TOLEB,OBUFSZ

;DEFINED IN SRTCER
EXTERN	.ERMSG,.TCHAR,.TCORW,.TCRLF,.TDECW,.TOCTW,.TRBRK,.TSIXN,.TSTRG,.TTIME

;DEFINED IN SRTCBL
EXTERN	COBPDP
SUBTTL	DEFINITIONS -- Impure Data

	SEGMENT	IMPURE		;[C20]

;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:!
	GD	(CPU,1)		;0 = KA10, 1 = KI10, 2 = KL10
	LD	(SECTSW,1)	;[C20] MEMORY SECTION TYPE
				;[C20] 0=ALLOCATE MEMORY USING .JBFF
				;[C20] 1=ALLOCATE MEMORY USING FUNCT.
				;[C20] 2=ALLOCATE MEMORY USING SECTFF
	LD	(SECTFF,1)	;[C20] FREE MEMORY ADDRESS FOR NON-ZERO SECTION
	LD	(OLDCOR,1)	;[C13] ORGINAL FRECOR
	LD	(FRECOR,1)	;[C13] MEMORY AVAILABLE FOR ALLOCATION
	LD	(FREEND,1)	;[C13] END OF VALID FRECOR POOL
	LD	(MAXCOR,1)	;[C13] LARGEST MEMORY IN USE AT ONE TIME
	LD	(OLDFF,1)	;[C13] ORIGINAL .JBFF
	LD	(OLDREL,1)	;[C13] ORIGINAL .JBREL
	LD	(CHNFRE,1)	;[C19] CHANNELS AVAILABLE FOR ALLOCATION
	GD	(NUMRCB,1)	;NUMBER OF RECORDS IN TREE (ALSO IN MEMORY)
	GD	(TBUFNO,1)	;NUMBER OF BUFFERS PER TEMPORARY FILE
	GD	(OBUFNO,1)	;NUMBER OF BUFFERS FOR OUTPUT OR MERGE FILE
	GD	(TCBIDX,1)	;INDEX INTO TCB TABLE
	GD	(RECORD,1)	;INPUT RECORD SIZE IN BYTES
	GD	(REKSIZ,1)	;NUMBER OF WORDS IN RECORD + EXTRACTED KEYS
	GD	(XTRWRD,1)	;[207] # OF WORDS OF EXTRACTED KEYS
	GD	(NUMTMP,1)
	GD	(ACTTMP,1)	;NO. OF TEMP FILES CURRENTLY OPEN FOR INPUT
	GD	(STRNUM,1)
	GD	(STRNAM,MX.TMP)	;STRUCTURES FOR TEMPORARY FILES
	GD	(MAXTMP,1)	;MAX. NO. OF TEMP FILES IN USE DURING MERGE
	GD	(BUFALC,1)
	LD	(JOBNUM,1)	;SIXBIT JOB NUMBER ,, OCTAL JOB NUMBER
	GD	(RTRUNC,1)	;[C20] NUMBER OF TRUCATED RECORDS - 1
	GD	(CMPCNT,1)	;[C20] NUMBER OF KEY COMPARISONS
	LD	(RCBTOT,1)	;[C20] NUMBER OF RECORDS IN MEMORY FOR SORT PHASE
	LD	(BUFTOT,1)	;[C20] COPY OF UBUFSZ FOR STATS
	LD	(RUNTOT,1)	;NUMBER OF RUNS
	GD	(TMPTOT,1)	;[C20] NUMBER OF TEMP WORDS WRITTEN
	LD	(CPUTIM,1)	;[C20] STARTING CPU TIME
	LD	(ORGTIM,1)	;[C20] STARTING DAY TIME
	GD	(NUMLFT,1)	;NUMBER OF TEMP FILES STILL TO MERGE
	GD	(NUMENT,1)	;NUMBER OF ENTERS DONE (FOR APPEND CODE)
	LD	(MRGNUM,1)	;NUMBER OF MERGE PASS
	GD	(NUMINP,1)	;NUMBER OF INPUT FILES
	GD	(BUFORG,1)	;[C13] START OF BUFFER POOL AREA
	GD	(BUFSZ,1)	;[C13] SIZE OF BUFFER POOL
	GD	(UBUFSZ,1)	;[C13] USEFUL SIZE OF BUFFER POOL
				;[C13] BUFFERS ON TOPS-20 MUST START ON A PAGE
				;[C13] BOUNDARY, THEREFORE THERE IS SOME
				;[C13] UNUSEABLE SPACE IN BUFSZ
	GD	(BUFPTR,1)
	GD	(TREORG,1)	;FIRST LOCATION OF NODE TREE
	GD	(TRESZ,1)	;[C13] SIZE OF TREE AREA
	GD	(RCBORG,1)	;[C13] FIRST LOCATION OF RECORD POOL
	GD	(RCBSZ,1)	;[C13] SIZE OF RECORD POOL
	GD	(LSTREC,1)	;PTR TO LAST RECORD JUST OUTPUT
	GD	(RQ,1)
	GD	(RC,1)
	LD	(FSTNOD,1)
	GD	(LOGEOF,1)	;LOGICAL END OF FILE INTERCEPT
	GD	(PHYEOF,1)	;PHYSICAL END OF FILE INTERCEPT
	LD	(RSAV,1)
	GD	(PSAV,1)
	GD	($RETRN,1)
	GD	(INPREC,1)	;NO. OF INPUT RECORDS SEEN
	GD	(OUTREC,1)	;NO. OF OUTPUT RECORDS SEEN
	GD	(IOBPW,1)	;[201] BYTES-PER-WORD IN EXTERNAL FILE
	GD	(IOBPW2,1)	;[C03] BYTES-PER-WORD ADJUSTED FOR SIXBIT
	LD	(CURSEQ,1)	;SEQUENCE # OF RECORD IN THIS RUN
	LD	(NXTSEQ,1)	;SEQUENCE # OF RECORD IN NEXT RUN
	GD	(SRTDN,1)	;-1 WHEN SORT PHASE OVER
	GD	(MRGDN,1)	;-1 WHEN MERGE PHASE OVER (FINAL OUTPUT STARTED)
	GD	(MRGSW,1)	;-1, 0 MEANS NO MERGE, 1 MEANS /MERGE
	GD	(WSCSW,1)	;1 IF WITH SEQUENCE CHECK (/CHECK) FOR MERGE
	GD	(SUPFLG,1)	;SEVERITY OF ERRORS TO SUPPRESS
	GD	(ERRADR,1)	;ERROR RETURN ADDRESS FOR USER CONTROL
	GD	(FERCOD,1)	;ADDRESS OF WHERE TO STORE ERROR CODE
	LD	(ADDR,1)	;ADDRESS OF MEMORY BLOCK (FOR FUNCT.)
	LD	(SIZE,1)	;SIZE OF MEMORY BLOCK (DITTO)
	LD	(CHANEL,1)	;[C19] CHANNEL FROM FUNCT.
	LD	(STATUS,1)	;RETURN STATUS FROM FUNCT.
	LD	(LSCWSZ,1)	;SIZE OF FIRST CONTINUE LSCW WORD SEEN
	LD	(LSCWMS,1)	;LSCWSZ-1 = MASK FOR CREATING CONTINUE LSCW BLOCKS
	LD	(CORSTK,1)	;PTR TO STACK OF MEMORY ALLOCATION WORDS
	LD	(CSTACK,100)	;STACK OF MEMORY ALLOCATION WORDS
IFE FTOPS20,<			;ONLY ON TOPS10
	LD	(MYPPN,1)	;[115] LOGGED-IN PPN
	LD	(DSKARG,.DCUPN)	;ARGS FOR DSKCHR UUO
	LD	(STRUSE,1)	;[214] # OF FIRST UNUSED STRNAM ENTRY
	LD	(STRDEF,1)	;[214] -1 IF WE DEFAULTED STRNAM TO DSK:
	LD	(STRARG,3)	;ARGS FOR JOBSTR UUO
>;END IFE FTOPS20
	GD	(FCBORG,FCBLEN)
	GD	(TMPFCB,MX.TMP*FCBLEN)	;DO NOT SPLIT
	GD	(DFBORG,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.

	LD	(T.BLK,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	LPURE			;[C20]

BEGIN
  PROCEDURE	(PUSHJ	P,PSORT%)
	PUSHJ	P,FMTBFP		;[C13] SETUP MEMORY POOLS
	MOVE	T1,NUMRCB		;[C20] [C13] NO. OF RECORDS
	MOVEM	T1,RCBTOT		;[C20] [C13]   FOR STATS
	MOVE	T1,UBUFSZ		;[C20] BUFFER POOL SIZE
	MOVEM	T1,BUFTOT		;[C20]   FOR STATS
IFN FTOPS20,<
	MOVE	T2,UBUFSZ		;[C13] GET USEFUL SIZE OF BUFFER POOL
  IFE FTCOBOL,<
	SKIPE	COBPDP			;CALLED FROM COBOL?
	JRST	PSORT1			;YES
	MOVE	T1,UBUFSZ		;[C13] GET USEFUL 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,UBUFSZ		;[C13] GET USEFUL SIZE OF POOL AGAIN
	SUB	T2,T1			;SUBTRACT INPUT BUFFERS
  >
PSORT1:	IDIVI	T2,PGSIZ		;COMPUTE PAGES PER TMP BUFFER
	MOVEM	T2,TBUFNO		;[325]  SAVE   (CHECK HERE)
	SKIPLE	MRGSW			;[325] IS IT MERGE?
	MOVEM	T2,OBUFNO		;[325] YES. NUMBER BUFFERS FOR FCB
>
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
ENDB;
SUBTTL	CHECK MONITOR AND CPU TYPES

	SEGMENT	HPURE			;[C20]
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.
	XMOVEI	T2,.			;[C20] A NON-ZERO SECTION?
	TLNN	T2,-1			;[C20] YES, MAY FAIL, DONT DO GETTAB
	GETTAB	T1,			;SEE WHICH MONITOR
	  JRST	$2			;[C20] 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
	JRST	@[IFIWS	<$2,$2,E$$SRM,E$$SRM,E$$1N2>](T1) ;[C20] [134]
>
IFN FTOPS20,<
	JRST	@[IFIWS	<E$$SRM,E$$2N1,E$$SRM,E$$SRM,$2>](T1) ;[C20] [134]
>
  $2%	SETZ	T2,			;[C20] [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
>
	RETURN
ENDB;
;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]		;[335] NEED THESE ON TOPS-10
	OPDEF	HALTF%[JSYS 170]	;[335]
>

	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 IMPURE DATA
ZHEAD:	BLOCK	1			;[427] LINK LOC
	Z.BEG,,Z.END			;[427] DATA TO ZERO
	.LNKEND	S.LNK,ZHEAD		;[427] HEAD OF CHAIN OF DATA TO ZERO

BEGIN
  PROCEDURE	(JSP	T4,ZDATA)	;ZERO AND INITIALIZE DATA AREAS
	MOVEI	T1,ZHEAD		;[427]  HEAD OF LIST
  $1%	HLRZ	T2,Z.ADD(T1)		;[C20] ZERO FIRST LOCATION
	SETZM	(T2)			;[C20]   ..
	HRLS	T2			;[C20] SETUP BLT AC
	ADDI	T2,1			;[C20]   ..
	HRRZ	T3,Z.ADD(T1)		;[C20] GET LAST LOCATION
	BLT	T2,(T3)			;[C20] ZERO DATA AREA
	SKIPE	T1,Z.NXT(T1)		;[OK] [427] SEE IF MORE TO DO
	JRST	$1			;[427] YES, LOOP
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,.RBALC		;[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
ENDB;



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%				;[335]
	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			;...
	ADD	T2,T3			;[C20]
	ADD	T1,T2			;[C20]
	IORI	T1,'000'		;[C20] MAKE SIXBIT
	HRLM	T1,JOBNUM		;SIXBIT OCTAL JOB NUMBER
	RETURN
ENDB;
SUBTTL	RELES. -- RELES% - Add Record to Tree

	SEGMENT	LPURE		;[C20]

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?
	JRST	$2		;[443] YES -- START ANOTHER RUN
	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
ENDB;
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
	HRRZM	R,RN.REC(S)	;CHANGE PTR ALSO
	RETURN
ENDB;
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	T2,NUMRCB	;[C20] USE ONE RCB TO HOLD LAST RECORD TO OUTPUT
	SETZ	J,		;[C20] CLEAR 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,RCBORG	;[C13] WHERE THE RECORDS START
$1%	MOVEM	U,RN.LSR(U)	;POINT TO ITSELF, RUN NO. = 0
	MOVE	T1,J		;[C20] 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	;
	ADD	T1,J		;[C20]
	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
	SOSLE	T2		;[C20] LOOP
	AOJA	J,$1		;[C20]   ..
	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
ENDB;
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)		;[OK] 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)		;[OK] GET FILE IT CAME FROM
	HLRZ	T1,RN.FCB(S)
	HLRZ	T1,FILRUN(T1)		;[OK] GET RUN # OF RECORD IN R
	HLRZ	T2,FILRUN(T2)		;[OK] 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
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,CLSRUN)
	;HERE TO OPEN NEW TEMP FILE
	PUSHJ	P,CLSFIL		;CLOSE FILE
	PUSHJ	P,SETPAS		;RENDER FILE PASSIVE
	PUSHJ	P,ENTFIL		;ENTER NEW FILE NAME
	SETZM	FILSIZ(F)
	RETURN
ENDB;

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

	SETZM	FILSIZ(F)		;CLEAR NUMBER OF RECORDS IN FILE
	SETZM	BUFALC			;FIRST TIME, SO ALLOCATE BUFFER
	PUSHJ	P,ENTFIL		;ENTER FILE
	SETOM	BUFALC			;REUSE BUFFERS FROM NOW ON
	RETURN
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,SETMRG)

;SETMRG IS CALLED TO COMPUTE THE NEW TREE SIZE FOR MERGES. SORT CAN ONLY HANDLE
;MAXTMP INPUT FILES AT A TIME, SO SETMRG IS CALLED BEFORE EACH NEW 'HUNK' OF
;INPUT FILES IS PROCESSED. AT THE TIME SETMRG IS CALLED, NO FILES HAVE BEEN
;OPENED AND LOOKED AT, SO THAT WE DON'T KNOW YET IF ANY OF THE FILES ARE NULL.
;THUS IT IS POSSIBLE THAT SETMRG WILL CAUSE A LARGER TREE TO BE ALLOCATED THAN
;IS ABSOLUTELY NECESSARY. THIS DOESN'T MATTER, SINCE GETMRG (FOR STAND-ALONE
;SORT) AND RELESI/MCLOS. (FOR COBOL SORT) HANDLE THIS CASE.

	MOVE	T1,NUMINP		;GET NO. OF INPUT FILES
	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
	AOS	NUMRCB			;[327] PLUS ONE FOR LASTREC
	RETURN
ENDB;
SUBTTL	MERGE. -- MERGE% - Begin a Merge Cycle

BEGIN
  PROCEDURE	(PUSHJ	P,MERGE%)
  IF FIRST TIME
	SKIPE	LSCWMS
	JRST	$F
  THEN MAKE SURE CONTINUE LSCW SIZE AND MASK IS SET UP
	SKIPN	T1,LSCWSZ		;ALREADY SEEN?
	MOVEI	T1,^D128		;NO, USE THE DEFAULT SIZE
	MOVEM	T1,LSCWSZ		;SET IT BACK
	SUBI	T1,1			;MASK IS 177 OR 777
	MOVEM	T1,LSCWMS
  FI;
  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;
	MOVE	T1,[DFBORG,,TMPFCB]	;[C20] GET FIRST BLOCK
	MOVE	T2,MAXTMP		;[C20] NO. TO COPY
  $4%	MOVE	T3,T1			;[C20] GET BLT AC
	ADD	T1,[DFBLEN,,DFBLEN]	;[C20] ADVANCE TO NEXT
	HRRZ	T4,T1			;[C20] GET BLT END
	BLT	T3,-1(T4)		;[C20] COPY PART WE NEED
	ADDI	T1,FCBLEN-DFBLEN	;ADVANCE RHS TO NEXT ALSO
	SOJG	T2,$4			;[C20] 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
	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
	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,DOEOF		;[C20] 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
	ENDB;
ENDB;
BEGIN
  PROCEDURE (PUSHJ	P,DELEOF)
	PUSHJ	P,DELFIL		;DELETE TEMP FILE NOW
	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
	ADD	T2,T1			;[C20] 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
	ADD	T1,T3			;[C20] 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
ENDB;


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			;[OK] GET BACK ORIGINAL RECORD
	CAMN	S,U			;WAS IT THE WINNER?
	AOS	RQ			;YES, SO FORCE INTO NEXT RUN
	RETURN				;RETURN
ENDB;


BEGIN
  PROCEDURE (PUSHJ	P,DOEOF)
	HRLI	EF,(IFIW)		;[C20] DISPTACH ON EOF
	JRST	@EF			;[C20]   ..
ENDB;
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.

	MOVE	T2,NUMRCB		;[C20] NO. OF NODES
	MOVE	U,TREORG		;[C20] 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		;[C20]
	SOJG	T2,$1			;[C20] LOOP
	JRST	$4			;DIDN'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,DOEOF			;[C20] 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,<
	SKIPE	COBPDP			;CALLED FROM COBOL?
	JRST	$5			;YES
  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
  $5%
>
	BEGIN
		MOVE	T2,NUMRCB		;[C20] GET PTR AGAIN
		MOVE	U,TREORG		;[C20]
	  $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		;[C20]
		SOJG	T2,$1			;[C20] LOOP
		SOS	RQ			;REDUCE CURRENT RUN #
		SOS	RQ			;...
	ENDB;
	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
		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
	ENDB;
	BEGIN
		;INCREASE REAL RUN NUMBERS BY 3 (TO +1)
		MOVE	T2,NUMRCB		;[C20] GET PTR AGAIN
		MOVE	U,TREORG		;[C20]
	  $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		;[C20]
		SOJG	T2,$1			;[C20] LOOP
		SETZM	RQ
		AOS	RQ			;INCREMENT CURRENT RUN #
	ENDB;
	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
		SKIPN	COBPDP		;SKIP IF CALLED FROM COBOL
		JSP	P4,PUTREC	;WE ALREADY HAVE FIRST RECORD IN R
>
		MOVEI	T1,RETRN2	;WHICH RETRN. ROUTINE TO USE
		MOVEM	T1,$RETRN
		MOVE	P,PSAV
	ENDB;
	RETURN
ENDB;
;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		;[C20] PTR TO FIRST FCB FOR INPUT FILE
	PUSH	P,ACTTMP		;[C20] SAVE LOOP COUNT ON STACK
	MOVE	S,TREORG		;GET FIRST "WINNER"
	HRRZ	R,RN.REC(S)		;AND RECORD
$1%	ADDI	F,FCBLEN		;[C20] 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
	SOSLE	(P)			;[C20] GET NEXT RECORD
	JRST	$1			;[C20]   ..
	POP	P,(P)			;[C20] RESTORE STACK
	POP	P,NUMTMP		;RESTORE NUMTMP
	AOS	RC			;SET CURRENT RUN TO #1
	SETOM	BUFALC			;INDICATE BUFFER RNGS FORMED
	RETURN
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,OBLFIL)
;SETUP FILE FOR INPUT -- DO OPEN, SET UP BUFFERS, AND LOOKUP
	SETZM	FILCNT(F)		;CLEAR BUFFER COUNT
	PJRST	LKPFIL			;PERFORM LOOKUP
ENDB;
SUBTTL	MERGE. -- MERGE0 - 0 Temporary Files

BEGIN
  PROCEDURE	(PUSHJ	P,MERGE0)
	MOVEI	T1,RETRN0		
	MOVEM	T1,$RETRN		;WHERE TO GO
IFE FTCOBOL,<
	SKIPE	COBPDP			;CALLED FROM COBOL?
	JRST	$1			;YES
	MOVE	T1,BUFORG		;[C13] GET START OFF BUFFER POOL
	MOVEM	T1,BUFPTR		;[C13] RESET BUFPTR
 IFE FTOPS20,<
	MOVE	T1,UBUFSZ		;[C13] GET USEFUL BUFFER POOL SIZE
	MOVE	T2,F.OXBK		;[215] GET OUTPUT BUFFER SIZE
	IDIV	T1,X.DVSZ(T2)		;[OK] [215] DIVIDE BY BUFFER SIZE
	CAIGE	T1,2			;[C18] AT LEAST TWO
	MOVEI	T1,2			;[C18]   ..
	TRZ	T1,1			;[C18] MAKE EVEN
 >
 IFN FTOPS20,<
	MOVE	T1,UBUFSZ		;[C13] GET USEFUL 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)

;Here for COBOL only
  $1%	SKIPG	LSTREC			;LSTREC TO FLUSH FIRST?
	PJRST	RETRN0			;GET FIRST RECORD FOR COBOL
	MOVE	R,LSTREC		;YES, GET RECORD PTR
	RETURN				;RETURN WITH RECORD IN (R)
ENDB;
SUBTTL	MERGE. --  MERGE1 - 1 Temporary File

BEGIN
  PROCEDURE	(PUSHJ	P,MERGE1)
IFE FTCOBOL!FTFORTRAN,<
	SKIPN	COBPDP			;SKIP IF CALLED FROM COBOL
	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,BUFORG		;[C13] START OF BUFFERS
	MOVEM	T2,BUFPTR		;POINT TO THEM
IFE FTOPS20,<
	MOVE	T1,UBUFSZ		;[C13] GET USEFUL SIZE OF BUFFER POOL
  IFE FTCOBOL,<
	MOVE	T2,F.OXBK		;[215] GET OUTPUT BUFFER SIZE
	MOVE	T2,X.DVSZ(T2)		;[OK] [215] SIZE OF OUTPUT BUFFER
	IDIVI	T1,.TBS(T2)		;[OK] DIVIDE BY COMBINED BUFFER SIZE
	CAIGE	T1,2			;[C18] AT LEAST TWO
	MOVEI	T1,2			;[C18]   ..
	TRZ	T1,1			;[C18] MAKE EVEN
  >
  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,UBUFSZ		;[C13] GET USEFUL SIZE OF BUFFER POOL
  IFE FTCOBOL,<				;IF NOT COBOL, WE HAVE OUTPUT FILE
	SKIPE	COBPDP			;CALLED FROM COBOL?
	JRST	[LSH	T1,-<POW2(PGSIZ)>	;YES, DIVIDE BY TEMP BUFFER SIZE
		MOVEM	T1,TBUFNO		;SAVE NO. OF TEMP AND OUTPUT BUFFERS
		JRST	$1]

	MOVE	T2,OBUFSZ		;GET OUTPUT FILE BUFFER SIZE
	IDIVI	T1,PGSIZ(T2)		;[OK] 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
  >
  $1%
>;END IFE FTOPS20
	SETZM	TCBIDX			;SO WE GET FIRST FILE AGAIN
	MOVEI	F,TMPFCB
	PUSHJ	P,OBLFIL		;LOOKUP TEMP FILE AGAIN
IFE FTCOBOL,<
	SKIPN	COBPDP			;CALLED FROM COBOL?
	JRST	$2			;NO
	MOVEI	T1,1			;[415] SET NO. OF ACTIVE TEMP FILES
	MOVEM	T1,ACTTMP		;[415] TO 1 IN CASE USERS ENDS BEFORE EOF
	MOVEI	F,TMPFCB
	JSP	P4,GTTREC		;GET FIRST RECORD FROM TEMP FILE
	  JRST	DOEOF			;[C20] E-O-F
 $2%
>
IFN FTCOBOL,<
	MOVEI	T1,1			;[415] SET NO. OF ACTIVE TEMP FILES
	MOVEM	T1,ACTTMP		;[415] TO 1 IN CASE USERS ENDS BEFORE EOF
	MOVEI	F,TMPFCB
	JSP	P4,GTTREC		;GET FIRST RECORD FROM TEMP FILE
	  JRST	DOEOF			;[C20] E-O-F
 $2%
>
	MOVE	P,PSAV
	RETURN
ENDB;
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
IFE FTCOBOL,<
	SKIPE	COBPDP			;CALLED FROM COBOL?
	JRST	$1			;YES
	PUSHJ	P,INIOUT		;OPEN SORT.OUT
	JSP	P4,PUTREC		;WE ALREADY HAVE FIRST RECORD IN R
  $1%
>
	MOVEI	T1,RETRN2		;WHICH RETRN. ROUTINE TO USE
	MOVEM	T1,$RETRN
	MOVE	P,PSAV
	RETURN
ENDB;
SUBTTL	RETRN. -- RETRN% - Return Record From Tree to Output File

BEGIN
  PROCEDURE	(PUSHJ	P,RETRN%)
	MOVE	T1,$RETRN	;[C20] GO TO RIGHT ROUTINE
	PJRST	(T1)		;[C20]   ..
ENDB;


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
ENDB;


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	DOEOF			;[C20] E-O-F
	RETURN
ENDB;

BEGIN
  PROCEDURE	(PUSHJ	P,EOFSNG)
	SETZM	ACTTMP			;[415] NORMAL EOF  TEMP FILE NOT ACTIVE NOW
	PUSHJ	P,DELFIL		;DELETE TEMP FILE
	JRST	EOFOUT			;FORCE OUT LAST RECORD
ENDB;
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,DOEOF		;[C20] E-O-F RETURN
	PUSHJ	P,SETTRE	;SET NEW RECORD IN TREE
	RETURN
ENDB;



BEGIN
  PROCEDURE	(PUSHJ	P,EOF15)
	PUSHJ	P,DELFIL		;DELETE TEMP FILE
	SOSG	ACTTMP			;ALL DONE?
	JRST	EOFOUT			;YES
	HLLOS	RQ			;SET TERMINATING RUN#
	RETURN
ENDB;
BEGIN
  PROCEDURE	(PUSHJ	P,SETPAS)
	HRRZ	T1,TCBIDX		;GET CURRENT POS
	IMULI	T1,DFBLEN
	ADDI	T1,DFBORG		;POSITION IN MEMORY
	HRRZI	T2,DFBLEN-1(T1)		;[C20] BLT PTR LIMIT
	HRL	T1,F			;[C20] GET START POSITION
	BLT	T1,(T2)			;[C20] 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
ENDB;

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-1(F)		;[C20] BLT PTR LIMIT
	BLT	T1,(T2)			;[C20] COPY FILE
	SOS	TCBIDX			;REDUCE INDEX
	RETURN
ENDB;
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

	HRLI	T1,(IFIW)		;[C20] SAVE R
	HRR	T1,R			;[C20]   ..
	MOVEM	T1,RSAV			;[C20]   ..
  IFN FTOPS20,<
	MOVE	T1,FILFLG(F)
	TXNE	T1,FI.RMS
	JRST	RMSGET			;RMS FILE
  >
  IFE FTFORTRAN,<
  $1%	SKIPE	T1,FILBLK(F)		;BLOCKED FILE?
	AOBJP	T1,[MOVN T1,T1			;RESET BLOCKING FACTOR
		HRLZM	T1,FILBLK(F)		;REFORM AOBJN PTR
		PUSHJ	P,SKPBLK		;[C17] ADVANCE TO NEXT BLOCK
		  RETURN			;EOF
		HRRZ	T3,IOMODE		;[201] FETCH I/O MODE
		CAIN	T3,MODEBCDIC		;IF EBCDIC
		SKIPL	FILFLG(F)		;AND VARIABLE
		JRST	$1			;NO
		CALL	RDEBBT			;[C06] BYPASS BLOCK DESCRIPTOR WORD
		CALL	RDEBBT			;[C06]  ..
		CALL	RDEBBT			;[C06]  ..
		CALL	RDEBBT			;[C06]  ..
		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	@[IFIWS <GETSXR,GETASR,GETEBR,GETBNR>]-1(T3)	;[C20]
  ESAC;
ENDB;
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)			;[OK] 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)			;[OK]  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
	CAMGE	T1,T2			;[C20] 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
	ADD	R,T2			;[C20] PTR TO LAST WORD IN RECORD DESTINATION
	BLT	T3,0(R)			;TRANSFER RECORD
	SUB	T1,T2			;[C20]
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	JRST	$F

  ELSE COPY PIECEMEAL
	MOVE	P1,T2			;[C20] 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%	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
		CAMLE	T2,T1			;[C20] CONTAINED WITHIN CURRENT BUFFER ?
		MOVE	T2,T1			;[C20] 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
		ADD	R,T2			;[C20] PTR TO END OF RECORD FRAGMENT
		BLT	T3,0(R)			;TRANSFER RECORD FRAGMENT
		SUB	T1,T2			;[C20]
		MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
		ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
		SUB	P1,T2			;[C20] DECREMENT LENGTH OF RECORD RESIDUE
		JUMPN	P1,$B			;FINISHED ?
		ENDB;
  FI;
	HRRZ	R,RSAV			;[C20] RESTORE R
	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	AOJA	P4,@EXTORG		;[OK] [C13] EXTRACT KEYS AND GIVE OK RETURN
ENDB;
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		;[OK] STORE IT IN RECORD
	MOVE	T2,RECSIZ		;JUST COPY THIS MUCH
	RETURN
ENDB;

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
ENDB;

>;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
	HRRZ	T1,FILPTR(F)		;[C20] [110] GET FIRST WORD
	MOVE	T1,(T1)			;[C20]   ..
	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
	ENDB;
  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)		;[OK] [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]	;[OK] 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			;INTEGRAL 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
	ADD	R,T1			;[C20] 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
ENDB;
;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
	HRRZ	T1,FILPTR(F)		;[C20] GET FULL WORD
	MOVE	T1,(T1)			;[C20]   ..
	AND	T1,ASCMSK(T2)		;[OK] 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
ENDB;


BEGIN
  PROCEDURE (JSP	P4,GETCRL)	;GET A CRLF
	SKIPLE	NOCRLF			;[N11] IF WE DON'T EXPECT A CRLF
	JRST	$3			;[N11] DON'T TRY TO READ ONE
	PUSHJ	P,RDASBT		;READ AN ASCII BYTE (CR)
GETLF:	PUSHJ	P,RDASBT		; ... (LF)
GETEND:	MOVE	T1,FILPTR(F)		;[310] VAR. LINE TERM- SET UP ONLY
	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
	HRRZ	R,RSAV			;[C20] RESTORE R
	MOVE	T1,(R)			;GET CHAR COUNT
	CAMGE	T1,MINKEY		;IS IT BIG ENOUGH?
	PUSHJ	P,ERRKNR		;NO
	AOJA	P4,@EXTORG		;[OK] [C13] EXTRACT KEYS AND GIVE OK RETURN
ENDB;

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,
;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>)
ENDB;

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

	MOVE	P1,T1			;[C20] 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
	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
	CAMLE	T2,T1			;[C20] CONTAINED WITHIN CURRENT BUFFER
	MOVE	T2,T1			;[C20] 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
	ADD	R,T2			;[C20] 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
	SUB	P1,T2			;[C20] 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
ENDB;
;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
	MOVE	T4,T1			;[C20] NO. OF FULL WORDS TO COPY
	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
	HRRZ	T1,T2			;[C20] GET FIRST WORD
	MOVE	T1,-1(T1)		;[C20]   ..
	LSH	T1,-1			;RIGHT JUSTIFY
  IF THERE ARE FULL WORDS TO MOVE
	JUMPLE	T4,$F			;[C20] 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
			PUSH	P,T4			;[C20] SAVE T4
			JSP	T4,GETBUF		;GET NEW BUFFER
			  JRST	E$$RIE			;WARN USER
			POP	P,T4			;[C20] RESTORE T4
			POP	P,T3
			POP	P,T1
			JRST	$1]
	  $1%	HRRZ	T2,FILPTR(F)		;[C20] GET IT
		MOVE	T2,(T2)			;[C20]   ..
		LSHC	T1,(P1)			;[OK] 35 BITS IN T1
		LSH	T1,1			;LEFT JUSTIFY
		MOVEM	T1,RC.KEY(R)		;STORE
		LSHC	T1,(T3)			;[OK] MOVE REMAINDER INTO T1
		MOVNI	T2,5
		ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
		AOS	FILPTR(F)		;AND BYTE PTR
		ADDI	R,1			;[C20] LOOP FOR ALL FULL WORDS
		SOJG	T4,$B			;[C20]   ..
	ENDB;
  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
	HRRZ	T2,FILPTR(F)		;[C20] GET IT
	SKIPA	T2,(T2)			;[C20]   ..
  $4%	TDZA	T2,T2			;NO REMAINDER
	AND	T2,ASCMSK(T3)		;[OK] ONLY WHAT WE NEED
	LSHC	T1,(P1)			;[OK] 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
ENDB;
;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
	ADD	T2,R			;[C20] END OF BLT
	BLT	T1,-1(T2)		;[OK] CLEAR IT ALL
  $1%
  IFE FTKL10,<
	HRLI	T4,(POINT 7,,35)	;[C20] DEPOSIT BYTE PTR
	HRR	T4,R			;[C20]   ..
	MOVE	P1,RECORD		;NO. OF CHARACTERS MAX. TO STORE
	SKIPG	SEQNO			;[110] CHECK FOR SEQUENCE NO.
	JRST	$3			;NOT
	HRRZ	T1,FILPTR(F)		;[C20] GET FULL WORD
	MOVE	T1,(T1)			;[C20]   ..
	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.
	AOS	T4			;[C20] GET NEXT REAL BYTE
	AOJA	R,$3			;[C20]   ..

  $2%	PUSH	P,T4			;[C20] SAVE T4
	JSP	T4,GETBUF		;GET NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
	POP	P,T4			;[C20] RESTORE T4
  $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	[SKIPLE	P1			;[C20] ROOM FOR IT?
		IDPB	T1,T4			;[C20] YES
		SOJA	P1,$3]			;[C20] LOOP UNTIL END OF LINE
	JUMPGE	P1,$4			;[C20] RECORD TRUNCATION?
	PUSHJ	P,ERRRTI		;[C20] YES, WARN USER FIRST TIME
	SETZ	P1,			;[C20] ONLY COUNT CHAR WE REALLY STORED
  $4%	SUB	P1,RECORD		;[C20] - NO. OF CHAR. STORED
	MOVMM	P1,@RSAV		;[OK] [147] STORE AS + BYTE COUNT
	PJRST	GETEND			;[310] READ THE LF-LAST ONE
  >;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		;[OK] [147] WILL TRY TO STORE THIS MANY
	HRR	T4,R			;[C20] DESTINATION ADDRESS
	HRLI	T4,(POINT 7,,35)	;DESTINATION BYTE PTR
	SKIPG	SEQNO			;[110] CHECK FOR SEQUENCE NO.
	JRST	$2			;[417] [110] NO
	HRRZ	T2,FILPTR(F)		;[C20] GET FIRST WORD
	MOVE	T2,(T2)			;[C20]   ..
	MOVEM	T2,RC.KEY(R)		;[C20] 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
	JUMPL	T0,E$$NAI		;[N01] [412] SUB TOO MANY. ISNT LINESEQ ASCII
	ADDI	T4,1			;INCREMENT DESTINATION
  $2%	MOVE	T1,FILPTR(F)		;SOURCE BYTE PTR
	TXO	T0,S.FLAG		;SET SIGNIFICANCE FLAG
  $3%	SETZ	T2,			;[417]JUST INCASE
  	EXTEND	T0,[MOVST AVRTBL
		EXP	0]		;[417] COPY AND ZERO FILL
	  JRST	$4			;EITHER COUNT RAN OUT OR CRLF SEEN
	PUSH	P,T4			;  ..
	JSP	T4,GETBUF		;GET NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
	POP	P,T4			;  RESTORE WORK ACS
	SETZ	T2,			;[417]
	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		;[OK] [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		;[OK] [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		;[OK] [147] UPDATE COUNT PROPERLY
	PJRST	GETEND			;[310] ALL DONE, READ LF NOW

  $5%	JUMPE	T0,[HALT .]		;BUFFER RAN OUT
	AOS	@RSAV			;[OK] [147] FEATURE OF MICRO CODE
	TXZN	T4,77B11		;[341] CLEAR BYTE POINTER
	AOJA	T3,$3			;[417] IF NOT FIRST TIME, READ TIL CR-LF SEEN
	MOVE	T2,T1			;[417] GET INPUT BYTE POINTER
	ILDB	T2,T2			;[417] GET NEXT BYTE
	CAIG	T2,.CHCRT		;[417] SEE IF END OF RECORD
	CAIGE	T2,.CHLFD		;[417] ...
	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

ENDB;

E$$NAI:	$ERROR(?,NAI,<Non ASCII input file>)	;[N01]	
	$DIE
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
	ENDB;

	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			;INTEGRAL 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
	ADD	R,T1			;[C20] 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,T2			;[440] NO. OF BYTES USED
	ADDM	T2,FILCNT(F)		;ACCOUNT FOR THEM
;	PJRST	GETELW			;NEXT PAGE
ENDB;
;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
  $2%	MOVN	T2,(P)			;[440] REMAINDER
	ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
	POP	P,T2			;[440] GET REMAINDER BACK
	JUMPE	T2,GETEBZ		;ALL DONE
	HRRZ	T1,FILPTR(F)		;[C20] GET FULL WORD
	MOVE	T1,(T1)			;[C20]   ..
	AND	T1,EBCMSK(T2)		;[OK] 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
ENDB;


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
	HRRZ	R,RSAV			;[C20] RESTORE R
	AOJA	P4,@EXTORG		;[OK] [C13] EXTRACT KEYS AND GIVE OK RETURN
ENDB;
;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
ENDB;

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

	MOVE	P1,T1			;[C20] SIZE OF RECORD (WORDS)
$1%	SKIPE	T1,FILCNT(F)		;[440] NUMBER OF BYTES 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
	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
	CAMLE	T2,T1			;[C20] CONTAINED WITHIN CURRENT BUFFER
	MOVE	T2,T1			;[C20] 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
	ADD	R,T2			;[C20] 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
	SUB	P1,T2			;[C20] DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$1			;FINISHED ?
	PJRST	GETELW			;GET LAST WORD, SEE IF IN BUFFER
ENDB;
;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
	MOVE	T4,T1			;[C20] NO. OF FULL WORDS TO COPY
	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
	HRRZ	T1,T2			;[C20] GET FIRST WORD
	MOVE	T1,-1(T1)		;[C20]   ..
  IF THERE ARE FULL WORDS TO MOVE
	JUMPGE	T4,$F			;[C20] 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
			PUSH	P,T4			;[C20] SAVE T4
			JSP	T4,GETBUF		;GET NEW BUFFER
			  JRST	E$$RIE			;WARN USER
			POP	P,T4			;[C20] RESTORE T4
			POP	P,T3
			POP	P,T1
			JRST	$1]
	  $1%	HRRZ	T2,FILPTR(F)		;[C20] GET IT
		MOVE	T2,(T2)			;[C20]   ..
		LSHC	T1,(P1)			;[OK] 36 BITS IN T1
		MOVEM	T1,RC.KEY(R)		;STORE
		LSHC	T1,(T3)			;[OK] MOVE REMAINDER INTO T1
		MOVNI	T2,4
		ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
		AOS	FILPTR(F)		;AND BYTE PTR
		ADDI	R,1			;[C20] LOOP FOR ALL FULL WORDS
		SOJG	T4,$B			;[C20]   ..
	ENDB;
  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
	SKIPN	T2,T3			;[C20] NO REMAINDER, GET 0
	JRST	$4			;[C20]   ..
	HRRZ	T2,FILPTR(F)		;[C20] GET IT
	MOVE	T2,(T2)			;[C20]   ..
  $4%	LSHC	T1,(P1)			;[C20] 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
ENDB;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,GETEVR)		;GET VARIABLE LENGTH EBCDIC RECORD
	PUSHJ	P,RDEBBT		;READ A BYTE
	LDB	T2,[POINT 6,FILPTR(F),11] ;[442] GET BYTE SIZE
	LSH	T1,(T2)			;[OK] [442] SHIFT HIGH ORDER BYTE
	MOVE	P1,T1			;STORE HIGH ORDER BYTE
	PUSHJ	P,RDEBBT
	ADD	P1,T1			;[C20] 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
	CAMG	P1,RECORD		;[367]
	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		;[OK] [150] STORE BYTE COUNT
    IFE FTKL10,<
	HRLI	T4,(POINT 9,,35)	;[C20] DEPOSIT BYTE PTR & BYPASS BYTE COUNT
	HRR	T4,R			;[C20]   ..
	JRST	$2			;FIRST TIME

  $1%	PUSH	P,T4			;[C20] SAVE T4
	JSP	T4,GETBUF		;GET NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
	POP	P,T4			;[C20] RESTORE T4
  $2%	SOSGE	FILCNT(F)		;BUFFER EMPTY?
	JRST	$1			;YES
	ILDB	T1,FILPTR(F)		;GET NEXT BYTE
	IDPB	T1,T4			;[C20] STORE
	SOJG	P1,$2			;GET NEXT
	POP	P,P1			;GET POSSIBLE EXCESS
	JUMPE	P1,$3			;OK
	TLZE	T4,(POINT 9,0,35)	;[C20] 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
	HRRZ	R,RSAV			;[C20]
	AOJA	P4,@EXTORG		;[OK] [C13]
    >;END OF IFE FTKL10
    IFN FTKL10,<
	MOVE	T0,P1			;[C20] 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
ENDB;

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		;[OK] [150] STORE BYTE COUNT
	HRLI	T4,(POINT 9,,35)	;[C20] DEPOSIT BYTE PTR & BYPASS BYTE COUNT
	HRR	T4,R			;[C20]   ..
	JRST	$2			;FIRST TIME

  $1%	PUSH	P,T4			;[C20] SAVE T4
	JSP	T4,GETBUF		;GET NEXT BUFFER
	  JRST	E$$RIE			;WARN USER
	POP	P,T4			;[C20] RESTORE T4
  $2%	SOSGE	FILCNT(F)		;BUFFER EMPTY?
	JRST	$1			;YES
	ILDB	T1,FILPTR(F)		;GET NEXT BYTE
	IDPB	T1,T4			;[C20] STORE
	SOJG	P1,$2			;GET NEXT
	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	HRRZ	R,RSAV			;[C20]
	AOJA	P4,@EXTORG		;[OK] [C13]
    >;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
ENDB;

  >;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
	CAMGE	T1,T2			;[C20] 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
	ADD	R,T2			;[C20] PTR TO LAST WORD IN RECORD DESTINATION
	BLT	T3,0(R)			;TRANSFER RECORD
	SUB	T1,T2			;[C20]
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	JRST	$F
  ELSE	COPY PIECEMEAL
	MOVE	P1,T2			;[C20] 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	[HRRZ	R,RSAV			;[C20] RESTORE R
		RETURN]				;GIVE EOF RETURN
  $3%	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
	CAMLE	T2,T1			;[C20] CONTAINED WITHIN CURRENT BUFFER ?
	MOVE	T2,T1			;[C20] 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
	ADD	R,T2			;[C20] PTR TO END OF RECORD FRAGMENT
	BLT	T3,0(R)			;TRANSFER RECORD FRAGMENT
	SUB	T1,T2			;[C20]
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	SUB	P1,T2			;[C20] DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$2			;FINISHED ?
  FI;
	HRRZ	R,RSAV			;[C20] RESTORE R
	AOS	FILSIZ(F)		;COUNT 1 MORE RECORD
	AOJA	P4,@EXTORG		;[OK] [C13] EXTRACT KEYS AND GIVE OK RETURN
ENDB;
SUBTTL	GETREC -- GETFBR - Get FORTRAN Binary Record


;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,GETFBR)
  WHILE THERE ARE NULL RECORDS TO IGNORE
	BEGIN
		HRRZ	P1,FILPTR(F)		;[C20] [402] ZERO LSCW?
		SKIPE	P1,(P1)			;[C20]   ..
		JRST	$E			;[402] NO--FOUND REAL RECORD
		PUSHJ	P,EATFBR		;[402] YES--EAT THIS RECORD
		JUMPG	P1,$B			;[402] ANY WORDS LEFT IN BUFFER?
		JSP	T4,GETBUF		;[402] NO--READ ANOTHER
		  JRST	(P4)			;[402] RETURN EOF FROM GETREC
		JRST	$B			;[402] TRY FOR ANOTHER RECORD
	ENDB;
	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$$FCW			;ERROR
;**;[530] At GETFBR+17L, insert 2 lines
	SKIPN	LSCWSZ			;[530] HAVE WE ALREADY SEEN THE SIZE?
	HRRZM	P1,LSCWSZ		;[530] NO, SAVE THE FIRST TIME
	HRRZS	P1			;[C20] NO. OF DATA WORDS TO FOLLOW
	SUBI	P1,1			;[C20]   ..
  IF RECORD IS CONTAINED IN CURRENT I/O BUFFER
  $1%	CAMGE	T1,P1			;[C20]
	JRST	$T			;NO
  THEN COPY ALL EXCEPT LSCW AT EITHER END
	HRL	T3,FILPTR(F)		;ORIGIN OF DATA
	HRRI	T3,RC.KEY(R)		;DESTINATION
	CAMG	P1,P2			;[C20] TOO BIG?
	SKIPA	T2,P1			;NO, USE ALL
	MOVE	T2,P2			;YES, JUST USE MAX.
	JUMPLE	P2,$6			;DON'T COPY TOO MUCH
	ADD	R,T2			;[C20] NO. TO COPY
	BLT	T3,0(R)			;COPY THEM
	SUB	P2,T2			;[C20] COUNT DOWN
  $6%	MOVN	T1,P1			;[C20] 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
	HRRZ	T2,FILPTR(F)		;[C20] GET LSCW
	HLRZ	T2,(T2)			;[C20]   ..
  $3%	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
	CAMLE	T2,T1			;[C20] CONTAINED WITHIN CURRENT BUFFER ?
	MOVE	T2,T1			;[C20] NO, TRANSFER ONLY FILCNT WORDS
	MOVE	T1,T2			;[C20] [203] REMEMBER HOW MUCH TOWARD LSCW WE'RE READING
	CAMLE	T2,P2			;[C20] [203] ENOUGH ROOM TO HOLD IT?
	MOVE	T2,P2			;[C20] [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
	ADD	R,T2			;[C20] PTR TO END OF RECORD FRAGMENT
	BLT	T3,0(R)			;TRANSFER RECORD FRAGMENT
	SUB	P2,T2			;[C20] [203] ACCOUNT FOR FILLING UP RECORD
  $7%	SUB	P1,T1			;[C20] [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%	HRRZ	T1,FILPTR(F)		;[C20] GET LSCW
	HLRZ	T2,(T1)			;[C20]   ..
	HRRZ	P1,(T1)			;[C20] GET WORD COUNT
	AOS	FILPTR(F)
	SOS	T1,FILCNT(F)		;ACCOUNT FOR IT
	CAIN	T2,E.LSCW		;END?
	JRST	$5			;YES
	CAIE	T2,C.LSCW		;CONTINUE
	JRST	E$$FCW			;NO, ERROR
;**;[530] At GETFBR+74L, delete 2 lines
	SOJA	P1,$1			;YES, GET NO. OF DATA WORDS

E$$FCW:	$ERROR	(?,FCW,<Fortran binary control word incorrect>)

  $5%	HRRZ	T1,R
	HRRZ	R,RSAV			;[C20]
	SUB	T1,R			;[C20]
	SUB	T1,XTRWRD		;[410] SUBTRACT LENGTH OF EXTRACTED KEYS
	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,@EXTORG		;[OK] [C13]
ENDB;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(PUSHJ	P,EATFBR)	;[402] EAT NON-EX FORTRAN RANDOM RECORD

;EATFBR SKIPS A SINGLE 'NON-EXISTENT' FORTRAN BINARY RECORD. THESE ARE FOUND IN
;RANDOM FILES WHEN THE USER HAS WRITTEN A RECORD PAST, BUT NOT ADJACENT TO, THE
;END OF FILE. THESE RECORDS CAN BE DETECTED BECAUSE THE ENTIRE LSCW WORD IS 0.
;
;THE IDEA IS SIMPLY TO IGNORE THEM AS WE DO IN COBOL RANDOM FILES. NOTE THAT
;SINCE THIS CONDITION IS ONLY POSSIBLE IN RANDOM FILES, ALL RECORDS MUST BE THE
;SAME SIZE. THEREFORE, WE EAT EXACTLY THE USER-SPECIFIED RECORD SIZE (IN WORDS)
;PLUS 2 (FOR THE LSCW PLACE-HOLDERS).
;
;NOTE FINALLY THAT THIS ACTION IS ONLY POSSIBLE BECAUSE THERE ARE LSCWS THAT WE
;CAN TELL FROM ZERO WORDS. THUS, UNWRITTEN RECORDS IN FORTRAN RANDOM IMAGE FILES
;CANNOT BE SKIPPED THIS WAY, SINCE THEY CANNOT BE TOLD FROM REAL RECORDS THAT
;CONTAIN ALL ZEROS.
;
;CALL:
;	FILCNT(F)/	# WORDS REMAINING IN BUFFER
;	FILPTR(F)/	BYTE POINTER TO CURRENT WORD IN BUFFER
;RETURNS:
;	P1/		UPDATED COPY OF FILCNT(F)

	MOVE	P1,RECSIZ		;[402] GET # WORDS TO SKIP
	ADDI	P1,2			;[402]   REMEMBERING TO COUNT LSCWS
  WHILE MORE BUFFERS TO SKIP
	BEGIN
		CAMG	P1,FILCNT(F)		;[402] DOES REST FIT IN BUFFER?
		JRST	$E			;[402] YES--DONE
		SUB	P1,FILCNT(F)		;[402] ACCOUNT FOR BUFFER'S-WORTH
		JSP	T4,GETBUF		;[402] READ NEXT BUFFER
		  PJRST	E$$RIE			;[402] SHOULD ALL BE THERE
		JRST	$B			;[402] LOOP FOR THE REST
	ENDB;
	ADDM	P1,FILPTR(F)		;[402] UPDATE BYTE POINTER
	EXCH	P1,FILCNT(F)		;[402]   AND WORD COUNT
	SUBB	P1,FILCNT(F)		;[402]   LEAVING IT IN P1
	RETURN				;[402] DONE
ENDB;
;STILL IN IFE FTCOBOL

;SKIP TO NEXT OUTPUT BLOCK.
;  ERROR RETURN IF A CALL TO PUTBUF IS REQUIRED

BEGIN
  PROCEDURE (PUSHJ P,CLRBLK)
	MOVE	T1,FILFLG(F)		;[C17] GET FILE FLAGS
	TXNN	T1,FI.DSK		;[C17] DSK?
	RETURN				;[C17] NO, GIVE ERROR RETURN
	MOVE	T1,FILKCT(F)		;[C17] FIRST TIME?
	CAMGE	T1,FILBPK(F)		;[C17]   ..
	JRST	$1			;[C17] NO
	SKIPLE	T1,FILCNT(F)		;[C17]   ..
	CAML	T1,FILBPB(F)		;[C17]   ..
	JRST	CPOPJ1			;[C17] YES, GIVE SKIP RETURN
  $1%	MOVE	T1,FILKCT(F)		;[C17] CALCULATE BYTES LEFT IN BLOCK
	SUB	T1,FILBPB(F)		;[C17]   ..
	ADD	T1,FILCNT(F)		;[C17]   ..
	JUMPLE	T1,[MOVE T1,FILBPK(F)	;[C17] ALL DONE, INCRIMENT BLOCK BYTE COUNT
		ADDM	T1,FILKCT(F)	;[C17]   ..
		SKIPG	T1,FILCNT(F)	;[C17] RETURN
		RETURN			;[C17]   ERROR
		JRST	CPOPJ1]		;[C17]   SKIP
	SKIPG	FILCNT(F)		;[C17] ROOM LEFT IN BUFFER?
	JRST   [JSP	T4,PUTBUF	;[C17] NO, MAKE SOME
		JRST	$1]		;[C17] AND TRY AGAIN
	CAMLE	T1,FILCNT(F)		;[C17] MORE THAN THIS BUFFER?
	MOVE	T1,FILCNT(F)		;[C17] YES, USE ONLY THIS BUFFER
	MOVN	T2,T1			;[C17] ADJUST BUFFER BYTE COUNT
	ADDM	T2,FILCNT(F)		;[C17]   ..
	IDIV	T1,IOBPW2		;[C17] CALCULATE WORDS
	JUMPLE	T2,$2			;[C17] ZERO ODD BYTES
	SETZ	T3,			;[C17]   ..
	IDPB	T3,FILPTR(F)		;[C17]   ..
	SOJG	T2,.-1			;[C17]   ..
  $2%	JUMPLE	T1,$3			;[C17] JUMP IF NOTHING TO ZERO
	MOVE	T2,FILPTR(F)		;[C17] GET START ADDRESS FOR BLT
	IBP	T2			;[C17]   ..
	HRRZS	T2			;[C20]   ..
	ADDM	T1,FILPTR(F)		;[C17] ADJUST BYTE POINTER FOR WORDS
	SETZM	(T2)			;[OK] [C17] ZERO FIRST WORD
	ADDI	T1,-1(T2)		;[OK] [C17] SETUP FOR BLT
	HRL	T3,T2			;[C20]   ..
	HRRI	T3,1(T2)		;[C20]   ..
	CAMLE	T1,T2			;[501] [C20] [C17] SKIP BLT IF UNNECESSARY
	BLT	T3,(T1)			;[C20] [C17] ZERO BUFFER
  $3%	JRST	$1			;[C17] LOOP BACK
ENDB;
;SKIP TO NEXT INPUT BLOCK.
;  ERROR RETURN IF EOF OCCURED

BEGIN
  PROCEDURE (PUSHJ P,SKPBLK)
	MOVE	T1,FILFLG(F)		;[C17] GET FILE FLAGS
	TXNN	T1,FI.DSK		;[C17] DSK?
	JRST	$3			;[C17] NO
	MOVE	T1,FILKCT(F)		;[C17] FIRST TIME?
	CAML	T1,FILBPK(F)		;[C17]   ..
	JRST	$3			;[C17] YES
  $1%	SKIPG	FILCNT(F)		;[C17] ANYTHING IN BUFFER?
	JRST   [JSP	T4,GETBUF	;[C17] NO, GET SOME
		  RETURN		;[C17] CAN'T EOF
		JRST	$1]		;[C17] AND TRY AGAIN
	MOVE	T1,FILKCT(F)		;[C17] CALCULATE BYTES LEFT IN BLOCK
	ADD	T1,FILCNT(F)		;[C17]   ..
	JUMPLE	T1,[MOVE T1,FILBPK(F)	;[C17] ALL DONE, INCRIMENT BLOCK BYTE COUNT
		ADDM	T1,FILKCT(F)	;[C17]   ..
		MOVE	T1,FILCNT(F)	;[C17] RETURN
		JRST	CPOPJ1]		;[C17]   ..
	CAMLE	T1,FILCNT(F)		;[C17] MORE THAN THIS BUFFER?
	MOVE	T1,FILCNT(F)		;[C17] YES, USE ONLY THIS BUFFER
	MOVN	T2,T1			;[C17] ADJUST BUFFER BYTE COUNT
	ADDM	T2,FILCNT(F)		;[C17]   ..
	IDIV	T1,IOBPW2		;[C17] CALCULATE WORDS
	JUMPLE	T2,$2			;[C17] ADVANCE OVER ODD BYTES
	IBP	FILPTR(F)		;[C17]   ..
	SOJG	T2,.-1			;[C17]   ..
  $2%	ADDM	T1,FILPTR(F)		;[C17] ADJUST BYTE POINTER FOR WORDS
	JRST	$1			;[C17] LOOP BACK
  $3%	JSP	T4,GETBUF		;[C17] JUST CALL GETBUF
	  RETURN			;[C17] CAN'T EOF
	JRST	CPOPJ1			;[C17]
ENDB;
;STILL IN IFE FTCOBOL

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

BEGIN
  PROCEDURE	(PUSHJ	P,BLKSET)
	HRRZ	T1,IOMODE		;[C18] GET I/O MODE
  CASE I/O MODE OF (SIXBIT, ASCII, EBCDIC, BINARY)
	JRST	@[IFIWS	<$1,$2,$3,$1>]-1(T1)	;[C20] [C18] DISPATCH

  $1%	MOVE	T1,RECSIZ		;[C18] GET BYTES PER RECORD
	IMUL	T1,X.BLKF(P1)		;[OK] [C18]   TIMES RECORDS PER BLOCK
	JRST	$4			;[C18] ROUND UP TO 128 WORD BLOCK

  $2%	MOVE	T1,RECORD		;[C18] GET RECORD SIZE IN CHARACTERS
	ADDI	T1,2			;[C18] PLUS CRLF
	IMUL	T1,X.BLKF(P1)		;[OK] [C18] TIMES RECORDS PER BLOCK
	IDIVI	T1,5			;[C18] WORDS PER BLOCK
	SKIPE	T2			;[C18] ROUND UP IF REQUIRED
	ADDI	T1,1			;[C18]   ..
	JRST	$4			;[C18] NOW ROUND UP TO DSK BLOCK

  $3%	MOVE	T1,RECORD		;[C18] GET RECORD SIZE IN CHARACTERS
	SKIPGE	FILFLG(F)		;[C18] IF VARIABLE?
	ADDI	T1,4			;[C18] ADD RECORD HEADER WORD
	IMUL	T1,X.BLKF(P1)		;[OK] [C18] TIMES RECORDS PER BLOCK
	IDIVI	T1,4			;[C18] WORDS PER BLOCK
	SKIPE	T2			;[C18] ROUND UP IF REQUIRED
	ADDI	T1,1			;[C18]   ..
	SKIPGE	FILFLG(F)		;[C18] IF VARIABLE?
	ADDI	T1,1			;[C18] ADD BLOCK HEADER WORD

  $4%	TRZE	T1,177			;[C18] ROUND UP TO DISK BLOCK
	ADDI	T1,200			;[C18]   ..
	IMUL	T1,IOBPW2		;[C18] CONVERT TO BYTES
	MOVEM	T1,FILBPK(F)		;[C18] SAVE IN FCB
	RETURN				;[C18] DONE
  ESAC;
ENDB;
;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
	HRR	T4,R		;[C20] 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
ENDB;
  >;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
	MOVE	T1,BUFORG		;[C13] DOES R POINT TO AN I/O BUFFER?
	ADD	T1,BUFSZ		;[C13]   ..
	CAML	R,BUFORG		;[C13]   ..
	CAML	R,T1			;[C13]   ..
	JRST	$F			;NO
  THEN RESET R WITH A VALID RCB 
	MOVE	R,LSTREC		;[C20] GET NEXT NEXT RCB
	MOVE	R,(R)			;[C20]   ..
	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)			;[OK] CHECK BYTE OR WORD COUNT
	JRST	$T			;MIGHT BE LOGICAL END-OF-FILE
  THEN COPY RECORD
IFE FTCOBOL,<
	  IF RECORD IS VARIABLE OR COBOL
		SKIPG	P.VARF
		SKIPE	COBPDP		;CALLED FROM COBOL?
		TRNA
		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,<
			SKIPE	COBPDP			;CALLED FROM COBOL?
			JRST	$F			;YES
		  	CAMLE	T2,MAXKEY		;WILL ALL KEYS FIT?
			JRST	$F			;YES
			HRLI	T1,0(R)			;[OK] BUILT BLT PTR
			HRRI	T1,1(R)			;[C20]   ..
			MOVE	T3,MAXKEY
			ADD	T3,R			;[C20] END OF KEYS
			SETZM	(R)			;ZERO FIRST WORD
			BLT	T1,(T3)			;[OK] 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
		CAMGE	T1,T2			;[C20] IS RECORD CONTAINED IN CURRENT BUFFER ?
		JRST	$T			;NO, RECORD SPANS BUFFERS
	  THEN
		EXCH	R,LSTREC		;YES, STORE THIS R IN LIST
		MOVE	T3,LSTREC		;[C20] AND LINK IN
		MOVEM	R,(T3)			;[C20]   ..
		HRRZ	R,FILPTR(F)		;FIRST DATA WORD
		HRRM	R,RN.REC(S)		;MAKE SURE PTR AGREES
		SUB	T1,T2			;[C20]
		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
		HRLI	T1,(IFIW)		;[C20] SAVE R
		HRR	T1,R			;[C20]   ..
		MOVEM	T1,RSAV			;[C20]   ..
		MOVE	P1,T2			;[C20] 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%	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
		CAMLE	T2,T1			;[C20] CONTAINED WITHIN CURRENT BUFFER ?
		MOVE	T2,T1			;[C20] 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
		ADD	R,T2			;[C20] ADVANCE RECORD DEPOSIT POINTER
		BLT	T3,-1(R)		;TRANSFER RECORD FRAGMENT
		SUB	T1,T2			;[C20]
		MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
		ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
		SUB	P1,T2			;[C20] DECREMENT LENGTH OF RECORD RESIDUE
		JUMPN	P1,$3			;FINISHED ?
		HRRZ	R,RSAV			;[C20]
						;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;
ENDB;
SUBTTL	PUTREC -- PUTREC - Put Next Record to Output File

IFE FTCOBOL,<
BEGIN
  PROCEDURE	(JSP	P4,PUTREC)	;OUTPUT NEXT RECORD
	HRLI	T1,(IFIW)		;[C20] SAVE R
	HRR	T1,R			;[C20]   ..
	MOVEM	T1,RSAV			;[C20]   ..
  IFN FTOPS20,<
	MOVE	T1,FILFLG(F)
	TXNE	T1,FI.RMS
	JRST	RMSPUT			;RMS FILE
  >
  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,CLRBLK		;[C17] YES, CLEAR TO NEXT BLOCK
		  JSP	T4,PUTBUF		;[C17] NEED 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)		;[OK] NO. OF BYTES + 4 BYTE OVERHEAD
		ADDI	T1,4			;PLUS THIS WORD
		LDB	T3,[POINT 6,FILPTR(F),11] ;[C06] GET BYTE SIZE
		MOVN	T3,T3			;[C06] NEGATE IT
		LSHC	T1,(T3)			;[OK] [C06] SHIFT OFF LOW BYTE
		MOVNI	T3,^D36(T3)		;[OK] [C06] BUILD SHIFT COUNT
		LSH	T2,(T3)			;[OK] [C06] RIGHT JUSTIFY LOW BYTE
		PUSH	P,T2			;[C06] AND SAVE IT
		CALL	WREBBT			;[C06] STORE HIGH BYTE
		POP	P,T1			;[C06] GET LOW BYTE BACK
		CALL	WREBBT			;[C06] AND STORE IT
		SETZ	T1,			;[C06] ZERO OTHER BYTES
		CALL	WREBBT			;[C06]  ..
		CALL	WREBBT			;[C06]  ..
		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	@[IFIWS <PUTSXR,PUTASR,PUTEBR,PUTBNR>]-1(T2)	;[C20]
  ESAC;
ENDB;
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;
	HRRZ	T1,FILPTR(F)		;[C20] STORE IT
	MOVEM	T2,(T1)			;[C20]   ..
	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
	CAMGE	T1,T2			;[C20] 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
	ADD	T4,T2			;[C20] ADDRESS OF END OF RECORD DESTINATION
	BLT	T3,-1(T4)		;[OK] TRANSFER RECORD
	SUB	T1,T2			;[C20]
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNTER
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	HRRZ	R,RSAV			;[C20]
	RETURN	
  ELSE COPY IT PIECEMEAL
	MOVE	P1,T2			;[C20] 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
		MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
		CAMLE	T2,T1			;[C20] WILL RESIDUE FIT IN CURRENT BUFFER ?
		MOVE	T2,T1			;[C20] 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
		ADD	T4,T2			;[C20] ADVANCE RECORD RETRIEVAL PTR
		BLT	T3,-1(T4)		;[OK] TRANSFER RECORD FRAGMENT
		SUB	T1,T2			;[C20]
		MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNTER
		ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
		ADD	R,T2			;[C20] ADVANCE RECORD RETRIEVAL PTR
		SUB	P1,T2			;[C20] DECREMENT LENGTH OF RECORD RESIDUE
		JUMPN	P1,$B			;NOT FINISHED 
	ENDB;
	HRRZ	R,RSAV			;[C20]
	RETURN	
  FI;
ENDB;
  >;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
  IF USER GAVE /AFTER-ADVANCING SWITCH
	SKIPG	ADVFLG			;[N11] DO WE WANT TO ADVANCE FIRST?
	JRST	$F			;[N11] NO
  THEN CALL THE PUTCRF ROUTINES
	PUSH	P,P4			;[N11] YES, FIRST SAVE RETURN
	JSP	P4,PUTCRB		;[N11] YES, OUTPUT CRLF
	POP	P,P4			;[N11] IT USES P4 SINCE OTHER ROUTINES ITS CALLS DO
  FI;
	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			;INTEGRAL 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
	ADD	R,T1			;[C20] ADVANCE READ PTR
	ADDB	T1,FILPTR(F)		;ADJUST BYTE PTR
	HRRZS	T1			;[C20]
	BLT	T3,-1(T1)		;[OK] 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
ENDB;
;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)		;[OK] ONLY WHAT WE REALLY NEED
	HRRZ	T3,FILPTR(F)		;[C20] STORE FULL WORD
	MOVEM	T1,(T3)			;[C20]   ..
	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
ENDB;


BEGIN
  PROCEDURE (JSP	P4,PUTCRL)	;PUT A CRLF
	HRRZ	R,RSAV			;[C20] RESTORE R
	SKIPLE	NOCRLF			;[N11] IF WE DON'T WANT A CRLF
	RETURN				;[N11] JUST RETURN
	SKIPLE	ADVFLG			;[N11] HAVE WE ALREADY OUTPUT THE CRLF
	RETURN				;[N11] YES
ENDB;					;[N11] FALL INTO PUTCRB

BEGIN
  PROCEDURE (JSP	P4,PUTCRB)	;[N11]
	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
ENDB;
;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			;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
ENDB;


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
ENDB;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,PUTAML)	;HERE WHEN RECORD CROSSES BLOCK BOUNDARY
	MOVE	P1,T1			;[C20] 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
	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
	CAMLE	T2,T1			;[C20] WILL RESIDUE FIT IN CURRENT BUFFER
	MOVE	T2,T1			;[C20] 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
	ADD	R,T2			;[C20] ADVANCE RECORD RETRIEVAL PTR
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	HRRZ	T1,FILPTR(F)		;[C20]
	BLT	T3,-1(T1)		;[OK] TRANSFER RECORD FRAGMENT
	MOVNI	T1,5			;5 BYTES PER WORD
	IMUL	T1,T2			;[C20] - NO. OF WORDS
	ADDM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	SUB	P1,T2			;[C20] DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$1			;FINISHED ?
	PJRST	PUTALW			;HANDLE LAST PARTIAL WORD
ENDB;
;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
	ADD	T1,T3			;[C20] THOSE IN FRONT + THOSE BEHIND
	PUSH	P,T1			;SAVE REMAINDER
	PUSH	P,T3			;SAVE NO. OF BYTES IN (R)
	MOVE	T4,T2			;[C20] -NO. OF FULL WORDS TO COPY
	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
	HRRZ	T1,FILPTR(F)		;[C20] GET PARTIAL WORD
	MOVE	T1,(T1)			;[C20]   ..
	MOVN	T2,P1			;NO. OF BYTES -1 IT IS LEFT SHIFTED
	LSH	T1,-1(T2)		;[OK] 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
		PUSH	P,T4			;[C20] SAVE T4
		JSP	T4,PUTBUF		;GET NEW BUFFER
		POP	P,T4			;[C20] RESTORE T4
		POP	P,T3
		POP	P,T1
		JRST	$5]
  $5%	MOVE	T2,RC.KEY(R)		;GET IT
	LSHC	T1,(P1)			;[OK] 35 BITS IN T1
	LSH	T1,1			;LEFT JUSTIFY
	MOVEM	T1,@FILPTR(F)		;STORE
	LSHC	T1,(T3)			;[OK] MOVE REMAINDER INTO T1
	MOVNI	T2,5
	ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
	AOS	FILPTR(F)		;AND BYTE PTR
	ADDI	R,1			;[C20] LOOP FOR ALL FULL WORDS
	SOJG	T4,$1			;[C20]   ..

;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)		;[OK] ONLY WHAT WE NEED
	LSHC	T1,(P1)			;[OK] 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
ENDB;
;STILL IN IFE FTCOBOL
BEGIN
  PROCEDURE	(JSP	P4,PUTAVR)	;WRITE VARIABLE LENGTH ASCII RECORD
;TERMINATE WITH CR-LF
  IFE FTKL10,<
	HRLI	T4,(POINT 7,,35)	;[C20] FORM BYTE PTR
	HRR	T4,R			;[C20]   ..
	MOVE	P1,@RSAV		;[OK] [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)		;[C20] 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,T4			;[C20] GET CHARACTER
  $2%	SOSGE	FILCNT(F)		;ANY ROOM IN BUFFER?
	JRST	[PUSH	P,T4			;[C20] SAVE T4
		JSP	T4,PUTBUF		;[C20] NO, EMPTY IT
		POP	P,T4			;[C20] RESTORE T4
		LDB	T1,T4			;[C20] 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		;[OK] NO. OF BYTES TO COPY
	SKIPG	SEQNO			;[110] SEQUENCE NO.?
	JRST	$3			;NO
	MOVE	T1,1(R)			;GET FIRST WORD
	HRRZ	T2,FILPTR(F)		;[C20] YES, STORE IT
	MOVEM	T1,(T2)			;[C20]   ..
	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
ENDB;
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			;INTEGRAL 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
	ADD	R,T1			;[C20] ADVANCE READ PTR
	ADDB	T1,FILPTR(F)		;ADJUST BYTE PTR
	HRRZS	T1			;[C20]
	BLT	T3,-1(T1)		;[OK] 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
ENDB;
;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)		;[OK] ONLY WHAT WE REALLY NEED
	HRRZ	T3,FILPTR(F)		;[C20] STORE FULL WORD
	MOVEM	T1,(T3)			;[C20]   ..
	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
ENDB;


BEGIN
  PROCEDURE (JSP	P4,PUTEBZ)	;PUT EBCDIC, FIX UP BYTE-POINTER
	HRRZ	R,RSAV			;[C20] 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
ENDB;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,PUTEML)	;HERE WHEN RECORD CROSSES BLOCK BOUNDARY
	MOVE	P1,T1			;[C20] 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
	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
	CAMLE	T2,T1			;[C20] WILL RESIDUE FIT IN CURRENT BUFFER
	MOVE	T2,T1			;[C20] 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
	ADD	R,T2			;[C20] ADVANCE RECORD RETRIEVAL PTR
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	MOVE	T1,FILPTR(F)
	BLT	T3,-1(T1)		;[OK] TRANSFER RECORD FRAGMENT
	MOVNI	T1,4			;5 BYTES PER WORD
	IMUL	T1,T2			;[C20] - NO. OF WORDS
	ADDM	T1,FILCNT(F)		;ADJUST BUFFER COUNT
	SUB	P1,T2			;[C20] DECREMENT LENGTH OF RECORD RESIDUE
	JUMPN	P1,$1			;FINISHED ?
	PJRST	PUTELW			;HANDLE LAST PARTIAL WORD
ENDB;
;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
	ADD	T1,T3			;[C20] THOSE IN FRONT + THOSE BEHIND
	PUSH	P,T1			;SAVE REMAINDER
	PUSH	P,T3			;SAVE NO. OF BYTES IN (R)
	MOVE	T4,T2			;[C20] NO. OF FULL WORDS TO COPY
	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
	HRRZ	T1,FILPTR(F)		;[C20] GET PARTIAL WORD
	MOVE	T1,(T1)			;[C20]   ..
	MOVN	T2,P1			;NO. OF BYTES  IT IS LEFT SHIFTED
	LSH	T1,(T2)			;[OK] 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
		PUSH	P,T4			;[C20] SAVE T4
		JSP	T4,PUTBUF		;GET NEW BUFFER
		POP	P,T4			;[C20] RESTORE T4
		POP	P,T3
		POP	P,T1
		JRST	$5]
  $5%	MOVE	T2,RC.KEY(R)		;GET IT
	LSHC	T1,(P1)			;[OK] 36 BITS IN T1
	MOVEM	T1,@FILPTR(F)		;STORE
	LSHC	T1,(T3)			;[OK] MOVE REMAINDER INTO T1
	MOVNI	T2,4
	ADDM	T2,FILCNT(F)		;ADJUST BYTE COUNT
	AOS	FILPTR(F)		;AND BYTE PTR
	ADDI	R,1			;[C20] LOOP FOR ALL FULL WORDS
	SOJG	T4,$1			;[C20]   ..

;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)		;[OK] ONLY WHAT WE NEED
	LSHC	T1,(P1)			;[OK] 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%	HRRZ	T1,FILPTR(F)		;[C20] STORE 2ND WORD
	MOVEM	T2,(T1)			;[C20]   ..
	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
ENDB;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
  PROCEDURE	(JSP	P4,PUTEVR)	;WRITE VARIABLE LENGTH EBCDIC RECORD

	MOVE	P1,@RSAV		;[OK] [150] GET BYTE COUNT
	MOVEI	T1,4(P1)		;[OK] BYTE COUNT PLUS 4 BYTE OVERHEAD
	LDB	T2,[POINT 6,FILPTR(F),11] ;[442] GET BYTE SIZE
	MOVN	T2,T2			;[442] NEGATE IT
	ROT	T1,(T2)			;[OK] [442] RIGHT JUST RIGHT ORDER BITS
	PUSHJ	P,WREBBT		;WRITE IT
	LDB	T2,[POINT 6,FILPTR(F),11] ;[442] GET BYTE SIZE
	LSH	T1,-^D36(T2)		;[OK] [442] RIGHT JUSTIFY LOW ORDER BITS
	PUSHJ	P,WREBBT		;WRITE IT
	SETZ	T1,
	PUSHJ	P,WREBBT		;WRITE JUNK
	PUSHJ	P,WREBBT		;...
    IFE FTKL10,<
	HRLI	T4,(POINT 9,,35)	;[C20] FORM BYTE PTR
	HRR	T4,R			;[C20]   ..
  $1%	ILDB	T1,T4			;[C20] GET CHARACTER
  $2%	SOSGE	FILCNT(F)		;ANY ROOM IN BUFFER?
	JRST	[PUSH	P,T4			;[C20] SAVE T4
		JSP	T4,PUTBUF		;[C20] NO, EMPTY IT
		POP	P,T4			;[C20] RESTORE T4
		LDB	T1,T4			;[C20] GET BYTE AGAIN
		JRST	$2]			;TRY AGAIN
	IDPB	T1,FILPTR(F)		;STORE
	SOJG	P1,$1			;LOOP
    >;END OF IFE FTKL10
    IFN FTKL10,<
	MOVE	T0,P1			;[C20] 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
ENDB;
;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
ENDB;
;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	T4,(POINT 9,,35)	;[C20] FORM BYTE PTR
	HRR	T4,R			;[C20]   ..
  $1%	ILDB	T1,T4			;[C20] GET CHARACTER
  $2%	SOSGE	FILCNT(F)		;ANY ROOM IN BUFFER?
	JRST	[PUSH	P,T4			;[C20] SAVE T4
		JSP	T4,PUTBUF		;[C20] NO, EMPTY IT
		POP	P,T4			;[C20] RESTORE T4
		LDB	T1,T4			;[C20] 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
ENDB;

  >;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
	CAMGE	T1,T2		;[C20] 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
	ADD	T4,T2		;[C20] ADDRESS OF END OF RECORD DESTINATION
	BLT	T3,-1(T4)	;[OK] [364] TRANSFER RECORD
	SUB	T1,T2		;[C20]
	MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
	ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
	HRRZ	R,RSAV		;[C20]
	RETURN	

  ELSE	COPY IT PIECEMEAL
	MOVE	P1,T2		;[C20] RECORD SIZE (WORDS)
	BEGIN
		SKIPN	T1,FILCNT(F)	;NUMBER WORDS REMAINING IN CURRENT BUFFER
		JSP	T4,PUTBUF	;BUFFER FILLED, WRITE IT
		MOVE	T2,P1		;[C20] SIZE OF RECORD RESIDUE
		CAMLE	T2,T1		;[C20] WILL RESIDUE FIT IN CURRENT BUFFER ?
		MOVE	T2,T1		;[C20] 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
		ADD	T4,T2		;[C20] ADVANCE RECORD RETRIEVAL PTR
		BLT	T3,-1(T4)	;[OK] [364] TRANSFER RECORD FRAGMENT
		SUB	T1,T2		;[C20]
		MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
		ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
		ADD	R,T2		;[C20] ADVANCE RECORD RETRIEVAL PTR
		SUB	P1,T2		;[C20] DECREMENT LENGTH OF RECORD RESIDUE
		JUMPN	P1,$B		;NOT FINISHED 
	ENDB;
	HRRZ	R,RSAV			;[C20]
	RETURN	
  FI;
ENDB;
;STILL IN IFE FTCOBOL

;PRIOR TO FORTRAN VERSION 7 ALL CONTINUE LSCW WORDS WERE 128 DECIMAL EXCEPT FOR THE LAST.
;WITH FORTRAN VERSION 7 THEY ARE GENERALLY PAGE SIZES (512) WORDS.
;THE ACTUAL SIZE IS STORED IN LSCWSZ.
;ALL CONTINUED BLOCKS EXCEPT THE LAST ARE MADE THIS SIZE.

BEGIN
  PROCEDURE	(JSP	P4,PUTFBR)
	MOVE	T2,@RSAV	;[OK] [203] GET THIS RECORD'S LENGTH IN WORDS
	MOVE	P3,T1		;COPY FILCNT AND CONVERT IT
	SOJL	P3,.+2		;[316] DON'T ROUND UP IF NOTHING
	AND	P3,LSCWMS	;GET A BLOCK NO LARGER THAN WE CAN HANDLE -1
	ADDI	P3,1		;BACK TO BIGGEST BLOCK
  IF RECORD WILL FIT IN CURRENT BUFFER
	CAIGE	P3,2(T2)	;[OK] WILL RECORD FIT IN CURRENT "BUFFER" ?
	JRST	$T		;NO, RECORD MUST SPAN BUFFERS
  THEN COPY IT
	MOVEI	T3,1(T2)	;[OK] WORDS TO LSCW
	HRLI	T3,S.LSCW
	HRRZ	T4,FILPTR(F)	;[C20] STORE START LSCW
	MOVEM	T3,(T4)		;[C20]   ..
	AOS	T3,FILPTR(F)
	HRLI	T3,RC.KEY(R)	;FORM BLT PTR
	HRRZ	T4,T3
	ADD	T4,T2		;[C20] ADDRESS OF END OF RECORD DESTINATION
	BLT	T3,-1(T4)	;[OK] [316] TRANSFER RECORD
	MOVEI	T3,2(T2)	;[OK] TOTAL WORDS
	HRLI	T3,E.LSCW
	MOVEM	T3,0(T4)	;[OK] STORE END CONTROL WORD
	SUBI	T1,2(T2)	;[OK]
	MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
	ADDI	T2,1
	ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
	JRST	$F		;[316] DONE
  ELSE COPY IT PIECEMEAL
	  IF MODE IS RANDOM
		SKIPGE	FILFLG(F)	;RANDOM IS FIXED SIZE
		JRST	$T		;MUST BE SEQUENTIAL
	  THEN COPY RECORD WITHOUT CONTINUE LSCWS
		MOVE	P1,T2		;[C20] RECORD SIZE (WORDS)
		MOVEI	T3,1(T2)	;[OK] WORDS TO LSCW
		HRLI	T3,S.LSCW
		HRRZ	T1,FILPTR(F)	;[C20] STORE START LSCW
		MOVEM	T3,(T1)		;[C20]   ..
		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
			MOVE	T2,P1		;[C20] SIZE OF RECORD RESIDUE
			CAMLE	T2,T1		;[C20] WILL RESIDUE FIT IN CURRENT BUFFER ?
			MOVE	T2,T1		;[C20] 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
			ADD	T4,T2		;[C20] ADVANCE RECORD RETRIEVAL PTR
			BLT	T3,-1(T4)	;[OK] [316] TRANSFER RECORD FRAGMENT
			SUB	T1,T2		;[C20]
			MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
			ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
			ADD	R,T2		;[C20] ADVANCE RECORD RETRIEVAL PTR
			SUB	P1,T2		;[C20] DECREMENT LENGTH OF RECORD RESIDUE
			JUMPN	P1,$B		;NOT FINISHED 
		ENDB;
		SKIPN	FILCNT(F)	;ROOM FOR LSCW
		JSP	T4,PUTBUF	;NO
		MOVE	T3,RECSIZ	;NO. OF DATA WORDS
		ADD	T3,[E.LSCW,,2]
		HRRZ	T1,FILPTR(F)	;[C20]
		MOVEM	T3,(T1)		;[C20]
		AOS	FILPTR(F)
		SOS	FILCNT(F)
		JRST	$F
	  ELSE IT'S SEQUENTIAL, COPY WITH CONTINUE LSCWS
		MOVE	P1,T2		;[C20] RECORD SIZE (WORDS)
		MOVE	P2,P1		;USED TO COUNT EXTRA LSCWS
		MOVE	T3,P3		;[C20] WORDS TO LSCW
		HRLI	T3,S.LSCW
		HRRZ	T1,FILPTR(F)	;[C20] STORE START LSCW
		MOVEM	T3,(T1)		;[C20]   ..
		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
		  $2%	SKIPLE	T1,P3		;WORDS REMAINING IN "BUFFER"
			JRST	$1		;STILL SOME
			MOVE	P3,LSCWSZ		;[316] PRETEND NEW "BUFFER"
			ADDI	P2,1		;ONE MORE LSCW TO COUNT
			MOVEI	T2,1(P1)	;[OK] SIZE OF RECORD RESIDUE + LSCW
			CAMLE	T2,P3		;[C20] [316] WMLL RESIDUE FIT IN CURRENT BUFFER ?
			MOVE	T2,P3		;[C20] [316] NO, TRANSFER ONLY FILCNT WORDS
			HRLI	T2,C.LSCW
			HRRZ	T3,FILPTR(F)	;[C20]
			MOVEM	T2,(T3)		;[C20]
			AOS	FILPTR(F)
			SOS	FILCNT(F)	;[316] ONE LESS WORD IN BUFFER
			SUBI	P3,1		;[316]   AND IN "BUFFER" TOO
		  $1%	MOVE	T2,P1		;[C20] SIZE OF RECORD RESIDUE
			CAMLE	T2,P3		;[C20] [316] WILL RESIDUE FIT IN CURRENT BUFFER ?
			MOVE	T2,P3		;[C20] [316] 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
			ADD	T4,T2		;[C20] ADVANCE RECORD RETRIEVAL PTR
			BLT	T3,-1(T4)	;[OK] TRANSFER RECORD FRAGMENT
			MOVE	T1,FILCNT(F)	;GET REAL BYTE COUNT
			SUB	T1,T2		;[C20] SUBTRACT WHAT WE'VE WRITTEN SO FAR
			MOVEM	T1,FILCNT(F)	;ADJUST BUFFER COUNTER
			SUB	P3,T2		;[C20] COUNT DOWN PSEUDO-BUFFER
			ADDM	T2,FILPTR(F)	;ADVANCE BUFFER POINTER
			ADD	R,T2		;[C20] ADVANCE RECORD RETRIEVAL PTR
			SUB	P1,T2		;[C20] DECREMENT LENGTH OF RECORD RESIDUE
			JUMPN	P1,$B		;NOT FINISHED 
		ENDB;
		JUMPN	P3,$1		;[316] NEED JUST END LSCW?
		SKIPN	FILCNT(F)	;[316] NO--NEED CONT THEN END LSCW--SEE IF ROOM
		JSP	T4,PUTBUF	;[316] NO--MAKE ROOM
		MOVE	T1,[C.LSCW,,1]	;[316] 1 BECAUSE ONLY END LSCW LEFT
		HRRZ	T2,FILPTR(F)	;[C20] STORE CONTINUE WORD
		MOVEM	T1,(T2)		;[C20]   ..
		AOS	FILPTR(F)
		SOS	FILCNT(F)
		ADDI	P2,1		;COUNT ONE MORE LSCW
	  $1%	MOVEI	T3,2(P2)	;[OK] NO. OF DATA WORDS + LSCWS
		HRLI	T3,E.LSCW
		HRRZ	T1,FILPTR(F)	;[C20]
		MOVEM	T3,(T1)		;[C20]
		AOS	FILPTR(F)
		SOS	FILCNT(F)
	  FI;
  FI;
	HRRZ	R,RSAV			;[C20]
	RETURN	
ENDB;
;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
	HRR	T1,R		;[C20] 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
ENDB;
  >;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 OR COBOL
	SKIPG	P.VARF
	SKIPE	COBPDP			;CALLED FROM COBOL?
	TRNA
	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
	CAMGE	T1,T2			;[C20] 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
	ADD	T4,T2			;[C20] END OF BLT
	BLT	T3,-1(T4)		;[OK] TRANSFER RECORD
	SUB	T1,T2			;[C20]
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNTER
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	RETURN
  ELSE
  $1%	HRLI	T1,(IFIW)		;[C20] SAVE R
	HRR	T1,R			;[C20]   ..
	MOVEM	T1,RSAV			;[C20]   ..
	MOVE	P1,T2			;[C20] RECORD SIZE (WORDS)
  $2%	SKIPN	T1,FILCNT(F)		;NUMBER WORDS REMAINING IN CURRENT BUFFER
	JSP	T4,PUTBUF		;BUFFER FILLED, WRITE IT
	MOVE	T2,P1			;[C20] SIZE OF RECORD RESIDUE
	CAMLE	T2,T1			;[C20] WILL RESIDUE FIT IN CURRENT BUFFER ?
	MOVE	T2,T1			;[C20] 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
	ADD	T4,T2			;[C20] END OF BLT
	BLT	T3,-1(T4)		;[OK] TRANSFER RECORD FRAGMENT
	SUB	T1,T2			;[C20]
	MOVEM	T1,FILCNT(F)		;ADJUST BUFFER COUNTER
	ADDM	T2,FILPTR(F)		;ADVANCE BUFFER POINTER
	ADD	R,T2			;[C20] ADVANCE RECORD RETRIEVAL PTR
	SUB	P1,T2			;[C20] DECREMENT LENGTH OF RECORD RESIDUE
	  IF NOT FINISHED
	  THEN	COPY SOME MORE
		JUMPN	P1,$2		;NOT FINISHED 
	  ELSE	RETURN
		HRRZ	R,RSAV		;[C20]
		RETURN
	  FI;
 FI;
ENDB;
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
ENDB;
SUBTTL	MEMORY MANAGEMENT

;SETSPC - SETUP MEMORY MANAGEMENT ROUTINES

BEGIN
  PROCEDURE	(PUSHJ	P,SETSPC)
  IFN FTFORTRAN,<
	MOVEI	T1,1		;[C20] ALWAYS USE FUNCT. FOR FORTRAN-10
  >
  IFN FTCOBOL,<
   IFE FTNZSEC,<		;IF SECTION ZERO CASE
	MOVEI	T1,1		;[C20] ALWAYS USE FUNCT. FOR SECTION-ZERO COBOL
   >
   IFN FTNZSEC,<		;IF NOT SECTION ZERO CASE
	MOVEI	T1,1		;[C20] ALWAYS USE FUNCT. FOR COBOL
	XMOVEI	T2,.		;[C20] GET MY SECTION NUMBER
	HLRZS	T2		;[C20]   ..
	SKIPE	T2		;[C20] NON-ZERO SECTION?
	MOVEI	T1,2		;[C20] YES, ASSUME USING SECTFF
  >>
  IFE FTCOBOL!FTFORTRAN,<
	MOVEI	T1,0		;[C20] ASSUME USING .JBFF FOR MEMORY ALLOCATION
	XMOVEI	T2,.		;[C20] GET MY SECTION NUMBER
	HLRZS	T2		;[C20]   ..
	SKIPE	T2		;[C20] NON-ZERO SECTION?
	MOVEI	T1,2		;[C20] YES, ASSUME USING SECTFF
	HLRZ	T3,FORFUN	;[C20] GET FORTRAN SECTION NUMBER
	SKIPE	FORRET		;[C20] CALLED BY FORTRAN
	CAME	T2,T3		;[C20]   AND IN FORTRAN'S SECTION?
	SKIPA			;[C20] NO
	MOVEI	T1,1		;[C20] YES, USE FUNCT. FOR MEMORY ALLOCATION
  >
	MOVEM	T1,SECTSW	;[C20] SAVE TYPE OF MEMORY ALLOCATION
	JRST	@[IFIWS <$1,$1,$2>](T1)	;[C20] DISPATCH


;SORT is in a non-zero section.
;All memory above SORT and below DDT is available.

  $2%	MOVEI	T2,FREORG	;[C20] GET STARTING SECTFF
	MOVEM	T2,SECTFF	;[C20] SAVE IT
	MOVEI	T2,DDTORG	;[N27] [C20] GET HIGHEST AVAILABLE LOCATION
	MOVEM	T2,FREEND	;[C20] REMEMBER IT
	SUB	T2,SECTFF	;[C20] CALCULATE MEMORY AVAILABLE

  $3%	MOVEM	T2,OLDCOR	;[C20] [C13] STORE IT
	MOVEM	T2,FRECOR	;[C13]   ..
	MOVE	T2,[IOWD STCKSZ,CSTACK]	;[N06] [C13] SETUP STACK
	MOVEM	T2,CORSTK	;[C13]   ..
	RETURN			;[C13]
;SORT is in section zero.
;The only memory available is between the top of the low segment (.JBREL)
;and the lower of the start of the hi-seg,  an OTS, or SORT.
;The are 3 cases to consider are:
;1) Two segment code, hiseg at 400000 or higher (normal TOPS-20 COBOL)
;	FREEND=start of hi-seg
;2) One segment code with OTS at 400000 but lower than SORT (normal FORTRAN)
;	FREEND=start of OTS
;3) One segment with OTS forced in low-seg (/SEG:LOW to LINK)
;	FREEND=start of SORT

  $1%				;[C20]
  IFE FTOPS20!FTCOBOL!FTFORTRAN,<
	MOVE	T2,.JBREL##	;[OK] [C13] GET .JBREL
	MOVEM	T2,OLDREL	;[C13] SAVE IT
  >
	HRRZ	T2,.JBFF##	;[OK] [C13] GET .JBFF
	MOVEM	T2,OLDFF	;[C13] SAVE IT
IFN FTOPS20,< IFE FTCOBOL!FTFORTRAN,<
	SKIPE	T2,FORHI	;[N27] HAVE WE BEEN CALLED BEFORE?
	JRST	$6		;[N27] YES, USE THE PREVIOUS VALUE
>>
	MOVE	T1,.JBREL##	;[N27] GET TOP OF LOW SEG
	ADDI	T1,1		;[N27] GET NEXT FREE PAGE ADDRESS
	LSH	T1,-<POW2(PGSIZ)>	;[N27] TURN INTO PAGE NUMBER
	CAIGE	T1,400		;[N27] ABOVE THE USUAL STARTING PAGE OF OTS?
 IFN FTOPS20,<
	SKIPA	T1,[.FHSLF,,400]	;[N27] NO, START THE SCAN AT PAGE 400
	HRLI	T1,.FHSLF	;[N27] YES, START HERE
  $4%	TRNE	T1,777000	;[524] Have we gone too far
	 JRST	$5		;[524] Yes, We have found the top
	RPACS%			;[N27] GET ACCESSIBILITY OF THE PAGE
	 ERJMP	$5		;[524] Just in case
	TXNN	T2,PA%PEX	;[N27] DOES THE PAGE EXIST?
 >
 IFE FTOPS20,<
	MOVEI	T1,400		;[N27] NO START THE SCAN AT PAGE 400
  $4%	MOVE	T2,T1		;[N27] GET THE PAGE TO TEST
	HRLI	T2,.PAGCA	;[N27] ACCESS FUNCTION
	PAGE.	T2,		;[N27]
	  JRST	$5		;[N27] ASSUME PAGE 400
	JUMPGE	T2,$5		;[N27] PAGE EXISTS
	CAIGE	T1,770		;[N27] ARE WE INTO DDT AND PFH AREAS?
 >
	AOJA	T1,$4		;[N27] NOT YET, TRY NEXT PAGE

  $5%	HRRZ	T2,T1		;[N27] GET PAGE NUMBER THAT FAILED
	LSH	T2,POW2(PGSIZ)	;[N27] CONVERT TO ADDRESS
;	CAILE	T2,HIORG	;[N27] MAKE SURE ITS REASONABLE
;	MOVEI	T2,HIORG	;[N27] IT IS NOW
IFN FTOPS20,< IFE FTCOBOL!FTFORTRAN,<
	MOVEM	T2,FORHI	;[N27] INCASE WE GET CALLED AGAIN
  $6%
>>
	MOVEM	T2,FREEND	;[N27] [C13] REMEMBER IT
	SUB	T2,OLDFF	;[C13] CALCULATE MEMORY AVAILABLE
	JRST	$3		;[C20]
ENDB;
;RSTSPC - RE-SETUP AVAILABLE MEMORY
;         T1 CONTAINS NEW AVAILABLE MEMORY

BEGIN
  PROCEDURE	(PUSHJ	P,RSTSPC)
	SUB	T1,OLDCOR	;[C13] CALCULATE CHANGE
  $1%	ADDM	T1,OLDCOR	;[C13] UPDATE AVAILABLE MEMORY
	ADDM	T1,FRECOR	;[C13]   ..
	SKIPLE	T1		;[C13] WARN USER IF INCREASE
	PUSHJ	P,E$$NCS	;[C13] NOT ENOUGH CORE SPECIFIED
	MOVN	T1,FRECOR	;[C13] NEGATIVE AVAILABLE MEMORY?
	JUMPG	T1,$1		;[C13] RE-ADJUST IF SO
	RETURN			;[C13]
ENDB;
;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.

BEGIN
  PROCEDURE	(PUSHJ	P,GETSPC)

	MOVEM	T1,SIZE		;[C01] SAVE REQUESTED SIZE
	MOVE	T1,SECTSW	;[C20] DISPTACH
	JRST	@[IFIWS <$2,$1,$4>](T1)	;[C20]   ..

  $1%	MOVEI	L,1+[-5,,0	;[C20] 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
	JRST	$5		;[C20] [C13]

  $2%	HRRZ	T1,.JBFF##	;[C20] [C13] GET ADDRESS
	MOVEM	T1,ADDR		;[C13] SAVE IT
	ADD	T1,SIZE		;[C13] ADD IN SIZE REQUESTED
	CAMLE	T1,FREEND	;[C13] ALLOCATING BEYOUND BOUNDARY?
	RETURN			;[C13] YES, NOT ENOUGH CORE
  IFE FTOPS20,<
  IF THERE'S NOT ENOUGH MEMORY
  $3%	CAMG	T1,.JBREL##	;[C20] SEE IF WE HAVE ENOUGH
	JRST	$F		;YES--GO FINISH
  THEN GET SOME
  IFE FTVM,<
	MOVE	T2,T1		;[C13] TRY TO ALLOCATE SOME MORE ROOM
	CORE	T2,		;[C13]  ..
	  RETURN		;[C13] CAN'T
  >
  IFN FTVM,<
	MOVE	T2,[XWD .PAGCD,T3]	;[C13] TRY TO ALLOCATE SOME MORE ROOM
	MOVEI	T3,1		;[C13]   ..
	MOVE	T4,.JBREL##	;[C13]   ..
	ADDI	T4,PGSIZ	;[C13]   ..
	LSH	T4,-<POW2(PGSIZ)>	;[C13]   ..
	PAGE.	T2,		;[C13]   ..
	  RETURN		;[C20] CAN'T
	JRST	$3		;[C20] TEST AGAIN
  >
  FI;
  >
	HRRM	T1,.JBFF##	;[OK] [C13] UPDATE FREE MEMORY ADDRESS
	JRST	$5		;[C20]

  $4%	MOVE	T1,SECTFF	;[C20] GET ADDRESS
	MOVEM	T1,ADDR		;[C20] SAVE IT
	ADD	T1,SIZE		;[C20] ADD IN SIZE REQUESTED
	CAMLE	T1,FREEND	;[C20] ALLOCATING BEYOUND BOUNDARY?
	RETURN			;[C20] YES, NOT ENOUGH CORE
	MOVEM	T1,SECTFF	;[C20] UPDATE FREE MEMORY ADDRESS

  $5%	MOVN	T1,SIZE		;[C20] [C13] SUBTRACT SIZE REQUESTED FROM POOL
	ADDM	T1,FRECOR	;[C13]   ..
	MOVE	T3,CORSTK	;[C13] GET PTR TO STACK OF ALLOCATION ENTRIES
	HRLZ	T1,SIZE		;[C13] CONSTRUCT XWD SIZE, ADDRESS
	HRR	T1,ADDR		;[C13]  FOR ALLOCATION STACK
	PUSH	T3,T1		;[C13] PUSH THIS ENTRY ONTO STACK
	MOVEM	T3,CORSTK	;[C13] SAVE STACK POINTER
	MOVE	T1,OLDCOR	;[C13] CALCULATE MEMORY IN USE
	SUB	T1,FRECOR	;[C13]   ..
	CAMLE	T1,MAXCOR	;[C13] LARGEST SO FAR?
	MOVEM	T1,MAXCOR	;[C13] YES, REMEMBER IT
  IFN FTDEBUG,<
	$ERROR	([,AMA,<Allocating >,+)
	$MORE	(DECIMAL,SIZE)
	$MORE	(TEXT,< words at >)
	$MORE	(OCTAL,ADDR)
	$CRLF
  >
	HRRZ	T1,ADDR		;[C13] RETURN ADDRESS OF BLOCK TO CALLER
	PJRST	CPOPJ1		;[C13] GIVE SKIP RETURN
ENDB;
;FRESPC - FREE C(T1) WORDS

BEGIN
  PROCEDURE	(PUSHJ	P,FRESPC)
	MOVE	T4,CORSTK	;[C13] GET ALLOCATION STACK POINTER
	POP	T4,T3		;[C13] POP SIZE AND ADDR OF LAST BLOCK ALLOCATED
	MOVEM	T4,CORSTK	;[C13] SAVE STACK POINTER
	HLRZM	T3,SIZE		;[C13] SAVE SIZE
	HRRZM	T3,ADDR		;[C13] SAVE ADDR
	MOVE	T2,SECTSW	;[C20] DISPATCH
	JRST	@[IFIWS <$2,$1,$3>](T2)	;[C20]   ..

  $1%	MOVEI	L,1+[-5,,0	;[C20] 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]
	PUSH	P,T1		;[C13] SAVE T1
	PUSHJ	P,FUNCT.	;RELEASE THE MEMORY
	POP	P,T1		;[C13] RESTORE T1
	SKIPE	STATUS		;OK?
	JRST	E$$FMR		;NO, COMPLAIN
	JRST	$4		;[C20] [C13]

  $2%	CAMGE	T1,SIZE		;[C20] [C13] FREEING LESS THAN TOP BLOCK'S SIZE
	JRST	E$$FMR		; IS AN ERROR
	HRRZ	T2,.JBFF##	;[OK] GET FREE POINTER
	SUB	T2,SIZE		;[C13] FREE UP TOP BLOCK
	CAME	T2,ADDR		;[C13] CORRECT ADDR?
	JRST	E$$FMR		;[C13] NO, OOPS
	HRRM	T2,.JBFF##	;[OK] REMEMBER NEW FREE POINTER
	JRST	$4		;[C20]

  $3%	CAMGE	T1,SIZE		;[C20] FREEING LESS THAN TOP BLOCK'S SIZE
	JRST	E$$FMR		;[C20]  IS AN ERROR
	MOVE	T2,SECTFF	;[C20] GET FREE POINTER
	SUB	T2,SIZE		;[C20] FREE UP TOP BLOCK
	CAME	T2,ADDR		;[C20] CORRECT ADDR?
	JRST	E$$FMR		;[C20] NO, OOPS
	MOVEM	T2,SECTFF	;[C20] REMEMBER NEW FREE POINTER

  $4%	SUB	T1,SIZE		;[C13] SUBTRACT WHAT WE'VE FREED
	MOVE	T2,SIZE		;[C13] ADD MEMORY BACK TO POOL
	ADDM	T2,FRECOR	;[C13]   ..
	JUMPG	T1,FRESPC	;[C13] IF SOME LEFT TO DUMP, DO IT
  IFN FTDEBUG,<
	$ERROR	([,DMA,<Returning >,+)
	$MORE	(DECIMAL,SIZE)
	$MORE	(TEXT,< words at >)
	$MORE	(OCTAL,ADDR)
	$CRLF
  >
	RETURN
ENDB;
;RELSPC - RELEASE ALL RETAINED SPACE

BEGIN
  PROCEDURE	(PUSHJ	P,RELSPC)
  $1%	MOVE	T1,CORSTK	;[C13] GET PTR TO ALLOCATION STACK
	HRRZ	T2,T1		;[C13] EMPTY YET?
	CAIGE	T2,CSTACK	;[C13]  ..
	JRST	$2		;[C13] YES
	HLRZ	T1,(T1)		;[OK] [C13] NO, GET LENGTH OF TOP ENTRY
	CALL	FRESPC		;[C13] FREE IT
	JRST	$1		;[C13] KEEP GOING
  $2%	MOVE	T1,SECTSW	;[C20] DISPATCH
	JRST	@[IFIWS <$4,$3,$6>](T1)	;[C20]   ..

  $3%	PUSHJ	P,CUTBAK	;[C20] [C13] CALL FORTRAN
	JRST	$6		;[C20] [C13]

  $4%				;[C20] [C13] STANDALONE
  IFE FTOPS20,<
  IFE FTVM,<
	MOVE	T1,OLDREL	;[C13] GET ORIGINAL MEMORY SIZE
	CORE	T1,		;[C13] REDUCE BACK TO IT
	  JRST	E$$FMR		;[C13] CAN'T HAPPEN
  >
  IFN FTVM,<
	MOVE	T3,.JBREL##	;[C20] GET MEMORY SIZE
	CAMG	T3,OLDREL	;[C20] SAME AS ORIGINAL?
	JRST	$5		;[C20] YES
	MOVE	T1,[XWD .PAGCD,T2]	;[C20] NO, REDUCE BACK TO IT
	MOVEI	T2,1		;[C20]   ..
	LSH	T3,-<POW2(PGSIZ)>	;[C20]   ..
	TLO	T3,(PA.GAF)	;[C20]   ..
	PAGE.	T1,		;[C20]   ..
	  JRST	E$$FMR		;[C20] CAN'T HAPPEN
	JRST	$4		;[C20] TEST AGAIN
  $5%				;[C20]
  >
  >
	MOVE	T1,OLDFF	;[C13] GET ORIGINAL .JBFF
	HRRZ	T2,.JBFF##	;[OK] [C13] AND CURRENT .JBFF
	CAME	T1,T2		;[C13] THEY SHOULD MATCH
	JRST	E$$FMR		;[C13] NO, ERROR

  $6%	RETURN			;[C20] [C13]
ENDB;

;CUTBAK - TELL FORTRAN TO CUT BACK MEMORY

BEGIN
  PROCEDURE	(PUSHJ	P,CUTBAK)
	MOVEI	L,1+[-3,,0		;[C13] LOAD UP ARG BLOCK FOR FUNCT. CALL	
		     Z TP%INT,[F.CBC]	;[C13]
		     Z TP%LIT,[ASCIZ /SRT/]	;[C13]
		     Z TP%INT,STATUS]	;[C13]
IFE FTOPS20!FTCOBOL,<
	SKIPN	FORPDP		;[472] FORSRT WILL DO IT IF CALLED FROM FORTRAN
>
	PUSHJ	P,FUNCT.	;[C13] CUT BACK CORE
	RETURN			;[C13]
ENDB;
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)		;[OK] GET 'TO' ADDR
	SETZM	(T3)			;[OK] CLEAR FIRST LOC
	ADD	T3,SIZE			;GET 'UNTIL' ADDR
	MOVE	T4,SIZE			;[C20] SKIP IF SIZE = ONE
	CAIE	T4,1			;[C20]   ..
	BLT	T2,-1(T3)		;[OK] CLEAR SPACE
	MOVE	T1,ADDR
	RETURN
ENDB;
SUBTTL	STATS -- Statistics 

;SSTATS -  SETUP STATISTICS LOCATIONS

BEGIN
  PROCEDURE	(PUSHJ	P,SSTATS)
	SETOM	RTRUNC			;[C20] FOR TRUNCATION MESSAGE
  IFE FTOPS20,<
	SETZ	T1,			;[C20] GET CPU TIME
	RUNTIM	T1,			;[C20]   ..
  >
  IFN FTOPS20,<
	HRROI	T1,-5			;[C20] GET CPU TIME
	RUNTM%				;[C20]   ..
  >
	MOVEM	T1,CPUTIM		;[C20] INITIAL CPU TIME IN MS
  IFE FTOPS20,<
	MSTIME	T1,			;[C20] GET DAY TIME
  >
  IFN FTOPS20,<
	TIME%				;[C20] GET DAY TIME
  >
	MOVEM	T1,ORGTIM		;[C20] INITIAL TIME OF DAY IN MS
	RETURN				;[C20]
ENDB;
;STATS - TYPE THE STATS IF REQUESTED

BEGIN
  PROCEDURE	(PUSHJ	P,STATS)
	SKIPG	STATSW			;[C20] WANT THE STATS?
	RETURN				;[C20] NO
	SKIPLE	MRGSW			;[C20] A MERGE OR SORT?
	JRST	$1			;[C20]
	TYPE	(<Sorted >)		;[C20] A SORT
	JRST	$2			;[C20]
  $1%	TYPE	(<Merged >)		;[C20] A MERGE
  $2%	MOVE	T1,INPREC		;[C20] TYPE RECORD COUNT
	PUSHJ	P,.TDECW		;[C20]   ..
  IF PLURAL 
	MOVE	T1,INPREC
	SOJE	T1,$T
  THEN TYPE RECORDS
	TYPE	(< records
>)					;[C20]   ..
	JRST	$F
  ELSE TYPE RECORD
	TYPE	(< record
>)					;[C20]   ..
  FI;
	AOSG	T1,RTRUNC		;[C20] ANY RECORDS TRUNCATED?
	JRST	$3			;[C20] NO
	PUSHJ	P,.TDECW		;[C20] YES, TYPE IT
  IF PLURAL 
	MOVE	T1,RTRUNC
	SOJE	T1,$T
  THEN TYPE RECORDS
	TYPE	(< records truncated
>)					;[C20]
	JRST	$F
  ELSE TYPE RECORD
	TYPE	(< record truncated
>)					;[C20]
  FI;
  $3%	MOVE	T1,CMPCNT		;[C20] TYPE NUMBER OF KEY COMPARISONS
	PUSHJ	P,.TDECW		;[C20]   ..
	TYPE	(< KEY comparisons, >)	;[C20]   ..
	MOVE	T1,CMPCNT		;[C20] TYPE PER RECORD
	MOVE	T2,INPREC		;[C20]   ..
	MOVEI	T3,2			;[C20]   ..
	PUSHJ	P,.TFLPW		;[C20]   ..
	TYPE	(< per record
>)					;[C20]   ..
	MOVE	T1,RCBTOT		;[C20] TYPE NUMBER OF LEAVES
	PUSHJ	P,.TDECW		;[C20]  ..
	TYPE	(< record leaves in memory, >)	;[C20]   ..
	MOVE	T1,BUFTOT		;[C20] TYPE SIZE OF BUFFER POOL
	PUSHJ	P,.TCOPK		;[C20]   ..
	TYPE	(< buffer memory
>)					;[C20]   ..
	MOVE	T1,RUNTOT		;[C20] TYPE NUMBER OF RUNS
	PUSHJ	P,.TDECW		;[C20]   ..
  IF PLURAL
	MOVE	T1,RUNTOT		;[C20]   ..
	SOJE	T1,$T			;[C20]   ..
  THEN TYPE PLURAL FORM
	TYPE	(< runs, >)		;[C20]   ..
	JRST	$F			;[C20]
  ELSE TYPE SINGULAR
	TYPE	(< run, >)		;[C20]   ..
  FI;
	MOVE	T1,MRGNUM
	PUSHJ	P,.TDECW
  IF PLURAL
	MOVE	T1,MRGNUM
	SOJE	T1,$T
  THEN TYPE PLURAL FORM
	TYPE	(< iterations>)
	JRST	$F
  ELSE TYPE SINGULAR
	TYPE	(< iteration>)
  FI;
	SKIPG	MRGSW			;[C20] BIAS MEANINGFUL?
	SKIPN	T2,RUNTOT		;[C20]   ..
	JRST	$6			;[C20] NO
	TYPE	(<, bias >)		;[C20] YES, TYPE IT
	MOVE	T1,INPREC		;[C20]   ..
	IDIV	T1,RUNTOT		;[C20]   ..
	MOVE	T2,RCBTOT		;[C20]   ..
	MOVEI	T3,2			;[C20]   ..
	PUSHJ	P,.TFLPW		;[C20]   ..
  $6%	PUSHJ	P,.TCRLF		;[C20]   ..
	SKIPN	TMPTOT			;[C20] ANY TEMPORARY FILES USED?
	JRST	$9			;[C20] NO
	TYPE	(<Total of >)		;[C20] YES, TYPE IT
	MOVE	T1,TMPTOT		;[C20]   ..
  IFN FTOPS20,<
	IDIVI	T1,PGSIZ		;[C20]   ..
  >
  IFE FTOPS20,<
	IDIVI	T1,200			;[C20]   ..
  >
	SKIPE	T2			;[C20]   ..
	ADDI	T1,1			;[C20]   ..
	PUSHJ	P,.TDECW		;[C20]   ..
	MOVE	T1,TMPTOT		;[C20]   ..
	SOJN	T1,$7			;[C20]   ..
  IFN FTOPS20,<
	TYPE	(< page>)		;[C20]   ..
  >
  IFE FTOPS20,<
	TYPE	(< disk block>)		;[C20]   ..
  >
	JRST	$8			;[C20]   ..
  IFN FTOPS20,<
  $7%	TYPE	(< pages>)		;[C20]   ..
  >
  IFE FTOPS20,<
  $7%	TYPE	(< disk blocks>)	;[C20]   ..
  >
  $8%	TYPE	(< in temporary files used
>)					;[C20]   ..
  $9%	MOVE	T1,MAXCOR		;[C20] GET MEMORY RETAINED
	PUSHJ	P,.TCOPK		;[C20]   ..
	TYPE	(< of memory retained at one time
>)					;[C20]   ..
  IFE FTOPS20,<
	SETZ	T1,			;[C20] GET CPU TIME
	RUNTIM	T1,			;[C20]   ..
  >
  IFN FTOPS20,<
	HRROI	T1,-5			;[C20] GET CPU TIME
	RUNTM%				;[C20]   ..
  >
	SUB	T1,CPUTIM		;[C20] CALCULATE INCREMENTAL CPU TIME
  IFN FTOPS20,<
	IMULI	T1,^D1000		;[C20] CONVERT TO MILLISECS
	IDIV	T1,T2		 	;[C20]   ..
  >
	PUSH	P,T1			;[C20] SAVE IT
	PUSHJ	P,.TTIME		;[C20] TYPE IT
	TYPE	(< CPU time, >)		;[C20]   ..
	POP	P,T1			;[C20] GET MS BACK
	MOVE	T2,INPREC		;[C20] TYPE PER RECORD
	MOVEI	T3,2			;[C20]   ..
	PUSHJ	P,.TFLPW		;[C20]   ..
	TYPE	(< ms per record
>)					;[C20]   ..
  IFE FTOPS20,<
	MSTIME	T1,			;[C20] GET DAY TIME
  >
  IFN FTOPS20,<
	TIME%				;[C20] GET DAY TIME
  >
	SUB	T1,ORGTIM		;[C20] CALCULATE INCREMENTAL ELAPSED TIME
  IFE FTOPS20,<
	SKIPGE	T1			;[C20] GONE PAST MIDNIGHT?
	ADD	T1,[^D<24*60*60*1000>]	;[C20] YES, ADD 1 DAY OF MILLISECS.
  >
  IFN FTOPS20,<
	IMULI	T1,^D1000		;[C20] CONVERT TO MILLISECS
	IDIV	T1,T2			;[C20]   ..
  >
	PUSHJ	P,.TTIME		;[C20] TYPE IT
	TYPE	(< elapsed time
>)					;[C20]   ..
	RETURN				;[C20]
ENDB;
SUBTTL	TYPE-OUT ROUTINES

BEGIN
  PROCEDURE	(PUSHJ	P,.TCOPK)
	;ROUND AND TYPE OUT A CORE NUMBER SUFFIXED WITH P OR K
	;CALL:	MOVE	T1,NUMBER
	;	PUSHJ	P,.TCOPK
	;USES T1, T2, T3, T4

	MOVEI	T2,PGSIZ		;[C20] ROUND TO A K OR P
IFE FTOPS20,<
	SKIPN	CPU			;[C20]   ..
	MOVEI	T2,2*PGSIZ		;[C20]   ..
>
	MOVE	T3,T2			;[C20]   ..
	SUBI	T3,1			;[C20]   ..
	TDZE	T1,T3			;[C20]   ..
	ADD	T1,T2			;[C20]   ..
	JRST	.TCORW			;[C20] TYPE IT
ENDB;

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

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

  $3%	POP	P,P1		;[C20] GET COUNT
	POP	P,T1		;[C20] GET WHOLE NUMBER
	PUSHJ	P,.TDECW	;[C20] PRINT IT
	MOVEI	T1,"."		;[C20] GET DECIMAL PT.
	PUSHJ	P,.TCHAR	;[C20] PRINT IT
  $4%	POP	P,T1		;[C20] GET NEXT DIGIT
	ADDI	T1,"0"		;[C20] CONVERT TO ASCII
	PUSHJ	P,.TCHAR	;[C20] TYPE IT
	SOJG	P1,$4		;[C20] LOOP
	POP	P,P1		;[C20] RESTORE P1
	RETURN			;[C20]
ENDB;
SUBTTL	ERROR MESSAGE SUPPRESSION CONTROL

BEGIN
  PROCEDURE	(PUSHJ	P,%ERMSG)
  IFE FTOPS20!FTCOBOL!FTFORTRAN,<
	SETZM	QBUFER		;[C20] CLEAR DEFERED TTY OUTPUT
  >
	HRRES	SUPFLG		;[351] CLEAR LAST CALL
	SKIPGE	SUPFLG		;[351] IF NEVER BEEN SET BY SWITCH
	SETZM	SUPFLG		;[351] CLEAR THE PRE-SCAN INITIAL SETTING
	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
	SKIPG	T4,FERCOD	;[N19] [C20] DOES USER WANT CODE RETURNED?
	JRST	$1		;[N19] NO
	PUSH	P,T2		;[N19] NEED TWO ACCS TO CONVERT TO ASCII
	PUSH	P,T1		;[527] SAVE T1 FOR .ERMSG
	HRLZ	T2,T1		;[N19] GET ERROR CODE
 $2%	LSH	T1,1		;[N19][527] MAKE 7 BITS
	LSHC	T1,6		;[N19] GET A CHAR.
	ADDI	T1," "		;[N19] CONVERT TO ASCII
	JUMPN	T2,$2		;[N19] LOOP FOR ALL 3 CHARS.
	LSH	T1,2*7+1	;[N19] GET IT LEFT JUSTIFIED
	IORI	T1,<"  ">_1	;[N19] ADD IN 2 SPACES
	MOVEM	T1,@T4		;[C20][527] YES
	POP	P,T1		;[527] RESTORE T1
	POP	P,T2		;[527] RESTORE T2
  $1%	CAMLE	T3,SUPFLG	;ARE WE ALLOWED TO PRINT IT?
	PJRST	.ERMSG		;YES
	HRROS	SUPFLG		;NO, AND NOT FOR $MORE EITHER
	RETURN
ENDB;

%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.>)

IFE FTOPS20,<
E$$NEH:	$ERROR	(?,NEH,<Not enough I/O channels for SORT/MERGE.>)
E$$FCN:	$ERROR	(?,FCN,<Attempt to free a I/O channel not retained or released.>)
>

E$$FCR:	$ERROR	(?,FCR,<Fatal core management error at RELSPC>)	;[C13]
E$$NCS:	$ERROR	(%,NCS,<Not enough core specified>)
	POPJ	P,
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, >,+)	;[362]
	$MORE	(DECIMAL,INPREC)
	$MORE	(TEXT,< read, >)
	$MORE	(DECIMAL,OUTREC)
	$MORE	(TEXT,< written>)
	$CRLF
	POPJ	P,

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

	SEGMENT	IMPURE			;[C20]
LOWEND=.-1				;[C20] END OF DATA
	SEGMENT	LPURE			;[C20]

;ENDMODULE;

	END