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