
    <<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];>>
}.