Trailing-Edge
-
PDP-10 Archives
-
AP-D489C-SB
-
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 29-Mar-78
;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, 1978 BY DIGITAL EQUIPMENT CORPORATION
FTCOBOL==1
FTFORTRAN==0
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 Low Segment Data .................................. 4
; 4 PSORT.
; 4.1 SORT/MERGE Initialization ......................... 5
; 4.2 Count Number of Input Files ....................... 11
; 5 RELES.
; 5.1 Add Input Record to Tree .......................... 12
; 6 MCLOS. CLOSE OUT INPUT MERGE FILE ........................ 15
; 7 MERGE.
; 7.1 Simulate Master End of File ....................... 16
; 8 RETRN.
; 8.1 Copy Records From Tree to Output File ............. 18
; 9 ENDS.
; 9.1 Clean Up After Sort or Merge ...................... 19
; 10 ACCUMULATOR SAVING ROUTINES .............................. 20
; 11 ROUTINE TO DO COMPARES IN COBOL SORT ..................... 21
; 12 INFO MESSAGES ............................................ 22
; 13 ERROR MESSAGES ........................................... 23
SUBTTL DEFINITIONS -- Flags, Entry Points and Macros
SEARCH FTDEFS ;GET COBOL FILE-TABLE DEFINITIONS
ENTRY PSORT.,RELES.,MERGE.,RETRN.,ENDS.,PMERG.,MCLOS.
EXTERN OPNCH.,FUNCT.,STOPR.,KEYCV.
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
>
IFE FTOPS20,<
DEFINE SEGMENT (A) <> ;ALL IN LOW SEGMENT
>
KEYZ SUP,<NONE,INFORMATION,WARNING,FATAL,ALL>
SUBTTL DEFINITIONS -- Low Segment Data
SEGMENT LOW
ZCOR:! ;START OF DATA TO CLEAR
$RELES: BLOCK 1 ;WHERE TO GO ON RELES.
IOCHN: BLOCK 1 ;I/O CHAN # RETURNED
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
USRSPC: BLOCK 1 ;TELLS IF USER SPECIFIED CORE AT RUNTIME
LOSIZE: BLOCK 1 ;SIZE OF LOW SEGMENT
HISIZE: BLOCK 1 ;SIZE OF HIGH SEGMENT
IFE FTOPS20,<
CHNMAP: BLOCK MX.TMP+1 ;ONE WORD PER CHANNEL ALLOWED
;LHS = CHANNEL # IN ACC FIELD (FOR I/O INST)
;RHS = CHANNEL # (FOR FILOP. UUO)
>
MRGCNT: BLOCK 1 ;COUNT OF FILES TO OPEN INITIALLY
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
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
IFN FTOPS20,<
CHNMAX: BLOCK 1 ;NO. OF CHANS. LIBOL HAS AVAILABLE
>
CMPRMP: BLOCK 2 ;EXP <PUSHJ P,RELES.>,<PUSHJ P,MERGE.>
SEGMENT HIGH20
SUBTTL PSORT. -- SORT/MERGE Initialization
BEGIN;
PROCEDURE (PUSHJ P,PSORT.)
PSORT.: TDZA P1,P1 ;SORT ENTRY
PMERG.: MOVEI P1,1 ;MERGE ENTRY
IFN FTOPS20,<
MOVX T1,.FHSLF ;DEACTIVATE INTERRUPTS
MOVX T2,<1B<.ICNXP>> ; ON PAGE CREATION
DIC ; SO PA1050 WON'T BITCH AT US
SETZM LOWLOC ;CREATE 2 LOW SEGMENT PAGES
SETZM LOWLOC+PGSIZ ; ..
AIC ;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
JSP T4,CPUTST ;[134] MAKE SURE IF CPU IS OK
MOVE T1,[IOWD 10,CSTACK] ;INIT CORE ALLOCATION STACK
MOVEM T1,CORSTK ; ..
PUSHJ P,CUTBAK ;REDUCE SIZE AS MUCH AS POSSIBLE
;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
MOVE T1,0(17)
MOVE T1,-1(T1) ;GET CALLING INST.
CAMN T1,[PUSHJ P,PSORT.
PUSHJ P,PMERG.](P1) ;SEE IF NON-REENTRANT
JRST $1 ;YES IT IS
SUB T1,P1 ;BACK UP TO PSORT.
ADDI T1,2 ;CONVERT INST TO <PUSHJ P,RELES.>
HRRM T1,CMPRMP+0
ADDI T1,1 ;CONVERT TO <PUSHJ P,MERGE.>
HRRM T1,CMPRMP+1
$1%
;SET UP LOCATIONS IN LIBIMP AND COBOL
MOVEI T2,2 ;GET DISPLACEMENT
ADDB T2,(P) ;RESET RETURN ADDRESS
DMOVE T1,-2(T2) ;GET CONTENTS OF FIRST & SECOND ARGS
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
LDB T2,[POINT 12,F.WMRS(T1),17] ;MAX RECORD SIZE
HRRZM T2,RECORD ;[207] REMEMBER MAX SIZE
LDB T4,[POINT 3,F.WFLG(T1),14] ;INT. RECORDING MODE
; CASE MODE OF EBCDIC,SIXBIT,0,ASCII
MOVE T4,[EXP 4,6,0,5]-1(T4)
MOVEM T4,IOBPW ;[207] SAVE IN I/O BYTES-PER-WORD
ADDI T2,-1(T4) ;FORCE UPWARD ROUNDING
IDIVI T2,(T4) ;FIND MAX WORDS/REC
ADD T2,XTRWRD ;[207] ADD IN THE SIZE OF THE KEY
HRRZI T2,1(T2) ;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) ;GET ADDRESS OF RECORD AREA
HRRZM T2,NEWREC ;SAVE IN LIBIMP
HRRZ T2,F.RNFT(T1) ;GET LINK TO NEXT FILE TABLE
HRRZM T2,OLDNXT ;SAVE IN LIBIMP
;SET UP CHANNELS TO BE USED BY THE TEMPORARY FILES
BEGIN
HLRZ T1,OPNCH. ;FREE CHANNELS
IFE FTOPS20,<
SKIPG T2,UR.CHN ;DID USER SET IT UP?
MOVEI T2,U.CHN ;NO, RESERVE DEFAULT NO.
>
SETZ P1, ;INITIALIZE
JUMPE T1,$1 ;ANY MORE FREE CHANNELS?
ANDI T1,-1(T1) ;SET
AOJA P1,.-2 ;COUNT IT
$1%
IFN FTOPS20,<
CAILE P1,MX.TMP
MOVEI P1,MX.TMP
MOVEM P1,CHNMAX ;SAVE MAX. CHANS LIBOL HAS FREE FOR MERGE
>
IFE FTOPS20,<
CAIL P1,3(T2) ;[140] DID WE GET AT LEAST 3+USER'S CHANS?
JRST $3 ;[140] YES--GO TAKE ALL BUT USER'S
CAIGE P1,3 ;[140] THEN DID WE GET AT LEAST 3?
JRST E$$TFC ;[140] NO--TOO FEW CHANNELS
SKIPA P1,[3] ;[140] YES--TAKE ONLY 3
$3% SUBI P1,(T2) ;[140] SAVE USER'S CHANS
HRRZM P1,MAXTMP ;SAVE MAX CHANNELS AVAILABLE
MOVN T1,P1
HRLZM T1,TCBIDX ;SAVE NEGATIVE AS AOBJN POINTER
SKIPLE MRGSW ;IF MERGE
JRST $E ;ALLOCATE CHANNEL LATER
MOVNI P1,(P1) ;MAKE P1 AN AOBJN POINTER
HRLZS P1
$2% PUSHJ P,GTMCHN ;GET A CHANNEL
MOVEM T1,CHNMAP+1(P1) ;SAVE IN CHANNEL MAP
AOBJN P1,$2 ;DO THE NEXT(IF ANY)
>;END IFE FTOPS20
IFN FTOPS20,<
SKIPLE MRGSW ;IF MERGE
SOSA T1,CHNMAX ;IN WHICH CASE USE MAX INPUT CHANS - 1 FOR OUTPUT
MOVEI T1,MX.TMP ;ELSE MAX. NO. OF TEMP FILES
MOVEM T1,MAXTMP ;USE ALL POSSIBLE
MOVN T1,T1
HRLZM T1,TCBIDX
>
END;
BEGIN
;FIND THE NAMES OF THE STRUCTURES TO BE USED FOR THE TEMPORARY FILES
MOVE T1,SDFILE ;GET ADDRESS OF SD FILE BLOCK
LDB T2,[POINT 6,F.WNOD(T1),17] ;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) ;ADDRESS OF SCRATCH DEVICE NAMES
$2% MOVE T3,(T1) ;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
POP P,STRNAM(T2) ;SAVE THE DEVICE NAME
ADDI T1,1 ;POINT TO THE NEXT NAME
AOBJN T2,$2 ;PUT IN THE NEXT(IF ANY)
>
IFN FTOPS20,<
HRRZ P1,F.WDNM(T1) ;ADDRESS OF SCRATCH DEVICE NAMES
MOVE P2,T2
$2% MOVE T2,(P1) ;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 ;TRANSLATE
JRST E$$DNE ;DEVICE DOES NOT EXIST
MOVE T1,T2 ;GET DESIGNATOR
DVCHR ;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 ;GET DIRECTORY NUMBER
ERJMP E$$DND ;CANNOT HAPPEN!
MOVEM T3,STRNAM(P2) ;SAVE THE DIRECTORY NUMBER
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% CAME T2,STRNAM(T1) ;IDENTICAL?
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,<
CASE CPU OF KA10, KI10, KL10
MOVE T1,CPU
JRST @[EXP $1,$2,$2](T1)
$1% MOVE T1,[.KACMP,,.CMPAR]
BLT T1,.CMPAR+12
MOVN T1,XTRWRD ;[207] SET TO COMPARE ALL KEYS
HRRM T1,KACMP1
JRST $C
$2% MOVE T1,[.KICMP,,.CMPAR]
BLT T1,.CMPAR+11
MOVN T1,XTRWRD ;[207]
HRRM T1,KICMP1
; JRST $C
ESAC
>
IFN FTKI10!FTKL10,<
MOVN T1,XTRWRD ;[207]
HRRM T1,KICMP1
>
END;
;COUNT NO. OF INPUT FILES AND SETUP MRGPC
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
MOVE P1,0(P) ;GET CURRENT RETURN PC
PUSHJ P,CNTINP ;COUNT NO. OF INPUT FILES
PUSHJ P,SETMRG ;SETUP NUMRCB ETC.
MOVN T1,ACTTMP ;GET MAX. NO. OF TEMP FILE
HRLZ T1,T1
MOVEM T1,TCBIDX ;RESET NUMBER OF TEMP FILES
ADDI T1,1 ;FIRST IS OUTPUT
MOVEM T1,MRGCNT ;REST TO DO
MOVEI T1,CPOPJ
MOVEM T1,$RETRN ;
MOVEI T1,RELESI ;SETUP TO INITIALIZE
MOVEM T1,$RELES
FI;
END;
PUSHJ P,GETJOB ;GET JOB NUMBER
HRRZ T1,.JBFF## ;INIT TREE ORIGIN
MOVEM T1,TREORG ; ..
;CALCULATE CORE REQUIREMENTS
IFE FTOPS20,<
IF USER SET MEMORY LIMIT
HRRZ J,@MEMRY%##
CAIN J,-1 ;777777 IS DEFAULT
JRST $T ;DEFAULT
THEN TRY IT
SKIPE T1,HISIZE ;GET HIGH SEG SIZE
SUBI J,-1(T1) ;REMOVE HI-SEG SIZE
JRST $F
ELSE USE DEFAULT
PUSHJ P,DEFCOR ;USE DEFAULT CORE ALGORITHM
FI;
>
IFN FTOPS20,<
MOVEI T1,400000 ;ASSUME WE HAVE A HIGH SEGMENT
SKIPN .JBHRL## ;DO WE?
MOVEI T1,600000 ;NO, LIMIT IS LIBOL
MOVEM T1,MAXFRE ;SAVE UPPER MEMORY BOUND
PUSHJ P,CHKCOR ;USE DEFAULT CORE ALGORITHM
>
IFE FTOPS20,<
PUSHJ P,TSTSIZ ;MAKE SURE ITS BIG ENOUGH
MOVEM J,LOSIZE ;SAVE IT FOR MERGE PHASE
MOVEM J,.JBFF ;THIS WILL BE NEW .JBFF
CAMG J,.JBREL ;DID THE USER SPECIFY CORE?
JRST $4 ;YES, DON'T CHANGE CORE
CORE J, ;GET CORE NEEDED
JRST E$$NEC ;?CAN'T
IFN FTDEBUG,<
PUSHJ P,E$$XPN ;TELL USER
>
>
$4% MOVE T1,.JBFF## ;[141] GET SIZE WE ARE NOW
MOVEM T1,USRSPC ;[16]
PUSHJ P,PSORT% ;JOIN COMMON CODE
IF MERGE PASS REQUIRED
SKIPL MRGPC+0
JRST $F
THEN GET TEMP CHANNEL
IFE FTOPS20,<
PUSHJ P,GTMCHN ;GET CHANNEL
MOVEM T1,CHNMAP+0 ;SAVE IT
>
MOVEI F,FCBORG
PUSHJ P,FSTRUN ;OPEN TEMP FILE
FI;
MOVE L,SAVEL ;RESTORE L
PJRST .RESTR ;RESTORE COBOL'S AC'S THEN RETURN
END;
SUBTTL PSORT. -- Count Number of Input Files
BEGIN;
PROCEDURE (PUSHJ P,CNTINP)
SETZM MRGPC+0
SETZM NUMINP
MOVN F,MAXTMP
HRLZ F,F ;AOBJN PTR.
SUB F,[1,,0] ;SO AOBJP COUNTS CORRECTLY
$1% MOVE T1,(P1) ;GET INST.
CAMN T1,CMPRMP+0 ;PUSHJ P,RELES.
JRST $2 ;FOUND IT
CAMN T1,CMPRMP+1 ;PUSHJ P,MERGE.
JRST $4 ;FOUND
AOJA P1,$1 ;KEEP LOOKING
$2% AOS NUMINP ;COUNT INPUT FILES
AOBJP F,$3 ;SKIP IF ALREADY TOO MANY
MOVE T1,1(P1) ;GET JRST BACK INST
HRRZM T1,MRGPC(F) ;STORE RETURN PC
AOJA P1,$1 ;TRY NEXT
$3% SKIPN MRGPC+0 ;STORE PC
HRROM P1,MRGPC+0 ;THE FIRST TIME
AOJA P1,$1
$4% SKIPL MRGPC+0
HRRZM P1,MRGPC+0 ;STORE RETURN PC
RETURN
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
PUSHJ P,(T4) ;CONVERT THE KEYS
JSP P4,.SAVE ;EXCHANGE AC BLOCKS
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) ;PUT IN PLACE
HRRZI T1,(T2) ;GET DESTINATION FOR THE DATA
HRL T1,NEWREC ;GET SD RECORD ADDRESS
ADD T2,SAVEL ;[217] ADD LENGTH OF RECORD
BLT T1,-1(T2) ;[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
PJRST @$RELES ;GOTO RIGHT ROUTINE
END;
BEGIN;
PROCEDURE (PUSHJ P,RELESI)
MOVE T1,MRGCNT
HRLM T1,RN.FCB(S) ;STORE INDEX
AOS MRGIRC-1(T1) ;COUNT FIRST RECORD
AOBJN T1,.+1
MOVEM T1,MRGCNT
AOS RQ ;MAKE 1ST RUN
PUSHJ P,SETTRE ;PUT RECORD IN TREE
IF STILL INITAILIZING
SKIPL T1,MRGCNT
JRST $T ;NO, START MERGE AND RETRN
THEN CONTINUE WITH NEXT FILE
MOVE T2,MRGPC(T1) ;GET NEXT FILE
SUBI T2,2 ;GET TO OPEN
JRST $F
ELSE SETUP TO RETURN TO MERGE.
HRRZS LSTREC ;CLEAR LEFT HALF
IF JUST 1 PASS
SKIPE NUMINP ;IS IT?
JRST $T ;NO
THEN RETURN TO MERGE.
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 SETUP FOR MERGE PASSES
MOVEI F,FCBORG
JSP P4,PTTREC ;WRITE OUT RECORD
MOVEI T1,RELES2 ;MERGE PASSES REQUIRED
HLRZ T2,RN.FCB(S) ;GET INDEX
MOVE T2,MRGPC(T2) ;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) ;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)
MOVE T1,PSAV ;GET ORIGINAL STACK POINTER
HRRM T2,-1(T1) ;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)
MOVE T1,PSAV ;GET ORIGINAL STACK POINTER
HRRM T2,-1(T1) ;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 >)
HRRZ T1,@MRGPC(F) ;GET POINTER FILE NAME
MOVE T1,(T1) ;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
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) ;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 RETURN
SETOM LASRET ;FLAG IT
PJRST RETRND
ELSE TRY AGAIN
IF THIS IS THE DUMMY END MARKER
JUMPGE T1,$T
THEN JUST CLOSE OUT
MOVE T2,MRGPC+0
MOVE T1,PSAV
HRRM T2,-1(T1)
RETURN
ELSE SETUP FOR ANOTHER MERGE CYCLE
MOVEI F,FCBORG
PUSHJ P,CLSRUN ;OPEN NEXT TEMP FILE
HRRZ P1,MRGPC+0 ;GET RESTART PC
PUSHJ P,CNTINP ;SETUP AGAIN
IF LAST FILE
MOVE T1,NUMINP ;GET NUMBER LEFT
SOJN T1,$T
THEN JUST COPY FILE
SETOM NUMINP ;SIGNAL THIS IS THE LAST
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
SKIPN NUMINP ;NEED ANOTHER ROUND AFTER THIS?
SETOM NUMINP ;NO, SIGNAL END
PUSHJ P,INITRE ;FILL WITH NULLS
MOVEI T1,RELESI ;INITIALIZE AGAIN
FI;
MOVEM T1,$RELES
MOVE T2,MRGPC+1 ;GET FIRST INPUT FILE
SUBI T2,2 ;
MOVE T1,PSAV
HRRM T2,-1(T1) ;RESET PC
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 JUST RETURN
RETURN
FI;
END;
IFE FTOPS20,<
BEGIN;
PROCEDURE (PUSHJ P,GTMCHN)
MOVEI L,1+[-4,,0
Z TP%INT,[F.GCH]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS
Z TP%INT,IOCHN]
PUSHJ P,FUNCT.## ;GET A CHANNEL #
SKIPE STATUS ;DID WE GET IT?
JRST E$$TFC ;NO, GIVE ERROR RETURN
MOVE T1,IOCHN ;GET IT
DPB T1,[POINT 4,T1,12] ;PUT INTO AC FIELD
RETURN
END;
BEGIN;
PROCEDURE (PUSHJ P,RTMCHN)
HRRZ T2,CHNMAP+0 ;GET THE CHANNEL NUMBER
MOVEM T2,IOCHN
MOVEI L,1+[-4,,0
Z TP%INT,[F.RCH]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS
Z TP%INT,IOCHN]
PUSHJ P,FUNCT.## ;TELL LIBOL IT'S FREE
MOVEM L,SAVEL
SKIPE STATUS ;[136] CHECK IF FREED OK
PUSHJ P,E$$CRE ;[136] NO--COMPLAIN
RETURN ;[136] DONE
END;
>;END IFE FTOPS20
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
HLRZ F,RN.FCB(S) ;GET INDEX
PJRST @MRGPC(F) ;GET NEXT RECORD
;---------------------------------------;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
ADDI T2,(T1) ;GET LAST ADDRESS FOR BLT
BLT T1,-2(T2) ;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
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 ;[125,224] ALL IN CORE?
SKIPN ACTTMP ;[224] OR ALL TEMP FILES GONE ALREADY?
JRST $F ;[125] YES, NO FILE TO CLOSE
DMOVE R,SORTAC ;[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 ;[125,224] DELETE FILE
PUSHJ P,RELFIL ;[225] AND RELEASE CHANNEL
JRST $F ;[125] DONE
ELSE DELETE ALL OPEN FILES
BEGIN
HLRZ F,RN.FCB(S) ;[125] GET WHICH FILE
PUSHJ P,DELFIL ;[125,224] DELETE IT
PUSHJ P,RELFIL ;[224] AND FREE CHAN
SOSG ACTTMP ;[125,224] 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;
IFE FTOPS20,<
MOVE P1,MAXTMP ;GET MAXIMUM NUMBER OF CHANNELS
$1% HRRZ T2,CHNMAP(P1) ;GET THE CHANNEL NUMBER
MOVEM T2,IOCHN
MOVEI L,1+[-4,,0
Z TP%INT,[F.RCH]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS
Z TP%INT,IOCHN]
PUSHJ P,FUNCT.## ;TELL LIBOL IT'S FREE
SKIPE STATUS ;[136] CHECK FOR FAILURE
PUSHJ P,E$$CRE ;[136] NO--COMPLAIN
$3% SOJG P1,$1 ;FREE THE NEXT ONE(IF ANY)
SKIPGE T1,USRSPC ;[16] DID USER SPECIFY CORE?
JRST $2 ;YES, DON'T CHANGE CORE
CAME T1,.JBFF## ;[141] HAS IT CHANGED?
JRST E$$CLC ;[16] YES, TELL USER BUT DON'T CHANGE
HRRZ T1,TREORG ;GET THE FIRST SORT LOCATION
CORE T1, ;GET RID OF EXCESS CORE
JRST E$$CLC ;[16] ?CAN'T
IFN FTDEBUG,<
PUSHJ P,E$$RDC ;TELL USER
>
HRRZ T1,TREORG
MOVEM T1,.JBFF ;RESET .JBFF
$2%
>;END IFE FTOPS20
IFN FTOPS20,<
PUSHJ P,RESET% ;CLEAN UP CORE
PUSHJ P,CUTBAK ;AND REDUCE SIZE
>
HRRZ T1,SDFILE ;RESET SD FILE BLOCK
HRRZ T2,OLDNXT
HRRM T2,6(T1)
SETZM KEYCV. ;CLEAR THIS LOCATION
SETZM LASRET ;STOP ALLOWING RETURNS
MOVSI L,ACSAVE ;SET UP BLT POINTER
BLT L,T4 ;RESTORE LIBOL'S ACS
MOVE L,ACSAVE+5
RETURN
IFE FTOPS20,<
E$$CLC: $ERROR (%,CLC,<Cannot lower core after SORT>)
JRST $2 ;[16] CONTINUE
>
END;
BEGIN
PROCEDURE (PUSHJ P,CUTBAK)
;**********
RETURN ;UNTIL COBFUN IS FIXED
;**********
MOVEI L,1+[-3,,0 ;LOAD UP ARG BLOCK FOR FUNCT. CALL
Z TP%INT,[F.CBC]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS]
PJRST FUNCT. ;CUT BACK CORE IF POSSIBLE
END;
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
PUSH P,[EXP .RESTR] ;RETURN ADDRESS
DMOVE R,SORTAC ;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
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
.CMPAR:
IFE FTKI10!FTKL10,<
BLOCK 13 ;LOAD THE CODE AT RUN TIME
;KA10 CODE
BEGIN;
.KACMP: PHASE .CMPAR
PROCEDURE (JSP P4,KACMP)
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) ;GET NEXT DATA WORD OF RECORD J
CAMN T1,1(T3) ;COMPARE TO DATA WORD OF RECORD R
AOJA T4,$2 ;EQUAL, INCREMENT TO POINT TO NEXT WORD
CAMG T1,1(T3) ;FIND WHICH RECORD IS LARGER
JRST 2(P4) ;REC R < REC J
JRST 1(P4) ;REC R > REC J
$2% AOBJN T3,$1 ;TRY AGAIN IF ANY MORE WORDS
JRST 0(P4) ;NONE- THE KEYS ARE EQUAL
DEPHASE
END;
>
;KI10/KL10 CODE
BEGIN;
.KICMP: PHASE .CMPAR
PROCEDURE (JSP P4,KICMP)
.DMOVE T3,J ;GET THE RECORD POINTERS
KICMP1: HRLI T3,.-. ;-XTRWRD TO MAKE T3 AN AOBJN PTR
$1% MOVE T1,1(T4) ;GET NEXT DATA WORD OF RECORD J
CAMN T1,1(T3) ;COMPARE TO DATA WORD OF RECORD R
AOJA T4,$2 ;EQUAL, INCREMENT TO POINT TO NEXT WORD
CAMG T1,1(T3) ;FIND WHICH RECORD IS LARGER
JRST 2(P4) ;REC R < REC J
JRST 1(P4) ;REC R > REC J
$2% AOBJN T3,$1 ;TRY AGAIN IF ANY MORE WORDS
JRST 0(P4) ;NONE- THE KEYS ARE EQUAL
DEPHASE
END;
SUBTTL INFO MESSAGES
IFN FTDEBUG,<
BEGIN;
PROCEDURE (PUSHJ P,E$$XPN)
$ERROR ([,XPN,<Expanding to >,+)
MOVE T1,.JBREL
ADDI T1,1
IFN FTOPS20,<
ADD T1,HISIZE
>
$MORE (CORE,T1)
IFE FTOPS20,<
$CHAR "+"
$MORE (CORE,HISIZE)
>
$CRLF
RETURN
END;
BEGIN;
PROCEDURE (PUSHJ P,E$$RDC)
$ERROR ([,RDC,<Reducing to >,+)
MOVE T1,.JBREL
ADDI T1,1
IFN FTOPS20,<
ADD T1,HISIZE
>
$MORE (CORE,T1)
IFE FTOPS20,<
$CHAR "+"
$MORE (CORE,HISIZE)
>
$CRLF
RETURN
END;
>
SUBTTL ERROR MESSAGES
;HERE ON FATAL ERRORS
IFE FTOPS20,<
E$$TFC: $ERROR (?,TFC,<Too few channels available>)
E$$CRE: $ERROR (%,CRE,<Channel return error.>)
POPJ P, ;[136] LIBOL GAVE ERROR RETURNING CHAN
>
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
IFN FTOPS20,<
CALL RESET% ;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.>)