basis/compiler/codegen/gc-maps/gc-maps-tests.factor

   1 USING: accessors alien.c-types arrays bit-arrays classes.struct
   2 compiler.cfg.instructions compiler.cfg.stack-frame
   3 compiler.codegen.gc-maps compiler.codegen.relocation cpu.architecture
   4 cpu.x86 byte-arrays make namespaces kernel layouts math sequences
   5 specialized-arrays system tools.test ;
   6 QUALIFIED: vm
   7 SPECIALIZED-ARRAY: uint
   8 IN: compiler.codegen.gc-maps.tests
   9
  10 SINGLETON: fake-cpu
  11
  12 fake-cpu \ cpu set
  13
  14 M: fake-cpu gc-root-offset ;
  15
  16 [
  17     init-relocation
  18     init-gc-maps
  19
  20     50 <byte-array> %
  21
  22     <gc-map> gc-map-here
  23
  24     50 <byte-array> %
  25
  26     T{ gc-map
  27        { scrub-d { 0 1 1 1 0 } }
  28        { scrub-r { 1 0 } }
  29        { gc-roots V{ 1 3 } }
  30        { derived-roots V{ { 2 4 } } }
  31     } gc-map-here
  32     emit-gc-maps
  33 ] B{ } make
  34 "result" set
  35
  36 [ 0 ] [ "result" get length 16 mod ] unit-test
  37
  38 [
  39     100 <byte-array> %
  40
  41     ! The below data is 46 bytes -- 14 bytes padding needed to
  42     ! align
  43     14 <byte-array> %
  44
  45     ! Bitmap - 2 bytes
  46     ?{
  47         ! scrub-d
  48         t f f f t
  49         ! scrub-r
  50         f t
  51         ! gc-roots
  52         f t f t
  53     } underlying>> %
  54
  55     ! Derived pointers
  56     uint-array{ -1 -1 4 } underlying>> %
  57
  58     ! Return addresses
  59     uint-array{ 100 } underlying>> %
  60
  61     ! GC info footer - 28 bytes
  62     S{ vm:gc-info
  63        { scrub-d-count 5 }
  64        { scrub-r-count 2 }
  65        { check-d-count 0 }
  66        { check-r-count 0 }
  67        { gc-root-count 4 }
  68        { derived-root-count 3 }
  69        { return-address-count 1 }
  70     } (underlying)>> %
  71 ] B{ } make
  72 "expect" set
  73
  74 [ t ] [ "result" get length "expect" get length = ] unit-test
  75 [ t ] [ "result" get "expect" get = ] unit-test
  76
  77 ! Fix the gc root offset calculations
  78 SINGLETON: linux-x86.64
  79 M: linux-x86.64 reserved-stack-space 0 ;
  80 M: linux-x86.64 gc-root-offset
  81     n>> spill-offset cell + cell /i ;
  82
  83 cpu x86.64? [
  84     linux-x86.64 \ cpu set
  85
  86     ! gc-root-offsets
  87     { { 1 3 } } [
  88         T{ stack-frame { spill-area-base 0 } } stack-frame [
  89             T{ gc-map
  90                { gc-roots {
  91                    T{ spill-slot { n 0 } }
  92                    T{ spill-slot { n 16 } }
  93                } }
  94             } gc-root-offsets
  95         ] with-variable
  96     ] unit-test
  97
  98     { { 6 10 } } [
  99         T{ stack-frame { spill-area-base 32 } } stack-frame [
 100             T{ gc-map
 101                { gc-roots {
 102                    T{ spill-slot { n 8 } }
 103                    T{ spill-slot { n 40 } }
 104                } }
 105             } gc-root-offsets
 106         ] with-variable
 107     ] unit-test
 108
 109     ! scrub-d scrub-r check-d check-r gc-roots
 110     { { 0 0 0 0 5 } } [
 111         T{ stack-frame { spill-area-base 0 } } stack-frame [
 112             T{ gc-map
 113                { gc-roots {
 114                    T{ spill-slot { n 0 } }
 115                    T{ spill-slot { n 24 } }
 116                } }
 117             } 1array gc-maps set
 118             [ emit-gc-info-bitmaps ] B{ } make drop
 119         ] with-variable
 120     ] unit-test
 121
 122     ! scrub-d scrub-r check-d check-r gc-roots
 123     { { 0 0 0 0 9 } } [
 124         T{ stack-frame { spill-area-base 32 } } stack-frame [
 125             T{ gc-map
 126                { gc-roots {
 127                    T{ spill-slot { n 0 } }
 128                    T{ spill-slot { n 24 } }
 129                } }
 130             } 1array gc-maps set
 131             [ emit-gc-info-bitmaps ] B{ } make drop
 132         ] with-variable
 133     ] unit-test
 134
 135     fake-cpu \ cpu set
 136 ] when
 137
 138 ! gc-map-needed?
 139 { t t } [
 140     T{ gc-map { scrub-d { 0 1 1 1 0 } } { scrub-r { 1 0 } } } gc-map-needed?
 141     T{ gc-map { check-d { 0 1 1 1 } } } gc-map-needed?
 142 ] unit-test
 143
 144 ! emit-scrub
 145 { 3 V{ t t t f f f } } [
 146     [ { { 0 0 0 } { 1 1 1 } } emit-scrub ] V{ } make
 147 ] unit-test
 148
 149 ! emit-gc-info-bitmaps
 150 {
 151     { 4 2 0 0 0 }
 152     V{ 1 }
 153 } [
 154     { T{ gc-map { scrub-d { 0 1 1 1 } } { scrub-r { 1 1 } } } } gc-maps set
 155     [ emit-gc-info-bitmaps ] V{ } make
 156 ] unit-test
 157
 158 {
 159     { 1 0 1 0 0 }
 160     V{ 3 }
 161 } [
 162     { T{ gc-map { scrub-d { 0 } } { check-d { 0 } } } } gc-maps set
 163     [ emit-gc-info-bitmaps ] V{ } make
 164 ] unit-test
 165
 166 ! derived-root-offsets
 167 USING: present prettyprint ;
 168 {
 169     V{ { 2 4 } }
 170 } [
 171     T{ gc-map { derived-roots V{ { 2 4 } } } }
 172     derived-root-offsets
 173 ] unit-test
 174
 175 ! emit-base-tables
 176 {
 177     3 B{ 255 255 255 255 255 255 255 255 4 0 0 0 }
 178 } [
 179     { T{ gc-map { derived-roots V{ { 2 4 } } } } } gc-maps set
 180     [ emit-base-tables ] B{ } make
 181 ] unit-test
 182
 183
 184 ! serialize-gc-maps
 185 {
 186     B{ 0 0 0 0 }
 187 } [
 188     { } return-addresses set serialize-gc-maps
 189 ] unit-test
 190
 191 {
 192     B{
 193         17 123 0 0 0 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 194         1 0 0 0
 195     }
 196 } [
 197     { 123 } return-addresses set
 198     { T{ gc-map { scrub-d { 0 1 1 1 0 } } } } gc-maps set
 199     serialize-gc-maps
 200 ] unit-test
 201
 202 ! gc-info + ret-addr + 9bits (5+2+2) = 28 + 4 + 2 = 34
 203 { 34 } [
 204     {
 205         T{ gc-map
 206            { scrub-d { 0 1 1 1 0 } }
 207            { scrub-r { 1 0 } }
 208            { gc-roots V{ 1 3 } }
 209         }
 210     } gc-maps set
 211     { 123 } return-addresses set
 212     serialize-gc-maps length
 213 ] unit-test
 214
 215 ! gc-info + ret-addr + 3 base-pointers + 9bits = 28 + 4 + 12 + 2 = 46
 216 { 46 } [
 217     {
 218         T{ gc-map
 219            { scrub-d { 0 1 1 1 0 } }
 220            { scrub-r { 1 0 } }
 221            { gc-roots V{ 1 3 } }
 222            { derived-roots V{ { 2 4 } } }
 223         }
 224     } gc-maps set
 225     { 123 } return-addresses set
 226     serialize-gc-maps length
 227 ] unit-test