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

   1 USING: accessors alien.c-types arrays bit-arrays classes.struct compiler.cfg
   2 compiler.cfg.instructions compiler.cfg.stack-frame compiler.cfg.utilities
   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 38 bytes -- 6 bytes padding needed to
  42     ! align
  43     6 <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 - 20 bytes
  62     S{ vm:gc-info
  63        { scrub-d-count 5 }
  64        { scrub-r-count 2 }
  65        { gc-root-count 4 }
  66        { derived-root-count 3 }
  67        { return-address-count 1 }
  68     } (underlying)>> %
  69 ] B{ } make
  70 "expect" set
  71
  72 { t } [ "result" get length "expect" get length = ] unit-test
  73 { t } [ "result" get "expect" get = ] unit-test
  74
  75 ! Fix the gc root offset calculations
  76 SINGLETON: linux-x86.64
  77 M: linux-x86.64 reserved-stack-space 0 ;
  78 M: linux-x86.64 gc-root-offset
  79     n>> spill-offset cell + cell /i ;
  80
  81 : cfg-w-spill-area-base ( base -- cfg )
  82     stack-frame new swap >>spill-area-base
  83     { } insns>cfg swap >>stack-frame ;
  84
  85 cpu x86.64? [
  86     linux-x86.64 \ cpu set
  87
  88     ! gc-root-offsets
  89     { { 1 3 } } [
  90         0 cfg-w-spill-area-base cfg [
  91             T{ gc-map
  92                { gc-roots {
  93                    T{ spill-slot { n 0 } }
  94                    T{ spill-slot { n 16 } }
  95                } }
  96             } gc-root-offsets
  97         ] with-variable
  98     ] unit-test
  99
 100     { { 6 10 } } [
 101         32 cfg-w-spill-area-base cfg [
 102             T{ gc-map
 103                { gc-roots {
 104                    T{ spill-slot { n 8 } }
 105                    T{ spill-slot { n 40 } }
 106                } }
 107             } gc-root-offsets
 108         ] with-variable
 109     ] unit-test
 110
 111     ! scrub-d scrub-r gc-roots
 112     { { 0 0 5 } } [
 113         0 cfg-w-spill-area-base cfg [
 114             T{ gc-map
 115                { gc-roots {
 116                    T{ spill-slot { n 0 } }
 117                    T{ spill-slot { n 24 } }
 118                } }
 119             } 1array
 120             [ emit-gc-info-bitmaps ] B{ } make drop
 121         ] with-variable
 122     ] unit-test
 123
 124     ! scrub-d scrub-r gc-roots
 125     { { 0 0 9 } } [
 126         32 cfg-w-spill-area-base cfg [
 127             T{ gc-map
 128                { gc-roots {
 129                    T{ spill-slot { n 0 } }
 130                    T{ spill-slot { n 24 } }
 131                } }
 132             } 1array
 133             [ emit-gc-info-bitmaps ] B{ } make drop
 134         ] with-variable
 135     ] unit-test
 136
 137     fake-cpu \ cpu set
 138 ] when
 139
 140 ! largest-spill-slot
 141 {
 142     5 0 4 1
 143 } [
 144     { { 4 } } largest-spill-slot
 145     { { } } largest-spill-slot
 146     { { 2 3 } { 0 } } largest-spill-slot
 147     { { 0 } } largest-spill-slot
 148 ] unit-test
 149
 150 ! gc-map-needed?
 151 { t t } [
 152     T{ gc-map { scrub-d { 0 1 1 1 0 } } { scrub-r { 1 0 } } } gc-map-needed?
 153     T{ gc-map { scrub-d { 0 1 1 1 } } } gc-map-needed?
 154 ] unit-test
 155
 156 ! emit-scrub
 157 { 3 V{ t t t f f f } } [
 158     [ { { 0 0 0 } { 1 1 1 } } emit-scrub ] V{ } make
 159 ] unit-test
 160
 161 ! emit-gc-info-bitmaps
 162 {
 163     { 4 2 0 }
 164     V{ 1 }
 165 } [
 166     { T{ gc-map { scrub-d { 0 1 1 1 } } { scrub-r { 1 1 } } } }
 167     [ emit-gc-info-bitmaps ] V{ } make
 168 ] unit-test
 169
 170 {
 171     { 1 0 0 }
 172     V{ 1 }
 173 } [
 174     { T{ gc-map { scrub-d { 0 } } } }
 175     [ emit-gc-info-bitmaps ] V{ } make
 176 ] unit-test
 177
 178 ! derived-root-offsets
 179 USING: present prettyprint ;
 180 {
 181     V{ { 2 4 } }
 182 } [
 183     T{ gc-map { derived-roots V{ { 2 4 } } } }
 184     derived-root-offsets
 185 ] unit-test
 186
 187 ! emit-base-tables
 188 {
 189     3 B{ 255 255 255 255 255 255 255 255 4 0 0 0 }
 190 } [
 191     { T{ gc-map { derived-roots V{ { 2 4 } } } } }
 192     [ emit-base-tables ] B{ } make
 193 ] unit-test
 194
 195 ! serialize-gc-maps
 196 {
 197     B{ 0 0 0 0 }
 198 } [
 199     { } return-addresses set serialize-gc-maps
 200 ] unit-test
 201
 202 {
 203     B{ 17 123 0 0 0 5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 }
 204 } [
 205     { 123 } return-addresses set
 206     { T{ gc-map { scrub-d { 0 1 1 1 0 } } } } gc-maps set
 207     serialize-gc-maps
 208 ] unit-test
 209
 210 ! gc-info + ret-addr + 9bits (5+2+2) = 20 + 4 + 2 = 26
 211 { 26 } [
 212     {
 213         T{ gc-map
 214            { scrub-d { 0 1 1 1 0 } }
 215            { scrub-r { 1 0 } }
 216            { gc-roots V{ 1 3 } }
 217         }
 218     } gc-maps set
 219     { 123 } return-addresses set
 220     serialize-gc-maps length
 221 ] unit-test
 222
 223 ! gc-info + ret-addr + 3 base-pointers + 9bits = 20 + 4 + 12 + 2 = 38
 224 { 38 } [
 225     {
 226         T{ gc-map
 227            { scrub-d { 0 1 1 1 0 } }
 228            { scrub-r { 1 0 } }
 229            { gc-roots V{ 1 3 } }
 230            { derived-roots V{ { 2 4 } } }
 231         }
 232     } gc-maps set
 233     { 123 } return-addresses set
 234     serialize-gc-maps length
 235 ] unit-test