Google
 

Trailing-Edge - PDP-10 Archives - BB-L014Y-BM_1990 - cblsrc/srtcrf.mac
There are 22 other files named srtcrf.mac in the archive. Click here to see a list.
; UPD ID= 1637 on 6/26/84 at 4:50 PM by MCARLETON                       
TITLE	SRTCRF FOR COBOL V13
SUBTTL	SORT THE CREF DATA	AL BLACKINGTON/CAM/KWS

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

	SEARCH	P
	%%P==:%%P
IFN TOPS20,<SEARCH	MONSYM,MACSYM>

TWOSEG
	.COPYRIGHT		;Put standard copyright statement in REL file
RELOC	400000
SALL

;EDITS
;V13*****************
;NAME	DATE		COMMENTS
;MJC	12-JAN-85	[1555] Flush buffers before closing tmp files
;KWS	16-NOV-84	[1552] Fix crash in sort by changing pushj to jrst
;MJC    18-JUN-84       [1540] Nativeize CORE UUO in sort setup.
;********************


ENTRY PSORT	;SET UP FOR SORT
ENTRY RELES	;GET A RECORD FROM CALLING PROGRAM
ENTRY RETRN	;GIVE A RECORD TO CALLING PROGRAM
ENTRY MERGE	;MERGE SCRATCH FILES

NUMFIL==3	;NUMBER OF TEMP FILES
SZ.SR==6	;SIZE OF SORT RECORD
SZ.BUF==203	;SIZE OF ONE BUFFER

IFE TOPS20,<OPDEF	TYPE	[OUTSTR]>
IFN TOPS20,<OPDEF	TYPE	[HRROI	T1,]>
PSORT:	HRRZ	TE,.JBFF##	;SET
IFE TOPS20,<
	MOVEM	TE,SF1BUF	;  ASIDE
	ADDI	TE,SZ.BUF*2	;  AREA
	MOVEM	TE,SF2BUF	;  FOR
	ADDI	TE,SZ.BUF*2	;  SCRATCH
	MOVEM	TE,SF3BUF	;  BUFFERS
	ADDI	TE,SZ.BUF*2	;SET UP
>
	MOVEM	TE,CRFTAB	;  START OF ADDRESS TABLE

PSORT1:	HRRZ	TE,.JBREL##	;COMPUTE
	ADDI	TE,1		;  NUMBER
	SUB	TE,CRFTAB	;  OF TABLE
	IDIVI	TE,SZ.SR+1	;  ENTRIES

	CAIL	TE,NUMFIL	;ENOUGH ROOM FOR THREE FILES?
	JRST	PSORT2		;YES

	HRRZ	TE,.JBREL	;NO
	ADDI	TE,2000		;  GET
IFE TOPS20, <
	CALLI	TE,$CORE	;  ANOTHER 1K OF CORE
>
IFN TOPS20, <
	PUSHJ	PP,GETCOR##	;[1540]CALL TO GET 1K OF CORE
>
	  JRST	NOCORE		;COULDN'T--TOUGH
	JRST	PSORT1

PSORT2:	MOVEM	TE,CRFSIZ	;SAVE TABLE SIZE

	MOVNS	TE		;FORM
	MOVSS	TE		;  <XWD -CRFSIZ,CRFTAB>
	HRR	TE,CRFTAB	;  *

	MOVE	TD,CRFTAB	;COMPUTE
	ADD	TD,CRFSIZ	;  FIRST FREE SLOT

PSORT3:	MOVEM	TD,(TE)		;FILL
	ADDI	TD,SZ.SR	;  TABLE
	AOBJN	TE,PSORT3	;  WITH ADDRESSES

	SWOFF	FSRTIO		;TURN OFF 'FILES ARE READY'
	SETZM	CRFTEN		;START AT
	SETZM	CRFLOW		;  TOP OF TABLE

	MOVEI	TE,NUMFIL-1
PSORT4:	SETZM	CRFTS(TE)
	SETZM	CRFSTA(TE)
	SOJGE	TE,PSORT4

	MOVEI	TE,1		;SET 'POWER OF 2 THAT
	MOVEM	TE,CRFPWR	;  IS > TABLE SIZE

	POPJ	PP,
RELES:	TSWF	FSRTIO		;ARE FILES SET UP?
	JRST	RELES6		;YES
	SKIPN	TE,CRFTEN	;NO--IS TABLE EMPTY?
	JRST	RELS1A		;YES
	CAMN	TE,CRFSIZ	;NO--IS IT FULL?
	JRST	RELES4		;YES

	PUSHJ	PP,BINSER	;NO--FIND PLACE FOR THE NEW RECORD
	MOVE	TD,CRFTEN	;SAVE VALUE OF 'CRFTEN'
	MOVE	TC,TD		;SAVE
	ADD	TC,CRFTAB	;  ADDRESS TO WHICH
	MOVE	TA,(TC)		;  'CRFTEN' POINTS

	AOS	CRFTEN		;INCREMENT NUMBER OF ENTRIES IN TABLE

	SUB	TD,TE		;COMPUTE DISTANCE FROM TOP FOR NEW ITEM
	JUMPE	TD,RELES3	;IF ZERO, NO NEED TO MOVE STUFF

RELES1:	MOVE	TB,-1(TC)	;MOVE ADDRESSES
	MOVEM	TB,(TC)		;  UP IN CORE
	SOJLE	TD,RELES2	;  TO MAKE ROOM FOR NEW ADDRESS
	SOJA	TC,RELES1

RELS1A:	MOVE	TC,CRFTAB
	MOVE	TA,(TC)
	AOSA	CRFTEN

RELES2:	MOVEM	TA,-1(TC)

RELES3:	MOVE	TD,TA		;MOVE NEW RECORD TO
	HRLI	TD,GCREFN	;  SCRATCH
	BLT	TD,SZ.SR-1(TA)	;  AREA

	MOVE	TE,CRFLOW	;IF MORE
	CAMGE	TE,CRFTEN	;  VISIBLE ENTRIES,
	POPJ	PP,		;  LEAVE

	SETZM	CRFLOW		;RESET TO TOP OF TABLE
	PUSHJ	PP,RITEOS	;WRITE 'E-O-S' ON CURRENT FILE
	SOS	CRFSTA(TD)	;DEDUCT ONE FROM 'STRINGS TO ADD'
	JRST	GETNFL		;GET NEXT FILE READY, AND LEAVE
;TABLE IS FULL, BUT FILES HAVEN'T BEEN INITIALIZED

RELES4:
IFE TOPS20,<
	MOVEI	TE,NUMFIL-1
RELS4A:	MOVE	TD,INITS(TE)	;SET UP
	MOVE	TC,3(TD)	;  AND
	ADD	TC,[OPEN (TD)]	;  EXECUTE
	XCT	TC		;  'OPEN'
	  JRST	CANTOP		;FAILURE--QUIT
	CAIE	TE,NUMFIL-1	;DO
	PUSHJ	PP,OPENO	;  'ENTER'
	MOVEI	TC,1		;  FOR
	MOVEM	TC,CRFSTA(TE)	;  ALL BUT
	SOJGE	TE,RELS4A	;  LAST FILE
>
IFN TOPS20,<
	PUSHJ	PP,OPNSF##	;SET UP TEMP FILES
	MOVEI	TC,1		;
	MOVEM	TC,CRFSTA	;
	MOVEM	TC,CRFSTA+1	;
	MOVEM	TC,CRFSTA+2	;
>
	SETZM	CRFCUR
	SETZM	CRFSTA+NUMFIL-1
	SWON	FSRTIO		;SET 'FILES ARE READY'

;FILES HAVE BEEN SET UP

RELES6:	MOVE	TE,CRFLOW	;WRITE OUT
	PUSHJ	PP,WRITE	;  SMALLEST RECORD
	PUSHJ	PP,BINSER	;FIND PLACE FOR NEW RECORD

	MOVE	TC,CRFLOW
	MOVE	TD,TC		;SAVE
	ADD	TC,CRFTAB	;  ADDRESS OF
	MOVE	TA,(TC)		;  RECORD JUST WRITTEN
	SUB	TD,TE		;COMPUTE DISTANCE FROM NEW RECORD
	JUMPL	TD,RELES7	;IF LESS, NEW ITEM IS NOT LESS THAN ONE WRITTEN
	AOS	CRFLOW		;NEW ITEM IS LESS THAN ONE WRITTEN
	JUMPE	TD,RELES3
	JRST	RELES1

;NEW ENTRY IS LARGER THAN, OR EQUAL TO, LAST ONE WRITTEN

RELES7:	HRLI	TC,1(TC)	;MOVE ADDRESSES
	MOVE	TD,TE		;  ABOVE
	ADD	TD,CRFTAB	;  CRFLOW
	CAIE	TD,-1(TC)	;  UNITL
	BLT	TC,-2(TD)	;  AT ADDRESS FOR NEW RECORD
	MOVEM	TA,-1(TD)	;STASH ADDRESS OF NEW RECORD
	JRST	RELES3
;MERGE THE SCRATCH FILES

MERGE:	TSWT	FSRTIO		;WERE ANY FILES INITIALIZED?
	POPJ	PP,		;NO--QUIT

	MOVE	TE,CRFLOW	;WRITE
	PUSH	PP,TE
MERGE1:	PUSHJ	PP,WRITE	;  OUT
	AOS	TE,CRFLOW	;  VISIBLE
	CAME	TE,CRFTEN	;  RECORDS
	JRST	MERGE1		;  *

	MOVE	TE,(PP)		;IF NO INVISIBLE ONES,
	JUMPE	TE,MERGE3	;  NO NEW STRING NEEDED

	PUSHJ	PP,RITEOS	;CLOSE OUT STRING
	SOS	CRFSTA(TD)	;DEDUCT ONE FROM 'STRINGS NEEDED' COUNT
	PUSHJ	PP,GETNFL	;OPEN UP ANOTHER

	SETZB	TE,CRFLOW	;WRITE
MERGE2:	PUSHJ	PP,WRITE	;  OUT
	AOS	TE,CRFLOW	;  ALL
	CAME	TE,(PP)		;  INVISIBLE
	JRST	MERGE2		;  RECORDS

MERGE3:	POP	PP,CRFLOW	;RESTORE ORIGINAL 'CRFLOW'
	PUSHJ	PP,RITEOS	;CLOSE OUT LAST STRING
	SOS	CRFSTA(TD)	;DEDUCT ONE FROM 'NUMBER OF STRINGS NEEDED'

IFN TOPS20,<
	PUSHJ	PP,RITSF1	;[1555] FLUSH THE BUFFER FOR SF1
	PUSHJ	PP,RITSF2	;[1555] FLUSH THE BUFFER FOR SF2
	PUSHJ	PP,CLSSF1	;CLOSE SF1
	PUSHJ	PP,CLSSF2	;CLOSE SF2
	PUSHJ	PP,SETSF1	; OPEN FILE FOR INPUT
	PUSHJ	PP,SETSF2
>
	MOVEI	TE,NUMFIL-2
MERG3A:
IFE TOPS20,<
	PUSHJ	PP,CLOSER	;CLOSE OUTPUT FILE
	PUSHJ	PP,OPENI	;OPEN FILES AS INPUT
>
	MOVE	TD,CRFSTA(TE)	;ADD 'NUMBER OF STRINGS NEEDED' TO
	ADDM	TD,CRFTS(TE)	;  'TOTAL NUMBER OF STRINGS ON FILE'
	SOJGE	TE,MERG3A

	MOVEI	TD,NUMFIL-1	;CURRENT OUTPUT
	MOVEM	TD,CRFCUR	;  FILE IS LAST ONE
;STARTING A NEW OUTPUT FILE

MERGE4:	MOVE	TE,CRFCUR	;OPEN UP
IFE TOPS20,<
	PUSHJ	PP,OPENO	;  NEW OUTPUT FILE
>
IFN TOPS20,<
	PUSHJ	PP,@OPNSFX(TE)	; OPEN FILE FOR OUTPUT
>

	MOVEI	TE,NUMFIL-1	;ADD UP
	MOVEI	TD,0		;  STRINGS
MERG4A:	CAME	TE,CRFCUR	;  ON ALL
	ADD	TD,CRFTS(TE)	;  INPUT  FILES
	SOJGE	TE,MERG4A
	CAIG	TD,NUMFIL-1	;IF TOTAL OF STRINGS IS NO MORE THAN ONE PER FILE,
	JRST	MERG10		;  SET UP INPUT FILES AND LEAVE

;START NEW STRING OF OUTPUT

MERGE5:	PUSHJ	PP,MERG10	;SET UP INPUT FILES

;MERGE INPUTS INTO OUTPUT

MERG5A:	PUSHJ	PP,MERG20	;FIND THE SMALLEST RECORD
	  JRST	MERGE6		;ALL FILES AT END OF STRING

	PUSH	PP,TE		;SAVE TE
	PUSHJ	PP,WRITE	;WRITE OUT SMALLEST RECORD
	POP	PP,TE		;RESTORE TE
	PUSHJ	PP,READ		;GET ANOTHER RECORD FROM THAT FILE
	JRST	MERG5A		;LOOP

;ALL INPUT STRINGS ARE EMPTY

MERGE6:	PUSHJ	PP,RITEOS	;WRITE 'EOS' ON CURRENT OUTPUT

	MOVEI	TE,NUMFIL-1	;IF
MERG6A:	SKIPN	CRFTS(TE)	;  ANY FILES
	JRST	MERGE7		;  ARE EMPTY, WE NEED NEW OUTPUT
	SOJGE	TE,MERG6A
	JRST	MERGE5		;LOOP BACK FOR MORE STRINGS

;ONE INPUT FILE IS EMPTY--IT BECOMES NEXT OUTPUT FILE

MERGE7:
IFE TOPS20,<
	PUSHJ	PP,CLOSER	;CLOSE INPUT FILE
>
IFN TOPS20,<
	PUSHJ	PP,@CLSSFX(TE)	;CLOSE FILE
>
	EXCH	TE,CRFCUR	;RESET 'CURRENT OUTPUT'
IFE TOPS20,<
	PUSHJ	PP,CLOSER	;CLOSE OLD OUTPUT FILE
	PUSHJ	PP,OPENI	;OPEN THAT FILE AS INPUT
>
IFN TOPS20,<
	PUSHJ	PP,@RITSFX(TE)	;[1555] FLUSH THE BUFFER
	PUSHJ	PP,@CLSSFX(TE)	;CLOSE INPUT FILE
	PUSHJ	PP,@SETSFX(TE)	;OPEN THAT FILE AS INPUT
>
	JRST	MERGE4
;SET UP ALL INPUT FILES BY GETTING ONE RECORD FROM EACH

MERG10:	MOVEI	TE,NUMFIL-1
	SETZM	CRFNE

MRG10A:	CAMN	TE,CRFCUR	;DON'T LOOK AT
	JRST	MRG10B		;  OUTPUT FILE
	SOS	CRFTS(TE)	;DEDUCT ONE FROM NUMBER OF STRINGS
	SKIPE	CRFSTA(TE)	;IF ANY DUMMY STRINGS,
	JRST	MERG11		;  SPECIAL PROCESSING
	SETZM	CRFEOS(TE)	;FILE IS NOT AT 'EOS'
	PUSHJ	PP,READ		;READ ONE RECORD
MRG10B:	SOJGE	TE,MRG10A	;LOOP

	MOVE	TD,CRFNE	;IF NOT ALL
	CAIE	TD,NUMFIL-1	;  FILES HAD DUMMY STRINGS
	POPJ	PP,		;  WE ARE DONE


	MOVE	TD,CRFCUR	;ACCOUNT FOR
	AOS	CRFSTA(TD)	;  DUMMY STRING ON OUTPUT FILE
	JRST	MERG10		;TRY AGAIN

MERG11:	SOS	CRFSTA(TE)
	SETOM	CRFEOS(TE)
	AOS	CRFNE
	JRST	MRG10B
;FIND SMALLEST RECORD ON INPUT FILES

MERG20:	MOVEI	TE,NUMFIL-1	;START AT TOP

;LOAD TE WITH INDEX TO FIRST AVAILABLE REAL FILE (IF THERE IS ONE)

MERG21:	CAME	TE,CRFCUR	;IF THIS IS OUTPUT FILE OR
	SKIPE	CRFEOS(TE)	;  THIS INPUT IS AT END-STRING
	SOJGE	TE,MERG21	;  TRY ANOTHER
	JUMPL	TE,MERG29	;IF NO INPUT--QUIT
	JUMPE	TE,MERG28	;IF ONLY ONE INPUT, IT IS SMALLEST
	MOVEI	TD,-1(TE)	;DROP DOWN ONE FILE

;NEXT LOAD TD WITH NEXT AVAILABLE REAL FILE (IF THERE IS ONE)

MERG22:	CAME	TD,CRFCUR	;IF THIS IS OUTPUT FILE OR
	SKIPE	CRFEOS(TD)	;  THIS INPUT IS AT 'EOS',
	SOJGE	TD,MERG22	;  DROP DOWN ONE MORE
	JUMPL	TD,MERG28	;IF NO MORE, 'TE' POINTS TO SMALLEST

;THERE ARE 2 REAL FILES, POINT TO THE ACTUAL RECORDS

MERG23:	MOVE	TA,TE
	ADD	TA,CRFTAB
	MOVE	TA,(TA)
	MOVE	TB,TD
	ADD	TB,CRFTAB
	MOVE	TB,(TB)
	HRLI	TA,-SZ.SR

;NOW DO THE COMPARISON

MERG24:	MOVE	TC,(TA)
	CAME	TC,(TB)
	JRST	MERG25
	AOBJP	TA,MERG26
	AOJA	TB,MERG24

MERG25:	CAML	TC,(TB)
	MOVE	TE,TD

;ALWAYS RETURN WITH TE POINTING TO SMALLEST RECORD

MERG26:	SOJGE	TD,MERG22
MERG28:	AOS	(PP)
MERG29:	POPJ	PP,
;RETURN A RECORD TO CALLING PROGRAM

RETRN:	TSWF	FSRTIO		;WERE ANY FILE INITIALIZED?
	JRST	RETRN2		;YES
	MOVE	TE,CRFLOW	;NO--ARE THERE
	CAMN	TE,CRFTEN	;  ANY MORE RECORDS?
	POPJ	PP,		;NO--RETURN

RETRN1:	ADD	TE,CRFTAB
	MOVS	TE,(TE)
	HRRI	TE,GCREFN
	BLT	TE,GCREFN+SZ.SR-1
	AOS	CRFLOW
	AOS	(PP)
	POPJ	PP,

RETRN2:	PUSHJ	PP,MERG20	;GET SMALLEST RECORD
	  JRST	RETRN3		;NO MORE
	MOVE	TD,TE
	ADD	TD,CRFTAB
	MOVS	TD,(TD)
	HRRI	TD,GCREFN
	BLT	TD,GCREFN+SZ.SR-1
	PUSHJ	PP,READ
	AOS	(PP)
	POPJ	PP,

;THERE ARE NO MORE RECORDS--DELETE THE SCRATCH FILES

RETRN3:
IFN TOPS20,<			
	PJRST	DELSF		;[1552]Delete the SF files
>
IFE TOPS20,<
	MOVEI	TE,NUMFIL-1
RTRN3A:	MOVE	CH,INITS(TE)
	MOVE	CH,3(CH)
	TLO	CH,(CLOSE)
	XCT	CH
	SETZB	TD,TC
	SETZB	TB,TA
	TLZ	CH,777000
	ADD	CH,[RENAME TD]
	XCT	CH
	  JFCL			;IGNORE ERRORS ON DELETE
	AND	CH,[Z 17,]
	TLO	CH,(RELEASE)
	XCT	CH
	SOJGE	TE,RTRN3A
	POPJ	PP,
>
;READ ONE RECORD

;ENTER WITH 'TE' HAVING FILE NUMBER

READ:
IFE TOPS20,<
	MOVE	TD,INITS(TE)	;GET ADDRESS OF I/O TABLE
	MOVE	TD,2(TD)	;PICK UP 'XXXBHI'
>
IFN TOPS20,<
	MOVE	TD,SFXBH(TE)	;GET BUFFER HEADER
>
	MOVE	TC,TE
	ADD	TC,CRFTAB
	MOVE	TC,(TC)
	HRLI	TC,-SZ.SR
	MOVEI	TB,1		;Count words from one

READ1:	SOSG	2(TD)
	JRST	READ3
READ2:	ILDB	TA,1(TD)
	CAIE	TB,SZ.SR	;If sixth word, skip else	
	JUMPE	TA,READ4	;  ZERO MEANS END-OF-STRING (IT
				;  CAN HAPPEN ONLY ON FIRST WORD)
	MOVEM	TA,(TC)
	AOS	TB		;
	AOBJN	TC,READ1
	POPJ	PP,

READ3:
IFE TOPS20,<
	MOVE	TA,INITS(TE)
	MOVE	TA,3(TA)
	TLO	TA,(IN)
	XCT	TA
	  JRST	READ2
	OUTSTR	[ASCIZ "%Input error on Cref Sort file
"]
	JRST	KILCRF
>
IFN TOPS20,<
	PUSHJ	PP,@GETSFX(TE)
	JRST	READ2
>

;END OF STRING

READ4:	SETOM	CRFEOS(TE)
	POPJ	PP,
;WRITE RECORD ONTO CURRENT FILE.
;ENTER WITH 'TE' POINTING TO TABLE ENTRY

WRITE:	ADD	TE,CRFTAB
	MOVE	TE,(TE)
	HRLI	TE,-SZ.SR

WRITE0:	MOVE	TD,CRFCUR
IFE TOPS20,<
	MOVE	TC,INITS(TD)
	MOVS	TC,2(TC)
>
IFN TOPS20,<
	MOVE	TC,SFXBH(TD)	;GET BUFFER HEADER
>

WRITE1:	SOSG	2(TC)
	JRST	WRITE3
WRITE2:	MOVE	TA,(TE)
	IDPB	TA,1(TC)
	AOBJN	TE,WRITE1
	POPJ	PP,

WRITE3:
IFE TOPS20,<
	MOVE	TA,INITS(TD)
	MOVE	TA,3(TA)
	TLO	TA,(OUT)
	XCT	TA
	  JRST	WRITE2
	OUTSTR	[ASCIZ "%Output error on Cref Sort file
"]
	JRST	KILCRF
>
IFN TOPS20,<
	PUSHJ	PP,@RITSFX(TD)
	JRST	WRITE2
>


;WRITE 'EOS' RECORD ON OUTPUT FILE

RITEOS:	MOVEI	TE,[0]
	PUSHJ	PP,WRITE0
	AOS	CRFTS(TD)	;INCREMENT 'TOTAL STRINGS ON FILE'
	POPJ	PP,
;FIND OUT WHICH FILE TO WRITE ON NEXT

GETNFL:	MOVEI	TB,NUMFIL-2
	MOVE	TE,CRFCUR
GETNF0:	AOS	TE

	CAIL	TE,NUMFIL-1	;IF NOT LEGAL FILE NUMBER,
	MOVEI	TE,0		;  START AGAIN AT ZERO

	SKIPN	CRFSTA(TE)	;MAY ANY MORE STRINGS GO ON THIS FILE?
	SOJGE	TB,GETNF0	;NO--TRY NEXT ONE
	JUMPL	TB,GETNF2	;IF NO MORE FILES--RESET
	MOVEM	TE,CRFCUR	;THIS IS THE FILE WE WANT
	POPJ	PP,

GETNF2:	MOVE	TE,CRFCUR
	MOVE	TD,CRFTS(TE)
	MOVEI	TE,NUMFIL-2

GETNF3:	CAME	TE,CRFCUR
	ADDM	TD,CRFSTA(TE)
	SOJGE	TE,GETNF3

	MOVEI	TE,0
	CAMN	TE,CRFCUR
	MOVEI	TE,1
	MOVEM	TE,CRFCUR
	POPJ	PP,
IFE TOPS20,<

;OPEN OUTPUT FILE

OPENO:	MOVE	TD,INITS(TE)
	MOVE	TC,3(TD)
	ADD	TC,[OUTBUF 2]
	MOVE	TB,SF1BUF(TE)
	HRRM	TB,.JBFF
	XCT	TC

	MOVE	CH,3(TD)
	ADD	CH,[ENTER TD]
	MOVSI	TC,(SIXBIT 'TMP')
	MOVS	TD,4(TD)
	HLL	TD,GENHDR
	SETZB	TB,TA
	XCT	CH
	  JRST	NOENTR
	POPJ	PP,

;OPEN INPUT FILE

OPENI:	MOVE	TD,INITS(TE)
	MOVE	TC,3(TD)
	ADD	TC,[INBUF 2]
	MOVE	TB,SF1BUF(TE)
	HRRM	TB,.JBFF
	XCT	TC

	MOVE	CH,3(TD)
	ADD	CH,[LOOKUP TD]
	MOVSI	TC,(SIXBIT 'TMP')
	MOVS	TD,4(TD)
	HLL	TD,GENHDR
	SETZB	TB,TA
	XCT	CH
	  JRST	NOLOOK
	POPJ	PP,


;CLOSE FILE

CLOSER:	MOVE	TD,INITS(TE)	;FORM
	MOVE	TD,3(TD)	;  'CLOSE X,'
	TLO	TD,(CLOSE)	;  *
	XCT	TD		;  AND EXECUTE IT
	POPJ	PP,
>
;FIND FIRST RECORD IN CORE GREATER THAN INPUT ENTRY.
;EXIT WITH 'TE' POINTING TO THAT TABLE ENTRY.

BINSER:	MOVNI	TE,1		;START AT ENTRY -1
	MOVE	TD,CRFPWR	;GET POWER OF TWO
	CAMLE	TD,CRFTEN	;IF GREATER THAN TABLE SIZE,
	JRST	BINSR1		;  ALL IS WELL
	LSH	TD,1		;DOUBLE IT
	MOVEM	TD,CRFPWR	;  AND SAVE VALUE

BINSR1:	LSH	TD,-1		;CUT INCREMENT IN HALF
	JUMPE	TD,BINSR6	;IF ZERO, WE ARE DONE
	ADD	TE,TD		;INCREMENT THE LOCATION

BINSR2:	CAML	TE,CRFTEN	;IF OUTSIDE TABLE,
	JRST	BINSR5		;  TRY ANOTHER

	MOVE	TB,TE		;POINT
	ADD	TB,CRFTAB	;  'TB' TO
	MOVE	TB,(TB)		;  THE ITEM IN THE TABLE
	MOVE	TA,[XWD -SZ.SR,GCREFN]

BINSR3:	MOVE	TC,(TA)		;COMPARE ONE WORD OF
	CAME	TC,(TB)		;  THE ITEMS
	JRST	BINSR4		;NOT EQUAL
	AOBJP	TA,BINSR5	;EQUAL--IF JUMP, ENTIRE ITEMS ARE EQUAL
	AOJA	TB,BINSR3	;LOOP FOR NEXT WORD OF ITEMS

BINSR4:	CAML	TC,(TB)		;IS NEW ITEM LESS THAN TABLE ENTRY?
	JRST	BINSR1		;NO--MUST BE GREATER

BINSR5:	LSH	TD,-1		;CUT INCREMENT IN HALF
	JUMPE	TD,CPOPJ##	;IF ZERO, WE ARE DONE
	SUB	TE,TD		;DECREMENT THE LOCATION
	JRST	BINSR2		;LOOP

BINSR6:	AOJA	TE,CPOPJ
;ERRORS DURING FILE INITIALIZATION

IFE TOPS20,<
CANTOP:	OUTSTR	[ASCIZ "%Cannot Open Cref scratch file
"]
	JRST	KILCRF

NOENTR:	OUTSTR	[ASCIZ "%Cannot Enter Cref scratch file
"]
	JRST	KILCRF

NOLOOK:	OUTSTR	[ASCIZ "%Cannot find Cref scratch file
"]
	JRST	KILCRF
>

;NOT ENOUGH CORE

NOCORE:	TYPE	[ASCIZ "%Not enough memory for Cref Sort
"]

IFE TOPS20,<
KILCRF:	MOVEI	TE,NUMFIL-1	;RELEASE
KILL1:	MOVE	TD,INITS(TE)	;  ALL
	MOVE	TD,3(TD)	;  SCRATCH
	TLO	TD,(RELEASE)	;  FILES
	XCT	TD		;  *
	SOJGE	TE,KILL1	;  *
>
IFN TOPS20,<
	PSOUT%
	PUSHJ	PP,DELSF##	;DELETE ALL SCRATCH FILES
>

	TYPE	[ASCIZ "%Compilation continuing without Cref
"]
IFN TOPS20,<PSOUT%>
	MOVE	PP,CRFERA	;WE WILL IGNORE THE ENTIRE CREF
	POPJ	PP,
;TABLE OF FILE DATA

IFN TOPS20,<
OPNSFX:	EXP	OPNSF1##
	EXP	OPNSF2##
	EXP	OPNSF3##

SETSFX:	EXP	SETSF1##
	EXP	SETSF2##
	EXP	SETSF3##

GETSFX:	EXP	GETSF1##
	EXP	GETSF2##
	EXP	GETSF3##

RITSFX:	EXP	RITSF1##
	EXP	RITSF2##
	EXP	RITSF3##

CLSSFX:	EXP	CLSSF1##
	EXP	CLSSF2##
	EXP	CLSSF3##

SFXBH:	EXP	SF1BH##
	EXP	SF2BH##
	EXP	SF3BH##
>

IFE TOPS20,<
INITS:	EXP	INSF1
	EXP	INSF2
	EXP	INSF3

INSF1:	OCT	14
	SIXBIT	'DSK'
	XWD	SF1BHO,SF1BHI
	EXP	SF1*1B12
	SIXBIT	'SF1'

INSF2:	OCT	14
	SIXBIT	'DSK'
	XWD	SF2BHO,SF2BHI
	EXP	SF2*1B12
	SIXBIT	'SF2'

INSF3:	OCT	14
	SIXBIT	'DSK'
	XWD	SF3BHO,SF3BHI
	EXP	SF3*1B12
	SIXBIT	'SF3'
>


EXTERN	CRFEOS,CRFLOW,CRFNE,CRFPWR,CRFTS,CRFSTA
EXTERN	CRFTAB,CRFTEN,CRFCUR,CRFSIZ
EXTERN	GCREFN,CRFERA

IFN TOPS20,<
EXTERN	SF1BH,SF2BH,SF3BH
>
IFE TOPS20,<
EXTERN	GENHDR
EXTERN	SF1BUF,SF2BUF,SF3BUF,SF1BHO,SF1BHI,SF2BHO,SF2BHI,SF3BHO,SF3BHI
>

	END