[Indigo]<Cedar>SafeStorage>TypesBasicImpl.mesa!1

TypesBasicImpl.mesa

Last Modified On December 6, 1983 10:23 pm by Paul Rovner

DIRECTORY

AllocatorOps USING[permanentPageZone],

BrandXSymbolDefs USING[PreDefinedSEI],

BrandYSymbolDefs USING[PreDefinedSEI],

Basics USING[BITAND, BITSHIFT, LowHalf],

RCMap USING[Index],

RCMapOps USING[Initialize],

RTSymbolDefs USING[SymbolIndex, nullSymbolIndex],

RTTypesBasicPrivate USING

[TypeDesc, TMapTiTd, PTypeDesc, FindSTI,

TypeStructure, UniqueTypeFinger, RMapTiTd,

STDesc, TMapStiStd, SymbolTableIndex, LOOPHOLEDTMapStiStd,

LOOPHOLEDRMapStiStd, InitialSTIRangeSize],

SafeStorage USING[TypeIndex, Type, nullType, anyType, lastPredefinedTypeIndex],

UnsafeStorage USING[GetSystemUZone],

StorageTraps USING[],

TimeStamp USING[Null],

TypeStrings USING[Code],

VM USING[AddressForPageNumber, Allocate];

TypesBasicImpl: MONITOR -- protects data structures for runtime types

IMPORTS AllocatorOps, Basics, RCMapOps, RTTypesBasicPrivate, UnsafeStorage, VM

EXPORTS

RTTypesBasicPrivate,

SafeStorage,

StorageTraps--CheckForNarrowRefFault, MapStiStd, MapTiTd--

= BEGIN OPEN bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RTSymbolDefs,

RTTypesBasicPrivate, SafeStorage;

-- Constants --

InitialTiRangeSize: CARDINAL = 10000B; -- a power of 2, divisible by PageSize (for MapTiTd)

InitialUTFRangeSize: CARDINAL = 10000B; -- a power of 2, divisible by PageSize (for MapUTFTi)

InitialTsRangeSize: CARDINAL = 4000B; -- a power of 2, divisible by PageSize (for MapTsTdl)

rcMapBasePages: CARDINAL = 30;

-- Variables --

uz: UNCOUNTED ZONE ← UnsafeStorage.GetSystemUZone[];

lastTypeIndex: TypeIndex ← lastPredefinedTypeIndex;

nullTD: TypeDesc ← [utf: [umid: TimeStamp.Null, seIndex: nullSymbolIndex], symbolAccess: [], myType: nullType, typeStructure: ""];

atomRecType: Type ← nullType;

MapTiTd: PUBLIC TMapTiTd; -- table: TypeIndex -> PTypeDesc

TMapTsTdl: TYPE = RECORD[SEQUENCE length: CARDINAL OF PTypeDesc];

MapTsTdl: LONG POINTER TO TMapTsTdl;

hash map: TypeStructure -> PTypeDesc

TMapUTFTi: TYPE = RECORD[SEQUENCE length: CARDINAL OF TypeIndex];

MapUTFTi: LONG POINTER TO TMapUTFTi;

hash map: UniqueTypeFinger -> TypeIndex

MapStiStd: PUBLIC TMapStiStd; -- EXTREMELY delicate initialization. WATCH OUT.

ERRORs

InvalidType: PUBLIC ERROR[type: Type] = CODE;

NarrowFault: PUBLIC ERROR = CODE;

NarrowRefFault: PUBLIC ERROR[ref: REF ANY, targetType: Type] = CODE;

TooManyTypes: ERROR = CODE;

PUBLIC procedures

EquivalentTypes: PUBLIC SAFE PROC[t1, t2: Type] RETURNS[BOOLEAN] =

TRUSTED { IF t1 = t2 THEN RETURN[TRUE];

t1 ← GetCanonicalType[t1]; t2 ← GetCanonicalType[t2];

RETURN[t1 = t2]};

BEWARE NOTE don't microcode this without changing InternalGetCanonicalReferentType

GetCanonicalType: PUBLIC ENTRY SAFE PROC[t: Type] RETURNS[Type] =

TRUSTED {ENABLE UNWIND => NULL; RETURN[DoGetCanonicalType[t]]};

NotifyAtomRecType: PUBLIC PROC[type: Type] = -- the Atom pkg is ready

{atomRecType ← type};

GetLastTypeIndex: PUBLIC PROC RETURNS[TypeIndex] = -- for use by CedarProbe

{RETURN[lastTypeIndex]};

this procedure value goes into SD

CheckForNarrowRefFault: PUBLIC PROC[ref: REF ANY, targetType: Type] RETURNS[REF ANY] = -- used by NARROW

{IF ref = NIL THEN RETURN[NIL] ELSE ERROR NarrowRefFault[ref: ref, targetType: targetType]};

GetMapTiTd: PUBLIC PROC RETURNS [LONG POINTER TO RMapTiTd] = {RETURN[MapTiTd]};

Enter: PUBLIC ENTRY PROC[inner: PROC] = {ENABLE UNWIND => NULL; inner[]};

AcquireTypeForLoader: PUBLIC ENTRY PROC

[utf: UniqueTypeFinger,

std: STDesc,

std identifies original source symbolStamp,

bcd and sgi for a symbol seg that contains

below sei (entry may be copied and relocated).

sei: SymbolIndex,

ts: TypeStructure,

rcmi: RCMap.Index,

canonicalize: BOOLEAN ← FALSE,

initializing: BOOL ← FALSE]

RETURNS[Type] =

{ ENABLE UNWIND => NULL;

ptd: PTypeDesc;

IF canonicalize

THEN ptd ← FindCanonicalPTD[ts]

ELSE ptd ← FindPTD[utf, ts];

RETURN[IF ptd # NIL

THEN ptd.myType

ELSE MakeNewType[utf, std, sei, CopyString[ts], rcmi, canonicalize, initializing]]};

***********************************

PRIVATE procedures

***********************************

CopyString: PROC[s: LONG STRING] RETURNS[ns: LONG STRING] =

{ ns ← LOOPHOLE[uz.NEW[TEXT[s.length]]];

AppendString[to: ns, from: s]};

AppendString: PROC [to: LONG STRING, from: LONG STRING] = {

i, j, n: CARDINAL;

IF to = NIL OR from = NIL THEN RETURN;

IF from.length + to.length > to.maxlength THEN ERROR;

n ← MIN[from.length, LOOPHOLE[to.maxlength - to.length, CARDINAL]];

i ← to.length;

j ← 0;

WHILE j < n DO to[i] ← from[j]; i ← i + 1; j ← j + 1; ENDLOOP;

to.length ← i;

};

EqualStrings: PROC[s1, s2: LONG STRING] RETURNS [ans: BOOL ← TRUE] = {

IF s1 = NIL AND s2 = NIL THEN RETURN[TRUE];

IF s1 = NIL OR s2 = NIL OR s1.length # s2.length THEN RETURN[FALSE];

FOR i: CARDINAL IN [0..s1.length) DO IF s1[i] # s2[i] THEN RETURN[FALSE]; ENDLOOP;

};

MakeNewType: PUBLIC INTERNAL PROC[utf: UniqueTypeFinger,

std: STDesc,

sei: SymbolIndex,

ts: TypeStructure,

rcmx: RCMap.Index,

canonicalize: BOOLEAN ← FALSE,

initializing: BOOLEAN ← FALSE,

type: Type ← nullType]

RETURNS[Type] =

{ ptd: PTypeDesc;

sti: SymbolTableIndex;

IF type = nullType THEN type ← [NewTypeIndex[utf]];

sti ← IF (WITH sei SELECT FROM

t: SymbolIndex.x => LOOPHOLE[t.e, CARDINAL] IN bx.PreDefinedSEI,

t: SymbolIndex.y => LOOPHOLE[t.e, CARDINAL] IN by.PreDefinedSEI,

ENDCASE => ERROR)

AND MapStiStd[1] # NIL

THEN 1

ELSE FindSTI[std, initializing];

MapTiTd[type] ← ptd ← uz.NEW

[TypeDesc ← [rcmx: rcmx,

utf: utf,

symbolAccess: [sti: sti, sei: sei],

myType: type,

typeStructure: ts]];

IF canonicalize

THEN {ptd.equivalentType ← type; EnterNewCanonicalType[ptd]};

RETURN[type]};

BEWARE NOTE don't microcode this without changing InternalGetCanonicalReferentType

DoGetCanonicalType: INTERNAL PROC[t: Type] RETURNS[Type] =

{ cptd, ptd: PTypeDesc;

IF t <= anyType THEN RETURN[t];

ptd ← MapTiTd[t];

IF ptd.equivalentType # nullType THEN RETURN[ptd.equivalentType];

here to "canonicalize" t

cptd ← FindCanonicalPTD[ptd.typeStructure];

IF cptd = NIL

THEN { ptd.equivalentType ← t;

EnterNewCanonicalType[ptd];

RETURN[t]}

ELSE { ptd.equivalentType ← cptd.equivalentType;

ptd.extension ← cptd.extension; -- there can't be one already

t would have been canonicalized

RETURN[ptd.equivalentType]}};

EnterNewCanonicalType: INTERNAL PROC[ptd: PTypeDesc] =

{ probe: CARDINAL = TsHash[ptd.typeStructure];

ptd.next ← MapTsTdl[probe];

MapTsTdl[probe] ← ptd};

here if utf is not yet registered

NewTypeIndex: INTERNAL PROC[utf: UniqueTypeFinger] RETURNS[typeIndex: TypeIndex] =

{ utfProbe: CARDINAL;

nLooks: CARDINAL ← 0;

lastTypeIndex ← (typeIndex ← lastTypeIndex + 1);

IF lastTypeIndex = InitialTiRangeSize OR lastTypeIndex = LAST[TypeIndex]

THEN ERROR TooManyTypes;

FOR utfProbe ← FirstUTFProbe[utf] , NextUTFProbe[utfProbe]

UNTIL MapUTFTi[utfProbe] = nullType DO

IF (nLooks ← nLooks + 1) > MapUTFTi.length THEN

{ double the size and chek

Get a new hash table.

rehash.

release old table.

try again

}

ERROR TooManyTypes; -- hash table is full

ENDLOOP;

MapUTFTi[utfProbe] ← typeIndex};

EstablishAtomRecUTF: INTERNAL PROC[utf: UniqueTypeFinger] =

{ utfProbe: CARDINAL;

nLooks: CARDINAL ← 0;

FOR utfProbe ← FirstUTFProbe[utf] , NextUTFProbe[utfProbe]

UNTIL MapUTFTi[utfProbe] = nullType DO

IF (nLooks ← nLooks + 1) > MapUTFTi.length THEN

{ double the size and chek

Get a new hash table.

rehash.

release old table.

try again

}

ERROR TooManyTypes; -- hash table is full

ENDLOOP;

MapUTFTi[utfProbe] ← atomRecType; MapTiTd[LOOPHOLE[atomRecType]].utf ← utf};

keep track of the canonical types. The representation is a hash map: TypeStructure -> PTypeDesc

FindCanonicalPTD: PUBLIC INTERNAL PROC[ts: TypeStructure]

RETURNS[ptd: PTypeDesc] =

{ IF IsAtomRecTS[ts]

THEN {IF atomRecType = nullType THEN ERROR; ptd ← MapTiTd[atomRecType]}

ELSE {ptd ← FindEQVType[ts]}};

FindEQVType: INTERNAL PROC[ts: TypeStructure] RETURNS[PTypeDesc] =

{ FOR candidate: PTypeDesc ← MapTsTdl[TsHash[ts]], candidate.next UNTIL candidate = NIL

DO IF EqualTS[ts, candidate.typeStructure] THEN RETURN[candidate] ENDLOOP;

RETURN[NIL]};

FindPTD: PUBLIC INTERNAL PROC[utf: UniqueTypeFinger, ts: TypeStructure ← NIL]

RETURNS[ptd: PTypeDesc] =

{ utfProbe: CARDINAL;

nLooks: CARDINAL ← 0;

FOR typeIndex: TypeIndex ← MapUTFTi[utfProbe ← FirstUTFProbe[utf]]

, MapUTFTi[utfProbe ← NextUTFProbe[utfProbe]]

UNTIL Type[typeIndex] = nullType DO

IF MapTiTd[typeIndex].utf = utf THEN RETURN[MapTiTd[typeIndex]];

IF (nLooks ← nLooks + 1) > MapUTFTi.length THEN

{ double the size and chek

Get a new hash table.

rehash.

release old table.

try again

}

ERROR TooManyTypes; -- hash table is full

ENDLOOP;

IF ts # NIL AND IsAtomRecTS[ts]

THEN {IF atomRecType = nullType THEN ERROR;

EstablishAtomRecUTF[utf];

RETURN[MapTiTd[atomRecType]]}

ELSE RETURN[NIL]}; -- end FindPTD

stolen from TexHash.mesa

TsHash: INTERNAL PROC[ts: TypeStructure] RETURNS[CARDINAL] = INLINE

{ acc: CARDINAL ← 0;

FOR i: CARDINAL IN [0..MIN[7, ts.length])

DO acc ← 7*acc+LOOPHOLE[ts[i], CARDINAL] ENDLOOP;

RETURN[acc MOD InitialTsRangeSize]};

EqualTS: INTERNAL PROC[ts1, ts2: TypeStructure]

RETURNS[ans: BOOLEAN ← TRUE] = INLINE

{RETURN[EqualStrings[ts1, ts2]]};

IsAtomRecTS: INTERNAL PROC[ts: TypeStructure] RETURNS[BOOLEAN] = INLINE

{RETURN[ts.length = 1 AND ts[0] = LOOPHOLE[TypeStrings.Code[atomRec]]]};

FirstUTFProbe: INTERNAL PROC[utf: UniqueTypeFinger] RETURNS[CARDINAL] = INLINE

{RETURN

[Basics.BITAND

[Basics.BITSHIFT[LOOPHOLE[Basics.LowHalf[utf.umid.time], CARDINAL]

+ LOOPHOLE[utf.seIndex, CARDINAL],

2],

MapUTFTi.length - 1]]};

NextUTFProbe: INTERNAL PROC[probe: CARDINAL] RETURNS[CARDINAL] = INLINE

{RETURN[Basics.BITAND[probe + 1, MapUTFTi.length - 1]]};

*****************************

M O D U L E I N I T I A L I Z A T I O N S T A R T S H E R E

LOOPHOLE[MapStiStd, LOOPHOLEDTMapStiStd] -- until the sun comes up.

← AllocatorOps.permanentPageZone.NEW[LOOPHOLEDRMapStiStd[InitialSTIRangeSize]];

FOR i: CARDINAL IN [0..InitialSTIRangeSize)

DO LOOPHOLE[MapStiStd, LOOPHOLEDTMapStiStd][i] ← NIL ENDLOOP;

MapTiTd ← LOOPHOLE[AllocatorOps.permanentPageZone.NEW[RMapTiTd[InitialTiRangeSize]]];

FOR i: CARDINAL IN [0..InitialTiRangeSize) DO MapTiTd[i] ← NIL ENDLOOP;

MapTiTd[nullType] ← @nullTD;

MapUTFTi ←

LOOPHOLE[AllocatorOps.permanentPageZone.NEW[TMapUTFTi[InitialUTFRangeSize]]];

FOR i: CARDINAL IN [0..InitialUTFRangeSize) DO MapUTFTi[i] ← nullType ENDLOOP;

MapTsTdl ← LOOPHOLE[AllocatorOps.permanentPageZone.NEW[TMapTsTdl[InitialTsRangeSize]]];

FOR i: CARDINAL IN [0..InitialTsRangeSize) DO MapTsTdl[i] ← NIL ENDLOOP;

RCMapOps.Initialize

[LOOPHOLE

[VM.AddressForPageNumber[VM.Allocate[count: rcMapBasePages, in64K: TRUE].page]],

rcMapBasePages];

END.