Trailing-Edge
-
PDP-10 Archives
-
bb-bt99h-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