Google
 

Trailing-Edge - PDP-10 Archives - BB-H580C-SB_1981 - srtcbl.mac
There are 10 other files named srtcbl.mac in the archive. Click here to see a list.
SUBTTL	SRTCBL - INTERFACE TO LIBOL FOR COBOL SORT
SUBTTL	E.F. McHUGH & D.M.NIXON/DMN/DZN	8-May-81



;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, 1981 BY DIGITAL EQUIPMENT CORPORATION

FTCOBOL==1
FTFORTRAN==0

IFN FTPRINT,<PRINTX [Entering SRTCBL.MAC]>
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  Meter point macros ................................   4
;        3.3  Impure Data .......................................   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
	SEARCH	METUNV			;[365] GET METER POINT DEFINITIONS
IFN LSTATS, SEARCH LBLPRM		;[***] GET MTRJS% DEFINITION

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

	WSCBIT==1B0			;WANT SEQUENCE CHECK ON MERGE

DEFINE	COMPARE(R,J)<
	JSP	P4,.CMPAR
>

DEFINE	ENDMODULE<
	$PURGE
	END>

IFN FTOPS20,<
	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
>

KEYZ	SUP,<NONE,INFORMATION,WARNING,FATAL,ALL>
SUBTTL	DEFINITIONS -- Meter point macros

;MACROS TO GET AND STORE THE CURRENT TIME

DEFINE	MRTMI. <		;[***] START MTR PT TIMING
IFN LSTATS,<
  IFE FTOPS20,<
	SETZ	T1,		;[365] OUR JOB
	RUNTIME	T1,		;[365] GET FAST 10 TIME
  >
  IFN FTOPS20,<
	PUSHJ	P,MRTS.		;[***] GET TIME IN AC1, AC2
	 SETZB	T1,T2		;[***] ERROR, CLEAR
  >
 >;END LSTATS
>;END MRTMI.

DEFINE	MRTMS. (ADD) <	;[365] START MRT PT TIMING
IFN LSTATS,<
  IFE FTOPS20,<
	SETZ	T1,		;[365] OUR JOB
	RUNTIME	T1,		;[365] GET FAST 10 TIME
	MOVEM	T1,MP.TIM	;[365] SAVE START TIME
  >
  IFN FTOPS20,<
	PUSHJ	P,MRTS.		;[***] START MTR TIMING
	 SETZB	1,2		;[***] ERROR, CLEAR
	DMOVEM	1,MP.TIM	;[365] SAVE 2 WORDS
  >
	MOVEI	T1,MP.BLK+ADD	;[365] SAVE BUCKET ADDRESS
	MOVEM	T1,MP.ADD	;[365] FOR MRTME.
 >;END LSTATS
>;END MRTMS.

DEFINE	MRTME. <	;[365] GET TIME SINCE MRTMS.,ADD TO TIME BUCKET ADDRESSED BY MP.ADD
 IFN LSTATS,<
  IFE FTOPS20,<
	SETZ	T1,		;[365] OUR JOB
	RUNTIME	T1,		;[365] GET FAST 10 TIME
	SUB	T1,MP.TIM	;[365] GET TIME SINCE METER PT START
	MOVE	T2,MP.ADD	;[C20] ADD TIME PAST TO TIME BUCKET
	ADDM	T1,(T2)		;[C20]   ..
  >
  IFN FTOPS20,<
	PUSHJ	P,MRTS.		;[***] READ METER BOARD
	 JRST	.+4		;[***] ERROR SKIP TIME CALC.
	DSUB	1,MP.TIM	;[365] SUBTRACT START TIME
	ASHC	1,^D24		;[365] SHIFT TO SINGLE WORD
	MOVE	2,MP.ADD	;[C20] ADD TIME PAST TO TIME BUCKET
	ADDM	1,(2)		;[C20]   ..
  >
 >;END LSTATS
>;END MRTME.
SUBTTL	DEFINITIONS -- Impure Data

	SEGMENT	IMPURE		;[C20]

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


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

IFN LSTATS,<
MP.BLK:	BLOCK	^D128		;[365] METER POINT INFO BLOCK
MP.TIM:	BLOCK	1		;[365] TEMP TO HOLD METER TIME
IFN FTOPS20,<BLOCK	1>	;[365] NEEDS 2 WORDS ON TOPS-20
MP.ADD:	BLOCK	1		;[365] ADDRESS OF BUCKET TO STORE TIME IN
>

	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	PSORT. -- SORT/MERGE Initialization

BEGIN;
  PROCEDURE	(PUSHJ	P,PSORT.)
PSORT.:	TDZA	P1,P1			;SORT ENTRY
PMERG.:	MOVEI	P1,1			;MERGE ENTRY
IFN LSTATS,<				;[***]
	MRTMI.				;[***][365] SAVE INITIAL TIME
	MOVE	P3,T1			;[***] SAVE INITIAL TIME
	MOVE	P4,T2			;[***]
>;END IFN LSTATS			;[***]
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
	BLT	T3,LOWORG+1777		;[356] OR THEY ALREADY EXIST
	AIC%				;[335] REACTIVATE INTERRUPTS FOR PA1050
>
	MOVEM	L,SAVEL			;SAVE AC L
	MOVEI	L,ACSAVE		;GET BLT POINTER
	BLT	L,ACSAVE+4		;SAVE ACS FROM COBOL
	JSP	T4,ZDATA		;ZERO SORT DATA
	MOVEM	P1,MRGSW		;SAVE MERGE OR SORT
IFN LSTATS,<
	MOVE	T1,[MBBT.S,,.MBSSZ]	;[***][365] HEADER WORD
	MOVEM	T1,MP.BLK		;[365] STORE AS FIRST WORD IN BLOCK
	MOVEI	T1,.MBSLN		;[***] REAL LENGTH OF BLOCK
	MOVEM	T1,MP.BLK+MB.SLN	;[***] STORE
	MOVEM	P1,MP.BLK+MB.SM		;[365] STORE SORT OR MERGE SWITCH
 IFE FTOPS20,<
	SETZ	P4,			;[365] JUNK ON TOPS-10
 >
	DMOVEM	P3,MP.BLK+MB.TM0	;[365] STORE START TIME
	DMOVEM	P3,MP.TIM		;[365] AND FOR END OF PSORT TEST
	MOVEI	T1,MP.BLK+MB.TPS	;[365] BUCKET FOR PSORT.
	MOVEM	T1,MP.ADD
>
	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
	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
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.
	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
	CAMN	T1,[PUSHJ P,PMERG.]	;[354] SEE IF NON-REENTRANT
	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

	MOVEI	T2,2			;GET DISPLACEMENT
	ADDB	T2,(P)			;RESET RETURN ADDRESS
	HRRZ	T3,T2			;[C20] GET CONTENTS OF FIRST & SECOND ARGS
	DMOVE	T1,-2(T3)		;[C20]   ..
	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 LSTATS,<
	HLRZM	T1,MP.BLK+MB.KSZ	;[365] SAVE KEY SIZE
	HRLZ	T2,T1			;[365] LOC OF FILE TABLE
	HRRI	T2,MP.BLK+MB.FTD	;[365] BLT PTR. TO STORE FILE TABLE
	BLT	T2,MP.BLK+MB.FTD+MB.HDL-1	;[365] DO IT
>
	HRRZ	T3,T1			;[C20] MAX RECORD SIZE
	LDB	T2,[POINT 12,F.WMRS(T3),17]	;[C20]   ..
	HRRZM	T2,RECORD		;[207] REMEMBER MAX SIZE
	LDB	T4,[POINT 3,F.WFLG(T3),14]	;[C20] 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
	HRRZ	T1,SDFILE		;GET SORT FILE RECORD ADDRESS
	HRRZ	T2,F.RREC(T1)		;[OK] GET ADDRESS OF RECORD AREA
	HRRZM	T2,NEWREC		;SAVE IN LIBIMP
	HRRZ	T2,F.RNFT(T1)		;[OK] GET LINK TO NEXT FILE TABLE
	HRRZM	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

	HRRZ	T1,SDFILE		;[C20] GET ADDRESS OF SD FILE BLOCK
	LDB	T2,[POINT 6,F.WNOD(T1),17]	;[OK] 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,<
	HRRZ	T1,F.WDNM(T1)		;[OK] 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,<
	HRRZ	P1,F.WDNM(T1)		;[OK] ADDRESS OF SCRATCH DEVICE NAMES
	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
>
END;
;SETUP CORRECT COMPARE CODE

BEGIN;
IFE FTKI10!FTKL10,<
  IF WE ARE RUNNING ON A KA-10 CPU
	MOVE	T1,CPU			;[433]
	CAIE	T1,KA.CPU		;[433] IS IT A KA-10?
	JRST	$T			;[433] NO

  THEN LOAD KA-10 COMPARE CODE
	MOVE	T1,[.KACMP,,.CMPAR]	;[433] YES
	BLT	T1,.CMPAR+KA.CL-1	;[433] MAKE IT SYMBOLIC
	MOVN	T1,XTRWRD		;[433] SET TO COMPARE ALL KEYS
	HRRM	T1,KACMP1		;[433] 
	JRST	$F			;[433]

  ELSE LOAD KI/KL COMPARE CODE
	MOVE	T1,[.KICMP,,.CMPAR]	;[433]
	BLT	T1,.CMPAR+KI.CL-1	;[433] MAKE IT SYMBOLIC
	MOVN	T1,XTRWRD		;[207]
	HRRM	T1,KICMP1
  FI;
>

IFN FTKI10!FTKL10,<
 IFN FTOPS20,<
	MOVE	T1,[.KICMP,,.CMPAR]	;[433] MOVE CODE TO IMPURE SEGMENT
	BLT	T1,.CMPAR+KI.CL-1	;[433] ...
 >
	MOVN	T1,XTRWRD		;[207]
	HRRM	T1,KICMP1
>

END;
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
	HRRZ	T1,(P)			;[C20] [327] START LOOKING AT RETURN ADDR
  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
	END;
	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
IFN LSTATS,<
	MOVEM	T2,MP.BLK+MB.NIF	;[365]
>
	PUSHJ	P,SETMRG		;SETUP NUMRCB ETC.
	MOVN	T1,ACTTMP		;GET MAX. NO. OF TEMP FILE
IFN LSTATS,<
	MOVMM	T1,MP.BLK+MB.NIO	;[365] SAVE NO. OF I/O CHANS AVAILABLE
>
	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;
END;
	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
	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
END;
;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 PMERGE. 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.

	MOVEI	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
	END;
	RETURN				;[327] DONE
END;
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
		END;
  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
		END;
  FI;
END;
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
	HRRZS	T4			;[C20] CONVERT THE KEYS
	PUSHJ	P,(T4)			;[C20]   ..
	JSP	P4,.SAVE		;EXCHANGE AC BLOCKS
	MRTMS.	MB.TRL			;[365]
	HRLZ	T1,KEYLOC		;GET THE LOCATION OF THE KEYS
	HRRI	T1,1(R)			;GET START OF THE RECORD
	HRRZ	T2,XTRWRD		;[207] GET THE SIZE OF THE KEYS
	ADDI	T2,1(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
	MOVE	T1,SAVEL		;[207] GET RECORD LENGTH IN WORDS
	IMUL	T1,IOBPW		;[207] GET IT IN BYTES
	MOVEM	T1,0(R)			;MAKE IT THE CONTROL WORD
	AOS	INPREC			;COUNT RECORDS ON WAY IN
	MOVE	T1,$RELES		;[C20] GOTO RIGHT ROUTINE
	PJRST	(T1)			;[C20]   ..
END;


BEGIN;
  PROCEDURE	(PUSHJ	P,RELESI)
	HRRZ	T1,MRGCNT		;[C20]
	HRRZ	T2,-1(P)		;[C20] [327] GET RELES. RETURN ADDRESS
	HRRZ	T2,(T2)			;[OK] [327]   WHERE THERE'S A JRST
	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
END;
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
	HRRZ	T1,-1(P)		;[C20] [327] GET RETURN FROM RELES. OR MCLOS.
	PUSHJ	P,FNDNXT		;[327] FIND NEXT PUSHJ P,RELES.
	  JFCL				;[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;
	MOVE	T1,PSAV			;GET ORIGINAL STACK POINTER
	HRRM	T2,-1(T1)		;[OK] SET NEW RETURN
	RETURN
END;
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
END;

BEGIN;
  PROCEDURE	(PUSHJ	P,RELES1)

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

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

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


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

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

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
END;
SUBTTL	MCLOS. CLOSE OUT INPUT MERGE FILE

BEGIN
  PROCEDURE	(PUSHJ	P,MCLOS.)
	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
		HRRM	T1,-1(P)		;SET RETURN TO GET IT
		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
				MOVE	T1,PSAV			;[327]   AND RETURN TO THERE
				HRRM	T2,-1(T1)		;[OK] [327]   ..
				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]   ..
			  JFCL				;[327] THERE *IS* ANOTHER
			HRRZ	T2,1(T2)		;[OK] [327] GET ADDR IN FOLLOWING JRST
			SUBI	T2,2			;[327] GET TO OPEN ROUTINE
			MOVE	T1,PSAV			;[327] RETURN TO THERE
			HRRM	T2,-1(T1)		;[OK] [327]   ..
			  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;
END;
SUBTTL	MERGE. -- Simulate Master End of File

BEGIN;
  PROCEDURE	(PUSHJ	P,MERGE.)
	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;
END;
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
	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.
;	MOVE	P,PSAV			;GET STACK RIGHT
	POP	P,-1(P)			;REMOVE TOP RETURN
	MOVEM	P,PSAV			;SET RETURN TO RETRN. CALLER
  FI;
	HRRZI	T1,1(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
  IF LAST SORT RECORD
	SKIPL	LASRET			;ANY MORE RECORDS TO RETURN?
	JRST	$T			;YES
  THEN FLAG LAST AND RETURN
	SETZM	LASRET			;STOP ALLOWING RETURNS
	AOS	-1(P)			;GIVE SKIP RETURN TO COBOL
	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;
END;

BEGIN;
  PROCEDURE	(PUSHJ	P,EOFOUT)
	SETOM	LASRET			;WANT ONLY ONE MORE RECORD
	MOVE	P,PSAV			;RESTORE STACK POINTER
	RETURN				;AND RETURN TO COBOL
END;
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
	MRTMS.	MB.TND			;[365]
  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
		END;
	  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;
IFN LSTATS,<
	DMOVE	T1,INPREC		;[365] GET NO. OF RECORD INPUT & OUTPUT
	DMOVEM	T1,MP.BLK+MB.NRI	;[365]
>
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
	HRRZ	T1,SDFILE		;RESET SD FILE BLOCK
	HRRZ	T2,OLDNXT
	HRRM	T2,F.RNFT(T1)		;[OK]
	SETZM	KEYCV.			;CLEAR THIS LOCATION
	SETZM	LASRET			;STOP ALLOWING RETURNS

IFN LSTATS,<
	MRTMI.				;[***][365] SAVE TIME AT END
 IFE FTOPS20,<
	SETZ	T2,			;[365] CLEAR JUNK IN SECOND WORD
 >
	DMOVEM	T1,MP.BLK+MB.TM1		;[365] SAVE TIME AT END
 IFE FTOPS20,<
	SUB	T1,MP.TIM		;[365] GET TIME IN ENDS CODE
	MOVEM	T1,MP.BLK+MB.TND	;[365] AND SAVE IT
 >
 IFN FTOPS20,<
	DSUB	1,MP.TIM		;[365] GET TIME IN ENDS CODE
	ASHC	1,^D24			;[365] CONVERT TO SINGLE WORD
	MOVEM	1,MP.BLK+MB.TND		;[365] AND SAVE IT
 >
	MOVE	T1,[-.MBSSZ,,MP.BLK]	;[365] POINT TO METER BLOCK
	PUSHJ	P,MROUT.		;[C20] [365] TELL LIBOL
>

	MOVSI	L,ACSAVE		;SET UP BLT POINTER
	BLT	L,T4			;RESTORE LIBOL'S ACS
	MOVE	L,ACSAVE+5
	RETURN

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

IFN LSTATS,<
 IFN FTOPS20,<

;TOPS20 ROUTINE TO GET FAST CLOCK TIME IN AC1 AND AC2
; RETURNS .+1 IF CAN'T GET.


  IFNDEF METER%,<		;[***] IF METER% JSYS UNDEFINED, THIS IS BEFORE RELEASE 4

MRTS.:	MTRJS%			;[***] GET FAST CLOCK TIME IN AC1& AC2
	  ERJMP	.+2		;[***] ERROR SKIP TIME SET
	AOS	(P)		;[***] ALL OK--SKIP RETURN
	POPJ	P,		;[***] NON-SKIP RETURN

  >;[***] END IFNDEF METER%

  IFDEF METER%,<		;[***] RELEASE 4 SYSTEM -- USE MONITOR JSYS

MRTS.:	MOVEI	AC1,.MEREA 	;[***] READ E-BOX TICKS
	METER%			;[***] GET FAST CLOCK TIME IN AC2&AC3
	 ERJMP	.+3		;[***] ERROR, SKIP TIME CALC
	AOS	(P)		;[***] OK WE WILL DO A SKIP RETURN
	DMOVE	AC1,AC2		;[***] COPY ARGS TO 1&2
	POPJ	P,		;[***] RETURN

  >;[***] END IFDEF METER%

 >;END IFN FTOPS20
>;END IFN LSTATS
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
END;

BEGIN;
  PROCEDURE	(PUSHJ	P,.RESTR)
	DMOVEM	R,SORTAC		;SAVE THE SORT ACS
	MRTME.				;[365] SAVE THE METER POINT TIME
	MOVSI	T4,ACSAVE		;SET UP BLT POINTER
	BLT	T4,T4			;RESTORE LIBOL'S ACS
	RETURN				;RETURN TO THE COBOL PROGRAM
END;
SUBTTL	ROUTINE TO DO COMPARES IN COBOL SORT

;THIS ROUTINE ASSUMES USE OF COBOL KEY ROUTINE DURING THE RELEASE PHASE
;USES THE MOST EFFICIENT CODE FOR THE HOST CPU

	SEGMENT	IMPURE			;[C20] [433] FORCE IMPURE CODE INTO LOW SEG
.CMPAR:
	SEGMENT	LPURE			;[C20] [433] BACK TO HIGH SEG

IFE FTKI10!FTKL10,<
	BLOCK	14			;[N04] LOAD THE CODE AT RUN TIME

;KA10 CODE
BEGIN;
.KACMP:	PHASE	.CMPAR
  PROCEDURE	(JSP	P4,.CMPAR)
	AOS	CMPCNT			;[C20] COUNT OF COMPARISONS
	MOVE	T3,J			;GET THE RECORD POINTERS
	MOVE	T4,R			;...
KACMP1:	HRLI	T3,.-.			;-XTRWRD TO MAKE T3 AN AOBJN PTR
  $1%	MOVE	T1,1(T4)		;[OK] GET NEXT DATA WORD OF RECORD J
	CAMN	T1,1(T3)		;[OK] COMPARE TO DATA WORD OF RECORD R
	AOJA	T4,$2			;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

  $2%	AOBJN	T3,$1			;TRY AGAIN IF ANY MORE WORDS
	JRST	0(P4)			;[OK] NONE- THE KEYS ARE EQUAL
	DEPHASE

	KA.CL==.-.KACMP			;[433] SIZE FOR KA-10
IFN KA.CL-14,<PRINTX ?Comparison code changed size>	;[N04]
END;
>
;KI10/KL10 CODE
BEGIN;
.KICMP:	PHASE	.CMPAR
  PROCEDURE	(JSP	P4,.CMPAR)
	AOS	CMPCNT			;[C20] COUNT OF COMPARISONS
	.DMOVE	T3,J			;GET THE RECORD POINTERS
KICMP1:	HRLI	T3,.-.			;-XTRWRD TO MAKE T3 AN AOBJN PTR
  $1%	MOVE	T1,1(T4)		;[OK] GET NEXT DATA WORD OF RECORD J
	CAMN	T1,1(T3)		;[OK] COMPARE TO DATA WORD OF RECORD R
	AOJA	T4,$2			;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

  $2%	AOBJN	T3,$1			;TRY AGAIN IF ANY MORE WORDS
	JRST	0(P4)			;[OK] NONE- THE KEYS ARE EQUAL
	DEPHASE

	KI.CL==.-.KICMP			;[433] SIZE FOR KI/KL-10
END;

IFN FTOPS20,<
	SEGMENT	IMPURE			;[C20]
.CMPAR:	BLOCK	KI.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
	JRST	STOPR.		;DO THE COBOL ERROR ROUTINE

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