MBUtilities.mesa
Edited by Sandman on 6-Aug-81 15:47:39
Edited by Lewis on 17-Sep-81 15:51:36
Edited by Levin on April 5, 1983 3:51 pm
DIRECTORY
Ascii USING [SP],
BcdDefs USING [Base, CTIndex, CTNull, FPIndex, GFTIndex, MTIndex, NTIndex, SPIndex],
BcdOps USING [
BcdBase, CTHandle, FPHandle, MTHandle, NameString, NTHandle, ProcessConfigs, ProcessFramePacks, ProcessModules, ProcessNames, ProcessSpaces, SPHandle],
LongString USING [EqualSubStrings, SubStringDescriptor],
MB USING [Abort, BHandle, BIndex, Handle],
MBTTY USING [Handle, PutCR, PutChar, PutString],
MBVM USING [CopyRead],
PrincOps USING [GlobalFrame, GlobalFrameHandle];
MBUtilities: PROGRAM
IMPORTS BcdOps, MB, MBTTY, MBVM, String: LongString
EXPORTS MB =
BEGIN
SubStringDescriptor: TYPE = String.SubStringDescriptor;
data: MB.Handle ← NIL;
mainBcd: MB.BHandle ← NIL;
currentBH: MB.BHandle;
currentCti: BcdDefs.CTIndex;
currentConfig: LONG STRING;
InitUtilities: PUBLIC PROC [h: MB.Handle] = {
data ← h;
ResetConfig[];
currentFrame ← NIL;
};
FinishUtilities: PUBLIC PROC = {data ← NIL};
NameToG: PUBLIC PROC [name: LONG STRING] RETURNS [PrincOps.GlobalFrameHandle] = {
bh: MB.BHandle;
mth: BcdOps.MTHandle;
[bh, mth] ← NameToMTHandle[name];
RETURN[IF mth ~= NIL THEN bh.mt[mth.gfi].frame ELSE NIL]
};
NameToMTHandle: PUBLIC PROC [name: LONG STRING]
RETURNS [bh: MB.BHandle, mth: BcdOps.MTHandle] = {
ss: SubStringDescriptor ← [base: name, offset: 0, length: name.length];
nmth: BcdOps.MTHandle ← NIL;
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdOps.BcdBase = thisBH.bcd;
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
bname: SubStringDescriptor;
CheckModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOL] = {
IF currentCti ~= BcdDefs.CTNull AND
(currentBH ~= thisBH OR mth.config ~= currentCti) THEN RETURN[FALSE];
IF mth.namedInstance THEN RETURN[FALSE];
bname.offset ← mth.name;
bname.length ← ssb.size[mth.name];
IF String.EqualSubStrings[@ss, @bname] THEN
IF nmth = NIL THEN {bh ← thisBH; nmth ← mth}
ELSE AmbiguousName[name: name];
RETURN[FALSE]
};
bname.base ← @ssb.string;
[] ← BcdOps.ProcessModules[bcd, CheckModule];
RETURN[FALSE]
};
[] ← DoAllBCDs[DoOneBCD];
IF (mth ← nmth) ~= NIL THEN RETURN;
SearchError[thing: "module"L, s1: name];
RETURN[NIL, NIL]
};
AmbiguousName: PROC [name: LONG STRING] = {
OPEN MBTTY;
tty: MBTTY.Handle = data.ttyHandle;
PutCR[tty];
PutString[tty, "!Ambiguous name "L];
IF currentConfig ~= NIL THEN {PutString[tty, currentConfig]; PutChar[tty, '[]};
PutString[tty, name];
IF currentConfig ~= NIL THEN PutChar[tty, ']];
PutCR[tty];
SIGNAL MB.Abort;
};
SearchError: PROC [thing: LONG STRING, s1: LONG STRING, s2: LONG STRING ← NIL] = {
OPEN MBTTY;
tty: MBTTY.Handle = data.ttyHandle;
don't give error message if not all BCDs have been loaded.
IF data.inputBCDs.bcds[data.inputBCDs.nBcds-1].bcd = NIL THEN RETURN;
PutCR[tty];
PutString[tty, "!Can't find "L];
PutString[tty, thing]; PutChar[tty, Ascii.SP];
IF currentConfig ~= NIL THEN {PutString[tty, currentConfig]; PutChar[tty, '[]};
PutString[tty, s1];
IF s2 ~= NIL THEN {PutChar[tty, '.]; PutString[tty, s2]};
IF currentConfig ~= NIL THEN PutChar[tty, ']];
PutCR[tty];
SIGNAL MB.Abort;
};
NameToFPHandle: PUBLIC PROC [name: LONG STRING]
RETURNS [bh: MB.BHandle, fph: BcdOps.FPHandle] = {
ss: SubStringDescriptor ← [base: name, offset: 0, length: name.length];
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdOps.BcdBase = (bh ← thisBH).bcd;
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
bname: SubStringDescriptor;
CheckFramePack: PROC [fph: BcdOps.FPHandle, fpi: BcdDefs.FPIndex] RETURNS [BOOL] = {
bname.offset ← fph.name;
bname.length ← ssb.size[fph.name];
RETURN[String.EqualSubStrings[@ss, @bname]]
};
bname.base ← @ssb.string;
RETURN[(fph ← BcdOps.ProcessFramePacks[bcd, CheckFramePack].fph) ~= NIL]
};
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "frame pack"L, s1: name];
RETURN[NIL, NIL]
};
NameToSPHandle: PUBLIC PROC [name: LONG STRING]
RETURNS [bh: MB.BHandle, sph: BcdOps.SPHandle, index: CARDINAL] = {
ss: SubStringDescriptor ← [base: name, offset: 0, length: name.length];
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdOps.BcdBase = (bh ← thisBH).bcd;
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
bname: SubStringDescriptor;
CheckSpace: PROC [sph: BcdOps.SPHandle, spi: BcdDefs.SPIndex]
RETURNS [BOOL] = {
FOR i: CARDINAL IN [0..sph.length) DO
bname.offset ← sph.spaces[i].name;
bname.length ← ssb.size[sph.spaces[i].name];
IF String.EqualSubStrings[@ss, @bname] THEN {index ← i; RETURN[TRUE]};
ENDLOOP;
RETURN[FALSE]
};
bname.base ← @ssb.string;
RETURN[(sph ← BcdOps.ProcessSpaces[bcd, CheckSpace].sph) ~= NIL]
};
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "code pack"L, s1: name];
RETURN[NIL, NIL, 0]
};
NameToCTHandle: PUBLIC PROC [name: LONG STRING]
RETURNS [bh: MB.BHandle, cth: BcdOps.CTHandle] = {
ss: SubStringDescriptor ← [base: name, offset: 0, length: name.length];
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdOps.BcdBase = (bh ← thisBH).bcd;
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
cname: SubStringDescriptor;
CheckConfig: PROC [cth: BcdOps.CTHandle, cti: BcdDefs.CTIndex]
RETURNS [BOOL] = {
cname.offset ← cth.name;
cname.length ← ssb.size[cth.name];
RETURN[String.EqualSubStrings[@ss, @cname]]
};
cname.base ← @ssb.string;
IF bcd.nConfigs = 0 THEN {
assert: bcd.nModules = 1
mth: BcdOps.MTHandle ← LOOPHOLE[bcd + bcd.mtOffset];
cname.offset ← mth.name;
cname.length ← ssb.size[mth.name];
RETURN[String.EqualSubStrings[@ss, @cname]]
}
ELSE RETURN[(cth ← BcdOps.ProcessConfigs[bcd, CheckConfig].cth) ~= NIL]
};
cth ← NIL;
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "configuration"L, s1: name];
RETURN[NIL, NIL]
};
InstanceToMTHandle: PUBLIC PROC [module, instance: LONG STRING]
RETURNS [bh: MB.BHandle, mth: BcdOps.MTHandle] = {
mss: SubStringDescriptor ← [base: module, offset: 0, length: module.length];
iss: SubStringDescriptor ← [base: instance, offset: 0, length: instance.length];
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdOps.BcdBase = (bh ← thisBH).bcd;
mtb: BcdDefs.Base = LOOPHOLE[bcd + bcd.mtOffset];
ssb: BcdOps.NameString = LOOPHOLE[bcd + bcd.ssOffset];
bname: SubStringDescriptor;
CheckName: PROC [nth: BcdOps.NTHandle, nti: BcdDefs.NTIndex] RETURNS [BOOL] = {
WITH nth.item SELECT FROM
module => {
bname.offset ← nth.name;
bname.length ← ssb.size[nth.name];
IF String.EqualSubStrings[@iss, @bname] THEN {
IF currentCti ~= BcdDefs.CTNull AND
(currentBH ~= bh OR mtb[mti].config ~= currentCti) THEN RETURN[FALSE];
bname.offset ← mtb[mti].name;
bname.length ← ssb.size[mtb[mti].name];
IF String.EqualSubStrings[@mss, @bname] THEN {
mth ← @mtb[mti];
RETURN[TRUE]
};
};
};
ENDCASE => RETURN[FALSE];
RETURN[FALSE]};
bname.base ← @ssb.string;
RETURN[BcdOps.ProcessNames[bcd, CheckName].nth ~= NIL]
};
mth ← NIL;
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "module instance"L, s1: instance, s2: module];
RETURN[NIL, NIL]
};
DoAllModules: PUBLIC PROC [proc: PROC [MB.BHandle, BcdOps.MTHandle] RETURNS [BOOL]]
RETURNS [BOOL] = {
IF currentCti = BcdDefs.CTNull THEN {
do all modules in all loaded BCDs
DoOneBCD: PROC [bh: MB.BHandle] RETURNS [BOOL] = {
PassItOn: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] RETURNS [BOOL] = {
RETURN[proc[bh, mth]]};
RETURN[BcdOps.ProcessModules[bh.bcd, PassItOn].mth ~= NIL]
};
RETURN[DoAllBCDs[DoOneBCD]]
}
ELSE {
do only modules within <currentBH.bcd, currentCti>, including subconfigurations
bcd: BcdOps.BcdBase = currentBH.bcd;
ctb: BcdDefs.Base = LOOPHOLE[bcd + bcd.ctOffset];
DoOneModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex] RETURNS [BOOL] = {
FOR cti: BcdDefs.CTIndex ← mth.config, ctb[cti].config UNTIL cti = BcdDefs.CTNull DO
IF cti = currentCti AND proc[currentBH, mth] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE]
};
RETURN[BcdOps.ProcessModules[bcd, DoOneModule].mth ~= NIL]
};
};
DoAllBCDs: PUBLIC PROC [proc: PROC [MB.BHandle] RETURNS [BOOL]] RETURNS [BOOL] = {
FOR i: MB.BIndex IN [0..data.inputBCDs.nBcds) DO
bh: MB.BHandle = data.inputBCDs.bcds[i];
IF bh.bcd ~= NIL AND proc[bh] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE]
};
DoAllSpaces: PUBLIC PROC [
proc: PROC [MB.BHandle, BcdOps.SPHandle, CARDINAL] RETURNS [BOOL]]
RETURNS [BOOL] = {
DoOneBCD: PROC [bh: MB.BHandle] RETURNS [BOOL] = {
PassItOn: PROC [sph: BcdOps.SPHandle, spi: BcdDefs.SPIndex]
RETURNS [BOOL] = {
FOR i: CARDINAL IN [0..sph.length) DO
IF proc[bh, sph, i] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE]
};
RETURN[BcdOps.ProcessSpaces[bh.bcd, PassItOn].sph ~= NIL]
};
RETURN[DoAllBCDs[DoOneBCD]]
};
DoAllFramePacks: PUBLIC PROC [
proc: PROC [MB.BHandle, BcdOps.FPHandle] RETURNS [BOOL]]
RETURNS [BOOL] = {
DoOneBCD: PROC [bh: MB.BHandle] RETURNS [BOOL] = {
PassItOn: PROC [fph: BcdOps.FPHandle, fpi: BcdDefs.FPIndex] RETURNS [BOOL] = {
RETURN[proc[bh, fph]]
};
RETURN[BcdOps.ProcessFramePacks[bh.bcd, PassItOn].fph ~= NIL]
};
RETURN[DoAllBCDs[DoOneBCD]]
};
SetConfig: PUBLIC PROC [name: LONG STRING] = {
ss: SubStringDescriptor ← [base: name, offset: 0, length: name.length];
DoOneBCD: PROC [bh: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdOps.BcdBase = bh.bcd;
ssb: BcdOps.NameString;
cti: BcdDefs.CTIndex;
bname: SubStringDescriptor;
CheckConfig: PROC [cth: BcdOps.CTHandle, cti: BcdDefs.CTIndex] RETURNS [BOOL] = {
bname.offset ← cth.name;
bname.length ← ssb.size[cth.name];
RETURN[String.EqualSubStrings[@ss, @bname]]
};
ssb ← LOOPHOLE[bcd + bcd.ssOffset];
bname.base ← @ssb.string;
IF (cti ← BcdOps.ProcessConfigs[bcd, CheckConfig].cti) ~= BcdDefs.CTNull THEN {
currentBH ← bh;
currentCti ← cti;
currentConfig ← name;
RETURN[TRUE]
};
RETURN[FALSE]
};
[] ← DoAllBCDs[DoOneBCD]
};
ResetConfig: PUBLIC PROC = {
currentBH ← NIL;
currentCti ← BcdDefs.CTNull;
currentConfig ← NIL;
};
globalFrame: PrincOps.GlobalFrame;
currentFrame: PrincOps.GlobalFrameHandle;
VirtualGlobalFrame: PUBLIC PROC [f: PrincOps.GlobalFrameHandle]
RETURNS [PrincOps.GlobalFrameHandle] = {
IF f ~= currentFrame THEN {
MBVM.CopyRead[from: f, to: @globalFrame, nwords: SIZE[PrincOps.GlobalFrame]];
currentFrame ← f;
};
RETURN[@globalFrame]
};
END.