// rff.sr

// Last modified October 25, 1979  6:54 PM by Taft

get "BRAVO1.DF";
get "MSG.DF"
// get "SELECT.DF"
get "VM.DF"
get "ALTOFILESYS.D"
get "BFS.DEF"
get "FORMAT.DF"
// get "COM.DF"
// get "RN1.DF"

// Incoming Procedures

external	[
	array
	errhlta
	errhlt
	movec
	VirtualDA
	move
	flushvm
	Enqueue
	remakevmtb
	TIMER
	ScanPages
// 	waitforfd
	deallocfn
	MyFrame
	hpalloca
	fastscan
	getsintfast
	LengthQ
	Dequeue
	diskwritegroup
	getfb
	SetVab
	setsel
	]

// Incoming Statics

external	[ 
	vxrightmargstd
	vxleftmargstd
	mpfnof
	vextendof
	macbp
	dnbp
	rgvpa
	rglastused
	vfloppy
	vchremain
	vlb
	char
	vpw
	rgfcode
	dnfun
	rgbs
	vdxtbStd
	selmain
	look1std
	look2std
	]

// Outgoing Procedures

external	[
	readformattedfile;
	];

// Outgoing Statics

external	[
	vfn;
	vfc;
	vfb;
	vfpfirst;
	vfplast;
	vbpsrc;
	vmask;
	vmacfc;
	vfbfrparlast;
	vfcterm;
	parastat;
	vmacfr;
	rglook1;
	mpfrfc;
	rglook2;
	vtop;
	vcfree;
	lvterminate;
	rgbpfs;
	vbpoffb;
	vpi;
	vparlast;
	vfcfirst;
	mpbifc;
	mpbifb;
	vbi;
	rgmpbifc;
	rgmpbifb;
	vfc1;
	vfbloclast;
	sblabel;
	vfclast;
	parsacred;
	vfbfirst;
	vfblast;
	rgfcterm;
	rgfctrailer;
	vcpage;
	cpar;
	vfinhibit;
	vfabort
	vfOldtab
	vdxtb
	]; 

// Local Statics

static	[
	vfn;
	vfc;
	vfb;
	vfpfirst;
	vfplast;
	vbpsrc;
	vmask;
	vmacfc;
	vfbfrparlast;
	vfcterm;
	parastat;
	vmacfr;
	rglook1;
	mpfrfc;
	rglook2;
	vtop;
	vcfree;
	lvterminate;
	rgbpfs;
	vbpoffb;
	vpi;
	vparlast;
	vfcfirst;
	mpbifc;
	mpbifb;
	vbi;
	rgmpbifc;
	rgmpbifb;
	vfc1;
	sblabel;
	vfclast;
	parsacred;
	vbifirstrun;
	vpifirstrun;
	ffirstrun;
	vfbfirst;
	vfblast;
	rgfcterm;
	rgfctrailer;
	vcpage;
	cpar;
	vfinhibit;
	vfabort
	vfchlt = -1
	num
	vfNewtable
	vfOldtab
	vdxtb
	vsiTtblprev
	];

// Local Structure

structure PDESC:
	[
	look1	word
	look2	word
	fInLabel	word
	fNumPending	word
	char	word
	itb	word
	fGotItb	word
	fBadformat	word
	]

structure AB:		// can't get df
	[
	crid	byte
	nrid	byte
	]


// local manifest

manifest	[
	chsp = $*S
	ctrlz = $Z-#100
	lPDesc = (size PDESC)/16
	cbpFree = 3
	cbpread = 4;
	maxfrstd = #100;
	look1trailer = #20;
	look2trailer = 0;
	mphd = 1;
	runovhd = 3;
	maxfr = (#400)/runovhd
	maxpar = 100;

	pidChRemain = 6
	pidFParse = 7
	pidParaStatStd = 8
	pidBuf = 9
	pidBufBin = 10
	pidQBufBinFree = 11
	pidQBufBinUsed = 12
	pidFcTrailer = 13
	pidFcFirst = 14
	pidPDesc = 15
	pidTtbl = 16
	pidTtblPrev = 17
	pidCparBadformat = 18
	pidAty = 19
	]


structure Q:
	[ head	word
	tail	word
	]

manifest	[ 
	lQ = (size Q)/16
	atyNil = 0
	atyParse = 1
	atyFbo = 2
	abmsg = -3
	mtyOw = -1
	sph = 9;
	schar = 6;
	]


let readformattedfile(fnsrc, lvnumcharslast) = valof
[ 
// pidChRemain = 6?

let chRemain = 0;
// can't find any reference to this
let fParse = false
let paraStatStd = vec 1+parovhd; let buf = 0; let bufBin = 0;
let qBufBinFree = vec lQ; qBufBinFree>>Q.head = 0;
let qBufBinUsed = vec lQ; qBufBinUsed>>Q.head = 0;
let fcTrailer = -1; let fcFirst = 0;
let pDesc = vec lPDesc
let ttbl = vec lnttblMax
let ttblPrev = vec lnttblMax
let cparBadformat = 0
let aty = atyNil

// ** there exist pid's for all locals above this line !!!

paraStatStd>>PSTAT.siz = 1+parovhd;
paraStatStd>>PSTAT.xrightmarg = vxrightmargstd
paraStatStd>>PSTAT.xleftmarg = vxleftmargstd
paraStatStd>>PSTAT.xleftmargf = -1
paraStatStd>>PSTAT.ypos = -1;
paraStatStd>>PSTAT.spec = specstd;
paraStatStd>>PSTAT.fOldtab = true;
paraStatStd>>PSTAT.dxtb = vdxtbStd;
paraStatStd>>PSTAT.ykeep = 0;
paraStatStd>>PSTAT.label = 0;

ttbl>>TTBL.cw = 1
let mpitbxtb = lv ttbl>>TTBL.ampitbxtb
for titb = 0 to itbMax-1 do
	mpitbxtb ! titb = xtbNil
vfNewtable = true
vfOldtab = true
vdxtb = vdxtbStd


// initialization of maps

let macbpread = cbpread;

rglook1 = array(maxfr+5);
rglook2 = array(maxfr+5);
mpfrfc = array(maxfr+5);
mpfrfc ! 0 = 0;
vmacfr = 0;
parastat = array(#400);
mpbifc = array(#200);
mpbifb = array(#200);
sblabel = array(#200);
vbi = -1;
let macpos = (mpfnof ! fnscrfs)>>OF.macpos;
unless macpos<<PCD.rc eq 0 then errhlta(7);
vfbfirst = macpos rshift 9;
vfb = vfbfirst-1;
vfn = fnsrc;
vmacfc = 0;
vextendof = false;
vfplast = -1;
vfbfrparlast = -1;
vcfree = 0;

let cfaSrc = vec lCFA
let of = mpfnof ! fnsrc
let da = of>>OF.rgda
movec(cfaSrc, cfaSrc+lCFA-1, 0)
cfaSrc>>CFA.fp.version = of>>OF.version;
cfaSrc>>CFA.fp.leaderVirtualDa = VirtualDA(da);
cfaSrc>>CFA.fa.da = da;
move(lv (of>>OF.sn1), lv (cfaSrc>>CFA.fp.serialNumber), lSN)
let poolBuf = array(macbp*lBuf)
let qBufFree = vec lQ; qBufFree>>Q.head = 0;
flushvm()
let tBuf = poolBuf
for bp = 0 to macbp-cbpFree-1 do
	[
	tBuf>>BUF.ca = dnbp ! bp
	tBuf>>BUF.bp = bp
	tBuf>>BUF.pgn = 0
	let qBuf = (bp ls macbpread) ? qBufFree, qBufBinFree
	Enqueue(qBuf, tBuf)
	tBuf = tBuf+lBuf
	rgvpa ! bp = -1
	rglastused ! bp = -1;
	]
remakevmtb()
let mpPgnDa = array(#202);
// let mpPgnDa = lv (of>>OF.rgda)

// let starttime = vec 2
// TIMER(starttime)
let tc = ScanPages(cfaSrc, qBufFree, TcFileParser, mpPgnDa, #201)
let pgnLast = cfaSrc>>CFA.fa.pageNumber
// if vfloppy then
// 	waitforfd(of>>OF.fda, 0, pgnLast, starttime);

if cfaSrc>>CFA.fa.charPos eq #1000 then
	[
	pgnLast = 130;
	goto rfffin;
	]

rfffin:
test (tc eq tcByScanPages) % (tc eq tcAbort) ifso
	[ 
// tcByScanPages means file too big
// tcAbort means parse error
	if (tc eq tcAbort) & (aty eq atyParse) then
		[ 
		let ab = nil
		ab<<AB.crid = 2
		ab<<AB.nrid = 10		// "End of file . . . "
		SetVab(ab)
		setsel(selmain, 0, 0)
		selmain>>SEL.type = schar
		]
	pgnLast = 130	// kludgy way of returning false
// 	ifnot file too large ?
	]
ifnot	[ 
//	if cparBadformat ne 0 then
//		[
//	message -- "Selected paragraph not in Bravo format[ - first of n]"
//		let ridFirstOf = rinil
//		let ridCpar = rinil
//		if cparBadformat gr 1 then
//			[
//			ridFirstOf = 226
//			let tsb = vec 5
//			stnum(tsb, cparBadformat)
//			SetRegionW(vrlwsys, 0, tsb)
//			ridCpar<<RID.nrl = 1
//			ridCpar<<RID.ri = 0
//			]
//		SetVab(abmsg, false, 75, ridFirstOf, ridCpar)
//		]
	move(mpPgnDa, lv ((mpfnof ! fnsrc)>>OF.rgda), pgnLast+2);
	test fParse ifso
		[
		vparlast>>PAR.nextpar = -1
		EstablishFb(MyFrame())
		mpbifc ! (vbi+1) = (pgnLast-1) lshift 9 + buf>>BUF.numChars
		mpbifb ! (vbi+1) = -1;
		let tphp = hpalloca(vbi+2);
		move(mpbifc, tphp, vbi+2);
		rgmpbifc ! fnsrc = tphp;
		tphp = hpalloca(vbi+2);
		move(mpbifb, tphp, vbi+2);
		rgmpbifb ! fnsrc = tphp;
		(mpfnof ! fnsrc)>>OF.macbi = vbi+1;
		]
	ifnot	(mpfnof ! fnsrc)>>OF.formatted = false;
	]
tBuf = poolBuf
let vpa = nil
for bp = 0 to macbp-cbpFree-1 do
	[ 
	rglastused ! bp = 1;
	unless bp ls macbpread then loop
	rgvpa ! bp = -1
	]
remakevmtb()

mpfrfc = 0;
@lvnumcharslast = cfaSrc>>CFA.fa.charPos
resultis pgnLast;
]

// F I L E P A R S E R
//
and TcFileParser(zone, fReturn) = valof
[
	[
	if fReturn(zone) then
		resultis tcNotDone;
	let scanParams = zone>>CBZ.extra
	let fmRff = scanParams>>SCP.fmCaller
	let tc =  TcTryGetBuf(zone)
	if tc ne tcNil then
// ** some thing here to indicate error if ScanPages returns on this
		[
		if (tc eq tcDone) & (fmRff ! pidFParse) &
		    (FcOfBuf(fmRff) ne fmRff ! pidFcFirst) then
			[ fmRff ! pidAty = atyParse
			resultis tcAbort
			] 
		resultis tc;
		]
	SetPters(fmRff)
	fastscan(ctrlz);
	fmRff ! pidChRemain = vchremain;
	unless vchremain do
		loop;
	fmRff ! pidFcTrailer = FcOfBuf(fmRff)
	InitParse(fmRff)
	scanParams>>SCP.TcScanProc = TcParseParagraph
	resultis tcNotDone
	] repeat
]

// P A R S E P A R A G R A P H
//
// Paragraph format is <body><trailer> where <body> has no CRs
// 	and trailer format is ctrlZ then "jn7b12B14u7bU" then CR
// means 5 changes starting with Justified text, 
//	7 chars later turn on Bold
//	12 chars later turn off bold
//	14 chars later turn on Ul
//	7 chars later turn on Bold and turn off ul
// n means no change since last version; N means has changed
// there is an optional change count in front of the trailer;
//	if not present it is estimated

and TcParseParagraph(zone, fReturn) = valof
[
let fmRff = (zone>>CBZ.extra)>>SCP.fmCaller
fmRff ! pidFParse = true
let pDesc = fmRff ! pidPDesc
let ttbl = fmRff ! pidTtbl
let mpitbxtb = lv ttbl>>TTBL.ampitbxtb
let itb = nil
vchremain = 0
let chRemainOld = 0;
	[
	if (vchremain eq 0) then
		[
		fmRff ! pidChRemain = fmRff ! pidChRemain - chRemainOld
		if fReturn(zone) then resultis tcNotDone
		let tc = TcTryGetBuf(zone)
		if tc ne tcNil then
			[ if tc eq tcDone then
				[ fmRff ! pidAty = atyParse
				resultis tcAbort
				] 
			resultis tc;
			] 
		SetPters(fmRff)
		chRemainOld = vchremain
		]
	test vlb ifso
		[
		char = vpw>>lh;
		vlb = false;
		]
	ifnot	[
		char = vpw>>rh;
		vlb = true;
		vpw = vpw+1;
		]
	vchremain = vchremain-1;

skipgetchar:
	unless pDesc>>PDESC.fNumPending do
		pDesc>>PDESC.char = char;
	let fcode = rgfcode ! (pDesc>>PDESC.char)
	let kind = fcode<<FCODE.kind
	if pDesc>>PDESC.fBadformat then
		test kind eq kcr ifso
			break
		ifnot	loop
	let w = fcode<<FCODE.wordn+1
  // plus 1 for Pstat instead of Par
	let bn = fcode<<FCODE.bitn
	let m = 1 lshift bn
	let un = fcode<<FCODE.un
	let siz, vpa, tbp, lvfbloc, fbloc, par, dnpi = nil, nil, nil, nil, nil, nil, nil;
	switchon kind into
		[
		case kdigit:
			pDesc>>PDESC.char = char;
			num = getsintfast(num, lv char) ;
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			if vfb ge #170 then
				[ until @nextDiskCommand eq 0 do loop
				SetVab(abmsg,mtyOw,227,50)
				fmRff ! pidAty = atyFbo
				resultis tcAbort
				] 
			MakeRun(fmRff, num, pDesc>>PDESC.look1, pDesc>>PDESC.look2);
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			goto skipgetchar;

		case kcr:
			break

		case klook1:
			pDesc>>PDESC.look1 = un ? pDesc>>PDESC.look1 & not m, pDesc>>PDESC.look1 % m
			endcase;

		case kquad:
			parastat ! w = (parastat ! w) % m
			endcase

		case koffset:
			pDesc>>PDESC.char = char;
			unless pDesc>>PDESC.fNumPending then char = $0
			num = getsintfast(num, lv char) ;
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			(lv (pDesc>>PDESC.look2))>>LOOK2.ofset = num;
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			goto skipgetchar;

		case kfun:
			pDesc>>PDESC.char = char;
			unless pDesc>>PDESC.fNumPending then char = $0
			num = getsintfast(num, lv char) ;
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			(lv (pDesc>>PDESC.look2))>>LOOK2.fun = num;
			dnfun ! num = true;
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			goto skipgetchar;

		case kmeasure:
			pDesc>>PDESC.char = char;
			unless pDesc>>PDESC.fNumPending then char = $0
			num = getsintfast(num, lv char)/mphd
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			unless pDesc>>PDESC.char eq $p then
				parastat ! w = num
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			goto skipgetchar;

		case kparastatterm:
			endcase;

		case klabel:
			if pDesc>>PDESC.fInLabel then
				[ errhlta(9)
//				sblabel>>lh = i;
// 				let len = sbwsize(sblabel);
// 				siz = parastat>>PSTAT.siz;
// 				move(sblabel, parastat+siz, len);
// 				parastat>>PSTAT.siz = siz+len;
				]
			pDesc>>PDESC.fInLabel = not pDesc>>PDESC.fInLabel;
// 			i = 0;
			endcase;

		case kldln:
			pDesc>>PDESC.char = char;
			unless pDesc>>PDESC.fNumPending then char = $0
			num = getsintfast(num, lv char) ;
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			parastat>>PSTAT.lead = num;
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			goto skipgetchar;

		case kldhdr:
			pDesc>>PDESC.char = char;
			unless pDesc>>PDESC.fNumPending then char = $0
			num = getsintfast(num, lv char) ;
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			parastat>>PSTAT.parspacing = num;
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			goto skipgetchar;

		case kitb:
			pDesc>>PDESC.char = char;
			unless pDesc>>PDESC.fNumPending then char = $0
			num = getsintfast(num, lv char) ;
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			if char eq $) then
				[
				vdxtb = num
				vfOldtab = true
				num = 0;
				pDesc>>PDESC.fNumPending = false;
				endcase
				]
			pDesc>>PDESC.itb = num
			pDesc>>PDESC.fGotItb = true
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			goto skipgetchar;

		case kxtb:
			unless pDesc>>PDESC.fGotItb do
				goto badformat
			pDesc>>PDESC.char = char;
			unless pDesc>>PDESC.fNumPending then char = $0
			num = getsintfast(num, lv char) ;
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			itb = pDesc>>PDESC.itb
			if itb ls 0 % itb ge itbMax then errhlta(10)
			if mpitbxtb ! itb ne num then
				[
				mpitbxtb ! itb = num
				if itb ge ttbl>>TTBL.cw-1 then
					ttbl>>TTBL.cw = itb + 2
				vfNewtable = true
				]
			pDesc>>PDESC.fGotItb = false
			vfOldtab = false
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			if char ne $) then
				goto badformat
			endcase

		case ktab:
//			if vfOldtab then
//				goto badformat
			pDesc>>PDESC.char = char;
			unless pDesc>>PDESC.fNumPending then char = $0
			num = getsintfast(num, lv char);
			if (char eq -1) do
				[ pDesc>>PDESC.fNumPending = true;
				loop;
				]
			(lv (pDesc>>PDESC.look2))>>LOOK2.tc = num
			num = 0;
			pDesc>>PDESC.fNumPending = false;
			goto skipgetchar;

badformat:	default:
			test pDesc>>PDESC.fInLabel ifso
				[ errhlta(11);
				]
			ifnot unless char eq chsp do
				[ 
				pDesc>>PDESC.fBadformat = true
				loop
				]
		]
	] repeat
fmRff ! pidChRemain = fmRff ! pidChRemain-chRemainOld+vchremain
unless fmRff ! pidFcTrailer eq mpfrfc ! vmacfr do
	MakeRun(fmRff, fmRff ! pidFcTrailer - mpfrfc ! vmacfr,
		pDesc>>PDESC.look1, pDesc>>PDESC.look2);
MakeParastat(fmRff, pDesc>>PDESC.look1, pDesc>>PDESC.look2);
(zone>>CBZ.extra)>>SCP.TcScanProc = TcFileParser
let tfc = FcOfBuf(fmRff)
if pDesc>>PDESC.fBadformat then
	[
	let cpar = fmRff ! pidCparBadformat
	if cpar eq 0 then
		[
		setsel(selmain, fmRff ! pidFcFirst, tfc - 1)
		selmain>>SEL.type = sph
		]
	fmRff ! pidCparBadformat = cpar + 1
	]
fmRff ! pidFcFirst = tfc
// test ((fmRff ! pidBuf)>>BUF.numChars ne #1000) & (fmRff ! pidChRemain eq 0) ifso
// 	resultis tcDone
// ifnot	
resultis tcNotDone
]

// F T R Y G E T B U F
//
and TcTryGetBuf(zone) = valof
[ let scanParams = zone>>CBZ.extra
let fmRff = scanParams>>SCP.fmCaller
unless fmRff ! pidChRemain eq 0 then resultis tcNil
unless fmRff ! pidBuf eq 0 then
	[ if ((fmRff ! pidBuf)>>BUF.numChars ne #1000) then
		resultis tcDone
	Enqueue(scanParams>>SCP.qBufFree, fmRff ! pidBuf)
	fmRff ! pidBuf = 0
	]
let qBufRead = scanParams>>SCP.qBufRead
let cBufRead = LengthQ(qBufRead)
test cBufRead eq 0 ifso
	resultis tcToYou
ifnot	[ let buf = Dequeue(qBufRead)
	fmRff ! pidBuf = buf;
	test buf>>BUF.pgn eq 0 ifso
		[ fmRff ! pidChRemain = 0
		resultis TcTryGetBuf(zone)
		]
	ifnot	[ fmRff ! pidChRemain = buf>>BUF.numChars
		resultis tcNil
		]
	]
]

// S E T P T E R S
// 
and SetPters(fmRff) be
[ vchremain = fmRff ! pidChRemain;
let buf = fmRff ! pidBuf
if buf>>BUF.pgn eq 0 then errhlta(12)
let dFc = buf>>BUF.numChars-vchremain
vpw = fmRff ! pidBuf>>BUF.ca+(dFc rshift 1);
vlb = dFc<<odd ? false, true;
]

// E S T A N D G E T F B
//
and EstAndGetFb(fmRff) be
[ let tfc = 0;
unless vbi eq -1 do
	[ vfblast = vfbfrparlast<<FBLOC.fb-1;
	EstablishFb(fmRff)
	tfc = mpfrfc ! vmacfr;
	]
GetNextFb(tfc, fmRff);
]

// G E T N E X T F B
//
and GetNextFb(fcfirst, fmRff) be
[ let vpa = nil;
vpa<<VPA.fn = fnscrfs;
vfb = vfb+1;
if vfb ge #200 then errhlta(13);
vpa<<VPA.fp = vfb;
// vbpoffb = assignbp(vpa);
// if vbpoffb eq -1 then errhlt("nbp");
// rglastused ! vbpoffb = -1;
// remakevmtb();
// let pfb = dnbp ! vbpoffb;
let buf = Dequeue(fmRff ! pidQBufBinFree)
if buf eq 0 then
	[ if vfblast ls vfbfirst then errhlta(14)
	until @nextDiskCommand eq 0 do loop
	diskwritegroup(fnscrfs, vfbfirst, vfblast, #1000);
	for fp = vfbfirst to vfblast do
		[ let buf = Dequeue(fmRff ! pidQBufBinUsed)
		unless fp+1 eq buf>>BUF.pgn then errhlta(5)
		Enqueue(fmRff ! pidQBufBinFree, buf)
		]
	vfbfirst = vfblast+1;
	buf = Dequeue(fmRff ! pidQBufBinFree)
	if buf eq 0 then errhlta(4)
	]
buf>>BUF.pgn = vfb+1
Enqueue(fmRff ! pidQBufBinUsed, buf)
rgvpa ! (buf>>BUF.bp) = vpa
remakevmtb();
let pfb = buf>>BUF.ca
fmRff ! pidBufBin = buf
vpi = 0;
vmacfr = 0;
mpfrfc ! 0 = fcfirst;
vtop = pfb+#377;
vcfree = #400-runovhd-1-fbovhd;// minus one for dnpi ! 0
vbi = vbi+1;
]

// E S T A B L I S H F B
//
and EstablishFb(fmRff) be
[ let buf = fmRff ! pidBufBin
let pfb = buf>>BUF.ca;
pfb>>FB.macfr = vmacfr;
pfb>>FB.mpfrfc = ((offset FB.rvdnpi)/16)+vpi+1
pfb>>FB.rglook1 = pfb>>FB.mpfrfc+vmacfr+2;
pfb>>FB.rglook2 = pfb>>FB.rglook1+vmacfr+1;
move(mpfrfc, pfb+pfb>>FB.mpfrfc, vmacfr+1);
move(rglook1, pfb+pfb>>FB.rglook1, vmacfr);
move(rglook2, pfb+pfb>>FB.rglook2, vmacfr);
(rgbs ! (buf>>BUF.bp))<<BS.dirty = true;
(pfb+pfb>>FB.rglook1) ! (-1) = 0;
mpbifc ! vbi = mpfrfc ! 0;
mpbifb ! vbi = vfb;
(mpfnof ! fnscrfs)>>OF.macpos = (vfb+1) lshift 9;
]

// M A K E R U N
//
and MakeRun(fmRff, dfc, look1, look2) be
[ 
// ?? if ugt(endposplus1, vfcterm+1) then errhlt("fct")
if dfc eq 0 then errhlt("dfc")
if vcfree ls runovhd then
	EstAndGetFb(fmRff);
if ffirstrun then
	[ vbifirstrun = vbi;
	vpifirstrun = vpi;
	ffirstrun = false;
	]
look1<<LOOK1.pi = vpi;
rglook1 ! vmacfr = look1
rglook2 ! vmacfr = look2
let fc = mpfrfc ! vmacfr
vmacfr = vmacfr + 1
mpfrfc ! vmacfr = fc+dfc
vcfree = vcfree-runovhd
]

// M A K E P A R A S T A T
//
and MakeParastat(fmRff, look1, look2) be
[ 
let ttbl = fmRff ! pidTtbl
let ttblPrev = fmRff ! pidTtblPrev
let cwTtbl = 0
let siz = parastat>>PSTAT.siz - offparParastat;
if vfNewtable & not vfOldtab then
	[
	let tmpitbxtb = lv ttbl>>TTBL.ampitbxtb
	let titb = itbMax-1
	while titb ge 0 do
		[
		if tmpitbxtb ! titb ne xtbNil then break
		titb = titb - 1
		]
	cwTtbl = titb + 2
	ttbl>>TTBL.cw = cwTtbl
	siz = siz + cwTtbl
	move(ttbl, ttblPrev, lnttblMax)
	]
if (vcfree ls siz+runovhd+1) % vpi+1 ge maxpi then // plus 1 for dnpi entry
	EstAndGetFb(fmRff);
let ttblBuf = vtop + 1 - cwTtbl
vtop = vtop-siz
let vpa = nil;
let bifr = nil
bifr<<FBFR.fb = vbi;
bifr<<FBFR.fr = vmacfr;
let fcNext = FcOfBuf(fmRff)
parastat>>PSTAT.par = bifr;
parastat>>PSTAT.fcofpar = fmRff ! pidFcFirst;
parastat>>PSTAT.fcofnextpar = fcNext;
parastat>>PSTAT.trailerlength = fcNext-fmRff ! pidFcTrailer;
if parastat>>PSTAT.xleftmargf eq -1 then
	parastat>>PSTAT.xleftmargf = parastat>>PSTAT.xleftmarg
unless vfbfrparlast eq -1 then
	vparlast>>PAR.nextpar = bifr;
let fbloc = nil;
vparlast = vtop+1;
let pfb = (fmRff ! pidBufBin)>>BUF.ca;

parastat>>PSTAT.fOldtab = vfOldtab
test vfOldtab ifso
	parastat>>PSTAT.dxtb = vdxtb
ifnot
	[
	if vfNewtable then
		[
		vsiTtblprev = vfb lshift 8 + ttblBuf - pfb
		vfNewtable = false
		]
	parastat>>PSTAT.siTtbl = vsiTtblprev
	]

fbloc<<FBLOC.fb = vfb;
fbloc<<FBLOC.bw = vparlast-pfb;
let dnpi = lv (pfb>>FB.rvdnpi)
dnpi ! vpi = fbloc;
move(parastat+1, vtop+1, siz);
if cwTtbl ne 0 then
	move(ttbl, ttblBuf, cwTtbl);
vcfree = vcfree-(siz+1)
vfbfrparlast<<FBFR.fb = vfb;
vfbfrparlast<<FBFR.fr = vmacfr;
// look1 = (look1 & visimask) % trailerbits;
look1 = look1 % trailerbits;
MakeRun(fmRff, parastat>>PSTAT.trailerlength, look1, look2)
if vbi ne vbifirstrun then
	[ let tbi = vbifirstrun;
	let tpi = vpifirstrun;
		[ let pfb = getfb(mpbifb ! tbi);
		(lv (pfb>>FB.rvdnpi)) ! tpi = fbloc;
		tbi = tbi+1;
		tpi = 0;
		] repeatuntil tbi eq vbi
	]
vpi = vpi+1;
]

// F C O F B U F
//
and FcOfBuf(fmRff) = valof
[ let buf = fmRff ! pidBuf
resultis ((buf>>BUF.pgn-1) lshift 9)+(buf>>BUF.numChars-fmRff ! pidChRemain)
]

// I N I T P A R S E
//
and InitParse(fmRff) be
[
ffirstrun = true;
num = 0
move(fmRff ! pidParaStatStd, parastat, 1+parovhd)
let pDescStd = table [ 0; 0; false; false; 0; 0; false; false ]
pDescStd!0 = look1std; pDescStd!1 = look2std
move(pDescStd, fmRff ! pidPDesc, lPDesc)
sblabel ! 0 = 0;
if fmRff ! pidChRemain eq 0 then errhlta(15)
fmRff ! pidChRemain = fmRff ! pidChRemain-1
]