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 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 cpu x86.64? [
  82     linux-x86.64 \ cpu set
  83
  84     ! gc-root-offsets
  85     { { 1 3 } } [
  86         T{ stack-frame { spill-area-base 0 } } stack-frame [
  87             T{ gc-map
  88                { gc-roots {
  89                    T{ spill-slot { n 0 } }
  90                    T{ spill-slot { n 16 } }
  91                } }
  92             } gc-root-offsets
  93         ] with-variable
  94     ] unit-test
  95
  96     { { 6 10 } } [
  97         T{ stack-frame { spill-area-base 32 } } stack-frame [
  98             T{ gc-map
  99                { gc-roots {
 100                    T{ spill-slot { n 8 } }
 101                    T{ spill-slot { n 40 } }
 102                } }
 103             } gc-root-offsets
 104         ] with-variable
 105     ] unit-test
 106
 107     ! scrub-d scrub-r gc-roots
 108     { { 0 0 5 } } [
 109         T{ stack-frame { spill-area-base 0 } } stack-frame [
 110             T{ gc-map
 111                { gc-roots {
 112                    T{ spill-slot { n 0 } }
 113                    T{ spill-slot { n 24 } }
 114                } }
 115             } 1array gc-maps set
 116             [ emit-gc-info-bitmaps ] B{ } make drop
 117         ] with-variable
 118     ] unit-test
 119
 120     ! scrub-d scrub-r gc-roots
 121     { { 0 0 9 } } [
 122         T{ stack-frame { spill-area-base 32 } } stack-frame [
 123             T{ gc-map
 124                { gc-roots {
 125                    T{ spill-slot { n 0 } }
 126                    T{ spill-slot { n 24 } }
 127                } }
 128             } 1array gc-maps set
 129             [ emit-gc-info-bitmaps ] B{ } make drop
 130         ] with-variable
 131     ] unit-test
 132
 133     fake-cpu \ cpu set
 134 ] when
 135
 136 ! gc-map-needed?
 137 { t t } [
 138     T{ gc-map { scrub-d { 0 1 1 1 0 } } { scrub-r { 1 0 } } } gc-map-needed?
 139     T{ gc-map { scrub-d { 0 1 1 1 } } } gc-map-needed?
 140 ] unit-test
 141
 142 ! emit-scrub
 143 { 3 V{ t t t f f f } } [
 144     [ { { 0 0 0 } { 1 1 1 } } emit-scrub ] V{ } make
 145 ] unit-test
 146
 147 ! emit-gc-info-bitmaps
 148 {
 149     { 4 2 0 }
 150     V{ 1 }
 151 } [
 152     { T{ gc-map { scrub-d { 0 1 1 1 } } { scrub-r { 1 1 } } } } gc-maps set
 153     [ emit-gc-info-bitmaps ] V{ } make
 154 ] unit-test
 155
 156 {
 157     { 1 0 0 }
 158     V{ 1 }
 159 } [
 160     { T{ gc-map { scrub-d { 0 } } } } gc-maps set
 161     [ emit-gc-info-bitmaps ] V{ } make
 162 ] unit-test
 163
 164 ! derived-root-offsets
 165 USING: present prettyprint ;
 166 {
 167     V{ { 2 4 } }
 168 } [
 169     T{ gc-map { derived-roots V{ { 2 4 } } } }
 170     derived-root-offsets
 171 ] unit-test
 172
 173 ! emit-base-tables
 174 {
 175     3 B{ 255 255 255 255 255 255 255 255 4 0 0 0 }
 176 } [
 177     { T{ gc-map { derived-roots V{ { 2 4 } } } } } gc-maps set
 178     [ emit-base-tables ] B{ } make
 179 ] unit-test
 180
 181 ! serialize-gc-maps
 182 {
 183     B{ 0 0 0 0 }
 184 } [
 185     { } return-addresses set serialize-gc-maps
 186 ] unit-test
 187
 188 {
 189     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 }
 190 } [
 191     { 123 } return-addresses set
 192     { T{ gc-map { scrub-d { 0 1 1 1 0 } } } } gc-maps set
 193     serialize-gc-maps
 194 ] unit-test
 195
 196 ! gc-info + ret-addr + 9bits (5+2+2) = 20 + 4 + 2 = 26
 197 { 26 } [
 198     {
 199         T{ gc-map
 200            { scrub-d { 0 1 1 1 0 } }
 201            { scrub-r { 1 0 } }
 202            { gc-roots V{ 1 3 } }
 203         }
 204     } gc-maps set
 205     { 123 } return-addresses set
 206     serialize-gc-maps length
 207 ] unit-test
 208
 209 ! gc-info + ret-addr + 3 base-pointers + 9bits = 20 + 4 + 12 + 2 = 38
 210 { 38 } [
 211     {
 212         T{ gc-map
 213            { scrub-d { 0 1 1 1 0 } }
 214            { scrub-r { 1 0 } }
 215            { gc-roots V{ 1 3 } }
 216            { derived-roots V{ { 2 4 } } }
 217         }
 218     } gc-maps set
 219     { 123 } return-addresses set
 220     serialize-gc-maps length
 221 ] unit-test