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