MBUtilities.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Sandman on 6-Aug-81 15:47:39
Lewis on 17-Sep-81 15:51:36
Levin on January 13, 1984 1:38 pm
Russ Atkinson (RRA) March 8, 1985 5:32:05 pm PST
Doug Wyatt, December 2, 1986 11:06:37 am PST
DIRECTORY
BcdDefs USING [Base, BcdBase, CTHandle, CTIndex, CTNull, CTRecord, FPHandle, FPIndex, FTIndex, FTNull, 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:
CEDAR
PROGRAM
IMPORTS BcdOps, IO, MB, MBVM, Rope
EXPORTS MB = BEGIN
ROPE: TYPE = Rope.ROPE;
data: MB.Handle ← NIL;
currentBH: MB.BHandle;
currentCti: BcdDefs.CTIndex;
currentConfig: ROPE;
InitUtilities:
PUBLIC
PROC [h:
MB.Handle] = {
data ← h;
ResetConfig[];
currentFrame ← NIL;
};
FinishUtilities:
PUBLIC
PROC = {
ResetConfig[];
data ← NIL;
};
NameToG:
PUBLIC
PROC [name:
ROPE]
RETURNS [PrincOps.GlobalFrameHandle] =
TRUSTED {
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]
RETURNS [bh: MB.BHandle, mth: BcdDefs.MTHandle] = TRUSTED {
nmth: BcdDefs.MTHandle ← NIL;
DoOneBCD:
PROC [thisBH:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
bcd: BcdDefs.BcdBase = thisBH.bcd;
CheckModule:
PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOL] = TRUSTED {
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] = {
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, s1:
ROPE, s2:
ROPE ←
NIL] =
TRUSTED {
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]
RETURNS [bh: MB.BHandle, fph: BcdDefs.FPHandle] = TRUSTED {
DoOneBCD:
PROC [thisBH:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
bcd: BcdDefs.BcdBase = (bh ← thisBH).bcd;
CheckFramePack:
PROC [fph: BcdDefs.FPHandle, fpi: BcdDefs.FPIndex]
RETURNS [BOOL] = TRUSTED {
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]
RETURNS [bh: MB.BHandle, sph: BcdDefs.SPHandle, index: CARDINAL] = TRUSTED {
DoOneBCD:
PROC [thisBH:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
bcd: BcdDefs.BcdBase = (bh ← thisBH).bcd;
CheckSpace:
PROC [sph: BcdDefs.SPHandle, spi: BcdDefs.SPIndex]
RETURNS [BOOL] = TRUSTED {
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]
RETURNS [bh: MB.BHandle, cth: BcdDefs.CTHandle] = TRUSTED {
DoOneBCD:
PROC [thisBH:
MB.BHandle]
RETURNS [found:
BOOL] =
TRUSTED {
bcd: BcdDefs.BcdBase = (bh ← thisBH).bcd;
CheckConfig:
PROC [cth: BcdDefs.CTHandle, cti: BcdDefs.CTIndex]
RETURNS [BOOL] = TRUSTED {
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]
RETURNS [bh: MB.BHandle, mth: BcdDefs.MTHandle] = TRUSTED {
DoOneBCD:
PROC [thisBH:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
bcd: BcdDefs.BcdBase = (bh ← thisBH).bcd;
mtb: BcdDefs.Base = LOOPHOLE[bcd + bcd.mtOffset];
CheckName:
PROC [nth: BcdDefs.NTHandle, nti: BcdDefs.NTIndex]
RETURNS [BOOL] = TRUSTED {
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] = TRUSTED {
ssb: BcdDefs.NameString = LOOPHOLE[bcd + bcd.ssOffset];
i: INT ← name;
GetFromNameString:
PROC
RETURNS [char:
CHAR] =
TRUSTED {
char ← ssb.string[i]; i ← i + 1};
RETURN[Rope.FromProc[ssb.size[name], GetFromNameString]]
};
RopeForFTI:
PUBLIC
PROC [bcd: BcdDefs.BcdBase, fti: BcdDefs.FTIndex]
RETURNS [ROPE] = TRUSTED {
SELECT fti
FROM
BcdDefs.FTNull => ERROR;
BcdDefs.FTSelf => RETURN[NIL];
ENDCASE => {
ftb: BcdDefs.Base = LOOPHOLE[bcd + bcd.ftOffset];
RETURN[RopeForNameRecord[bcd, ftb[fti].name]]
};
};
DoAllModules:
PUBLIC
PROC [proc:
PROC [
MB.BHandle, BcdDefs.MTHandle]
RETURNS [
BOOL]]
RETURNS [BOOL] = TRUSTED {
IF currentCti = BcdDefs.CTNull
THEN {
do all modules in all loaded BCDs
DoOneBCD:
PROC [bh:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
PassItOn:
PROC [mth: BcdDefs.MTHandle, mti: BcdDefs.MTIndex]
RETURNS [BOOL] = TRUSTED {
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] = TRUSTED {
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] = TRUSTED {
DoOneBCD:
PROC [bh:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
PassItOn:
PROC [sph: BcdDefs.SPHandle, spi: BcdDefs.SPIndex]
RETURNS [BOOL] = TRUSTED {
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] = TRUSTED {
DoOneBCD:
PROC [bh:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
PassItOn:
PROC [fph: BcdDefs.FPHandle, fpi: BcdDefs.FPIndex]
RETURNS [BOOL] = TRUSTED {
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] = TRUSTED {
DoOneBCD:
PROC [bh:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
bcd: BcdDefs.BcdBase = bh.bcd;
cth: BcdDefs.CTHandle;
FindTopLevel:
PROC [cth: BcdDefs.CTHandle, cti: BcdDefs.CTIndex]
RETURNS [BOOL] = TRUSTED {
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] = {
DoOneBCD:
PROC [bh:
MB.BHandle]
RETURNS [
BOOL] =
TRUSTED {
bcd: BcdDefs.BcdBase = bh.bcd;
cti: BcdDefs.CTIndex;
CheckConfig:
PROC [cth: BcdDefs.CTHandle, cti: BcdDefs.CTIndex]
RETURNS [BOOL] = TRUSTED {
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;
};
globalFrameWords: CARDINAL ~ SIZE[PrincOps.GlobalFrame[0]];
globalFrameSpace: ARRAY [0..globalFrameWords) OF WORD;
globalFrame: PrincOps.GlobalFrameHandle;
currentFrame: PrincOps.GlobalFrameHandle;
VirtualGlobalFrame:
PUBLIC
PROC [f: PrincOps.GlobalFrameHandle]
RETURNS [PrincOps.GlobalFrameHandle] = TRUSTED {
IF f ~= currentFrame
THEN {
MBVM.CopyRead[from: f, to: globalFrame, nwords: globalFrameWords];
currentFrame ← f;
};
RETURN[globalFrame]
};
TRUSTED { globalFrame ← LOOPHOLE[@globalFrameSpace] };
END.