Re: How can I avoid Using a Semaphore?

["DuckE" <nospam_steved94@home.com>]

"Nick Roberts" <nickroberts@callnetuk.com> wrote in message
news:93ti8b$bjpps$1@ID-25716.news.dfncis.de...
> Please find attached my first quick attempt at a slightly neater solution.
> It's untested, so don't say I didn't warn you!
>
> The essential idea is that the task reading the socket does something like
> this:
>
>    loop
>       get length of buffer
>       call Create to allocate a buffer in the queue (and in memory)
>       read data into buffer
>       call Commit to allow other tasks to obtain the buffer
>    end loop
>
> Each task handling messages does the following:
>
>    loop
>       call Obtain to get an unprocessed buffer
>       process the buffer as required
>       call Delete to release the buffer (from the queue and memory)
>    end loop
>
> Does this vaguely cut it?

No.  One of the things I'm attempting to avoid (which is perhaps creating
some difficulty) is dynamic allocation and deallocation at runtime.  Perhaps
I cut out too much implementation.

What you will find below is a more complete sample.  As you will see below I
set up a table containing packets of different sizes.  When a request is
made for a new packet "NewPacketNPU( size )" the list is searched for the
smallest available packet to meet the request.

To the user of this it's associated modules using packets is simple:

  packet := NewPacketNPU( maxPacketSize );
  PutNPU( packet, integerValue );
  PutNPU( packet, floatValue );
  FinishPacketNPU( packet );
  SendPacketTGM( service, packet );

With no concern of memory leaks.

SteveD


--  Network Packet Utility
--    This module contains routines for manipulating "network packets".
--    The network packet type "aPacketNPU" is limited private and defined
--    within this module.
--
--    Functions are provided to "Put" data to a packet and to "Get" data
--    from a packet.  A primative set of data types are defined with get
--    and put operations overloaded for each of these types.
--
--    A task safe data packet pool is also maintained by this module.
--
WITH Ada.Finalization;
WITH Interfaces.C;
WITH System;
WITH BDTbaseDataTypes;
 USE BDTbaseDataTypes;
PACKAGE NPUnetworkPacketUtil IS

  -- packetOverflowNPU is raised if there is an attempt to store more data
into
  -- a packet than the size of the buffer allows.
  -- packetUnderflowNPU is raised if there is an attempt to read past the
end
  -- of the packet.
  packetUnderflowNPU    : EXCEPTION;
  packetOverflowNPU     : EXCEPTION;
  noAvailablePacketsNPU : EXCEPTION;
  packetTooBigNPU       : EXCEPTION;

  -- In the TimberGrafx protocol each message is sent with a command code
  -- to a node address.
  SUBTYPE aCommandCodeNPU IS aUInt16NPU;

  TYPE aNodeAddressNPU IS PRIVATE;

  TYPE aPacketNPU IS PRIVATE;

  package C renames Interfaces.C;

  TYPE aDataArrayNPU IS ARRAY( Positive RANGE <> ) OF ALIASED C.Char;

  -- Gets a new packet from the available packets that is a size greater
than
  -- or equal to the size given by packetSizeNPU.
  -- The "get" operation places a "hold" on the entry.
  -- If no packets are available raises the exception: noAvailablePacketsNPU
  FUNCTION NewPacketNPU( packetSizeNPU : Natural ) RETURN aPacketNPU;

  -- Release a packet by assigning to Null
  FUNCTION NullPacketNPU RETURN aPacketNPU;

PRIVATE
  PROCEDURE ResetPacketToHeaderNPU( packetNPU : aPacketNPU );

  TYPE aNodeAddressNPU IS NEW aUInt16NPU;

  broadcastAddressNPU : CONSTANT aNodeAddressNPU := 16#FFFF#;
  routerAddressNPU    : CONSTANT aNodeAddressNPU := 0;

  PROTECTED TYPE aRefCounterNPU IS
    PROCEDURE PlaceHoldNPU;
    PROCEDURE ReleaseHoldNPU( lastHoldNPU : out BOOLEAN );
  PRIVATE
    referenceCountNPU : Natural := 0;
  END aRefCounterNPU;

--  NOTE: All references in the public portion of is module refer to packets
as if they
--  were all data.  Internally dataBufferNPU reserves headerLengthNPU bytes
at the beginning
--  of the data array for the header.

  headerLengthNPU      : CONSTANT := 8;  -- size of packet header

  TYPE aPacketBufNPU( bufSizeNPU : Positive );

  TYPE aPacketBufPtrNPU IS ACCESS ALL aPacketBufNPU;

  TYPE aPacketNPU IS NEW Ada.Finalization.Controlled WITH
    RECORD
      packetBufPtrNPU : aPacketBufPtrNPU;
    END RECORD;
  PROCEDURE Initialize( object : in out aPacketNPU );
  PROCEDURE Adjust( object : in out aPacketNPU );
  PROCEDURE Finalize( object : in out aPacketNPU );

  TYPE aPacketBufNPU( bufSizeNPU : Positive ) IS LIMITED
    RECORD
      dataBufferNPU : aliased aDataArrayNPU(1..bufSizeNPU); -- Buffered data
      nbBytesNPU    : Natural := 0;          -- Bytes currently in the
buffer
      positionNPU   : Positive := 1;         -- Position where next data is
to be stored
      nextPacketNPU : aPacketBufPtrNPU := NULL;  -- Pointer for keeping
buffers in a linked list
      holdLockNPU   : aRefCounterNPU;        -- Reference counter for the
packet buffer
      packetFinishedNPU : BOOLEAN := FALSE;  -- Packet has been finished,
for sending
    END RECORD;

END NPUnetworkPacketUtil;


WITH Interfaces.C;
WITH System;
WITH Unchecked_Conversion;
WITH Ada.Strings;
WITH Ada.Strings.Fixed;
WITH BDTbaseDataTypes;
 USE BDTbaseDataTypes;

PACKAGE BODY NPUnetworkPacketUtil IS
  PACKAGE Fixed RENAMES Ada.Strings.Fixed;
  PACKAGE Strings RENAMES Ada.Strings;

  --------------------------------------------------------------------------
------
  --
  -- The reference count is put inside a protected type to make it task
safe.
  --
  PROTECTED BODY aRefCounterNPU IS
    PROCEDURE PlaceHoldNPU IS
    BEGIN
      referenceCountNPU := referenceCountNPU + 1;
    END PlaceHoldNPU;
    PROCEDURE ReleaseHoldNPU( lastHoldNPU : out BOOLEAN ) IS
    BEGIN
      referenceCountNPU := referenceCountNPU - 1;
      lastHoldNPU := referenceCountNPU = 0;
    END ReleaseHoldNPU;
  END aRefCounterNPU;
  --------------------------------------------------------------------------
--------------
  --
  -- Keep a table of free packet lists.  All socket communications use these
packets
  -- The number of entries in each list may grow based on demand until the
limit is reached
  TYPE
    anAvailablePacketEntry IS
      RECORD
        packets        : aPacketBufPtrNPU := NULL;  -- Pointer to list of
unallocated packets of this size
        packetSize     : Natural;                   -- Size of packets in
this list
        nbAllocPackets : Natural;                   -- Nb of packets to
allocated of this size
        maxNbPackets   : Natural;                   -- Max nb of packets to
allocate of this size
      END RECORD;

  TYPE
    anAvailablePacketTable IS ARRAY( Positive RANGE <> ) OF
anAvailablePacketEntry;

  availablePacketTable : anAvailablePacketTable :=
    (  1 => ( NULL,  2**5, 0, 64 ), -- 32
       2 => ( NULL,  2**6, 0, 32 ), -- 64
       3 => ( NULL,  2**7, 0, 32 ), -- 128
       4 => ( NULL,  2**8, 0, 16 ), -- 256
       5 => ( NULL,  2**9, 0, 16 ), -- 512
       6 => ( NULL, 2**10, 0, 16 ), -- 1024
       7 => ( NULL, 2**11, 0, 16 ), -- 2048
       8 => ( NULL, 2**12, 0, 16 ), -- 4096
       9 => ( NULL, 2**13, 0, 16 ), -- 8192
      10 => ( NULL, 2**14, 0, 16 ), -- 16384
      11 => ( NULL, 2**15, 0, 16 ), -- 32768
      12 => ( NULL, 2**16, 0, 16 ), -- 65536
      13 => ( NULL, 2**17, 0, 16 ), -- 131072
      14 => ( NULL, 2**18, 0, 16 ), -- 262144
      15 => ( NULL, 2**19, 0, 16 ), -- 524288
      16 => ( NULL, 2**20, 0, 16 )  -- 1048576
    );

  PROTECTED TYPE aMutex IS
    ENTRY LockMutex;
    PROCEDURE UnlockMutex;
  PRIVATE
    isLocked : BOOLEAN := FALSE;
  END aMutex;

  PROTECTED BODY aMutex IS
    ENTRY LockMutex WHEN NOT isLocked IS
    BEGIN
      isLocked := TRUE;
    END LockMutex;
    PROCEDURE UnlockMutex IS
    BEGIN
      isLocked := FALSE;
    END UnlockMutex;
  END aMutex;

  tableProtect : ARRAY ( availablePacketTable'RANGE ) OF aMutex;

  -- Gets a new packet from the available packets that is a size greater
than
  -- or equal to the size given by packetSizeNPU.
  -- The "get" operation places a "hold" on the entry.
  FUNCTION NewPacketNPU( packetSizeNPU : Natural ) RETURN aPacketNPU IS
    newPacket : aPacketNPU;
    retPtr : aPacketBufPtrNPU RENAMES newPacket.packetBufPtrNPU;
    actualSize : Natural := packetSizeNPU + headerLengthNPU;
  BEGIN
    retPtr := NULL;
    TableSearch:
    FOR ii IN availablePacketTable'RANGE LOOP
      DECLARE
        tableEntry : anAvailablePacketEntry RENAMES availablePacketTable(
ii );
      BEGIN
        IF tableEntry.packetSize > actualSize THEN
          tableProtect( ii ).LockMutex;
           IF tableEntry.packets /= NULL THEN
            retPtr := tableEntry.packets;
             tableEntry.packets := tableEntry.packets.nextPacketNPU;
             retPtr.nextPacketNPU := NULL;
             retPtr.holdLockNPU.PlaceHoldNPU;
           ELSIF tableEntry.nbAllocPackets < tableEntry.maxNbPackets THEN
             tableEntry.nbAllocPackets := tableEntry.nbAllocPackets + 1;
             retPtr := NEW aPacketBufNPU( tableEntry.packetSize );

             retPtr.holdLockNPU.PlaceHoldNPU;
           END IF;
           tableProtect( ii ).UnlockMutex;
           EXIT tableSearch;
        END IF;
      END;
    END LOOP tableSearch;
    IF retPtr /= NULL THEN
      RETURN newPacket;
    ELSE
      RAISE noAvailablePacketsNPU;
    END IF;
  END NewPacketNPU;

  -- Places an additional "hold" on an entry that was obtained using
  -- "NewPacketNPU"
  PROCEDURE HoldPacketBuf( packetBufNPU : aPacketBufPtrNPU ) IS
  BEGIN
    packetBufNPU.holdLockNPU.PlaceHoldNPU;
  END HoldPacketBuf;

  -- Removes the "hold" on an entry.  When all holds are removed the
  -- entry automatically returns to the free pool.
  PROCEDURE ReleasePacketBuf( packetBufNPU : in out aPacketBufPtrNPU ) IS
    lastHold : BOOLEAN;
  BEGIN
    IF packetBufNPU /= NULL THEN
     packetBufNPU.holdLockNPU.ReleaseHoldNPU( lastHold );
     IF lastHold THEN
       TableSearch:
      FOR ii IN availablePacketTable'RANGE LOOP
        DECLARE
          tableEntry : anAvailablePacketEntry RENAMES
availablePacketTable( ii );
        BEGIN
          IF tableEntry.packetSize = packetBufNPU.bufSizeNPU THEN
             tableProtect( ii ).LockMutex;
             packetBufNPU.nextPacketNPU := tableEntry.packets;
             tableEntry.packets := packetBufNPU;
             packetBufNPU := NULL;
           tableProtect( ii ).UnlockMutex;
             EXIT tableSearch;
          END IF;
        END;
      END LOOP tableSearch;
     END IF;
    END IF;
  END ReleasePacketBuf;

  PROCEDURE Initialize( object : in out aPacketNPU ) IS
  BEGIN
    object.packetBufPtrNPU := NULL;
  END Initialize;

  PROCEDURE Adjust( object : in out aPacketNPU ) IS
  BEGIN
    IF object.packetBufPtrNPU /= NULL THEN
      HoldPacketBuf( object.packetBufPtrNPU );
    END IF;
  END Adjust;

  PROCEDURE Finalize( object : in out aPacketNPU ) IS
  BEGIN
    IF object.packetBufPtrNPU /= NULL THEN
      ReleasePacketBuf( object.packetBufPtrNPU );
    END IF;
  END Finalize;

  FUNCTION NullPacketNPU RETURN aPacketNPU IS
    packet : aPacketNPU;
  BEGIN
    RETURN packet;
  END NullPacketNPU;

END NPUnetworkPacketUtil;