Trailing-Edge
-
PDP-10 Archives
-
BB-4160E-BM
-
sort-development/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-AUG-79
;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, 1979 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 Low Segment Data .................................. 5
; 4 PSORT.
; 4.1 SORT/MERGE Initialization ......................... 6
; 4.2 Count Number of Input Files ....................... 10
; 4.3 Find next input merge file ........................ 13
; 5 RELES.
; 5.1 Add Input Record to Tree .......................... 15
; 6 MCLOS. CLOSE OUT INPUT MERGE FILE ........................ 18
; 7 MERGE.
; 7.1 Simulate Master End of File ....................... 19
; 8 RETRN.
; 8.1 Copy Records From Tree to Output File ............. 21
; 9 ENDS.
; 9.1 Clean Up After Sort or Merge ...................... 22
; 10 ACCUMULATOR SAVING ROUTINES .............................. 23
; 11 ROUTINE TO DO COMPARES IN COBOL SORT ..................... 24
; 12 INFO MESSAGES ............................................ 25
; 13 ERROR MESSAGES ........................................... 26
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 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
LOWORG==LOWLOC ;[356] NEVER GETS MODIFIED BY SEGMENT MACRO
>
IFE FTOPS20,<
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
ADDM T1,@MP.ADD ;[365] ADD TIME PAST TO TIME BUCKET
>
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
ADDM 1,@MP.ADD ;[365] ADD TIME PAST TO TIME BUCKET
>
>;END LSTATS
>;END MRTME.
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
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
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.>
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 HIGH20
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 ;DEACTIVATE INTERRUPTS
MOVX T2,<1B<.ICNXP>> ; ON PAGE CREATION
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
MOVE T1,[IOWD 10,CSTACK] ;INIT CORE ALLOCATION STACK
MOVEM T1,CORSTK ; ..
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
MOVE T2,0(17) ;[354]
MOVE T1,-1(T2) ;[354] GET CALLING INST.
TXNE T1,<Z @> ;[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
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
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
>
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% ;[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!
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,<
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
MOVE T1,(P) ;[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
MOVEI T1,(T2) ;[327] LOOK SOME MORE
JRST $B ;[327] LOOP FOR ANOTHER
END;
MOVEM T2,MRGPC+0 ;[327] SAVE MERGE. ADDR FOR LATER
IFN LSTATS,<
MOVE T2,NUMINP ;[365] GET NO. OF INPUT FILES
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
HRRZ T1,.JBFF## ;INIT TREE ORIGIN
MOVEM T1,TREORG ; ..
IFE FTOPS20,<
MOVEM T1,FSLOC.## ;[320] TELL FUNCT. SORT IS IN PROGRESS
>
;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
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) ;[327] START AT ADDR+1
WHILE NOT PUSHJ P,RELES. OR PUSHJ P,MERGE.
BEGIN
MOVE T3,(T2) ;[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)
MOVE T1,(T1) ;[354] GET ADDRESS
CAIN T1,PMERG. ;[354]
JRST $T ;[354] /R CODE
THEN
WHILE NOT PUSHJ P,RELES. OR PUSHJ P,MERGE.
BEGIN
HLRZ T1,(T2) ;[354] GET NEXT INSTRUCTION
CAIE T1,(PUSHJ P,@) ;[354] IS IT A POSSIBLE CANDIDATE
AOJA T2,$B ;[354] NO KEEP LOOKING
HRRZ T1,@(T2) ;[354] GET ADDRESS
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) ;[354] GET INST
MOVEM T1,CMPRMP+0 ;[354] SAVE IT
AOJA T2,$B ;[354] NOW LOOK FOR MERGE.
$1% MOVE T1,(T2) ;[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) ;[354] GET NEXT INSTRUCTION
CAIE T1,(PUSHJ P,@) ;[354] IS IT A POSSIBLE CANDIDATE
AOJA T2,$B ;[354] NO KEEP LOOKING
MOVEI T1,@(T2) ;[354] GET ADDRESS
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) ;[354] GET INST
MOVEM T1,CMPRMP+0 ;[354] SAVE IT
AOJA T2,$B ;[354] NOW LOOK FOR MERGE.
$1% MOVE T1,(T2) ;[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
PUSHJ P,(T4) ;CONVERT THE KEYS
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) ;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
MOVE T2,-1(P) ;[327] GET RELES. RETURN ADDRESS
HRRZ T2,(T2) ;[327] WHERE THERE'S A JRST
MOVEM T2,MRGPC(T1) ;[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) ;COUNT FIRST RECORD
AOBJN T1,.+1
MOVEM T1,MRGCNT
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
MOVE T1,-1(P) ;[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) ;[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
IFE FTOPS20,<
PUSHJ P,GTMCHN ;[327] GET A CHAN
MOVEM T1,CHNMAP+0 ;[327] SAVE FOR OUTPUT
>
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) ;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
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) ;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) ;[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) ;[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) ;[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;
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
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 ;[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;
IFN LSTATS,<
DMOVE T1,INPREC ;[365] GET NO. OF RECORD INPUT & OUTPUT
DMOVEM T1,MP.BLK+MB.NRI ;[365]
>
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
SETZM FSLOC.## ;[320] RESET- NO SORT IN PROGRESS
$2%
>;END IFE FTOPS20
IFN FTOPS20,<
PUSHJ P,RESET$ ;[335] 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
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.## ;[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;
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 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
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
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 LOW ;[433] FORCE IMPURE CODE INTO LOW SEG
.CMPAR:
SEGMENT HIGH20 ;[433] BACK TO HIGH SEG
IFE FTKI10!FTKL10,<
BLOCK 13 ;LOAD THE CODE AT RUN TIME
;KA10 CODE
BEGIN;
.KACMP: PHASE .CMPAR
PROCEDURE (JSP P4,.CMPAR)
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
KA.CL==.-.KACMP ;[433] SIZE FOR KA-10
IFN KA.CL-13,<PRINTX ?COMPARISON CODE CHANGED SIZE>
END;
>
;KI10/KL10 CODE
BEGIN;
.KICMP: PHASE .CMPAR
PROCEDURE (JSP P4,.CMPAR)
.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
KI.CL==.-.KICMP ;[433] SIZE FOR KI/KL-10
END;
IFN FTOPS20,<
SEGMENT LOW
.CMPAR: BLOCK KI.CL ;[433] LOAD THE CODE AT RUN TIME
SEGMENT HIGH20
>
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$ ;[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.>)