From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-0.3 required=5.0 tests=BAYES_00, REPLYTO_WITHOUT_TO_CC,T_FILL_THIS_FORM_SHORT autolearn=no autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,6f69b1cf0f02b9ac X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2001-01-15 19:54:07 PST Path: supernews.google.com!sn-xit-03!supernews.com!cyclone-sjo1.usenetserver.com!news-out.usenetserver.com!cyclone-pass-sjo.usenetserver.com!newshub2.rdc1.sfba.home.com!news.home.com!news1.sttls1.wa.home.com.POSTED!not-for-mail Reply-To: "DuckE" From: "DuckE" Newsgroups: comp.lang.ada References: <93ti8b$bjpps$1@ID-25716.news.dfncis.de> Subject: Re: How can I avoid Using a Semaphore? X-Priority: 3 X-MSMail-Priority: Normal X-Newsreader: Microsoft Outlook Express 5.50.4133.2400 X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4133.2400 Message-ID: <9BP86.270637$U46.8654942@news1.sttls1.wa.home.com> Date: Tue, 16 Jan 2001 03:53:41 GMT NNTP-Posting-Host: 24.6.221.63 X-Complaints-To: abuse@home.net X-Trace: news1.sttls1.wa.home.com 979617221 24.6.221.63 (Mon, 15 Jan 2001 19:53:41 PST) NNTP-Posting-Date: Mon, 15 Jan 2001 19:53:41 PST Organization: Excite@Home - The Leader in Broadband http://home.com/faster Xref: supernews.google.com comp.lang.ada:4041 Date: 2001-01-16T03:53:41+00:00 List-Id: "Nick Roberts" 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;