Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 94 on 11/18/83 at 5:01 PM by FONG                             
TITLE	SRTCBL - INTERFACE TO LIBOL FOR COBOL SORT
SUBTTL	E.F. McHUGH & D.M.NIXON/DMN/DZN

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

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

;FTCOBOL==1
FTFORTRAN==0

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

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

SUBTTL	TABLE OF CONTENTS FOR SRTCBL


;                    Table of Contents for SRTCBL
;
;
;                             Section                             Page
;
;   1  SRTCBL - INTERFACE TO LIBOL FOR COBOL SORT ...............   1
;   2  TABLE OF CONTENTS FOR SRTCBL .............................   2
;   3  DEFINITIONS
;        3.1  Flags, Entry Points and Macros ....................   3
;        3.2  Impure Data .......................................   4
;        3.2  Impure Data .......................................   4
;	 3.3  TOPS-20 non-zero section entry vector .............   5
;   4  PSORT.
;        4.1  SORT/MERGE Initialization .........................   6
;        4.2  Count Number of Input Files .......................   9
;        4.3  Find next input merge file ........................  12
;   5  RELES.
;        5.1  Add Input Record to Tree ..........................  14
;   6  MCLOS. CLOSE OUT INPUT MERGE FILE ........................  17
;   7  MERGE.
;        7.1  Simulate Master End of File .......................  18
;   8  RETRN.
;        8.1  Copy Records From Tree to Output File .............  19
;   9  ENDS.
;        9.1  Clean Up After Sort or Merge ......................  20
;  10  ACCUMULATOR SAVING ROUTINES ..............................  22
;  11  ROUTINE TO DO COMPARES IN COBOL SORT .....................  23
;  12  ERROR MESSAGES ...........................................  24

SUBTTL	DEFINITIONS -- Flags, Entry Points and Macros

	SEARCH	FTDEFS			;GET COBOL FILE-TABLE DEFINITIONS
	IXMASK==777760,,-1		;USED TO REMOVE INDEX FIELD FROM FTDEFS BYTE POINTERS

	ENTRY	PSORT.,RELES.,MERGE.,RETRN.,ENDS.,PMERG.,MCLOS.
IFE FTNZSEC,<
	EXTERN	FUNCT.,STOPR.,KEYCV.,MEMRY%	;[C20] [C19]
>
IFE FTOPS20,<
	EXTERN	FSLOC.				;[C20]
>

	WSCBIT==1B0			;WANT SEQUENCE CHECK ON MERGE

IFN FTCOBOL,<				;NOT IF COBOL-SORT = STAND-ALONE SORT
DEFINE	COMPARE(R,J)<
	JSP	P4,.CMPAR
>


IFN FTOPS20,<
 IFN FTNZSEC,<
	HIORG==640000			;TRY TO AVOID CASHE INTERFERENCE WITH LIBOL
	HILOC==HIORG			; BY NOT OCCUPYING SAME PAGE # AS LIBOL VECTOR AND LIBOL
 >
	LOWLOC==676000			;REDEFINE SINCE WE NEED ONLY 2 PAGES
	LOWORG==LOWLOC			;[356] NEVER GETS MODIFIED BY SEGMENT MACRO
>
IFE FTOPS20,<
LOWORG==<LOWLOC==0>			;[N07] SET DATA SECTION BASE TO ZERO
DEFINE	SEGMENT (A) <>			;ALL IN LOW SEGMENT
>
>;END IFN FTCOBOL

KEYZ	SUP,<NONE,INFORMATION,WARNING,FATAL,ALL>

SUBTTL	INTERNAL/EXTERNAL DEFINITIONS

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

;GLOBAL ROUTINES
INTERN	CBLVLN,CBLVEC
IFN FTNZSEC,<
INTERN	EOFCBL
>


;EXTERNALS

;DEFINED IN SORT
EXTERN	ACTTMP,CMPCNT,FCBORG,INPREC,IOBPW,IOBPW2,LSTREC,MAXTMP,MRGSW,NUMTMP,PSAV,RQ
EXTERN	NUMENT,NUMINP,OUTREC,RECORD,REKSIZ,STRNAM,STRNUM,TCBIDX,TMPFCB,WSCSW,XTRWRD,$RETRN
EXTERN	CLSRUN,CPOPJ,CPOPJ1,CPUTST,E$$RNI,E$$TMT,FSTRUN,GETJOB,INITRE,MERGE%,PTTREC
EXTERN	PSORT%,RELES%,RETRN%,RETRN0,RETRN1,RSTSPC,SETMRG,SETSPC,SETTRE,SSTATS,STATS
EXTERN	%ERMSG,%TDECW,%TCRLF,%TSIXN,%TSTRG

;DEFINED IN SRTJSS
EXTERN	DELFIL,CHKCOR,RESET$

;DEFINED IN SRTSTA
IFE FTCOBOL,<
EXTERN	.CMPAR
>

SUBTTL	DEFINITIONS -- Impure Data

	SEGMENT	IMPURE		;[C20]

ZCOR:!				;START OF DATA TO CLEAR
	LD	($RELES,1)	;WHERE TO GO ON RELES.
	LD	(KEYLOC,1)	;LOCATION OF THE KEYS AFTER CONVERSION
	LD	(SDFILE,1)	;LOCATION OF SD FILE TABLE
	LD	(OLDNXT,1)	;ORIGINAL VALUE OF NEXT SD TABLE
	LD	(NEWREC,1)	;CONTAINS SD RECORD ADDRESS
	LD	(LASRET,1)	;FLAGS END OF RETURNS
	LD	(MRGCNT,1)	;COUNT OF FILES TO OPEN INITIALLY
	LD	(MLTPAS,1)	;[327] -1 IF WE NEEDED MULTI-PASS FOR MERGE
	LD	(LASPAS,1)	;[327] -1 IF ON LAST PASS OF MULTI-PASS MERGE
	LD	(MRGRLS,1)	;[327] ADDR OF PUSHJ P,RELES. FOR NEXT SCAN
	LD	(MRGPC,1)	;PC TO RETURN TO FOR MERGE.
	BLOCK	MX.TMP		;PC OF RELES. ROUTINES
	LD	(MRGIRC,MX.TMP)	;COUNT OF RECORDS INPUT ON EACH MERGE FILE
EZCOR==.-1			;END OF DATA TO BE ZEROED

	LD	(UR.CHN,1)	;GLOBAL VALUE CAN BE SET BY USER
	LD	(STATSW,1)	;[C20] GLOBAL VALUE CAN BE SET BY USER
	LD	(ACSAVE,5)	;SAVES LIBOL'S ACS
	LD	(SAVEL,1)	;SAVE LIBOL'S ACC L
IFN FTOPS20,<
	LD	(DEVNAM,0)	;USE SAME AREA SINCE NO CONFLICT
>
	LD	(SORTAC,2)	;SAVES SORT ACS
IFE FTNZSEC,<
	LD	(CMPRMP,2)	;EXP <PUSHJ P,RELES.>,<PUSHJ P,MERGE.>
>

IFN FTNZSEC,<
	LD	(COBRET,1)	;RETURN ADDRESS
	LD	(STOPR.,1)	;ADDRESS OF LIBOL'S ERROR ROUTINE
	LD	(KEYCV.,1)	;ADDRESS OF KEYCV.
	LD	(FUNCT.,1)	;ADDRESS OF FUNCT.
	LD	(UPMERG,1)	;EXP <PUSHJ P,PMERG.>
	LD	(CMPRMP,2)	;EXP <PUSHJ P,RELES.>,<PUSHJ P,MERGE.>

	LD	(CODSEC,1)	;LHS = SECTION # OF COBOL CODE
	GD	(COBPDP,1)	;SAVE COBOL'S PUSHDOWN STACK POINTER
	LD	(STACK,PDLEN)	;NEW STACK
>

	SEGMENT	LPURE		;[C20]

	BLOCK	1		;[427] LINK TO NEXT
	ZCOR,,EZCOR		;[427] DATA TO ZERO
	.LINK	S.LNK,.-2	;[427] TELL LINK WHAT TO DO

SUBTTL	NON-ZERO SECTION ENTRY POINTS -- TOPS-20 Entry Vector


IFN FTNZSEC,<
	SEGMENT	HPURE		;[C20]

ENTVEC:	JRST	PSORT.		;MAIN ENTRY POINT
	HALT	.		;REENTER ENTRY POINT
	EXP	V%SORT		;VERSION NUMBER
	CBLVLN,,CBLVEC		;USER COBOL ENTRY VECTOR

	ENTVLN==.-ENTVEC

CBLVEC:	EXP	0,PSORT.	;COBOL ENTRY POINTS
	EXP	0,PMERG.
	EXP	0,RELES.
	EXP	0,MERGE.
	EXP	0,MCLOS.
	EXP	0,RETRN.
	EXP	0,ENDS.

	CBLVLN==.-CBLVEC
>

SUBTTL	PSORT. -- SORT/MERGE Initialization

BEGIN;
  PROCEDURE	(PUSHJ	P,PSORT.)
PSORT.:	TDZA	P1,P1			;SORT ENTRY
PMERG.:	MOVEI	P1,1			;MERGE ENTRY
IFN FTOPS20,<
	MOVX	T1,.FHSLF		;[N13] THIS PROCESS
	RCM%				;[N13] READ INTERUPT MASK
	MOVX	T2,<1B<.ICNXP>>		;[N13] ONLY WORRY ABOUT INTERUPT ON PAGE CREATION
	AND	T2,T1			;[N13] ONLY TURN OFF IF CURRENTLY ON
	MOVX	T1,.FHSLF		;[N13] THIS PROCESS
	DIC%				;[335]   SO PA1050 WON'T BITCH AT US
	SETZM	LOWORG			;[356] CREATE 2 LOW SEGMENT PAGES
	MOVE	T3,[LOWORG,,LOWORG+1]	;[356] CLEAR THEM IN CASE NOT FIRST TIME
IFN FTCOBOL,<
	BLT	T3,LOWORG+1777		;[356] OR THEY ALREADY EXIST
>
IFE FTCOBOL,<
	BLT	T3,LOWORG+3777		;[356] OR THEY ALREADY EXIST
>
	AIC%				;[335] REACTIVATE INTERRUPTS FOR PA1050
>
IFN FTNZSEC,<
	HLLZM	L,CODSEC		;SAVE SECTION # OF COBOL CODE (SHOULD BE 1)
	MOVEM	P,COBPDP		;SAVE ORIGINAL STACK POINTER
	XMOVEI	P,STACK-1		;SET UP NEW STACK
	MOVE	T2,L			;POINT TO ARG BLOCK IN SEC ZERO
	HLRE	T1,-1(L)		;NEG ARG COUNT
	MOVN	T1,T1			;NO OF WORDS TO MOVE
	XMOVEI	T3,COBRET		;POINT TO BLOCK IN THIS SECTION
	EXTEND	T1,[XBLT]		;MOVE TO THIS SECTION
>
	MOVEM	L,SAVEL			;SAVE AC L
	MOVEI	L,ACSAVE		;GET BLT POINTER
	BLT	L,ACSAVE+4		;SAVE ACS FROM COBOL
IFE FTOPS20,<
	JSP	T4,ZDATA		;ZERO SORT DATA
>
	MOVEM	P1,MRGSW		;SAVE MERGE OR SORT
	JSP	T4,CPUTST		;[134] MAKE SURE IF CPU IS OK
IFE FTOPS20,<
	PUSHJ	P,MONSPC		;[N12] SEE IF 7-SERIES MONITOR
>
	PUSHJ	P,SSTATS		;[C20] SETUP STATS LOCS
	PUSHJ	P,SETSPC		;[C13] SETUP MEMORY LOCS
IFE FTNZSEC,<
	PUSHJ	P,CUTBAK		;REDUCE SIZE AS MUCH AS POSSIBLE
>
  IF MERGE VERB
	SKIPG	MRGSW			;[354]
	JRST	$F			;[354]
  THEN TEST TO SEE IF SHAREABLE SORT OR NOT
IFE FTNZSEC,<
 IFN FTKI10,<
	DMOVE	T1,[PUSHJ P,RELES.
		    PUSHJ P,MERGE.]	;NEEDED FOR CNTINP ROUTINE
 >
 IFE FTKI10,<
	MOVE	T1,[PUSHJ P,RELES.]
	MOVE	T2,[PUSHJ P,MERGE.]	;NEEDED FOR CNTINP ROUTINE
 >
	DMOVEM	T1,CMPRMP		;SO SAVE NON-REENTRANT VERSION
	HRRZ	T2,0(P)			;[C20] [354]
	MOVE	T1,-1(T2)		;[OK] [354] GET CALLING INST.
>
IFN FTNZSEC,<
	MOVE	T2,COBPDP		;GET CODE STACK
	HLL	T2,CODSEC		;MAKE IT GLOBAL
	HRR	T2,(T2)			;GET ADDRESS OF PC+1
	MOVE	T1,-1(T2)		;GET CALL
>
	TXNE	T1,<Z @>		;[OK] [354] WERE WE CALLED FROM COBOL OVERLAY?
	JRST	[PUSHJ P,FNDINS		;[354] YES--NEED SPECIAL CODE TO SET UP COMPARE INST
		 JRST $F]		;[354] HAVING DONE SO, LEAVE WELL ALONE
IFE FTNZSEC,<
	CAMN	T1,[PUSHJ P,PMERG.]	;[354] SEE IF NON-REENTRANT
>
IFN FTNZSEC,<
	CAMN	T1,UPMERG		;EXP <PUSHJ P,PMERG.>
>
	JRST	$F			;[354] YES IT IS
	ADDI	T1,1			;[354] CONVERT INST TO <PUSHJ P,RELES.>
	HRRM	T1,CMPRMP+0
	ADDI	T1,1			;CONVERT TO <PUSHJ P,MERGE.>
	HRRM	T1,CMPRMP+1
  FI;

;SET UP LOCATIONS IN LIBIMP AND COBOL

IFE FTNZSEC,<
	MOVEI	T2,2			;GET DISPLACEMENT
	ADDB	T2,(P)			;RESET RETURN ADDRESS
	HRRZ	T2,T2			;[C20] GET CONTENTS OF FIRST & SECOND ARGS
	DMOVE	T1,-2(T2)		;[C20]   ..
>
IFN FTNZSEC,<
	MOVE	T2,COBPDP		;GET CODE SECTION STACK POINTER
	HLL	T2,CODSEC		;MAKE IT GLOBAL
	MOVE	T1,T2			;MAKE A COPY OF PC
	HRR	T2,(T2)			;GET PC OF CALL+1
	MOVEI	T3,2			;WE NEED TO INCREMENT THE RETURN PC
	ADDM	T3,(T1)			; OVER THE TWO WORDS FOLLOWING THE CALL
	DMOVE	T1,(T2)			;GET 2 WORDS AFTER CALL
>
	TXZE	T1,WSCBIT		;WANT SEQUENCE CHECK?
	AOS	WSCSW			;YES
	HLRZM	T1,XTRWRD		;[207] SAVE THE KEY SIZE
	HRRZM	T1,SDFILE		;SAVE LOC OF SD RECORD AREA
	HLRZM	T2,KEYLOC		;SAVE LOC OF CONVERTED KEYS
	HRRZM	T2,KEYCV.		;SAVE LOC OF KEY CONVERSION CODE
IFN FTNZSEC,<
	HLLZ	T3,CODSEC		;NEED TO FIXUP GLOBAL ADDRESSES
	HLLM	T3,SDFILE		; ...
	HLLM	T3,KEYLOC		; ...
	HLLM	T3,KEYCV.		; ...
>
	HRRZ	T3,T1			;ADDRESS OF MAX RECORD SIZE
IFN FTNZSEC,<
	HLL	T3,CODSEC		;MAKE ADDRESS GLOBAL
>
	LDB	T2,[<F%BMRS>&<IXMASK>+<Z (T3)>]	;GET MAX RECORD SIZE
	HRRZM	T2,RECORD		;[207] REMEMBER MAX SIZE
	LDB	T4,[<F%ACDM>&<IXMASK>+<Z (T3)>]	;INT. RECORDING MODE
;  CASE MODE OF EBCDIC,SIXBIT,0,ASCII
	MOVE	T3,[EXP 4,1,0,5]-1(T4)	;[OK] [C03]
	MOVEM	T3,IOBPW2		;[C03] SAVE IN I/O BYTES-PER-WORD USED
	MOVE	T4,[EXP 4,6,0,5]-1(T4)	;[OK]
	MOVEM	T4,IOBPW		;[207] SAVE IN I/O BYTES-PER-WORD
	ADDI	T2,-1(T4)		;[OK] FORCE UPWARD ROUNDING
	IDIV	T2,T4			;[C20] FIND MAX WORDS/REC
	ADD	T2,XTRWRD		;[207] ADD IN THE SIZE OF THE KEY
	ADDI	T2,1			;[C20] ACCOUNT FOR THE FLAG WORD
	HRRZM	T2,REKSIZ		;SAVE NUMBER OF WORDS/REC
	MOVE	T1,SDFILE		;GET SORT FILE RECORD ADDRESS
	LDB	T2,[<F%BREC>&<IXMASK>+<Z (T1)>]	;GET ADDRESS OF RECORD AREA
IFN FTNZSEC,<
	HLL	T2,T1			;MAKE ADDRESS GLOBAL
>
	MOVEM	T2,NEWREC		;SAVE IN LIBIMP
	LDB	T2,[<F%BNFT>&<IXMASK>+<Z (T1)>]	;GET LINK TO NEXT FILE TABLE
IFN FTNZSEC,<
	HLL	T2,T1			;MAKE ADDRESS GLOBAL
>
	MOVEM	T2,OLDNXT		;SAVE IN LIBIMP
IFN FTOPS20,<
	MOVEI	T1,MX.TMP		;[C19] GET MAXIMUM TEMP FILES
>
IFE FTOPS20,<
	PUSHJ	P,SETCHN		;[C19] SETUP CHANNEL ALLOCATOR
	MOVE	T1,CHNFRE		;[C19] GET CHANNELS AVAILABLE
>
	MOVEM	T1,MAXTMP		;[C19] THIS IS MAX TEMP FILES
	MOVN	T1,MAXTMP		;[C19] MAKE AN AOBJ POINTER
	HRLZM	T1,TCBIDX		;[C19] PUT IT AWAY FOR LATER

BEGIN
	;FIND THE NAMES OF THE STRUCTURES TO BE USED FOR THE TEMPORARY FILES

	MOVE	T1,SDFILE		;[C20] GET ADDRESS OF SD FILE BLOCK
	LDB	T2,[<F%BNOD>&<IXMASK>+<Z (T1)>]	;GET NUMBER OF TEMP DEVICES
	CAMG	T2,MAXTMP		;TOO MANY?
	JRST	$1			;NO
	PUSHJ	P,E$$TMT		;YES, WARN USER
	MOVE	T2,MAXTMP		;USE WHAT WE CAN
  $1%	MOVEM	T2,STRNUM		;SAVE
	MOVN	T2,T2			;MAKE AOBJN POINTER
	HRLZ	T2,T2
IFE FTOPS20,<
	LDB	T1,[<F%BDNM>&<IXMASK>+<Z (T1)>]	;ADDRESS OF SCRATCH DEVICE NAMES
  $2%	MOVE	T3,(T1)			;[OK] GET THE SCRATCH DEVICE NAME
	PUSH	P,T3			;SAVE FOR NOW
	DEVCHR	T3,			;GET DEVICE CHARACTERISTICS
	JUMPE	T3,E$$DNE		;NONE-EXISTENT DEVICE
	TXNN	T3,DV.DSK		;IS IT A DISK STRUCTURE?
	JRST	E$$DND			;NO, CAN'T USE IT
	HRRZ	T3,T2			;[C20] SAVE THE DEVICE NAME
	POP	P,STRNAM(T3)		;[C20]   ..
	ADDI	T1,1			;POINT TO THE NEXT NAME
	AOBJN	T2,$2			;PUT IN THE NEXT(IF ANY)
>
IFN FTOPS20,<
	LDB	P1,[<F%BDNM>&<IXMASK>+<Z (T1)>]	;ADDRESS OF SCRATCH DEVICE NAMES
 IFN FTNZSEC,<
	HLL	P1,T1			;MAKE GLOBAL
 >
	MOVE	P2,T2
  $2%	MOVE	T2,(P1)			;[OK] GET THE SCRATCH DEVICE NAME
	SETZB	T1,DEVNAM		;INITIALIZE
	SETZM	DEVNAM+1		;...
	MOVE	T3,[POINT 7,DEVNAM]
  $5%	SETZ	T1,			;CLEAR FOR NEXT CHAR
	LSHC	T1,6			;GET NEXT CHAR.
	ADDI	T1," "			;CONVERT TO ASCII
	IDPB	T1,T3			;STORE
	JUMPN	T2,$5			;LOOP
	MOVEI	T1,":"
	IDPB	T1,T3
	MOVE	T1,[POINT 7,DEVNAM]
	STDEV%				;[335] TRANSLATE
	  JRST	E$$DNE			;DEVICE DOES NOT EXIST
	MOVE	T1,T2			;GET DESIGNATOR
	DVCHR%				;[335] GET DEVICE CHARACTERISTICS
	  ERJMP	E$$DND			;ERROR
	TXNE	T2,DV%TYP		;IS IT A DISK STRUCTURE?
	JRST	E$$DND			;NO, CAN'T USE IT
	SETZ	T1,			;NO FLAGS
	MOVE	T2,[POINT 7,DEVNAM]
	RCDIR%				;[335] GET DIRECTORY NUMBER
	  ERJMP	E$$DND			;CANNOT HAPPEN!
	HRRZ	T1,P2			;[C20] SAVE THE DIRECTORY NUMBER
	MOVEM	T3,STRNAM(T1)		;[C20]   ..
	ADDI	P1,1			;POINT TO THE NEXT NAME
	AOBJN	P2,$2			;PUT IN THE NEXT(IF ANY)
>
	;NOW SEE IF THEY ARE ALL IDENTICAL
	MOVN	T1,STRNUM		;NO. TO LOOK AT
	HRLZ	T1,T1			;AOBJN PTR
	MOVE	T2,STRNAM+0		;GET FIRST
	AOBJP	T1,$4			;ALL DONE
  $3%	HRRZ	T3,T1			;[C20] IDENTICAL?
	CAME	T2,STRNAM(T3)		;[C20]   ..
	JRST	$E			;[214] NO,SO GIVE UP
	AOBJN	T1,$3			;YES, TRY AGAIN
	MOVEI	T1,1
	MOVEM	T1,STRNUM		;LEAVE ONLY ONE
  $4%
IFE FTOPS20,<
	MOVE	T1,[1,,T2]		;[214] SEE IF LONELY STR IS GENERIC DSK:
	DSKCHR	T1,			;[214]   ..
	  JRST	$E			;[214]   MUST NOT BE
	TXNN	T1,DC.TYP		;[214]   ..
	SETOM	STRDEF			;[214] YES--ACT AS IF STR WAS DEFAULTED
>
ENDB;

;SETUP COMPARE CODE

BEGIN;
IFN FTCOBOL,<
	MOVE	T1,[.KLCMP,,.CMPAR]	;[433] MOVE CODE TO IMPURE SEGMENT
	BLT	T1,.CMPAR+KL.CL-1	;[433] ...
	MOVN	T1,XTRWRD		;[207]
	HRRM	T1,KLCMP1
>
IFE FTCOBOL,<
	MOVE	T1,[.KLCMP,,%CMPAR]	;[433] MOVE CODE TO IMPURE SEGMENT
	BLT	T1,%CMPAR+KL.CL-1	;[433] ...
	MOVN	T1,XTRWRD		;[207]
	HRRM	T1,%CMPAR+KLCMP1
	XMOVEI	T1,%CMPAR
	MOVEM	T1,.CMPAR		;NEED TO GO INDIRECT
	HRRZ	T1,T1			;LOCAL ADDRESS
	ADDM	T1,%CMPAR+KLCMP3	;FIXUP ADDRESSES
	ADDM	T1,%CMPAR+KLCMP4	;...
>

ENDB;

SUBTTL	PSORT. -- Count Number of Input Files

BEGIN
  IF SORT (I.E. NOT MERGE)
	SKIPLE	MRGSW			;IF SORT
	JRST	$T			;NO
  THEN SETUP $RELES AND RETURN
	MOVEI	T1,RELES%
	MOVEM	T1,$RELES
	JRST	$F
  ELSE SETUP FOR MERGE
	SETZM	NUMINP			;[327] START WITH ZERO
IFE FTNZSEC,<
	HRRZ	T1,(P)			;[C20] [327] START LOOKING AT RETURN ADDR
>
IFN FTNZSEC,<
	MOVE	T1,COBPDP		;GET CODE STACK
	HLL	T1,CODSEC		;MAKE GLOBAL
	HRR	T1,(T1)			;GET ADDRESS OF INSTRUCTION SEQ.
>
	HRR	T1,(T1)			;BYPASS THE KEY EXTRACT CODE, GO TO TARGET OF JRST
  WHILE THERE ARE FILES TO COUNT
	BEGIN
		PUSHJ	P,FNDNXT		;[327] LOOK FOR PUSHJ P,RELES.
		  JRST	$E			;[327] NO MORE--DONE
		AOS	NUMINP			;[327] GOT ONE--COUNT IT
		MOVE	T1,T2			;[C20] [327] LOOK SOME MORE
		JRST	$B			;[327] LOOP FOR ANOTHER
	ENDB;
	MOVEM	T2,MRGPC+0		;[327] SAVE MERGE. ADDR FOR LATER
	MOVE	T2,NUMINP		;[N02] GET NUMBER OF MERGE FILES
	CAIGE	T2,2			;[N02] NEED AT LEAST TWO
	JRST	E$$ATF			;[N02] NO, SO GIVE ERROR
	PUSHJ	P,SETMRG		;SETUP NUMRCB ETC.
	MOVN	T1,ACTTMP		;GET MAX. NO. OF TEMP FILE
	HRLZ	T1,T1
	MOVEM	T1,TCBIDX		;RESET NUMBER OF TEMP FILES
	ADDI	T1,1			;FIRST IS OUTPUT
	MOVEM	T1,MRGCNT		;REST TO DO
	MOVEI	T1,CPOPJ
	MOVEM	T1,$RETRN		;
	MOVEI	T1,RELESI		;SETUP TO INITIALIZE
	MOVEM	T1,$RELES
  FI;
ENDB;

	PUSHJ	P,GETJOB 		;GET JOB NUMBER

IFE FTOPS20,<
	MOVEM	T1,FSLOC.		;[C20] [320] TELL FUNCT. SORT IS IN PROGRESS
>

;CALCULATE CORE REQUIREMENTS

  IF USER SET MEMORY LIMIT
IFE FTNZSEC,<
	MOVE	T1,MEMRY%		;[C20] [C13] GET COBOL MEMORY LIMIT
	HRRZ	T1,(T1)			;[C20]   ..
	CAIN	T1,-1			;[C13] DEFAULT?
>
	JRST	$T			;[C13] YES
  THEN USE IT
	PUSHJ	P,RSTSPC		;[C13] RE-SETUP AVAILABLE MEMORY
	JRST	$F

  ELSE USE THE DEFAULT
IFE FTOPS20,<
	PUSHJ	P,DEFCOR		;USE DEFAULT CORE ALGORITHM
>
  FI;

IFN FTOPS20,<
	PUSHJ	P,CHKCOR		;USE DEFAULT CORE ALGORITHM
>
IFE FTOPS20,<
	PUSHJ	P,TSTSIZ		;MAKE SURE ITS BIG ENOUGH
>
	PUSHJ	P,PSORT%		;JOIN COMMON CODE
	MOVE	L,SAVEL			;RESTORE L
	PJRST	.RESTR			;RESTORE COBOL'S AC'S THEN RETURN
ENDB;

;THE CALLING SEQUENCE USED BY THE MERGE STATEMENT IN COBOL IS RATHER COMPLEX.
;PART OF THE REASON IS THAT SORT, THE INPUT FILE PROCEDURES AND THE OUTPUT
;PROCEDURE WOULD LIKE TO BE CO-ROUTINES, BUT THE STANDARD COBOL CALLING SEQUENCE
;(MOVEI 16,ARGBLK; PUSHJ 17,SUBR) DOES NOT ALLOW THIS. ALSO, THE COMPILER
;GENERATES CLOSED LOOPS FOR EACH INPUT FILE'S RELEASE PROCEDURE, BUT SORT WANTS
;TO CHOOSE THE FILE FROM WHICH TO READ THE NEXT RECORD. THUS, SORT DOES A LOT OF
;STACK UNBINDING AND ANALYSIS OF THE COBOL PROGRAM'S CODE TO IMPLEMENT MERGES.
;AS A RESULT, THE SUCCESS OF MERGE DEPENDS ON THE EXACT FORMAT OF THE CODE
;PRODUCED BY COBOL. THIS IS WHAT SORT EXPECTS:
;
;	PUSHJ	P,PMERG.		;INITIALIZE FOR A MERGE
;	<# WDS EXTRACTED KEYS>,,<ADDR OF SD> ;ARGUMENTS FOR MERGE
;	<ADDR OF CONVERTED KEYS>,,<ADDR OF KEY CONVERSION ROUTINE>
;	.
;	.
;	.
;	INSTR				;OPEN ROUTINE FOR FIRST INPUT FILE
;	INSTR				;  WHICH IS 2 WORDS LONG
; %1:	INSTR				;FIRST INPUT FILE'S RELEASE ROUTINE
;	...
;	PUSHJ	P,RELES.		;CALL SORT WITH RECORD
;	JRST	%1			;LOOP FOR NEXT INPUT RECORD
;	...
;	PUSHJ	P,MCLOS.		;CALL SORT INDICATING FIRST FILE IS DONE
;	.
;	.
;	.
;	INSTR				;OPEN ROUTINE FOR SECOND INPUT FILE
;	INSTR				;  WHICH IS ALSO 2 WORDS LONG
; %2:	INSTR				;SECOND INPUT FILE'S RELEASE ROUTINE
;	...
;	PUSHJ	P,RELES.		;CALL SORT WITH RECORD
;	JRST	%2			;LOOP FOR NEXT INPUT RECORD
;	...
;	PUSHJ	P,MCLOS.		;CALL SORT INDICATING SECOND FILE IS DONE
;	.
;	.				;MORE INPUT FILE RELEASE ROUTINES
;	.
;	PUSHJ	P,MERGE.		;TELL SORT THERE ARE NO MORE INPUT FILES
;
;SORT FINDS THE RELEASE ROUTINES BY LOOKING FOR <PUSHJ P,RELES.> INSTRUCTIONS
;BETWEEN THE RETURN ADDRESS FOR THE PMERG. CALL AND THE FIRST SUBSEQUENT
;<PUSHJ P,MERGE.>. THE ENTRIES FOR THESE RELEASE ROUTINES ARE THEN POINTED TO BY
;THE FOLLOWING <JRST %N> INSTRUCTION. THE OPEN ROUTINES FOR EACH FILE ARE THEN 2
;INSTRUCTIONS BEFORE THE BEGINNING OF THE ASSOCIATED RELEASE ROUTINES. SORT
;KNOWS THAT A FILE HAS REACHED END OF FILE WHEN IT 'CALLS' THE RELEASE ROUTINE
;FOR A RECORD AND CONTROL RETURNS TO MCLOS. RATHER THAN RELES.

SUBTTL	PSORT. -- Find next input merge file

BEGIN;
  PROCEDURE	(PUSHJ	P,FNDNXT)	;[327] FIND NEXT INPUT FILE

;FNDNXT STARTS LOOKING AT A SPECIFIED ADDRESS IN THE USER'S COBOL PROGRAM
;FOR CALLS TO SORT'S RELES. ENTRY POINT. EACH ONE WE FIND BETWEEN THE CALL
;TO PMERG. AND THE CALL TO MERGE. REPRESENTS AN INPUT FILE.
;
;CALL WITH:
;	T1/	ADDRESS TO START SEARCH (SKIPS FIRST LOCATION)
;RETURNS:
;	T1/	UNCHANGED
;	T2/	ADDRESS OF NEXT RELES. OR MERGE. CALL
;
;FNDNXT GIVES A SKIP RETURN IF T2 CONTAINS THE ADDRESS OF THE NEXT RELES. CALL,
;AND A NON-SKIP RETURN IF T2 IS THE ADDRESS OF THE MERGE. CALL. DESTROYS T3.

	XMOVEI	T2,1(T1)		;[OK] [327] START AT ADDR+1
  WHILE NOT PUSHJ P,RELES. OR PUSHJ P,MERGE.
	BEGIN
		MOVE	T3,(T2)			;[OK] [327] GET NEXT INSTRUCTION
		CAMN	T3,CMPRMP+1		;[327] IS IT PUSHJ P,MERGE.?
		JRST	$E			;[327] YES--DONE
		CAMN	T3,CMPRMP+0		;[327] OR PUSHJ P,RELES.?
		AOSA	(P)			;[327] YES--SKIP RETURN
		AOJA	T2,$B			;[327] NO--LOOP FOR NEXT INSTR
	ENDB;
	RETURN				;[327] DONE
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,FNDINS)	;[354]

;IN THE CASE OF NON-RESIDENT CALL TO MERGE FNDINS SETS UP THE COMPARE LOCATIONS
;USED LATER BY FNDNXT THE PROBLEM IS THAT THE CALLS TO MERGE. AND RELES. ARE
;INDIRECT THROUGH THE RESIDENT SECTION AND ARE THUS HARD TO IDENTIFY.
;
;CALL WITH:
;	T1/	WORD POINTED TO BY T2
;	T2/	ADDRESS TO START SEARCH (SKIPS FIRST LOCATION)

  IF NON-REENTRANT CALLING SEQUENCE (NOT /R IN COBOL)
	HRRZS	T1			;[C20] GET ADDRESS
	MOVE	T1,(T1)			;[C20] [354]   ..
	CAIN	T1,PMERG.		;[354]
	JRST	$T			;[354] /R CODE
  THEN
	  WHILE NOT PUSHJ P,RELES. OR PUSHJ P,MERGE.
		BEGIN
			HLRZ	T1,(T2)		;[OK] [354] GET NEXT INSTRUCTION
			CAIE	T1,(PUSHJ P,@)	;[354] IS IT A POSSIBLE CANDIDATE
			AOJA	T2,$B		;[354] NO KEEP LOOKING
			HRRZ	T1,(T2)		;[C20] [354] GET ADDRESS
			TLO	T1,(IFIW)	;[C20]   ..
			HRRZ	T1,@T1		;[C20]   ..
			CAIN	T1,MERGE.	;[354] IS IT MERGE.
			JRST	$1		;[354] YES
			CAIE	T1,RELES.	;[354] NO, IS IT RELES. THEN?
			AOJA	T2,$B		;[354] NOT YET
			MOVE	T1,(T2)		;[OK] [354] GET INST
			MOVEM	T1,CMPRMP+0	;[354] SAVE IT
			AOJA	T2,$B		;[354] NOW LOOK FOR MERGE.
		  $1%	MOVE	T1,(T2)		;[OK] [354] GET INST
			MOVEM	T1,CMPRMP+1	;[354] SAVE IT
			RETURN			;[354] DONE
		ENDB;
  ELSE ITS /R CODE
	  WHILE NOT PUSHJ P,RELES. OR PUSHJ P,MERGE.
		BEGIN
			HLRZ	T1,(T2)		;[OK] [354] GET NEXT INSTRUCTION
			CAIE	T1,(PUSHJ P,@)	;[354] IS IT A POSSIBLE CANDIDATE
			AOJA	T2,$B		;[354] NO KEEP LOOKING
			HRRZ	T1,(T2)		;[C20] [354] GET ADDRESS
			TLO	T1,(IFIW)	;[C20]   ..
			HRRZ	T1,@T1		;[C20]   ..
			CAIN	T1,MERGE.	;[354] IS IT MERGE.
			JRST	$1		;[354] YES
			CAIE	T1,RELES.	;[354] NO, IS IT RELES. THEN?
			AOJA	T2,$B		;[354] NOT YET
			MOVE	T1,(T2)		;[OK] [354] GET INST
			MOVEM	T1,CMPRMP+0	;[354] SAVE IT
			AOJA	T2,$B		;[354] NOW LOOK FOR MERGE.
		  $1%	MOVE	T1,(T2)		;[OK] [354] GET INST
			MOVEM	T1,CMPRMP+1	;[354] SAVE IT
			RETURN			;[354] DONE
		ENDB;
  FI;
ENDB;

SUBTTL	RELES. -- Add Input Record to Tree

BEGIN;
  PROCEDURE	(PUSHJ	P,RELES.)
	SKIPN	T4,KEYCV.		;IS THE SORT ACTIVE?
	  PJRST	E$$RLO			;[151] NO-AN ERROR
	MOVEM	L,SAVEL			;[207] SAVE REAL RECORD LENGTH
IFN FTNZSEC,<
	MOVEM	P,COBPDP		;SAVE ORIGINAL STACK POINTER
	XMOVEI	P,STACK-1		;SET UP NEW STACK
>
	PUSHJ	P,(T4)			;[C20] CONVERT THE KEYS
	JSP	P4,.SAVE		;EXCHANGE AC BLOCKS
IFE FTNZSEC,<
	HRLZ	T1,KEYLOC		;GET THE LOCATION OF THE KEYS
	HRRI	T1,RC.KEY(R)		;GET START OF THE RECORD
	HRRZ	T2,XTRWRD		;[207] GET THE SIZE OF THE KEYS
	ADDI	T2,RC.KEY(R)		;GET THE LAST ADR FOR THE KEYS
	BLT	T1,-1(T2)		;[OK] PUT IN PLACE
	MOVE	T1,T2			;[C20] GET DESTINATION FOR THE DATA
	HRL	T1,NEWREC		;GET SD RECORD ADDRESS
	ADD	T2,SAVEL		;[217] ADD LENGTH OF RECORD
	BLT	T1,-1(T2)		;[OK] [207] AND SAVE IN PLACE
>
IFN FTNZSEC,<
	HRRZ	T1,XTRWRD		;GET THE SIZE OF THE KEYS
	MOVE	T2,KEYLOC		;GET THE LOCATION OF THE KEYS
	XMOVEI	T3,RC.KEY(R)		;GET START OF THE RECORD
	EXTEND	T1,[XBLT]		;PUT IN PLACE
	MOVE	T1,SAVEL		;ADD LENGTH OF RECORD
	MOVE	T2,NEWREC		;GET SD RECORD ADDRESS
	EXTEND	T1,[XBLT]		;AND SAVE IN PLACE
>
	MOVE	T1,SAVEL		;[207] GET RECORD LENGTH IN WORDS
	IMUL	T1,IOBPW		;[207] GET IT IN BYTES
	MOVEM	T1,RC.CNT(R)		;MAKE IT THE CONTROL WORD
	AOS	INPREC			;COUNT RECORDS ON WAY IN
	MOVE	T1,$RELES		;[C20] GOTO RIGHT ROUTINE
	PJRST	(T1)			;[C20]   ..
ENDB;


BEGIN;
  PROCEDURE	(PUSHJ	P,RELESI)
	HRRZ	T1,MRGCNT		;[C20]
IFE FTNZSEC,<
	HRRZ	T2,-1(P)		;[C20] [327] GET RELES. RETURN ADDRESS
	HRRZ	T2,(T2)			;[OK] [327]   WHERE THERE'S A JRST
>
IFN FTNZSEC,<
	MOVE	T2,COBPDP		;GET CODE STACK
	HLL	T2,CODSEC		;MAKE IT GLOBAL
	HRR	T2,(T2)			;GET PC OFF STACK
	HRR	T2,(T2)			;GET <JRST ADDRESS>
>
	MOVEM	T2,MRGPC(T1)		;[OK] [327]   TO TOP OF COBOL INPUT PROC
	SOS	NUMINP			;[327] COUNT ANOTHER FILE USED
	HRLM	T1,RN.FCB(S)		;STORE INDEX
	AOS	MRGIRC-1(T1)		;[OK] COUNT FIRST RECORD
	MOVE	T1,[XWD 1,1]		;[C20]
	ADDM	T1,MRGCNT		;[C20]
	AOS	RQ			;MAKE 1ST RUN
	PUSHJ	P,SETTRE		;PUT RECORD IN TREE
;	PJRST	NXMFIL			;[327] GO SET UP NEXT MERGE FILE
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,NXMFIL)	;[327] SET UP NEXT MERGE FILE
  IF WE CAN STILL INITIALIZE
	SKIPGE	MRGCNT			;[327] WILL MORE FILES FIT?
	SKIPN	NUMINP			;[327]   AND MORE FILES TO USE?
	JRST	$T			;[327] NO--GO START UP MERGE
  THEN CONTINUE WITH NEXT FILE
IFE FTNZSEC,<
	HRRZ	T1,-1(P)		;[C20] [327] GET RETURN FROM RELES. OR MCLOS.
>
IFN FTNZSEC,<
	MOVE	T1,COBPDP		;GET CODE STACK
	HLL	T1,CODSEC		;MAKE IT GLOBAL
	HRR	T1,(T1)			;GET PC OFF STACK
>
	PUSHJ	P,FNDNXT		;[327] FIND NEXT PUSHJ P,RELES.
	  NOOP				;[327] THERE IS STILL AT LEAST 1
	MOVEM	T2,MRGRLS		;[327] SAVE IN CASE LAST BEFORE MERGE
	HRRZ	T2,1(T2)		;[OK] [327] GET ADDR OF INPUT PROC FROM JRST
	SUBI	T2,2			;GET TO OPEN 
	JRST	$F
  ELSE SETUP TO RETURN TO MERGE.
	HRRZS	LSTREC			;CLEAR LEFT HALF
	  IF THERE ARE HOLES IN THE TREE (SOME FILES WERE NULL ON LAST PASS)
		SKIPL	T1,MRGCNT		;[327] ANY HOLES LEFT IN THE TREE?
		JRST	$F			;[327] NO
	  THEN FILL UP TREE WITH EOF RECORDS
	  $1%  	MOVEM	T1,MRGCNT		;[327] SAVE MRGCNT OVER SETTRE
		SOS	ACTTMP			;[327] ONE LESS ACTIVE FILE
		HLLOS	RQ			;[327] SET DUMMY REC IN TREE
		PUSHJ	P,SETTRE		;[327]   ..
		MOVE	T1,MRGCNT		;[327] LOOP 'TIL TREE FULL
		AOBJN	T1,$1			;[327]   ..
	  FI;
	  	MOVEM	T1,MRGCNT		;[327] SAVE COMPLETED COUNT
	  IF EXACTLY ONE PASS (CAN RETURN RECORDS NOW)
		SKIPN	MLTPAS			;[327] ALREADY MULTI-PASS?
		SKIPE	NUMINP			;[327]   OR MORE FILES TO MERGE
		JRST	$T			;[327] YES--NOT 1 PASS
	  THEN SET TO RETURN RECORDS TO COBOL NOW
		MOVEI	T1,RELES1		;1 PASS
		SKIPLE	WSCSW			;NEED MERGE CHECK
		MOVEI	T1,RELCK1		;YES, CHECK FIRST
		MOVE	T2,MRGPC+0		;GET MERGE. PC
		JRST	$F
	  ELSE SET UP FOR ANOTHER TEMP FILE
		MOVEI	F,FCBORG		;[327] START A RUN
		  IF WE NEED TO START TEMP FILES
			SKIPE	MLTPAS			;[327] ALREADY BEEN HERE?
			JRST	$F			;[327] YES--SKIP THIS
		  THEN SET UP THE FIRST TEMP FILE
			PUSHJ	P,FSTRUN		;[327] INITIALIZE FIRST RUN
			SETOM	MLTPAS			;[327] REMEMBER WE'VE BEEN HERE
		  FI;
		JSP	P4,PTTREC		;WRITE OUT RECORD
		MOVEI	T1,RELES2		;MERGE PASSES REQUIRED
		HLRZ	T2,RN.FCB(S)		;GET INDEX
		MOVE	T2,MRGPC(T2)		;[OK] PC OF INPUT ROUTINE
		SKIPG	WSCSW			;NEED SEQUENCE CHECK?
		JRST	$F			;NO, GET THE NEXT RECORD
		EXCH	R,LSTREC		;YES, SAVE THIS RECORD
		HRRM	R,RN.REC(S)
		MOVEI	T1,RELCK2		;CAUSE CHECKING TO TAKE PLACE
	  FI;
	MOVEM	T1,$RELES
  FI;
IFE FTNZSEC,<
	MOVE	T1,PSAV			;GET ORIGINAL STACK POINTER
	HRRM	T2,-1(T1)		;[OK] SET NEW RETURN
>
IFN FTNZSEC,<
	MOVE	T1,COBPDP		;GET CODE STACK
	HLL	T1,CODSEC		;MAKE IT GLOBAL
	HRRM	T2,(T1)			;SET NEW RETURN ADDRESS TO USER CODE
>
	RETURN
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,RELCK1)
	MOVE	J,LSTREC		;GET LAST RECORD
	HLRZ	F,RN.FCB(S)		;GET INDEX TO FILE
	AOS	MRGIRC-1(F)		;COUNT ONE MORE
	COMPARE	(R,J)
	  JRST	$E			;KEY(R) = KEY(J)	;OK
	  JRST	$E			;KEY(R) > KEY(J)	;OK
	  PUSHJ P,SEQERR		;KEY(R) < KEY(J)	;OUT OF SEQUENCE
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,RELES1)

	PUSHJ	P,SETTRE
	PJRST	RETRND			;CONTINUE WITH RETRN. CODE
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,RELCK2)
	MOVE	J,LSTREC		;GET LAST RECORD
	HLRZ	F,RN.FCB(S)		;GET INDEX TO FILE
	AOS	MRGIRC-1(F)		;COUNT ONE MORE
	COMPARE	(R,J)
	  JRST	$E			;KEY(R) = KEY(J)	;OK
	  JRST	$E			;KEY(R) > KEY(J)	;OK
	  PUSHJ P,SEQERR		;KEY(R) < KEY(J)	;OUT OF SEQUENCE
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,RELES2)
	PUSHJ	P,SETTRE
	MOVEI	F,FCBORG
	JSP	P4,PTTREC	;WRITE OUT RECORD
	HLRZ	T2,RN.FCB(S)
	MOVE	T2,MRGPC(T2)		;[OK]
	MOVE	T1,PSAV			;GET ORIGINAL STACK POINTER
	HRRM	T2,-1(T1)		;[OK] SET NEW RETURN
	SKIPG	WSCSW			;NEED SEQUENCE CHECK?
	RETURN				;NO, GET THE NEXT RECORD
	EXCH	R,LSTREC		;YES, SAVE THIS RECORD
	HRRM	R,RN.REC(S)
	RETURN
ENDB;


BEGIN;
  PROCEDURE	(PUSHJ	P,RELCK0)
	MOVE	J,LSTREC		;GET LAST RECORD
	AOS	MRGIRC+0		;COUNT ONE MORE
	COMPARE	(R,J)
	  JRST	$E			;KEY(R) = KEY(J)	;OK
	  JRST	$E			;KEY(R) > KEY(J)	;OK
	  MOVE T1,MRGIRC+0		;KEY(R) < KEY(J)	;OUT OF SEQUENCE
	SOJE	T1,RELES0		;BUT IGNORE FIRST TIME
	PUSHJ	P,SEQERR
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,RELES0)
	MOVEI	F,FCBORG
	JSP	P4,PTTREC	;WRITE OUT RECORD
	HLRZ	T2,RN.FCB(S)
	MOVE	T2,MRGPC(T2)		;[OK]
	MOVE	T1,PSAV			;GET ORIGINAL STACK POINTER
	HRRM	T2,-1(T1)		;[OK] SET NEW RETURN
	SKIPG	WSCSW			;NEED SEQUENCE CHECK?
	RETURN				;NO, GET THE NEXT RECORD
	EXCH	R,LSTREC		;YES, SAVE THIS RECORD
	HRRM	R,RN.REC(S)
	RETURN
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,SEQERR)
	HLRZ	F,RN.FCB(S)	;GET FILE INDEX
	$ERROR	(%,MRS,<MERGE record >,+)
	$MORE	(DECIMAL,MRGIRC-1(F))
	$MORE	(TEXT,< not in sequence for >)
	MOVE	T1,MRGPC(F)	;[C20] GET POINTER FILE NAME
	HRRZ	T1,(T1)		;[C20]   ..
	MOVE	T1,(T1)		;[OK] GET FILE NAME
	$MORE	(SIXBIT,T1)
	$CRLF
	RETURN
ENDB;

SUBTTL	MCLOS. CLOSE OUT INPUT MERGE FILE

BEGIN
  PROCEDURE	(PUSHJ	P,MCLOS.)
IFN FTNZSEC,<
	MOVEM	P,COBPDP		;SAVE ORIGINAL STACK POINTER
	XMOVEI	P,STACK-1		;SET UP NEW STACK
>
	JSP	P4,.SAVE		;GET SORT ACCS
  IF STILL INITIALIZING FILES IN RELESI
	SKIPL	MRGCNT			;[327] STILL INITIALIZING?
	JRST	$T			;[327] NO
  THEN PASS THIS FILE (IGNORE IT) AND CONTINUE WITH NEXT
	SOS	NUMINP			;[327] FORGET THIS FILE
	PJRST	NXMFIL			;[327] GO GET ANOTHER
  ELSE CLOSE THE FILE AND SEE WHAT TO DO NEXT
	HLLOS	RQ			;SET TERMINATING RUN#
	PUSHJ	P,SETTRE		;PUT END IN TREE
	  IF NOT LAST FILE
		SOSG	ACTTMP			;ALL DONE?
		JRST	$T			;YES
	  THEN CLOSE FILE AND CONTINUE
		MOVEI	F,FCBORG
		SKIPN	NUMENT			;IF MULTI-PASS
		JRST	RETRND			;NO, RETURN RECORD TO USER
		JSP	P4,PTTREC		;WRITE IT OUT
		HLRZ	T1,RN.FCB(S)		;GET NEXT FILE
		MOVE	T1,MRGPC(T1)		;[OK] GET INPUT ROUTINE
IFE FTNZSEC,<
		HRRM	T1,-1(P)		;SET RETURN TO GET IT
>
IFN FTNZSEC,<
		MOVE	T2,COBPDP		;GET CODE STACK
		HLL	T2,CODSEC		;MAKE IT GLOBAL
		HRRM	T1,(T2)			;SET NEW RETURN ADDRESS TO USER CODE
>
		RETURN
	  ELSE TERMINATE CYCLE AND START AGAIN
		SETZM	MRGIRC			;CLEAR INPUT COUNTS
		MOVE	T1,[MRGIRC,,MRGIRC+1]	; SO THAT ERROR MESSAGE
		BLT	T1,MRGIRC+MX.TMP	; WILL CONTAIN CORRECT NUMBER
		  IF NO MORE TO DO
			SKIPE	T1,NUMINP		;ANY MORE
			JRST	$T			;TOO BAD
		  THEN JUST CLOSE OUT OR RETURN
			  IF END OF MULTI-PASS MERGE
				SKIPN	LASPAS			;[327] ARE WE ON LAST PASS?
				JRST	$T			;[327] NO
			  THEN CLOSE OUT (GO MERGE TEMP FILES)
				MOVE	T2,MRGPC+0		;[327] GET ADDR OF MERGE. CALL
IFE FTNZSEC,<
				MOVE	T1,PSAV			;[327]   AND RETURN TO THERE
				HRRM	T2,-1(T1)		;[OK] [327]   ..
>
IFN FTNZSEC,<
				MOVE	T1,COBPDP		;GET CODE STACK
				HLL	T1,CODSEC		;MAKE IT GLOBAL
				HRRM	T2,(T1)			;SET NEW RETURN ADDRESS TO USER CODE
>
				RETURN				;[327]   ..
			  ELSE JUST RETURN NEXT RECORD TO COBOL
				SETOM	LASRET			;FLAG IT
				PJRST	RETRND
			  FI;
		  ELSE SET UP FOR ANOTHER MERGE
			MOVEI	F,FCBORG
			PUSHJ	P,CLSRUN		;OPEN NEXT TEMP FILE
			MOVE	T1,MRGRLS		;[327] FIND NEXT RELES. ROUTINE
			PUSHJ	P,FNDNXT		;[327]   ..
			  NOOP				;[327] THERE *IS* ANOTHER
			HRRZ	T2,1(T2)		;[OK] [327] GET ADDR IN FOLLOWING JRST
			SUBI	T2,2			;[327] GET TO OPEN ROUTINE
IFE FTNZSEC,<
			MOVE	T1,PSAV			;[327] RETURN TO THERE
			HRRM	T2,-1(T1)		;[OK] [327]   ..
>
IFN FTNZSEC,<
			MOVE	T1,COBPDP		;GET CODE STACK
			HLL	T1,CODSEC		;MAKE IT GLOBAL
			HRRM	T2,(T1)			;SET NEW RETURN ADDRESS TO USER CODE
>
			  IF LAST FILE
				MOVE	T1,NUMINP		;GET NUMBER LEFT
				SOJN	T1,$T
			  THEN JUST COPY FILE TO TEMP FILE
				SETOM	LASPAS			;[327] SIGNAL END
				SETZM	NUMINP			;[327] NO MORE FILES NOW
				MOVEI	T1,1
				HRLM	T1,RN.FCB(S)		;FIRST AND ONLY FILE
				MOVEI	T1,RELES0		;USE THIS ROUTINE
				SKIPLE	WSCSW			;UNLESS CHECKING REQUIRED
				MOVEI	T1,RELCK0		;IN WHICH CASE USE THIS
				JRST	$F
			  ELSE REINITIALIZE FOR MERGE PASS
				PUSHJ	P,SETMRG		;SETUP NUMRCB AGAIN
				MOVN	T1,ACTTMP
				HRLZ	T1,T1
				ADDI	T1,1
				MOVEM	T1,MRGCNT
				MOVE	T1,NUMINP		;[327] NEED ANOTHER PASS?
				CAMG	T1,MAXTMP		;[327]   ..
				SETOM	LASPAS			;[327] NO--REMEMBER
				PUSHJ	P,INITRE		;FILL WITH NULLS
				MOVEI	T1,RELESI		;INITIALIZE AGAIN
			  FI;
			MOVEM	T1,$RELES
			RETURN
		  FI;
	  FI;
  FI;
ENDB;

SUBTTL	MERGE. -- Simulate Master End of File

BEGIN;
  PROCEDURE	(PUSHJ	P,MERGE.)
IFN FTNZSEC,<
	MOVEM	P,COBPDP		;SAVE ORIGINAL STACK POINTER
	XMOVEI	P,STACK-1		;SET UP NEW STACK
>
	JSP	P4,.SAVE		;SAVE NEEDED AC'S
	HLRZ	F,RN.FCB(S)		;GET FILE POINTER
	AOS	LASRET			;ENABLE RETURNS
  IF NOT 1 PASS /MERGE
	SKIPLE	MRGSW
	SKIPE	NUMTMP
  THEN DO MERGE
	PJRST	MERGE%			;START UP THE MERGE PHASE
  ELSE CHECK FOR ALL FILES NULL AND RETURN
	MOVE	T1,RQ			;[327] GET RUN # OF TOP RECORD
	CAIN	T1,-1			;[327] IS IT THE EOF DUMMY ONE>
	SETOM	LASRET			;[327] YES--GIVE EOF ON NEXT RETRN.
	RETURN
  FI;
ENDB;

SUBTTL	RETRN. -- Copy Records From Tree to Output File

BEGIN;
  PROCEDURE	(PUSHJ	P,RETRN.)
	SKIPN	LASRET			;RETURNS ENABLED?
	  PJRST	E$$RTO			;[151] NO, GIVE USER ERROR MESSAGE
  IF SORT OR MULTI-PASS MERGE
	SKIPLE	MRGSW			;MERGE
	SKIPE	NUMENT			;MULTI-PASS?
	JRST	$1			;SORT OR MULTI-PASS
	SKIPLE	OUTREC			;BUT NOT FIRST TIME
	JRST	$T			;YES
  $1%
  THEN RETURN RECORD FROM TEMP FILE
IFN FTNZSEC,<
	MOVEM	P,COBPDP		;SAVE ORIGINAL STACK POINTER
	XMOVEI	P,STACK-1		;SET UP NEW STACK
>
	JSP	P4,.SAVE		;EXCHANGE AC BLOCKS
	JRST	$F

  ELSE GET NEXT INPUT RECORD FOR 1 PASS MERGE
	SKIPGE	LASRET			;ALREADY OUTPUT LAST RECORD
	JRST	[SETZM	LASRET
		JRST	CPOPJ1]		;YES
	DMOVE	R,SORTAC		;[OK]
	HLRZ	F,RN.FCB(S)		;GET INDEX
	MOVE	T1,MRGPC(F)		;[C20] GET NEXT RECORD
	PJRST	(T1)			;[C20]   ..
;---------------------------------------;LONG WAIT TIL NEXT RECORD IS PROCESSED
RETRND:					;RETURN HERE FROM RELES.
IFE FTNZSEC,<
	POP	P,-1(P)			;REMOVE TOP RETURN
	MOVEM	P,PSAV			;SET RETURN TO RETRN. CALLER
>
IFN FTNZSEC,<
	MOVE	T1,COBPDP		;GET COBOL STACK POINTER
	ADJSP	T1,-1			;REMOVE TOP CALL
	MOVEM	T1,COBPDP		;RESTORE STACK POINTER
>
  FI;
IFE FTNZSEC,<
	HRRZI	T1,RC.KEY(R)		;GET ADDRESS OF INTERNAL RECORD
	ADD	T1,XTRWRD		;[207] GET PAST CONVERTED KEY
	HRLZS	T1			;PUT IN LEFT HALF
	HRR	T1,NEWREC		;GET ADR OF SD RECORD
	HRRZ	T2,REKSIZ		;GET THE NUMBER OF WORDS/RECORD
	SUB	T2,XTRWRD		;[207] ACCOUNT FOR KEYS
	ADD	T2,NEWREC		;[C20] GET LAST ADDRESS FOR BLT
	BLT	T1,-2(T2)		;[OK] RETURN RECORD TO COBOL PROGRAM
>
IFN FTNZSEC,<
	MOVE	T1,REKSIZ		;GET THE NUMBER OF WORDS/RECORD
	SUB	T1,XTRWRD		;SUBTRACT EXTRACT WORDS FOR KEY
	SUBI	T1,1			;SUBTRACT SIZE OF FLAG WORD
	XMOVEI	T2,RC.KEY(R)		;GET ADDRESS OF INTERNAL RECORD
	ADD	T2,XTRWRD		;GET PAST CONVERTED KEY
	MOVE	T3,NEWREC		;GET ADR OF SD RECORD
	EXTEND	T1,[XBLT]		;RETURN RECORD TO COBOL PROGRAM
>
  IF LAST SORT RECORD
	SKIPL	LASRET			;ANY MORE RECORDS TO RETURN?
	JRST	$T			;YES
  THEN FLAG LAST AND RETURN
	SETZM	LASRET			;STOP ALLOWING RETURNS
IFE FTNZSEC,<
	AOS	-1(P)			;GIVE SKIP RETURN TO COBOL
>
IFN FTNZSEC,<
	MOVE	T1,COBPDP		;GET CODE STACK
	HLL	T1,CODSEC		;MAKE IT GLOBAL
	AOS	(T1)			;INCREMENT PC IN USERS SECTION
>
	RETURN
  ELSE GET NEXT RECORD
	AOS	OUTREC			;COUNT ONE MORE RECORD OUTPUT 
	SKIPG	WSCSW			;NEED SEQUENCE CHECK?
	PJRST	RETRN%			;NO, GET THE NEXT RECORD
	EXCH	R,LSTREC		;YES, SAVE THIS RECORD
	HRRM	R,RN.REC(S)
	PJRST	RETRN%
 FI;
ENDB;

BEGIN;
 IFE FTNZSEC,<  PROCEDURE	(PUSHJ	P,EOFOUT)>
 IFN FTNZSEC,<  PROCEDURE	(PUSHJ	P,EOFCBL)>
	SETOM	LASRET			;WANT ONLY ONE MORE RECORD
	MOVE	P,PSAV			;RESTORE STACK POINTER
	RETURN				;AND RETURN TO COBOL
ENDB;

SUBTTL	ENDS. -- Clean Up After Sort or Merge

BEGIN;
  PROCEDURE	(PUSHJ	P,ENDS.)
	MOVEM	L,ACSAVE+5		;SAVE AC L
	MOVEI	L,ACSAVE		;SET UP BLT POINTER
	BLT	L,ACSAVE+4		;SAVE LIBOL'S ACS
IFN FTNZSEC,<
	MOVEM	P,COBPDP		;SAVE ORIGINAL STACK POINTER
	XMOVEI	P,STACK-1		;SET UP NEW STACK
>
  IF USER ROUTINE EXITED BEFORE E-O-F
	SKIPN	LASRET			;[125] DID WE END NORMALLY?
	JRST	$T			;[125] YES
  THEN DELETE ANY OPEN FILES
	MOVE	T1,$RETRN		;[125] GET WHICH RETRN WAS USED
	CAIE	T1,RETRN0		;[224] [125] ALL IN CORE?
	SKIPN	ACTTMP			;[224]   OR ALL TEMP FILES GONE ALREADY?
	JRST	$F			;[125] YES, NO FILE TO CLOSE
	DMOVE	R,SORTAC		;[OK] [125] SETUP R & S
	  IF ONE TEMP FILE
		CAIE	T1,RETRN1		;[125] 1 FILE?
		JRST	$T			;[125] NO
	  THEN JUST DELETE THIS FILE
		MOVEI	F,TMPFCB		;[125] POINTER
		PUSHJ	P,DELFIL		;[224] [125] DELETE FILE
		JRST	$F			;[125] DONE
	  ELSE DELETE ALL OPEN FILES
		BEGIN
			HLRZ	F,RN.FCB(S)		;[125] GET WHICH FILE
			PUSHJ	P,DELFIL		;[224] [125] DELETE IT
			SOSG	ACTTMP			;[224] [125] SOME LEFT?
			JRST	$E			;[125] NO
			HLLOS	RQ			;[224] FLUSH TREE
			PUSHJ	P,SETTRE		;[125] GET NEXT RECORD
			JRST	$B			;[125] LOOP
		ENDB;
	  FI;
	JRST	$F			;[125]
  ELSE MAKE SURE ALL RECORDS WERE OUTPUT
	MOVE	T1,INPREC
	CAME	T1,OUTREC
	PUSHJ	P,E$$RNI		;RECORD NUMBER INCONSISTENT
  FI;
IFE FTOPS20,<
	PUSHJ	P,RELSPC		;[C13] RELEASE ANY RETAINED MEMORY
	SETZM	FSLOC.			;[C20] [320] RESET- NO SORT IN PROGRESS
>;END IFE FTOPS20
IFN FTOPS20,<
	PUSHJ	P,RESET$		;[335] CLEAN UP CORE
>
	PUSHJ	P,STATS			;[C20] TYPE STATISTICS, IF NECESSARY
	MOVE	T1,SDFILE		;RESET SD FILE BLOCK
	HRRZ	T2,OLDNXT
	DPB	T2,[<F%BNFT>&<IXMASK>+<Z (T1)>]
	SETZM	KEYCV.			;CLEAR THIS LOCATION
	SETZM	LASRET			;STOP ALLOWING RETURNS


	MOVSI	L,ACSAVE		;SET UP BLT POINTER
	BLT	L,T4			;RESTORE LIBOL'S ACS
	MOVE	L,ACSAVE+5
IFE FTNZSEC,<
	RETURN
>
IFN FTNZSEC,<
	MOVE	P,COBPDP		;RESTORE ORIGINAL P
	JRST	@COBRET			;RETURN TO CALLER
>

IFE FTOPS20,<
E$$CLC:	$ERROR	(%,CLC,<Cannot lower core after SORT>)
	JRST	$2			;[16] CONTINUE
>
ENDB;

SUBTTL	ACCUMULATOR SAVING ROUTINES

BEGIN;
  PROCEDURE	(JSP	P4,.SAVE)
	MOVEM	T4,ACSAVE+4		;SAVE AC T4
	MOVEI	T4,ACSAVE		;SET UP BLT POINTER
	BLT	T4,ACSAVE+3		;SAVE LIBOL'S ACS
	XMOVEI	T4,.RESTR		;[C20] RETURN ADDRESS
	PUSH	P,T4			;[C20]   ..
	DMOVE	R,SORTAC		;[OK] RESTORE THE SORT ACS
	MOVEM	P,PSAV			;SAVE THE PRESENT PDL POINTER
	RETURN
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,.RESTR)
	DMOVEM	R,SORTAC		;SAVE THE SORT ACS
	MOVSI	T4,ACSAVE		;SET UP BLT POINTER
	BLT	T4,T4			;RESTORE LIBOL'S ACS
IFE FTNZSEC,<
	RETURN				;RETURN TO THE COBOL PROGRAM
>
IFN FTNZSEC,<
	MOVE	P,COBPDP		;RESTORE USER'S STACK
	JRST	@COBRET			;RETURN TO SECTION 0
>
ENDB;

SUBTTL	ROUTINE TO DO COMPARES IN COBOL SORT

;THIS ROUTINE ASSUMES USE OF COBOL KEY ROUTINE DURING THE RELEASE PHASE

IFN FTCOBOL,<
	SEGMENT	IMPURE			;[C20] [433] FORCE IMPURE CODE INTO LOW SEG
.CMPAR:
	SEGMENT	LPURE			;[C20] [433] BACK TO HIGH SEG
>

BEGIN;
.KLCMP:
IFN FTCOBOL,<
	PHASE	.CMPAR
.CMPAR:
>
IFE FTCOBOL,<
	PHASE	0			;BUG IN MACRO
>
	AOS	CMPCNT			;[C20] COUNT OF COMPARISONS
	DMOVE	T3,J			;GET THE RECORD POINTERS
KLCMP1:	HRLI	T3,.-.			;-XTRWRD TO MAKE T3 AN AOBJN PTR
KLCMP2:	MOVE	T1,1(T4)		;[OK] GET NEXT DATA WORD OF RECORD J
	CAMN	T1,1(T3)		;[OK] COMPARE TO DATA WORD OF RECORD R
KLCMP4:	AOJA	T4,KLCMP3		;EQUAL, INCREMENT TO POINT TO NEXT WORD
	CAMG	T1,1(T3)		;[OK] FIND WHICH RECORD IS LARGER
	JRST	2(P4)			;[OK] REC R < REC J
	JRST	1(P4)			;[OK] REC R > REC J

KLCMP3:	AOBJN	T3,KLCMP2		;TRY AGAIN IF ANY MORE WORDS
	JRST	0(P4)			;[OK] NONE- THE KEYS ARE EQUAL

	DEPHASE

	KL.CL==.-.KLCMP			;[433] SIZE FOR KL-10

	SEGMENT	IMPURE			;[C20]

IFN FTCOBOL,<
.CMPAR:
>
IFE FTCOBOL,<
%CMPAR:
>
	BLOCK	KL.CL			;[433] LOAD THE CODE AT RUN TIME
	SEGMENT	LPURE			;[C20]

SUBTTL	ERROR MESSAGES

;HERE ON FATAL ERRORS

E$$ATF:	$ERROR	(?,ATF,<At least 2 input files required for MERGE>)

E$$RLO:	$ERROR	(?,RLO,<RELEASE called out of sequence. SORT not active.>)

E$$DND:	$ERROR	(?,DND,<Device >,+)
IFE FTOPS20,<
	POP	P,T1			;GET DEVICE OFF STACK
	$MORE	(SIXBIT,T1)
>
IFN FTOPS20,<
	$MORE	(ASCII,DEVNAM)
>
	$MORE	(TEXT,<: not disk.  All scratch devices must be disk>)
DIE:	$CRLF			;CLOSE OUT LINE
IFE FTOPS20,<
	CALL	RELSPC		;[C13] RELEASE ANY RETAINED MEMORY
>;END IFE FTOPS20
IFN FTOPS20,<
	CALL	RESET$		;[335] CLEAN UP THE MESS
>;END IFN FTOPS20
IFE FTNZSEC,<
	JRST	STOPR.		;DO THE COBOL ERROR ROUTINE
>
IFN FTNZSEC,<
	MOVE	P,COBPDP		;RESTORE ORIGINAL P
	JRST	@STOPR.			;RETURN TO CALLER
>

E$$DNE:	$ERROR	(?,DNE,<Device >,+)
IFE FTOPS20,<
	POP	P,T1			;GET DEVICE OFF STACK
	$MORE	(SIXBIT,T1)
>
IFN FTOPS20,<
	$MORE	(ASCII,DEVNAM)
>
	$MORE	(TEXT,< does not exist>)
	$DIE

E$$RTO:	$ERROR	(?,RTO,<RETURN called out of sequence. SORT not active.>)

;	$PURGE

;IFE FTNZSEC,<	END>

;IFN FTNZSEC,<	END	<ENTVLN,,ENTVEC>>


	END