🚀 go-pugleaf

From article <290@saxony.pa.reuter.COM>, by dgil@pa.reuter.COM (Dave Gillett):
>   
> So I'm looking for a simple, and preferably portable, way to (a) calculate, 
> and (b) use, the offset.  Pointer arithmetic is possible, but I'm developing 
> on the PC so that approach may not be simple or portable.  Any suggestions?

I have used the following interface to optain genericity and still rely
on Modula-2 strong typing. Portability is isolated in the SYSTEM and
Storage modules. I'm sorry for posting sources, but I hope these sources
can be useful to many.

*******************************************************************************
*******************************************************************************

DEFINITION MODULE Lists;
(*==========================================================================

  Global Description :  This module provides generic linked lists

      A list is a couple ( L, IO ) where L is the list structure and IO is
  a variable of the type of the elements that L can handle. When creating
  the structure a variable must be assigned to it. The role of that variable
  is double:
             1)- It provides the base type of the list structure,
             2)- it is the port to the list, insuring type checking.

     Operations on the list structure IMPLICITELY use the IO variable.
  That's why these operations are described as side effects. A single IO
  variable may be the port to many lists as long as all lists are of the
  same base type.
                               _______________
                               __: WARNING :__

     The port of a list structure MUST have the same LIFELENGTH and SCOPE
  as the structure itself.

  ________________________________________________________________________

                                  FirstEdit: 23/03/87
                                  LastEdit :  2/07/87
  ________________________________________________________________________

               Author : Marc Benveniste
               System : Logitech MODULA-2/86 V. 2.05
     Developped while
        working at    : IIMAS-UNAM,
                        Apdo. Postal 20-726,
                        Mexico D.F., 01000
                        MEXICO
 ===========================================================================*)

    FROM SYSTEM IMPORT
    (* Type *)         ADDRESS;

    EXPORT QUALIFIED
    (* Type *)         List,
    (* Var *)          ListError,
    (* Procedure *)    NewList, IsEmpty, First, Remove,
                       Insert, Next, Dispose;

    TYPE
      List;

    VAR
      ListError : CARDINAL;

 (*______: Possible error codes :__________________________________________

          0 -------->  No error ocurred,
          1 -------->  General failure,
          2 -------->  Out of memory,
          3 -------->  Tried to REMOVE or FIRST on an empty list or position,
          4 -------->  Tried to DISPOSE of a non-empty list,
          5 -------->  No next element available.
  _________________________________________________________________________*)


  PROCEDURE NewList(IOPort: ADDRESS; ElemTypeSize: CARDINAL): List;
 (*______________________________________________________________________

       NewList creates, if possible, a list ready to handle a given TYPE
   of objects. The only way to interact with the list is through it's
   port. The port must be a VAR  with the same life length and scope as
   the new list.

   In --> IO ::=  The address of the port variable of list.
          TypeSize ::=  Size of the TYPE of the list's port.
   Out -> An empty list ready to handle elements of size TypeSize
          through port at address IO if no error ocurred.

   SideEffect ---> ListError is set to 0 or 2.
   ______________________________________________________________________*)


  PROCEDURE IsEmpty(VAR L : List): BOOLEAN;
(*_________________________________________________________________________

     IsEmpty is True if L is an empty list; False otherwise.

  In  ----> L ::= A list obtained by means of a successful NewList call.
  Out ----> L ::= Untouched
            IsEmpty ::= TRUE if L is empty; FALSE otherwise.

  SideEffect ---> ListError is set to 0 or 1.
  _________________________________________________________________________*)


  PROCEDURE First(VAR L: List);
(*_________________________________________________________________________

      First places in the port assigned to L the head element of the list
  structure L, and makes it the current element. ListError may be 0,1 or 3.

  In  ----> L ::= A list obtained by means of a successful New call.
  Out ----> L ::= The Head  of L has become the current element

  SideEffect ---> A copy of the Head of L is in its port.
                  ListError is set to 0,1 or 3.
  _________________________________________________________________________*)

  PROCEDURE Insert(VAR L: List);
(*_________________________________________________________________________

      Insert makes a copy of the element in the port assigned to L and
  inserts it in the list structure immediately before the current element;
  The inserted element becomes the current one. If L is empty then the copy
  becomes the head and current element. ListError may be 0,1 or 2.

  In         ---> L = Any legal List.
  Out        ---> L = The input list with a copy of it's port's content
                      inserted in front of it's current element.
  SideEffect ---> ListError is set according to the result of the operation.
                  The current element of the list is the inserted one if
                  ListError is 0.
  _________________________________________________________________________*)


  PROCEDURE Remove(VAR L: List);
(*_________________________________________________________________________

     The current element is removed from the list. Next element becomes the
  current one. A copy of that element is in the port associated to L.
  ListError may be 0,1,3 or 5.

  In         ---> L = Any legal List.
  Out        ---> L = The input list with it's current element removed.
  SideEffect ---> ListError is set to 0,1,3 or 5.
                  The List's port contains a copy of the current element,
                  if any.
  _________________________________________________________________________*)


  PROCEDURE Next(VAR L: List);
(*_________________________________________________________________________

      A copy of the next element of the current one is available in the
  port associated to L. That element also becomes the current one.
  ListError may be 0,1 or 5.

  In         ---> L = Any legal List.
  Out        ---> L = The input list.
  SideEffect ---> ListError is set to 0,1 or 5.
                  A copy of the next element, if any, of the current one
                  is in the port. That one also becomes the current one.
  _________________________________________________________________________*)


  PROCEDURE Dispose(VAR L: List);
(*_________________________________________________________________________

      If L is empty, Dispose frees the allocated memory and L becomes an
  invalid data. ListError may be 0,1 or 4.

  In         ---> L = Any legal empty List.
  Out        ---> L = Meaningless data if ListError = 0; same data otherwise.
  SideEffect ---> ListError is set to 0,1 or 4.
_________________________________________________________________________*)


END Lists.

IMPLEMENTATION MODULE Lists;
(*==========================================================================

  Global Description :  This module implements generic linked lists
  ________________________________________________________________________

                                  FirstEdit: 18/05/87
                                  LastEdit : 15/01/88
  ________________________________________________________________________

               Author : Marc Benveniste
               System : Logitech MODULA-2/86 V. 2.05
     Developped while
        working at    : IIMAS-UNAM,
                        Apdo. Postal 20-726,
                        Mexico D.F., 01000
                        MEXICO
 ===========================================================================*)


  FROM SYSTEM IMPORT
    (* Type *)         ADDRESS, WORD,
    (* Procedure *)    TSIZE;

  FROM Storage IMPORT
    (* Procedure *)    ALLOCATE, DEALLOCATE, Available;

  FROM CopyMem IMPORT
    (* Procedure *)    CopyByte, CopyWord;  (* Address arithmetics *)


  TYPE
    List       = POINTER TO Descriptor;
    Link       = POINTER TO Node;
    Descriptor = RECORD
                   IOBuffer    : ADDRESS;   (* Port to List *)
                   TSize       : CARDINAL;  (* Size of Elements *)
                   WordUnits   : BOOLEAN;   (* T if Word; F if Bytes *)
                   Head,PreCur,             (* Head, Precurrent & Current *)
                   Current     : Link       (* elements of List *)
                 END;
    Node       = RECORD
                   Elem : ADDRESS;          (* Ptr to Copy of Elem *)
                   Next : Link
                 END;


  PROCEDURE NewList(IOPort: ADDRESS; ElemTypeSize: CARDINAL): List;
    VAR
      L : List;
      A : BITSET;
  BEGIN
    IF Available(TSIZE(Descriptor))
      THEN
        ListError := 0;
        A := BITSET(ElemTypeSize);
        NEW(L);
        WITH L^ DO
          IOBuffer := IOPort;
          IF (0 IN A)
           THEN TSize := ElemTypeSize; WordUnits := FALSE
           ELSE TSize := ElemTypeSize DIV 2; WordUnits := TRUE
          END;
          Head     := NIL;
          PreCur   := NIL;
          Current  := NIL
        END; (* with *)
        RETURN L
    END; (* if *)
    ListError := 2;
    RETURN NIL
  END NewList;


  PROCEDURE IsEmpty(VAR L : List): BOOLEAN;
  BEGIN
    IF L = NIL
      THEN
        ListError := 1;
        RETURN FALSE
      ELSE
        ListError := 0;
        RETURN (L^.Head = NIL)
    END (* if *)
  END IsEmpty;

  PROCEDURE First(VAR L: List);
  BEGIN
    ListError := 0;
    IF    L = NIL
      THEN ListError := 1
    ELSIF L^.Head = NIL
      THEN ListError := 3
    ELSIF L^.WordUnits
      THEN CopyWord(L^.Head^.Elem,L^.IOBuffer,L^.TSize)
      ELSE CopyByte(L^.Head^.Elem,L^.IOBuffer,L^.TSize)
    END; (*if*)
    IF ListError = 0
     THEN
      WITH L^ DO
        Current := Head;
        PreCur  := Head
      END (* with *)
    END (* if *)
  END First;

  PROCEDURE Insert(VAR L: List);
    VAR
      p : Link;
  BEGIN
    ListError := 0;
    IF    L = NIL
      THEN ListError := 1;
    ELSIF L^.WordUnits & Available(TSIZE(Node) + L^.TSize*2)
      THEN
        NEW(p);
        ALLOCATE(p^.Elem,L^.TSize*2);
        CopyWord(L^.IOBuffer,p^.Elem,L^.TSize)
    ELSIF NOT(L^.WordUnits) & Available(TSIZE(Node) + L^.TSize)
      THEN
        NEW(p);
        ALLOCATE(p^.Elem,L^.TSize);
        CopyByte(L^.IOBuffer,p^.Elem,L^.TSize)
      ELSE
        ListError := 2
    END; (*if*)
    IF ListError = 0
      THEN
        IF L^.Head = L^.Current
          THEN
            WITH L^ DO
              Current := p;
              Current^.Next := Head;
              Head := Current;
              PreCur := Head
            END (* with *)
          ELSE
            p^.Next := L^.Current;
            L^.Current := p;
            L^.PreCur^.Next := L^.Current
        END (* if *)
    END (* if *)
  END Insert;

  PROCEDURE Remove(VAR L: List);
    VAR
      p : Link;
  BEGIN
    IF    L = NIL
      THEN ListError := 1
    ELSIF L^.Current = NIL
      THEN ListError := 3
      ELSE
        p := L^.Current;
        WITH L^ DO
          IF Head = Current
            THEN
              Head := Current^.Next;
              Current := Head;
              PreCur := Head
            ELSE
              Current := Current^.Next;
              PreCur^.Next := Current
          END (* if *)
        END; (* with *)
        IF L^.Current = NIL
          THEN
            ListError := 5
          ELSE
            ListError := 0;
            WITH L^ DO
             IF WordUnits
              THEN CopyWord(Current^.Elem,IOBuffer,TSize)
              ELSE CopyByte(Current^.Elem,IOBuffer,TSize)
             END
            END
        END; (* if *)
        IF L^.WordUnits
         THEN DEALLOCATE(p^.Elem,L^.TSize*2)
         ELSE DEALLOCATE(p^.Elem,L^.TSize)
        END;
        DISPOSE(p)
    END (* if *)
  END Remove;

  PROCEDURE Next(VAR L: List);
  BEGIN
    IF    L = NIL
      THEN ListError := 1
    ELSIF (L^.Current = NIL) OR (L^.Current^.Next = NIL)
      THEN ListError := 5
      ELSE
        ListError := 0;
        WITH L^ DO
          PreCur  := Current;
          Current := Current^.Next;
          IF WordUnits
           THEN CopyWord(Current^.Elem,IOBuffer,TSize)
           ELSE CopyByte(Current^.Elem,IOBuffer,TSize)
          END
        END (* with *)
    END (* if *)
  END Next;

  PROCEDURE Dispose(VAR L: List);
  BEGIN
    IF    L = NIL
      THEN ListError := 1
    ELSIF L^.Head # NIL
      THEN ListError := 4
      ELSE
        ListError := 0;
        DISPOSE(L);
        L := NIL
    END (* if *)
  END Dispose;

BEGIN
  ListError := 0
END Lists.