Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - sort-source/srtdtr.mac
There is 1 other file named srtdtr.mac in the archive. Click here to see a list.
; UPD ID= 96 on 12/5/83 at 10:48 AM by FONG                             
TITLE	SRTDTR - INTERFACE TO DATATRIEVE FOR SORT
SUBTTL	P.M.VATNE

	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) 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

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

	.COPYRIGHT		;Put standard copyright statement in REL file
	SEGMENT	HPURE
SUBTTL	TABLE OF CONTENTS FOR SRTDTR


;                    Table of Contents for SRTDTR
;
;
;                             Section                             Page
;
;   1  STRDTR - INTERFACE TO DATATRIEVE FOR SORT ................   1
;   2  TABLE OF CONTENTS FOR SRTDTR .............................   2
;   3  DEFINITIONS
;        3.1  Flags, Entry Points and Macros ....................   3
;        3.2  Internal/External Symbols .........................   4
;        3.3  Impure Data .......................................   5
;        3.4  TOPS-20 Entry Vector ..............................   6
;   4  SRTINI
;        4.1  SORT Initialization ...............................   7
;        4.2  Initialization continued ..........................   8
;        4.3  Convert Key Specifications to Internal Format .....   9
;        4.4  Sort Key Type Table ...............................  10
;   5  SRTREL
;        5.1  Add Input Record to Tree ..........................  11
;   6  SRTMRG
;        6.1  Simulate Master End of File .......................  12
;   7  SRTRET
;        7.1  Copy Records From Tree to Output File .............  13
;   8  SRTEND
;        8.1  Clean Up After Sort ...............................  14
;   9  SRTERR
;        9.1  Return text of error message ......................  15
;  10  ACCUMULATOR SAVE/RESTORE ROUTINE .........................  16
;  11  STRCPY
;       11.1  String Copy Routine ...............................  17
;       11.2  BLT all full words in string ......................  18
;       11.3  Initialize BYTBLT Constants .......................  19
;       11.4  Convert One-word Byte Pointers to Two Words .......  20
;  12  ERROR MESSAGES ...........................................  21
SUBTTL	DEFINITIONS -- Flags, Entry Points and Macros

ENTRY	SRTINI,SRTREL,SRTMRG,SRTRET,SRTEND,SRTERR

ERRLEN==^D80	;MAXIMUM NUMBER OF CHARACTERS IN ERROR MESSAGE
CODSIZ==2000	;MAXIMUM SIZE OF GENERATED COMPARE CODE

;***************************** WARNING *********************************
;THE FOLLOWING KEYZ MACRO CALL MUST BE THE SAME AS THE CALL IN SRTSTA
;***********************************************************************

KEYZ	MOD,<SIXBIT,ASCII,EBCDIC,BINARY>
SUBTTL	DEFINITIONS -- Internal/External Symbols

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

;GLOBAL ROUTINES
INTERN	DTRVLN,DTRVEC


;EXTERNALS

;DEFINED IN SORT
EXTERN	ACTTMP,DFBORG,ERRADR,INPREC,LSTREC,MAXTMP,MRGSW,NUMTMP,PSAV,RQ
EXTERN	OUTREC,RECORD,REKSIZ,STRNAM,STRNUM,TCBIDX,TMPFCB,XTRWRD,$RETRN
EXTERN	IOBPW
EXTERN	CLRSPC,CPUTST,E$$KOR,E$$NEC,E$$RNI,GETJOB,GETSPC,INITRE,MERGE%
EXTERN	PSORT%,RELES%,RETRN%,RETRN0,RETRN1,RSTSPC,SETMRG,SETSPC,SETTRE
EXTERN	ZDATA,%ERMSG,%TDECW,%TCRLF,%TSIXN,%TSTRG,.TYOCH

;DEFINED IN SRTJSS
EXTERN	DELFIL,CHKCOR,RESET$,ERSET$,SETTMP

;DEFINED IN SRTSTA
EXTERN	.CMPAR,BPWORD,E$$OKR,E$$RSR,EXTORG,EXTSZ,KEYEXT,KEYGEN,FSTKEY,LSTKEY
SUBTTL	DEFINITIONS -- Impure Data

	SEGMENT	IMPURE

	LD	(RETVAL,1)	;VALUE TO RETURN TO DATATRIEVE
	LD	(SAVEPC,1)	;PC OF CALLER TO .SAVE
	LD	(SAVACS,20)	;PLACE TO SAVE DATATRIEVE'S ACS
	LD	(STACK,PDLEN)	;NEW STACK
	LD	(SORTAC,2)	;SAVES SORT ACS
;***DO NOT SEPARATE OR REORDER THE FOLLOWING WORDS***
	LD	(ERRPTR,1)	;BYTE POINTER TO ERRMSG FOR ERRCHR
	LD	(ERRCTR,1)	;BYTE COUNTER TO ERRMSG FOR ERRCHR
;***END OF DO NOT SEPARATE***
ZCOR:!				;START OF DATA TO CLEAR
	LD	(INITED,1)	;FLAG WHETHER SRTINI HAS BEEN CALLED
	LD	(NUMKEY,1)	;NUMBER OF KEYS
	LD	(KEYBUF,1)	;ADDRESS OF CURRENT KEY SPEC
		KEYTYP==0	;KEY TYPE FOR CURRENT KEY
		KEYORD==1	;KEY ORDER FOR CURRENT KEY
		KEYPOS==2	;START POSITION FOR CURRENT KEY
		KEYLEN==3	;LENGTH OF CURRENT KEY
	LD	(MAXLEN,1)	;MAXIMUM RECORD LENGTH IN BYTES
;***DO NOT SEPARATE OR REORDER THE FOLLOWING WORDS***
	LD	(STRPTR,1)	;STRING BYTE POINTER
	LD	(STRLEN,1)	;STRING SECTION,,STRING LENGTH
;***END OF DO NOT SEPARATE***
	LD	(ERRMSG,ERRLEN/5)	;ASCII TEXT OF ERROR MESSAGE

	LD	(BYTPTR,1)	;P AND S FIELDS OF FIRST BYTE POINTER
	LD	(BYTFST,1)	;BYTE POINTER TO FIRST PART OF RECORD
	LD	(BYTLST,1)	;BYTE POINTER TO LAST PART OF RECORD
	LD	(BYTWRD,1)	;NUMBER OF BYTES PER WORD
	LD	(BYTLFT,1)	;NUMBER OF BYTES LEFT IN FIRST WORD

	LD	(FSTREL,1)	;FLAGS THE FIRST RELEASE
	LD	(MRGDON,1)	;FLAGS END OF RELEASES
	LD	(LASRET,1)	;FLAGS END OF RETURNS
EZCOR==.-1			;END OF DATA TO BE ZEROED

	SEGMENT	LPURE

	BLOCK	1		;LINK TO NEXT
	ZCOR,,EZCOR		;DATA TO ZERO
	.LINK	S.LNK,.-2	;TELL LINK WHAT TO DO
SUBTTL	DEFINITIONS -- TOPS-20 Entry Vector


	SEGMENT	HPURE

ENTVEC:	JRST	SRTINI		;MAIN ENTRY POINT
	HALT	.		;REENTER ENTRY POINT
	EXP	V%SORT		;VERSION NUMBER
	DTRVLN,,DTRVEC		;USER DATATRIEVE ENTRY VECTOR

	ENTVLN==.-ENTVEC

DTRVEC:	EXP	0,SRTINI	;DATATRIEVE ENTRY POINTS
	EXP	0,SRTREL
	EXP	0,SRTMRG
	EXP	0,SRTRET
	EXP	0,SRTEND
	EXP	0,SRTERR

	DTRVLN==.-DTRVEC
SUBTTL	SRTINI -- SORT Initialization

BEGIN;
  PROCEDURE	(PUSHJ	P,SRTINI)
;
;CALL WITH:
;	STATUS = SRTINI(KEY-ARRAY,MAX-RECORD-LENGTH)
;
;KEY-ARRAY CONTAINS: NUMBER OF KEYS, AND A REPEATING BLOCK OF
;	KEY TYPE, KEY ORDER, KEY STARTING POSITION, KEY LENGTH.
;MAX-RECORD-LENGTH  IS THE LENGTH OF THE LONGEST RECORD PASSED TO SORT.
;
	PUSHJ	P,.SAVE			;SAVE DATATRIEVE'S ACS
	JSP	T4,ZDATA		;ZERO SORT DATA
	SETZM	MRGSW			;TELL SORT THIS IS NOT A MERGE
	JSP	T4,CPUTST		;MAKE SURE IF CPU IS OK
	XMOVEI	T1,DIE			;WHERE TO GO ON FATAL ERROR
	MOVEM	T1,ERRADR		;STORE IN GLOBAL LOCATION
	PUSHJ	P,SETSPC		;SETUP MEMORY LOCS

;GET MAXIMUM RECORD LENGTH

	SKIPG	T1,@1(L)		;GET MAX RECORD LENGTH
	  JRST	E$$RSR			;RECORD LENGTH MAY NOT BE ZERO
	TLNE	T1,-1			;LENGTH BIGGER THAN A HALF-WORD?
	  JRST	E$$MTL			;MAX RECORD LENGTH IS TOO LARGE
	MOVEM	T1,MAXLEN		;SAVE MAX RECORD LENGTH
	MOVEM	T1,RECORD		;SAVE FOR SRTCMP

;PROCESS THE KEY BUFFER

	XMOVEI	T1,@0(L)		;GET ADDRESS OF KEY BUFFER
	MOVEM	T1,KEYBUF		;SAVE FOR LATER
	SKIPG	T2,0(T1)		;GET NUMBER OF KEYS
	  JRST	E$$OKR			;ERROR--ONE KEY REQUIRED
	MOVEM	T2,NUMKEY		;SAVE NUMBER OF KEYS
	MOVE	P1,T2			;SAVE NUMBER OF KEYS FOR LOOP
  FOR EACH KEY IN KEY-ARRAY DO
    BEGIN;
	AOS	KEYBUF			;ADVANCE TO NEXT KEY
	PUSHJ	P,KEYCNV		;CONVERT TO INTERNAL FORMAT
	MOVEI	T1,KEYLEN		;GET LENGTH OF BLOCK MINUS 1
	ADDM	T1,KEYBUF		;ADVANCE PAST THIS BLOCK
	SOJG	P1,$B			;LOOP FOR NEXT KEY
    ENDB;
	SETOM	INITED			;INDICATE WE ARE READY TO SORT
	RETURN				;THAT'S ALL WE CAN DO FOR NOW
ENDB;
SUBTTL	SRTINI -- Initialization continued

BEGIN;
  PROCEDURE	(PUSHJ	P,SRTIN2)
;
;CONTINUE WITH INITIALIZATION HERE.  CALLED FROM SRTREL
;THE FIRST TIME SRTREL IS CALLED AFTER SRTINI IS CALLED.
;
	SETOM	COBPDP##		;FAKE OUT SORT
	DMOVE	T1,STRPTR		;GET FIRST STRING POINTER
	PUSHJ	P,BYTINI		;INITIALIZE FOR BYTBLT
	MOVE	T1,BYTWRD		;GET NUMBER OF BYTES/WORD
	MOVEM	T1,BPWORD		;SAVE FOR SRTCMP
	MOVEM	T1,IOBPW		;AND SAVE FOR SORT I/O
	SKIPE	T1,BYTLFT		;ANY BYTES LEFT IN FIRST WORD?
	MOVE	T1,BYTWRD		;YES, COMPUTE NULL BYTES
	SUB	T1,BYTLFT		; AT BEGINNING OF RECORD
	ADDM	T1,RECORD		;ADJUST RECORD SIZE FOR SRTCMP
	PUSHJ	P,KEYREL		;RELOCATE KEYS W.R.T. NULL BYTES
	MOVE	T1,MAXLEN		;GET MAXIMUM NUMBER OF BYTES
	SUB	T1,BYTLFT		;SUBTRACT BYTES IN FIRST WORD
	IDIV	T1,BYTWRD		;COMPUTE LENGTH IN WORDS
	SKIPE	T2			;ANY BYTES LEFT OVER?
	ADDI	T1,1			;YES, ROUND UP
	SKIPE	BYTLFT			;ANY BYTES LEFT IN FIRST WORD?
	ADDI	T1,1			;YES, ROUND UP
	MOVEM	T1,REKSIZ		;SAVE NUMBER OF WORDS/REC
IFN FTOPS20,<
	MOVEI	T1,MX.TMP		;GET MAXIMUM TEMP FILES
>
IFE FTOPS20,<
	PUSHJ	P,SETCHN		;SETUP CHANNEL ALLOCATOR
	MOVE	T1,CHNFRE		;GET CHANNELS AVAILABLE
>
	MOVEM	T1,MAXTMP		;THIS IS MAX TEMP FILES
	MOVN	T1,MAXTMP		;MAKE AN AOBJ POINTER
	HRLZM	T1,TCBIDX		;PUT IT AWAY FOR LATER
	PUSHJ	P,SETTMP		;SET UP STRNUM AND STRNAM
	MOVEI	T1,CODSIZ		;GET MAXIMUM SIZE OF CODE
	MOVEM	T1,EXTSZ		;SAVE FOR KEYGEN
	PUSHJ	P,GETSPC		;ALLOCATE BLOCK OF MEMORY
	  JRST	E$$NEC			;NOT ENOUGH CORE
	XMOVEI	T1,(T1)			;MAKE SURE IT HAS THE SECTION
	MOVEM	T1,EXTORG		;SAVE ADDRESS OF CODE
	PUSHJ	P,KEYEXT		;GENERATE CODE TO EXTRACT KEYS
	PUSHJ	P,KEYGEN		;GENERATE CODE FOR KEY COMPARES
	MOVEI	T1,1			;ACCOUNT FOR HEADER WORD
	ADD	T1,XTRWRD		;PLUS EXTRACTED KEYS
	ADDM	T1,REKSIZ		;NEW RECORD SIZE IN MEMORY
	PUSHJ	P,GETJOB 		;GET JOB NUMBER
	PUSHJ	P,CHKCOR		;USE DEFAULT CORE ALGORITHM
	PJRST	PSORT%			;JOIN COMMON CODE
ENDB;
SUBTTL	SRTINI -- Convert Key Specifications to Internal Format

BEGIN;
  PROCEDURE	(PUSHJ	P,KEYCNV)
;
;THIS ROUTINE CONVERTS A KEY BLOCK FROM THE SRTINI ARGUMENT LIST
;TO A FORMAT USED INTERNALLY BY KEYEXT, KEYGEN, AND SRTCMP.
;
	MOVX	T1,KY.LEN		;GET A KEY BLOCK
	PUSHJ	P,GETSPC		;..
	  JRST	E$$NEC			;NOT ENOUGH CORE
	PUSHJ	P,CLRSPC		;MAKE SURE IT'S CLEAN
  IF THIS IS THE FIRST KEY
	SKIPE	FSTKEY			;SEEN ONE YET?
	JRST	$T			;YES--PUT BLOCK AT END
  THEN MAKE THIS BLOCK THE FIRST IN THE LIST
	MOVEM	T1,FSTKEY		;
	JRST	$F			;
  ELSE PUT SUBSEQUENT BLOCKS AT END OF THE LIST
	MOVE	T2,LSTKEY		;
	MOVEM	T1,KY.NXT(T2)		;
  FI;
	MOVEM	T1,LSTKEY		;REMEMBER NEW LAST BLOCK
	MOVE	T4,KEYBUF		;GET ADDRESS OF KEY BLOCK
	MOVE	T2,KEYPOS(T4)		;GET STARTING POSITION OF KEY
	SOJL	T2,E$$KOR		;MAKE 0-ORIGIN
	CAML	T2,MAXLEN		;DOES KEY START INSIDE RECORD?
	  JRST	E$$KOR			;ERROR-KEY OUT OF RANGE
	MOVEM	T2,KY.INI(T1)
	MOVE	T2,KEYLEN(T4)		;GET LENGTH OF KEY
	MOVEM	T2,KY.SIZ(T1)
	ADD	T2,KY.INI(T1)		;COMPUTE ENDING BYTE
	CAMLE	T2,MAXLEN		;DOES KEY END INSIDE RECORD?
	  JRST	E$$KOR			;ERROR-KEY OUT OF RANGE
	MOVN	T2,KEYORD(T4)		;GET ORDER OF KEY
	MOVEM	T2,KY.ORD(T1)		;-1 MEANS DESCENDING
	MOVE	T2,KEYTYP(T4)		;GET TYPE OF KEY
	CAIL	T2,FSTTYP		;IN RANGE OF LEGAL TYPES?
	CAILE	T2,LSTTYP		;
	  JRST	E$$IKT			;ILLEGAL KEY TYPE CODE
	MOVE	T2,TYPTAB-FSTTYP(T2)	;CONVERT TO BITS
	MOVEM	T2,KY.MOD(T1)
	RETURN				;DONE
ENDB;
SUBTTL	SRTINI -- Sort Key Type Table

FSTTYP==1			;INDEX OF FIRST TYPE
TYPTAB:	EXP	MODSIX!RM.SIX!RM.ALP			;ALS (1)
	EXP	MODASC!RM.ASC!RM.ALP			;ALA (2)
	EXP	MODEBC!RM.EBC!RM.ALP			;ALE (3)
	EXP	MODSIX!RM.SIX!RM.NUM!RM.SGN		;NSS (4)
	EXP	MODASC!RM.ASC!RM.NUM!RM.SGN		;NSA (5)
	EXP	MODEBC!RM.EBC!RM.NUM!RM.SGN		;NSE (6)
	EXP	MODSIX!RM.SIX!RM.NUM!RM.UNS		;NUS (7)
	EXP	MODASC!RM.ASC!RM.NUM!RM.UNS		;NUA (8)
	EXP	MODEBC!RM.EBC!RM.NUM!RM.UNS		;NUE (9)
	EXP	MODSIX!RM.SIX!RM.COM!RM.SGN		;CSS (10)
	EXP	MODASC!RM.ASC!RM.COM!RM.SGN		;CSA (11)
	EXP	MODEBC!RM.EBC!RM.COM!RM.SGN		;CSE (12)
	EXP	MODSIX!RM.SIX!RM.COM!RM.UNS		;CUS (13)
	EXP	MODASC!RM.ASC!RM.COM!RM.UNS		;CUA (14)
	EXP	MODEBC!RM.EBC!RM.COM!RM.UNS		;CUE (15)
	EXP	MODEBC!RM.EBC!RM.PAC!RM.SGN		;C3S (16)
	EXP	MODEBC!RM.EBC!RM.PAC!RM.UNS		;C3U (17)
	EXP	MODBIN!RM.BIN!RM.COM!RM.SGN		;CSB (18)
	EXP	MODBIN!RM.BIN!RM.COM!RM.UNS		;CUB (19)
	EXP	MODBIN!RM.BIN       !RM.SGN		;NSB (20)
	EXP	MODBIN!RM.BIN       !RM.UNS		;NUB (21)
LSTTYP==.-TYPTAB-1+FSTTYP	;INDEX OF LAST TYPE

BEGIN;
  PROCEDURE	(PUSHJ	P,KEYREL)
	MOVE	R,FSTKEY		;GET ADDRESS OF FIRST KEY
  FOR EACH KEY DO
    BEGIN
	ADDM	T1,KY.INI(R)		;ADJUST KEY STARTING POSITION
    IF KEY HAS BINARY MODE
	MOVE	T2,KY.MOD(R)		;GET MODE OF KEY
	TXNN	T2,RM.BIN		;BINARY?
	JRST	$F			;NOPE
    THEN CONVERT STARTING POSITION TO WORDS
	MOVE	T3,KY.INI(R)		;GET STARTING POSITION IN BYTES
	IDIV	T3,BPWORD		;CONVERT TO WORDS (0-ORIGIN)
	MOVEM	T3,KY.INI(R)		;STORE NEW POSITION
      IF KEY IS NON-COMPUTATIONAL
	TXNE	T2,RM.COM		;COMPUTATIONAL?
	JRST	$F			;YES
      THEN CONVERT LENGTH OF KEY TO WORDS
	MOVE	T3,KY.SIZ(R)		;GET LENGTH OF KEY IN BYTES
	IDIV	T3,BPWORD		;CONVERT TO WORDS (TRUNCATED)
	MOVEM	T3,KY.SIZ(R)		;STORE NEW LENGTH
      FI;
    FI;
	SKIPE	R,KY.NXT(R)		;GET NEXT
	JRST	$B			;LOOP FOR MORE
    ENDB;
	RETURN				;DONE
ENDB;
SUBTTL	SRTREL -- Add Input Record to Tree

BEGIN;
  PROCEDURE	(PUSHJ	P,SRTREL)
;
;CALL WITH:
;	STATUS = SRTREL(STRING)
;
;THE STRING DESCRIPTOR CONTAINS A BYTE POINTER, AND THE NEXT WORD
;	IN THE DESCRIPTOR CONTAINS A BYTE COUNT.
;
	PUSHJ	P,.SAVE			;SAVE DATATRIEVE'S ACS
	SKIPE	INITED			;IS THE SORT ACTIVE?
	SKIPE	MRGDON			;HAS A MERGE NOT BEEN DONE?
	  JRST	E$$RLO			;NO-AN ERROR
	DMOVE	T1,@0(L)		;GET STRING DESCRIPTOR
	XHLLI	T2,@0(L)		;GET STRING'S SECTION
	DMOVEM	T1,STRPTR		;SAVE THE DESCRIPTOR
	SKIPN	FSTREL			;IS THE THE FIRST RELEASE?
	PUSHJ	P,SRTIN2		;YES, COMPLETE INITIALIZATION
	SETOM	FSTREL			;MARK INITIALIZATION COMPLETE
	DMOVE	T1,STRPTR		;GET BACK THE DESCRIPTOR
	TRNN	T2,-1			;ZERO RECORD LENGTH?
	  JRST	E$$RLZ			;YES--FATAL ERROR
	HRRZM	T2,RC.CNT(R)		;STORE LENGTH FOR SORT
	MOVEI	T3,RC.KEY(R)		;GET START OF RECORD IN TREE
	ADD	T3,XTRWRD		;MOVE PAST CONVERTED KEY AREA
	HLL	T3,BYTPTR		;FORM BYTE POINTER
	MOVE	T4,MAXLEN		;GET MAXIMUM LENGTH OF STRING
	XHLLI	T4,RC.KEY(R)		;GET SECTION OF RECORD IN TREE
	PUSHJ	P,STRCPY		;COPY STRING
	  JRST	E$$RLM			;RECORD SIZE LARGER THAN MAX
	JSP	P4,@EXTORG		;CONVERT ANY KEYS NEEDED
	AOS	INPREC			;COUNT RECORDS ON WAY IN
	PJRST	RELES%			;RELEASE RECORD TO SORT
ENDB;
SUBTTL	SRTMRG -- Simulate Master End of File

BEGIN;
  PROCEDURE	(PUSHJ	P,SRTMRG)
;
;CALL WITH:
;	STATUS = SRTMRG()
;
	PUSHJ	P,.SAVE			;SAVE DATATRIEVE'S ACS
	SKIPE	INITED			;IS THE SORT ACTIVE?
	SKIPE	MRGDON			;HAS A MERGE NOT BEEN DONE?
	  JRST	E$$MRO			;NO-AN ERROR
	HLRZ	F,RN.FCB(S)		;GET FILE POINTER
	SETOM	MRGDON			;FLAG THAT MERGE WAS DONE
  IF NO RECORDS WERE RELEASED TO THE SORT
	SKIPE	FSTREL			;FIRST RELEASE DONE?
	JRST	$F			;YES
  THEN FLAG THAT NO RECORDS ARE TO BE RETURNED
	SETOM	LASRET			;ALLOW ONLY ONE RETURN
	RETURN				;MAY NOT MERGE 0 RECORDS
  FI;
	AOS	LASRET			;ENABLE RETURNS
	MOVEM	P,PSAV			;*** KLUDGE SO MERGE WILL WORK
	PJRST	MERGE%			;START UP THE MERGE PHASE
ENDB;
SUBTTL	SRTRET -- Copy Records From Tree to Output File

BEGIN;
  PROCEDURE	(PUSHJ	P,SRTRET)
;
;CALL WITH:
;	STATUS = SRTRET(STRING,RECORD-LENGTH)
;
;THE STRING DESCRIPTOR CONTAINS A BYTE POINTER, AND THE NEXT WORD
;	IN THE DESCRIPTOR CONTAINS A BYTE COUNT.
;RECORD-LENGTH IS THE LENGTH OF THE RECORD BEING RETURNED.
;
	PUSHJ	P,.SAVE			;SAVE DATATRIEVE'S ACS
  IF NO MORE RECORDS TO BE RETURNED
	SKIPL	LASRET			;ANY MORE RECORDS TO RETURN?
	JRST	$T			;MORE TO DO
  THEN FLAG LAST AND RETURN ZERO AS THE RECORD LENGTH
	SETZM	LASRET			;STOP ALLOWING RETURNS
	SETZM	@1(L)			;ZERO RECORD LENGTH
	RETURN				;DONE
  ELSE GET NEXT RECORD
	SKIPN	LASRET			;RETURNS ENABLED?
	  JRST	E$$RTO			;NO, GIVE USER ERROR MESSAGE
	MOVEI	T1,RC.KEY(R)		;GET ADDRESS OF RECORD IN TREE
	ADD	T1,XTRWRD		;MOVE PAST CONVERTED KEYS
	HLL	T1,BYTPTR		;FORM BYTE POINTER
	MOVE	T2,RC.CNT(R)		;GET LENGTH OF RECORD
	XHLLI	T2,RC.KEY(R)		;GET SECTION OF RECORD IN TREE
	HRRZM	T2,@1(L)		;RETURN SIZE OF RECORD IN BYTES
	DMOVE	T3,@0(L)		;GET BYTE POINTER TO RECORD
	XHLLI	T4,@0(L)		;GET STRING'S SECTION
	PUSHJ	P,STRCPY		;COPY STRING
	  JRST	E$$RLS			;RETURN RECORD TOO SMALL
	AOS	OUTREC			;COUNT ONE MORE RECORD OUTPUT 
	XMOVEI	T1,EOFDTR		;*** KLUDGE TO TRAP END OF FILE
	MOVEM	T1,SAVEPC		;*** RETURN IN EOFCBL TO EOFDTR
	XMOVEI	T1,SAVEPC		;*** BY SAVING FAKE STACK
	MOVEM	T1,PSAV			;*** IN PSAV
	PJRST	RETRN%			;GET THE NEXT RECORD
  FI;
ENDB;

BEGIN;
  PROCEDURE	(PUSHJ	P,EOFDTR)
	SETOM	LASRET			;WANT ONLY ONE MORE RECORD
	JRST	.RESTR			;RETURN TO DATATRIEVE
ENDB;
SUBTTL	SRTEND -- Clean Up After Sort

BEGIN;
  PROCEDURE	(PUSHJ	P,SRTEND)
;
;CALL WITH:
;	STATUS = SRTEND()
;
	PUSHJ	P,.SAVE			;SAVE DATATRIEVE'S ACS
  IF USER ROUTINE EXITED BEFORE E-O-F
	SKIPN	LASRET			;DID WE END NORMALLY?
	JRST	$T			;YES
  THEN DELETE ANY OPEN FILES
	MOVE	T1,$RETRN		;GET WHICH RETRN WAS USED
	CAIE	T1,RETRN0		;ALL IN CORE?
	SKIPN	ACTTMP			;  OR ALL TEMP FILES GONE ALREADY?
	JRST	$F			;YES, NO FILE TO CLOSE
	  IF ONE TEMP FILE
		CAIE	T1,RETRN1		;1 FILE?
		JRST	$T			;NO
	  THEN JUST DELETE THIS FILE
		MOVEI	F,TMPFCB		;POINTER
		PUSHJ	P,DELFIL		;DELETE FILE
		JRST	$F			;DONE
	  ELSE DELETE ALL OPEN FILES
		BEGIN
			HLRZ	F,RN.FCB(S)		;GET WHICH FILE
			PUSHJ	P,DELFIL		;DELETE IT
			SOSG	ACTTMP			;SOME LEFT?
			JRST	$E			;NO
			HLLOS	RQ			;FLUSH TREE
			PUSHJ	P,SETTRE		;GET NEXT RECORD
			JRST	$B			;LOOP
		ENDB;
	  FI;
	JRST	$F			;
  ELSE MAKE SURE ALL RECORDS WERE OUTPUT
	SKIPN	MRGDON			;WAS A MERGE DONE?
	JRST	$F			;NO-THAT'S WHY LASRET IS ZERO
	MOVE	T1,INPREC
	CAME	T1,OUTREC
	JRST	[PUSHJ	P,E$$RNI	;RECORD NUMBER INCONSISTENT
		JRST	DIE]		;NOW GO DIE
  FI;
	PUSHJ	P,RESETC		;RESET CORE AND FILES
	SETZM	INITED			;INDICATE DONE WITH SORT
	SETZM	FSTREL			;INDICATE FIRST RELEASE NOT DONE
	SETZM	MRGDON			;INDICATE MERGE NOT DONE
	SETZM	LASRET			;STOP ALLOWING RETURNS
	RETURN				;RETURN TO DATATRIEVE
ENDB;
SUBTTL	SRTERR -- Return text of error message

BEGIN;
  PROCEDURE	(PUSHJ	P,SRTERR)
;
;CALL WITH:
;	CALL SRTERR(STRING)
;
;THE STRING DESCRIPTOR CONTAINS A BYTE POINTER, AND THE NEXT WORD
;	IN THE DESCRIPTOR CONTAINS A BYTE COUNT.
;
					;DO NOT CALL .SAVE HERE!
	DMOVE	T1,@0(L)		;GET POINTER TO ERROR STRING
	XHLLI	T2,@0(L)		;GET ERROR STRING'S SECTION
	PUSHJ	P,BYTGLB		;CONVERT TO TWO-WORD GLOBAL
	MOVE	P3,T1			;SAVE BYTE COUNT
	DMOVE	P1,T2			;SAVE BYTE POINTER
	MOVE	T1,[POINT 7,ERRMSG]	;GET POINTER TO ERROR MESSAGE
	MOVEI	T2,ERRLEN		;COMPUTE HOW MANY CHARS
	SUB	T2,ERRCTR		; IN ERROR MESSAGE
	SKIPN	T2			;WAS THERE ANY PREVIOUS ERROR?
	DMOVE	T1,[POINT 7,NOTERR
			NOTLEN*5]	;NO, MAKE NOT AN ERROR MESSAGE
	XHLLI	T2,ERRMSG		;GET ERROR MESSAGE'S SECTION
	PUSHJ	P,BYTGLB		;CONVERT TO TWO-WORD GLOBAL
	MOVE	T4,P3			;GET DESTINATION BYTE COUNT
	EXTEND	T1,[MOVSLJ
			0]		;COPY TO USER'S STRING
	  JFCL				;DON'T CARE IF MESSAGE TRUNCATED
	RETURN				;DONE

NOTERR:	ASCII	/[There was no error]/
NOTLEN==.-NOTERR

ENDB;
SUBTTL	ACCUMULATOR SAVE/RESTORE ROUTINE

BEGIN;
  PROCEDURE	(PUSHJ	P,.SAVE)
;
;THIS IS A CO-ROUTINE WHICH EXCHANGES DATATRIEVE'S ACS WITH SORT'S ACS,
;SETS UP A NEW STACK, AND INITIALIZES THE ERROR MESSAGE HANDLER.
;
;WHEN CONTROL IS RETURNED TO .RESTR, IT EXCHANGES THE ACS AGAIN,
;AND RETURNS A SUCCESS/FAILURE VALUE IN AC0.
;
;CALL WITH:
;	PUSHJ	P,.SAVE
;
	SETOM	RETVAL			;ASSUME CALL WILL BE SUCCESSFUL
	POP	P,SAVEPC		;POP OFF THE CALLER'S PC
	MOVEI	0,SAVACS		;SAVE THE ACS
	BLT	0,SAVACS+17		;..
	DMOVE	R,SORTAC		;RESTORE THE SORT ACS
	XMOVEI	P,STACK-1		;GET NEW STACK IN SORT'S SECTION
	DMOVE	T1,[POINT 7,ERRMSG
			ERRLEN]		;INITIALIZE ERROR MESSAGE
	DMOVEM	T1,ERRPTR		; POINTER AND COUNTER
	XMOVEI	T1,ERRCHR		;GET ADDRESS OF CHAR PUTTER
	PUSHJ	P,.TYOCH		;ALL SCAN OUTPUT GOES TO ERRCHR
	PUSHJ	P,@SAVEPC		;CALL THE CALLER
.RESTR:	DMOVEM	R,SORTAC		;SAVE THE SORT ACS
	MOVSI	17,SAVACS		;RESTORE THE ACS
	BLT	17,17			;..
	MOVE	0,RETVAL		;GET VALUE TO BE RETURNED
	RETURN
ENDB;
SUBTTL	STRCPY -- String Copy Routine

BEGIN;
  PROCEDURE	(PUSHJ	P,STRCPY)
;
;CALL WITH:
;	T1/SOURCE BYTE POINTER
;	T2/SOURCE SECTION,,SOURCE BYTE COUNT
;	T3/DEST   BYTE POINTER
;	T4/DEST   SECTION,,DEST   BYTE COUNT
;	PUSHJ	P,STRCPY
;	  ERROR	RETURN	(DESTINATION TOO SHORT)
;	NORMAL RETURN
;
;DESTROYS T1-T4,P1-P4
;
	DMOVE	P3,T1			;SAVE SOURCE STRING DESCRIPTOR
	DMOVE	T1,T3			;GET DEST STRING DESCRIPTOR
	PUSHJ	P,BYTGLB		;MAKE 2-WORD GLOBAL BYTE POINTER
	DMOVE	P1,T2			;SAVE BYTE POINTER
	EXCH	T1,P3			;SAVE DEST BYTE COUNT
	MOVE	T2,P4			;GET SOURCE BYTE COUNT
	PUSHJ	P,BYTGLB		;MAKE 2-WORD GLOBAL BYTE POINTER
	MOVE	T4,P3			;GET DEST BYTE COUNT
  IF RECORDS START AT SAME BIT BOUNDARY AND DESTINATION IS LONG ENOUGH
	CAMN	T2,P1			;COMPARE P AND S FIELDS
	CAMLE	T1,T4			;SEE IF ROOM IN DESTINATION
	JRST	$T			;NOT SAME OR RECORD TOO SHORT
  THEN COPY USING XBLT
	PUSHJ	P,BYTBLT		;COPY STRING USING XBLT
	SKIPN	T4			;PARTIAL WORD LEFT?
	AOSA	(P)			;ALL DONE--GIVE GOOD RETURN
  ELSE COPY USING MOVSLJ
	EXTEND	T1,[MOVSLJ
			0]		;COPY THE STRING WITH NULL FILL
	  RETURN			;ERROR--GIVE NON-SKIP RETURN
	AOS	(P)			;GIVE GOOD RETURN
	RETURN				;ALL DONE!
  FI;
ENDB;
SUBTTL	STRCPY -- BLT all full words in string

BEGIN;
  PROCEDURE	(PUSHJ	P,BYTBLT)
;
;CALL WITH:
;	T1/SOURCE BYTE COUNT
;	T2/SOURCE TWO-WORD GLOBAL BYTE POINTER
;	T3/..
;	T4/DEST BYTE COUNT
;	P1/DEST TWO-WORD GLOBAL BYTE POINTER
;	P2/..
;	PUSHJ	P,BYTBLT
;	RETURNS	WITHOUT COPYING LAST PARTIAL WORD
;
;DESTROYS T1-T4,P1-P4.  ASSUMES T2 AND P1 ARE THE SAME.
;
  IF BYTES LEFT IN FIRST WORD
	SKIPN	P3,BYTLFT		;GET BYTES LEFT IN FIRST WORD
	JRST	$F			;NO BYTES LEFT IN THIS WORD
  THEN COPY THE FIRST PARTIAL WORD
	CAMGE	T1,P3			;DO WE EVEN FILL A PARTIAL WORD?
	RETURN				;NO, BETTER LET MOVSLJ DO IT
	MOVE	T2,BYTFST		;GET POINTER TO FIRST PART
	MOVE	P1,T2			;DEST IS SAME AS SOURCE
	LDB	P4,T2			;GET THE FIRST PARTIAL WORD
	DPB	P4,P1			;STORE THE PARTIAL WORD
	SUB	T4,P3			;FIX HOW MANY BYTES LEFT IN DEST
  FI;
  IF THERE ARE ANY INTERMEDIATE FULL WORDS
	SUBB	T1,P3			;COMPUTE HOW MANY BYTES TO GO
	IDIV	P3,BYTWRD		;COMPUTE HOW MANY WORDS TO GO
	JUMPE	P3,$F			;ANY FULL WORDS TO COPY?
  THEN COPY THE WORDS WITH XBLT
	MOVE	T1,P3			;GET WORDS TO TRANSFER
	AOS	T2,T3			;COMPUTE SOURCE ADDRESS
	AOS	T3,P2			;COMPUTE DEST ADDRESS
	EXTEND	T1,[XBLT]		;COPY THE RECORD
	IMUL	P3,BYTWRD		;COMPUTE BYTES TRANSFERRED
	SUB	T4,P3			;COMPUTE BYTES REMAINING IN DEST
    IF BYTES REMAINING IN DESTINATION
	JUMPE	T4,$F			;NO BYTES REMAINING IN DEST
    THEN SET UP FOR COPY OF LAST PARTIAL WORD WITH MOVSLJ
	MOVE	P2,T3			;UPDATE NEW DEST ADDRESS
	MOVE	T3,T2			;UPDATE NEW SOURCE ADDRESS
	MOVE	T1,P4			;GET BYTES REMAINING IN SOURCE
	MOVE	T2,BYTLST		;GET GLOBAL BYTE POINTER
	MOVE	P1,T2			;DEST IS SAME AS SOURCE
    FI;
  FI;
	RETURN				;ALL DONE!
ENDB;
SUBTTL	STRCPY -- Initialize BYTBLT Constants

BEGIN;
  PROCEDURE	(PUSHJ	P,BYTINI)
;
;THIS ROUTINE INITIALIZES ALL THE CONSTANTS NEEDED BY BYTBLT
;
;CALL WITH:
;	T1/BYTE POINTER TO STRING
;	T2/STRING SECTION,,LENGTH OF STRING IN BYTES
;	PUSHJ	P,BYTINI
;
	PUSHJ	P,BYTGLB		;MAKE 2-WORD GLOBAL BYTE POINTER
	TLZ	T2,77			;GET JUST P AND S
	HLLZM	T2,BYTPTR		;SAVE P AND S FOR LATER
	LDB	T3,[POINT 6,T2,5]	;GET STARTING POSITION
	LDB	T4,[POINT 6,T2,11]	;GET BYTE SIZE
	JUMPE	T4,E$$IBS		;MAKE SURE BYTE POINTER OK
	CAILE	T4,^D36			;LEGAL BYTE SIZE?
	  JRST	E$$IBS			;NO-ERROR
	MOVE	T1,T3			;GET BITS LEFT IN WORD
	LSH	T1,^D24			;MAKE INTO BYTE POINTER TO
	TLO	T1,(<POINT 0,,35>!1B12)	; FIRST PART OF RECORD
	MOVEM	T1,BYTFST		;SAVE FOR LATER
	MOVE	T1,T4			;GET BYTE SIZE
	LSH	T1,^D24			;MAKE INTO BYTE POINTER TO
	TLO	T1,(<POINT 0,,-1>!1B12)	; LAST PART OF RECORD
	MOVEM	T1,BYTLST		;SAVE FOR LATER
	MOVEI	T1,^D36			;GET NUMBER OF BITS IN A WORD
	IDIV	T1,T4			;COMPUTE BYTES/WORD
	MOVEM	T1,BYTWRD		;SAVE FOR LATER
	IDIV	T3,T4			;GET NUMBER OF BYTES LEFT
	MOVEM	T3,BYTLFT		;SAVE FOR LATER
	MOVEI	T1,^D36			;POSITION WHEN PRE-DECREMENTED
	SKIPN	T3			;IF THERE ARE NO BYTES LEFT
	DPB	T1,[POINT 6,BYTPTR,5]	;CONVERT TO PRE-DECREMENTED FORM
	RETURN				;DONE
ENDB;
SUBTTL	STRCPY -- Convert One-word Byte Pointers to Two Words

BEGIN;
  PROCEDURE	(PUSHJ	P,BYTGLB)
;
;CALL WITH:
;	T1/LOCAL OR ONE-WORD GLOBAL BYTE POINTER
;	T2/BYTE SECTION,,BYTE COUNT
;	PUSHJ	P,BYTGLB
;RETURNS:
;	T1/BYTE COUNT
;	T2/TWO-WORD GLOBAL BYTE POINTER (NOT PRE-DECREMENTED)
;	T3/..
;DESTROYS T4
;
	SETZ	T3,			;MAKE SURE BYTE POINTER
	ADJBP	T3,T1			; IS NOT PRE-DECREMENTED
	DMOVE	T1,T2			;SWAP COUNT AND POINTER
  IF BYTE POINTER IS A ONE WORD GLOBAL BYTE POINTER
	LDB	T4,[POINT 6,T2,5]	;GET BYTE POSITION
	CAIG	T4,44			;ANYTHING > 44 IS GLOBAL
	JRST	$T			;LOCAL
  THEN CONVERT ONE-WORD TO TWO-WORD GLOBAL BYTE POINTER FORMAT
	TLZ	T1,-1			;CLEAR JUNK FROM COUNT
	LDB	T3,[POINT 30,T2,35]	;GET SECTION AND ADDRESS
	MOVE	T2,BYTTAB-45(T4)	;GET TWO-WORD P AND S
	RETURN				;DONE
  ELSE CONVERT LOCAL TO TWO-WORD GLOBAL BYTE POINTER FORMAT
	LDB	T3,[POINT 5,T2,17]	;GET I AND X FROM BYTE POINTER
	LSH	T3,^D30			;POSITION FOR TWO-WORD FORMAT
	OR	T3,T1			;GET BYTE SECTION
	HRR	T3,T2			;GET BYTE ADDRESS
	TLZ	T1,-1			;CLEAR JUNK FROM COUNT
	AND	T2,[777700,,0]		;CLEAR JUNK IN BYTE POINTER
	TLO	T2,(1B12)		;AND SET TWO-WORD FORMAT FLAG
	RETURN				;DONE
  FI;
ENDB;

BYTTAB:	EXP <POINT 6,,-1>!1B12,<POINT 6,,5>!1B12,<POINT 6,,11>!1B12
	EXP <POINT 6,,17>!1B12,<POINT 6,,23>!1B12,<POINT 6,,29>!1B12
	EXP <POINT 6,,35>!1B12,<POINT 8,,-1>!1B12,<POINT 8,,7>!1B12
	EXP <POINT 8,,15>!1B12,<POINT 8,,23>!1B12,<POINT 8,,31>!1B12
	EXP <POINT 7,,-1>!1B12,<POINT 7,,6>!1B12,<POINT 7,,13>!1B12
	EXP <POINT 7,,20>!1B12,<POINT 7,,27>!1B12,<POINT 7,,34>!1B12
	EXP <POINT 9,,-1>!1B12,<POINT 9,,8>!1B12,<POINT 9,,17>!1B12
	EXP <POINT 9,,26>!1B12,<POINT 9,,35>!1B12,<POINT 18,,-1>!1B12
	EXP <POINT 18,,17>!1B12,<POINT 18,,35>!1B12,<0>!1B12
SUBTTL	ERROR MESSAGES

;HERE ON FATAL ERRORS

E$$IKT:	$ERROR	?,IKT,<Illegal key type code.>

E$$MTL:	$ERROR	?,MTL,<Maximum record length is too large for sort.>

E$$IBS:	$ERROR	?,IBS,<Illegal byte size specified for record.>

E$$RLZ:	$ERROR	?,RLZ,<Record length may not be equal to zero.>

E$$RLM:	$ERROR	?,RLM,<Record length exceeds maximum declared length.>

E$$RLS:	$ERROR	?,RLS,<Return record length is too small.>

E$$RLO:	$ERROR	?,RLO,<SRTREL called out of sequence.>

E$$MRO:	$ERROR	?,MRO,<SRTMRG called out of sequence.>

E$$RTO:	$ERROR	?,RTO,<SRTRET called out of sequence.>

DIE:	$CRLF			;CLOSE OUT LINE
	SETZM	RETVAL		;FLAG FAILURE OF THE CALL
	JRST	.RESTR		;ABORT THIS SUBROUTINE CALL

RESETC:
IFE FTOPS20,<
	PJRST	RELSPC		;RELEASE ANY RETAINED MEMORY
>
IFN FTOPS20,<
;*** WARNING *** THE FOLLOWING CODE IS PURE KLUDGERY!
	SKIPE	MRGDON		;WAS A MERGE DONE?
	PJRST	RESET$		;YES-JUST RESET CORE
	MOVE	T1,NUMTMP	;NO-FIX UP ACTTMP FOR ERSET$
	MOVEM	T1,ACTTMP	;NUMBER OF ACTIVE TEMPORARY FILES
	XMOVEI	T2,DFBORG	;DATA FILE BLOCK ORIGIN
	XMOVEI	T3,TMPFCB	;.TMP FILE CONTROL BLOCK
	ADDI	T3,FCBLEN	;SKIP PAST CURRENT .TMP FILE
RESTC1:	MOVE	T4,FILJFN(T2)	;GET JFN OF FILE
	MOVEM	T4,FILJFN(T3)	;STORE IT SO ERSET$ CAN FIND IT
	ADDI	T2,DFBLEN	;ADVANCE TO NEXT DFB
	ADDI	T3,FCBLEN	;ADVANCE TO NEXT FCB
	SOJG	T1,RESTC1	;LOOP FOR ALL TEMPORARY FILES
	PJRST	ERSET$		;RESET CORE AND FILES
>

ERRCHR:	CAIGE	T1," "		;CONTROL CHARACTER?
	POPJ	P,		;YES, THROW IT AWAY
	SOSL	ERRCTR		;ROOM LEFT IN ERRMSG?
	IDPB	T1,ERRPTR	;YES, APPEND IT TO STRING
	POPJ	P,		;RETURN


	END