Trailing-Edge
-
PDP-10 Archives
-
BB-L014Z-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