DIRECTORY
CardTab,
CardTabBackdoor,
Checksum,
MesaLoadState,
MesaLoadStateBackdoor,
RefTab,
RefTabBackdoor,
SafeStorage;


InstallationTypesImpl: CEDAR PROGRAM
IMPORTS CardTab, CardTabBackdoor, Checksum, RefTab, RefTabBackdoor
EXPORTS MesaLoadState, MesaLoadStateBackdoor
~ BEGIN


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

RefToString: PROC [r: REF] RETURNS [STRING] ~ TRUSTED INLINE {
RETURN[LOOPHOLE[r]];
};

StringToRef: PROC [s: STRING] RETURNS [REF] ~ TRUSTED INLINE {
RETURN[LOOPHOLE[s]];
};


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


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

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.
  Т  
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.
ExternalNames
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!

The initial list implementation of types.  Used until RefTab available;
The ultimate implementation; uses RefTab.  By the time this code is run RefTab has been installed.

Now transfer the initial types into the table.
 Э╩ї  ХNewlineDelimiter
Ц(cedarcode) styleЩ ЪЬЩJЪЬ
╧eЬ=ЩHJЪЬ%Щ%JЩ#JЩ ЧcodeЪ╧k	Ш	KШKЪЬШKШ	KШKЪЬШKЪЬШKЪЬШKЪЬШKШ ЧKШ KЪ╨lnЬЮШ$KЪЮЬ;ШBKЪЮЬ%Ш,ЪЬЮШKШ ЧЩ+KШ KЪЬЮЬЮЬШKЪЬ0ЮЬШ4KШ KЪЬЮЬЮЬШKШ KЪЬЮЬШ!KШ KЪ╧nЬЮЬ%ЮЬЮЬШLKШ KЪЬЮЬЮЬШЪЬЮЬЮЬШKШKШKЪЬШKШ ЧheadЩЪ
аЬЮЬЮЬЮЬЮЬШ,KЪЬШKЪЬаЬЮЬШ!KЪЬШKШ ЧЧЪаЬЮЬЮЬЮЬЮЬЮЬШ_KЪЮЬЮЬЮЬШ3KЪЬШKШ ЧЪа!ЬЮЬЮЬЮЬЮЬЮЬШsKЪЬШKЪЬ3ЮЬЮЬШAЪЮЬЮЬ$ЮШ4KЪЮЬЮЬШKЪЮЬШ!ЧKЪЮШKШKШ ЧЪаЬЮЬЮЬЮЬЮЬ╧cЬбШЙKЪЮЬ7ЮЬШNKШKШ ЧЪаЬЮЬЮЬЮЬ#ЮЬЮЬ	ЮЬШЧKЪЮЬЮЬЮЬ8ШOЪЮЬЮЬЮЬШKШKЪЬЮЬ	ЮЬ!ЮЬ1ШuKЪ
ЮЬЮЬЮЬЮЬЮЬШ9KЪЮЬ	ЮЬЮЬЮЬШ-KШKШKЪЬ,ЮЬ(ШWKШ:KЪЬШЧЪЮЬШKШ
KШ)KЪЮЬЮЬЮЬЮЬШ*KЪЮЬ	ЮЬЮЬЮЬШ-KШKШKЪЬЮЬ(ШCKЪЬШЧKЪЮЬШЧKШ KШ Ъ
аЬЮЬЮЬЮЬЮЬШSKЪЬЮЬ(ЮЬШ8ЧKШ Ъ
аЬЮЬЮЬЮЬЮЬШ^KЪЬЮЬ(ЮЬШ9ЧKШ Ъа ЬЮЬ"ЮЬЮЬЮЬЮЬШuЪЮЬЮЬЮЬШKЪЬЮЬШKШKЪ	ЬЮЬ	ЮЬЮЬ/ЮЬШqKЪ
ЮЬЮЬЮЬЮЬЮЬШ-KЪЮЬЮЬЮЬШKЪЬШЧЪЮЬШKЪЬЮЬШKЪЬЮЬШKЪЬ!ЮЬШ1KЪЮЬЮЬЮЬШKЪЮЬЮЬЮЬШKЪЬШЧKЪЬШKШ ЧЪа
ЬЮЬ
ЮЬЩ1KЩ=KЩKЩKЩ ЧЪаЬЮЬ
ЮЬЩ:KЩ=KЩKЩKЩ ЧЪаЬЮЬ
ЮЬЩ9KЩ=KЩKЩKЩ ЧЧKЩBЩ ЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШ>KЪЮЬЮЬШKШKШ ЧЪаЬЮЬЮЬЮЬЮЬЮЬЮЬШ>KЪЮЬЮЬШKШKШ ЧЧЩGKШ KЪЬЮЬШKШ KЪЬ
ЮЬЮЬШЪЬЮЬЮЬШKЪЬЮЬШKШ
KЪЬШKШ ЧЪ
аЬЮЬЮЬЮЬ	ЮЬШMЪЮЬЮЬЮЬЮЬЮЬЮШ5KЪЮЬ-ЮЬЮЬЮЬШOKЪЮЬШЧKЪЮЬЮЬЮЬШKШKШ ЧЪаЬЮЬЮЬШ6KЪЬЮЬШ.KШKШ ЧЪаЬЮЬ
ЮЬЮЬЮЬЮЬШ=KЪЮЬЮЬЮЬЮЬШ,ЪЮЬЮЬЮЬЮШKЪЮЬЮЬЮЬЮЬШ$KЪЮЬШ	ЧKЪЮЬЮЬШKШЧKШ Ъ
аЬЮЬЮЬ	ЮЬЮЬШWЪЮЬЮЬЮЬЮЬЮЬЮШ5KЪЮЬЮЬЮЬЮЬШGKЪЮЬШЧKЪЮЬЮЬЮЬШKШKШ KШ ЧЧKЩbЩ KШKШKШ ЪаЬЮЬШ#KЪЮЬ6Ш<KЪЬШKШ ЧЪаЬЮЬШ!KЪЬЮЬШKЪЮЬBШHKЪЬШЧKШ KШ<KШ&KШ KЩ.ЪЮЬЮЬЮЬЮЬЮЬЮШ7KЪЬBШBKЪЬOШOKЪЮЬШЧKЪЬЮЬШKШKШ ЧKЪЮЬШЧ ЕЧ      е  