Trailing-Edge
-
PDP-10 Archives
-
BB-4160F-BM
-
sort-source/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 8-May-81
;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, 1981 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 Impure Data ....................................... 5
; 4 PSORT.
; 4.1 SORT/MERGE Initialization ......................... 6
; 4.2 Count Number of Input Files ....................... 9
; 4.3 Find next input merge file ........................ 12
; 5 RELES.
; 5.1 Add Input Record to Tree .......................... 14
; 6 MCLOS. CLOSE OUT INPUT MERGE FILE ........................ 17
; 7 MERGE.
; 7.1 Simulate Master End of File ....................... 18
; 8 RETRN.
; 8.1 Copy Records From Tree to Output File ............. 19
; 9 ENDS.
; 9.1 Clean Up After Sort or Merge ...................... 20
; 10 ACCUMULATOR SAVING ROUTINES .............................. 22
; 11 ROUTINE TO DO COMPARES IN COBOL SORT ..................... 23
; 12 ERROR MESSAGES ........................................... 24
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 FUNCT.,STOPR.,KEYCV.,MEMRY% ;[C20] [C19]
IFE FTOPS20,<
EXTERN FSLOC. ;[C20]
>
IFN LSTATS,<
EXTERN MROUT. ;[C20]
>
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,<
LOWORG==<LOWLOC==0> ;[N07] SET DATA SECTION BASE TO ZERO
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
MOVE T2,MP.ADD ;[C20] ADD TIME PAST TO TIME BUCKET
ADDM T1,(T2) ;[C20] ..
>
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
MOVE 2,MP.ADD ;[C20] ADD TIME PAST TO TIME BUCKET
ADDM 1,(2) ;[C20] ..
>
>;END LSTATS
>;END MRTME.
SUBTTL DEFINITIONS -- Impure Data
SEGMENT IMPURE ;[C20]
ZCOR:! ;START OF DATA TO CLEAR
$RELES: BLOCK 1 ;WHERE TO GO ON RELES.
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
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
STATSW::BLOCK 1 ;[C20] 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
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 LPURE ;[C20]
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 ;[N13] THIS PROCESS
RCM% ;[N13] READ INTERUPT MASK
MOVX T2,<1B<.ICNXP>> ;[N13] ONLY WORRY ABOUT INTERUPT ON PAGE CREATION
AND T2,T1 ;[N13] ONLY TURN OFF IF CURRENTLY ON
MOVX T1,.FHSLF ;[N13] THIS PROCESS
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
IFE FTOPS20,<
PUSHJ P,MONSPC ;[N12] SEE IF 7-SERIES MONITOR
>
PUSHJ P,SSTATS ;[C20] SETUP STATS LOCS
PUSHJ P,SETSPC ;[C13] SETUP MEMORY LOCS
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
HRRZ T2,0(P) ;[C20] [354]
MOVE T1,-1(T2) ;[OK] [354] GET CALLING INST.
TXNE T1,<Z @> ;[OK] [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
HRRZ T3,T2 ;[C20] GET CONTENTS OF FIRST & SECOND ARGS
DMOVE T1,-2(T3) ;[C20] ..
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
>
HRRZ T3,T1 ;[C20] MAX RECORD SIZE
LDB T2,[POINT 12,F.WMRS(T3),17] ;[C20] ..
HRRZM T2,RECORD ;[207] REMEMBER MAX SIZE
LDB T4,[POINT 3,F.WFLG(T3),14] ;[C20] INT. RECORDING MODE
; CASE MODE OF EBCDIC,SIXBIT,0,ASCII
MOVE T3,[EXP 4,1,0,5]-1(T4) ;[OK] [C03]
MOVEM T3,IOBPW2 ;[C03] SAVE IN I/O BYTES-PER-WORD USED
MOVE T4,[EXP 4,6,0,5]-1(T4) ;[OK]
MOVEM T4,IOBPW ;[207] SAVE IN I/O BYTES-PER-WORD
ADDI T2,-1(T4) ;[OK] FORCE UPWARD ROUNDING
IDIV T2,T4 ;[C20] FIND MAX WORDS/REC
ADD T2,XTRWRD ;[207] ADD IN THE SIZE OF THE KEY
ADDI T2,1 ;[C20] 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) ;[OK] GET ADDRESS OF RECORD AREA
HRRZM T2,NEWREC ;SAVE IN LIBIMP
HRRZ T2,F.RNFT(T1) ;[OK] GET LINK TO NEXT FILE TABLE
HRRZM T2,OLDNXT ;SAVE IN LIBIMP
IFN FTOPS20,<
MOVEI T1,MX.TMP ;[C19] GET MAXIMUM TEMP FILES
>
IFE FTOPS20,<
PUSHJ P,SETCHN ;[C19] SETUP CHANNEL ALLOCATOR
MOVE T1,CHNFRE ;[C19] GET CHANNELS AVAILABLE
>
MOVEM T1,MAXTMP ;[C19] THIS IS MAX TEMP FILES
MOVN T1,MAXTMP ;[C19] MAKE AN AOBJ POINTER
HRLZM T1,TCBIDX ;[C19] PUT IT AWAY FOR LATER
BEGIN
;FIND THE NAMES OF THE STRUCTURES TO BE USED FOR THE TEMPORARY FILES
HRRZ T1,SDFILE ;[C20] GET ADDRESS OF SD FILE BLOCK
LDB T2,[POINT 6,F.WNOD(T1),17] ;[OK] 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) ;[OK] ADDRESS OF SCRATCH DEVICE NAMES
$2% MOVE T3,(T1) ;[OK] 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
HRRZ T3,T2 ;[C20] SAVE THE DEVICE NAME
POP P,STRNAM(T3) ;[C20] ..
ADDI T1,1 ;POINT TO THE NEXT NAME
AOBJN T2,$2 ;PUT IN THE NEXT(IF ANY)
>
IFN FTOPS20,<
HRRZ P1,F.WDNM(T1) ;[OK] ADDRESS OF SCRATCH DEVICE NAMES
MOVE P2,T2
$2% MOVE T2,(P1) ;[OK] 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!
HRRZ T1,P2 ;[C20] SAVE THE DIRECTORY NUMBER
MOVEM T3,STRNAM(T1) ;[C20] ..
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% HRRZ T3,T1 ;[C20] IDENTICAL?
CAME T2,STRNAM(T3) ;[C20] ..
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
HRRZ T1,(P) ;[C20] [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
MOVE T1,T2 ;[C20] [327] LOOK SOME MORE
JRST $B ;[327] LOOP FOR ANOTHER
END;
MOVEM T2,MRGPC+0 ;[327] SAVE MERGE. ADDR FOR LATER
MOVE T2,NUMINP ;[N02] GET NUMBER OF MERGE FILES
CAIGE T2,2 ;[N02] NEED AT LEAST TWO
JRST E$$ATF ;[N02] NO, SO GIVE ERROR
IFN LSTATS,<
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
IFE FTOPS20,<
MOVEM T1,FSLOC. ;[C20] [320] TELL FUNCT. SORT IS IN PROGRESS
>
;CALCULATE CORE REQUIREMENTS
IF USER SET MEMORY LIMIT
MOVE T1,MEMRY% ;[C20] [C13] GET COBOL MEMORY LIMIT
HRRZ T1,(T1) ;[C20] ..
CAIN T1,-1 ;[C13] DEFAULT?
JRST $T ;[C13] YES
THEN USE IT
PUSHJ P,RSTSPC ;[C13] RE-SETUP AVAILABLE MEMORY
JRST $F
ELSE USE THE DEFAULT
IFE FTOPS20,<
PUSHJ P,DEFCOR ;USE DEFAULT CORE ALGORITHM
>
FI;
IFN FTOPS20,<
PUSHJ P,CHKCOR ;USE DEFAULT CORE ALGORITHM
>
IFE FTOPS20,<
PUSHJ P,TSTSIZ ;MAKE SURE ITS BIG ENOUGH
>
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) ;[OK] [327] START AT ADDR+1
WHILE NOT PUSHJ P,RELES. OR PUSHJ P,MERGE.
BEGIN
MOVE T3,(T2) ;[OK] [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)
HRRZS T1 ;[C20] GET ADDRESS
MOVE T1,(T1) ;[C20] [354] ..
CAIN T1,PMERG. ;[354]
JRST $T ;[354] /R CODE
THEN
WHILE NOT PUSHJ P,RELES. OR PUSHJ P,MERGE.
BEGIN
HLRZ T1,(T2) ;[OK] [354] GET NEXT INSTRUCTION
CAIE T1,(PUSHJ P,@) ;[354] IS IT A POSSIBLE CANDIDATE
AOJA T2,$B ;[354] NO KEEP LOOKING
HRRZ T1,(T2) ;[C20] [354] GET ADDRESS
TLO T1,(IFIW) ;[C20] ..
HRRZ T1,@T1 ;[C20] ..
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) ;[OK] [354] GET INST
MOVEM T1,CMPRMP+0 ;[354] SAVE IT
AOJA T2,$B ;[354] NOW LOOK FOR MERGE.
$1% MOVE T1,(T2) ;[OK] [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) ;[OK] [354] GET NEXT INSTRUCTION
CAIE T1,(PUSHJ P,@) ;[354] IS IT A POSSIBLE CANDIDATE
AOJA T2,$B ;[354] NO KEEP LOOKING
HRRZ T1,(T2) ;[C20] [354] GET ADDRESS
TLO T1,(IFIW) ;[C20] ..
HRRZ T1,@T1 ;[C20] ..
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) ;[OK] [354] GET INST
MOVEM T1,CMPRMP+0 ;[354] SAVE IT
AOJA T2,$B ;[354] NOW LOOK FOR MERGE.
$1% MOVE T1,(T2) ;[OK] [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
HRRZS T4 ;[C20] CONVERT THE KEYS
PUSHJ P,(T4) ;[C20] ..
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) ;[OK] PUT IN PLACE
MOVE T1,T2 ;[C20] GET DESTINATION FOR THE DATA
HRL T1,NEWREC ;GET SD RECORD ADDRESS
ADD T2,SAVEL ;[217] ADD LENGTH OF RECORD
BLT T1,-1(T2) ;[OK] [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
MOVE T1,$RELES ;[C20] GOTO RIGHT ROUTINE
PJRST (T1) ;[C20] ..
END;
BEGIN;
PROCEDURE (PUSHJ P,RELESI)
HRRZ T1,MRGCNT ;[C20]
HRRZ T2,-1(P) ;[C20] [327] GET RELES. RETURN ADDRESS
HRRZ T2,(T2) ;[OK] [327] WHERE THERE'S A JRST
MOVEM T2,MRGPC(T1) ;[OK] [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) ;[OK] COUNT FIRST RECORD
MOVE T1,[XWD 1,1] ;[C20]
ADDM T1,MRGCNT ;[C20]
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
HRRZ T1,-1(P) ;[C20] [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) ;[OK] [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
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) ;[OK] 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) ;[OK] 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) ;[OK]
MOVE T1,PSAV ;GET ORIGINAL STACK POINTER
HRRM T2,-1(T1) ;[OK] 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) ;[OK]
MOVE T1,PSAV ;GET ORIGINAL STACK POINTER
HRRM T2,-1(T1) ;[OK] 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 >)
MOVE T1,MRGPC(F) ;[C20] GET POINTER FILE NAME
HRRZ T1,(T1) ;[C20] ..
MOVE T1,(T1) ;[OK] 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) ;[OK] 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) ;[OK] [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) ;[OK] [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) ;[OK] [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;
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 ;[OK]
HLRZ F,RN.FCB(S) ;GET INDEX
MOVE T1,MRGPC(F) ;[C20] GET NEXT RECORD
PJRST (T1) ;[C20] ..
;---------------------------------------;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
ADD T2,NEWREC ;[C20] GET LAST ADDRESS FOR BLT
BLT T1,-2(T2) ;[OK] 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 ;[224] [125] ALL IN CORE?
SKIPN ACTTMP ;[224] OR ALL TEMP FILES GONE ALREADY?
JRST $F ;[125] YES, NO FILE TO CLOSE
DMOVE R,SORTAC ;[OK] [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 ;[224] [125] DELETE FILE
JRST $F ;[125] DONE
ELSE DELETE ALL OPEN FILES
BEGIN
HLRZ F,RN.FCB(S) ;[125] GET WHICH FILE
PUSHJ P,DELFIL ;[224] [125] DELETE IT
SOSG ACTTMP ;[224] [125] 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,<
PUSHJ P,RELSPC ;[C13] RELEASE ANY RETAINED MEMORY
SETZM FSLOC. ;[C20] [320] RESET- NO SORT IN PROGRESS
>;END IFE FTOPS20
IFN FTOPS20,<
PUSHJ P,RESET$ ;[335] CLEAN UP CORE
>
PUSHJ P,STATS ;[C20] TYPE STATISTICS, IF NECESSARY
HRRZ T1,SDFILE ;RESET SD FILE BLOCK
HRRZ T2,OLDNXT
HRRM T2,F.RNFT(T1) ;[OK]
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. ;[C20] [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;
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
XMOVEI T4,.RESTR ;[C20] RETURN ADDRESS
PUSH P,T4 ;[C20] ..
DMOVE R,SORTAC ;[OK] 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 IMPURE ;[C20] [433] FORCE IMPURE CODE INTO LOW SEG
.CMPAR:
SEGMENT LPURE ;[C20] [433] BACK TO HIGH SEG
IFE FTKI10!FTKL10,<
BLOCK 14 ;[N04] LOAD THE CODE AT RUN TIME
;KA10 CODE
BEGIN;
.KACMP: PHASE .CMPAR
PROCEDURE (JSP P4,.CMPAR)
AOS CMPCNT ;[C20] COUNT OF COMPARISONS
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) ;[OK] GET NEXT DATA WORD OF RECORD J
CAMN T1,1(T3) ;[OK] COMPARE TO DATA WORD OF RECORD R
AOJA T4,$2 ;EQUAL, INCREMENT TO POINT TO NEXT WORD
CAMG T1,1(T3) ;[OK] FIND WHICH RECORD IS LARGER
JRST 2(P4) ;[OK] REC R < REC J
JRST 1(P4) ;[OK] REC R > REC J
$2% AOBJN T3,$1 ;TRY AGAIN IF ANY MORE WORDS
JRST 0(P4) ;[OK] NONE- THE KEYS ARE EQUAL
DEPHASE
KA.CL==.-.KACMP ;[433] SIZE FOR KA-10
IFN KA.CL-14,<PRINTX ?Comparison code changed size> ;[N04]
END;
>
;KI10/KL10 CODE
BEGIN;
.KICMP: PHASE .CMPAR
PROCEDURE (JSP P4,.CMPAR)
AOS CMPCNT ;[C20] COUNT OF COMPARISONS
.DMOVE T3,J ;GET THE RECORD POINTERS
KICMP1: HRLI T3,.-. ;-XTRWRD TO MAKE T3 AN AOBJN PTR
$1% MOVE T1,1(T4) ;[OK] GET NEXT DATA WORD OF RECORD J
CAMN T1,1(T3) ;[OK] COMPARE TO DATA WORD OF RECORD R
AOJA T4,$2 ;EQUAL, INCREMENT TO POINT TO NEXT WORD
CAMG T1,1(T3) ;[OK] FIND WHICH RECORD IS LARGER
JRST 2(P4) ;[OK] REC R < REC J
JRST 1(P4) ;[OK] REC R > REC J
$2% AOBJN T3,$1 ;TRY AGAIN IF ANY MORE WORDS
JRST 0(P4) ;[OK] NONE- THE KEYS ARE EQUAL
DEPHASE
KI.CL==.-.KICMP ;[433] SIZE FOR KI/KL-10
END;
IFN FTOPS20,<
SEGMENT IMPURE ;[C20]
.CMPAR: BLOCK KI.CL ;[433] LOAD THE CODE AT RUN TIME
SEGMENT LPURE ;[C20]
>
SUBTTL ERROR MESSAGES
;HERE ON FATAL ERRORS
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
IFE FTOPS20,<
CALL RELSPC ;[C13] RELEASE ANY RETAINED MEMORY
>;END IFE FTOPS20
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.>)