Было у меня такое в хозяйстве... В экспериментальном... В последнюю переработанную реинкарнацию не перекочевало пока. (Возможно, потому, что в ненастольных вещах всё больше придерживаюсь стратегии явного управления ресурсами, по возможности).

Там недостаток в том, что базовый тип для указуемой сущности должен быть наш. Т.е. в случае другого базового типа будет три динамических объекта: ссылка, формальная цель ссылки, реальная цель ссылки.

## Код:
```
Про XxTypes.Object можете считать, что это всего лишь заложенный HandleMsg.

MODULE  XxReferences;

   IMPORT SYSTEM;

   TYPE
      Ref* = POINTER TO ABSTRACT RECORD (XxTypes.Object) END;

      AboutCloseMsg* = RECORD
         ref*: Ref
      END;

      WeakRef = POINTER TO RECORD (Ref)
         handler: XxTypes.Object;
         target: INTEGER
      END;

      RefItem = POINTER TO RECORD
         next: RefItem;
         ref: INTEGER
      END;

      WeakTarget* = POINTER TO ABSTRACT RECORD (XxTypes.Object)
         refs: RefItem
      END;

   PROCEDURE (ref: Ref) Deref* (): ANYPTR, NEW, ABSTRACT;
   PROCEDURE (ref: Ref) SetHandler* (obj: XxTypes.Object), NEW, ABSTRACT;
   PROCEDURE (ref: Ref) Close*, NEW, ABSTRACT;

   PROCEDURE AddRef (tg: WeakTarget; ref: WeakRef);
      VAR it: RefItem;
   BEGIN
      ASSERT(ref.target = SYSTEM.ADR(tg^), 20);
      NEW(it);
      it.ref := SYSTEM.ADR(ref^);
      it.next := tg.refs;
      tg.refs := it
   END AddRef;

   PROCEDURE RemoveRef (tg: WeakTarget; ref: WeakRef);
      VAR prev, r: RefItem;
   BEGIN
      r := tg.refs;
      WHILE r.ref # SYSTEM.ADR(ref^) DO
         prev := r;
         r := r.next
      END;
      IF prev # NIL THEN
         prev.next := r.next
      ELSE
         tg.refs := r.next
      END
   END RemoveRef;

   PROCEDURE NewWeakRef* (target: WeakTarget): Ref;
      VAR r: WeakRef;
   BEGIN
      ASSERT(target # NIL, 20);
      NEW(r);
      r.target := SYSTEM.ADR(target^);
      AddRef(target, r);
      RETURN r   
   END NewWeakRef;

   PROCEDURE IsWeakRef* (ref: Ref): BOOLEAN;
   BEGIN
      RETURN ref IS WeakRef
   END IsWeakRef;

   PROCEDURE BeforeClose (ref: WeakRef);
      VAR msg: AboutCloseMsg;
   BEGIN
      IF ref.handler # NIL THEN
         msg.ref := ref;
         ref.handler.HandleMsg(msg)
      END
   END BeforeClose;

   PROCEDURE (ref: WeakRef) Deref (): WeakTarget;
   BEGIN
      RETURN SYSTEM.VAL(WeakTarget, ref.target)
   END Deref;
   
   PROCEDURE (ref: WeakRef) SetHandler (obj: XxTypes.Object);
   BEGIN
      ref.handler := obj
   END SetHandler;

   PROCEDURE (ref: WeakRef) Close;
   BEGIN
      IF ref.target # 0 THEN
         BeforeClose(ref);
         RemoveRef(SYSTEM.VAL(WeakTarget, ref.target), ref);
         ref.target := 0
      END
   END Close;

   PROCEDURE (ref: WeakRef) FINALIZE;
   BEGIN
      ref.Close
   END FINALIZE;

   PROCEDURE (t: WeakTarget) FINALIZE2-, NEW, EMPTY;

   PROCEDURE (t: WeakTarget) FINALIZE-;
      VAR it: RefItem;
            ref: WeakRef;
   BEGIN
      t.FINALIZE2;
      it := t.refs; t.refs := NIL;
      WHILE it # NIL DO
         ref := SYSTEM.VAL(WeakRef, it.ref);
         BeforeClose(ref);
         ref.target := 0;
         it := it.next
      END
   END FINALIZE;

END XxReferences.
```
