Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SEARCH MTHPRM,FORPRM
	TV	SORT - FORTRAN interface to stand-alone SORT, 10(4227)
SUBTTL	D.M.NIXON/DMN/DZN/BRF/EGM/BL/RJD/CDM/JLC/AHM	 5-Dec-82



;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1978, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

CUSTVR==0
DECVER==4
DECMVR==3
DECEVR==10

V%FSRT==:<CUSTVR>B2+<DECVER>B11+<DECMVR>B17+DECEVR

COMMENT \

***** Begin 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.

Start of incorporation into version 6 of FORTRAN

1367	EGM	26-Mar-81       --------
	Add search of FORPRM, and replace old feature test switches
	with those from FORPRM.

1555	BL	22-Jul-81
	Install DMN version into V6:.

1612	BL	18-Aug-81	Q20-01642
	Have SORT put itself into SECTION 0 for now.

2121	RJD	28-Oct-82	20-18131
	(Not usable for V7, bugs fixed by edit 3205).

***** Begin Version 7 *****

7	DMN	14-Jan-82
	Make non-zero section code work with TOPS-20 Rel. 5.

3076	CDM	1-Apr-82
	Do a fixup for character constants as arguements to SORT.

3123	JLC	29-May-82
	Mathlib integration.

3124	AHM	1-Jun-82
	Add SEGMENT macros so  that things go  into .CODE. and  .DATA.
	under FTXLIB.

10	DMN	13-Oct-82
	More non-zero section code.

3205	AHM	27-Oct-82
	Delete  private  AC  definitions  for  Tx,  Px,  etc  and  use
	FORPRM's.  Define names for SORT linkage ACs, page boundaries.
	Fix PDVOP% jsys call.   Make execute-only code paranoid  about
	RFSTS% failures.  Replace $ERROR macro with $FCALL.  Add  TMA,
	CGP, CRP, NSS, CFS, CGS errors.  Change module name to FORSRT.
	Move %SRTAD to FORINI so that we can toss SORT's section  upon
	restart.  Add FTDEBUG (default off) to turn off of all of  the
	controversial symbol table swapping  code until it is  cleaned
	up.  Don't map up into section 1 unless debugging.  Make  sure
	we have a null lowseg.  Redo character arg fixup edit 3076  to
	support variable numbers  of arguments, one  word global  byte
	pointers and multiple sections of code.  Requires edit 476  to
	SORT.  Call  MPG FUNCT.   function before  getsegging SORT  on
	both systems  and call  UPG function  after discarding  it  on
	Tops-10 to avoid problem of overlapping the FOROTS heap  (same
	intent as edit 6(2121)).

3225	JLC	24-Nov-82
	Remove local definition of $JCALL, as there is now
	one in FORPRM ($FJCAL), and change the calls appropriately.

3232	AHM	5-Dec-82
	Fix test for extra args to copy before ARGLOP in Tops-20  code
	and NOTCHR in Tops-10 code - MOVNI doesn't sign extend the EA.

3252	JLC	12-Jan-82
	Moved KSORT. here.

3253	JLC	13-Jan-83
	Set up null version of KSORT. for -10.

***** End V7 Development *****

3362	TGS	28-Oct-83	SPR:20-19293
	If the user has called SRTINI (FORMSC subroutine), then SORT's
	pages 600:677 have already been preallocated and %PASRT is non-
	zero.  In this case, for TOPS20 do not try to allocate those pages
	again; for TOPS10, don't preallocate pages and don't deallocate
	them either after SORT has been called.

3455	ADDITIONAL ARGUMENTS NOT PASSED TO SORT
	The extra arguments for SORT calls (like /FATAL) are not
	being passed correctly for TOPS-10 calls to SORT.

3463	MRB	14-FEB-84	(RAW PCO)
	Fix edit 3455. 

***** Begin Version 10 *****

4023	JLC	29-Jun-83
	Search MTHPRM also.

4066	JLC	11-Jan-84
	Remove FT20UUOS code, as it is done another way.

4106	JLC	2-Mar-84
	Change the name of this module, so TRACE can see it.

4012	MRB	14-Jun-84
	Have the flagger know about sort and output an error message
	when it is called.

4172	MRB	4-Dec-84
	Fix-up some flagger stuff for the TOPS-10 version of 
	SORT.

***** End V10 Development *****

4227	MRB	30-Oct-85
	When SORT encounters a character string as an argument have
	it get some OTS memory, make a copy of the character string 
	and null terminate it. And remember when returning from 
	(real) SORT to give back the memory. Also, changed MAXARG 
	to 3 (it's the real maximum). 

4234	MRB	20-NOV-85
	Edit 4227 did not check correctly for the total number 
	of arguments to the call to SORT.

***** End Revision History *****
\

SUBTTL	DEFINITIONS -- Assembly Parameters, ACs, etc.

.DIRECTIVE	FLBLST
.DIRECTIVE	SFCOND


;ACCUMULATOR DEFINITIONS (SORT linkage ACs only)

SF==1				;[3205] SORT's FUNCT. parameter
SR==4				;[3205] SORT's return address parameter
;SL==16				;[3205] SORT's argument list

;EXTENDED ADDRESSING OPCODE DEFINITIONS


	ENTRY	SORT
	EXTERN	ABORT.,FUNCT.,%SRTAD
	EXTERN	%PASRT		;[3362]

	SRT1ST==600			;[3205] First page of SORT
	SRTLST==677			;[3205] Last page of SORT
	SRTSIZ==SRTLST-SRT1ST+1		;[3205] Number of pages in SORT

	MAXARG==^D3		;[4227] Allow a maximum of 3 arguments

IF20,<
IFNDEF FTDEBUG,<FTDEBUG==0>		;[3205] Turn on to insert debug code


> ; End of IF20

SUBTTL	TOPS-20 VERSION -- General description

COMMENT	\

This routine is built into  FORLIB.REL.

When this routine is called for the first time it first looks for
SORT.EXE on SYS: and gives an error if not found.
If it is running in section 0 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 the current
section 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 address of the SORT
entry point so that the user call will go directly to SORT.
It looks at .JBSYM in the SORT section to get the symbol table.
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 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
somewhere else in the target section) and do a $P from before the code
that swaps the symbol table pointers.

Use of FTDEBUG

Since it is  not necessary or  nice for FORSRT  to always swap  symbol
table pointers (consider trying to debug your Fortran program when you
have ^Ced it while running SORT and SORT's symbol table is  selected),
FORSRT only contains code to swap pointers when it has been  assembled
with the feature test FTDEBUG set to a non-zero value.

Use of %SRTAD

%SRTAD is a two word global PC word.
On the very first call to SORT %SRTAD+1 must be zero.
On subsequent calls %SRTAD+1 contains the PC of SORT.
%SRTAD is zero if SORT is in a non-zero section and -1 if it is in
section 0.

\

SUBTTL	TOPS-20 VERSION -- Data


IF20,<
	SEGMENT	DATA			;[3124] Put into lowseg

SRTDAT:!				;[10] START OF DATA TO CLEAR ON FIRST CALL

SAVEVC:	BLOCK	2			;[10] SAVE USER'S ENTRY VECTOR

RFSBLK:	BLOCK	.RFSFL+1		;[3205] ARG BLOCK FOR LONG FORM RFSTS%
					;[3205]  JSYS - SPACE FOR RETURNED ARGS

STATUS:	BLOCK	1			;[3205] Status word for FUNCT. calls

;[7] CROCK TO SET SYMBOL TABLE FOR SORT IF DDT LOADED SO WE CAN DEBUG IT

IFN FTDEBUG,<				;[3205] Start of debugging variables
DDTPG.==764				;[10] START OF DDT
CODSYM:	BLOCK	1			;[7] ADDRESS OF CURRENT SYMBOL TABLE
SRTSYM:	BLOCK	1			;[7] ADDRESS OF SORT'S SYMBOL TABLE
> ; End of IFN FTDEBUG

.GFLAG==0				;[3205] Flag word
.GBASE==3				;[3205] Offset in GET% arg block which
					;[3205]  gives the section offset

GETARG:	BLOCK	.GBASE+1		;[3205] FLAGS,
					;[3205]  LOW ADDR,
					;[3205]  HIGH ADDR,
					;[3205]  SECTION # OFFSET

;[10] PROGRAM DATA VECTOR 

.POLOC==5				;[10] LOCATE THE SPECIFIED PDV

.POCT1==0				;[10] NO. OF WORDS IN ARG BLOCK
.POPHD==1				;[10] PROCESS HANDLE
.POCT2==2				;[10] NO. OF WORDS IN DATA BLOCK
.PODAT==3				;[10] ADDRESS OF DATA BLOCK

.PVSTR==2				;[10] PROGRAM START ADDRESS
.PVSYM==6				;[10] PROGRAM SYMBOL TABLE

PDVARG:	BLOCK	.PODAT+1		;[10] ARG BLOCK FOR PDVOP% JSYS

PDVA:	BLOCK	1			;[3205] LENGTH OF PDV WE WANT

;[10] SYMBOLS NOT IN MONSYM

SM%RWX==:SM%RD!SM%WR!SM%EX		;[10] CONVENIENCE

SRTLEN==.-SRTDAT			;[10] LENGTH OF DATA TO CLEAR

	BLOCK	1			;[3205] Holds argument count
NEWARG:	BLOCK	2*MAXARG		;[3205] Holds arguments for SORT call 
MEMREQ:	BLOCK	1		;[4227] Holds size (words) of memory gotten
MEMADR:	BLOCK	1		;[4227] Holds address of memory gotten

SUBTTL	TOPS-20 VERSION -- SORT/MERGE Entry Point

	SEGMENT	CODE			;[3124] Put into hiseg

	'SORT  '			;SIXBIT NAME FOR TRACE.
SORT:
;
; [4012] Check for compatibility flagging.
;
	SKIPE	[FLGON.##]	;[4100]Is any compatbility flagging on?
	 $FCALL	CFX		;[4100]Yes; display the compatibility message


;	[3076] If we have  a character constant,  we must do  a fixup  to
;	[3076] make it into a hollerith constant.

	LDB	T0,[POINTR (0(L),ARGTYP)] ;[3076] Get argument's type
	CAIE	T0,TP%CHR		;[3076] Is it character?
	 JRST	NOTCHR			;[3076] No
;
	DMOVE	T0,@0(L)	;[4227] Fetch the character descriptor
	MOVEI	T3,<1+4>(T1)	;[4227] Round up, leaving room for the null
	EXCH	T0,T1		;[4227] Put source length in T0, BP in T1
	IDIVI	T3,5		;[4227] Figure number of words needed
	MOVEM	T3,MEMREQ	;[4227] Save in memory for FUNCT. call
	FUNCT	(FUNCT.,<[FN%GOT],[ASCIZ |SRT|],STATUS,MEMADR,MEMREQ>);[4227]
	SKIPE	STATUS		;[4227] Did we get it?
	 $FCALL	CCS,ABORT.	;[4227]  no, error!
;
	IMULI	T3,5		;[4227] Dest length=(BPW*words requested)
	MOVE	T4,MEMADR	;[4227]
	$BLDBP	T4		;[4227] Make BP to destination string
	EXTEND	T0,[MOVSLJ	;[4227] Move the string
		    EXP 0]	;[4227] 
	JFCL			;[4227] Don't care
;
	MOVE	T0,MEMADR	;[4227] Get the address of the pointer

	MOVEM	T0,NEWARG+MAXARG	;[3205] Save it in the indirect word
	MOVE	T0,[IFIW TP%LIT,@NEWARG+MAXARG] ;[3205] Get arg block entry for
	MOVEM	T0,NEWARG		;[3205]  the string arg and store it

	MOVE	T3,-1(L)		;[3205] Get whole count word
	MOVEM	T3,NEWARG-1		;[3205] Save it away in new block
	HLRE	T3,T3			;[3205] Get negative of arg count
	CAMGE	T3,[-MAXARG]		;[3205] More than we have room for?
	 $FCALL	TMA,ABORT.		;[3205] No, complain
;	$FERR (?,TMA,21,115,<Too many arguments in call to SORT>) ;[3205]


	XMOVEI	T1,1(L)			;[3205] Get pointer to rest of old args
	XMOVEI	T2,NEWARG+1		;[3205] Point to rest of new block
	XMOVEI	L,NEWARG		;[3205] Point to new arg block
	MOVN	T3,T3			;[3232] Get positive number of args
	SOJLE	T3,NOTCHR		;[3232] Don't fool around if no extras

	XMOVEI	T0,0			;[3205] There are args - where are we?
	JUMPE	T0,COP0			;[3205] Section 0 - just use BLT

ARGLOP:	XMOVEI	T0,@0(T1)		;[3205] Eval this arg's address
	MOVEM	T0,MAXARG(T2)		;[3205] Store it in an indirect word
	LDB	T0,[POINTR (0(T1),ARGTYP)] ;[3205] Get the arg's type
	LSH	T0,^D<18+9>		;[3205] Put it in the AC field
	TXO	T0,<IFIW @>		;[3205] Make a local indirect word
	HRRI	T0,MAXARG(T2)		;[3205] Point it to the arg's real addr
	MOVEM	T0,0(T2)		;[3205] Store the arg word away
	ADDI	T1,1			;[3205] Move the source pointer along
	ADDI	T2,1			;[3205] Move destination pointer along
	SOJG	T3,ARGLOP		;[3205] Loop back for more
	JRST	NOTCHR			;[3205] Finished, join main line

COP0:	HRLZ	T1,T1			;[3205] Put BLT source address in LH
	HRR	T1,T2			;[3205] Put BLT destination in RH
	ADD	T2,T3			;[3205] Compute number of words to move
	BLT	T1,-1(T2)		;[3205] Move user's other args over

NOTCHR:	SKIPE	%SRTAD+1		;[5] CALLED BEFORE?
	 JRST	SORT3			;[5] YES

	MOVE	T1,[SRTDAT,,SRTDAT+1]	;[10] BLT PTR
	SETZM	T1,SRTDAT		;[10] CLEAR FIRST WORD
	BLT	T1,SRTDAT+SRTLEN-1	;[10]  AND REST
	MOVX	T1,.FHSLF		;[5] NO, SAVE OUR ENTRY VECTOR
					;[2] SINCE GET% JSYS DESTROYS IT
	XGVEC%				;[10] INCASE IN NON-ZERO SECTION
	 ERJMP	[MOVX	T1,.FHSLF	;[10] NOT REL 5
		GEVEC%			;[10] USE OLD SECTION 0 JSYS
		 ERJMP	[SETZB	T2,T3	;[10] ERROR, SET EV TO ZERO
			JRST	.+1]	;[10]
		JRST	.+1]		;[10]
	DMOVEM	T2,SAVEVC		;[10] SAVE BOTH WORDS
	MOVEI	T1,.RFSFL+1		;[10] LENGTH OF ARG BLOCK
	MOVEM	T1,RFSBLK+.RFCNT	;[10] ...
	MOVE	T1,[RF%LNG!.FHSLF]	;[10] LONG FORM
	XMOVEI	T2,RFSBLK		;[4] ARG BLOCK
	RFSTS%				;[4] GET STATUS
	 ERJMP	SORT1			;[3205] ASSUME 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
SORT1:	 SKIPA	T1,[GJ%OLD!GJ%SHT!GJ%PHY] ;[4] PHYSICAL ONLY IF EXECUTE-ONLY
	  MOVX	T1,GJ%OLD!GJ%SHT	;[4] GET A JFN FOR SORT.EXE
	HRROI	T2,SRTEXE		;  ..
	GTJFN%				;[2]   ..
	 $FCALL	CFS,ABORT.		;[3205] Complain if we can't find SORT
;	$FERR (?,CFS,21,119,<Can't find SYS:SORT.EXE - $J>) ;[3205]

	HRRZ	P4,T1			;[5] PUT JFN IN A SAFE PLACE
	XMOVEI	T1,0			;[3205] SEE IF WE ARE IN SECTION 0
	JUMPN	T1,SORT5A		;[3205] NO, DON'T BOTHER WITH SECTION 0

	MOVE	T1,[.FHSLF,,1]		;[7] SEE IF SECTION 0 AND 1
	RSMAP%				;[7]  ALREADY MAPPED TOGETHER
	 ERJMP	SORTV4			;[7] NOT RELEASE 5

;[7] WE ARE RUNNING UNDER RELEASE 5

IFN FTDEBUG,<				;[3205] Get into a non-zero section to
					;[3205] hack symbol table pointers

	AOJN	T1,SORT5A		;[7] ALREADY DONE (T1 NOT = -1)
	MOVSI	T1,.FHSLF		;[7] THIS FORK IN SECT 0
	MOVE	T2,[.FHSLF,,1]		;[7] ...       IN SECT 1
	MOVX	T3,SM%RWX+1		;[10]
	SMAP%				;[7] MAP SECTIONS 0 & 1 TOGETHER
	 $FJCAL	IJE,ABORT.		;[3205] Should never fail
> ; End of IFN FTDEBUG

SUBTTL	TOPS-20 VERSION -- Release 5

;[10] LOOP THROUGH THE SECTIONS STARTING AT SECTION 1 LOOKING FOR A FREE ONE FOR SORT

SORT5A:	SETZ	P3,			;[10] NOW FIND A FREE SECTION FOR SORT
SORT5B:	AOS	T1,P3			;[7] TRY NEXT ONE
	CAILE	T1,37			;[7] MAKE SURE SOME STILL LEFT
	 $FCALL	NSS,ABORT.		;[3205]
;	$FERR (?,NSS,21,118,<No free section available for SORT>) ;[3205]

	HRLI	T1,.FHSLF		;[7]
	RSMAP%				;[7]
	 $FJCAL	IJE,ABORT.		;[3205] Should never fail

	AOJN	T1,SORT5B		;[7] THIS ONE NOT FREE
	MOVEM	P3,GETARG+.GBASE	;[3205] SAVE SECTION # FOR GET

IFN FTDEBUG,<
	MOVE	T1,[.FHSLF,,770]	;[7] IS PAGE ACCESSIBLE?
	RPACS%				;[7]
	 $FJCAL	IJE,ABORT.		;[3205] Should never fail
	AND	T2,[PA%RD!PA%EX!PA%PEX]	;[7]
	CAME	T2,[PA%RD!PA%EX!PA%PEX]	;[7]
	 JRST	SORT5C			;[7] NO DDT
	MOVE	T1,770000		;[7] DOES IT CONTAIN DDT?
	CAME	T1,[JRST 770002]	;[7]
	 JRST	SORT5C			;[7] NO
	MOVE	T1,[.FHSLF,,DDTPG.]	;[10] SOURCE
	MOVE	T2,P3			;[7] GET DESTINATION SECTION #
	LSH	T2,9			;[7]
	ADD	T2,[.FHSLF,,DDTPG.]	;[10] DESTINATION
	MOVX	T3,PM%CNT!PM%RWX+<777-DDTPG.+1> ;[10] ACCESS INFO
	PMAP%				;[7] MAP THE PAGES TOGETHER
	 $FJCAL	IJE,ABORT.		;[3205] Should never fail

	MOVE	T1,@770001		;[7] GET CURRENT SYMBOL TABLE POINTER
	ERJMP	.+2			;[7] JUST IN CASE NO SYMBOL TABLE
	MOVEM	T1,CODSYM		;[7] STORE IT AS FLAG THAT DDT LOADED
> ; End of IFN FTDEBUG

;[7] NOW GET SORT INTO THE NON-ZERO SECTION

SORT5C:
IFN FTDEBUG,<				;[3205] Get into a non-zero section to
					;[3205] hack symbol table pointers
	XMOVEI	T1,.			;[10] SEE WHAT SECTION WE ARE IN
	TLNN	T1,-1			;[10] IF ALREADY IN NON-ZERO SECTION
					;[10]  STAY THERE,
					;[10]   ELSE JUMP TO SECTION 1

	 XJRSTF	[0			;[7] NOTE THAT YOU CANNOT $X THIS
		 1,,.+1]		;[7]  INSTRUCTION.  PUT A BREAKPOINT
SORT5D:					;[7]  AT SORT5D AND $P INSTEAD
> ; End of IFN FTDEBUG

	HRLZ	P3,P3			;[7] PUT SECTION # IN GLOBAL SIDE
	HRRZ	T1,P4			;[3205] GET JFN
	TXO	T1,<<.FHSLF_^D18>!GT%PRL!GT%ARG> ;[3205] PRE-LOAD ALL OF FILE
	MOVX	T2,GT%BAS		;[3205] SORT's "/USE-SECTION" offset
	MOVEM	T2,GETARG+.GFLAG	;[10] ...

	XMOVEI	T2,GETARG		;[7] POINT TO ARG BLOCK
	GET%				;[7]
	 $FJCAL	CGS,ABORT.		;[3205]
;	$FERR (?,CGS,21,120,<Can't get SYS:SORT.EXE - $J>)	;[3205]

;[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
	XMOVEI	T2,PDVARG		;[3205] ARG BLOCK
	HRROI	T3,[ASCIZ /SORT/]	;[10] PDV NAME
	PDVOP%				;[10]
	 ERJMP	SORT5E			;[10] FAILED, USE ENTRY VECTOR
	SKIPE	T1,PDVARG+.POCT2	;[3205] At least one PDV
	 TLNE	T1,^-<1>		;[3205]  But no more than one?
	  JRST	SORT5E			;[3205] No - old version of SORT or
					;[3205]  confused user - ignore it
	MOVE	P1,PDVA			;[3205] Point to the PDV

	MOVE	T1,[.PVSTR(P1)]		;[3205] Start address word
	PUSHJ	P,S1MOVE		;[3205] Fetch it
	HLL	T1,P3			;[3205] ADD IN SORT SECTION
	MOVEM	T1,%SRTAD+1		;[10]

IFN FTDEBUG,<
	MOVE	T1,.PVSYM(P1)		;[3205] GET SYMBOL TABLE POINTER
>

	JRST	SORT5F			;[10] JOIN COMMON CODE

;[10] HERE WHEN PDV CANNOT BE FOUND

SORT5E:	MOVEI	T1,.FHSLF		;[10] GET SORT'S ENTRY VECTOR
	XGVEC%				;[10] ..
	 $FJCAL	IJE,ABORT.		;[3205] Should never fail

	HRR	P3,T3			;[10] POINT TO SORT ENTRY VECTOR
	MOVE	T1,[3(P3)]		;[3205] Point into entry vector
	PUSHJ	P,S1MOVE		;[3205] Get the word into T1
	HRR	P3,T1			;[3205] Get addr of start address
	MOVEM	P3,%SRTAD+1		;[3205] Save SORT's entry point

;[7] HERE WHEN SORT IS READ IN

IFN FTDEBUG,<
	MOVEI	T1,.JBSYM##		;[7] POINT TO SYMBOL TABLE 
	HLL	T1,P3			;[3205] IN SORT SECTION
SORT5F:	MOVE	T1,(T1)			;[3205] GET POINTER
	SKIPN	CODSYM			;[7] IS DDT LOADED?
	SETZ	T1,			;[7] NO, DON'T SAVE SYMBOL POINTER
	MOVEM	T1,SRTSYM		;[7] SAVE ADDRESS OF SORT'S SYMBOL TABLE
	SKIPE	CODSYM			;[7] IS DDT LOADED?
	 MOVEM T1,@770001		;[7] YES STORE NEW SYMBOL TABLE
> ; End of IFN FTDEBUG

IFE FTDEBUG,<
SORT5F:
>
	MOVEI	T1,.FHSLF
	DMOVE	T2,SAVEVC		;[10] RESTORE USER'S ENTRY VECTOR
	XSVEC%				;[10]   ..
	 $FJCAL	IJE,ABORT.		;[3205] Should never fail

	SETZ	SF,			;[3205] FUNCT. not required
	XMOVEI	SR,SORT4		;[3205] Set return address
	XJRSTF	%SRTAD			;[7] CALL SORT TO DO THE REAL WORK

;Enter here if not first call to SORT

SORT3:
IFN FTDEBUG,<
	SKIPN	CODSYM			;[10] DO WE HAVE TO WORRY ABOUT SYMBOL TABLES?
	 JRST	SORT3A			;[10] NO
	MOVE	T1,@770001		;[10] YES, GET CURRENT SYMBOL TABLE POINTER
	MOVEM	T1,CODSYM		;[10] IN CASE USER HAS DEFINED SOME NEW SYMBOLS
SORT3A: SKIPE	T1,SRTSYM		;[7] DO WE NEED TO SET UP SYMBOL TABLE POINTER?
	 MOVEM T1,@770001		;[7] YES, SO WE CAN DEBUG SORT
> ; End of IFN FTDEBUG

IFE FTDEBUG,<
SORT3A:
>
	XMOVEI	SF,FUNCT.		;[3205] TELL SORT WHERE FUNCT. IS
					;[3205]  (Assume it needs it)
	XMOVEI	SR,SORT4		;[3205] Give return address
	SKIPE	%SRTAD			;[5] CALL SORT TO DO THE REAL WORK
	 JRST	@%SRTAD+1		;[5]   ..

	SETZ	SF,			;[3205] SORT in own section, no FUNCT.
	XJRSTF	%SRTAD			;[5]   ..

;[7] Return from SORT to original section

SORT4:	  JRST	SORT4E			;[7] ERROR RETURN
IFN FTDEBUG,<
	SKIPE	T1,CODSYM		;[7] DO WE NEED TO RESTORE POINTER
	 MOVEM T1,@770001		;[7] YES
> ; End of IFN FTDEBUG
;
; [4227] Return the memory gotten when calling sort with a character string
;
KSTR:	SKIPN	MEMADR		;[4227] Any memory used
	 POPJ	P,		;[4227] No, Return
	FUNCT	(FUNCT.,<[FN%ROT],[ASCIZ |SRT|],STATUS,MEMADR,MEMREQ>);[4227]
	SKIPE	STATUS		;[4227] Any Problems?
	 $FCALL	SNH,ABORT.	;[4227] Error
	SETZM	MEMADR		;[4227] Clear the address
	POPJ	P,		;[7] RETURN TO CALLER

SORT4E:
IFN FTDEBUG,<
	SKIPE	T1,CODSYM		;[7] DO WE NEED TO RESTORE POINTER
	 MOVEM T1,@770001		;[7] YES
> ; End of IFN FTDEBUG
	XMOVEI	L,1+[XWD 0,0]		;[10] FAILED, CALL EXIT.
	PUSHJ	P,EXIT.##		;[5]
	PJRST	KSTR		;[4227] CONTINUED?????

;[3205] Routine to fetch words from a non-zero section 
; Calling sequence:
; T1/ I, X and Y field of IFIW to fetch with
;	PUSHJ	P,S1MOVE
; Return, always, T1/ contents of word addressed by the indirect pointer arg
; Destroys T1-T4

S1MOVE:

IFE FTDEBUG,<
	TXO	T1,<MOVE T1,0>		;[3205] Instruction to fetch data
	MOVE	T2,[XJRSTF T3]		;[3205] Return to section 0
	SETZ	T3,			;[3205] Who needs flags, anyway
	XMOVEI	T4,S1RET		;[3205] Our return PC
	XJRSTF	[0			;[3205] Jump into the section 1 ACs
		 1,,T1]			;[3205]  to fetch data
S1RET:	POPJ	P,			;[3205] Return to caller
> ; End of IFE FTDEBUG

IFN FTDEBUG,<
	TXO	T1,<IFIW>		;[3205] Make address into a true IFIW
	MOVE	T1,@T1			;[3205] Fetch the data
	POPJ	P,			;[3205] Return to caller
> ; End of IFN FTDEBUG

SUBTTL	TOPS-20 VERSION -- Release 4

SORTV4:	SETOM	%SRTAD			;[10] REMEMBER FAILURE TO GET
					;[10]  NON-ZERO SECTION

;[3205] Reclaim as many pages from the heap manager as possible

	FUNCT	(FUNCT.,<[FN%CBC],[ASCIZ |SRT|],STATUS>)

;[3205] Try and steal pages 600:677

	SKIPE	%PASRT			;[3362]Already prealloc by FOROP. call?
	 JRST	SRTGET			;[3362] Yes, don't try again!
	FUNCT	(FUNCT.,<[FN%MPG],[ASCIZ |SRT|],STATUS,[SRT1ST],[SRTSIZ]>)

	SKIPE	STATUS			;[3205] Can we have them ?
	 $FCALL	CGP,ABORT.		;[3205] No, complain
;	$FERR (?,CGP,21,116,<Can't get pages 600:677 for SORT>) ;[3205]

SRTGET:	HRLI	T1,.FHSLF		;[3362][5] DO A GET% ON SORT.EXE
	HRR	T1,P4			;[5] GET JFN
	TXO	T1,GT%ADR!GT%PRL	;[3205] Obey page limits, preload pages
	MOVE	T2,[SRT1ST,,SRTLST]	;[10] ALL OF SORT'S HIGH SEGMENT
	GET%				;[5]
	 $FJCAL	CGS,ABORT.		;[3205]
;	$FERR (?,CGS,21,120,<Can't get SYS:SORT.EXE - $J>)	;[3205]

	MOVEI	T1,.FHSLF		;[5] GET SORT'S ENTRY VECTOR
	GEVEC%				;[5]   ..
	 $FJCAL	IJE,ABORT.		;[3205] Should never fail
	HRRZ	P3,T2			;[5] CALCULATE SORT ENTRY POINT
	HRR	P3,3(P3)		;[5]   ..
	MOVEM	P3,%SRTAD+1		;[5] SAVE SORTS ADDRESS

	DMOVE	T2,SAVEVC		;[3205] RESTORE USER'S ENTRY VECTOR
	SEVEC%				;[2]   ..
	 $FJCAL	IJE,ABORT.		;[3205] Should never fail
	JRST	SORT3A			;[10] JOIN MAIN LINE CODE

SRTEXE:	ASCIZ	/SYS: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	PDVA			;[10] WHERE TO RETURN THE DATA


>;END IF20

SUBTTL	TOPS-10 VERSION - Data

IF10,<

	SEGMENT	DATA			;[3124] Put in lowseg

SRTBLK:	BLOCK	6			;[3205] Leave room for MERGE. arg block

SAVEL:	BLOCK	1			;[5] SAVE AC L DURING MERGE. UUO
SAVEP:	BLOCK	1			;[5] SAVE AC P DURING MERGE. UUO

	BLOCK	1			;[3205] Holds argument count
NEWARG:	BLOCK	MAXARG			;[3205] Holds arguments for SORT call

MEMREQ:	BLOCK	1		;[4227] Holds size (words) of memory gotten
MEMADR:	BLOCK	1		;[4227] Holds address of memory gotten

STATUS:	BLOCK	1			;[3205] Status word for FUNCT. calls

SUBTTL	TOPS-10 VERSION -- SORT/MERGE Entry Point

	SEGMENT	CODE			;[3124] Put in hiseg

	'SORT  '			;NAME FOR TRACE.
SORT:
;
; [4172] Check for compatibility flagging.
;
	SKIPE	[FLGON.##]	;[4172]Is any compatbility flagging on?
	 $FCALL	CFX		;[4172]Yes; display the compatibility message

;	[3076] If we have  a character constant,  we must do  a fixup  to
;	[3076] make it into a hollerith constant.

	LDB	T0,[POINTR (0(L),ARGTYP)] ;[3076] Get argument's type
	CAIE	T0,TP%CHR		;[3076] Is it character?
	 JRST	NOTCHR			;[3076] No

;
	HLRE	T3,-1(L)		;[4234] [4227] Get whole count word
	MOVM	T3,T3			;[4227] Make it positive
	CAIL	T3,MAXARG		;[4234] [4227] More than we have room for? 
	 $FCALL	TMA,ABORT.		;[3205] No, complain 
;	$FERR (?,TMA,21,115,<Too many arguments in call to SORT>) ;[3205] 
	MOVSI	T1,-1(L)		;[4227] Put BLT source address in LH
	HRRI	T1,NEWARG-1		;[4227] Put BLT destination in RH
	BLT	T1,NEWARG-1(T3)		;[4227] Move user's other args over
	XMOVEI	L,NEWARG		;[3463] Point to new arg block
;
	DMOVE	T0,@0(L)	;[4227] Fetch the character descriptor
	MOVEI	T3,<1+4>(T1)	;[4227] Round up, leaving room for the null
	EXCH	T0,T1		;[4227] Put source length in T0, BP in T1
	IDIVI	T3,5		;[4227] Figure number of words needed
	MOVEM	T3,MEMREQ	;[4227] Save in memory for FUNCT. call
	FUNCT	(FUNCT.,<[FN%GOT],[ASCIZ |SRT|],STATUS,MEMADR,MEMREQ>);[4227]
	SKIPE	STATUS		;[4227] Did we get it?
	 $FCALL	CCS,ABORT.	;[4227]  no, error!
;
	IMULI	T3,5		;[4227] Dest length=(BPW*words requested)
	MOVE	T4,MEMADR	;[4227]
	$BLDBP	T4		;[4227] Make BP to destination string
	EXTEND	T0,[MOVSLJ	;[4227] Move the string
		    EXP 0]	;[4227] 
	JFCL			;[4227] Don't care

	MOVE	T0,MEMADR	;[4227] Get the address of the pointer
	HRLI	T0,(IFIW TP%LIT,0)	;[3205] Get arg block entry for
	MOVEM	T0,NEWARG		;[3205]  the string arg and store it

NOTCHR:	DMOVEM	L,SAVEL			;[5] SAVE AC L AND P

;[3205] Reclaim as many  pages from  the heap manager  as possible  so
;[3205] that there is  a greater chance  of marking all  of the  pages
;[3205] SORT will need,  and so that  there is more  lowseg space  for
;[3205] SORT to use for buffers.

	FUNCT	(FUNCT.,<[FN%CBC],[ASCIZ |SRT|],STATUS>)

;[3205] Try and steal pages 600:677

	SKIPE	%PASRT			;[3362] Already alloc by FOROP. call?
	 JRST	SRTMRG			;[3362] Yes, don't try again.
	FUNCT	(FUNCT.,<[FN%MPG],[ASCIZ |SRT|],STATUS,[SRT1ST],[SRTSIZ]>)

	SKIPE	STATUS			;[3205] Can we have them ?
	 $FCALL	CGP,ABORT.		;[3205] No, complain
;	$FERR (?,CGP,21,116,<Can't get pages 600:677 for SORT>) ;[3205]

SRTMRG:	MOVE	T1,[SRTEXE,,SRTBLK] 	;[3362][3205]Point from hiseg to lowseg
	BLT	T1,SRTBLK+SRTEXL-1	;[3205] Move the block downstairs
	MOVEI	T1,SRTBLK		;[5] MERGE IN SORT
	MERGE.	T1,			;[5]   ..
	 HALT	ABORT.			;[3205] Failed, complain
	DMOVE	L,SAVEL			;[5] RETORE AC L AND P
	MOVEI	SF,FUNCT.		;[5] TELL SORT WHERE FUNCT. IS
	MOVEI	SR,SORT1		;[3205] CALL SORT TO DO THE REAL WORK
	HRRZ	P2,600000+.JBHSA##	;[5]   ..
	JRST	2(P2)			;[3205]   ..

SORT1:	 JRST	[MOVEI	L,1+[XWD 0,0]	;[5] FAILED, CALL EXIT.
		 PUSHJ	P,EXIT.##	;[5]
		 JRST	.+1]		;[5] CONTINUED?????

	MOVEI	T1,SRTSIZ		;[5] OK, GET PAGE COUNT
	MOVEI	T2,1			;[5] SETUP PAGE. UUO
	MOVE	T3,[PA.GAF+SRT1ST]	;[5]   ..

SORT2:	MOVE	T4,[.PAGCD,,T2]		;[5] DESTROY A PAGE
	PAGE.	T4,			;[5]   ..
	 JFCL				;[5] FAILED
	ADDI	T3,1			;[5] LOOP
	SOJG	T1,SORT2		;[5]   ..

;[3205] Try and return pages 600:677

	SKIPE	%PASRT			;[3362] FOROP. preallocated?
	 POPJ	P,			;[3362] Yes, don't deallocate either
	FUNCT	(FUNCT.,<[FN%UPG],[ASCIZ |SRT|],STATUS,[SRT1ST],[SRTSIZ]>)

	SKIPE	STATUS			;[3205] Can we return them ?
	 $FCALL	CRP,ABORT.		;[3205] No, can't return pages
;	$FERR (?,CRP,21,117,<Can't return pages 600:677 after call to SORT>)

;[3205] Get rid of extra pages from the core image

	FUNCT	(FUNCT.,<[FN%CBC],[ASCIZ |SRT|],STATUS>)

;
; [4227] Return the memory gotten when calling sort with a character string
;
	SKIPN	MEMADR		;[4227] 
	 POPJ	P,		;[4227]
	FUNCT	(FUNCT.,<[FN%ROT],[ASCIZ |SRT|],STATUS,MEMADR,MEMREQ>);[4227]
	SKIPE	STATUS		;[4227] Any Problems?
	 $FCALL	SNH,ABORT.	;[4227] Error
	SETZM	MEMADR		;[4227] Clear the address
	SETZM	MEMREQ		;[4227] and the number of words
	POPJ	P,		;[3205]  AND RETURN TO CALLER

SUBTTL	TOPS-10 VERSION -- Error Messages

SRTEXE:	SIXBIT /SYS/			;[5] MERGE. UUO ARGUMENT BLOCK
	SIXBIT /FSORT/			;[5]   ..
	0				;[5]   ..
	0				;[5]   ..
	0				;[5]   ..
	XWD SRT1ST,SRTLST		;[3205] Undocumented "range" arg ?!?
	SRTEXL==.-SRTEXE		;[3205] Length of block to move
>;END IF10

	XLIST
	LIT
	LIST

	PRGEND

	SEARCH	MTHPRM
	TV	KSORT	KILL VESTIGES OF SORT

	ENTRY	KSORT.

	INTERN	%SRTAD
	INTERN	%PASRT		;[3362]

; Here we  have a  hook into  FORSRT and  SORT.  %SRTAD  is a  flag/PC
; doubleword which points  to SORT's  start address,  if present.   If
; %SRTAD+1 is non-zero, it is the start address of SORT.  If %SRTAD is
; zero, then %SRTAD%+1 is a  30 bit PC, and  SORT is in some  non-zero
; section.  If %SRTAD is non-zero, then  %SRTAD+1 is an 18 bit PC  and
; SORT is in section 0.

; To insure that programs that use SORT restart properly, we reset the
; state of FORSRT and  SORT.  This means  that if SORT  is in its  own
; section (first word 0, second word non-zero), we destroy the section
; SORT is in (section number is in left half of second word).  And, in
; order to  make  sure  that a  fresh  copy  of SORT  is  GET%ed  upon
; restarting Fortran programs, we zero  out the address in the  second
; word so that FORSRT thinks it does not exist at all.

; Added by edit 3205

	SEGMENT	CODE

KSORT.:
IF20,<				;[4227]
	SKIPN	%SRTAD+1	;[3205] Is there a SORT anywhere?
	 POPJ	P,		;[3205] No, return

	SKIPE	%SRTAD		;[3205] Is SORT in another section?
	 JRST	SRTZER		;[3205] No, go zero out the pointer

	MOVNI	T1,1		;[3205] -1 means destroy mapping
	MOVSI	T2,.FHSLF	;[3205] The mapping is in our fork
	HLR	T2,%SRTAD+1	;[3205] Get section # from SORT's start address
	MOVEI	T3,1		;[3205] Unmap exactly one section
	SMAP%			;[3205] Ask Tops-20, it knows how
> ; End of IF20			;[4227]

	SETZM	%SRTAD		;[3205] Erase all traces of
SRTZER:	SETZM	%SRTAD+1	;[3205]  SORT's existance
	POPJ	P,

	SEGMENT	DATA

%SRTAD:	BLOCK	2		;[3205] Flag/PC doubleword for SORT (if FORSRT
				;[3205]  is loaded, and SORT.EXE is GET%ed)
%PASRT:	BLOCK	1		;[3362] Nonzero'd by FOROP. call if FO$SRT has
				;[3362]  already preallocated SORT pages.
	XLIST
	LIT
	LIST

	END