
DIRECTORY
InstallationSupportPrivate,
MesaLoadState,
MesaLoadStateBackdoor,
MesaLoadStateQuery,
Process,
Rope,
RefTab,
RefTabBackdoor,
RuntimeError,
SafeStorage,
UXStrings;

InstallationScopesImpl: CEDAR MONITOR
IMPORTS RefTab, RefTabBackdoor, Rope, RuntimeError, UXStrings
EXPORTS MesaLoadState, MesaLoadStateBackdoor, MesaLoadStateQuery
~ BEGIN 

OPEN InstallationSupportPrivate;
InterfaceRecord: PUBLIC TYPE = InstallationSupportPrivate.InterfaceRecord;

ConfigRep: PUBLIC TYPE ~ InstallationSupportPrivate.ConfigRep;

ProgramRep: PUBLIC TYPE ~ InstallationSupportPrivate.ProgramRep;

ProgramOrConfig: TYPE ~ MesaLoadState.ProgramOrConfig;
ProgramAndConfigList: TYPE ~ MesaLoadState.ProgramAndConfigList;

InstallationProblem: TYPE ~ MesaLoadState.InstallationProblem;
InstallationProblems: TYPE ~ MesaLoadState.InstallationProblems;
ReportProc: TYPE ~ MesaLoadState.ReportProc;

TypeExport: TYPE = RECORD[
name: CString,
abstract: Type,
concrete: Type,
exporter: Program
];

TypeClash: TYPE = RECORD[
name: CString,
attempter: Program,
exporter: Program
];

TypeExports: TYPE ~ LIST OF TypeExport;
initialized: BOOL Ź FALSE;
installationScopesStarted: BOOL Ź FALSE; -- funny business for getting the start traps for this module removed
cedarCoreStarted: BOOL Ź FALSE; 
cedarCoreErrors: InstallationProblems;

installationLock: BOOL Ź FALSE; -- protects the uncommitted data structures
installationLockReleased: CONDITION;

inspectionLock: BOOL Ź FALSE; -- protects the committed data structures
inspectionLockReleased: CONDITION;

uncommittedGlobalConfig: Config;
newProgsAndConfigs: ProgramAndConfigList; -- progs and configs making up the current installation transaction
currentConfig: Config;
currentProgram: Program;
typeClashes: LIST OF TypeClash Ź NIL;
interfacesNeedingWork: LIST OF Interface;
keyInterfaceCache: Interface Ź NEW[InterfaceRecord[0]]; -- used in Lookup to avoid allocation;
typeExports: TypeExports Ź NIL;
uncommittedTypeExports: TypeExports Ź NIL;
lastUncommittedTypeExport: TypeExports Ź NIL; -- for efficient catenation;
programs: LIST OF Program Ź NIL;
globalConfig: Config;

ExternalNames: PROC [] = TRUSTED MACHINE CODE {
"^ExternalNames\n";
"BeginInstallation XR_BeginInstallation\n";
"PrepareToCommitInstallation XR_PrepareToCommitInstallation\n";
"CommitInstallation XR_CommitInstallation\n";
"AbortInstallation XR_AbortInstallation\n";
"PushScope XR_PushScope\n";
"PopScope XR_PopScope\n";
"ImportInterface XR_ImportInterface\n";
"ExportInterface XR_ExportInterface\n";
"HideNames XR_HideNames\n";
"ExportProc XR_ExportProc\n";
"ImportProc XR_ImportProc\n";
"PushRename XR_PushRename\n";
"PopRename XR_PopRename\n";
"DeclareGlobalFrame XR_DeclareGlobalFrame\n";
"StartFrame XR_Start\n";
"StartModule XR_StartModule\n";
"XRStartProgram XR_StartProgram\n";
"EnsureConfigStarted XR_StartCedarModule\n";
"FirstControl XR_FirstControl\n";
"AddControl XR_AddControl\n";
"ExportVar XR_ExportVar\n";
"ExportType XR_ExportType\n";
"IsBound XR_IsBound\n";
"RaiseUnbound XR_RaiseUnbound\n";
"Unload XR_Unload\n";
"VerboseCommit XR_VerboseCommit\n";
};

Insert: PROC[i: Interface, e: Environ] ~ TRUSTED {
IF e=NIL OR i=NIL THEN ERROR;
WITH erep: e­ SELECT FROM
list => erep.list Ź CONS[i, erep.list];
reftab => [] Ź RefTab.Store[erep.tab, i, i];
ENDCASE => NULL;
};

GlobalConfig: PUBLIC PROC[] RETURNS [Config] ~ {
RETURN[globalConfig];
};

Parent: PUBLIC PROC[object: ProgramOrConfig] RETURNS [Config] ~ {
WITH object SELECT FROM
c: ProgramOrConfig.config => RETURN[c.config.parent];
p: ProgramOrConfig.program => RETURN[p.program.parent];
ENDCASE => ERROR;
};

EnumerateChildren: PUBLIC PROC[config: Config, proc: MesaLoadState.ChildProc] ~ {
FOR l: ProgramAndConfigList Ź config.contents, l.rest WHILE l#NIL DO
proc[l.first];
ENDLOOP;
};

EnumerateInterfaces: PUBLIC PROC[config: Config, proc: MesaLoadState.InterfaceProc] ~ {
MaybeMonitorEnumerateInterfaces[config, proc, TRUE]};

UnmonitoredEnumerateInterfaces: PUBLIC PROC[config: Config, proc: MesaLoadState.InterfaceProc] ~ {
MaybeMonitorEnumerateInterfaces[config, proc, FALSE]};

MaybeMonitorEnumerateInterfaces: PROC[config: Config, proc: MesaLoadState.InterfaceProc, monitor: BOOL] ~ {
EachInterface: PROC[interface: Interface] ~ {
proc[interface~interface, transparent~interface.nItems=0];
};
MaybeMonitorEnumerateEnviron[config.interfaces, EachInterface, monitor];
};

EnumerateExports: PUBLIC PROC[program: Program, proc: MesaLoadState.ExportItemProc] ~ {
FOR l: LIST OF ExportItem Ź program.exportsTo, l.rest WHILE l#NIL DO
proc[l.first.interface, l.first.item];
ENDLOOP;
};

ObjectName: PUBLIC PROC[object: ProgramOrConfig] RETURNS [Rope.ROPE] ~ {
WITH object SELECT FROM
c: ProgramOrConfig.config => RETURN[UXStrings.ToRope[c.config.name]];
p: ProgramOrConfig.program => RETURN[UXStrings.ToRope[p.program.name]];
ENDCASE => ERROR;
};

ProgramType: PUBLIC PROC[program: Program] RETURNS[SafeStorage.Type] ~ {
RETURN[program.type];
};

InterfaceName: PUBLIC PROC[interface: Interface] RETURNS [Rope.ROPE] ~ {
RETURN[UXStrings.ToRope[interface.key.name]];
};

InterfaceType: PUBLIC PROC[interface: Interface] RETURNS [SafeStorage.Type] ~ {
RETURN[interface.key.type];
};

StartFault: SIGNAL[prog: PROGRAM] ~ RuntimeError.StartFault;
UndeclaredFrame: ERROR[frame: GlobalFrame] ~ CODE;

TakeInstallationLock: ENTRY PROC[] ~ {
ENABLE UNWIND => NULL;
WHILE installationLock DO WAIT installationLockReleased ENDLOOP;
installationLock Ź TRUE;
};

GiveInstallationLock: ENTRY PROC[] ~ {
installationLock Ź FALSE;
BROADCAST installationLockReleased;
};

TakeInspectionLock: ENTRY PROC[] ~ {
ENABLE UNWIND => NULL;
WHILE inspectionLock DO WAIT inspectionLockReleased ENDLOOP;
inspectionLock Ź TRUE;
};

GiveInspectionLock: ENTRY PROC[] ~ {
inspectionLock Ź FALSE;
BROADCAST inspectionLockReleased;
};

BeginInstallation: PUBLIC PROC [] RETURNS [] ~ { -- XRŹBeginInstallation
dummy: INT Ź 1; -- for Cirio
TakeInstallationLock[];
IF NOT initialized THEN  {
globalConfig Ź NEW[ConfigRep];
globalConfig.opaque Ź TRUE;
globalConfig.started Ź TRUE;
globalConfig.interfaces Ź NEW[EnvironRep.list];
currentConfig Ź globalConfig;
uncommittedGlobalConfig Ź NEW[ConfigRep];
uncommittedGlobalConfig.opaque Ź TRUE;
uncommittedGlobalConfig.started Ź TRUE;
uncommittedGlobalConfig.interfaces Ź NEW[EnvironRep.list];
initialized Ź TRUE;
};
};

CheckInstallation: PUBLIC PROC [report: ReportProc] ~ { --  XRŹPrepareToCommitInstallation 
dummy: INT Ź 1; -- for Cirio
CheckDuplicate: PROC [interface: Interface] ~ {
IF Lookup[[interface.key.name, SafeStorage.nullType], globalConfig.interfaces].found THEN report[[interface, 0, interfaceVersionMismatch[]]];
};
EnumerateEnviron[uncommittedGlobalConfig.interfaces, CheckDuplicate];
FOR l: LIST OF Interface Ź interfacesNeedingWork, l.rest WHILE l#NIL DO
CheckInterface[l.first, report];
ENDLOOP;
FOR l: LIST OF TypeClash Ź typeClashes, l.rest WHILE l#NIL DO
report[[NIL, 0, typeClash[UXStrings.ToRope[l.first.name], l.first.attempter, l.first.exporter]]];
ENDLOOP;
};

CheckInterface: PROC [interface: Interface, report: ReportProc] ~ {  
dummy: INT Ź 1; -- for Cirio
FOR i: INT IN [0..interface.nItems) DO
WITH interface.aux.items[i] SELECT FROM
peItem: AuxItem.uncommittedProcExports => IF peItem.ue.rest#NIL OR peItem.itemTag IN [startTrap..bound] THEN {
FOR l: LIST OF UncommittedProcExport Ź peItem.ue, l.rest WHILE l#NIL DO
IF peItem.itemTag=empty THEN report[[interface, i, multipleExports[l.first.exporter]]]
ELSE report[[interface, i, reExport[l.first.exporter]]];
ENDLOOP;
};
veItem: AuxItem.uncommittedVarExport => IF veItem.uv.rest#NIL OR veItem.itemTag#empty THEN {
FOR l: LIST OF UncommittedVarExport Ź veItem.uv, l.rest WHILE l#NIL DO
IF veItem.itemTag=empty THEN report[[interface, i, multipleExports[l.first.exporter]]]
ELSE report[[interface, i, reExport[l.first.exporter]]];
ENDLOOP;
};
piItem: AuxItem.importDesired => {
FOR l: LIST OF ImportDesired Ź piItem.ui, l.rest WHILE l#NIL DO
report[[interface, i, unboundImport[l.first.importer]]]
ENDLOOP;
};
ENDCASE => NULL; 
ENDLOOP;
};

CommitInstallation: PUBLIC PROC [] RETURNS [] ~ { --  XRŹCommitInstallation 
dummy: INT Ź 1; -- for Cirio
MakeCommitted: PROC [interface: Interface] ~ {
Insert[interface, globalConfig.interfaces];
};
TakeInspectionLock[];
EnumerateEnviron[uncommittedGlobalConfig.interfaces, MakeCommitted];
EmptyInterfaces[uncommittedGlobalConfig];
FOR l: ProgramAndConfigList Ź uncommittedGlobalConfig.contents, l.rest WHILE l#NIL DO
globalConfig.contents Ź CONS[l.first, globalConfig.contents];
ENDLOOP;
uncommittedGlobalConfig.contents Ź NIL;
FOR needsWork: LIST OF Interface Ź interfacesNeedingWork, needsWork.rest WHILE needsWork#NIL DO
CommitInterface[needsWork.first];
ENDLOOP;
IF lastUncommittedTypeExport#NIL THEN {
lastUncommittedTypeExport.rest Ź typeExports;
typeExports Ź uncommittedTypeExports;
uncommittedTypeExports Ź lastUncommittedTypeExport Ź NIL;
typeClashes Ź NIL;
};
interfacesNeedingWork Ź NIL;
newProgsAndConfigs Ź NIL;
GiveInspectionLock[];
GiveInstallationLock[];
};

CommitInterface: PROC [interface: Interface] ~ {
dummy: INT Ź 1; -- for Cirio
FOR i: INT IN [0..interface.nItems) DO
CommitItem[interface, i];
ENDLOOP;
};

CommitItem: PROC [interface: Interface, i: INT] ~ {
dummy: INT Ź 1; -- for Cirio
WITH interface.aux.items[i] SELECT FROM
n: AuxItem.none => RETURN;
up: AuxItem.uncommittedProcExports => {
SELECT TRUE FROM
interface.aux.prohibitDuplicateExports AND up.itemTag IN [startTrap..bound] => NULL;
ENDCASE => {
OPEN pe~~up.ue.first;
prev: POINTER TO TrapDescriptor ~ 
IF interface.aux.items[i].itemTag = unboundTrap THEN LOOPHOLE[interface.items[i]] ELSE NIL;
interface.items[i] Ź GetStartTrap[pe.unitsOut, pe.unitsIn, pe.argsIn, pe.exporter, pe.proc];
interface.aux.items[i].itemTag Ź startTrap;
IF prev#NIL THEN TRUSTED{ prev.shadowedProc Ź LOOPHOLE[interface.items[i]] };
};
};
uv: AuxItem.uncommittedVarExport => {
SELECT TRUE FROM
interface.aux.prohibitDuplicateExports AND uv.itemTag=bound => NULL;
ENDCASE => {
interface.items[i] Ź LOOPHOLE[uv.uv.first.varPtr];
interface.aux.items[i].itemTag Ź bound;
};
};
id: AuxItem.importDesired => {
SELECT TRUE FROM
id.itemTag IN [unboundTrap..bound] => NULL;
ENDCASE => {
interface.items[i] Ź GetUnboundTrap[id.ui.first.unitsOut, id.ui.first.unitsIn, id.ui.first.argsIn];
interface.aux.items[i].itemTag Ź unboundTrap;
};
};
ENDCASE;
TRUSTED {interface.aux.items[i].uncommitted Ź none[]};
};

AbortInstallation: PUBLIC PROC [] RETURNS [] ~ { --  XRŹAbortInstallation 
dummy: INT Ź 1; -- for Cirio
EmptyInterfaces[uncommittedGlobalConfig];
FOR needsWork: LIST OF Interface Ź interfacesNeedingWork, needsWork.rest WHILE needsWork#NIL DO
AbortInterface[needsWork.first];
ENDLOOP;
interfacesNeedingWork Ź NIL;
uncommittedGlobalConfig.contents Ź NIL;
newProgsAndConfigs Ź NIL;
uncommittedTypeExports Ź lastUncommittedTypeExport Ź NIL;
typeClashes Ź NIL;
GiveInstallationLock[];
};

AbortInterface: PROC [interface: Interface] ~ {
dummy: INT Ź 1; -- for Cirio
FOR i: INT IN [0..interface.nItems) DO
AbortItem[interface, i];
ENDLOOP;
};

AbortItem: PROC [interface: Interface, i: INT] ~ {
dummy: INT Ź 1; -- for Cirio
SELECT interface.aux.items[i].auxTag FROM
none => RETURN;
ENDCASE => TRUSTED {interface.aux.items[i].uncommitted Ź none[]};
};

NewEnvironRefTab: PROC [] RETURNS [environ: Environ] ~ {
RETURN [NEW[EnvironRep Ź [reftab[tab: RefTab.Create[equal~InterfaceMatch, hash~InterfaceHash]]]]];
};

InterfaceMatch: RefTab.EqualProc ~ TRUSTED {
k1: Interface Ź LOOPHOLE[key1];
k2: Interface Ź LOOPHOLE[key2];
RETURN[KeyMatch[k1.key, k2.key]];
};

InterfaceHash: RefTab.HashProc ~ TRUSTED {
k: Interface Ź LOOPHOLE[key];
name: CString Ź k.key.name;
hash: CARD Ź 0;
i: CARD Ź 0;
WHILE name[i] # '\000 DO
hash Ź hash + ORD[name[i]];
i Ź i+1;
ENDLOOP;
RETURN[ hash ];
};

PushScope: PROC [name: CString] ~ { --  XRŹPushScope 
dummy: INT Ź 1; -- for Cirio
IF NOT initialized THEN BeginInstallation[]; -- once only;
IF currentConfig=globalConfig AND currentProgram#NIL THEN {
CommitInstallation[]; -- bogus, but until the clients are reworked to do their own commits, it's necessary.
currentProgram Ź NIL;
};
{
newScope: Config Ź NEW[ConfigRep Ź [currentConfig, name, [NIL, NIL], NIL, FALSE, IF installationScopesStarted THEN NewEnvironRefTab[] ELSE NEW[EnvironRep.list], FALSE]];
IF currentConfig=globalConfig THEN {
uncommittedGlobalConfig.contents Ź CONS[[config[newScope]], uncommittedGlobalConfig.contents]
}
ELSE currentConfig.contents Ź CONS[[config[newScope]], currentConfig.contents];
currentConfig Ź newScope;
currentProgram Ź NIL;
};
};

PopScope: PROC [] RETURNS [] ~ { -- XRŹPopScope
dummy: INT Ź 1; -- for Cirio
IF currentConfig.parent = NIL THEN ERROR;
currentConfig Ź currentConfig.parent;
currentProgram Ź NIL;
};


ImportInterface: PROC [name: CString, type: Type, size: INT] RETURNS [Interface] ~ { -- XRŹImportInterface
key: Key ~ [name, type];
RETURN [GetAnyInterface[key~key, size~size, config~currentConfig]];
};

ExportInterface: PROC [name: CString, type: Type, size: INT] RETURNS [Interface] ~ { -- XRŹExportInterface
key: Key ~ [name, type];
RETURN[ GetAnyInterface[key~key, size~size, config~currentConfig] ];
};

GetAnyInterface: PROC [key: Key, size: INT, config: Config] RETURNS [interface: Interface] ~ {
found: BOOL Ź FALSE;
IF config=globalConfig THEN [found, interface] Ź Lookup[key, uncommittedGlobalConfig.interfaces];
IF NOT found THEN [found, interface] Ź Lookup[key, config.interfaces];
SELECT TRUE FROM
config.opaque AND ~found => {
IF key.type # SafeStorage.nullType THEN {
interface Ź NewInterface[size, key];
IF config=globalConfig THEN Insert[ interface, uncommittedGlobalConfig.interfaces ]
ELSE Insert[ interface, config.interfaces ];
};
};
config.opaque AND found => 
IF interface.nItems=0 THEN RETURN [ GetAnyInterface[key, size, config.parent] ]
ELSE RETURN[ interface ];
~config.opaque AND ~found => {
Insert[ NewInterface[0, key], config.interfaces ];
RETURN [GetAnyInterface[key, size, config.parent]];
};
~config.opaque AND found => RETURN [GetAnyInterface[key, size, config.parent]];  -- Imports and Exports of the same interface from a config will cause this 
ENDCASE => NULL; 
};

HideNames: PROC [] RETURNS [] ~ { -- XRŹHideNames
dummy: INT Ź 1; -- for Cirio
currentConfig.opaque Ź TRUE;
};

NewInterface: PROC [size: INT, key: Key] RETURNS [interface: Interface] ~ {
dummy: INT Ź 1; -- for Cirio
interface Ź NEW[ InterfaceRecord[size] ];
interface.key Ź key;
IF size > 0 THEN {
interface.aux Ź NewAuxInterface[size];
interface.aux.prohibitDuplicateExports Ź FALSE;
interface.aux.unique Ź FALSE;
};
};

NewAuxInterface: PROC [size: INT] RETURNS [aux: AuxInterface] ~ TRUSTED {
dummy: INT Ź 1; -- for Cirio
aux Ź NEW[ AuxInterfaceRecord[size] ];
FOR i: INT IN [0..size) DO
aux.items[i] Ź [empty, none[]];
ENDLOOP;
};

ExportProc: PROC [interface: Interface, item: CARD, proc: PROC, unitsOut: CARD, unitsIn: CARD, argsIn: CARD] ~ TRUSTED { -- XRŹExportProc
dummy: INT Ź 1; -- for Cirio
WITH it~~interface.aux.items[item] SELECT FROM
none, importDesired => it.uncommitted Ź uncommittedProcExports[LIST[[proc, unitsOut, unitsIn, argsIn, currentProgram]]];
uncommittedProcExports => it.ue Ź CONS[[proc, unitsOut, unitsIn, argsIn, currentProgram], it.ue];
uncommittedVarExport => ERROR;
ENDCASE;
InterfaceNeedsWork[interface];
currentProgram.exportsTo Ź CONS[[interface, item], currentProgram.exportsTo];
};

ImportProc: PROC [interface: Interface, item: CARD, unitsOut: CARD, unitsIn: CARD, argsIn: CARD] ~ TRUSTED { -- XRŹImportProc
dummy: INT Ź 1; -- for Cirio
IF interface.aux.items[item].itemTag IN [startTrap..bound] THEN RETURN;
WITH it~~interface.aux.items[item] SELECT FROM
none => interface.aux.items[item].uncommitted Ź importDesired[LIST[[unitsOut, unitsIn, argsIn, currentProgram]]]; 
importDesired => it.ui Ź CONS[[unitsOut, unitsIn, argsIn, currentProgram], it.ui];
uncommittedProcExports =>  NULL;
uncommittedVarExport => ERROR;
ENDCASE;
InterfaceNeedsWork[interface];
};

ExportVar: PROC [interface: Interface, item: CARD, addr: POINTER] ~ TRUSTED { -- XRŹExportVar
dummy: INT Ź 1; -- for Cirio
WITH it~~interface.aux.items[item] SELECT FROM
none, importDesired => it.uncommitted Ź uncommittedVarExport[LIST[[addr, currentProgram]]];
uncommittedProcExports => ERROR;
uncommittedVarExport => it.uv Ź CONS[[addr, currentProgram], it.uv];
ENDCASE;
InterfaceNeedsWork[interface];
};

ExportType: PROC [typeName: CString, abstract, concrete: Type] ~ TRUSTED { -- XRŹExportType
export: TypeExports Ź FindExporter[abstract, uncommittedTypeExports];
doExport: BOOL Ź TRUE;
IF export=NIL THEN export Ź FindExporter[abstract, typeExports];
SELECT TRUE FROM
export#NIL AND export.first.concrete#concrete => {
typeClashes Ź CONS[[typeName, currentProgram, export.first.exporter], typeClashes];
};
export#NIL AND export.first.concrete=concrete => doExport Ź FALSE;
ENDCASE => NULL;
IF doExport THEN {
IF uncommittedTypeExports=NIL THEN uncommittedTypeExports Ź lastUncommittedTypeExport Ź LIST[[typeName, abstract, concrete, currentProgram]]
ELSE uncommittedTypeExports Ź CONS[[typeName, abstract, concrete, currentProgram], uncommittedTypeExports];
};
};

FindExporter: PROC [abstract: Type, list: TypeExports] RETURNS [TypeExports] ~ {
FOR l: TypeExports Ź list, l.rest WHILE l#NIL DO
IF l.first.abstract = abstract THEN RETURN[l];
ENDLOOP;
RETURN[NIL];
};

ConcreteTypeFromAbstractType: PUBLIC PROC[abstract: SafeStorage.Type] RETURNS[concrete: SafeStorage.Type] ~ {
export: TypeExports Ź FindExporter[abstract, typeExports];
IF export#NIL THEN RETURN[export.first.concrete] ELSE RETURN [SafeStorage.nullType];
};

InterfaceNeedsWork: PROC [interface: Interface] ~ {
dummy: INT Ź 1; -- for Cirio
FOR ints: LIST OF Interface Ź interfacesNeedingWork, ints.rest WHILE ints # NIL DO
IF ints.first = interface THEN RETURN;
ENDLOOP;
interfacesNeedingWork Ź CONS[interface, interfacesNeedingWork];
};

StartTrapAuxInfo: TYPE ~ RECORD[ procDesc: ProcDescriptor, exporter: Program];

GetStartTrap: PROC [unitsOut, unitsIn, argsIn: CARD, prog: Program, proc: PROC] RETURNS [LinkItem.proc] ~ TRUSTED {
original: Proc Ź LOOPHOLE[proc];
GetStartTrapCode: PROC[unitsOut, unitsIn, argsIn: CARD] RETURNS[POINTER] ~ TRUSTED MACHINE CODE {
"XR_GetStartTrap"
};
trapInfo: REF StartTrapAuxInfo ~ LOOPHOLE[NEW[StartTrapAuxInfo]];
trapInfo.procDesc Ź original­;
trapInfo.exporter Ź prog;
original­ Ź [GetStartTrapCode[unitsOut, unitsIn, argsIn], LOOPHOLE[trapInfo]];
RETURN[ LOOPHOLE[original] ];
};
 
GetUnboundTrap: PROC [unitsOut, unitsIn, argsIn: CARD] RETURNS [LinkItem.proc] ~ TRUSTED {
GetUnboundTrapCode: PROC[unitsOut, unitsIn, argsIn: CARD] RETURNS[POINTER] ~ TRUSTED MACHINE CODE {
"XR_GetUnboundTrap"
};
trapDesc: POINTER TO TrapDescriptor ~ AllocateTrapDescriptor[];
trapDesc­ Ź [[GetUnboundTrapCode[unitsOut, unitsIn, argsIn], unbound], NIL];
RETURN[ LOOPHOLE[trapDesc] ];
};
 
trapDescriptors: LIST OF REF DescriptorSegment Ź NIL;
MaxDescriptorsPerSegment: CARD = (4096/BYTES[TrapDescriptor]) - 4;
DescriptorSegment:  TYPE ~ ARRAY [0..MaxDescriptorsPerSegment) OF TrapDescriptor;
nextDescriptor: CARD Ź 0;


AllocateTrapDescriptor: PROC [] RETURNS [d: POINTER TO TrapDescriptor] ~ {
IF trapDescriptors=NIL OR nextDescriptor=MaxDescriptorsPerSegment THEN {
trapDescriptors Ź CONS[NEW[DescriptorSegment], trapDescriptors];
nextDescriptor Ź 0;
};
TRUSTED { d Ź @(trapDescriptors.first[nextDescriptor]) };
nextDescriptor Ź nextDescriptor.SUCC;
};

Lookup: PROC [ key: Key, e: Environ ] RETURNS [found: BOOL, interface: Interface] ~ {
WITH e­ SELECT FROM
listrep: EnvironRep.list => {
FOR l: LIST OF Interface Ź listrep.list, l.rest WHILE l#NIL DO
IF KeyMatch[l.first.key, key] THEN RETURN[TRUE, l.first]; 
ENDLOOP;
RETURN[FALSE, NIL];
};
tabrep: EnvironRep.reftab => TRUSTED {
found: BOOL;
interface: REF;
keyInterfaceCache.key Ź key;
[found, interface] Ź RefTab.Fetch[tabrep.tab, keyInterfaceCache];
RETURN[found, LOOPHOLE[interface]];
};
ENDCASE;
RETURN[FALSE, NIL];
};

EnumerateEnviron: PROC [e: Environ, p: PROC[interface: Interface]] ~ {
MaybeMonitorEnumerateEnviron[e, p, TRUE]};

MaybeMonitorEnumerateEnviron: PROC [e: Environ, p: PROC[interface: Interface], monitor: BOOL] ~ {
WITH e­ SELECT FROM
listrep: EnvironRep.list => {
FOR l: LIST OF Interface Ź listrep.list, l.rest WHILE l#NIL DO
p[l.first]; 
ENDLOOP;
};
tabrep: EnvironRep.reftab => {
EachPair: RefTab.EachPairAction ~ TRUSTED {
p[LOOPHOLE[val]];
};
[] Ź (IF monitor THEN RefTab.Pairs ELSE RefTabBackdoor.UnmonitoredPairs)[tabrep.tab, EachPair];
};
ENDCASE => NULL;
};
EmptyInterfaces: PROC[ config: Config ] ~ TRUSTED {
WITH erep: config.interfaces­ SELECT FROM
list => erep.list Ź NIL;
reftab => RefTab.Erase[erep.tab];
ENDCASE => NULL;
};

KeyMatch: PROC[ k1, k2: Key ] RETURNS [BOOL] ~ {
dummy: INT Ź 1; -- for Cirio
IF strcmp[k1.name, k2.name]#0 THEN RETURN[FALSE];
IF k1.type=SafeStorage.nullType OR k2.type=SafeStorage.nullType THEN RETURN[TRUE];
RETURN[k1.type=k2.type];
};

strcmp: PROC [s1, s2: CString] RETURNS[INT] ~ TRUSTED MACHINE CODE {
"strcmp"
};

PushRename: PROC [] RETURNS [] ~ { -- XRŹPushRename 
NULL;
};

PopRename: PROC [] RETURNS [] ~ { -- XRŹPopRename 
NULL
};


DeclareGlobalFrame: PROC [name: CString, frame: GlobalFrame, type: Type, main: PROC]  ~ { -- XRŹDeclareGlobalFrame 
IF currentConfig=globalConfig AND currentProgram#NIL THEN CommitInstallation[]; -- bogus but necessary 'til clients are fixed;
{
program: Program ~ NEW[ProgramRep Ź [name, frame, type, main, currentConfig, NIL, FALSE]];
IF currentConfig=globalConfig THEN uncommittedGlobalConfig.contents Ź CONS[[program[program]], uncommittedGlobalConfig.contents]
ELSE currentConfig.contents Ź CONS[[program[program]], currentConfig.contents];
programs Ź CONS[program, programs];
currentProgram Ź program;
};
};

ProgramFromFrame: PROC  [frame: GlobalFrame] RETURNS[Program] ~ {
dummy: INT Ź 1; -- for Cirio
FOR l: LIST OF Program Ź programs, l.rest WHILE l#NIL DO
IF l.first.frame = frame THEN RETURN[l.first];
ENDLOOP;
RETURN[NIL];
};

DoStartConfig: PROC [config: Config] ~ { 
dummy: INT Ź 1;
config.started Ź TRUE;
FOR l: ProgramAndConfigList Ź config.controlModule.first, l.rest WHILE l#NIL DO
WITH l.first SELECT FROM
config: ProgramOrConfig.config => DoStartConfig[config.config];
program: ProgramOrConfig.program => DoStartProgram[program.program];
ENDCASE => ERROR;
ENDLOOP;
};

DoStartProgram: PROC [program: Program] ~ {
startedInstallationScopes: BOOL Ź installationScopesStarted;
IF program.started THEN RETURN;
IF FixStartTraps[program] THEN {
program.main[];
startedInstallationScopes Ź (startedInstallationScopes#installationScopesStarted);
IF startedInstallationScopes THEN [] Ź FixStartTraps[program];
};
};

startOrder: LIST OF Program Ź NIL;
ListStartOrder: <<DEBUGGER>> PROC RETURNS [list: LIST OF Rope.ROPE Ź NIL] ~ {
FOR tail: LIST OF Program Ź startOrder, tail.rest UNTIL tail = NIL DO
list Ź CONS[QualifiedName[[program[tail.first]]], list];
ENDLOOP;
};

FixStartTraps: ENTRY PROC [program: Program] RETURNS [doStart: BOOL] ~ {
doStart Ź NOT program.started;
program.started Ź TRUE;

FOR l: LIST OF ExportItem Ź program.exportsTo, l.rest WHILE l#NIL DO
int: Interface ~ l.first.interface;
item: INT ~  l.first.item;
{
IF int.aux.items[item].itemTag = startTrap THEN TRUSTED {
t: POINTER TO ProcDescriptor Ź LOOPHOLE[int.items[item]];
trapInfo: REF StartTrapAuxInfo Ź NARROW[LOOPHOLE[t.linkInfo, REF]];
IF trapInfo.exporter = program THEN {
t­ Ź trapInfo.procDesc;
int.aux.items[item].itemTag Ź bound;
};
}; 
};
ENDLOOP;
IF doStart THEN startOrder Ź CONS[program, startOrder];
};


EnsureConfigStarted: PROC [config: Config] ~ { -- XRŹStartCedarModule
IF config=NIL THEN RETURN;
IF config.started THEN RETURN;
IF cedarCoreStarted THEN {
EnsureConfigStarted[config.parent];
IF config.started THEN RETURN;
}
ELSE cedarCoreStarted Ź TRUE;
DoStartConfig[config];
};

StartFrame: PROC [frame: GlobalFrame]  ~ { -- XRŹStart 
IF frame=NIL THEN RETURN;
{
program: Program Ź ProgramFromFrame[frame];
IF program=NIL THEN ERROR UndeclaredFrame[frame];
IF program.started THEN ERROR StartFault[LOOPHOLE[program]];
StartProgram[program];
};
};

StartModule: PROC [args: POINTER, frame: GlobalFrame, rets: POINTER]  ~ { -- XRŹStartModule 
StartFrame[frame];
};

startTrapped: LIST OF Program Ź NIL;
ListStartTraps: <<DEBUGGER>> PROC RETURNS [list: LIST OF Rope.ROPE Ź NIL] ~ {
FOR tail: LIST OF Program Ź startTrapped, tail.rest UNTIL tail = NIL DO
list Ź CONS[QualifiedName[[program[tail.first]]], list];
ENDLOOP;
};

LogStartTrap: ENTRY PROC [program: Program] ~ {
startTrapped Ź CONS[program, startTrapped];
};

XRStartProgram: PROC [program: Program] ~ { -- XR_StartProgram
LogStartTrap[program];
StartProgram[program];
};

StartProgram: PROC [program: Program] ~ { -- XRŹStartProgram
IF currentConfig=globalConfig AND currentProgram#NIL THEN { -- bogus auto-commit until clients are fixed;
CommitInstallation[];
currentProgram Ź NIL;
};

EnsureConfigStarted[program.parent];
IF program.started THEN RETURN;
DoStartProgram[program];
};

FirstControl: PROC [] RETURNS [Config] ~ { -- XRŹFirstControl
dummy: INT Ź 1; -- for Cirio
RETURN[currentConfig];
};

AddToCM: PROC [item: ProgramOrConfig] ~ { 
dummy: INT Ź 1; -- for Cirio
IF currentConfig.controlModule.first = NIL THEN {
currentConfig.controlModule.first Ź LIST[item];
currentConfig.controlModule.last Ź currentConfig.controlModule.first
}
ELSE {
currentConfig.controlModule.last.rest Ź LIST[item];
currentConfig.controlModule.last Ź currentConfig.controlModule.last.rest;
};
};

AddControl: PROC [name: CString] ~ { -- XRŹAddControl 
itemName: CString;
FOR l: ProgramAndConfigList Ź currentConfig.contents, l.rest WHILE l#NIL DO
WITH l.first SELECT FROM
program: ProgramOrConfig.program => itemName Ź program.program.name;
config: ProgramOrConfig.config => itemName Ź config.config.name;
ENDCASE;
IF strcmp[itemName, name]=0 THEN {
AddToCM[l.first];
EXIT
};
ENDLOOP;
};

RaiseUnbound: PROC [p: PROC ANY RETURNS ANY] ~ TRUSTED { -- XRŹRaiseUnbound
newProc: PROC ANY RETURNS ANY Ź SIGNAL RuntimeError.UnboundProcedureFault[p];
r: REF TrapDescriptor Ź NARROW[LOOPHOLE[p]];
r.procDesc Ź LOOPHOLE[newProc, Proc]­;
};

IsBound: PROC [p: PROC ANY RETURNS ANY] RETURNS [BOOL] ~ TRUSTED { --XRŹIsBound
t: Proc Ź LOOPHOLE[p];
IF t=NIL THEN RETURN[FALSE];
IF t.linkInfo=unbound THEN RETURN[FALSE];
RETURN[TRUE];
};

Unload: PROC [config: Config] RETURNS [] ~ { -- XRŹUnload
ERROR;
};

CedarCoreReport: ReportProc ~ {
cedarCoreErrors Ź CONS[problem, cedarCoreErrors];
};

QualifiedName: PUBLIC PROC [pc: MesaLoadState.ProgramOrConfig] RETURNS [Rope.ROPE] ~ {
WITH pc SELECT FROM
p: MesaLoadState.ProgramOrConfig.program => {
RETURN[Rope.Concat[QualifiedName[[config[p.program.parent]]], UXStrings.ToRope[p.program.name]]];
};
c: MesaLoadState.ProgramOrConfig.config => {
IF c.config=globalConfig THEN RETURN[NIL] 
ELSE RETURN[Rope.Cat[QualifiedName[[config[c.config.parent]]],  UXStrings.ToRope[c.config.name], Rope.FromChar['.]]];
};
ENDCASE => RETURN[NIL];
};

ProgramListFromName: PUBLIC PROC[name: Rope.ROPE, optionalList: LIST OF Program Ź NIL]
RETURNS[LIST OF Program] ~ {
makeCopy: BOOL ~ optionalList = NIL;
copy, copyTail: LIST OF Program Ź NIL;
cName: CString ~ UXStrings.Create[name];
start: LIST OF Program Ź programs;
IF optionalList # NIL THEN {
IF strcmp[cName, optionalList.first.name] = 0 THEN optionalList Ź optionalList.rest;
IF optionalList = NIL THEN RETURN[NIL];
start Ź optionalList;
};
FOR p: LIST OF Program Ź start, p.rest UNTIL p = NIL DO
IF strcmp[cName, p.first.name] = 0 THEN RETURN[p];
ENDLOOP;
RETURN[NIL];
};

ConvertToRefTab: PROC [] ~ {
TakeInstallationLock[];
TakeInspectionLock[];
WITH globalConfig.interfaces­ SELECT FROM
elist: EnvironRep.list => {
lsave: LIST OF Interface Ź elist.list;
tab: RefTab.Ref Ź RefTab.Create[equal~InterfaceMatch, hash~InterfaceHash];
FOR l: LIST OF Interface Ź lsave, l.rest WHILE l#NIL DO
[] Ź RefTab.Insert[tab, l.first, l.first];
ENDLOOP;
globalConfig.interfaces Ź NEW[EnvironRep Ź [reftab[tab]]];
};
ENDCASE => NULL;
GiveInstallationLock[];
GiveInspectionLock[];
};

PutCedarCoreProblems: PROC [] RETURNS [] ~ {
};

VerboseCommit: PROC [] RETURNS [] ~ { -- XRŹVerboseCommit
problems: InstallationProblems;
RecordProblems: ReportProc ~ {
problems Ź CONS[problem, problems];
};
CheckInstallation[RecordProblems];
CommitInstallation[];
};

EnableAborts: PROC [pCondition: Process.ConditionPointer] = {
DoIt: PROC [pCondition: Process.ConditionPointer] ~ TRUSTED MACHINE CODE {
"XR_EnableAborts"
};
DoIt[pCondition];
};


CheckInstallation[CedarCoreReport];
CommitInstallation[];
ConvertToRefTab[];
TRUSTED { EnableAborts[@installationLockReleased] };
TRUSTED { EnableAborts[@inspectionLockReleased] };
ExternalNames[];
installationScopesStarted Ź TRUE;
END.
   ä  
InstallationScopesImpl.mesa
  Copyright Ó 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights reserved.
Chauser, February 13, 1991 1:00 pm PST
Willie-s, January 18, 1993 1:39 pm PST
Michael Plass, November 6, 1992 4:39 pm PST
Protocol:
Clients doing installations should bracket sequences of calls on the installation routines with BeginInstallation[]..CommitInstallation[] or BeginInstallation[]..AbortInstallation[].  Sequences ending with AbortInstallation have no effect.  Concurrent clients, each following this protocol, will be properly synchronized with one another.
Clients using the inspection procedures (enumerate?...) will not see uncommitted updates (those that would disappear were an AbortInstallation[] to occur).

Types Exported to MesaLoadState  
Types Exported to MesaLoadState  
Local Types
  
Global variables
These global variables are not monitored; they are updated only while there is but a single thread in the world.  They are used to coordinate the delicate dance of getting this module and CedarCore installed and started. 
These global variables are protected by the MONITOR lock
These global variables are protected by the Installation lock

These global variables are protected by the Inspection lock
ExternalNames
remember, nullType acts as a wild-card. The fact that the typed interface is in uncommittedGlobalConfig implies that it is not in globalConfig.  Hence, any match with the wildcard is a versionMismatch. 
walk the data structures finding out what might be wrong and reporting to the client.
walk the data structures finding out what might be wrong and reporting to the client.
move uncommitted global names to the committed data structures.  Also uncommitted interface changes to the committed interfaces.
toss the uncommitted changes in the global config and interface records.
IF currentConfig=globalConfig THEN {
CommitInstallation[]; -- bogus, but until the clients are reworked to do their own commits, it's necessary.
};
If there's going to be one, it's going to be here.
Theres's already one here; cases: transparent or not
It won't be here.
this is a real interface, not an entry denoting transparency.
Global Frame Support
Warning: calls into this module and InstallationTypesImpl prior to the time this procedure is called for the first time will allocate objects with 0 type code in them, instead of the correct one.  This shouldn't be a problem because these are never used in NARROW or ISTYPE, but it could get clients in trouble if they are allowed to escape from this module.  The objects in question are the globalConfig, the CedarCore config and the InstallationSupportPackage config, together with some of the list elements they point to.
This funny business gets the start traps for this module, InstallationScopesImpl, removed after the start code is run.  (Because this module's installation isn't complete until after it's start code is run!)
put the original proc descriptor back into the global frame in place of the descriptor for the trap.
This is called by Cinder-generated code, e.g. XR_StartCedarModule(firstControl)
makes sure all of config's ancestors are started, then starts config.
CedarCore must always be the first thing started, even if it is contained in another config.  Furthermore, its being started does not depend on the parent being started, so, we just use a 'first time flag' to not start the parent in the course of starting CedarCore.
This is called by Mimosa-generated XR_run_xxx procedures, e.g. XR_Start(&gf)
This is called by Mimosa-generated code for the mesa "START Program" construct.  Note that non-NIL args and rets are unsupported by the compiler and runtime.
This is called from StartTrapImpl.c.
This is called above and from StartTrapImpl.c.
makes sure all of program's ancestors are started, then starts program.
IF cedarCoreErrors # NIL AND Basics.IsBound[InstallationSupportPrivate.DefaultProblemPrinter] THEN {
InstallationSupportPrivate.DefaultProblemPrinter[cedarCoreErrors];
};
IF problems#NIL AND Basics.IsBound[InstallationSupportPrivate.DefaultProblemPrinter] THEN InstallationSupportPrivate.DefaultProblemPrinter[problems];
copied from ProcessImpl, because that's not yet available when this need to be done.
InstallationScopesImpl
Now it's possible to report errors in CedarCore installation

 Ę&!  NewlineDelimiter
(cedarcode) style JĎeCPJ&J&J+Icode Ďk		KKKKKKKKKKK

K 	KŇKK KĐln%K6=K9@K K head2!K.JK (>K )@K !K!6K&@K K%>K&@K,K KKKKKK KKKKK K'KÝKKĎcEnK K&&K 8K +KK	$K K )GK	"K =K K* CmKKK%K)K &^K ;KK&*K) JK
 KK head
Ďn/KKĄ+KĄ ?KĄ-KĄ+KĄ	KĄKĄ'KĄ'KĄ	KĄ
KĄ
KĄ
KĄ	KĄ-KĄ

KĄKĄ#KĄ,KĄ!KĄ
KĄ	KĄKĄKĄ!KĄKĄ#KK Ą2K
K'K,,KKK Ą0KKK ĄAK5K7KKK Ą3Q3DKKKK Ą7WK.5K Ą7bK.6K Ą=kĄ-K::KKHHKK Ą:W(DK&KKK 
Ą
HK"EK#GKKK ĄHKKK 
ĄHK'-KK ĄOKKK KĄ
<KĄ2K Ą&KK@KKK Ą&KK	#KK Ą$KK<KKK Ą$KK	!KK 	Ą HK KKKKK/KK)K!&K"'K%:KKKK Ą #[K Ą/KĘĘKS4KKUKEE+GK  K!=KVaKKK Ą0 EK KU&'*n+GK:VK48KK(\*FK:VK48KK""#?K77KKKKKK 	Ą LKK Ą.K++KKKDDK))DUK!=KK#'3_K!K'K--K%%K59KKKKKKKK Ą0K &KKKK Ą
3K 'K''K'TKK.~K\\K++K
MKK%%K'DK2K''KKK+KccK--KKKK/6KK 	Ą JKHK K))3_K KKK#'KK59KKKK Ą/K &KKKK Ą	2K )KK/AKK Ą8KWbKK Ą,KKK!KK Ą*KKKKK
KKK	KK Ą	 5K K :;K UkKKK$Š$K#6]KK-OKKKKK Ą /K K)K%%K$K UkKKK K 	Ą# jKK=CK 	Ą# jKK>DKK Ą^KKFaK5FK2!)K$$K8SK(,KK
K4K.OKKK22K-3KK
/ KKKK Ą	 1K KKK ĄKK K)K
K=K&&K)/KKKK 
ĄIK K&KKKK Ą

 K .K?5xK";aKKKK.MKK Ą

 }K K#G.K>0rK5RK KKKKK Ą	 ]K .K=[K K  DKKKK Ą
1 [KEEK
K.@$2KASKK.BK
K60KIkKKK Ą%P0K.KKKK Ą mK::KTKK Ą3K .RK&KK#?KK K/NK ĄsK ĄaKKK
AKKK:NKKK
ĄZĄcKKK
+?KGLKKKK	5KĄ	BKQK K 
ĄJ)HK&@KKK29K %KK Ą	U">K:KKK&KKKKAAK#KKKKK ĄFK#*K Ą!a">KKKĄ+KKK	8_KKKĄ3)KK!!KKK Ą0K K1K
RKKK DKKK Ą
 4KKK Ą	 2KKK K Ą7 sKK	 .~K7ZK$6K-OK#KKKK ĄAK 8K
.KKKK Ą)KK>O	K??KDDKKKK Ą+<KZpĎK KKRRK>KKK K"ĄM!EK-8KKK 
ĄHK
KK (DK#K)9K9K	
C%KdKK$$KKKKK	7KK K Ą EK. OKEKKKK##KKKKKK Ą
 7K#LKK+K	1K<KKKK 	Ą \KKKK K$ĄM#GK-8KKK Ą/K+KK Ą  >K$KKKK Ą <K.KGG	 -iKKKK K$$KKKK Ą =K KKK Ą*K %1K$/KDDKK(3KIIKKK Ą
 6K:K	KDDK@@K"KKKKKK Ą KK	'MK,K&KK Ą OK
K
K)KKK Ą 9KKK ĄK1KK 
Ą%V--K[aK,,K*KjuKKKK ĄsK
$K&K((K"K,"TK
'KK7K!2KKKK ĄKK)K&KJJ7K*KK:KKKKKK Ą,BdKBBKKK Ą 9KĄK#KK""KK
B<KK Ą+=KT
Ą)JKKKKK K K#KKK-4K+2KK!K<K K     p  §  