// QFILE.SR get "BRAVO.DF"; get "GINN.DF" get "CHAR.DF" // Incoming procedures external [ setsel invalidatedoc wipedoc hpalloc stcopy; ugt; ult; getvch; updatedisplay; invalidatedisplay; stappend; confirm; readsel; open; FileLength; insertb; normalizefilesb; mapcp; errhlt; hpfree; remakevmtb; ckdoc; setlf; stequal; move; enww; fnalloc; dirlkup; opens; CreateFile; puts; gets; flushfn; VirtualDA; diskwritegroup; trims; closes; creates; stnum; deallocfn // ** ckdir ActOnPages sbwsize paraspec qreadfilev qwritefilev ] // Incoming statics external [ ddoc rgcpfdispl vwwcurrent rgsfile pzone sbpast; rgmaccp; selarg; vdoc; vcp; vchremain; vlb; vpw; vdlhint; rgpctb; cstream; dnfn; mpfnsb; vrgcc; SYSTEMDIR; macbp; rgvpa; vcplast; vpc; selaux; selection; mpdldcb; rgmaxdl; rgdirty; mpfnof; vpos; vda; vsn1; vsn2; vversion; ppcd; rglastused; lrutime; vbp; vchremainput; vpwput; vlbput; vextendof; cof; vmessage; vdeltafp // ** rgpara rgprogram DCread DCwrite ] // Qutgoing procedures external [ qreadfile qreadfile1; qwritefile; qwritefile1; qfnamfilter; ] // Qutgoing statics // ** Took out readwritecoms // Q R E A D F I L E // catalogue no. = 125 let qreadfile(selfnam,doc,cp) = valof [ let sbfnam = vec sbfnaml; readsel(sbfnam,selfnam >> SEL.doc,selfnam >> SEL.cpfirst,selfnam >> SEL.cplast,(sbfnaml lshift 1)-1); resultis qreadfile1(sbfnam,doc,cp) ] and qreadfile1(sbfnam,doc,cp) = valof [ let sbnoopen = vec (10+sbfnaml); sbnoopen ! 0 = 0; stcopy(sbnoopen," Could not open "); let tfn = fnalloc( ); if tfn eq -1 then [ stcopy(sbpast," Too many open files -"); resultis false; ] unless open(tfn,sbfnam,false) do [ stappend(sbnoopen,sbfnam) stappend(sbnoopen," - ") stcopy(sbpast,sbnoopen); resultis false; ] // ** setlf(lfsys,idpast," Reading file"); updatedisplay( ); let ppcd = vec 2; let vpa = nil; let plen = vec 2; plen ! 0 = 0; let l = (mpfnof ! tfn) >> OF.macpos; vpa << VPA.fn = tfn; ppcd >> PCD.live = 0; ppcd >> PCD.rc = 0; vpa << VPA.fp = 0; ppcd >> PCD.vpaddr = vpa; invalidatedisplay(doc,cp,vdlhint); insertb(doc,cp,ppcd,l); qreadfilev(doc, cp, cp+l-1) // ** resultis true; ] // Q W R I T E F I L E // catalogue no. = 136 and qwritefile(selfnam,docfnam,cpfirst,cplast,translate) be [ let sbfnam = vec (sbfnaml+1); readsel(sbfnam,selfnam >> SEL.doc,selfnam >> SEL.cpfirst,selfnam >> SEL.cplast,(sbfnaml lshift 1)-1); qwritefile1(sbfnam,docfnam,cpfirst,cplast,translate) ] and qwritefile1(sbfnam,docfnam,cpfirst,cplast,translate) be [ let usbfnam = vec (sbfnaml+1); // ** normalizefilesb(sbfnam,sbfnam); stcopy(usbfnam, sbfnam) // ** let overwrite = false; let tsn1,tsn2,tversion,tda,tpos = nil,nil,nil,nil,nil; let tfn = nil; let tcp = nil; let tchremain = 0; let vpa,fnget,bplock,cpage,macbpput = nil,nil,0,0,macbp-2; for fn = 1 to maxfn-1 do if mpfnof ! fn ne -1 do if stequal(sbfnam,mpfnsb ! fn) then [ tfn = fn; overwrite = true; sbfnam >> lh = sbfnam >> lh-1; stappend(sbfnam,"$."); ] vextendof = false; let newfile = nil; if creates(fnput,sbfnam,true,false) then newfile = true; tsn1 = vsn1; tsn2 = vsn2; tversion = vversion; tda = vda; tpos = vpos; // ** GYPSY ADDED: if rgprogram ! docfnam then test (rgpara ! docfnam) >> LIST.siz le 3 & paraspec(docfnam, 0) >> SPEC.trailerlength eq 2 ifso cplast = cplast - 4 // omit dummy para & main trailer ifnot errhlt("FPR") // ** vcp = cpfirst; vchremain = 0; vchremainput = 0; let char = nil; let posput,fpfirst = 0,0; test translate ifso errhlt("TRA") // ** ifnot [ while not ugt(vcp,cplast) do [ if vchremain eq 0 then [ rglastused ! bplock = lrutime; vdeltafp = 1; mapcp(docfnam,vcp); vdeltafp = 0; bplock = vbp; rglastused ! bplock = -1; ] test vlb ifso [ char = vpw >> lh; vlb = false; ] ifnot [ char = vpw >> rh; vlb = true; vpw = vpw+1; ] test vchremainput ifso [ test vlbput ifso [ vpwput >> lh = char; vlbput = false; ] ifnot [ vpwput >> rh = char; vlbput = true; vpwput = vpwput+1; ] ] ifnot [ test cpage eq macbpput ifso [ diskwritegroup(fnput,fpfirst,fpfirst+cpage-1,#1000); cpage = 1; fpfirst = posput << PCD.p; ] ifnot cpage = cpage+1; if posput << PCD.rc then errhlt("npg"); let ofput = mpfnof ! fnput; ofput >> OF.pos = posput; ofput >> OF.macpos = posput; puts(fnput,char); rglastused ! vbp = -1; vlbput = not vlbput; if vlbput then vpwput = vpwput+1; ] vchremainput = vchremainput-1; posput = posput+1; vcp = vcp+1; vchremain = vchremain-1; ] ] writedone: (mpfnof ! fnput) >> OF.macpos = posput; rglastused ! bplock = 0; diskwritegroup(fnput,fpfirst,posput << PCD.p,posput << PCD.rc) unless rgprogram ! docfnam do [ (mpfnof ! fnput) >> OF.pos = posput; qwritefilev(docfnam, fnput); ] if overwrite then [ leaderpage(tfn, sbfnam) // ** leaderpage(fnput, usbfnam) // ** dirlkup(mpfnsb ! tfn); (mpfnof ! fndir) >> OF.pos = vpos+2; (mpfnof ! fndir) >> OF.wf = true; puts(fndir,tsn1); puts(fndir,tsn2); puts(fndir,tversion); puts(fndir,0); puts(fndir,VirtualDA(tda)); (mpfnof ! fndir) >> OF.pos = tpos+2; puts(fndir,vsn1); puts(fndir,vsn2); puts(fndir,vversion); puts(fndir,0); puts(fndir,VirtualDA(vda)); flushfn(fndir); (mpfnof ! fndir) >> OF.wf = false; stcopy(mpfnsb ! tfn,sbfnam); ] flushfn(fnput); trims(fnput); ofilemessage(sbfnam,(mpfnof ! fnput) >> OF.macpos,true,newfile); deallocfn(fnput); cof = cof-1; if overwrite then ckdir() // ** unless rgprogram ! docfnam % docfnam eq ddoc do qfakefetch(usbfnam, docfnam) ] // QFAKEFETCH and qfakefetch(sbfnam, doc) be [ let tcpfdispl = vec maxww // %% move(rgcpfdispl, tcpfdispl, maxww) // %% let tcpfirsttarget = selection>>SEL.cpfirst let tcplasttarget = selection>>SEL.cplast let tcpfirstrange = selaux>>SEL.cpfirst let tcplastrange = selaux>>SEL.cplast invalidatedoc(doc) wipedoc(doc) qreadfile1(sbfnam, doc, 0) if rgsfile ! doc eq 0 then rgsfile ! doc = hpalloc(sbfnaml, pzone) stcopy(rgsfile ! doc, sbfnam) setsel(selection, tcpfirsttarget, tcplasttarget) setsel(selaux, tcpfirstrange, tcplastrange) move(tcpfdispl, rgcpfdispl, maxww) // %% ] // Q F N A M F I L T E R // SPE catalogue no. and qfnamfilter(char,c) = ((char le chsp) % (c ge mastx-3)); // Q F I L E M E S S A G E // and ofilemessage(sbname,siz,write,newfile) be return ; // ** // [ let tsb = vec 5; // stcopy(sbpast," "); // stnum(tsb,siz); // stappend(sbpast,tsb); // stappend(sbpast," bytes"); // stappend(sbpast,(write ? " written on "," read from ")); // stappend(sbpast,sbname); // stappend(sbpast,(newfile ? " [ NEW FILE ]"," [ OLD FILE ]")); // vmessage = true; // ] and leaderpage(fn, name) be // ** [ let b = vec (chperpage/2); let of = mpfnof ! fn; ActOnPages(0, lv (of >> OF.rgda), lv (of >> OF.fileid), 0, 0, DCread, 0, 0, b, 0) move(name, lv b>>LD.name, sbwsize(name)) let of = mpfnof ! fn; ActOnPages(0, lv (of >> OF.rgda), lv (of >> OF.fileid), 0, 0, DCwrite, 0, 0, b, 0) ]