// param.sr 


get "BRAVO1.DF"
get "CHAR.DF"
get "VM.DF"
get "PARAM.DF"


// Incoming Procedures

external	[
	slget
	slput
	gets
	puts
	endofs
	stcompare
	stput
	ult
	]


// Incoming Statics

external	[
	mpfnof
	char
	]


// Outgoing Procedures

external	[
	owritemacro
	FcGetParam
	FcFindLabel
	]


// O W R I T E M A C R O
//
let owritemacro(fn, sl, macro) = valof
[
let i = 0
let tchar = nil
while (i ls rv sl) do
	[
	tchar = slget(sl, i)
	test tchar eq chat ifnot
		puts(fn, tchar)
	ifso	[
		i = i+1
		if i ge rv sl then resultis false
		tchar = slget(sl, i)
		test tchar eq chat ifso
			puts(fn, tchar)
		ifnot	test (tchar le $9) & (tchar ge $0) ifso
			macro(fn, tchar-$0)
		ifnot	resultis false
		]
	i = i+1
	]
resultis true
]


// F C G E T P A R A M
//
and FcGetParam(fn, fcFirst, prm, fUc; numargs na) = valof
[
if na ls 4 then fUc = (fn eq fnuser)
let of = mpfnof ! fn
let macpos = of>>OF.macpos
of>>OF.pos = fcFirst
prm>>PRM.pt = ptNil
let cchMax = prm>>PRM.cchMax
let i = 0
let sl = nil

	[
	if endofs(fn) then
		resultis macpos
	char = gets(fn)
	switchon char into
		[
case chsp:
case chtab:
case chcr:
case $::
case $]:
case chlf:
		loop

case $/:
		prm>>PRM.pt = ptflag
		char = gets(fn)
		break

case $[:
		prm>>PRM.pt = ptname
		char = gets(fn)
		break

case $":
		prm>>PRM.pt = ptsl
		sl = lv (prm>>PRM.astr)
		until endofs(fn) do
			[
			char = gets(fn)
			test char eq chat ifso
				[
				if endofs(fn) do
					resultis false
				char = gets(fn)
				if (char ne $") & (i ls cchMax) then
					[
					slput(sl, i, chat)
					i = i+1
					]
				]
			ifnot	if char eq $" then
				[
				sl ! 0 = i
				if i ge cchMax then
					prm>>PRM.pt = ptNil
				resultis (mpfnof ! fn)>>OF.pos
				]
			if fUc & (char ge $a) & (char le $z) then
				char = char-#40
			if i ls cchMax then
				[
				slput(sl, i, char)
				i = i+1
				]
			]
		prm>>PRM.pt = ptNil
		resultis macpos

default:
		prm>>PRM.pt = ptparam
		break
		]
	] repeat

let sb = lv prm>>PRM.astr

	[
	switchon char into
		[ 
case chsp:
case chcr:
case chtab:
case $::
case $]:
case $/:
case chlf:
		break

default:
		endcase
		]
	if fUc & (char ge $a) & (char le $z) then
		char = char-#40
	if i ls cchMax then
		[
		stput(sb, i, char)
		i = i+1
		]
	if endofs(fn) then
		break
	char = gets(fn)
	] repeat

if (prm>>PRM.pt eq ptparam) & (char eq $:) then
	prm>>PRM.pt = ptlabel
sb>>lh = i
if i ge cchMax then prm>>PRM.pt = ptNil
let pos = (mpfnof ! fn)>>OF.pos
resultis (pos eq macpos) ? pos, pos-1
]


// F C   F I N D   L A B E L
//
and FcFindLabel(sb, prmVec, fn, fcFirst, sbName; numargs na) = valof
[
if na ls 3 then fcFirst = 0
if na ls 4 then sbName = 0
let fInName = (fcFirst ne 0)
let macpos = (mpfnof ! fn)>>OF.macpos

	[
	unless ult(fcFirst, macpos) do
		[
		prmVec>>PRM.pt = ptNil
		break
		]
	fcFirst = FcGetParam(fn, fcFirst, prmVec)
	if prmVec>>PRM.pt eq ptname then
		[
		if fInName then 
			[
			prmVec>>PRM.pt = ptNil
			break
			]
		if sbName & stcompare(lv prmVec>>PRM.astr, sbName) eq 0 then
			fInName = true
		]
	if fInName & (prmVec>>PRM.pt eq ptlabel) & (stcompare(lv prmVec>>PRM.astr, sb) eq 0) then
		break
	] repeat

resultis fcFirst
]