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
 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
 129             [ emit-gc-info-bitmaps ] B{ } make drop
 130         ] with-variable
 131     ] unit-test
 132
 133     fake-cpu \ cpu set
 134 ] when
 135
 136 ! largest-spill-slot
 137 {
 138     5 0 4 1
 139 } [
 140     { { 4 } } largest-spill-slot
 141     { { } } largest-spill-slot
 142     { { 2 3 } { 0 } } largest-spill-slot
 143     { { 0 } } largest-spill-slot
 144 ] unit-test
 145
 146 ! gc-map-needed?
 147 { t t } [
 148     T{ gc-map { scrub-d { 0 1 1 1 0 } } { scrub-r { 1 0 } } } gc-map-needed?
 149     T{ gc-map { scrub-d { 0 1 1 1 } } } gc-map-needed?
 150 ] unit-test
 151
 152 ! emit-scrub
 153 { 3 V{ t t t f f f } } [
 154     [ { { 0 0 0 } { 1 1 1 } } emit-scrub ] V{ } make
 155 ] unit-test
 156
 157 ! emit-gc-info-bitmaps
 158 {
 159     { 4 2 0 }
 160     V{ 1 }
 161 } [
 162     { T{ gc-map { scrub-d { 0 1 1 1 } } { scrub-r { 1 1 } } } }
 163     [ emit-gc-info-bitmaps ] V{ } make
 164 ] unit-test
 165
 166 {
 167     { 1 0 0 }
 168     V{ 1 }
 169 } [
 170     { T{ gc-map { scrub-d { 0 } } } }
 171     [ emit-gc-info-bitmaps ] V{ } make
 172 ] unit-test
 173
 174 ! derived-root-offsets
 175 USING: present prettyprint ;
 176 {
 177     V{ { 2 4 } }
 178 } [
 179     T{ gc-map { derived-roots V{ { 2 4 } } } }
 180     derived-root-offsets
 181 ] unit-test
 182
 183 ! emit-base-tables
 184 {
 185     3 B{ 255 255 255 255 255 255 255 255 4 0 0 0 }
 186 } [
 187     { T{ gc-map { derived-roots V{ { 2 4 } } } } }
 188     [ emit-base-tables ] B{ } make
 189 ] unit-test
 190
 191 ! serialize-gc-maps
 192 {
 193     B{ 0 0 0 0 }
 194 } [
 195     { } return-addresses set serialize-gc-maps
 196 ] unit-test
 197
 198 {
 199     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 }
 200 } [
 201     { 123 } return-addresses set
 202     { T{ gc-map { scrub-d { 0 1 1 1 0 } } } } gc-maps set
 203     serialize-gc-maps
 204 ] unit-test
 205
 206 ! gc-info + ret-addr + 9bits (5+2+2) = 20 + 4 + 2 = 26
 207 { 26 } [
 208     {
 209         T{ gc-map
 210            { scrub-d { 0 1 1 1 0 } }
 211            { scrub-r { 1 0 } }
 212            { gc-roots V{ 1 3 } }
 213         }
 214     } gc-maps set
 215     { 123 } return-addresses set
 216     serialize-gc-maps length
 217 ] unit-test
 218
 219 ! gc-info + ret-addr + 3 base-pointers + 9bits = 20 + 4 + 12 + 2 = 38
 220 { 38 } [
 221     {
 222         T{ gc-map
 223            { scrub-d { 0 1 1 1 0 } }
 224            { scrub-r { 1 0 } }
 225            { gc-roots V{ 1 3 } }
 226            { derived-roots V{ { 2 4 } } }
 227         }
 228     } gc-maps set
 229     { 123 } return-addresses set
 230     serialize-gc-maps length
 231 ] unit-test