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 May 24, 1983 10:21 am
DIRECTORY
Ascii USING [CR],
BcdDefs USING [
Base, BcdBase, CTHandle, CTIndex, CTNull, CTRecord, FPHandle, FPIndex, FTSelf, MTHandle, MTIndex, 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;
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
CheckModule: PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOL] = {
i: INT ← mth.name;
Proc: SAFE PROC RETURNS [char: CHARACTER] = TRUSTED {
char ← ssb.string[i]; i ← i + 1};
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: Rope.FromProc[ssb.size[mth.name], Proc], 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.ROPE ← NIL] = {
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.PutChar[Ascii.CR];
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;
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
CheckFramePack: PROC [fph: BcdDefs.FPHandle, fpi: BcdDefs.FPIndex] RETURNS [BOOL] = {
i: INT ← fph.name;
Proc: SAFE PROC RETURNS [char: CHARACTER] = TRUSTED {
char ← ssb.string[i]; i ← i + 1};
RETURN[Rope.Equal[s1: name, s2: Rope.FromProc[ssb.size[fph.name], Proc], 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;
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
CheckSpace: PROC [sph: BcdDefs.SPHandle, spi: BcdDefs.SPIndex] RETURNS [BOOL] = {
FOR i: CARDINAL IN [0..sph.length) DO
j: INT ← sph.spaces[i].name;
Proc: SAFE PROC RETURNS [char: CHARACTER] = TRUSTED {
char ← ssb.string[j]; j ← j + 1};
IF Rope.Equal[s1: name, s2: Rope.FromProc[ssb.size[sph.spaces[i].name], Proc], 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;
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
i: INT;
Proc: SAFE PROC RETURNS [char: CHARACTER] = TRUSTED {char ← ssb.string[i]; i ← i + 1};
CheckConfig: PROC [cth: BcdDefs.CTHandle, cti: BcdDefs.CTIndex] RETURNS [BOOL] = {
i ← cth.name;
RETURN[Rope.Equal[s1: name, s2: Rope.FromProc[ssb.size[cth.name], Proc], case: TRUE]]
};
IF bcd.nConfigs = 0 THEN {
assert: bcd.nModules = 1
mth: BcdDefs.MTHandle = LOOPHOLE[bcd + bcd.mtOffset];
i ← mth.name;
IF (found ← Rope.Equal[s1: name, s2: Rope.FromProc[ssb.size[mth.name], Proc], 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];
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
CheckName: PROC [nth: BcdDefs.NTHandle, nti: BcdDefs.NTIndex] RETURNS [BOOL] = {
WITH nth.item SELECT FROM
module => {
i: INT ← nth.name;
Proc: SAFE PROC RETURNS [char: CHARACTER] = TRUSTED {
char ← ssb.string[i]; i ← i + 1};
IF Rope.Equal[s1: instance, s2: Rope.FromProc[ssb.size[nth.name], Proc], case: TRUE] THEN {
IF currentCti ~= BcdDefs.CTNull AND
(currentBH ~= bh OR mtb[mti].config ~= currentCti) THEN RETURN[FALSE];
i ← mtb[mti].name;
IF Rope.Equal[s1: module, s2: Rope.FromProc[ssb.size[mtb[mti].name], Proc], 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]
};
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;
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
cti: BcdDefs.CTIndex;
CheckConfig: PROC [cth: BcdDefs.CTHandle, cti: BcdDefs.CTIndex] RETURNS [BOOL] = {
i: INT ← cth.name;
Proc: SAFE PROC RETURNS [char: CHARACTER] = TRUSTED {
char ← ssb.string[i]; i ← i + 1};
RETURN[Rope.Equal[s1: name, s2: Rope.FromProc[ssb.size[cth.name], Proc], case: TRUE]]
};
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.