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 November 15, 1983 10:32 am
DIRECTORY
BcdDefs USING [
Base, BcdBase, CTHandle, CTIndex, CTNull, CTRecord, FPHandle, FPIndex, FTSelf, MTHandle, MTIndex, NameRecord, NameString, NTHandle, NTIndex, SPHandle, SPIndex],
BcdOps USING [
ProcessConfigs, ProcessFramePacks, ProcessModules, ProcessNames, ProcessSpaces],
IO USING [PutChar, PutF, PutRope, rope, STREAM],
MB USING [Abort, BHandle, BIndex, Handle],
MBVM USING [CopyRead],
PrincOps USING [GlobalFrame, GlobalFrameHandle],
Rope USING [Equal, FromProc, ROPE];
MBUtilities: PROGRAM
IMPORTS BcdOps, IO, MB, MBVM, Rope
EXPORTS MB =
BEGIN
data: MB.Handle ← NIL;
currentBH: MB.BHandle;
currentCti: BcdDefs.CTIndex;
currentConfig: Rope.ROPE;
InitUtilities: PUBLIC PROC [h: MB.Handle] = {
data ← h;
ResetConfig[];
currentFrame ← NIL;
};
FinishUtilities: PUBLIC PROC = {
ResetConfig[];
data ← NIL;
};
NameToG: PUBLIC PROC [name: Rope.ROPE] RETURNS [PrincOps.GlobalFrameHandle] = {
bh: MB.BHandle;
mth: BcdDefs.MTHandle;
[bh, mth] ← NameToMTHandle[name];
RETURN[IF mth ~= NIL THEN bh.mt[mth.gfi].frame ELSE NIL]
};
NameToMTHandle: PUBLIC PROC [name: Rope.ROPE]
RETURNS [bh: MB.BHandle, mth: BcdDefs.MTHandle] = {
nmth: BcdDefs.MTHandle ← NIL;
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdDefs.BcdBase = thisBH.bcd;
CheckModule: PROC [mth: BcdDefs.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];
IF Rope.Equal[s1: name, s2: RopeForNameRecord[bcd, mth.name], case: TRUE] THEN
IF nmth = NIL THEN {bh ← thisBH; nmth ← mth}
ELSE AmbiguousName[name: name];
RETURN[FALSE]
};
[] ← BcdOps.ProcessModules[bcd, CheckModule];
RETURN[FALSE]
};
[] ← DoAllBCDs[DoOneBCD];
IF (mth ← nmth) ~= NIL THEN RETURN;
SearchError[thing: "module", s1: name];
RETURN[NIL, NIL]
};
AmbiguousName: PROC [name: Rope.ROPE] = {
typescript: IO.STREAM = data.typescript;
typescript.PutRope["\N! Ambiguous name"];
IF currentConfig ~= NIL THEN
typescript.PutF["%g[%g]\N", IO.rope[currentConfig], IO.rope[name]]
ELSE typescript.PutF["%g\N", IO.rope[name]];
SIGNAL MB.Abort;
};
SearchError: PROC [thing: Rope.ROPE, s1: Rope.ROPE, s2: Rope.ROPENIL] = {
typescript: IO.STREAM = data.typescript;
don't give error message if not all BCDs have been loaded.
IF data.inputBCDs.bcds[data.inputBCDs.nBcds-1].bcd = NIL THEN RETURN;
typescript.PutF["\N! Can't find %g '", IO.rope[thing]];
IF currentConfig ~= NIL THEN {typescript.PutF["%g[", IO.rope[currentConfig]]};
typescript.PutRope[s1]; IF s2 ~= NIL THEN typescript.PutF[".%g", IO.rope[s2]];
IF currentConfig ~= NIL THEN typescript.PutChar[']];
typescript.PutRope["'\N"];
SIGNAL MB.Abort;
};
NameToFPHandle: PUBLIC PROC [name: Rope.ROPE]
RETURNS [bh: MB.BHandle, fph: BcdDefs.FPHandle] = {
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdDefs.BcdBase = (bh ← thisBH).bcd;
CheckFramePack: PROC [fph: BcdDefs.FPHandle, fpi: BcdDefs.FPIndex] RETURNS [BOOL] = {RETURN[Rope.Equal[s1: name, s2: RopeForNameRecord[bcd, fph.name], case: TRUE]]};
RETURN[(fph ← BcdOps.ProcessFramePacks[bcd, CheckFramePack].fph) ~= NIL]
};
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "frame pack", s1: name];
RETURN[NIL, NIL]
};
NameToSPHandle: PUBLIC PROC [name: Rope.ROPE]
RETURNS [bh: MB.BHandle, sph: BcdDefs.SPHandle, index: CARDINAL] = {
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdDefs.BcdBase = (bh ← thisBH).bcd;
CheckSpace: PROC [sph: BcdDefs.SPHandle, spi: BcdDefs.SPIndex] RETURNS [BOOL] = {
FOR i: CARDINAL IN [0..sph.length) DO
IF Rope.Equal[s1: name, s2: RopeForNameRecord[bcd, sph.spaces[i].name], case: TRUE] THEN {index ← i; RETURN[TRUE]};
ENDLOOP;
RETURN[FALSE]
};
RETURN[(sph ← BcdOps.ProcessSpaces[bcd, CheckSpace].sph) ~= NIL]
};
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "code pack", s1: name];
RETURN[NIL, NIL, 0]
};
fakeCTRecord: ARRAY [0..SIZE[BcdDefs.CTRecord]+1) OF WORD;
NameToCTHandle: PUBLIC PROC [name: Rope.ROPE]
RETURNS [bh: MB.BHandle, cth: BcdDefs.CTHandle] = {
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [found: BOOL] = {
bcd: BcdDefs.BcdBase = (bh ← thisBH).bcd;
CheckConfig: PROC [cth: BcdDefs.CTHandle, cti: BcdDefs.CTIndex] RETURNS [BOOL] = {
RETURN[Rope.Equal[s1: name, s2: RopeForNameRecord[bcd, cth.name], case: TRUE]]
};
IF bcd.nConfigs = 0 THEN {
assert: bcd.nModules = 1
mth: BcdDefs.MTHandle = LOOPHOLE[bcd + bcd.mtOffset];
IF (found ← Rope.Equal[s1: name, s2: RopeForNameRecord[bcd, mth.name], case: TRUE]) THEN {
cth ← LOOPHOLE[LONG[@fakeCTRecord]];
cth^ ← [
name: mth.name,
namedInstance: FALSE,
file: BcdDefs.FTSelf,
config: BcdDefs.CTNull,
nControls: 1,
controls:
];
cth.controls[0] ← [module[mti: LOOPHOLE[0]]];
};
}
ELSE RETURN[(cth ← BcdOps.ProcessConfigs[bcd, CheckConfig].cth) ~= NIL]
};
cth ← NIL;
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "configuration", s1: name];
RETURN[NIL, NIL]
};
InstanceToMTHandle: PUBLIC PROC [module, instance: Rope.ROPE]
RETURNS [bh: MB.BHandle, mth: BcdDefs.MTHandle] = {
DoOneBCD: PROC [thisBH: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdDefs.BcdBase = (bh ← thisBH).bcd;
mtb: BcdDefs.Base = LOOPHOLE[bcd + bcd.mtOffset];
CheckName: PROC [nth: BcdDefs.NTHandle, nti: BcdDefs.NTIndex] RETURNS [BOOL] = {
WITH nth.item SELECT FROM
module => {
IF Rope.Equal[s1: instance, s2: RopeForNameRecord[bcd, nth.name], case: TRUE] THEN {
IF currentCti ~= BcdDefs.CTNull AND
(currentBH ~= bh OR mtb[mti].config ~= currentCti) THEN RETURN[FALSE];
IF Rope.Equal[s1: module, s2: RopeForNameRecord[bcd, mtb[mti].name], case: TRUE] THEN {
mth ← @mtb[mti];
RETURN[TRUE]
};
};
};
ENDCASE => RETURN[FALSE];
RETURN[FALSE]};
RETURN[BcdOps.ProcessNames[bcd, CheckName].nth ~= NIL]
};
mth ← NIL;
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "module instance", s1: instance, s2: module];
RETURN[NIL, NIL]
};
RopeForNameRecord: PUBLIC PROC [bcd: BcdDefs.BcdBase, name: BcdDefs.NameRecord]
RETURNS [Rope.ROPE] = {
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
i: INT ← name;
GetFromNameString: SAFE PROC RETURNS [char: CHAR] = TRUSTED {
char ← ssb.string[i]; i ← i + 1};
RETURN[Rope.FromProc[ssb.size[name], GetFromNameString]]
};
DoAllModules: PUBLIC PROC [proc: PROC [MB.BHandle, BcdDefs.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: BcdDefs.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: BcdDefs.BcdBase = currentBH.bcd;
ctb: BcdDefs.Base = LOOPHOLE[bcd + bcd.ctOffset];
DoOneModule: PROC [mth: BcdDefs.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, BcdDefs.SPHandle, CARDINAL] RETURNS [BOOL]]
RETURNS [BOOL] = {
DoOneBCD: PROC [bh: MB.BHandle] RETURNS [BOOL] = {
PassItOn: PROC [sph: BcdDefs.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, BcdDefs.FPHandle] RETURNS [BOOL]]
RETURNS [BOOL] = {
DoOneBCD: PROC [bh: MB.BHandle] RETURNS [BOOL] = {
PassItOn: PROC [fph: BcdDefs.FPHandle, fpi: BcdDefs.FPIndex] RETURNS [BOOL] = {
RETURN[proc[bh, fph]]
};
RETURN[BcdOps.ProcessFramePacks[bh.bcd, PassItOn].fph ~= NIL]
};
RETURN[DoAllBCDs[DoOneBCD]]
};
DoAllTopLevelConfigs: PUBLIC PROC [
proc: PROC [MB.BHandle, BcdDefs.CTHandle] RETURNS [BOOL]] RETURNS [BOOL] = {
DoOneBCD: PROC [bh: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdDefs.BcdBase = bh.bcd;
cth: BcdDefs.CTHandle;
FindTopLevel: PROC [cth: BcdDefs.CTHandle, cti: BcdDefs.CTIndex] RETURNS [BOOL] = {
RETURN[cth.config = BcdDefs.CTNull]
};
IF bcd.nConfigs = 0 THEN {
mth: BcdDefs.MTHandle = LOOPHOLE[bcd + bcd.mtOffset];
cth ← LOOPHOLE[LONG[@fakeCTRecord]];
cth^ ← [
name: mth.name,
namedInstance: FALSE,
file: BcdDefs.FTSelf,
config: BcdDefs.CTNull,
nControls: 1,
controls:
];
cth.controls[0] ← [module[mti: LOOPHOLE[0]]];
}
ELSE cth ← BcdOps.ProcessConfigs[bcd, FindTopLevel].cth;
RETURN[proc[bh, cth]]
};
RETURN[DoAllBCDs[DoOneBCD]]
};
SetConfig: PUBLIC PROC [name: Rope.ROPE] = {
DoOneBCD: PROC [bh: MB.BHandle] RETURNS [BOOL] = {
bcd: BcdDefs.BcdBase = bh.bcd;
cti: BcdDefs.CTIndex;
CheckConfig: PROC [cth: BcdDefs.CTHandle, cti: BcdDefs.CTIndex] RETURNS [BOOL] = {
RETURN[Rope.Equal[s1: name, s2: RopeForNameRecord[bcd, cth.name], case: TRUE]]
};
IF (cti ← BcdOps.ProcessConfigs[bcd, CheckConfig].cti) ~= BcdDefs.CTNull THEN {
currentBH ← bh;
currentCti ← cti;
currentConfig ← name;
RETURN[TRUE]
};
RETURN[FALSE]
};
IF DoAllBCDs[DoOneBCD] THEN RETURN;
SearchError[thing: "configuration", s1: name];
};
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.