// GFILE.SR	GYPSY added readfile etc to invoke overlay

get "BRAVO.DF";
get "CHAR.DF";
get "GINN.DF"; // ** for minuserfn

// Incoming Procedures

external [
	GETAFILE;
	OPENAFILE;
	stsize;
	hpalloca;
	stcopy;
	stappend;
	ugt;
	stget;
	stput;
	movec;
	move;
	ActOnPages;
	hpfree;
	ult;
	gets;
	RealDA;
	GetNextDA;
	errhlt;
	CreateFile;
	puts;
	getvp;
	WritePages;
	trims;
	flushfn;
	sbwsize;
	umin;
	VirtualDA;
	diskio;
	ckdoc;
	remakevmtb;
	inheap;
// **
	qreadfile;
	qreadfile1;
	qwritefile;
	qwritefile1;
	overlay
	ckdir
	];

// Incoming Statics

external [
	sbpast;
	vcp;
	vchremain;
	vcplast;
	vlb;
	vpw;
	vrgcc;
	SYSTEMDIR;
	macbp;
	rgvpa;
	mpfnof;
	dnbp;
	vwremain;
	fillInDA;
	DCread;
	vbp;
	];

// Outgoing Procedures

external [
	open;
	normalizefilesb;
	opens;
	creates;
	dirlkup;
	fnalloc;
	closes;
	setmacfp;
	updateofs;
	endofs;
	deallocfn;
// **
	readfile;
	readfile1;
	writefile;
	writefile1;
	];

// Outgoing Statics

external [
	mpfnsb;
	cstream;
	dnfn;
	rgcfn;
	macfn;
	vsn1;
	vsn2;
	vversion;
	vda;
	vpos;
	vposhole;
	cof;
	vdeltafp;
	]; 

// Local Statics

static [
	mpfnsb;
	cstream;
	dnfn;
	rgcfn;
	macfn;
	vsn1;
	vsn2;
	vversion;
	vda;
	vpos;
	vposhole;
	cof;
	vdeltafp;
	];

manifest [ 
	ldirstruc = 7; // plus the rest of the name
	] 
// O P E N
// catalogue no. = 124
let open(fn,sb,wf) = valof
[ let tstream = nil;
let tchar = nil;
let tsb = vec (sbfnaml+1);
normalizefilesb(sb,tsb);
unless dirlkup(tsb) do resultis false;
unless opens(fn,vversion,vsn1,vsn2,vda,wf,false) do
	[ stcopy(sbpast," File too large -");
	resultis false;
	] 
let siz = (stsize(tsb)+6) rshift 1;
mpfnsb ! fn = hpalloca(siz);
(mpfnsb ! fn) ! 0 = 0;
stcopy(mpfnsb ! fn,tsb);
resultis true;
]

and opens(fn,version,sn1,sn2,da,wf,wmode) = valof
[ let tof = hpalloca(ofsiz+129);
tof >> OF.version = version;
tof >> OF.sn1 = sn1;
tof >> OF.sn2 = sn2;
tof >> OF.wf = wf;
tof >> OF.wmode = wmode;
tof >> OF.rgda = da;
tof >> OF.pos = 0;
tof >> OF.macfp = 129;
let rgda = lv (tof >> OF.rgda);
let lastpage = nil;
let numcharslast = nil;
let numcharsfullpages = nil;
movec(rgda+1,rgda+129,fillInDA);
test wf ifnot
	[ lastpage = ActOnPages(0,rgda,lv(tof >> OF.fileid),0,129,DCread,lv numcharslast,0,dnbp ! bpbuff,0);
	if lastpage eq 130 then
		resultis false;
	test lastpage ifso
		numcharsfullpages = (lastpage-1) lshift 9
	ifnot	numcharsfullpages = 0;
	tof >> OF.macpos = numcharsfullpages+numcharslast;
	mpfnof ! fn = tof;
	setmacfp(fn,lastpage+1);
	] 
ifso	[ mpfnof ! fn = tof;
	tof >> OF.macpos = 0;
	] 
cof = cof+1;
resultis true;
] 
// C R E A T E S 
// 
and creates(fn,sb,wf,wmode) = valof
[ let tsb = vec sbfnaml+1;
normalizefilesb(sb,tsb);
unless dirlkup(tsb) do
	[ let dir = vec (offset DIR.name)/16
	dir ! 4 = 0;
	CreateFile(tsb,dir+1);
	dir >> DIR.da = VirtualDA(dir >> DIR.da);
	let sizdir = (offset DIR.name)/16+sbwsize(tsb);
	(mpfnof ! fndir) >> OF.wf = true;
	if vposhole ne (mpfnof ! fndir) >> OF.macpos then
		[ (mpfnof ! fndir) >> OF.pos = vposhole;
		let sizhole = gets(fndir);
		if sizhole ls sizdir then errhlt("siz");
		if sizdir ls sizhole then
			[ (mpfnof ! fndir) >> OF.pos = vposhole;
			puts(fndir,sizhole-sizdir);
			vposhole = vposhole+((sizhole-sizdir) lshift 1);
			] 
		] 
	(mpfnof ! fndir) >> OF.pos = vposhole;
	dir >> DIR.type = 1;
	dir >> DIR.siz = sizdir;
	for i = 0 to (offset DIR.name)/16-1 do
		puts(fndir,dir ! i);
	for i = 0 to sbwsize(tsb)-1 do
		puts(fndir,tsb ! i);
	flushfn(fndir);
	(mpfnof ! fndir) >> OF.wf = false;
	vsn1 = dir >> DIR.sn1;
	vsn2 = dir >> DIR.sn2;
	vversion = dir >> DIR.version;
	vda = RealDA(dir >> DIR.da);
	vpos = vposhole;
	] 
unless opens(fn,vversion,vsn1,vsn2,vda,wf,false) do
	[ stcopy(sbpast," File too large -");
	resultis false;
	] 
let siz = (stsize(tsb)+6) rshift 1;
mpfnsb ! fn = hpalloca(siz);
(mpfnsb ! fn) ! 0 = 0;
stcopy(mpfnsb ! fn,tsb);
ckdir() // **
resultis true;
] 
// N O R M A L I Z E F I L E S B
//
and normalizefilesb(sbsource,sbdest) be
[ 
let tchar = nil;
sbdest >> lh = stsize(sbsource);
for i = 0 to sbsource >> lh-1 do
	[ tchar = stget(sbsource,i);
	stput(sbdest,i,tchar % #40);
	] 
if tchar ne $. then
	stappend(sbdest,".");
unless (sbdest >> lh) << odd then
	stput(sbdest,sbdest >> lh,0);
] 

// D I R L K U P
//
and dirlkup(sb) = valof
[ let lwinsb = sbwsize(sb)-1;
let lcmask = #20040;
let firstlcmask = #40;
let ofdir = mpfnof ! fndir;
ofdir >> OF.pos = 0;
let macpos = ofdir >> OF.macpos;
let type = nil;
let j = nil;
let siz = nil;
let tword = nil;
let pname = nil;
let ldirentry = (offset DIR.name)/16+lwinsb+1;
let holeneeded = true;
vwremain = 0;
vdeltafp = macbp-1;
while ult(ofdir >> OF.pos,macpos) do
	[ vpos = ofdir >> OF.pos;
	if vwremain le 0 then
		tword = gets(fndir);
	type = vpw >> DIR.type;
	siz = vpw >> DIR.siz;
	test type ifso
		test vwremain ge siz ifso
			[ pname = lv(vpw >> DIR.name);
			if rv sb ne ((rv pname) % firstlcmask) then
				goto failinc;
			for i = 1 to lwinsb do
				if (sb ! i % lcmask) ne (pname ! i % lcmask) then
					goto failinc;
			vsn1 = vpw ! 1;
			vsn2 = vpw ! 2;
			vversion = vpw ! 3;
			vda = RealDA(vpw ! 5);
			vdeltafp = 0;
			resultis true;
			] 
		ifnot
			[ ofdir >> OF.pos = vpos+2;
			vsn1 = gets(fndir);
			vsn2 = gets(fndir);
			vversion = gets(fndir);
			tword = gets(fndir);
			vda = RealDA(gets(fndir));
			tword = gets(fndir);
			if rv sb ne (tword % firstlcmask) then
				goto failninc;
			for i = 1 to lwinsb do
				[ tword = gets(fndir);
				if (sb ! i % lcmask) ne (tword % lcmask) then
					goto failninc;
				] 
			vdeltafp = 0;
			resultis true;
			] 
	ifnot
		[ if holeneeded & (siz ge ldirentry) then
			[ 
			vposhole = vpos;
			holeneeded = false;
			] 
		test vwremain ge siz ifso
			goto failinc
		ifnot
			goto failninc;
		] 
failninc:
		ofdir >> OF.pos = vpos+(siz lshift 1);
		vwremain = 0;
		loop;
failinc:
		ofdir >> OF.pos = vpos+(siz lshift 1);
		vwremain = vwremain-siz;
		vpw = vpw+siz;
	] 
if holeneeded then
	vposhole = ofdir >> OF.macpos;
vdeltafp = 0;
resultis false;
] 
// F N A L L O C
// catalogue no. = 128
and fnalloc( ) = valof
[ for fn = minuserfn to maxfn-1 do
	if mpfnof ! fn eq -1 then resultis fn;
resultis -1;
] 

// C L O S E S 
//
and closes(fn) be
[ errhlt("cls");
if (mpfnof ! fn) >> OF.wf then
	[ flushfn(fn);
	let macpos = (mpfnof ! fn) >> OF.macpos;
	let lastnumchars = macpos << PCD.rc;
	let rgda = lv ((mpfnof ! fn) >> OF.rgda);
	let fileid = lv((mpfnof ! fn) >> OF.fileid);
	if lastnumchars then
		[ let fp = macpos << PCD.p;
		let vpa = nil;
		vpa << VPA.fn= fn;
		vpa << VPA.fp = macpos << PCD.p;
		let ca = getvp(vpa);
		WritePages(0,rgda,fileid,fp+1,fp+1,0,0,lastnumchars,ca);
		] 
	trims(fn);
	(mpfnof ! fn) >> OF.wf = false;
	] 
]

// S E T M A C F P
//
and setmacfp(fn,newmac) be
[ let of = mpfnof ! fn;
let macfp = of >> OF.macfp;
unless ult(of >> OF.macpos,(newmac lshift 9)) then errhlt("mfp");
let ofnew = hpalloca(ofsiz+newmac);
of = mpfnof ! fn;
move(of,ofnew,ofsiz+umin(macfp,newmac));
let rgdanew = lv(ofnew >> OF.rgda);
if newmac gr macfp then
	movec(rgdanew+macfp,rgdanew+newmac,fillInDA);
ofnew >> OF.macfp = newmac;
mpfnof ! fn = ofnew;
hpfree(of);
] 

// U P D A T E O F S
// 
and updateofs( ) be
[ ckdoc( );
for fn = minuserfn to maxfn-1 do
	[ if fnscr eq fn then errhlt("scr");
	if (rgcfn ! fn eq 0) & (mpfnof ! fn ne -1) & not (mpfnof ! fn) >> OF.wf do
		[ hpfree(mpfnsb ! fn);
		hpfree(mpfnof ! fn);
		mpfnof ! fn = -1;
		cof = cof-1;
		if cof ls 2 then errhlt("cst");
		mpfnsb ! fn = 0;
		] 
	] 
for bp = 0 to macbp-1 do
	if mpfnof ! ((rgvpa+bp) >> VPA.fn) eq -1 then
		rgvpa ! bp = -1;
remakevmtb( );
] 

// E N D O F S
//
and endofs(fn) = valof
[ let of = mpfnof ! fn;
test ult(of >> OF.pos,of >> OF.macpos) ifso
	resultis false
ifnot	resultis true;
] 

// D E A L L O C F N 
//
and deallocfn(fn) be
[ test inheap(mpfnof ! fn) ifnot
	errhlt("nih")
ifso	hpfree(mpfnof ! fn);
test inheap(mpfnsb ! fn) ifnot
	errhlt("nih")
ifso	hpfree(mpfnsb ! fn);
mpfnsb ! fn = 0;
mpfnof ! fn = -1;
] 

// **

and readfile(selfnam,doc,cp) = valof
[
overlay(fnfilebb);
let ans = qreadfile(selfnam,doc,cp)
resultis ans
]

and readfile1(sbfnam,doc,cp) = valof
[
overlay(fnfilebb);
let ans = qreadfile1(sbfnam,doc,cp)
resultis ans
]

and writefile(selfnam,docfnam,cpfirst,cplast,translate) = valof
[
overlay(fnfilebb);
let ans = qwritefile(selfnam,docfnam,cpfirst,cplast,translate)
resultis ans
]

and writefile1(sbfnam,docfnam,cpfirst,cplast,translate) = valof
[
overlay(fnfilebb);
let ans = qwritefile1(sbfnam,docfnam,cpfirst,cplast,translate)
resultis ans
]