Google
 

Trailing-Edge - PDP-10 Archives - BB-D489E-SB - 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==0>

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