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.
initialized: BOOL ¬ FALSE;
installationScopesStarted: BOOL ¬ FALSE; -- funny business for getting the start traps for this module removed
cedarCoreStarted: BOOL ¬ FALSE;
cedarCoreErrors: InstallationProblems;
These global variables are protected by the MONITOR lock
installationLock: BOOL ¬ FALSE; -- protects the uncommitted data structures
installationLockReleased: CONDITION;
inspectionLock: BOOL ¬ FALSE; -- protects the committed data structures
inspectionLockReleased: CONDITION;
These global variables are protected by the Installation lock
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;
These global variables are protected by the Inspection lock
typeExports: TypeExports ¬ NIL;
uncommittedTypeExports: TypeExports ¬ NIL;
lastUncommittedTypeExport: TypeExports ¬ NIL; -- for efficient catenation;
programs: LIST OF Program ¬ NIL;
globalConfig: Config;
ExternalNames
ExternalNames:
PROC [] =
TRUSTED
MACHINE
CODE {
"^ExternalNames\n";
"BeginInstallation XR�ginInstallation\n";
"PrepareToCommitInstallation XR←PrepareToCommitInstallation\n";
"CommitInstallation XR𡤌ommitInstallation\n";
"AbortInstallation XR�ortInstallation\n";
"PushScope XR←PushScope\n";
"PopScope XR←PopScope\n";
"ImportInterface XR←ImportInterface\n";
"ExportInterface XR𡤎xportInterface\n";
"HideNames XR←HideNames\n";
"ExportProc XR𡤎xportProc\n";
"ImportProc XR←ImportProc\n";
"PushRename XR←PushRename\n";
"PopRename XR←PopRename\n";
"DeclareGlobalFrame XR�lareGlobalFrame\n";
"StartFrame XR←Start\n";
"StartModule XR←StartModule\n";
"XRStartProgram XR←StartProgram\n";
"EnsureConfigStarted XR←StartCedarModule\n";
"FirstControl XR𡤏irstControl\n";
"AddControl XR�ontrol\n";
"ExportVar XR𡤎xportVar\n";
"ExportType XR𡤎xportType\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] ~ {
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.
IF Lookup[[interface.key.name, SafeStorage.nullType], globalConfig.interfaces].found THEN report[[interface, 0, interfaceVersionMismatch[]]];
};
walk the data structures finding out what might be wrong and reporting to the client.
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
walk the data structures finding out what might be wrong and reporting to the client.
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
move uncommitted global names to the committed data structures. Also uncommitted interface changes to the committed interfaces.
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
toss the uncommitted changes in the global config and interface records.
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;
IF currentConfig=globalConfig THEN {
CommitInstallation[]; -- bogus, but until the clients are reworked to do their own commits, it's necessary.
};
};
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 there's going to be one, it's going to be here.
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 =>
Theres's already one here; cases: transparent or not
IF interface.nItems=0 THEN RETURN [ GetAnyInterface[key, size, config.parent] ]
ELSE RETURN[ interface ];
~config.opaque
AND ~found => {
It won't be here.
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 {
this is a real interface, not an entry denoting transparency.
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
};
Global Frame Support
DeclareGlobalFrame:
PROC [name: CString, frame: GlobalFrame, type: Type, main:
PROC] ~ {
-- XR¬DeclareGlobalFrame
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.
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;
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!)
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 {
put the original proc descriptor back into the global frame in place of the descriptor for the trap.
t ¬ trapInfo.procDesc;
int.aux.items[item].itemTag ¬ bound;
};
};
};
ENDLOOP;
IF doStart THEN startOrder ¬ CONS[program, startOrder];
};
EnsureConfigStarted:
PROC [config: Config] ~ {
-- XR¬StartCedarModule
This is called by Cinder-generated code, e.g. XR←StartCedarModule(firstControl)
makes sure all of config's ancestors are started, then starts config.
IF config=NIL THEN RETURN;
IF config.started THEN RETURN;
IF cedarCoreStarted
THEN {
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.
EnsureConfigStarted[config.parent];
IF config.started THEN RETURN;
}
ELSE cedarCoreStarted ¬ TRUE;
DoStartConfig[config];
};
StartFrame:
PROC [frame: GlobalFrame] ~ {
-- XR¬Start
This is called by Mimosa-generated XR←run←xxx procedures, e.g. XR←Start(&gf)
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
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.
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
This is called from StartTrapImpl.c.
LogStartTrap[program];
StartProgram[program];
};
StartProgram:
PROC [program: Program] ~ {
-- XR¬StartProgram
This is called above and from StartTrapImpl.c.
makes sure all of program's ancestors are started, then starts program.
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[];
};