-- RTTypesBasicImpl.mesa
  -- Last Modified On January 12, 1983 4:44 pm by Paul Rovner 

DIRECTORY
        BrandXSymbolDefs USING[PreDefinedSEI],
        BrandYSymbolDefs USING[PreDefinedSEI],
        Environment USING[wordsPerPage],
        Inline,
        LongString USING[EqualStrings, AppendString],
        RCMap USING[Index],
        NewRCMapOps USING[Initialize],
        RTBasic USING[TypeIndex],
        RTOS USING[GetPermanentDataPages, PrivateHeapZone, PermanentPageZone],
        RTSymbolDefs USING[SymbolIndex, nullSymbolIndex],
        RTTypesBasicPrivate USING[TypeDesc, TMapTiTd, PTypeDesc, FindSTI,
                                         TypeStructure, UniqueTypeFinger, RMapTiTd,
                                         STDesc, MapStiStd, SymbolTableIndex],
        RTTypesBasic USING[Type, nullType, anyType],
        SafeStorage USING[],  -- EXPORTS only
        TimeStamp USING[Null],
        TypeStrings USING[Code];

RTTypesBasicImpl: MONITOR  -- protects data structures for runtime types
  IMPORTS Inline, LongString, NewRCMapOps, RTOS, RTTypesBasicPrivate
  EXPORTS RTTypesBasic, RTTypesBasicPrivate, SafeStorage  
  SHARES  RTTypesBasic  

= BEGIN OPEN bx: BrandXSymbolDefs, by: BrandYSymbolDefs, RTBasic, RTSymbolDefs,
                 RTTypesBasic, RTTypesBasicPrivate;

-- 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 --
lastTypeIndex: TypeIndex _ 6;
nullTD: TypeDesc _ [utf: [umid: TimeStamp.Null, seIndex: nullSymbolIndex], symbolAccess: [], myType: nullType, typeStructure: ""];
atomRecType: Type _ nullType;

MapTiTd: PUBLIC TMapTiTd; -- table: TypeIndex -> PTypeDesc
MapTsTdl: LONG DESCRIPTOR FOR ARRAY OF PTypeDesc; -- hash map: TypeStructure -> PTypeDesc
MapUTFTi: LONG DESCRIPTOR FOR ARRAY OF TypeIndex; -- hash map: UniqueTypeFinger -> TypeIndex

-- ERRORs
InvalidType: PUBLIC ERROR[type: Type] = CODE;
CantEstablishFinalization: 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] = {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]
      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]]};

-- ***********************************

--PRIVATE procedures

-- ***********************************

CopyString: PROC[s: LONG STRING] RETURNS[ns: LONG STRING] =
 { ns _ LOOPHOLE[RTOS.PrivateHeapZone.NEW[TEXT[s.length]]];
   LongString.AppendString[to: ns, from: s]};

MakeNewType: PUBLIC INTERNAL PROC[utf: UniqueTypeFinger,
                                                  std: STDesc,
                                                  sei: SymbolIndex,
                                                  ts: TypeStructure,
                                                  rcmx: RCMap.Index,
                                                  canonicalize: 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];
      MapTiTd[type] _ ptd _ RTOS.PrivateHeapZone.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) > LENGTH[MapUTFTi] 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) > LENGTH[MapUTFTi] 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) > LENGTH[MapUTFTi] 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[LongString.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
  { OPEN Inline;
    RETURN
     [BITAND
       [BITSHIFT[LOOPHOLE[LowHalf[utf.umid.time], CARDINAL] + LOOPHOLE[utf.seIndex, CARDINAL],
                 2],
        LENGTH[MapUTFTi] - 1]]};

NextUTFProbe: INTERNAL PROC[probe: CARDINAL] RETURNS[CARDINAL] = INLINE
    {RETURN[Inline.BITAND[probe + 1, LENGTH[MapUTFTi] - 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 

  MapTiTd _ LOOPHOLE[RTOS.PermanentPageZone.NEW[RMapTiTd[InitialTiRangeSize]]];
  FOR i: CARDINAL IN [0..InitialTiRangeSize) DO MapTiTd[i] _ NIL ENDLOOP;
  MapTiTd[nullType] _ @nullTD;

  MapUTFTi _
         DESCRIPTOR[RTOS.GetPermanentDataPages
                        [InitialUTFRangeSize * SIZE[TypeIndex]/Environment.wordsPerPage],
                    InitialUTFRangeSize];
  FOR i: CARDINAL IN [0..InitialUTFRangeSize) DO MapUTFTi[i] _ nullType; ENDLOOP;

  MapTsTdl _
         DESCRIPTOR[RTOS.GetPermanentDataPages
                        [InitialTsRangeSize * SIZE[PTypeDesc]/Environment.wordsPerPage],
                    InitialTsRangeSize];
  FOR i: CARDINAL IN [0..InitialTsRangeSize) DO MapTsTdl[i] _ NIL ENDLOOP;

  NewRCMapOps.Initialize[LOOPHOLE[RTOS.GetPermanentDataPages[rcMapBasePages]],
                      rcMapBasePages, NIL];

END.


Κ€–
"Mesa" style˜Iprocš³Οcœ=œ
Οk	œžœ*žœ%žœ3žœ,žœžœžœžœ
žœRžœ<žœα
žœ/žœœžœžœžœ.œžœ"žœžœ4žœžœ
žœyœžœ5œžœ6œžœ6œžœœΚ
žœ!œ
žœ
ž
œ
žœ
žœ
žœ(œ
žœ
ž
œ
žœ
žœ
žœ+œ

œ
žœ
žœžœžœ
žœžœžœ
žœžœžœ
žœžœ
žœžœžœžœœΟnœžœ
žœ
žœžœ
žœžœžœ	žœ
žœ
žœAžœ
VŸœžœ
žœ
žœ
žœ
žœžœžœ
žœžœžœŸœžœ
žœ&Ÿœžœ
žœ
žœœžœ%Ÿœžœ
žœžœ
žœžœ
žœ
žœœžœžœ
žœ
žœ
žœžœ
žœ5Ÿ
œžœ
žœ
žœžœ
žœ
žœžœ
Ÿœžœ
žœ
žœžœžœ
žœžœ
Ÿœžœ
žœ
žœ„
/œ!.œ!2œΒ
žœžœžœ
žœ
žœžœžœžœ#žœžœ
žœžœžœžœD'œ
œ
'œ
Ÿ
œžœžœ
žœžœžœ
žœžœ
žœžœ
žœ=Ÿœžœ
žœ
žœεžœžœQžœBžœžœ)žœžœžœ
žœ(žœžœžœ:žœžœžœ%žœžœžœžœžœžœ+žœžœ‡žœžœ@žœVŸœžœ
žœ
žœ(žœžœ
žœžœžœ
žœœ4žœžœžœRžœ
žœ]œ-#œžœŸœžœ
žœžœ^%Ÿœžœ
žœžœ)žœžœCžœ$žœžœžœ
žœžœ?žœžœ	žœžœžœ
rœ
žœœžœ*Ÿœžœ
žœ*žœžœ
žœ?žœžœ	žœžœžœ
rœ
žœœžœ2žœcœ
Ÿœžœ
žœ
žœžœžœžœžœžœ
žœ#žœŸœžœ
žœžœžœ=žœ
žœžœ
žœ&žœ
žœžœžœ
žœŸœžœ
žœ
žœ,žœžœ#žœžœ
žœŠ
žœžœ	žœžœ
žœžœžœžœ
rœ
žœœžœžœžœ
žœžœžœžœ
žœ<žœžœ
žœ
žœœ
Ÿœžœ
žœžœ
žœžœ
žœ
žœžœ
žœžœžœ
žœžœžœžœžœŸœžœ
žœ žœžœžœžœžœ'Ÿœžœ
žœžœ
žœžœžœžœ	žœ Ÿ
œžœ
žœžœ
žœžœžœ
žœžœ	žœ
žœžœžœžœ žœŸœžœ
žœžœžœ
žœžœžœžœžœ!œEœ
žœ
žœžœ#žœžœ
žœžœžœ
žœ8ž
œ
žœFžœSžœžœ
žœžœžœž
œ
žœEžœRžœžœ
žœžœžœ
žœžœ
žœOžœžœ˜ΧZ—…—-Z4