Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/nlnsrt.fai
There are no other files named nlnsrt.fai in the archive.
title Nlnsrt
search Monsym
extern .jbsa
Z=0 A=1 B=2 C=3 D=4 E=5 N=6 L=7 R=10 I=11 J=12 V=13 T=14
maxrex==20000 lrecl==4 depth==100 buflen==50
array stack[depth], rectab[maxrex*lrecl], ptrtab[maxrex]
array combuf[buflen], atmbuf[buflen], jfnblk[.gjatr+1]
integer free, nbc, jfn
define fatal(errmsg) <jrst [
hrroi A,[asciz \errmsg\]
jrst estop ]>
start: RESET%
move P,[iowd depth+1,stack]
call read
call sequen ; set up line numbers
call sort
call write
stop: HALTF%
jrst stop
read: hrroi A,[asciz "Input file to sort? "]
movei D,[<.cmifi*1B8>!cm%fix]
call parse
hrrz A,jfn
move B,[of%rd!7B5]
OPENF%
erjmp error
move B,[2,,.fbbyv] ; just the two words .FBBYV and .FBSIZ
movei C,B ; put them in B and C
GTFDB%
load B,fb%bsz,B ; byte size
caie B,7 ; 7-bit?
imuli C,5 ; assume words, make bytes
hlro D,.jbsa ; calculate number of bytes we can handle
movns D ; words
imuli D,5 ; to bytes
subi D,maxrex ; less maybe MAXREX extra bytes for LFs
lsh D,-1 ; half that available for file
camle C,D ; are we ok?
fatal <File too big>
movns C ; negative byte count
movem C,nbc
hlro B,.jbsa ; pointer to free space
SIN%
movem B,free ; free space pointer
CLOSF%
erjmp error
hrroi A,[asciz "File for sorted output? "]
movei D,[<.cmofi*1B8>!cm%fix]
parse: movem A,cstate+.cmrty ; put prompt
movei A,cstate
movei B,[<.cmini*1B8>!cm%fix]
COMND%
rparse: movei B,(D) ; fetch what to parse from C
COMND%
movem B,jfn
movei B,[<.cmcfm*1B8>!cm%fix]
COMND%
ret1: ret
sequen: movsi I,-maxrex ; at most maxrex iterations
movei J,rectab ; points at record of interest
movn Z,nbc ; byte counts in C and Z
move C,Z
movsi A,(<point 7,0>) ; string source
hlr A,.jbsa
move D,free ; string destination
setzb B,E
numlp: jumple Z,numlpe
move T,Z ; old byte count
move V,C
movem A,3(J) ; save pointers to these strings
movem D,1(J)
extend Z,getkey ; move uppercase line
nop
tlz Z,(7B2) ; take off random bits from movst
sub T,Z ; calculate length of line
ldb R,A ; if CRLF skip LF
dpb B,A ; (make sure a null at end of line)
move L,A
ildb L,L
cain R,.chcrt
caie L,.chlfd
jrst .+3
ibp A
subi Z,1
sub V,C ; length of key
jumpe V,numlp ; blank lines, what blank lines?
movem T,2(J) ; save lengths
movem V,(J)
movem J,ptrtab(I)
addi J,lrecl ; point at next record
aobjn I,numlp ; update boundscheck variable and loop
numlpe: movni N,-1(I) ; save negative number of lines
ret
write: movsi I,-1(N) ; aobjn pointer
movn C,nbc ; space to stuff output
move D,free
setzb B,E
setz T,0 ; put a char count in here
linlp: move J,ptrtab(I) ; copy the next line
dmove Z,2(J) ; length of string
add T,Z ; accumulate byte count for output
extend Z,movst0 ; move exact string
nop
movei Z,.chcrt ; put on crlf
idpb Z,D
movei Z,.chlfd
idpb Z,D
addi T,1 ; accumulate count (CR already counted)
aobjn I,linlp ; loop
hrrz A,jfn ; open, output, close
move B,[of%wr!7B5]
OPENF%
erjmp error
move B,free
movn C,T
SOUT%
CLOSF%
erjmp error
ret
sort: jumpge N,ret1 ; utter triviality (or error, bah!)
movn R,N ; rightmost element of file
caig R,9 ; can we use straight insertion?
jrst isort
movei L,0 ; leftmost element of file
push P,[-1] ; sentinel for no sort requests pending
setzb B,E ; zero these for compares
dosort: movei I,(L) ; set I = (L+R)/2 and sort L,I,R
addi I,(R)
lsh I,-1
dmove Z,@ptrtab(L) ; compare record L with record R
move V,ptrtab(R) ; and simultaneously save record R in V
dmove C,(V)
extend Z,cmpsle
exch V,ptrtab(L) ; L and R out of order, switch
dmove Z,@ptrtab(I) ; swap I and V if need be
dmove C,(V)
extend Z,cmpsle
exch V,ptrtab(I)
movem V,ptrtab(R) ; V has largest of the 3, put in R
dmove Z,@ptrtab(L) ; swap L and I if need be
move V,ptrtab(I)
dmove C,(V)
extend Z,cmpsle
exch V,ptrtab(L)
exch V,ptrtab+1(L) ; now swap final I with L+1
movem V,ptrtab(I)
movsi I,(N) ; start I at L+1, J at R, and Ith record
adjsp I,1(L)
movei J,(R)
move V,ptrtab(I)
ijloop: aobjp I,idone ; For I := I+1 to N
iloop: dmove Z,(V) ; done if V leq record I
dmove C,@ptrtab(I)
extend Z,cmpsle
aobjn I,iloop
idone: sojle J,jdone ; For J:=J-1 downto 0
jloop: dmove Z,@ptrtab(J) ; done if record J leq V
dmove C,(V)
extend Z,cmpsle
sojg J,jloop
jdone: move T,ptrtab(J) ; set up for swap with J
movei A,(I)
cail A,(J) ; done when I and J have crossed
jrst ijdone
exch T,ptrtab(I) ; swap I with J
movem T,ptrtab(J)
jrst ijloop
ijdone: exch T,ptrtab+1(L) ; partition done, swap L with J
movem T,ptrtab(J)
movei T,(J) ; T=J-L, left subfile
subi T,(L)
movei V,(R) ; V=R-J, right subfile
subi V,(J)
camle T,V ; compare subfiles
jrst lftbig ; left greater than right
caig V,9 ; don't sort small subfiles
jrst popsrt ; both too small to sort
caig T,9 ; what about left?
jrst [movei L,1(J) ; left too small to sort, just sort right
jrst dosort]
hrli R,1(J) ; both need sorting, stack right (larger)
push P,R
movei R,-1(J) ; go sort smaller left subfile
jrst dosort
lftbig: caig T,9 ; left subfile too small to sort?
jrst popsrt ; yes, both are, get one off stack
caig V,9 ; left is big enough, what about right?
jrst [movei R,-1(J) ; right too small to sort, just do left
jrst dosort]
movss L ; both need sorting, stack left (larger)
hrri L,-1(J)
push P,L
movei L,1(J) ; go sort smaller right subfile
jrst dosort
popsrt: pop P,R ; pop a stacked subfile
jumpl R,isort ; oops, sentinel, all done quicksorting
hlrz L,R
jrst dosort ; quicksort popped request
isort: movsi I,-1(N) ; finish off sort by insertion
aobjp I,ret1 ; For I:=1 to N
sortup: move V,ptrtab(I) ; set V=key(I)
movsi J,377777(I) ; For J:=I-1 downto 0
hrri J,ptrtab-1(I)
inloop: dmove Z,(V) ; If key J geq key in question then next J
dmove C,@(J)
extend Z,cmpsl
jrst insert
pop J,1(J) ; else bump a key and loop
jumpl J,inloop
insert: movem V,1(J) ; found the spot to insert key
aobjn I,sortup ; loop until whole file done
ret
estop: ESOUT%
death: RESET%
jrst stop
error: hrroi A,[asciz ""] ;output a crlf, questionmark, and nullstring
ESOUT%
movei A,.priou
hrloi B,.fhslf
setz C,0
ERSTR%
nop
nop
jrst death
cstate: rparse
.priin,,.priou
-1,,[asciz/??? /]
-1,,combuf
-1,,combuf
buflen*5-1
0
-1,,atmbuf
buflen*5-1
jfnblk
cmpsle: 3B8 ; compare strings and skip on less or equal
0
cmpsl: 1B8 ; ... skip on less than
0
movst0: <15B8>!string ; move exact string
0 ; shouldn't need to pad
getkey: <15B8>!keystr ; skip blanks, uppercase, break on eol
0
string: <.chnul,,.chnul+1>!<1B2>!<4B20> ; break on zerobyte
for ch=.chnul+2,177,2 {
<ch,,ch+1>!<4B2>!<4B20> } ; direct translation otherwise
keystr: <.chnul,,.chnul+1>!<1B2>!<4B20> ; break on zerobyte
for ch=.chnul+2,.chtab-2,2 {
<ch,,ch+1>!<4B2>!<4B20> }
<.chtab-1,,.chtab>!<4B2>!<0B20> ; ignore leading tab
<.chlfd,,.chlfd+1>!<1B2>!<4B20> ; break on linefeed
<.chcrt-1,,.chcrt>!<4B2>!<1B20> ; break on carriage-return
for ch=.chcrt+1," "-2,2 {
<ch,,ch+1>!<4B2>!<4B20> }
<" ",," "+1>!<0B2>!<4B20> ; ignore leading space
for ch=" "+2,"a"-2,2 {
<ch,,ch+1>!<4B2>!<4B20> }
<"a"-1,,"A">!<4B2>!<4B20> ; translate "a" through "z" to uppercase
for ch="b","z"-2,2 {
<ch-40,,ch-37>!<4B2>!<4B20> }
<"Z",,"z"+1>!<4B2>!<4B20>
for ch="z"+2,177,2 {
<ch,,ch+1>!<4B2>!<4B20> }
end start