-- RTTSupportImpl.mesa
-- Last Modified On December 21, 1982 3:05 pm by Paul Rovner

DIRECTORY
AMTypes USING[Error],
AtomsPrivate USING[UnsafeMakeAtom],
ConvertUnsafe USING[ToRope],
RCMap USING[Index],
RCMapOps USING[Acquire],
Rope USING[ROPE],
RTBasic USING[TypeIndex],
RTOS USING[UnRavelUSUs],
RTMiniModel USING[], -- EXPORTS only
RTSymbolDefs USING[SymbolTableHandle, nullHandle, SymbolTableBase, SymbolIndex,
SymbolRecordIndex, SymbolNameIndex,
SymbolConstructorIndex, nullSymbolIndex, SymbolIdIndex,
symbolIndexForANY, StandardSymbolContextIndex, contextLevelZero],
RTSymbolOps USING[EnumerateCtxIseis, PeelAllButLast],
RTSymbols USING[Outer, AcquireSTBFromMDI, AcquireSTB, ReleaseSTB],
RTSymbolsPrivate USING[AcquireSTHFromSTX, GetSTHForModule],
RTTypesBasic USING[Type, nullType, unspecType, listOfRefAnyType, refAnyType, anyType],
RTTypesBasicPrivate USING[PTypeDesc, TypeStructure, UniqueTypeFinger, SymbolAccess,
MapStiStd, STDesc, MakeNewType, MapTiTd, GetLastTypeIndex,
FindCanonicalPTD, Enter, FindPTD,
SymbolTableIndex, FindSTI, PreDefinedSEI],
Space USING[Handle, GetHandle, WindowOrigin, GetWindow, GetAttributes,
PageFromLongPointer],
Strings USING[SubString, EqualSubStrings, SubStringDescriptor, AppendSubString],
SymbolTable USING[SetCacheSize],
TimeStamp USING[Null],
TypeStrings USING[Create],
UnsafeStorage USING[NewUZone];


RTTSupportImpl: PROGRAM
IMPORTS AMTypes, AtomsPrivate, ConvertUnsafe, RCMapOps, RTOS, RTSymbolOps, RTSymbols,
RTSymbolsPrivate, RTTypesBasicPrivate, Space, Strings,
SymbolTable, TypeStrings, UnsafeStorage
EXPORTS RTSymbolOps, RTSymbols

= BEGIN OPEN Rope, RTSymbolDefs, RTSymbolOps, RTSymbols, RTSymbolsPrivate, RTBasic,
RTTypesBasic, RTTypesBasicPrivate;


standardSTH: SymbolTableHandle ← nullHandle;
typeStringZone: UNCOUNTED ZONE = UnsafeStorage.NewUZone[];

-- *****************************
-- S U P P O R T F O R T H E D E B U G G E R

AcquireType: PUBLIC PROC[stb: SymbolTableBase,
seIndex: SymbolIndex,
canonicalize: BOOLEAN ← FALSE,
rcmi: RCMap.Index ← LAST[RCMap.Index]]
RETURNS[type: Type] = {inner: PROC =
{ ENABLE UNWIND => NULL;
ptd: PTypeDesc;
utf: UniqueTypeFinger;
ustb: SymbolTableBase;
usei: SymbolIndex;
csei: SymbolConstructorIndex = stb.UnderType[seIndex];
isConsType: BOOLEAN = WITH stb.seb[seIndex] SELECT FROM
id => FALSE,
cons => TRUE,
ENDCASE => ERROR;

MakePredefinedType: PROC[preType: Type] =
INLINE{utf: UniqueTypeFinger;
ustb: SymbolTableBase;
usei: SymbolIndex;
std: STDesc;

[utf, ustb, usei] ← ComputeUTF[stb, seIndex];
std ← [symbolsStamp: ustb.stHandle.version,
sth: SymbolHandleFromLongPointer[ustb.stHandle]];
IF stb # ustb THEN ReleaseSTB[ustb];
IF rcmi = LAST[RCMap.Index] THEN rcmi ← RCMapOps.Acquire[stb, csei];
[] ← MakeNewType[utf, std, usei,
TypeStrings.Create[stb, csei, typeStringZone],
rcmi, FALSE, preType]};

IF seIndex = nullSymbolIndex THEN ERROR;
IF csei = symbolIndexForANY THEN
{IF MapTiTd[unspecType] = NIL THEN MakePredefinedType[unspecType];
type ← unspecType;
RETURN};

IF isConsType THEN
{ isListOfRefAny: BOOLEAN ← FALSE;
isRefAny: BOOLEAN ← FALSE;
isAny: BOOLEAN ← FALSE;

WITH ser: stb.seb[csei] SELECT FROM
long => WITH rse: stb.seb[stb.UnderType[ser.rangeType]] SELECT FROM
ref => IF rse.counted
THEN IF rse.list
THEN NULL --someday figure out whether this is a LORA
ELSE IF stb.seb[stb.UnderType[rse.refType]].typeTag = any
THEN isRefAny ← TRUE;
ENDCASE;
any => isAny ← TRUE;
-- opaque => canonicalize ← TRUE;
ENDCASE;

IF isListOfRefAny THEN
{IF MapTiTd[listOfRefAnyType] = NIL THEN MakePredefinedType[listOfRefAnyType];
type ← listOfRefAnyType;
RETURN};

IF isRefAny THEN
{IF MapTiTd[refAnyType] = NIL THEN MakePredefinedType[refAnyType];
type ← refAnyType;
RETURN};

IF isAny THEN
{IF MapTiTd[anyType] = NIL THEN MakePredefinedType[anyType];
type ← anyType;
RETURN}};
IF canonicalize
THEN { ts: TypeStructure;
[ptd, ts, utf] ← FindCanonicalType[stb, csei]; -- ts new storage only if ptd = NIL
IF ptd # NIL
THEN {type ← ptd.equivalentType; RETURN}
ELSE {std: STDesc = [symbolsStamp: stb.stHandle.version,
sth: SymbolHandleFromLongPointer[stb.stHandle]];
IF rcmi = LAST[RCMap.Index] THEN rcmi ← RCMapOps.Acquire[stb, csei];
type ← MakeNewType[utf, std, csei, ts, rcmi, TRUE]; RETURN}}
ELSE { IF NOT isConsType THEN seIndex ← PeelAllButLast[stb, LOOPHOLE[seIndex]];
[ptd, utf, ustb, usei] ← FindUTF[stb, seIndex];
IF ptd # NIL
THEN {IF stb # ustb THEN ReleaseSTB[ustb];
type ← ptd.myType; RETURN}
ELSE {std: STDesc = [symbolsStamp: ustb.stHandle.version,
sth: SymbolHandleFromLongPointer[ustb.stHandle]];
IF stb # ustb THEN ReleaseSTB[ustb];
IF rcmi = LAST[RCMap.Index] THEN rcmi ← RCMapOps.Acquire[stb, csei];
type ← MakeNewType[utf, std, usei, TypeStrings.Create[stb, csei, typeStringZone], rcmi];
RETURN}}};
Enter[inner]};

AcquireSequenceType: PUBLIC PROC[stb: SymbolTableBase,
sei: SymbolIndex, -- of sequence part
recordSTB: SymbolTableBase,
recordSEIndex: SymbolRecordIndex]
RETURNS[type: Type] = {inner: PROC =
{ ptd: PTypeDesc;
utf: UniqueTypeFinger;
ustb: SymbolTableBase;
usei: SymbolIndex;
csei: SymbolConstructorIndex = stb.UnderType[sei];

WITH s: stb.seb[csei] SELECT FROM
sequence => NULL;
ENDCASE => ERROR;

WITH ser: stb.seb[sei] SELECT FROM
id => sei ← PeelAllButLast[stb, LOOPHOLE[sei]];
ENDCASE;

[ptd, utf, ustb, usei] ← FindUTF[stb, sei];
IF ptd # NIL
THEN {IF stb # ustb THEN ReleaseSTB[ustb];
type ← ptd.myType}
ELSE {rcmi: RCMap.Index = RCMapOps.Acquire[recordSTB, recordSEIndex];
std: STDesc =
[symbolsStamp: ustb.stHandle.version,
sth: SymbolHandleFromLongPointer[ustb.stHandle]];
IF stb # ustb THEN ReleaseSTB[ustb];
type ← MakeNewType
[utf,
std,
usei,
TypeStrings.Create[recordSTB,
recordSEIndex,
typeStringZone],
rcmi]}};
Enter[inner]};

AcquireRope: PUBLIC PROC[stb: SymbolTableBase, hti: SymbolNameIndex]
RETURNS[ROPE] =
{ a: Strings.SubStringDescriptor;
s: STRING = [100];
stb.SubStringForHash[@a, hti];
s.length ← 0;
Strings.AppendSubString[s, @a];
RETURN[ConvertUnsafe.ToRope[LONG[s]]]};

AcquireAtom: PUBLIC PROC[stb: SymbolTableBase, hti: SymbolNameIndex]
RETURNS[atom: ATOM] =
{ a: Strings.SubStringDescriptor;
s: STRING = [100];
stb.SubStringForHash[@a, hti];
s.length ← 0;
Strings.AppendSubString[s, @a];
RETURN[AtomsPrivate.UnsafeMakeAtom[LOOPHOLE[LONG[s]]]]};

EnumerateTypes: PROC[p: PROC[Type] RETURNS[stop: BOOLEAN]]
RETURNS[stopped: BOOLEAN ← FALSE] =
{FOR t: TypeIndex IN [FIRST[TypeIndex]..GetLastTypeIndex[]]
DO IF p[[t]] THEN RETURN[TRUE] ENDLOOP};

GetTypeSymbols: PUBLIC PROC[type: Type]
RETURNS[stb: SymbolTableBase, sei: SymbolIndex] =
{ moduleName: ROPE;
IF type = nullType THEN ERROR AMTypes.Error[reason: typeFault, type: type];
[stb, sei, moduleName] ← DoGetTypeSymbols[type];
IF stb = NIL
THEN ERROR AMTypes.Error[reason: noSymbols, msg: moduleName]};

GetOriginalTypeSymbols: PUBLIC PROC[type: Type]
RETURNS[stb: SymbolTableBase, sei: SymbolIndex] =
{ IF type = nullType THEN ERROR AMTypes.Error[reason: typeFault, type: type];
[stb, sei,] ← DoGetTypeSymbols[type, TRUE];
IF stb = NIL
THEN ERROR AMTypes.Error[reason: noSymbols]};

DoGetTypeSymbols: PROC[type: Type, originalOnly: BOOL ← FALSE]
RETURNS[stb: SymbolTableBase, sei: SymbolIndex, moduleName: ROPE ← NIL] =
{stInfo: SymbolAccess = MapTiTd[type].symbolAccess;
sth: SymbolTableHandle ← IF originalOnly
THEN nullHandle
ELSE MapStiStd[stInfo.sti].sth;

sei ← IF originalOnly THEN MapTiTd[type].utf.seIndex ELSE stInfo.sei;
IF sth = nullHandle
THEN IF LOOPHOLE[sei, CARDINAL] IN PreDefinedSEI
THEN -- standard symbol; any table will do
{IF standardSTH # nullHandle
THEN sth ← standardSTH
ELSE FOR i: SymbolTableIndex IN [1..MapStiStd.length)
DO IF MapStiStd[i] = NIL
THEN LOOP
ELSE IF MapStiStd[i].sth # nullHandle
THEN {sth ← MapStiStd[i].sth; EXIT}
ELSE { -- go find the symbol table bits
[sth: sth, moduleName: moduleName]
← AcquireSTHFromSTX[i];
MapStiStd[i].sth ← sth;
IF sth # nullHandle THEN EXIT}; -- found one.
ENDLOOP;
}
ELSE -- go find the symbol table bits
{IF originalOnly
THEN sth ← GetSTHForModule
[MapTiTd[type].utf.umid, NIL, NIL
! AMTypes.Error => CONTINUE]
ELSE
{[sth: sth, moduleName: moduleName]
← AcquireSTHFromSTX[stInfo.sti];
MapStiStd[stInfo.sti].sth ← sth;
IF sth = nullHandle
THEN -- try for the original defining module
{ std: STDesc = [symbolsStamp: MapTiTd[type].utf.umid,
bcd: MapStiStd[stInfo.sti].bcd];
sei ← MapTiTd[type].utf.seIndex;
IF LOOPHOLE[sei, CARDINAL] IN PreDefinedSEI
THEN
{IF standardSTH # nullHandle
THEN sth ← standardSTH
ELSE FOR i: SymbolTableIndex IN [1..MapStiStd.length)
DO IF MapStiStd[i] = NIL
THEN LOOP
ELSE IF MapStiStd[i].sth # nullHandle
THEN {sth ← MapStiStd[i].sth; EXIT}
ELSE { -- go find the symbol table bits
[sth: sth, moduleName: moduleName]
← AcquireSTHFromSTX[i];
MapStiStd[i].sth ← sth;
IF sth # nullHandle
THEN EXIT}; -- found one.
ENDLOOP;
}
ELSE [sth: sth, moduleName: moduleName]
← AcquireSTHFromSTX[FindSTI[std]];
}};
};
IF sth = nullHandle
THEN stb ← NIL
ELSE {IF standardSTH = nullHandle THEN standardSTH ← sth;
stb ← AcquireSTB[sth]};
};

-- Creation of new runtime Type descriptors

-- ts new storage only if ptd = NIL
FindCanonicalType: PROC[stb: SymbolTableBase, csei: SymbolConstructorIndex]
RETURNS[ptd: PTypeDesc, ts: TypeStructure, utf: UniqueTypeFinger] =
{ ts ← TypeStrings.Create[stb, csei, typeStringZone];
ptd ← FindCanonicalPTD[ts];
IF ptd # NIL
THEN {typeStringZone.FREE[@ts]; RETURN[ptd, ptd.typeStructure, ptd.utf]}
ELSE {[utf,,] ← ComputeUTF[stb, csei]; RETURN[NIL, ts, utf]}};

-- Recognize identical type previously entered
-- hash map: UniqueTypeFinger -> TypeIndex

FindUTF: PROC [stb: SymbolTableBase, sei: SymbolIndex]
RETURNS[ptd: PTypeDesc,
utf: UniqueTypeFinger,
ustb: SymbolTableBase,
usei: SymbolIndex] =
{ [utf, ustb, usei] ← ComputeUTF[stb, sei];
RETURN[FindPTD[utf], utf, ustb, usei]};

-- ComputeUTF might return a new (ustb, usei) only if sei is an SymbolIdIndex
ComputeUTF: PROC [outerSTB: SymbolTableBase, sei: SymbolIndex]
RETURNS[utf: UniqueTypeFinger, ustb: SymbolTableBase, usei: SymbolIndex] =
INLINE BEGIN
ustb ← outerSTB;
usei ← sei;
WITH ser: outerSTB.seb[sei] SELECT FROM
id => IF ser.idCtx IN StandardSymbolContextIndex THEN
utf ← [umid: TimeStamp.Null, seIndex: sei] -- a primitive type
ELSE
WITH ctxr: outerSTB.ctxb[ser.idCtx] SELECT FROM
included =>
IF ctxr.level # contextLevelZero THEN
utf ← [umid: outerSTB.mdb[ctxr.module].stamp,
seIndex: LOOPHOLE[ser.idValue]]
ELSE
{ inner: PROC[stb: SymbolTableBase] =
{ p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex]
RETURNS[stop: BOOLEAN] =
{ ssd1: Strings.SubStringDescriptor;
ssd2: Strings.SubStringDescriptor;
ss1: Strings.SubString = @ssd1;
ss2: Strings.SubString = @ssd2;
outerSTB.SubStringForHash[ss1, ser.hash];
stb.SubStringForHash[ss2, stb.seb[isei].hash];
IF Strings.EqualSubStrings[ss1, ss2]--stb.seb[isei].idValue = ser.idValue
THEN
{ utf ← [umid: stb.stHandle.version, seIndex: isei];
usei ← isei;
RETURN[TRUE]}
ELSE RETURN[FALSE];
};
IF NOT EnumerateCtxIseis[stb: stb, ctx: ctxr.map, proc: p]
THEN ERROR;
};
Outer[stb: outerSTB, mdi: ctxr.module, inner: inner];
ustb ← AcquireSTBFromMDI[outerSTB, ctxr.module];
RETURN
};
ENDCASE => utf ← [umid: outerSTB.stHandle.version, seIndex: sei];
cons => utf ← [umid: (IF LOOPHOLE[sei, CARDINAL] IN PreDefinedSEI
THEN TimeStamp.Null
ELSE outerSTB.stHandle.version), -- NOTE
seIndex: sei];
ENDCASE => ERROR
END;

SymbolHandleFromLongPointer: PROC[p: LONG POINTER]
RETURNS[SymbolTableHandle] =
{ OPEN Space;
space: Handle = RTOS.UnRavelUSUs[GetHandle[PageFromLongPointer[p]]];
window: WindowOrigin ← GetWindow[space];
sth: SymbolTableHandle
← [file: window.file,
span: [base: window.base, pages: GetAttributes[space].size]];
RETURN[sth]};


-- START HERE

SymbolTable.SetCacheSize[pages: 512];

END.