Trailing-Edge
-
PDP-10 Archives
-
BB-4160E-BM
-
sort-development/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 21-Mar-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) 1978, 1979 BY DIGITAL EQUIPMENT CORPORATION
CUSTVR==0
DECVER==4
DECMVR==2
DECEVR==4
V%FSR==:<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 - NOT SUPPORTED .......................... 9
SUBTTL DEFINITIONS -- Assembly Parameters, ACs
;FEATURE TEST SWITCHES
;FTOPS20 ;TOPS-20 VERSION
IFNDEF FTOPS20,<FTOPS20==1>
IFN FTOPS20,<SEARCH MACSYM,MONSYM>
IFE FTOPS20,<SEARCH MACTEN,UUOSYM>
SALL
.DIRECTIVE FLBLST, SFCOND
;ACCUMULATOR DEFINITIONS (SAME AS SRTPRM)
T1=1
T2=2
T3=3
T4=4
P1=5
L=16
P=17
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.
SUBTTL DEFINITIONS -- Typeout Macros
DEFINE TYPE(MESSAGE)<
IFE FTOPS20,<
OUTSTR [ASCIZ \MESSAGE\]
>
IFN FTOPS20,<
HRROI T1,[ASCIZ \MESSAGE\]
;;*;[2] Replace in TYPE macro DZN 9-Nov-78
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
ARGBLK: BLOCK 1 ;SAVE AC16
JRST FUNCT.## ;PASS THESE FORTRAN ROUTINE ADDRS
JRST EXIT.## ; TO SORT
SUBTTL TOPS-20 VERSION -- SORT/MERGE Entry Point
'SORT ' ;SIXBIT NAME FOR TRACE.
SORT: MOVX T1,.FHSLF ;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
HRLI T1,.FHSLF ;[2] DO A GET% ON SORT.EXE
TXO T1,GT%ADR ;CHECK ADDRESS LIMITS
MOVE T2,[600,,677] ;ALL OF HIGH SEGMENT
GET% ;[2]
MOVX T1,.FHSLF ;GET SORT'S ENTRY VECTOR
GEVEC% ;[2] TO MAKE SURE IT'S THE NEW SORT
MOVE P1,T2 ;PUT ENTRY VECTOR IN SAFE PLACE
MOVE T2,SAVEVC ;RESTORE USER'S ENTRY VECTOR
SEVEC% ;[2] ..
HLRZ T1,P1 ;GET 'LENGTH' OF SORT'S ENTRY VECTOR
CAIN T1,<JRST>_<-^D18> ;LOOK LIKE A JRST (I.E., TOPS-10 STYLE)?
JRST E$$SV4 ;[3] YES--MUST BE OLDER THAN RELEASE 4
MOVE P1,3(P1) ;GET USER ENTRY LIST IN SAFE PLACE
MOVEM L,ARGBLK ;SAVE USER'S L
MOVEI L,ARGBLK ;POINT TO IT
PUSHJ P,0(P1) ;CALL SORT TO DO THE REAL WORK
MOVX T1,.FHSLF ;PAGE EVERYTHING OUT SO
RWSET% ;[2] SORT GETS REMOVED FROM WORKING SET
POPJ P, ;RETURN TO CALLER
SUBTTL TOPS-20 VERSION -- Error Messages
E$$SV4: $ERROR (?,SV4,<SORT version 4 or later required.>)
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 - NOT SUPPORTED
IFE FTOPS20,<
;FORTRAN DATA TYPES
TP%UDF==0 ;UNDEFINED TYPE
TP%LOG==1 ;LOGICAL
TP%INT==2 ;INTEGER
TP%REA==4 ;REAL
TP%OCT==6 ;OCTAL
TP%LBL==7 ;LABEL OR ADDRESS
TP%DOR==10
TP%DOT==12
TP%COM==14
TP%LIT==17 ;ASCIZ TEXT (LITERAL STRING)
;FUNCT. ARGUMENTS
F.GCH==4 ;GET CHANNEL ARGUMENT
F.RCH==5 ;RETURN CHANNEL NUMBER
;LOCAL DEFINITIONS
DIRLEN==5 ;ALL WE SHOULD NEED OF .EXE DIRECTORY
PAGLEN==^D32 ;MAX. PAGES NEEDED FOR HIGH SEG CODE
'SORT ' ;NAME FOR TRACE.
SORT: MOVEM L,SAVEL
MOVEI L,1+[-4,,0
Z TP%INT,[F.GCH]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,CHSTAT
Z TP%INT,SRTCHN]
PUSHJ P,FUNCT.## ;ASK FOROTS FOR A CHANNEL
SKIPE CHSTAT ;DID WE GET IT?
JRST E$$CAS ;NO
MOVE T1,SRTCHN
DPB T1,[POINT 4,SRTCHN,12] ;PUT IN ACC FIELD
HLLZ T1,SRTCHN
IOR T1,[OPEN OBLK]
XCT T1 ;OPEN SYS
JRST E$$OPN ;FAILED?
HLLZ T1,SRTCHN
IOR T1,[LOOKUP LBLK]
XCT T1 ;LOOKUP SYS:SRTFOR.EXE
JRST E$$LKP ;FAILED
HLLZ T1,SRTCHN
IOR T1,[IN DIRIOW]
XCT T1
SKIPA T1,SRTDIR ;OK, GET DIRECTORY HEADER
JRST E$$INP ;ERROR
CAME T1,[1776,,5] ;WHAT WE EXPECT
JRST E$$DUF ;NO
HRRZ T1,SRTDIR+3 ;GET FILE PAGE
LSH T1,2 ;4 BLOCKS PER PAGE
ADDI T1,1 ;START AT 1
HLL T1,SRTCHN
TLO T1,(USETI)
XCT T1 ;SET ON HIGH SEG PAGES
LDB T1,[POINT 9,SRTDIR+4,8] ;GET REPEAT COUNT
CAILE T1,PAGLEN ;TOO BIG
JRST E$$HTB ;YES
MOVEM T1,PAGARG ;LOAD UP ARG COUNT
MOVN T1,T1
HRLZ T1,T1 ;AOBJN POINTER
HRRZ T2,SRTDIR+4 ;CORE PAGE
MOVEM T2,PAGARG+1(T1) ;STORE PAGE #
ADDI T2,1
AOBJN T1,.-2 ;FILL UP ARG BLOCK
MOVE T1,[.PAGCD,,PAGARG]
PAGE. T1,
JRST E$$PCF ;FAILED
HRRZ T2,PAGARG+1 ;GET FIRST PAGE
LSH T2,^D9 ;INTO WORDS
SUBI T2,1
MOVE T3,PAGARG ;GET NUMBER OF PAGES
LSH T3,^D9
MOVN T3,T3
HRL T2,T3 ;I/O WORD
HLLZ T1,SRTCHN
IOR T1,[IN T2]
SETZ T3,
XCT T1
SKIPA
JRST E$$INP
PUSH P,.JBHSA##+1(T2) ;GET START ADDRESS
MOVEI L,1+[-4,,0
Z TP%INT,[F.RCH]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,CHSTAT
Z TP%INT,SRTCHN]
PUSHJ P,FUNCT. ;RESTORE CHAN TO FOROTS
POP P,T1 ;GET BACK START ADDRESS
MOVE L,SAVEL ;RESTORE STRING POINTER
PUSHJ P,(T1) ;START SORT
MOVSI T1,-PAGLEN
MOVSI T2,(1B0)
IORM T2,PAGARG+1(T1) ;SET DESTROY BIT
AOBJN T1,.-1 ;FOR ALL OF SORT PAGES
MOVE T1,[.PAGCD,,PAGARG]
PAGE. T1,
JFCL ;TOO BAD
POPJ P, ;RETURN TO CALLER
OBLK: EXP .IODMP
SIXBIT /SYS/
0
LBLK: EXP .RBEXT ;.RBCNT
0 ;.RBPPN
SIXBIT /SRTFOR/ ;.RBNAM
SIXBIT /EXE/ ;.RBEXT
DIRIOW: IOWD DIRLEN,SRTDIR
0
E$$CAS: $ERROR (?,CAS,<Channel not available for FORTRAN SORT/MERGE.>)
E$$OPN: $ERROR (?,OPN,<OPEN failed for SYS:SRTFOR.EXE.>)
E$$LKP: $ERROR (?,LKP,<LOOKUP failed for SYS:SRTFOR.EXE.>)
E$$DUF: $ERROR (?,DUF,<SYS:SRTFOR.EXE directory not in expected format.>)
E$$HTB: $ERROR (?,HTB,<SYS:SRTFOR.EXE high segment too big.>)
E$$PCF: $ERROR (?,PCF,<PAGE. UUO failed for FORTRAN SORT/MERGE.>)
E$$INP: $ERROR (?,INP,<Input error for SYS:SRTFOR.EXE.>)
DIE: EXIT
SAVEL: BLOCK 1 ;SAVE L
CHSTAT: BLOCK 1 ;STATUS OF FUNCT. CALL
SRTCHN: BLOCK 1 ;CHAN USED FOR I/O
SRTDIR: BLOCK DIRLEN
PAGARG: BLOCK PAGLEN
>;END IFE FTOPS20
END