qemu/roms/SLOF/slof/fs/alloc-mem-debug.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2011 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 \ * Dynamic memory allocation/de-allocation debug functions
  13 \ *****************************************************************************
  14
  15
  16 \ Uncomment the following code for debugging bad write accesses beyond
  17 \ the end of the allocated block:
  18 \ Store magic value past the end of the block during alloc-mem and
  19 \ check for this magic value when free-mem has been called.
  20 #if 1
  21 : alloc-mem  ( len -- addr )
  22    dup /n + alloc-mem    ( len addr )
  23    2dup + 3141592653589793 swap ! nip
  24 ;
  25
  26 : free-mem  ( addr len -- )
  27    2dup + @ 3141592653589793 <> IF
  28       cr ." Detected memory corrupt during free-mem of "
  29       swap . . cr EXIT
  30    THEN
  31    /n + free-mem
  32 ;
  33 #endif
  34
  35
  36 \ Never ever assume that allocated memory is pre-initialized with 0 ...
  37 : alloc-mem  ( len -- addr )
  38    dup alloc-mem  swap 2dup ff fill drop
  39 ;
  40
  41 \ Make sure that memory block do not contain "valid" data after free-mem:
  42 : free-mem  ( addr len -- )
  43    2dup ff fill  free-mem
  44 ;
  45
  46
  47 \ The following definitions are used for debugging the parameters of free-mem:
  48 \ Store block address and size of allocated blocks
  49 \ in an array, then check for right values on free-mem.
  50
  51 1000 CONSTANT max-malloced-blocks
  52 CREATE malloced-blocks max-malloced-blocks 2 * cells allot
  53 malloced-blocks max-malloced-blocks 2 * cells erase
  54
  55
  56 : alloc-mem  ( len -- addr )
  57    dup alloc-mem dup 0= IF
  58       cr ." alloc-mem returned 0 for size " swap . cr EXIT
  59    THEN                                        ( len addr )
  60    malloced-blocks max-malloced-blocks 0 DO    ( len addr m-blocks-ptr )
  61       dup @ 0= IF                              ( len addr m-blocks-ptr )
  62          \ Found a free entry: store addr and len
  63          over >r dup >r !
  64          r> cell+ !
  65          r> UNLOOP EXIT
  66       THEN
  67       cell+ cell+                              ( len addr next-m-blocks-ptr )
  68    LOOP
  69    ." Please increase max-malloced-blocks." cr ( len addr next-m-blocks-ptr )
  70    drop nip
  71 ;
  72
  73
  74 : free-mem  ( addr len -- )
  75    malloced-blocks max-malloced-blocks 0 DO    ( addr len m-blocks-ptr )
  76       dup @ ?dup IF
  77          ( addr len m-blocks-ptr s-addr )
  78          3 pick = IF
  79             ( addr len m-blocks-ptr )
  80             dup cell+ @     ( addr len m-blocks-ptr s-len )
  81             2 pick = IF     ( addr len m-blocks-ptr )
  82                \ All right, addr and len matched,
  83                \ clear entry and call original free-mem.
  84                dup cell+ 0 swap !
  85                0 swap !
  86                free-mem
  87             ELSE
  88                >r swap cr
  89                ." free-mem called for block " . ." with wrong size=" . cr
  90                ." ( correct size should be: " r> cell+ @ . ." )" cr
  91             THEN
  92             UNLOOP EXIT
  93          THEN                 ( addr len m-blocks-ptr )
  94       THEN
  95       cell+ cell+             ( addr len next-m-blocks-ptr )
  96    LOOP
  97    drop swap cr
  98    ." free-mem called for block " .
  99    ." ( size=" .
 100    ." ) which has never been allocated before!" cr
 101 ;
 102
 103
 104 \ Enable these for verbose debug messages:
 105 #if 0
 106 : alloc-mem
 107    cr ." alloc-mem with len=" dup .
 108    alloc-mem
 109    ."  returned addr=" dup . cr
 110 ;
 111
 112 : free-mem
 113    cr ." free mem addr=" over . ."  len=" dup . cr
 114    free-mem
 115 ;
 116 #endif