// 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)
	]