InstallationComfortsImpl.mesa
Copyright Ó 1990, 1991, 1993 by Xerox Corporation. All rights reserved.
Peter B. Kessler, May 24, 1990 2:24 pm PDT
Chauser, July 15, 1991 4:11 pm PDT
Willie-s, June 9, 1993 12:11 pm PDT
A collection of handy procedures for trekking around the mesa load state from mesa.
Michael Plass, November 22, 1991 4:05 pm PST
DIRECTORY
CStrings,
IncrementalLoad USING [LookupSymEntryByValue, SETypeMODULE, SymEntry],
InstallationComforts,
InstallationBasicComforts,
InstallationSupportPrivate,
IO,
MesaLoadState,
Rope,
UXIO,
UXStrings;
InstallationComfortsImpl: CEDAR PROGRAM
IMPORTS CStrings, IncrementalLoad, IO, MesaLoadState, Rope, UXIO, UXStrings
EXPORTS InstallationBasicComforts, InstallationComforts, InstallationSupportPrivate, MesaLoadState
~ { OPEN InstallationSupportPrivate;
Types Exported to MesaLoadState
InterfaceRecord: PUBLIC TYPE ~ InstallationSupportPrivate.InterfaceRecord;
ConfigRep: PUBLIC TYPE ~ InstallationSupportPrivate.ConfigRep;
ProgramRep: PUBLIC TYPE ~ InstallationSupportPrivate.ProgramRep;
Copied Types
ROPE: TYPE ~ Rope.ROPE;
CString: TYPE ~ CStrings.CString;
Interface: TYPE ~ InstallationSupportPrivate.Interface;
Config: TYPE ~ InstallationSupportPrivate.Config;
Program: TYPE ~ InstallationSupportPrivate.Program;
Exported to InstallationComforts
InterfaceFromConfig: PUBLIC PROC [interfaceName: ROPE, context: Config]
RETURNS [foundInterface: Interface] ~ {
cInterfaceName: CString ¬ UXStrings.Create[from: interfaceName];
EachInterface: MesaLoadState.InterfaceProc ~ {
IF foundInterface=NIL AND NOT transparent THEN {
IF CStrings.Strcmp[interface.key.name, cInterfaceName]=0 THEN {
foundInterface ¬ interface;
};
};
};
IF context=NIL THEN context ¬ MesaLoadState.GlobalConfig[];
MesaLoadState.EnumerateInterfaces[context, EachInterface];
RETURN[foundInterface];
};
ChildProgramFromConfig: PUBLIC PROC [ programName: ROPE, context: Config]
RETURNS [Program] ~ {
cProgramName: CString ¬ UXStrings.Create[from: programName];
foundProgram: Program ¬ NIL;
EachChild: MesaLoadState.ChildProc ~ {
IF foundProgram=NIL THEN {
WITH child SELECT FROM
prog: MesaLoadState.ProgramOrConfig.program => {
IF CStrings.Strcmp[prog.program.name, cProgramName]=0 THEN {
foundProgram ¬ prog.program;
};
};
ENDCASE => NULL;
};
};
IF context=NIL THEN context ¬ MesaLoadState.GlobalConfig[];
MesaLoadState.EnumerateChildren[context, EachChild];
RETURN[foundProgram];
};
ChildConfigFromConfig: PUBLIC PROC [configName: ROPE, context: Config]
RETURNS [Config] ~ {
cConfigName: CString ¬ UXStrings.Create[from: configName];
foundConfig: Config ¬ NIL;
EachChild: MesaLoadState.ChildProc ~ {
IF foundConfig=NIL THEN {
WITH child SELECT FROM
conf: MesaLoadState.ProgramOrConfig.config => {
IF CStrings.Strcmp[conf.config.name, cConfigName]=0 THEN {
foundConfig ¬ conf.config;
};
};
ENDCASE => NULL;
};
};
IF context=NIL THEN context ¬ MesaLoadState.GlobalConfig[];
MesaLoadState.EnumerateChildren[context, EachChild];
RETURN[foundConfig]
};
interfaceCount: INT ¬ 0;
ProcFromInterface: PUBLIC PROC [interface: Interface, procName: ROPE]
RETURNS [PROC ANY RETURNS ANY] ~ {
IF interface#NIL THEN {
Find and return the proc
aux: AuxInterface ¬ interface.aux;
IF ( interfaceCount ¬ interfaceCount + 1) < 3 THEN
IO.PutF1[debugStream, "**looking for %g\n", [rope[procName]] ];
FOR i: CARD IN [0..aux.nItems) DO
SELECT aux.items[i].itemTag FROM
startTrap => TRUSTED {
IF Match[ProcNameOnly[LOOPHOLE[interface.items[i], LinkItem.startTrap].trap.shadowedProc], procName] THEN RETURN[LOOPHOLE[interface.items[i], LinkItem.proc].proc];
};
bound => {
IF Match[ProcNameOnly[LOOPHOLE[interface.items[i], LinkItem.proc].proc], procName] THEN RETURN[LOOPHOLE[interface.items[i], LinkItem.proc].proc];
};
ENDCASE => NULL;
ENDLOOP;
};
IO.PutRope[debugStream, "not found\n"];
RETURN[NIL];
};
BasicProcFromNamedInterface: PUBLIC PROC [interfaceName, procName: ROPE]
RETURNS [PROC ANY RETURNS ANY] ~ {
foundInterface: Interface ~ InterfaceFromConfig[interfaceName, NIL];
RETURN[ProcFromInterface[foundInterface, procName]];
};
ProcFromNamedInterface: PUBLIC PROC [interfaceName, procName: ROPE, context: Config]
RETURNS [PROC ANY RETURNS ANY] ~ {
foundInterface: Interface ~ InterfaceFromConfig[interfaceName, context];
RETURN[ProcFromInterface[foundInterface, procName]];
};
ProcName: PUBLIC PROC [p: PROC ANY RETURNS ANY] RETURNS [ROPE] ~ {
mod: ROPE ¬ ModuleName[p];
RETURN [Rope.Cat[mod, ".", ProcNameOnly[p]]];
};
BasicProcName: PUBLIC PROC [p: PROC ANY RETURNS ANY] RETURNS [ROPE] ~ {
mod: ROPE ¬ ModuleName[p];
RETURN [Rope.Cat[mod, ".", ProcNameOnly[p]]];
};
ProcNameOnly: PROC [p: PROC ANY RETURNS ANY] RETURNS [proc: ROPE] ~ {
sym: IncrementalLoad.SymEntry;
start: INT ¬ 0;
TRUSTED {
sym ¬ IncrementalLoad.LookupSymEntryByValue[LOOPHOLE[LOOPHOLE[p, POINTER TO ProcDescriptor]­.code]];
proc ¬ UXStrings.ToRope[from: sym.name];
};
IF proc.Fetch[0] = '← THEN start ¬ 1;
proc ¬ Rope.Substr[proc, start, Rope.Index[s1: proc, pos1: start, s2: "←"]-start];
};
BasicModuleName: PUBLIC PROC [p: PROC ANY RETURNS ANY] RETURNS [ROPE] ~
{ RETURN[ModuleName[p]] };
ModuleName: PUBLIC PROC [p: PROC ANY RETURNS ANY]
RETURNS [ROPE] ~ TRUSTED {
codeP: CARD32 ¬ LOOPHOLE[LOOPHOLE[p, POINTER TO ProcDescriptor]­.code];
modEntry: IncrementalLoad.SymEntry ¬ ImproveModEntry[ILGetMatchingSymEntryByValue[NIL, codeP, IncrementalLoad.SETypeMODULE, 0, 0]]; -- the preceding "module" symbol
mod: ROPE ¬ UXStrings.ToRope[from: modEntry.name];
RETURN[Rope.Substr[mod, 0, Rope.Index[s1: mod, s2: "."]]];
};
PutProblems: PUBLIC PROC [s: IO.STREAM, problems: MesaLoadState.InstallationProblems] ~ {
lagInterface: MesaLoadState.Interface ¬ NIL;
lagItem: INT ¬ 0;
lagProgram: MesaLoadState.Program ¬ NIL;
FOR l: MesaLoadState.InstallationProblems ¬ problems, l.rest WHILE l#NIL DO
a: MesaLoadState.InstallationProblem ¬ l.first;
WITH a SELECT FROM
me: MesaLoadState.InstallationProblem.multipleExports => {
IF lagInterface#me.interface OR lagItem#me.item THEN {
IO.PutRope[s, "\n Multiple exports: "];
IO.PutRope[s, MesaLoadState.InterfaceName[me.interface]];
IO.PutF1[s, "[%g] exported from", [integer[me.item]]];
};
IO.PutF1[s, "\n %g", [rope[MesaLoadState.QualifiedName[[program[me.exporter]]]]]];
lagProgram ¬ me.exporter;
};
re: MesaLoadState.InstallationProblem.reExport => {
IF lagInterface#re.interface OR lagItem#re.item THEN {
IO.PutRope[s, "\n Re-export: "];
IO.PutRope[s, MesaLoadState.InterfaceName[re.interface]];
IO.PutF1[s, "[%g] exported from", [integer[re.item]]];
};
IO.PutF1[s, "\n %g", [rope[MesaLoadState.QualifiedName[[program[re.exporter]]]]]];
lagProgram ¬ re.exporter;
};
ui: MesaLoadState.InstallationProblem.unboundImport => {
IF lagInterface#ui.interface OR lagItem#ui.item THEN {
IO.PutRope[s, "\n Unbound imports from "];
IO.PutRope[s, MesaLoadState.InterfaceName[ui.interface]];
IO.PutF1[s, "[%g]; importer(s):", [integer[ui.item]]];
};
IO.PutF1[s, "\n %g", [rope[MesaLoadState.QualifiedName[[program[ui.importer]]]]]];
lagProgram ¬ ui.importer;
};
ivm: MesaLoadState.InstallationProblem.interfaceVersionMismatch => {
IO.PutRope[s, "\n Interface version mismatch: "];
IO.PutRope[s, MesaLoadState.InterfaceName[ivm.interface]];
lagProgram ¬ NIL;
};
tc: MesaLoadState.InstallationProblem.typeClash => {
IO.PutF[s, "\n Type clash exporting %g from %g (already exported by %g).", [rope[tc.typeName]], [rope[MesaLoadState.QualifiedName[[program[tc.now]]]]], [rope[MesaLoadState.QualifiedName[[program[tc.already]]]]] ];
lagProgram ¬ NIL;
};
ENDCASE => NULL;
lagInterface ¬ l.first.interface;
lagItem ¬ l.first.item;
ENDLOOP;
};
Exported to InstallationSupportPrivate
DefaultProblemPrinter: PUBLIC PROC [problems: InstallationProblems] ~ {
IF problems# NIL THEN {
s: IO.STREAM ~ UXIO.CreateStandardStream[output];
IO.PutRope[s, "Problems during installation:\n"];
PutProblems[s, problems];
IO.PutRope[s, "\n"];
IO.Close[s];
};
};
Utilities
ImproveModEntry: PROC [mod: IncrementalLoad.SymEntry] RETURNS [IncrementalLoad.SymEntry] ~ TRUSTED {
tempMod: IncrementalLoad.SymEntry ¬ mod;
WHILE (tempMod#NIL) AND (tempMod.value = mod.value) DO
IF LooksLikeRealName[tempMod.name] THEN RETURN [tempMod];
tempMod ¬ ILGetMatchingSymEntryByValue[tempMod, 0, IncrementalLoad.SETypeMODULE, 0, -1];
ENDLOOP;
RETURN [mod];
};
maxReasonableRun: INT = 5;
LooksLikeRealName: PROC [s: CString] RETURNS [BOOL ¬ TRUE] ~ {
r: ROPE ¬ UXStrings.ToRope[s];
numRun: INT ¬ 0;
len: INT ¬ r.Length[];
FOR i: INT IN [0..len) DO
IF r.Fetch[i] IN ['0..'9] THEN {
numRun ¬ numRun+1;
IF numRun > maxReasonableRun THEN RETURN [FALSE];
}
ELSE numRun ¬ 0;
ENDLOOP;
};
ILGetMatchingSymEntryByValue: PROC [ilse: IncrementalLoad.SymEntry, val: CARD, wantedTypes: CARD, ignoredClasses: CARD, numToSkip: INT] RETURNS [IncrementalLoad.SymEntry] ~ TRUSTED MACHINE CODE {
"XR←ILGetMatchingSymEntryByValue"
};
XRPrefix: ROPE ~ "←XR←";
Match: PROC [symName, procName: ROPE] RETURNS [BOOL ¬ FALSE] ~ {
sn: ROPE ¬ IF Rope.IsPrefix[XRPrefix, symName] THEN Rope.Substr[symName, 4] ELSE
IF symName.Fetch[0] = '← THEN Rope.Substr[symName, 1] ELSE symName;
IF interfaceCount < 3 THEN IO.PutF[debugStream, "\t%g (%g)\n", [rope[sn]], [rope[symName]] ];
RETURN[Rope.Equal[sn, procName]];
};
debugging
debugStream: IO.STREAM ¬ UXIO.CreateStandardStream[output];
}.