InstallationTypesImpl.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Chauser, August 31, 1990 10:41 am PDT
Willie-s, March 3, 1992 1:06 pm PST
DIRECTORY
CardTab,
CardTabBackdoor,
Checksum,
MesaLoadState,
MesaLoadStateBackdoor,
RefTab,
RefTabBackdoor,
SafeStorage;
InstallationTypesImpl: CEDAR PROGRAM
IMPORTS CardTab, CardTabBackdoor, Checksum, RefTab, RefTabBackdoor
EXPORTS MesaLoadState, MesaLoadStateBackdoor
~ BEGIN
Procedures to be exported with XR← C names.
TypeIndex: TYPE = CARD;
nullTypeIndex: TypeIndex = SafeStorage.nullType.ORD;
RCMapIndex: TYPE = CARD;
InstallationCode: TYPE = {other};
InstallationError: ERROR[code: InstallationCode, typeString: STRING] ~ CODE;
Type: TYPE = REF TypeObject;
TypeObject: TYPE = RECORD [
typeIndex: TypeIndex,
rcMapIndex: RCMapIndex
];
ExternalNames
ExternalNames: PROC = TRUSTED MACHINE CODE {
"^ExternalNames\n";
"GetTypeIndex XR←GetTypeIndex\n";
};
TypeFromTypeString: PUBLIC PROC[typeString: STRING] RETURNS[type: SafeStorage.Type] ~ TRUSTED {
RETURN[LOOPHOLE[GetTypeIndex[typeString, NIL, 0]]];
};
UnmonitoredFindTypeFromTypeString: PUBLIC PROC[typeString: STRING] RETURNS[found: BOOL, type: SafeStorage.Type] ~ {
typeIndex: TypeIndex;
[found, typeIndex] ¬ MaybeGetTypeIndex[typeString, NIL, 0, TRUE];
IF found AND typeIndex <= SafeStorage.TypeIndex.LAST
THEN type ¬ VAL[typeIndex]
ELSE type ¬ SafeStorage.nullType;
RETURN
};
GetTypeIndex: PROC [typeString: STRING, structure: POINTER, rcMapIndex: RCMapIndex] RETURNS [typeIndex: TypeIndex] ~ { -- XR¬GetTypeIndex
RETURN [MaybeGetTypeIndex[typeString, structure, rcMapIndex, FALSE].typeIndex]
};
MaybeGetTypeIndex: PROC [typeString: STRING, structure: POINTER, rcMapIndex: RCMapIndex, timidly: BOOL] RETURNS [found: BOOL, typeIndex: TypeIndex] ~ {
IF structure # NIL THEN InstallationError[code: other, typeString: typeString];
IF typeTab # NIL THEN {
val: RefTab.Val;
[found, val] ¬ (IF timidly THEN RefTabBackdoor.UnmonitoredFetch ELSE RefTab.Fetch)[typeTab, StringToRef[typeString]];
IF found THEN RETURN[TRUE, NARROW[val, Type].typeIndex ];
IF timidly THEN RETURN[FALSE, nullTypeIndex];
typeIndex ¬ typeCount;
typeCount ¬ typeCount+1;
[] ¬ typeTab.Store[StringToRef[typeString], NEW[TypeObject ¬ [typeIndex, rcMapIndex]]];
[] ¬ invTypeTab.Store[typeIndex, StringToRef[typeString]];
}
ELSE {
val: Type;
[found, val] ¬ FetchFromList[typeString];
IF found THEN RETURN[TRUE, val.typeIndex];
IF timidly THEN RETURN[FALSE, nullTypeIndex];
typeIndex ¬ typeCount;
typeCount ¬ typeCount+1;
StoreInList[typeString, NEW[TypeObject ¬ [typeIndex, rcMapIndex]]];
};
RETURN};
TypeStringFromType: PUBLIC PROC[type: SafeStorage.Type] RETURNS[typeString: STRING]
~ {RETURN MaybeMonitoredTypeStringFromType[type, TRUE]};
UnmonitoredTypeStringFromType: PUBLIC PROC[type: SafeStorage.Type] RETURNS[typeString: STRING]
~ {RETURN MaybeMonitoredTypeStringFromType[type, FALSE]};
MaybeMonitoredTypeStringFromType: PROC[type: SafeStorage.Type, monitor: BOOL] RETURNS[typeString: STRING] ~ TRUSTED {
IF invTypeTab # NIL THEN {
found: BOOL;
val: CardTab.Val;
[found, val] ¬ (IF monitor THEN CardTab.Fetch ELSE CardTabBackdoor.UnmonitoredFetch)[invTypeTab, LOOPHOLE[type]];
IF found THEN RETURN[ LOOPHOLE[val, STRING] ]
ELSE RETURN[NIL];
}
ELSE {
found: BOOL;
val: STRING;
[found, val] ¬ FetchTypeFromList[LOOPHOLE[type]];
IF found THEN RETURN[ val ]
ELSE RETURN[NIL];
};
};
GetRCIndex: PROC [Args] RETURNS [Results] ~ {
It looks like there are no clients of this (January 17, 1990)
Body
};
RCIndexForTypeIndex: PROC [Args] RETURNS [Results] ~ {
It looks like there are no clients of this (January 17, 1990)
Body
};
GetUniqueTypeIndex: PROC [Args] RETURNS [Results] ~ {
It looks like there are no clients of this (January 17, 1990)
Body
};
Playing fast and loose with types. This would NOT work in DCedar!
RefToString: PROC [r: REF] RETURNS [STRING] ~ TRUSTED INLINE {
RETURN[LOOPHOLE[r]];
};
StringToRef: PROC [s: STRING] RETURNS [REF] ~ TRUSTED INLINE {
RETURN[LOOPHOLE[s]];
};
The initial list implementation of types. Used until RefTab available;
typeCount: CARD ¬ 4;
typeList: LIST OF Pair;
Pair: TYPE = RECORD[
typeString: STRING,
type: Type
];
FetchFromList: PROC [typeString: STRING] RETURNS [found: BOOL, val: Type] ~ {
FOR l: LIST OF Pair ¬ typeList, l.rest WHILE l#NIL DO
IF StringEqual[typeString, l.first.typeString] THEN RETURN[TRUE, l.first.type];
ENDLOOP;
RETURN[FALSE, NIL];
};
StoreInList: PROC [typeString: STRING, type: Type] ~ {
typeList ¬ CONS[[typeString, type], typeList];
};
StringEqual: PROC [s1, s2: STRING] RETURNS [BOOL] ~ TRUSTED {
IF s1.length#s2.length THEN RETURN[ FALSE ];
FOR i: NAT IN [0..s1.length) DO
IF s1[i]#s2[i] THEN RETURN[ FALSE ];
ENDLOOP;
RETURN[ TRUE ];
};
FetchTypeFromList: PROC [type: TypeIndex] RETURNS [found: BOOL, typeString: STRING] ~ {
FOR l: LIST OF Pair ¬ typeList, l.rest WHILE l#NIL DO
IF type = l.first.type.typeIndex THEN RETURN[TRUE, l.first.typeString];
ENDLOOP;
RETURN[FALSE, NIL];
};
The ultimate implementation; uses RefTab. By the time this code is run RefTab has been installed.
typeTab: RefTab.Ref;
invTypeTab: CardTab.Ref;
Equal: RefTab.EqualProc ~ TRUSTED {
RETURN[ StringEqual[RefToString[key1], RefToString[key2]] ];
};
Hash: RefTab.HashProc ~ TRUSTED {
s: STRING ¬ RefToString[key];
RETURN[ Checksum.ComputeChecksumINLINE[0, (s.length+1)/2, @s.text, 0] ];
};
typeTab ¬ RefTab.Create[mod: 509, equal: Equal, hash: Hash];
invTypeTab ¬ CardTab.Create[mod: 509];
Now transfer the initial types into the table.
FOR l: LIST OF Pair ¬ typeList, l.rest WHILE l # NIL DO
[] ¬ typeTab.Store[StringToRef[l.first.typeString], l.first.type];
[] ¬ invTypeTab.Store[l.first.type.typeIndex, StringToRef[l.first.typeString]];
ENDLOOP;
typeList ¬ NIL;
ExternalNames[];
END.