-- RTTypesBasicExtensionImpl.mesa
  -- Last Modified On May 27, 1982 4:29 pm by Paul Rovner 

DIRECTORY
     RTQueue USING[New, Dequeue, Empty, Q, qNil, Enqueue],
     RTTypesBasic USING[GetCanonicalType, FinalizationQueue, maxNPackageRefs, CantEstablishFinalization, Type],
     RTTypesBasicPrivate USING[RTypeExtension, PTypeExtension, PTypeDesc, MapTiTd, TypeExtension];

RTTypesBasicExtensionImpl: MONITOR  -- protects list of type extensions
  IMPORTS RTQueue, RTTypesBasic, RTTypesBasicPrivate
  EXPORTS RTTypesBasic, RTTypesBasicPrivate  

= BEGIN OPEN RTTypesBasic, RTTypesBasicPrivate;


    -- private variables
  typeExtensions: RTypeExtension ← NIL;


    -- PUBLIC procedures

        -- Finalization of collectible objects; type attachments
EstablishFinalization: PUBLIC ENTRY SAFE PROC
             [type: Type, npr: [1..maxNPackageRefs], fq: FinalizationQueue] =
  TRUSTED { ENABLE UNWIND => NULL;
    cType: Type = GetCanonicalType[type];
    ptd: PTypeDesc ← MapTiTd[cType];
      --NOTE beware of LOOPHOLED sharing!!
    IF ptd.extension = NIL
      THEN MapTiTd[type].extension ← ptd.extension ← CreateTypeExtension[];
    IF (NOT npr IN [1..maxNPackageRefs]) OR ptd.extension.finalizationSet # NIL
     THEN ERROR CantEstablishFinalization[type];
    MapTiTd[cType].nPackageRefs ← npr; MapTiTd[type].nPackageRefs ← npr;
    LOOPHOLE[ptd.extension, RTypeExtension].finalizationSet ← LOOPHOLE[fq]};

ReEstablishFinalization: PUBLIC ENTRY SAFE PROC
             [type: Type, npr: [1..maxNPackageRefs], fq: FinalizationQueue] =
  TRUSTED { ENABLE UNWIND => NULL;
    cType: Type = GetCanonicalType[type];
    ptd: PTypeDesc ← MapTiTd[cType];
      --NOTE beware of LOOPHOLED sharing!!
    IF ptd.extension = NIL
     THEN ERROR CantEstablishFinalization[type];
    IF npr # ptd.nPackageRefs
      OR npr # MapTiTd[type].nPackageRefs
      OR ptd.extension.finalizationSet = NIL
     THEN ERROR CantEstablishFinalization[type];
    LOOPHOLE[ptd.extension, RTypeExtension].finalizationSet ← LOOPHOLE[fq]};

NewFQ: PUBLIC SAFE PROC[length: CARDINAL ← 10--refs--] RETURNS[FinalizationQueue] =
  TRUSTED { RETURN[LOOPHOLE[RTQueue.New[length]]]};

FQNext: PUBLIC SAFE PROC[fq: FinalizationQueue] RETURNS[REF ANY] =
  TRUSTED { RETURN[RTQueue.Dequeue[LOOPHOLE[fq]]]};  -- WAITs till there is one if necessary

FQEmpty: PUBLIC SAFE PROC[fq: FinalizationQueue] RETURNS[BOOLEAN] =
  TRUSTED { RETURN[RTQueue.Empty[LOOPHOLE[fq]]]};

PutTypeAttachment: PUBLIC ENTRY SAFE PROC[type: Type, attachment: REF ANY] =
  TRUSTED { ENABLE UNWIND => NULL;
    ptd: PTypeDesc = MapTiTd[GetCanonicalType[type]];
      --NOTE beware of LOOPHOLED sharing!!
    IF ptd.extension = NIL 
      THEN { MapTiTd[type].extension ← ptd.extension ← CreateTypeExtension[]};
    LOOPHOLE[ptd.extension, RTypeExtension].attachment ← attachment;
  };

GetTypeAttachment: PUBLIC ENTRY SAFE PROC [type: Type] RETURNS[REF ANY] =
  TRUSTED { ENABLE UNWIND => NULL;
    ptd: PTypeDesc = MapTiTd[GetCanonicalType[type]];
      --NOTE beware of LOOPHOLED sharing!!
    IF ptd.extension = NIL THEN RETURN[NIL]
    ELSE RETURN[LOOPHOLE[ptd.extension, RTypeExtension].attachment];
  };

  -- called only by the collector. NOTE this does no RC operations
  -- because if PutForFinalization succeeds the count is already correct
PutForFinalization: PUBLIC PROC[type: Type, ref: REF ANY] RETURNS[done: BOOLEAN] =
  { ptd: PTypeDesc = MapTiTd[type];
    q: RTQueue.Q;
    IF ptd = NIL
      OR ptd.extension = NIL
      OR (q ← ptd.extension.finalizationSet) = RTQueue.qNil
     THEN ERROR;
    RETURN[NOT RTQueue.Enqueue[q: q, ref: ref]];
  };


-- PRIVATE procedures
CreateTypeExtension: INTERNAL PROC RETURNS[PTypeExtension] =
  { ENABLE UNWIND => NULL;
    rte: RTypeExtension = NEW[TypeExtension ← [next: typeExtensions]];
    typeExtensions ← rte;
    RETURN[LOOPHOLE[rte, PTypeExtension]]};  -- BEWARE NOTE this will be shared, and not w/ REFs

END.