Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/cobsrt.mac
There is 1 other file named cobsrt.mac in the archive. Click here to see a list.
; UPD ID= 1408 on 10/26/83 at 2:57 PM by FONG
TITLE SORT - COBOL INTERFACE TO NON-ZERO SEGMENT COBOL SORT
SUBTTL D.M.NIXON/DMN
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1982, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
CUSTVR==0
DECVER==1
DECMVR==0
DECEVR==1
V%FSRT==:<CUSTVR>B2+<DECVER>B11+<DECMVR>B17+DECEVR
IFNDEF FTDEBUG,<FTDEBUG==1> ;TO DEBUG SORT
;Requires Monitor Release 5 or later for non-zero section version.
SEARCH MACSYM,MONSYM
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
.DIRECTIVE FLBLST, SFCOND
SUBTTL TABLE OF CONTENTS FOR COBSRT
; Table of Contents for COBSRT
;
;
; Section Page
;
; 1 TABLE OF CONTENTS FOR COBSRT ............................. 2
; 2 REVISION HISTORY ......................................... 3
; 3 DEFINITIONS
; 3.1 Assembly Parameters, ACs .......................... 4
; 3.2 Typeout Macros .................................... 5
; 3.3 General description ............................... 6
; 4 TOPS-20 VERSION
; 4.1 SORT/MERGE Main Entry Points ...................... 7
; 4.2 Other Entry Points ................................ 11
; 4.3 Impure data ....................................... 12
; 4.4 Error Messages .................................... 13
SUBTTL REVISION HISTORY
;Creation.
SUBTTL DEFINITIONS -- Assembly Parameters, ACs
ENTRY PSORT.,PMERG.,RELES.,MERGE.,MCLOS.,RETRN.,ENDS.
;ACCUMULATOR DEFINITIONS (SAME AS SRTPRM)
T1=1
T2=2
T3=3
T4=4
P1=12 ;SORT = 0, MERGE = 1
P2=13
P3=14 ;SECTION # OF SORT
P4=15
L=16
P=17
;EXTENDED ADDRESSING OPCODE DEFINITIONS
OPDEF XMOVEI [SETMI]
OPDEF XHLLI [HLLI]
OPDEF XJRSTF [JRST 5,]
OPDEF XBLT [20B8]
OPDEF RSMAP% [JSYS 610]
OPDEF SMAP% [JSYS 767]
OPDEF PDVOP% [JSYS 603]
OPDEF XGVEC% [JSYS 606]
OPDEF XSVEC% [JSYS 607]
SUBTTL DEFINITIONS -- Typeout Macros
DEFINE TYPE(MESSAGE)<
HRROI T1,[ASCIZ \MESSAGE\]
PSOUT%
>
DEFINE TYPEC(ACC)<
IFN <ACC>-T1,<
HRRZ T1,ACC
>
PBOUT%
>
DEFINE $ERROR(Q,CODE,TEXT,MORE)<
E$$'CODE:
IFB <MORE>,<
TYPE <Q'SRT'CODE TEXT
>
>
IFNB <MORE>,<
TYPE <Q'SRT'CODE TEXT>
>
IFIDN <Q'MORE><?>,<
JRST DIE
>
>
SUBTTL General description
COMMENT \
This routine is built into COBLIB and replaces the existing SORT (SRTCBL).
It is not part of the shareable OTS (COBOTS) because it has about 30 words
of impure storage that must be allocated in the low segment.
Also it is totally independant of the OTS.
When this routine is called for the first time it first looks for
SORT.EXE on SYS: and gives an error if not found.
It then MAPs section 0 and section 1 together.
It then loops through the section table looking for the next free section above 1.
It then checks if DDT is loaded if so it MAPs DDT in section 0 into the SORT section.
It then jumps to itself in section 1 and does a GET of SORT into the SORT section
for all pages that exist.
It then uses the SORT entry vector to get the addresses of the various SORT entry
points so that the user calls will go directly to SORT.
It then gets the SORT symbol table pointer from .JBSYM in the SORT section.
If DDT is loaded it then swaps the symbol table pointers and jumps to the SORT section.
On returning it swaps the symbol table pointers back to point to the user's code.
If you wish to debug COBOL-SORT in a non-zero section then there are several
aspects (i.e. deficiencies) of DDT that must be taken into account.
You can not $X an XJRSTF in section 0 and get to a non-zero section.
You remain in section 0. The solution is to put a break point at the target of
the XJRSTF and $P there.
In general you can not $X through or put a break point in the code that swaps
the symbol table pointers. DDT range checks the symbol table for the section it
is in and will zero the pointer if it looks illegal, which it might well do.
The solution is to put a break point at the target of the XJRSTF (or some where
else in the target section) and do a $P from before the code that swaps the
symbol table pointers.
Use of PSORT%
PSORT% is a two word global PC word.
On the very first call to SORT PSORT%+1 must be zero.
On subsequent calls PSORT%+1 contains the PC of SORT.
PSORT% is zero if SORT is in a non-zero section and -1 if it is in section 0.
\
SUBTTL TOPS-20 VERSION -- SORT/MERGE Entry Points
;If you wish to enter DDT in the sort section execute XJRSTF GO2DDT$X
PSORT.: TDZA P1,P1 ; SORT ENTRY POINT
PMERG.: MOVEI P1,1 ; MERGE ENTRY POINT
SKIPE PSORT%+1 ; CALLED BEFORE?
JRST SORT5 ; YES
MOVX T1,.FHSLF ; NO, DISABLE SOME PA1050 INTERUPTS
MOVX T2,1B<.ICILI>!1B<.ICNXP>
DIC%
MOVX T1,.FHSLF ; SAVE OUR ENTRY VECTOR
; SINCE GET% JSYS DESTROYS IT
XGVEC% ; INCASE IN NON-ZERO SECTION
ERJMP [MOVX T1,.FHSLF ; NOT REL 5
GEVEC% ; USE OLD SECTION 0 JSYS
ERJMP [SETZB T2,T3 ; ERROR, SET EV TO ZERO
JRST .+1]
JRST .+1]
DMOVEM T2,SAVEVC ; SAVE BOTH WORDS
MOVX T1,RF%LNG+.FHSLF ; LONG FORM FOR THIS PROCESS
MOVEI T2,RFSBLK ; ARG BLOCK
SETZM RFSBLK+.RFSFL ; MAKE SURE ITS CLEAR INCASE REL 3
RFSTS% ; GET STATUS
ERJMP SORT1 ; ASSUME NOT EXECUTE-ONLY
IFGE RF%EXO,<PRINTX ?ERROR - RF%EXO is not the sign bit> ; INCASE IT CHANGES
SKIPGE RFSBLK+.RFSFL ; RF%EXO IS SIGN BIT
SKIPA T1,[GJ%OLD!GJ%SHT!GJ%PHY] ; PHYSICAL ONLY IF EXECUTE-ONLY
SORT1: MOVX T1,GJ%OLD!GJ%SHT ; GET A JFN FOR SORT.EXE
MOVE P4,T1 ; PUT IN SAFE PLACE FOR NOW
MOVE T1,[.FHSLF,,1] ; SEE IF SECTION 0 AND 1
RSMAP% ; ALREADY MAPPED TOGETHER
ERJMP SORTV4 ; NOT RELEASE 5
; WE ARE RUNNING UNDER RELEASE 5 OR LATER
AOJN T1,SORT1A ; ALREADY DONE (T1 NOT = -1)
MOVSI T1,.FHSLF ; THIS FORK IN SECT 0
MOVE T2,[.FHSLF,,1] ; ... IN SECT 1
MOVX T3,SM%RWX+1
SMAP% ; MAP SECTIONS 0 & 1 TOGETHER
ERJMP E$$CM1 ; CAN'T DO IT
SORT1A: MOVE T1,P4 ; GET BACK GTJFN BITS
HRROI T2,SRTEXE ; ..
GTJFN% ; ..
ERJMP E$$CFS ; COMPLAIN IF WE CAN'T FIND SORT
HRRZ P4,T1 ; PUT JFN IN A SAFE PLACE
SUBTTL TOPS-20 Release 5
;LOOP THROUGH THE SECTIONS STARTING AT SECTION 2 LOOKING FOR A FREE ONE FOR SORT
SORT5A: MOVEI P3,1 ; NOW FIND A FREE SECTION FOR SORT
SORT5B: AOS T1,P3 ; TRY NEXT ONE
CAILE T1,37 ; MAKE SURE SOME STILL LEFT
JRST E$$NFS ; NO FREE SECTIONS
HRLI T1,.FHSLF
RSMAP%
ERJMP E$$SNA ; ERROR
AOJN T1,SORT5B ; THIS ONE NOT FREE
MOVEM P3,SRTSEC ; SAVE SECTION # FOR GET
SETZ T1, ; DEFINE A MEMORY SECTION
HRLI T2,.FHSLF ; ..
HRR T2,P3 ; ..
MOVX T3,<PM%RWX!1> ; ..
SMAP% ; ..
ERJMP E$$SNA ; FAILED, OTHER SECTIONS NOT AVAILABLE
MOVE T1,[.FHSLF,,770] ; IS PAGE ACCESSIBLE?
IFN FTDEBUG,<
SETZM CODSYM ; CLEAR DDT INDICATOR
>
RPACS%
AND T2,[PA%RD!PA%EX!PA%PEX]
CAME T2,[PA%RD!PA%EX!PA%PEX]
JRST SORT5C ; NO DDT
MOVE T1,770000 ; DOES IT CONTAIN DDT?
CAME T1,[JRST 770002]
JRST SORT5C ; NO
MOVE T1,[.FHSLF,,764] ; SOURCE
MOVE T2,P3 ; GET DESTINATION SECTION #
LSH T2,9
ADD T2,[.FHSLF,,764] ; DESTINATION
MOVX T3,<PM%CNT!PM%RD!PM%WR!PM%EX+13> ; ACCESS INFO
; THIS WILL BE THE AND OF THIS AND SECTION 0
; ALLOW ONE EXTRA PAGE FOR DDT IN CASE IT EXPANDS
PMAP% ; MAP THE PAGES TOGETHER
ERJMP E$$CM2 ; ERROR
IFN FTDEBUG,<
MOVE T1,@770001 ; GET CURRENT SYMBOL TABLE POINTER
ERJMP .+2 ; JUST IN CASE NO SYMBOL TABLE
MOVEM T1,CODSYM ; STORE IT AS FLAG THAT DDT LOADED
>
;NOW GET SORT INTO THE NON-ZERO SECTION
SORT5C: XMOVEI T1,. ; SEE WHAT SECTION WE ARE IN
TLNN T1,-1 ; IF ALREADY IN NON-ZERO SECTION STAY THERE
;NOTE THAT YOU CANNOT $X THE NEXT INSTRUCTION, PUT A BREAKPOINT AT SORT5D AND $P
XJRSTF [0
1,,.+1] ; ELSE JUMP TO SECTION 1
SORT5D: HRLI T1,.FHSLF ; DO A GET% ON SORT.EXE
HRR T1,P4 ; GET JFN
TXO T1,GT%ARG!GT%NOV ; DON'T PRE-LOAD AS MOST IS NOT USED
XMOVEI T2,GETARG ; POINT TO ARG BLOCK
GET%
ERJMP E$$CGS ; FAILED
;[10] GET SORT'S PROGRAM DATA VECTOR
MOVE T1,[PDVDAT,,PDVARG] ;[10] SET UP ARG BLOCK
BLT T1,PDVARG+.PODAT ;[10] ...
MOVEI T1,.POLOC ;[10] LOCATE
MOVEI T2,PDVARG ;[10] ARG BLOCK
HRROI T3,[ASCIZ /COBOL-SORT/] ;[10] PDV NAME
PDVOP% ;[10]
ERJMP SORT5E ;[10] FAILED USE ENTRY VECTOR
SKIPN PDVARG+.POCT2 ;[10] DID WE FIND ONE?
JRST SORT5E ;[10] NO, OLD VERSION OF SORT
MOVE T1,PDVBLK+.PVSTR ;[10] GET LOCAL CALLABLE START ADDRESS
HLL T1,P3 ;[10] ADD IN SORT SECTION
MOVEM T1,PSORT%+1 ;[10]
MOVE T1,PDVBLK+.PVSYM ;[10] GET SYMBOL TABLE POINTER
JRST SORT5F ;[10] JOIN COMMON CODE
;[10] HERE WHEN PDV CANNOT BE FOUND
SORT5E: MOVEI T1,.FHSLF ; GET SORT'S ENTRY VECTOR
XGVEC% ; ..
MOVE P3,T3 ; POINT TO SORT ENTRY VECTOR
HLRZ T1,4(P3) ; GET SIZE OF COBOL ENTRY VECTOR
HRRZ T2,4(P3) ; LOCAL ADDRESS OF COBOL VECTOR
HLL T2,P3 ; MAKE IT GLOBAL
XMOVEI T3,PSORT% ; CURRENT SECTION ADDRESS
EXTEND T1,[XBLT] ; MOVE THE ENTRY VECTOR TO CURRENT SECTION
SORT5F: MOVEI T1,.FHSLF
DMOVE T2,SAVEVC ; RESTORE USER'S ENTRY VECTOR
XSVEC%
;HERE WHEN SORT IS READ IN
SORT5G: HLLM P3,PSORT%+1 ; FIX UP THE TRANSFER ADDRESSES
HLLM P3,PMERG%+1 ; ...
HLLM P3,RELES%+1 ; ...
HLLM P3,MERGE%+1 ; ...
HLLM P3,MCLOS%+1 ; ...
HLLM P3,RETRN%+1 ; ...
HLLM P3,ENDS%+1 ; ...
HLLM P3,GO2DDT+1 ; SO WE CAN GET TO DDT IN SORT SECTION
XMOVEI T1,SRTARG ; GET CURRENT SECTION NUMBER
HLLM T1,SRTARG+1 ; FILL IN ARG BLOCK
HLLM T1,SRTARG+2 ; ..
HLLM T1,SRTARG+3 ; ..
IFN FTDEBUG,<
MOVEI T1,.JBSYM## ; POINT TO SYMBOL TABLE
HLL T1,P3 ; IN SORT SECTION
MOVE T1,(T1) ; GET POINTER
SKIPN CODSYM ; IS DDT LOADED?
SETZ T1, ; NO, DON'T SAVE SYMBOL POINTER
MOVEM T1,SRTSYM ; SAVE ADDRESS OF SORT'S SYMBOL TABLE
>
SORT3:
IFN FTDEBUG,<
SKIPE CODSYM ; IS DDT LOADED?
MOVEM T1,@770001 ; YES STORE NEW SYMBOL TABLE
>
XMOVEI L,SRTARG ; LOAD RETURN ADDRESS
JUMPN P1,SORT3M ; WANT SORT OR MERGE?
SKIPE PSORT%
JRST @PSORT%+1 ; SECTION 0
XJRSTF PSORT% ; NON-ZERO SECTION SORT
SORT3M: SKIPE PSORT%
JRST @PMERG%+1 ; SECTION 0
XJRSTF PMERG% ; NON-ZERO SECTION MERGE
;Return from SORT to section 0
SORT4:
IFN FTDEBUG,<
SKIPE T1,CODSYM ; DO WE NEED TO RESTORE POINTER
MOVEM T1,@770001 ; YES
>
POPJ P, ; RETURN TO CALLER
;Here on subsequent calls, we must get to section 1
SORT5: XMOVEI T1,. ; SEE WHAT SECTION WE ARE IN
SKIPN PSORT% ; DON'T BOTHER IF A NON-EXTENDED MACHINE
TLNE T1,-1 ; IF ALREADY IN NON-ZERO SECTION
JRST SORT3 ; STAY THERE, ELSE JUMP TO SECTION 1
XJRSTF [0 ; ..
1,,SORT3] ; ..
SUBTTL TOPS-20 VERSION -- Release 4
SORTV4: SETOM PSORT% ;[10] [5] REMEMBER FAILURE TO GET NON-ZERO SECTION
MOVE T1,P4 ; RESTORE GTJFN BITS
HRROI T2,CSRTEXE ; ..
GTJFN% ; ..
ERJMP E$$CFC ; COMPLAIN IF WE CAN'T FIND SORT
HRRZ P4,T1 ; PUT JFN IN A SAFE PLACE
HRLI T1,.FHSLF ;[5] DO A GET% ON SORT.EXE
TXO T1,GT%ADR!GT%NOV ;[6] CHECK ADDRESS LIMITS, DON'T OVERLAY
MOVE T2,[600,,677] ;[10] ALL OF SORT'S HIGH SEGMENT
GET% ;[5]
MOVEI T1,.FHSLF ;[5] GET SORT'S ENTRY VECTOR
GEVEC% ;[5] ..
HRLZ P3,P3 ; PUT SECTION # IN GLOBAL SIDE
HRR P3,T2 ; POINT TO COBOL-SORT ENTRY VECTOR
HLRZ T1,4(P3) ; GET SIZE OF ENTRY VECTOR
HRRZ T2,4(P3) ; LOCAL ADDRESS OF VECTOR
HLL T2,P3 ; MAKE IT GLOBAL
MOVEI T3,PSORT% ; CURRENT SECTION ADDRESS
EXTEND T1,[XBLT] ; MOVE THE ENTRY VECTOR TO CURRENT SECTION
DMOVE T2,SAVEVC ;RESTORE USER'S ENTRY VECTOR
SEVEC% ;[2] ..
JRST SORT5G ;[10] JOIN MAIN LINE CODE
SUBTTL TOPS-20 VERSION -- Other entry points
;OTHER ENTRY POINTS
RELES.:
IFN FTDEBUG,<
SKIPE T1,SRTSYM ; DO WE NEED TO SET UP SYMBOL TABLE POINTER?
MOVEM T1,@770001 ; YES, SO WE CAN DEBUG SORT
>
XJRSTF RELES%
MERGE.:
IFN FTDEBUG,<
SKIPE T1,SRTSYM
MOVEM T1,@770001
>
XJRSTF MERGE%
MCLOS.:
IFN FTDEBUG,<
SKIPE T1,SRTSYM
MOVEM T1,@770001
>
XJRSTF MCLOS%
RETRN.:
IFN FTDEBUG,<
SKIPE T1,SRTSYM
MOVEM T1,@770001
>
XJRSTF RETRN%
ENDS.:
IFN FTDEBUG,<
SKIPE T1,SRTSYM
MOVEM T1,@770001
>
XJRSTF ENDS%
;SET UP AFTER COBSRT MERGED IN
PSORT%: BLOCK 1 ; SORT'S PSORT. XJRSTF PC
Z ; MUST BE ZERO FIRST TIME
PMERG%: BLOCK 2 ; PMERG.
RELES%: BLOCK 2 ; RELES.
MERGE%: BLOCK 2 ; MERGE.
MCLOS%: BLOCK 2 ; MCLOS.
RETRN%: BLOCK 2 ; RETERN.
ENDS%: BLOCK 2 ; ENDS.
GO2DDT: EXP 0 ; ENTER DDT IN SORT SECTION
XWD 0,770000
SRTEXE: ASCIZ /SYS:SORT.EXE/ ;[2] NAME TO DO A GET% JSYS ON
CSRTEXE:ASCIZ /SYS:COBOL-SORT.EXE/ ;[2] NAME TO DO A GET% JSYS ON
PDVDAT: EXP .PODAT+1 ;[10] DON'T SUPPLY MEMORY RANGES
EXP .FHSLF ;[10] THIS FORK
EXP .PVSYM+1 ;[10] NO. OF WORDS WE WANT RETURNED
EXP PDVBLK ;[10] WHERE TO RETURN THE DATA
SUBTTL TOPS-20 VERSION -- Impure data
SAVEVC: BLOCK 2 ; SAVE USER'S ENTRY VECTOR
RFSBLK: EXP .RFSFL+1 ; ARG BLOCK FOR LONG FORM RFSTS% JSYS
BLOCK .RFSFL ; SPACE FOR RETURNED ARGS
;CROCK TO SET SYMBOL TABLE FOR SORT IF DDT LOADED SO WE CAN DEBUG IT
IFN FTDEBUG,<
CODSYM: BLOCK 1 ; ADDRESS OF CURRENT SYMBOL TABLE
SRTSYM: BLOCK 1 ; ADDRESS OF SORT'S SYMBOL TABLE
>
GETARG: EXP GT%LOW!GT%BAS
EXP 0
EXP 0
SRTSEC: BLOCK 1 ; SECTION # OF SORT
-7,,0
SRTARG: EXP SORT4 ; RETURN ADDRESS IN SECTION 0
EXP STOPR.## ; LIBOL ERROR ROUTINE IN SECTION 1
EXP KEYCV.##
EXP FUNCT.## ; TELL SORT WHERE FUNCT. IS
PUSHJ P,PMERG.
PUSHJ P,RELES. ; USED BY MERGE TO SEE
PUSHJ P,MERGE. ; IF /R OR NOT
; PROGRAM DATA VECTOR
.POLOC==5 ; LOCATE THE SPECIFIED PDV
.POCT1==0 ; NO. OF WORDS IN ARG BLOCK
.POPHD==1 ; PROCESS HANDLE
.POCT2==2 ; NO. OF WORDS IN DATA BLOCK
.PODAT==3 ; ADDRESS OF DATA BLOCK
.PVSTR==2 ; PROGRAM START ADDRESS
.PVSYM==6 ; PROGRAM SYMBOL TABLE
PDVARG: BLOCK .PODAT+1 ; ARG BLOCK FOR PDVOP JSYS
PDVBLK: BLOCK .PVSYM+1 ; LENGTH OF PDV WE WANT
; SYMBOLS NOT IN MONSYM
SM%RWX==:SM%RD!SM%WR!SM%EX ; CONVENIENCE
DDTPG.==764 ; START OF DDT
SUBTTL TOPS-20 VERSION -- Error Messages
E$$SNA: $ERROR(?,SNA,<Non-zero sections not available>)
E$$CM1: $ERROR (?,CM1,<Can't MAP sections 0 and 1 together>)
E$$CM2: $ERROR (?,CM2,<Can't MAP section 0 and SORT section together>)
E$$NFS: $ERROR (?,NFS,<No free sections left>)
E$$CGS: $ERROR (?,CGS,<Can't get SORT into non-zero section>)
E$$CFC: SKIPA T1,[-1,,CSRTEXE]
E$$CFS: HRROI T1,SRTEXE ; MESSAGE WE WANT
PUSH P,T1
SKIPL RFSBLK+.RFSFL ; EXECUTE-ONLY?
JRST E$CFS1 ; NO, USE OLD MESSAGE
$ERROR (?,XGF,<Execute-only GTJFN% failed for >,+)
JRST E$CFS2 ; REST OF MESSAGE
E$CFS1: $ERROR (?,GFS,<GTJFN% failed for >,+)
E$CFS2: POP P,T1 ; TYPE WHAT WE COULDN'T FIND
PSOUT% ; ..
TYPE <, > ; FOLLOWED BY WHY (LAST PROCESS ERROR)
DIE: MOVX T1,.PRIOU ; TYPE LAST PROCESS ERROR
MOVX T2,<.FHSLF,,-1> ; ..
SETZ T3, ; ..
ERSTR% ; ..
ERJMP .+2 ; IGNORE ERRORS AT THIS POINT
ERJMP .+1 ; ..
TYPE <.
>
HALTF% ; STOP THE JOB
JRST PSORT. ; IN CASE USER FIXED THINGS
END