home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap36 / mem.bas < prev    next >
BASIC Source File  |  1995-09-19  |  2KB  |  73 lines
  1. Attribute VB_Name = "basMem"
  2. '=====================================================================
  3. 'MEM.BAS by Frank Font 1995
  4. '
  5. 'This VB 4 file contains functions and definitions
  6. 'for constructing and manipulating a memory pool.
  7. '
  8. 'The memory pool is simulated by an array of type memrec_t.  The
  9. 'memrec_t type is defined elsewhere.
  10. '
  11. '*********************************************************************
  12. 'NOTE: These program procedures are for entertainment purposes ONLY.
  13. '=====================================================================
  14. Option Explicit
  15.  
  16. '---------------------------------------------------------------------
  17. 'Makes the specified memPool element available
  18. 'again for re-allocation.
  19. '---------------------------------------------------------------------
  20. Public Sub Mem_free(index As Long)
  21.   memPool(index).status = False
  22. End Sub
  23.  
  24. '---------------------------------------------------------------------
  25. 'Initializes the memPool array to empty.
  26. '---------------------------------------------------------------------
  27. Public Sub InitmemPool()
  28.   MemPoolSize = JobsInProject * EmpsInPool + 1024
  29.   ReDim memPool(MemPoolSize + 1)
  30.   Dim i As Long
  31.   
  32.   For i = 0 To MemPoolSize
  33.     memPool(i).status = False
  34.   Next i
  35. End Sub
  36.  
  37. '---------------------------------------------------------------------
  38. 'Returns index into the memPool array that
  39. 'can be used to store new data.
  40. '---------------------------------------------------------------------
  41. Public Function Mem_alloc() As Long
  42.   Dim i As Long
  43.   i = 0
  44.     
  45.   While True
  46.     While i < MemPoolSize
  47.       If memPool(i).status = False Then
  48.         memPool(i).status = True
  49.         Mem_alloc = i
  50.         Exit Function
  51.       End If
  52.       i = i + 1
  53.     Wend
  54.     'Need to allocate more memory to the pool.
  55.     On Error GoTo mem_alloc_NoMemory
  56.     MemPoolSize = MemPoolSize + 1024
  57.     ReDim Preserve memPool(MemPoolSize)
  58.     Dim j  'Here for speed.
  59.     For j = i To MemPoolSize
  60.       memPool(j).status = False
  61.     Next j
  62.     On Error GoTo 0
  63.     DoEvents
  64.   Wend
  65.  
  66. mem_alloc_NoMemory:
  67.   Beep
  68.   MsgBox "Fatal Error - Out of internal memory pool!", 16, gProgramTitle
  69.   End
  70.  
  71. End Function
  72.  
  73.