%( **************************************************************** Copyright (c) 1992, Carnegie Mellon University All Rights Reserved Permission is hereby granted to use, copy, modify, and distribute this software provided that the above copyright notice appears in all copies and that any distribution be for noncommercial purposes. Carnegie Mellon University disclaims all warranties with regard to this software. In no event shall Carnegie Mellon University be liable for any special, indirect, or consequential damages or any damages whatsoever resulting from loss of use, data, or profits arising out of or in connection with the use or performance of this software. **************************************************************** )% %TITLE 'MEMGR - Dynamic Memory allocaion / deallocation rtns.' %( Module: MEMGR Facility: Provide dynamic memory allocation & deallocation for various TCP/IP data structures. Abstract: Many of the data structures used by TCP/IP are dynamically allocated & deallocated (TCB's,Queue block, etc.). Some of the dynamically allocated data structures are preallocated and placed on free-lists. The globals "xxx_xxx_count_base" are initialized during startup routine: "configure_acp" in module: config.bli. These byte-size integers represent the number of elements on their respective free list. Author: Stan C. Smith Fall 1981 This version by Vince Fuller, CMU-CSD, Summer, 1986 Modification History: *** Begin CMU change log *** 2.7 18-Aug-89, Edit by BRM (CMU NetDev) AddedMM$Get_Mem and MM$Free_Mem generic memory allocation routines. Changed Conect reference to a pointer. 2.6-1 03-APR-1989, M. Madison, RPI/ECS Turn off AST's when doing interruptible REMQUE in routine MM$QBLK_FREE. 2.6 23-Jul-87, Edit by VAF Know to flush any TVT data when deleting TCB's. 2.5 20-Jul-87, Edit by VAF Minor cleanup of circular queue stuff. 2.4 23-Mar-87, Edit by VAF Replace the three standard-sized packet buffers with two - minimum size and maximum sized. 2.3 5-Aug-86, Edit by VAF Modify TCB$Create/TCB_Delete to also allocate/deallocate the the send/receive circular queues for the TCB. 2.2 22-Jul-86, Edit by VAF Add code to track allocation, deallocation and queue movement of QBlks. Queue movement is under the QDEBUG conditional. 2.1 11-Jul-86, Edit by VAF Make all counters global. 2.0 25-Jun-86, Edit by VAF Make TCB$Create set VTCB_INDEX field in TCB. TCB_DELETE doesn't search VALID_TCB anymore - just uses VTCB_INDEX. Don't use index 0 of VALID_TCB table. 1.9 22-May-86, Edit by VAF In TCB$Delete - remove TCB from UCB hash queue. 1.8 20-May-86, Edit by VAF Use new AST locking scheme - respect previous AST state. *** End CMU change log *** 1.1 [9-10-81] Original version. 1.2 [6-5-82] Free-lists implemented for frequently accessed data structures. 1.3 [4-28-83] Number of elements on the free-lists is configurable from the config.txt file. This file is processed during acp initialization phase. 1.4 [5-16-83] stan removed "max_seg" references (free_list, count, init) as they are no longer different from max_network_size_mesg. 1.5 [5-23-83] stan replaced xport memory manager calls with direct calls to vms runtime library. Xport routines eventually used the RTL calls anyway, attempt was to increase memory mgmt speed. Effect was dramatic. 1.6 [7-15-83] stan force byte-size for some external literals, explicit var's in register declarations. 1.7 [5-30-85] noelan olson Track current overflow and maximum size of preallocated queues. )% %SBTTL 'Module & Environment Definition' MODULE MEMGR(Ident='2.7',LANGUAGE(BLISS32), ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE, NONEXTERNAL=LONG_RELATIVE), LIST(NOREQUIRE,ASSEMBLY,OBJECT,BINARY), OPTIMIZE,OPTLEVEL=3,ZIP)= BEGIN LIBRARY 'SYS$LIBRARY:STARLET'; ! Include VMS systems definitions LIBRARY 'CMUIP_SRC:[CENTRAL]NETXPORT'; ! Include transportablity package LIBRARY 'CMUIP_SRC:[CENTRAL]NETVMS'; ! VMS specifics LIBRARY 'TCPMACROS'; ! Local Macros LIBRARY 'STRUCTURE'; ! Structure & Field definitions %SBTTL 'External: Routines, Literals and data' EXTERNAL ROUTINE LIB$GET_VM : ADDRESSING_MODE(GENERAL), LIB$FREE_VM : ADDRESSING_MODE(GENERAL), TCP$Find_Local_Port, ! USER.BLI TELNET_CLOSE : NOVALUE, ! TCP_TELNET.BLI MovByt; ! MACLIB.MAR ! External Literals from tcp.bli EXTERNAL LITERAL Window_Default, Empty_Queue : UNSIGNED(8), Queue_Empty_Now : UNSIGNED(8), Error; ! External Data Segements EXTERNAL ConectPtr : REF Connection_Table_Structure, VTCB_ptr : REF VECTOR[0], ! Vector of Valid TCB pointers. VTCB_Size, Max_TCB, ast_in_progress, ! Flag if running at AST level INTDF, ! interrupt deferral count TCB_Count, ! # of "valid_TCB" table entries. MIN_PHYSICAL_BUFSIZE, MAX_PHYSICAL_BUFSIZE; %SBTTL 'Memory manager header structure' $FIELD MEM$HDR_FIELDS = SET MEM$QNEXT = [$Address], ! Next item on queue MEM$QPREV = [$Address], ! Previous item on queue %IF QDEBUG %THEN MEM$CURQUEUES = [$Ulong], ! Queues this block is on MEM$ALLQUEUES = [$Ulong], ! Queues this block has been on MEM$ALLOCRTN = [$Address], ! Routine which allocated most recently MEM$FREERTN = [$Address], ! Routine which freed most recently MEM$INSQUERTN = [$Address], ! Routine which INSQUE'd most recently MEM$INSQUEHDR = [$Address], ! Queue header where most recently INSQUE'd MEM$INSQUEVAL = [$Address], ! Additional value when INSQUE'd MEM$REMQUERTN = [$Address], ! Routine which REMQUE'd most recently MEM$REMQUEHDR = [$Address], ! Queue header where most recently REMQUE'd MEM$REMQUEVAL = [$Address], ! Additional value when REMQUE'd %FI MEM$FLAGS = [$Ulong], ! Flags defining free, prealloc, etc. $OVERLAY(MEM$FLAGS) MEM$ISFREE = [$BIT], ! This block is free MEM$ISPERM = [$BIT] ! This block is permanent (preallocated) $CONTINUE TES; LITERAL MEM$HDR_SIZE = $FIELD_SET_SIZE; MACRO MEM$HDR_STRUCT = BLOCK[MEM$HDR_SIZE] FIELD(MEM$HDR_FIELDS) %; %Sbttl 'Preallocated dynamic data structures.' %( Here we define memory management preallocated data structure queues. Idea is to keep specified number of dynamic data structures around so we don't have to dynamically allocate the structure each time we need one. A little faster execution is what we are after. )% ! Define and initialize free lists to "empty". OWN FREE_Qblks : Queue_Header_Structure(Queue_Header_Fields) PRESET( [Qhead] = Free_Qblks, [Qtail] = Free_Qblks ), USED_Qblks : Queue_Header_Structure(Queue_Header_Fields) PRESET( [Qhead] = Used_Qblks, [Qtail] = Used_Qblks ), FREE_Uargs : Queue_Header_Structure(Queue_Header_Fields) PRESET( [Qhead] = Free_Uargs, [Qtail] = Free_Uargs ), Free_Minsize_Segs : Queue_Header_Structure(Queue_Header_Fields) PRESET ( [Qhead] = Free_Minsize_Segs, [Qtail] = Free_Minsize_Segs ), Free_Maxsize_Segs : Queue_Header_Structure(Queue_Header_Fields) PRESET ( [Qhead] = Free_Maxsize_Segs, [Qtail] = Free_Maxsize_Segs ); ! "count_base" items are initialized in conifg_acp routine during startup. ! they provide the base number of items on a free list. GLOBAL !!! HACK !!! I don't like the looks of this next comment. QBLK_Count_base : UNSIGNED BYTE INITIAL(0), ! #Qblks on free list. Uarg_Count_base : UNSIGNED BYTE INITIAL(0), ! #Uarg blks on free list. Min_Seg_Count_base: UNSIGNED BYTE INITIAL(0), ! #Min-size segs Max_Seg_Count_base: UNSIGNED BYTE INITIAL(0), ! #Max-size segs ! Counters for the number of items on a specific queue. QBLK_Count: UNSIGNED BYTE INITIAL(0), ! #Qblks on free list. Uarg_Count: UNSIGNED BYTE INITIAL(0), ! #Uarg blks on free list. Min_Seg_Count: UNSIGNED BYTE INITIAL(0), ! #Min-size segs Max_Seg_Count: UNSIGNED BYTE INITIAL(0); ! #Max-size segs %( Here we keep track of what kind of data structures are being dynamically allocated & which should have more reserved during initialization. )% GLOBAL QB_gets : INITIAL(0), ! Queue Blks dynamically allocated UA_gets : INITIAL(0), ! User arg blks. MIN_gets : INITIAL(0), ! Minimum size buffers MAX_gets : INITIAL(0), ! Maximum size buffers QB_max : INITIAL(0), ! Queue Blk max queue size UA_max : INITIAL(0), ! User arg max queue size MIN_max : INITIAL(0), ! Minimum size buffers max queue size MAX_max : INITIAL(0); ! Maximum seg max queue size %Sbttl 'Memory Management Fault Handler' %( Function: Die gracefully on memory allocation/deallocation errors. Idea is to NOT hang user processes by making sure all user IO is posted to VMS to users don't end up in MWAIT. Inputs: None Outputs: None Side Effects: Post all remaining user IO back to VMS & die gracefully here. leave some tracks by sending the network operator a mesage with the hex error code in it. )% ROUTINE Memgr_Fault_Handler(Caller,Primary_CC,Sec_CC) : NOVALUE = BEGIN Signal(.Primary_cc); Fatal_Error('Memory Mgmt. Fault detected.',.Primary_cc); END; %SBTTL 'Get_Mem: Allocate memory.' %( Function: Allocate a new block of memory. Calling Convention: CALLS, standard BLISS linkage. Inputs: Addr: pointer to longword to receive allocated memory's address Size: Amount of memory desired, in bytes. Outputs: Address of newly allocated zeroed memory block. Error(0) for no memory available. Side Effects: None )% GLOBAL ROUTINE MM$Get_Mem (Addr, Size) = BEGIN LOCAL RC; NOINT; ! Hold AST's please... IF NOT (RC = LIB$GET_VM(Size,.Addr)) THEN Memgr_Fault_Handler(0,.RC,0); OKINT; CH$FILL(0,.Size,..Addr); ! clean house.....zero fill. .RC END; %SBTTL 'Free_Mem: Release allocated memory.' %( Function: Free the memory allocated by MM$Get_Mem. Inputs: Mem = address of memory block. Outputs: None. Side Effects: None. )% GLOBAL ROUTINE MM$Free_Mem(Mem,Size) : NOVALUE = BEGIN LOCAL RC; NOINT; ! Hold AST's IF NOT ( RC = LIB$FREE_VM ( Size , .Mem ) ) THEN Memgr_Fault_Handler(0,.RC,0); OKINT; END; %SBTTL 'Queue Block Handlers' %( Function: Acquire one queue block. See TCP Segment definition for Queue block structure definition (SEG.DEF). Calling Conventions: CALLS, standard BLISS linkage. Inputs: none Outputs: Pointer to Queue block is returned. Side Effects: Get Queue Block from queue-block free list or dynamically allocate one. If no memory is available then we die here. )% GLOBAL ROUTINE MM$QBLK_GET= BEGIN BUILTIN R0; ! standard vax/vms routine return value register. LOCAL Ptr, Hptr : REF MEM$HDR_STRUCT; IF REMQUE(.Free_QBlks[QHead],Hptr) NEQ Empty_Queue THEN QBlk_Count = .QBlk_Count - 1 ! Say there is 1 less avail. ELSE ! allocate a new qb. BEGIN ! Disallow ast during memory allocation. NOINT; IF NOT (LIB$GET_VM(%REF((qb_size+MEM$HDR_SIZE)*4),Hptr)) THEN Memgr_Fault_Handler(0,.R0,0); OKINT; CH$FILL(%CHAR(0),MEM$HDR_SIZE*4,.Hptr); Hptr[MEM$ISPERM] = FALSE; ! Not a permanent qblk QB_Gets = .QB_gets + 1; ! track this event. IF .QB_gets GTR .QB_max THEN QB_max = .QB_gets; END; ptr = .Hptr + MEM$HDR_SIZE*4; ! Point at data area CH$FILL(%CHAR(0),qb_size*4,.ptr); ! fresh qb. !!!HACK!!!~~~ Should record allocator here ~~~ Hptr[MEM$ISFREE] = FALSE; ! QB is no longer free INSQUE(.Hptr,.USED_Qblks[QTail]); ! Insert on used queue RETURN(.Ptr); END; %( Function: Deallocate one queue block. Calling Conventions: CALLS, standard BLISS-32 linkage. Inputs: Address of Queue block structure. Outputs: None. Side Effects: If count of queue-blocks on the free list is < max allowed on list then queue the QB otherwise delete the memory. )% GLOBAL ROUTINE MM$QBLK_Free(Ptr): NOVALUE = BEGIN BUILTIN R0; ! standard vax/vms routine return value register. LOCAL Hptr : REF MEM$HDR_STRUCT; Hptr = .Ptr - MEM$HDR_SIZE*4; ! Point at header NOINT; REMQUE(.Hptr,Hptr); ! Remove from the used queue OKINT; IF .Hptr[MEM$ISPERM] THEN BEGIN ! Free a permanent block - just put on free Q !~~~ Record deallocator here ~~~ Hptr[MEM$ISFREE] = TRUE; INSQUE(.Hptr,.Free_QBlks[QTail]); QBlk_Count = .QBlk_Count + 1; END ELSE BEGIN NOINT; ! Disable AST's !!!HACK!!! Why? IF NOT (LIB$FREE_VM(%REF((qb_size+MEM$HDR_SIZE)*4),Hptr)) THEN Memgr_Fault_Handler(0,.R0,0); OKINT; QB_Gets = .QB_gets - 1; ! track this event. END; END; %( Function: Preallocate blocks & queue them on the free list "Free_QBlks". Inputs: None. Outputs: None. Side Effects: Could die here if no avail memory. )% ROUTINE QBLK_Init: NOVALUE = BEGIN LOCAL Hptr : REF MEM$HDR_STRUCT; QBLK_Count = .Qblk_count_base; INCR J FROM 1 TO .QBlk_count DO BEGIN LIB$GET_VM(%REF((qb_size+MEM$HDR_SIZE)*4),Hptr); CH$FILL(%CHAR(0),MEM$HDR_SIZE*4,.Hptr); Hptr[MEM$ISFREE] = TRUE; Hptr[MEM$ISPERM] = TRUE; INSQUE(.Hptr,.Free_QBlks[QTail]); END; END; %SBTTL 'TCB_Create: Create a Transmission Control Blk.' %( Function: Create one TCB (transmission Control Block) & place it's address in the valid TCB table. Calling Convention: CALLS, standard BLISS linkage. Inputs: none Outputs: Address of newly allocated uninitialized TCB. Error(-1) for Valid TCB table full Side Effects: Address of newly allocated TCB is placed in first free entry in the Valid TCB table. )% GLOBAL ROUTINE TCB$Create = BEGIN LOCAL TCB : REF TCB_Structure, ! New TCB Indx, ! location of new TCB in Valid TCB table. Old, ! remember the old value of VTCB_ptr when resizing... SENDQ, ! Send Queue RECVQ, ! Receive Queue RC; ! return code NOINT; ! Hold AST's please... !!!HACK!!! Why are we holding AST's??? IF NOT (RC = LIB$GET_VM(%REF(tcb_Size*4),TCB)) THEN Memgr_Fault_Handler(0,.RC,0); IF NOT (RC = LIB$GET_VM(%REF(Window_Default),SENDQ)) THEN Memgr_Fault_Handler(0,.RC,0); IF NOT (RC = LIB$GET_VM(%REF(Window_Default),RECVQ)) THEN Memgr_Fault_Handler(0,.RC,0); OKINT; CH$FILL(%CHAR(0),tcb_size*4,.TCB); ! clean house.....zero fill. ! Set pointers and sizes of send and receive queues TCB[SND_Q_BASE] = TCB[SRX_Q_BASE] = .SENDQ; TCB[SND_Q_SIZE] = TCB[SRX_Q_SIZE] = Window_Default; TCB[RCV_Q_BASE] = .RECVQ; TCB[RCV_Q_SIZE] = Window_Default; ! Find an empty Valid_TCB_table entry for the newly created TCB address. NOINT; Indx = 0; INCR J FROM 1 TO .VTCB_Size DO IF .VTCB_ptr[.J] EQL 0 THEN EXITLOOP Indx = .J; IF .Indx EQL 0 THEN BEGIN OPR$FAO('MMgr: Growing Valid TCB table to !SW entries...!/',.VTCB_Size*2); ! This should be called at AST level to assure that we aren't ! pulling the rug out from anyone Indx = .VTCB_Size; VTCB_Size = .VTCB_Size * 2; Old = .VTCB_Ptr; MM$Get_Mem( VTCB_Ptr , (.VTCB_Size+1) * 4 ); MovByt ( (.Indx+1) * 4 , .Old , .VTCB_Ptr ); MM$Free_Mem( Old , .Indx * 4 ); Indx = .Indx + 1; END; ! Maintain pointer to last TCB in table IF .Indx GTR .Max_TCB THEN Max_TCB = .Indx; !OPR$FAO('!%T Max_TCB = !UW',0,.Max_TCB); ! Link the new TCB into the Valid TCB table. VTCB_ptr[.Indx] = .TCB; ! set TCB's address TCB_Count = .TCB_Count + 1; ! Keep track of active TCB's. TCB[VTCB_INDEX] = .Indx; ! Remember index into Valid TCB Table OKINT; ! Carry on... .TCB END; %SBTTL 'TCB-Delete: Delete one TCB' %( Function: Free the memory associated with a specified TCB. If this happens to be the last TCB in a Local_Port TCB list then free the Local_port slot from the Connection table (CONECT). Inputs: TCB_Ptr = address of TCB data structure. Outputs: None. Side Effects: Connection table (CONECT) entry maybe cleared if last TCB for specified local_port. )% FORWARD ROUTINE MM$Seg_Free : NOVALUE; GLOBAL ROUTINE TCB$Delete(TCB_Ptr) : NOVALUE = BEGIN LOCAL RC, IDX, TCB: REF TCB_Structure; TCB = .TCB_Ptr; ! Flush any TVT data block. IF .TCB[TVTDATA] NEQ 0 THEN TELNET_CLOSE(.TCB); ! Get index into Valid TCB table IDX = .TCB[VTCB_INDEX]; IF .VTCB_ptr[.IDX] EQLA .TCB THEN BEGIN LABEL X; NOINT; ! Hold AST's VTCB_ptr[.IDX] = 0; ! Clean out entry TCB_Count = .TCB_Count-1; ! Account for this TCB going away. IF .Max_TCB LEQ .Idx THEN X : BEGIN DECR J FROM .Idx TO 1 DO IF .VTCB_ptr[.J] NEQ 0 THEN LEAVE X WITH Max_TCB = .J; ! No valid TCB's left? Do a sanity check. DECR J FROM .VTCB_Size TO 1 DO IF .VTCB_ptr[.J] NEQ 0 THEN LEAVE X WITH Max_TCB = .J; Max_TCB = 1; END; ! end of block X !OPR$FAO('!%T Max_TCB = !UW',0,.Max_TCB); ! Remove the TCB from local port list. ! Check if the Local_port queue of TCB's is now empty. ! If TRUE Then remove the local-port name from the Connection table (CONECT). ! REMQUE must not be interrupted... IF (REMQUE(.tcb_ptr,tcb_ptr)) EQL queue_empty_now THEN BEGIN IF (RC=TCP$Find_Local_Port(.tcb[local_port])) NEQ Error THEN ConectPtr[.rc,CN$Local_Port] = -1; ! Make CONECT entry avail. END; ! First, deallocate the queues for this TCB IF NOT (RC = LIB$FREE_VM(%REF(.TCB[SND_Q_SIZE]),TCB[SND_Q_BASE])) THEN Memgr_Fault_Handler(0,.RC,0); IF NOT (RC = LIB$FREE_VM(%REF(.TCB[RCV_Q_SIZE]),TCB[RCV_Q_BASE])) THEN Memgr_Fault_Handler(0,.RC,0); ! Then, deallocate the TCB itself IF NOT (RC = LIB$FREE_VM(%REF(tcb_size*4),tcb_ptr)) THEN Memgr_Fault_Handler(0,.RC,0); OKINT; END ELSE Warn_Error('Attempt to Delete unknown TCB,'); END; %Sbttl 'TCP User IO argument block (uarg) memory mangler' %( Function: Allocate one user argument block from process virtual space. User-requests-avail (maclib.mar) calls this routine to allocate a user arg block when copying TCP user request arguments from the system buffer to this buffer. Called from user_requests_avail routine in MACLIB.mar in "KERNEL" mode. Calling Sequence: CALLS #0,Uarg_Get Inputs: None. Outputs: Address of process-local space user argument block. Side Effects: Routine executes in Kernel mode. Uarg block could be removed from free list "FREE_UARGS". )% GLOBAL ROUTINE MM$UARG_GET= BEGIN BUILTIN R0; ! standard vax/vms routine return value register. LOCAL Ptr; IF REMQUE(.FREE_Uargs[QHead],Ptr) NEQ Empty_Queue THEN Uarg_Count = .Uarg_Count - 1 ELSE BEGIN NOINT; ! Disable interrupts, do allocation IF NOT (LIB$GET_VM(%REF(Max_User_ArgBlk_Size*4),ptr)) THEN Memgr_Fault_Handler(0,.R0,0); OKINT; UA_Gets = .UA_gets + 1; IF .UA_gets GTR .UA_max THEN UA_max = .UA_gets; END; CH$FILL(%CHAR(0),Max_User_ArgBlk_Size*4,.Ptr); RETURN(.Ptr); END; %( Function: Deallocate one process-local user arg block. Inputs: Ptr = address of block to deallocate. Outputs: None. Side Effects: None. )% GLOBAL ROUTINE MM$UARG_Free(Ptr): NOVALUE = BEGIN LOCAL queptr; BUILTIN R0; ! standard vax/vms routine return value register. !!!HACK!!! This should be a conditional statement LOG$FAO('!%T Dealoc Uarg: Uarg=!XL!/',0,.quePtr); queptr = .Free_Uargs[QHead]; LOG$FAO('!%T Dealoc Uarg: !XL !XL !XL !XL!/',0, .queptr,..queptr,...queptr,....queptr); IF .Uarg_Count LSS .Uarg_Count_base THEN BEGIN !!!HACK!!! can an exception right here cause !!!HACK!!! CPU 00 -- DOUBLDEALO, Double deallocation of memory block???? INSQUE(.Ptr,.Free_Uargs[QTail]); Uarg_Count = .Uarg_Count + 1; END ELSE BEGIN NOINT; IF NOT (LIB$FREE_VM(%REF(Max_User_ArgBlk_Size*4),ptr)) THEN Memgr_Fault_Handler(0,.R0,0); OKINT; UA_Gets = .UA_gets - 1; END; END; %( Function: Preallocate Uarg blocks & queue them on the free list "Free_Uargs". Inputs: None. Outputs: None. Side Effects: Could die here if no avail memory. )% ROUTINE Uarg_Init: NOVALUE = BEGIN LOCAL Ptr; Uarg_count = .Uarg_count_base; INCR J FROM 1 TO .Uarg_count DO BEGIN LIB$GET_VM(%REF(Max_User_ArgBlk_Size*4),ptr); INSQUE(.Ptr,.Free_Uargs[QTail]); END; END; %SBTTL 'Segment Handlers' %( Function: Allocate one segment of specified size. Used to construct a TCP network segment. Allocation is always in BLISS Fullwords, size argument is rounded to e next bliss fullword. Routine is called from both user & AST modes of operation. Because of this fact we cannot allow AST's to be delivered when in this routine. Calling Conventions: CALLS, Default BLISS-32 linkage. Inputs: Size = Segment size in bytes Outputs: Address of segment Side Effects: AST delivery is disabled for the duration of this routine. This prevents the routine from being called & then called again from an AST service routine. )% GLOBAL ROUTINE MM$SEG_GET(Size) = BEGIN BUILTIN R0; ! standard vax/vms routine return value register. LOCAL Alloc: INITIAL(False), ! no seg allocation yet. Ptr; ! Respond to various size segments (ie, some may be preallocated.) SELECTONE .Size OF SET ! Minimum-sized segment buffer (control segs & small segs) [.MIN_PHYSICAL_BUFSIZE]: BEGIN IF REMQUE(.Free_Minsize_Segs[QHead],Ptr) NEQ Empty_Queue THEN BEGIN MIN_Seg_Count = .MIN_Seg_Count - 1; Alloc = True; END ELSE BEGIN MIN_gets = .MIN_gets + 1; IF .MIN_gets gtr .MIN_max THEN MIN_max = .MIN_gets; END; END; ! Max size segment - big segments to transmit & all receive buffers [.MAX_PHYSICAL_BUFSIZE]: BEGIN IF REMQUE(.Free_Maxsize_Segs[QHead],Ptr) NEQ Empty_Queue THEN BEGIN Max_Seg_Count = .Max_Seg_Count - 1; Alloc = True; END ELSE BEGIN MAX_gets = .MAX_gets + 1; IF .MAX_gets GTR .MAX_max THEN MAX_max = .MAX_gets; END; END; TES; ! Did we Allocate a segment yet? If not then better get one before we leave. IF NOT .Alloc THEN BEGIN NOINT; IF NOT (LIB$GET_VM(size,ptr)) THEN Memgr_Fault_Handler(0,.R0,0); OKINT; END; RETURN(.Ptr); END; %( Function: Deallocate one Segment. Size is specified in bytes BUT it is assumed that the actual allocation was done in bliss fullwords (ala MM$Seg_Get rtn). Inputs: Size = size of segment in bytes Ptr = address of segement. Outputs: None. Side Effects: AST delivery is disabled for the duration of this routine. Prevents user mode & AST service routines from stepping on each others toes. )% GLOBAL ROUTINE MM$SEG_FREE(Size,Ptr) : NOVALUE = BEGIN BUILTIN R0; ! standard vax/vms routine return value register. LOCAL Released: INITIAL(False); ! Check if segment is of a preallocated size. SELECTONE .Size OF SET [.MIN_PHYSICAL_BUFSIZE]: BEGIN IF .MIN_Seg_Count LSS .MIN_Seg_Count_base THEN BEGIN INSQue(.Ptr,.Free_Minsize_Segs[QTail]); MIN_Seg_Count = .MIN_Seg_Count + 1; Released = True; END ELSE MIN_gets = .MIN_gets - 1; END; [.MAX_PHYSICAL_BUFSIZE]: BEGIN IF .Max_Seg_Count LSS .Max_Seg_Count_base THEN BEGIN INSQUE(.Ptr,.Free_Maxsize_Segs[QTail]); Max_Seg_Count = .Max_Seg_Count + 1; Released = True; END ELSE MAX_gets = .MAX_gets - 1; END; TES; ! Did we actually release the segment? If not then do so. IF NOT .Released THEN BEGIN NOINT; IF NOT (LIB$FREE_VM(size,ptr)) THEN Memgr_Fault_Handler(0,.R0,0); OKINT; END; END; %( Function: Initialize the free control segment list. Inputs: None. Outputs: None. Side Effects: Can die if no memory. )% ROUTINE SEG_INIT : NOVALUE = BEGIN LOCAL Ptr; ! Allocate minimum (default) size segments. MIN_seg_count = .MIN_seg_count_base; INCR J FROM 0 TO .MIN_Seg_count-1 DO BEGIN LIB$GET_VM(MIN_PHYSICAL_BUFSIZE,ptr); INSQUE(.Ptr,.Free_Minsize_Segs[QTail]); END; ! Allocate maximum size segments MAX_seg_count = .MAX_seg_count_base; DECR J FROM .MAX_Seg_count TO 1 DO BEGIN LIB$GET_VM(MAX_PHYSICAL_BUFSIZE,ptr); INSQUE(.Ptr,.Free_Maxsize_Segs[QTail]); END; END; %Sbttl 'Memory Management Initialization.' %( Function: Initialize various aspects of dynamic memory preallocation. Inputs: None. Outputs: None. Side Effects: Specific dynamically allocated data structures are preallocated. )% GLOBAL ROUTINE MM$INIT : NOVALUE = BEGIN QBLK_Init(); Uarg_Init(); Seg_Init(); END; %SBTTL 'Debugging routines to simulate INSQUE and REMQUE' %( The routines MEM_INSQUE and MEM_REMQUE are called by the XINSQUE and XREMQUE macros when the QDEBUG flag has been turned on. **N.B.** This routines will currently only work for QBLKS since they are the only dynamic memory objects that have our special debugging header attached to them. Use of XINSQUE or XREMQUE with other dynamic memory objects will cause memory to be trashed. )% %IF QDEBUG %THEN GLOBAL ROUTINE MM$INSQUE(QBLK,QHDR,QRTN,QID,QVAL) = BEGIN LOCAL HPTR : REF MEM$HDR_STRUCT; HPTR = .QBLK - MEM$HDR_SIZE*4; HPTR[MEM$INSQUERTN] = .QRTN; HPTR[MEM$INSQUEHDR] = .QHDR; HPTR[MEM$INSQUEVAL] = .QVAL; HPTR[MEM$CURQUEUES] = .HPTR[MEM$CURQUEUES] OR .QID; HPTR[MEM$ALLQUEUES] = .HPTR[MEM$ALLQUEUES] OR .QID; RETURN INSQUE(.QBLK,.QHDR); END; GLOBAL ROUTINE MM$REMQUE(QHDR,QBLK,QRTN,QID,QVAL) = BEGIN LOCAL HPTR : REF MEM$HDR_STRUCT, RVAL; IF (RVAL = REMQUE(.QHDR,.QBLK)) NEQ Empty_Queue THEN BEGIN HPTR = ..QBLK - MEM$HDR_SIZE*4; HPTR[MEM$REMQUERTN] = .QRTN; HPTR[MEM$REMQUEHDR] = .QHDR; HPTR[MEM$REMQUEVAL] = .QVAL; HPTR[MEM$CURQUEUES] = .HPTR[MEM$CURQUEUES] AND (NOT .QID); END; RETURN .RVAL; END; %FI END ELUDOM