← Back to branch summary

~pmdj/ubuntu/trusty/qemu/2.9+applesmc+fadtv3

« back to all changes in this revision

Viewing changes to roms/SLOF/slof/fs/alloc-mem.fs

  • Committer: Phil Dennis-Jordan
  • Date: 2017-07-21 08:03:43 UTC
  • mfrom: (1.1.1)
  • Revision ID: phil@philjordan.eu-20170721080343-2yr2vdj7713czahv
New upstream release 2.9.0.

Show diffs side-by-side

added added

removed removed

Lines of Context:
roms/SLOF/slof/fs/alloc-mem.fs
 
1
\ *****************************************************************************
 
2
\ * Copyright (c) 2004, 2008 IBM Corporation
 
3
\ * All rights reserved.
 
4
\ * This program and the accompanying materials
 
5
\ * are made available under the terms of the BSD License
 
6
\ * which accompanies this distribution, and is available at
 
7
\ * http://www.opensource.org/licenses/bsd-license.php
 
8
\ *
 
9
\ * Contributors:
 
10
\ *     IBM Corporation - initial implementation
 
11
\ ****************************************************************************/
 
12
 
 
13
#include <claim.fs>
 
14
\ Memory "heap" (de-)allocation.
 
15
 
 
16
\ Keep a linked list of free blocks per power-of-two size.
 
17
\ Never coalesce entries when freed; split blocks when needed while allocating.
 
18
 
 
19
\ 3f CONSTANT (max-heads#)
 
20
heap-end heap-start - log2 1+ CONSTANT (max-heads#)
 
21
 
 
22
CREATE heads (max-heads#) cells allot
 
23
heads (max-heads#) cells erase
 
24
 
 
25
 
 
26
: size>head  ( size -- headptr )  log2 3 max cells heads + ;
 
27
 
 
28
 
 
29
\ Allocate a memory block
 
30
: alloc-mem  ( len -- a-addr )
 
31
   dup 0= IF EXIT THEN
 
32
   1 over log2 3 max                   ( len 1 log_len )
 
33
   dup (max-heads#) >= IF cr ." Out of internal memory." cr 3drop 0 EXIT THEN
 
34
   lshift >r                           ( len  R: 1<<log_len )
 
35
   size>head dup @ IF
 
36
      dup @ dup >r @ swap ! r> r> drop EXIT
 
37
   THEN                                ( headptr  R: 1<<log_len)
 
38
   r@ 2* recurse dup                   ( headptr a-addr2 a-addr2  R: 1<<log_len)
 
39
   dup 0= IF r> 2drop 2drop 0 EXIT THEN
 
40
   r> + >r 0 over ! swap ! r>
 
41
;
 
42
 
 
43
 
 
44
\ Free a memory block
 
45
 
 
46
: free-mem  ( a-addr len -- )
 
47
   dup 0= IF 2drop EXIT THEN size>head 2dup @ swap ! !
 
48
;
 
49
 
 
50
 
 
51
: #links  ( a -- n )
 
52
   @ 0 BEGIN over WHILE 1+ swap @ swap REPEAT nip
 
53
;
 
54
 
 
55
 
 
56
: .free  ( -- )
 
57
   0 (max-heads#) 0 DO
 
58
      heads i cells + #links dup IF
 
59
         cr dup . ." * " 1 i lshift dup . ." = " * dup .
 
60
      THEN
 
61
      +
 
62
   LOOP
 
63
   cr ." Total " .
 
64
;
 
65
 
 
66
 
 
67
\ Start with just one free block.
 
68
heap-start heap-end heap-start - free-mem
 
69
 
 
70
 
 
71
\ : free-mem  ( a-addr len -- ) 2drop ;
 
72
 
 
73
\ Uncomment the following line for debugging:
 
74
\ #include <alloc-mem-debug.fs>
 
75