Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99g-bb - forsrt.c13
There is 1 other file named forsrt.c13 in the archive. Click here to see a list.
 REP 3/1	;13C1
		TV	SORT - FORTRAN interface to stand-alone SORT, 10(4172)
 WIT
		TV	SORT - FORTRAN interface to stand-alone SORT, 10(4227)
 INS 147/1	;13C2
	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.

 REP 24/2	;13C3
		MAXARG==^D10			;[3205] Allow a maximum of 10 arguments
 WIT
		MAXARG==^D3		;[4227] Allow a maximum of 3 arguments
 REP 56/4	;13C4
	NEWARG:	BLOCK	2*MAXARG		;[3205] Holds arguments for SORT call
 WIT
	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
 REP 20/5	;13C5

		MOVE	T0,@(16)		;[3076] Get byte pointer

		LDB	T1,[POINT 6,T0,5]	;[3076] Get position of character
		CAIE	T1,44			;[3076] At beginning of word?
		 CAIN	T1,61			;[3205] Or aligned OWGBP?
		  SKIPA				;[3205] Yes, something worth fixing up
		   $FCALL AQS,ABORT.		;[3076] Not at beginning, give error
	;	$FERR (?,AQS,21,112,<First argument to SORT must be a quoted string>) ;[3205]

		CAIE	T1,44			;[3205] Local byte pointer ?
		 TLZA	T0,(77B5)		;[3205] No, clear the P&S field
		  TLZ	T0,(<37B5>!<77B11>!<@>) ;[3205] Yes, clear P, S and I fields
						;[3205]  while leaving the IFIW bit on
		XMOVEI	T0,@T0			;[3205] Get the address of the pointer
 WIT
	;
		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

 REP 32/8	;13C6
		POPJ	P,			;[7] RETURN TO CALLER
 WIT
	;
	; [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
 REP 41/8	;13C7
		POPJ	P,			;[5] CONTINUED?????
 WIT
		PJRST	KSTR		;[4227] CONTINUED?????
 INS 15/11	;13C8
	MEMREQ:	BLOCK	1		;[4227] Holds size (words) of memory gotten
	MEMADR:	BLOCK	1		;[4227] Holds address of memory gotten

 REP 20/12	;13C9
		MOVE	T0,@(16)		;[3076] Get byte pointer

		LDB	T1,[POINT 6,T0,5]	;[3076] Get position of character
		CAIE	T1,44			;[3076] At begining of word?
		 $FCALL	AQS,ABORT.		;[3076] Not at beginning, give error
	;	$FERR (?,AQS,21,112,<First argument to SORT must be a quoted string>) ;[3205]

		TLZ	T0,(<37B5>!<77B11>!<@>) ;[3205] Clear P, S and I fields
						;[3205]  while leaving the IFIW bit on
		XMOVEI	T0,@T0			;[3205] Get the address of the pointer
 WIT
	;
		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
 DEL 33/12	;13C10
		MOVE	T3,-1(L)		;[3205] Get whole count word
		MOVEM	T3,NEWARG-1		;[3205] Save it away in new block
		HLRE	T3,T3			;[3455] 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] 

		MOVN	T3,T3			;[3232] Get number of extra args
		SOJLE	T3,ONEARG		;[3463] Don't fool around if no extras

		MOVSI	T1,1(L)			;[3205] Put BLT source address in LH
		HRRI	T1,NEWARG+1		;[3205] Put BLT destination in RH
		BLT	T1,NEWARG(T3)		;[3205] Move user's other args over
	ONEARG:	XMOVEI	L,NEWARG		;[3463] Point to new arg block

 REP 106/12	;13C11
		POPJ	P,			;[3205]  AND RETURN TO CALLER
 WIT
	;
	; [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
 REP 46/13	;13C12
	IF20,<
	KSORT.:	SKIPN	%SRTAD+1	;[3205] Is there a SORT anywhere?
 WIT
	KSORT.:
	IF20,<				;[4227]
		SKIPN	%SRTAD+1	;[3205] Is there a SORT anywhere?
 INS 58/13	;13C13
	> ; End of IF20			;[4227]
 REP 61/13	;13C14
		POPJ	P,		;[3205] Go initialize some more
	> ; End of IF20

	IF10,<
	KSORT.:	SETZM	%SRTAD		;ERASE SORT FROM MEMORY
		SETZM	%SRTAD+1
		POPJ	P,
	> ;END IF10
 WIT
		POPJ	P,
 SUM 35072