external  routine  spec  nrstrg(string  name  s)
external  routine  spec  prompt(string  (255) s)
external  routine  spec  disconnect alias  "S#DISCONNECT"(string  name  s, integer  name  f)
external  routine  spec  ucstring(string  name  s)
external  routine  spec  uctranslate alias  "S#UCTRANSLATE"(integer  name  adr, len)
external  integer  fn  spec  rdfilead(string  (255) s)
external  integer  fn  spec  tpfilead(string  (255) s, integer  pages)
external  routine  spec  move alias  "S#MOVE"(integer  name  len, from, to)
record  format  srcf(integer  nextfreebyte, txtrelst, maxlen, filetype)


const  integer  slen=149

routine  sort3(integer  array  name  p, integer  array  name  x, integer  num)
! DECLARE INTEGER ARRAY X, BOUNDS 1:NUM, IN CALLING ROUTINE
integer  i, j, hit, n
   cycle  i=1, 1, num
      x(i)=i
   repeat 
   cycle  i=num-1, -1, 1
      hit=0
      cycle  n=1, 1, i
         if  string(p(x(n)))>string(p(x(n+1))) start 
            j=x(n)
            x(n)=x(n+1)
            x(n+1)=j
            hit=1
         finish 
      repeat 
      if  hit=0 then  exit 
   repeat 
end  {sort3}


external  routine  line sort(string  (255) file)

integer  lastb, i, fad, len, aad, bad, flen, afad
integer  errors, outfad, ch, startad, endad, n, pt
string  (31) newfile, startkey, endkey
string  (255) wk, wklc
record  (srcf) name  h, h2

const  integer  max=3000 {max no of lines can cope with}
integer  array  x(1:max)
integer  array  fpt, arraypt(1:max)

   fad=rdfilead(file)
   return  if  fad=0
   h==record(fad)
   lastb=h_nextfreebyte-1
   flen=h_nextfreebyte-h_txtrelst

   newfile="T#A"
   outfad=tpfilead(newfile, (flen+4095)>>12 {pgs})
   if  outfad=0 then  ->fail
   afad=tpfilead("T#AZ", (flen+4095)>>12+2)
   if  afad=0 then  ->fail
   printstring("Output in file ".newfile)
   newline
   h2==record(outfad)

   prompt("Start key:")
   nrstrg(startkey)
   ucstring(startkey)
   prompt("Endkey:")
   nrstrg(endkey)
   ucstring(endkey)

   wk=""
   if  startkey="" then  startad=h_txtrelst else  startad=-1
   if  endkey="" then  endad=h_nextfreebyte else  endad=-1
   pt=afad+32
   n=0
   i=h_txtrelst
   while  i<h_nextfreebyte cycle 
      ch=byteinteger(fad+i)
      wk=wk.tostring(ch)
      if  ch=nl and  ((i<lastb and  byteinteger(fad+i+1)#nl) or  i=lastb) start 
         if  n>=max start 
            printstring("Too many lines (max ="); write(max, 1)
            newline
            ->fail
         finish 
         wklc=wk
         ucstring(wk)
         if  startad<0 and  length(wk)>=length(startkey) and  c 
            substring(wk, 1, length(startkey))=startkey then  startad=i-length(wk)+1
         if  endad<0 and  length(wk)>=length(endkey) and  c 
            substring(wk, 1, length(endkey))=endkey then  endad=1
         if  startad>0 start 
            n=n+1
            string(pt)=wk
            fpt(n)=i-length(wk)+1
            arraypt(n)=pt
            pt=pt+length(wk)+1
            if  length(wk)>slen start 
               printstring("Line too long (Max len ="); write(slen, 1)
               newline
               printstring("Line:".wk)
               ->fail
            finish 
         finish 
         wk=""
      finish 
      if  endad=1 then  endad=i-length(wk)+1 and  exit 
      i=i+1
   repeat 

externalroutinespec  phex alias  "S#PHEX"(integername  i)
printstring("Startad, endad = "); phex(startad); space; phex(endad); newline
   sort3(arraypt, x, n)

   ! Now move sorted lines into output file
   move(startad-h_txtrelst, fad+h_txtrelst, outfad+h2_txtrelst)
   h2_nextfreebyte=startad

   for  i=1, 1, n cycle 
      move(byteinteger(arraypt(x(i))), fad+fpt(x(i)), outfad+h2_nextfreebyte)
      h2_nextfreebyte=h2_nextfreebyte+byteinteger(arraypt(x(i)))
   repeat 

   ! And the post-text
   move(h_nextfreebyte-endad, fad+endad, outfad+h2_nextfreebyte)
   h2_nextfreebyte=h2_nextfreebyte+h_nextfreebyte-endad

   unless  h_nextfreebyte=h2_nextfreebyte start 
      printstring("?? File length ??!")
      newline
   finish 

fail:
   disconnect(file, i)
   disconnect(newfile, i)

end  {line sort}
end  of  file