MODULE PrivSubscription;

   CONST
      MaxItems = 10;
   
   TYPE
      Object* = EXTENSIBLE RECORD END;
      
      BasicSubscriber* = POINTER TO ABSTRACT RECORD END;
      
      Subscribers* = ARRAY MaxItems OF BasicSubscriber;
      
      SubscriberList = RECORD
         items: Subscribers;
         count: INTEGER
      END;
      
      Message* = RECORD(Object)
         text-: ARRAY 30 OF CHAR
      END;
      Parameter* = RECORD(Object) END;
      
      SubscriberManager* = RECORD
         list: SubscriberList
      END;
      
      PROCEDURE (VAR M: Message) Set* (IN text: ARRAY OF CHAR), NEW;
      BEGIN
         M.text := text$
      END Set;
      
      PROCEDURE (S: BasicSubscriber) InterpretMessage* (VAR m: Message; VAR p: Parameter), NEW, ABSTRACT;
      
      PROCEDURE (VAR L: SubscriberList) New (s: BasicSubscriber), NEW;
      BEGIN
         L.count := 0
      END New;
      
      PROCEDURE (VAR L: SubscriberList) Add (s: BasicSubscriber), NEW;
      BEGIN
         ASSERT(L.count < MaxItems);
         INC(L.count);
         L.items[L.count - 1] := s
      END Add;
      
      PROCEDURE (VAR L: SubscriberList) Each (m: Message; p: Parameter), NEW;
         VAR i: INTEGER; s: BasicSubscriber;
      BEGIN
         FOR i := 0 TO L.count - 1 DO
            s := L.items[i];
            s.InterpretMessage(m, p)
         END
      END Each;
      
      PROCEDURE (VAR M: SubscriberManager) AddSubscriber* (s: BasicSubscriber), NEW;
      BEGIN
         IF M.list.count < MaxItems THEN  M.list.Add(s) END
      END AddSubscriber;
      
      PROCEDURE (VAR M: SubscriberManager) DeliverMessage* (m: Message; p: Parameter), NEW;
      BEGIN
         M.list.Each(m, p)
      END DeliverMessage;

END PrivSubscription.

MODULE PrivSubscriptionDemo;
   
   IMPORT Subscription := PrivSubscription, StdLog;
   
   TYPE
      MySubscriber = POINTER TO RECORD(Subscription.BasicSubscriber) END;
      
   PROCEDURE (S: MySubscriber) InterpretMessage (VAR m: Subscription.Message; VAR p: Subscription.Parameter);
   BEGIN
      StdLog.String("Interpreter of MySubscriber");
      StdLog.String(m.text)
   END InterpretMessage;
   
   PROCEDURE Do*;
      VAR
         msg: Subscription.Message;
         parameters: Subscription.Parameter;
         mySubscriber: MySubscriber;
         manager: Subscription.SubscriberManager;
   BEGIN
      msg.Set("Message");
      NEW(mySubscriber);
      manager.AddSubscriber(mySubscriber);
      manager.DeliverMessage(msg, parameters)
   END Do;
   
END PrivSubscriptionDemo.

System/Mod/Kernel
- 20080107, bh, full GC included in NewBlock
- 20080107, bh, pointer anchoring bug corrected in NewRec & NewArr