// domsg.sr

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


get "BRAVO1.DF"
get "CACHE.DF"
get "MSG.DF"
get "NEWMSG.DF"
get "VM.DF"


// Outgoing Procedures

external	[
	DoFop
	DoUfop
	FfsYpos
	FfsClr
	FfsUp
	FfsDown
	FfsDxtb
	FfsXtb
	FfsSameLooks
	FfsSamePar
	FfsLeftmarg
	FfsColumn
	FfsSub
//	FfsTable
	MufopFromFopi
	MufopFromFop
	]


// Outgoing Statics

external	[
	vcache
	]


// Incoming Procedures

external	[
	PlGetCache
	SiPutCache
	GetSi
	SiPut
	gets
	lockbp
	unlockbp
	move
	movec
	umin
	umax
	divmod
	mult
	ult
	max
	min
	errhlta
	]


// Incoming Statics

external	[
	mpIffFfs
	mpIffFfp
	mpfnof
	vpw
	vlb
	vchremain
	vbp
	vdxrightmarg
	vdxleftmarg
	vdxleftmargf
	vxleftmargstd
	vxrightmargstd
	vdxtbStd
	look1std
	look2std
	]


// Local Statics

static	[
	vcache
	]


// Local Structures

// structure


// D O    F O P

let DoFop(fop, plook1, plook2, par, ttbl) be
[
if fop eq fopNil then return
let mufop = vec lnmufopMin
mufop = MufopFromFop(fop, mufop)
let cw = mufop>>MUFOP.cw
let lnpl = vcache>>CACHE.lnci - offaplCi
let tpw = nil
let tlb = nil
let tchremain = nil
let tbp = nil
if cw gr lnpl then
	[
	tpw = vpw
	tlb = vlb
	tchremain = vchremain
	tbp = vbp
	lockbp(tbp)
	(mpfnof ! fnscrfs)>>OF.pos = (fop<<FOP.fopi + lnpl) lshift 1
	]
let pufop = vec lnufopMax
let iw = 1
while iw ls cw do
	[
	rv pufop = (iw ls lnpl ? mufop ! iw, gets(fnscrfs))
	iw = iw + 1
	let iff = pufop>>UFOP.iff
	for iarg = 1 to (mpIffFfp ! iff)<<FFP.carg do
		[
		pufop ! iarg = (iw ls lnpl ? mufop ! iw, gets(fnscrfs))
		iw = iw + 1
		]
	DoUfop(pufop, plook1, plook2, par, ttbl)
	]
if cw gr lnpl then
	[
	unlockbp(tbp, false)
	vpw = tpw
	vlb = tlb
	vchremain = tchremain
	]
] // end DoFop


// D O    U F O P

and DoUfop(pufop, plook1, plook2, par, ttbl) be
[
let iff = pufop>>UFOP.iff
if iff ge iffMax then errhlta(221)
let fIncrement = pufop>>UFOP.fIncrement
let ffs = mpIffFfs ! iff
let ffp = mpIffFfp ! iff
test ffp<<FFP.fProcval ifnot
	[
	let ffv = (ffp<<FFP.carg eq 0 ? pufop>>UFOP.ffv, pufop ! 1)
	SetFormatField(pufop, plook1, plook2, par, ttbl, fIncrement, ffs, ffv)
	]
ifso ffs(pufop, plook1, plook2, par, ttbl, fIncrement)
] // end DoUfop


// F F S   Y P O S

and FfsYpos(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if par eq 0 then return
let ypos = par>>PAR.ypos
if fIncrement & ypos eq -1 then return
par>>PAR.ypos = pufop ! 1 + (fIncrement ? ypos, 0)
] // end FfsYpos


// F F S   C L R

and FfsClr(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if plook1 ne 0 then
//	rv plook1 = (rv plook1 & (casebits % trailerbits)) +
//		(look1std & not (casebits % trailerbits))
	rv plook1 = (rv plook1 & trailerbits) + (look1std & not trailerbits)
if plook2 ne 0 then
	rv plook2 = (rv plook2 & tcbits) + (look2std & not tcbits)
//	rv plook2 = look2std
] // end FfsClr


// F F S   U P

and FfsUp(pufop, plook1, plook2, par, ttbl, fIncrement) be
if par ne 0 then
	SetParLevel(par, true)
// end FfsUp


// F F S   D O W N

and FfsDown(pufop, plook1, plook2, par, ttbl, fIncrement) be
if par ne 0 then
	SetParLevel(par, false)
// end FfsDown


// S E T   P A R   L E V E L

and SetParLevel(par, fUp) be
[
let dxrightmarg = fUp ? -vdxrightmarg, vdxrightmarg;
let dxleftmarg = fUp ? vdxleftmarg, -vdxleftmarg;
let xleftmarg = max(par>>PAR.xleftmarg+dxleftmarg, 0);
let xleftmargf = max(par>>PAR.xleftmargf+dxleftmarg, 0);
par>>PAR.xrightmarg = max(par>>PAR.xrightmarg+dxrightmarg,
	max(xleftmarg+vdxleftmarg, xleftmargf+vdxleftmarg));
par>>PAR.xleftmarg = xleftmarg;
par>>PAR.xleftmargf = xleftmargf;
] // end SetParLevel


// F F S   D X T B

and FfsDxtb(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if par eq 0 then return
let dxtb = par>>PAR.fOldtab ? par>>PAR.dxtb, vdxtbStd
par>>PAR.fOldtab = true
par>>PAR.dxtb = pufop ! 1 + (fIncrement ? dxtb, 0)
] // end FfsDxtb


// F F S   X T B

and FfsXtb(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if par eq 0 then return
if ttbl eq 0 then errhlta(222)
let mpitbxtb = lv ttbl>>TTBL.ampitbxtb
if par>>PAR.fOldtab then
	[
	movec(mpitbxtb, mpitbxtb+itbMax-1, xtbNil)
	ttbl>>TTBL.cw = 1
	par>>PAR.siTtbl = siTtblNil
	par>>PAR.fOldtab = false
	]
let itb = pufop>>UFOP.ffv
if itb ge itbMax then errhlta(223)
let xtb = itb ls ttbl>>TTBL.cw-1 ? mpitbxtb ! itb, xtbNil
if fIncrement & xtb eq xtbNil then return
mpitbxtb ! itb = pufop ! 1 + (fIncrement ? xtb, 0)
ttbl>>TTBL.cw = max(ttbl>>TTBL.cw, itb+2)
] // end FfsXtb


// F F S   S A M E   L O O K S

and FfsSameLooks(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if plook1 ne 0 then
//	rv plook1 = (rv plook1 & (casebits % trailerbits)) +
//		(pufop ! 1 & not (casebits % trailerbits))
	rv plook1 = (rv plook1 & trailerbits) + (pufop ! 1 & not trailerbits)
if plook2 ne 0 then
	rv plook2 = (rv plook2 & tcbits) + (pufop ! 2 & not tcbits)
//	rv plook2 = pufop ! 2
] // end FfsSameLooks


// F F S   S A M E   P A R

and FfsSamePar(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if par eq 0 then return
let tpl = vec parovhd+1
GetSi(tpl, pufop ! 1, parovhd+1)
move(tpl+1, par, parovhd)
unless par>>PAR.fOldtab do
	[
	if ttbl eq 0 then errhlta(224)
	let siTtbl = par>>PAR.siTtbl
	if siTtbl eq siTtblNil then errhlta(225)
	GetSi(ttbl, siTtbl, lnttblMax)
	movec(ttbl+ttbl>>TTBL.cw, ttbl+offampTtbl+itbMax-1, xtbNil)
	]
] // end FfsSamePar


// F F S   L E F T M A R G

and FfsLeftmarg(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if par eq 0 then return
par>>PAR.xleftmarg = pufop ! 1 + (fIncrement ? par>>PAR.xleftmarg, 0)
par>>PAR.xleftmargf = pufop ! 2 + (fIncrement ? par>>PAR.xleftmargf, 0)
] // end FfsLeftmarg


// F F S   C O L U M N

and FfsColumn(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if par eq 0 % par>>PAR.control then return
// par>>PAR.xrightmarg = umin(par>>PAR.xrightmarg, pufop ! 1)
// par>>PAR.xleftmarg = umax(par>>PAR.xleftmarg, pufop ! 2)
// par>>PAR.xleftmargf = umax(par>>PAR.xleftmargf, pufop ! 2)
par>>PAR.xrightmarg = pufop ! 1 + par>>PAR.xrightmarg - vxrightmargstd
par>>PAR.xleftmarg = max(0, pufop ! 2 + par>>PAR.xleftmarg - vxleftmargstd)
par>>PAR.xleftmargf = max(0, pufop ! 2 + par>>PAR.xleftmargf - vxleftmargstd)
] // end FfsColumn


// F F S   S U B

and FfsSub(pufop, plook1, plook2, par, ttbl, fIncrement) be
[
if plook2 ne 0 then
	plook2>>LOOK2.ofset = -(pufop ! 1) + (fIncrement ? plook2>>LOOK2.ofset, 0)
] // end FfsSub


// F F S   T A B L E
// 
// and FfsTable(pufop, plook1, plook2, par, ttbl, fIncrement) be
// [
// if par eq 0 then return
// par>>PAR.tab = pufop ! 1
// if par>>PAR.fOldtab then return
// if ttbl eq 0 then errhlta(226)
// let mpitbxtb = lv ttbl>>TTBL.ampitbxtb
// let tcw = ttbl>>TTBL.cw
// let txtb = mpitbxtb ! 0
// GetSi(ttbl, par>>PAR.siTtbl, lnttblMax)
// if fIncrement then
// 	[
// 	ttbl>>TTBL.cw = max(ttbl>>TTBL.cw, tcw)
// 	mpitbxtb ! 0 = txtb
// 	]
// ] end FfsTable


// S E T   F O R M A T   F I E L D

and SetFormatField(pufop, plook1, plook2, par, ttbl, fIncrement, ffs, ffv) be
[
let pw = selecton ffs<<FFS.iw into
		[
case iwLook1:	plook1
case iwLook2:	plook2
default:		(par ? lv par ! (ffs<<FFS.iw - iwMinpar), 0)
		]
if pw eq 0 then return
let offbitRt = ffs<<FFS.offbitRt
let cbit = ffs<<FFS.cbit
if cbit + offbitRt gr 16 then errhlta(227)
if cbit eq 16 then
	[
	rv pw = ffv + (fIncrement ? rv pw, 0)
	return
	]
let mask = (1 lshift cbit) - 1
if fIncrement then
	[
	ffv = ffv + ((rv pw rshift offbitRt) & mask)
	unless pufop>>UFOP.iff eq iffSuper do
		ffv = max(min(ffv, mask), 0)
	]
mask = mask lshift offbitRt
rv pw  = (rv pw & not mask) + (ffv lshift offbitRt & mask)
] // end SetFormatField


// M U F O P   F R O M   F O P I

and MufopFromFopi(fopi, mufop, cwMax; numargs carg) = valof
[
let tmufop = PlGetCache(vcache, fopi)
if carg eq 1 then resultis tmufop
if carg ne 3 then errhlta(228)
let lnpl = vcache>>CACHE.lnci - offaplCi
let cwMove = umin(tmufop>>MUFOP.cw, cwMax)
move(tmufop, mufop, umin(cwMove, lnpl))
if cwMove gr lnpl then
	[
	(mpfnof ! fnscrfs)>>OF.pos = (fopi + lnpl) lshift 1
	for iw = lnpl to cwMove-1 do
		mufop ! iw = gets(fnscrfs)
	]
resultis mufop
] // end MufopFromFopi


// M U F O P   F R O M   F O P

and MufopFromFop(fop, mufop, cwMax; numargs carg) = valof
[
if carg ls 2 then errhlta(229)
if fop eq fopNil then
	[
	mufop>>MUFOP.cw = 1
	resultis mufop
	]
if fop<<FOP.fIndirect then
	resultis (carg ls 3 ? MufopFromFopi(fop<<FOP.fopi),
		MufopFromFopi(fop<<FOP.fopi, mufop, cwMax))
mufop>>MUFOP.cw = 2
mufop>>MUFOP.ufop = fop
resultis mufop
] // end MufopFromFop