Trailing-Edge
-
PDP-10 Archives
-
BB-4160F-BM
-
sort-source/forsrt.mac
There are 33 other files named forsrt.mac in the archive. Click here to see a list.
TITLE SORT - FORTRAN INTERFACE TO STAND-ALONE SORT
SUBTTL D.M.NIXON/DMN/DZN/BRF 5-Jun-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) 1978, 1981 BY DIGITAL EQUIPMENT CORPORATION
CUSTVR==0
DECVER==4
DECMVR==3
DECEVR==6
V%FSRT==:<CUSTVR>B2+<DECVER>B11+<DECMVR>B17+DECEVR
SUBTTL TABLE OF CONTENTS FOR FORSRT
; Table of Contents for FORSRT
;
;
; Section Page
;
; 1 TABLE OF CONTENTS FOR FORSRT ............................. 2
; 2 DEFINITIONS
; 2.1 Assembly Parameters, ACs .......................... 3
; 3 REVISION HISTORY ......................................... 4
; 4 DEFINITIONS
; 4.1 Typeout Macros .................................... 5
; 5 TOPS-20 VERSION
; 5.1 Data .............................................. 6
; 5.2 SORT/MERGE Entry Point ............................ 7
; 5.3 Error Messages .................................... 8
; 6 TOPS-10 VERSION
; 5.1 Data .............................................. 7
; 5.2 SORT/MERGE Entry Point ............................ 8
; 5.3 Error Messages .................................... 9
SUBTTL DEFINITIONS -- Assembly Parameters, ACs
;FEATURE TEST SWITCHES
IFNDEF FTOPS20,<FTOPS20==1>
IFN FTOPS20,<SEARCH MACSYM,MONSYM>
IFE FTOPS20,<SEARCH MACTEN,UUOSYM>
SALL
IFNDEF S.SEC,<S.SEC==5> ;[6] PUT SORT IN SECTION 5 BY DEFAULT
.DIRECTIVE FLBLST, SFCOND
;ACCUMULATOR DEFINITIONS (SAME AS SRTPRM)
T1=1
T2=2
T3=3
T4=4
P1=12 ;[5]
P2=13 ;[5]
P3=14 ;[5]
P4=15 ;[5]
L=16
P=17
;EXTENDED ADDRESSING OPCODE DEFINITIONS
OPDEF XMOVEI [SETMI] ;[5]
OPDEF XHLLI [HLLI] ;[5]
OPDEF XJRSTF [JRST 5,] ;[5]
OPDEF XBLT [20B8] ;[5]
IFN FTOPS20,<
OPDEF SMAP% [JSYS 767] ;[5]
>
ENTRY SORT
SUBTTL REVISION HISTORY
;Creation.
;FORSRT released with SORT %4(302).
;1 Data pages should contain zero before calling SORT.
;2 Use new JSYS name format, NAME%, to avoid symbol name conflicts.
;3 Delete edit 1, put code in SORT itself. Improve error message.
;4 Add test for execute-only in Release 4.
;5 Clean up code to allow SORT-20 to run in a non-zero memory SECTION.
;6 More non-zero section code.
SUBTTL DEFINITIONS -- Typeout Macros
DEFINE TYPE(MESSAGE)<
IFE FTOPS20,<
OUTSTR [ASCIZ \MESSAGE\]
>
IFN FTOPS20,<
HRROI T1,[ASCIZ \MESSAGE\]
PSOUT% ;;[2]
>
>
DEFINE TYPEC(ACC)<
IFE FTOPS20,<
OUTCHR ACC
>
IFN FTOPS20,<
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 TOPS-20 VERSION -- Data
IFN FTOPS20,<
SRTEXE: ASCIZ /SYS:SORT.EXE/ ;[2] NAME TO DO A GET% JSYS ON
SAVEVC: BLOCK 1 ;SAVE USER'S ENTRY VECTOR
RFSBLK: EXP .RFSFL+1 ;[4] ARG BLOCK FOR LONG FORM RFSTS% JSYS
BLOCK .RFSFL ;[4] SPACE FOR RETURNED ARGS
SRTADR: BLOCK 1 ;[5] SORTS XJRSTF PC
Z ;[5] MUST BE ZERO FIRST TIME
SUBTTL TOPS-20 VERSION -- SORT/MERGE Entry Point
'SORT ' ;SIXBIT NAME FOR TRACE.
SORT: MOVX T1,.FHSLF ;[5] DISABLE SOME PA1050 INTERUPTS
MOVX T2,1B<.ICILI>!1B<.ICNXP> ;[5] ..
DIC% ;[5] ..
SKIPE SRTADR+1 ;[5] CALLED BEFORE?
JRST SORT3 ;[5] YES
MOVX T1,.FHSLF ;[5] NO, SAVE OUR ENTRY VECTOR
GEVEC% ;[2] SINCE GET% JSYS DESTROYS IT
MOVEM T2,SAVEVC ; ..
MOVX T1,RF%LNG!.FHSLF ;[4] LONG FORM FOR THIS PROCESS
MOVEI T2,RFSBLK ;[4] ARG BLOCK
SETZM RFSBLK+.RFSFL ;[4] MAKE SURE ITS CLEAR INCASE REL 3
RFSTS% ;[4] GET STATUS
ERJMP SORT1 ;[4] ASSUME NOT EXECUTE-ONLY
IFGE RF%EXO,<PRINTX ?ERROR - RF%EXO is not the sign bit> ;[4] INCASE IT CHANGES
SKIPGE RFSBLK+.RFSFL ;[4] RF%EXO IS SIGN BIT
SKIPA T1,[GJ%OLD!GJ%SHT!GJ%PHY] ;[4] PHYSICAL ONLY IF EXECUTE-ONLY
SORT1: MOVX T1,GJ%OLD!GJ%SHT ;[4] GET A JFN FOR SORT.EXE
HRROI T2,SRTEXE ; ..
GTJFN% ;[2] ..
ERJMP E$$CFS ;COMPLAIN IF WE CAN'T FIND SORT
HRRZ P4,T1 ;[5] PUT JFN IN A SAFE PLACE
SETZ T1, ;[5] DEFINE A MEMORY SECTION
DMOVE T2,[.FHSLF,,S.SEC ;[5] ..
PM%RWX!1] ;[5] ..
SMAP% ;[5] ..
ERJMP SORTS0 ;[5] FAILED, OTHER SECTIONS NOT AVAILABLE
SETZB P1,SRTADR ;[5] REMEMBER SUCCESS OF SMAP%
HRLZ P3,T2 ;[5] REMEMBER GET% SECTION
MOVE T1,[.FHSLF,,770] ;[6] IS PAGE ACCESSIBLE?
RPACS% ;[6]
AND T2,[PA%RD!PA%EX!PA%PEX] ;[6]
CAME T2,[PA%RD!PA%EX!PA%PEX] ;[6]
JRST SORTND ;[6] NO DDT
MOVE T1,770000 ;[6] DOES IT CONTAIN DDT?
CAME T1,[JRST 770002] ;[6]
JRST SORTND ;[6] NO
MOVE T1,[.FHSLF,,770] ;[6] SOURCE
DMOVE T2,[.FHSLF,,S.SEC*1000+770 ;[6] DESTINATION
PM%CNT!PM%RD!PM%EX+10] ;[6] ACCESS INFO
PMAP% ;[6] MAP THE PAGES TOGETHER
ERJMP SORTND ;[6] TOO BAD
MOVE T1,[.FHSLF,,766] ;[6] ALSO THE DATA PAGES
DMOVE T2,[.FHSLF,,S.SEC*1000+766 ;[6]
PM%CNT!PM%RD!PM%WR!PM%EX+2] ;[6] THESE ARE WRITEABLE
PMAP% ;[6] MAP THE PAGES TOGETHER
ERJMP SORTND ;[6] TOO BAD
SORTND: MOVE T2,[SORTXB,,XT1] ;[5] TRANSFER XBLT CODE TO ACS
BLT T2,XT10 ;[5] ..
XMOVEI P2,SORT2 ;[5] GO TO XBLT CODE
XJRSTF [0 ;[5] IN NON-ZERO SECTION
1,,XT1] ;[5] ..
;RETURN HERE WHEN SORT IS READ IN
SORT2: SKIPA ;[6] IF YOU WISH TO USE DDT IN THE SORT SECTION
XJRSTF [0 ;[6] THEN EXECUTE THIS XJRSTF
S.SEC,,770000] ;[6] USE $P NOT $X
MOVEM P3,SRTADR+1 ;[5] SAVE SORTS ADDRESS
MOVE T2,SAVEVC ;RESTORE USER'S ENTRY VECTOR
SEVEC% ;[2] ..
SORT3: XMOVEI T1,FUNCT.## ;[5] TELL SORT WHERE FUNCT. IS
XMOVEI T4,SORT4 ;[5] CALL SORT TO DO THE REAL WORK
SKIPE SRTADR ;[5] ..
JRST @SRTADR+1 ;[5] ..
XJRSTF SRTADR ;[5] ..
SORT4: JRST [MOVEI L,1+[XWD 0,0] ;[5] FAILED, CALL EXIT.
PUSHJ P,EXIT.## ;[5]
JRST .+1] ;[5] CONTINUED?????
POPJ P, ;RETURN TO CALLER
SORTXB: PHASE T1 ;[5]
XT1:! HLL XT6,P2 ;[5] GET SOURCE SECTION
HLL XT7,P3 ;[5] GET OBJECT SECTION
EXTEND XT5,XT10 ;[5] TRANSFER GET% CODE
JRST SORTG-SORTG2(XT7) ;[5] GO TO IT
XT5:! EXP SORTG2-SORTG ;[5] XBLT COUNT
XT6:! XWD 0,SORTG ;[5] XBLT SOURCE ADDRESS
XT7:! XWD 0,677000 ;[5] XBLT OBJECT ADDRESS
XT10:! XBLT ;[5]
XP1:! DEPHASE ;[5]
IFG <XP1-P1>,<PRINTX ?ERROR - SORTXB subroutine too large> ;[5]
SORTS0: SETOB P1,SRTADR ;[5] REMEMBER FAILURE
XMOVEI P3,SORTG ;[5] REMEMBER GET% SECTION
XMOVEI P2,SORT2 ;[5] GO DIRECTLY TO SORTG
SORTG: HRLI T1,.FHSLF ;[5] DO A GET% ON SORT.EXE
HRR T1,P4 ;[5] GET JFN
TXO T1,GT%ADR!GT%NOV ;[6] CHECK ADDRESS LIMITS, DON'T OVERLAY
HRLI T2,000 ;[5] ALL OF HIGH SEGMENT
SKIPE P1 ;[5] ..
HRLI T2,600 ;[5] ..
HRRI T2,765 ;[6] ..
SKIPE P1 ;[5] ..
HRRI T2,677 ;[5] ..
GET% ;[5]
MOVEI T1,.FHSLF ;[5] GET SORT'S ENTRY VECTOR
GEVEC% ;[5] ..
HRR P3,T2 ;[5] CALCULATE SORT ENTRY POINT
HRR P3,3(P3) ;[5] ..
JUMPN P1,(P2) ;[5] RETURN
XJRSTF P1 ;[5] ..
SORTG2:! ;[5]
SUBTTL TOPS-20 VERSION -- Error Messages
E$$CFS: SKIPL RFSBLK+.RFSFL ;[4] EXECUTE-ONLY?
JRST E$CFS1 ;[4] NO, USE OLD MESSAGE
$ERROR (?,XGF,<Execute-only GTJFN% failed for >,+) ;[4]
JRST E$CFS2 ;[4] REST OF MESSAGE
E$CFS1: $ERROR (?,GFS,<GTJFN% failed for >,+) ;[4]
E$CFS2: HRROI T1,SRTEXE ;[4] TYPE WHAT WE COULDN'T FIND
PSOUT% ;[2] ..
TYPE <, > ; FOLLOWED BY WHY (LAST PROCESS ERROR)
PRCERR: MOVX T1,.PRIOU ;TYPE LAST PROCESS ERROR
MOVX T2,<.FHSLF,,-1> ; ..
SETZ T3, ; ..
ERSTR% ;[2] ..
ERJMP .+2 ;IGNORE ERRORS AT THIS POINT
ERJMP .+1 ; ..
TYPE <.
>
DIE: HALTF% ;[2] STOP THE JOB
JRST SORT ;IN CASE USER FIXED THINGS
>;END IFN FTOPS20
SUBTTL TOPS-10 VERSION - Data
IFE FTOPS20,<
SRTEXE: SIXBIT /SYS/ ;[5] MERGE. UUO ARGUMENT BLOCK
SIXBIT /FSORT/ ;[5] ..
0 ;[5] ..
0 ;[5] ..
0 ;[5] ..
XWD 600,677 ;[5] ..
SAVEL: BLOCK 1 ;[5] SAVE AC L DURING MERGE. UUO
SAVEP: BLOCK 1 ;[5] SAVE AC P DURING MERGE. UUO
;FUNCT. ARGUMENTS
F.CBC==12 ;CUT BACK CORE (SHRINK)
;FORTRAN DATA TYPES
TP%INT==2 ;INTEGER
TP%LIT==17 ;ASCIZ TEXT (LITERAL STRING)
SUBTTL TOPS-10 VERSION -- SORT/MERGE Entry Point
'SORT ' ;NAME FOR TRACE.
SORT: DMOVEM L,SAVEL ;[5] SAVE AC L AND P
MOVEI T1,SRTEXE ;[5] MERGE IN SORT
MERGE. T1, ;[5] ..
HALT ;[5] FAILED
DMOVE L,SAVEL ;[5] RETORE AC L AND P
SETZ P1, ;[5] CALCULATE SORT ENTRY POINT
HRRZ P2,600000+.JBHSA## ;[5] ..
ADDI P2,2 ;[5] ..
XMOVEI T1,FUNCT.## ;[5] TELL SORT WHERE FUNCT. IS
XMOVEI T4,SORT1 ;[5] CALL SORT TO DO THE REAL WORK
JRST (P2) ;[5] ..
SORT1: JRST [MOVEI L,1+[XWD 0,0] ;[5] FAILED, CALL EXIT.
PUSHJ P,EXIT.## ;[5]
JRST .+1] ;[5] CONTINUED?????
MOVEI T1,677-600+1 ;[5] GET PAGE COUNT
MOVEI T2,1 ;[5] SETUP PAGE. UUO
MOVE T3,[PA.GAF!600] ;[5] ..
SORT2: MOVE T4,[XWD .PAGCD,T2] ;[5] DESTROY A PAGE
PAGE. T4, ;[5] ..
JFCL ;[5] FAILED
ADDI T3,1 ;[5] LOOP
SOJG T1,SORT2 ;[5] ..
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,T1]
JRST FUNCT. ;CUT BACK CORE AND RETURN TO CALLER
SUBTTL TOPS-10 VERSION -- Error Messages
DIE: EXIT 1, ;[5]
JRST SORT ;[5]
>;END IFE FTOPS20
END