dynamic-memory-here

Dynamic memory allocation in the data space region



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\
\   User-interface words:
\
\     malloc   ( size -- pObj )        allocate the specified number of addresses for an object
\
\     mfree    ( pObj -- )             free the space used by an object
\
\     mresize  ( pObj size -- pObj' )  resize the amount of space used by an object. its 
\                                      original contents are moved to the new location. if
\                                      pObj is 0, a new object is created (malloc is called).
\                                      if size is 0, pObj is freed (mfree is called) and 0
\                                      is returned.
\
\     msize    ( pObj -- size )        get the number of addresses allocated for this object


\ uncommon words that might have been defined more efficiently by the system:
bl word [UNDEFINED] find nip 0= [IF]
: [UNDEFINED] bl word find nip 0= ; immediate
[THEN]

[UNDEFINED] cell- [IF] : cell- -1 cells + ; [THEN]
[UNDEFINED] 3pick [IF] : 3pick  3 pick    ; [THEN]
[UNDEFINED] 2pick [IF] : 2pick  2 pick    ; [THEN]
[UNDEFINED] <=    [IF] : <=     > 0=      ; [THEN]
[UNDEFINED] drop0 [IF] : drop0  drop 0    ; [THEN]
[UNDEFINED] swap- [IF] : swap-  swap -    ; [THEN]


\ All routines use these words to get and manipulate memory space.  Adjust these
\ definitions if you want/need to alter their default behavior, such as getting
\ memory from somewhere else.  These default implementations just use the original
\ equivalents as placeholders.
: _allot postpone allot ; immediate
: _here  postpone here  ; immediate
: _align postpone align ; immediate
: _,     postpone ,     ; immediate


\ If you'd rather use this code for a fixed heap, you can remove the conditionals
\ from mfree and mresize that start "over _obj_end _here = if", adjust _bub_list
\ to point to a large bubble of free memory that you've created above _bub_list
\ itself, and then do something very "abort"-like at the end of malloc, instead
\ of trying to create space at "here".


\ A pBubble is a two-cell record defining an unused region of memory that was freed,
\ previously.  Memory cells between pBubble and pBubble+F-1c (inclusive) could be
\ repurposed, if of sufficient size, for allocation.  The element pointing to pBubble
\ would need to be updated to either merge used regions, or F can be decreased by
\ enough to allocate more space.  If pNext is zero, the region from pBubble+F to
\ "here" is in use.
\
\ ("1c" means one 'cell', etc.  all pointers are cell-aligned.)
\
\
\        @pBubble+0c: pNext     - pointer to next bubble (or 0, if end of list)
\        @pBubble+1c: pBubble+F - pointer to end of this bubble
\  @pBubble+2c..F-1c: free memory
\      @pBubble+F...: used memory


\ A pObj is a pointer to the beginning of storage returned from mresize or malloc.
\ It is an aligned address, and the cell immediately before it stores the number of
\ addresses allocated:
\
\
\      @pObj-1c: N - number of addresses in this allocation
\  @pObj+0..N-1: user data 
\
\
\ Regions are only allocated as an integral number of *cells*, but the requested number
\ of *address locations* (number of bytes, for many systems) is recorded in the cell
\ before the object, in order to assist the user by allowing querying of the exact size.


\ _bub_list is a 0-space bubble after which more bubbles can be added.  This must be
\ at the lowest viable memory address for storage, since we use u< to compare addresses
\ while walking through the bubble list.
create _bub_list
here 0 , ,

: _size_to_cells aligned cell+                ; ( size -- a-size )
: _obj_get_size  cell- @                      ; ( pObj -- size )
: _obj_set_size  cell- !                      ; ( size pObj -- )
: _obj_start     cell-                        ; ( pObj -- addr )
: _obj_end       dup _obj_get_size aligned +  ; ( pObj -- addr )  \ compute the address just after this object
: _obj_num_cells _obj_get_size _size_to_cells ; ( pObj -- a-size )

: _bub_next      @                            ; ( pBub -- pBub' )
: _bub_end       cell+ @                      ; ( pBub -- pEnd  )
: _bub_set_end   cell+ !                      ; ( pEnd pBub --  )
: _bub_size      cell+ dup @ swap cell+ -     ; ( pBub -- size  ) \ conservative estimate for bubble size (size when keeping bubble pointers)
: _bub_resize    cell+ +!                     ; ( a-adj pBub -- ) \ change the size of free space at the end of this bubble by the specified (aligned) amount
: _bub_move      _bub_next 2@ 2pick 2!        ; ( dst prevBub -- dst ) \ move the bubble after prevBub to dst

\ find the address of the bubble right before 'pObj':
: _bub_prev  ( pObj -- pBub )
  _bub_list
  begin
    dup @ dup
  while
    ( pObj pBub pNext )
    dup 3pick u< if
      nip
    else
      drop nip exit
    then
  repeat
  drop
  nip
;

\ find a bubble large enough for an object of 'size' addresses, or return 0:
\ UNIMPLEMENTED: could return the entirety of a bubble, if the caller can "pop" the
\ bubble and the object will fit exactly.
: _bub_find  ( size -- pBub | 0 )
  _size_to_cells
  
  _bub_list @
  begin
    dup
  while
    2dup _bub_size <= if
      nip exit
    then
    @
  repeat
  nip
;

: _adj_this over _obj_start over _bub_end = ; ( pObj pBub -- pObj pBub flag )  \ if pObj starts right at the end of this bubble
: _adj_next over _obj_end over _bub_next =  ; ( pObj pBub -- pObj pBub flag )  \ if pObj ends right at the start of the next bubble



\ get the size of the allocated object
: msize  ( pObj -- size )
  dup if _obj_get_size then
;



\ allocate an object of the given number of bytes
: malloc  ( size -- pObj )
  \ return null pointer for 0-size objects :
  dup 0= if exit then
  
  dup _bub_find dup if
    ( size pBub )
    
    \ shrink the bubble:
    over _size_to_cells negate over _bub_resize
    
    \ and use the new space for the object:
    _bub_end tuck ! cell+ exit
  then
  
  drop
  \ just allocate from 'here' (aligned)
  ( size -- pObj )
  dup _size_to_cells unused > abort" out of memory"
  _align dup _,
  _here swap aligned _allot
;



\ free a previously-allocated object
: mfree  ( pObj -- )

  \ no-op if null pointer:
  dup 0= if drop exit then
  
  \ find the previous bubble:
  dup _bub_prev
  ( pObj pBub )
  
  \ if pObj ends right at 'here':
  over _obj_end _here = if
    \ rewind 'here' to de-allot:
    over _obj_num_cells negate _allot
    
    _adj_this if
      \ remove this bubble if pObj was adjacent:
      nip 0 over _bub_prev !
      \ and rewind 'here' further:
      _here - _allot
    else
      2drop
    then
    
    exit
  then
  
  ( pObj pBub )
  _adj_this if
    _adj_next if
      \ adjacent to both bubbles, merge them:
      dup _bub_move
      2drop
      exit
    then
    
    \ expand this bubble by the number of cells used for pObj:
    swap _obj_num_cells swap _bub_resize
    exit
  then
  
  ( pObj pBub )
  _adj_next if
    \ expand the next bubble by moving it to pObj:
    swap _obj_start over _bub_move swap !
    exit
  then
  
  \ create a new bubble at pObj
  ( pObj pBub )
  swap dup _obj_end over ! _obj_start
  
  \ and insert it into the chain:
  ( pBub pNew )
  swap 2dup _bub_next swap ! !
;


\ try to resize the object in place, if there is enough room
\ either return success and the original object, or failure and the original stack
: _grow_in_place    ( size pObj pBub -- pObj -1 | size pObj pBub 0 )
  \ end of new object if resized in-place:
  over 3pick aligned +
  ( size pObj pBub objNewEnd )

  \ end of next bubble (minus bubble info):
  over _bub_next _bub_end -2 cells +
  over < if
    drop0
    exit
  then
  
  \ can resize in-place just by moving next bubble:
  ( size pObj pBub objNewEnd )
  over _bub_move
  swap !
  tuck _obj_start ! -1
;



\ try to shrink the object in place, if enough room frees up for a new bubble
\ either return success and the original object, or failure and the original stack
: _shrink_in_place    ( size pObj pBub -- pObj -1 | size pObj pBub 0 )
  >r
  over _size_to_cells
  over _obj_num_cells - -2 cells > if
    r> 0 exit
  then
  
  dup _obj_end >r                \ save orig obj end before shrinking
  tuck _obj_set_size             \ tuck the object and set a new size
  r> over _obj_end tuck _bub_set_end  \ new bubble ends at orig obj end
  r@ _bub_next over !            \ new bubble points to pBub's next
  r> !                           \ pBub now points to new bubble
  -1                             \ return success!
;



\ resize a previously-allocated object
: mresize  ( pObj size -- pObj' )

  \ null-ptr in means just call malloc:
  over 0= if nip malloc exit then
  
  \ zero-byte request means free object:
  dup 0= if swap mfree exit then
  
  \ option 1: current aligned size is same as aligned request.  update size field and exit:
  \ (e.g., when an object grows by one byte, and that is not enough to need more cells)
  over _obj_get_size aligned over aligned = if
    over _obj_set_size exit
  then
  
  \ option 2: object is right before 'here'.  simply call _allot to adjust its size:
  over _obj_end _here = if
    over _obj_get_size aligned over aligned swap- _allot
    over _obj_set_size exit
  then
  
  \ otherwise, find the nearest bubble:
  swap dup _bub_prev
  ( size pObj pBub )

  \ option 3: object is just before a bubble that has enough room for it to grow:
  _adj_next if
    _grow_in_place if
      exit
    then
  else
    \ option 4: object is shrinking by more than 2 cells and is not adjacent
    \ to the next bubble.  shrink in-place and make a new bubble in the freed space.
    _shrink_in_place if
      exit
    then
  then
  drop
  
  \ default: no free space found in adjacent bubbles.  call malloc, move object, and mfree original:
  swap malloc
  ( pOld pNew )
  
  tuck over swap
  ( pNew pOld pOld pNew )
  
  over _obj_get_size over _obj_get_size min
  ( pNew pOld pOld pNew minsize )
  
  move
  mfree
;


by JimPeterson

avatar of JimPeterson

Versions

1.0.0

Download current as zip

Tags

forth-2012, memory, allocation

Dependencies

None

Dependents

None