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

   1 USING: accessors alien.c-types arrays bit-arrays byte-arrays
   2 classes.struct compiler.cfg compiler.cfg.instructions
   3 compiler.cfg.stack-frame compiler.cfg.utilities
   4 compiler.codegen.gc-maps compiler.codegen.relocation cpu.architecture
   5 cpu.x86 kernel layouts make math namespaces sequences
   6 specialized-arrays system tools.test ;
   7 QUALIFIED: vm
   8 SPECIALIZED-ARRAY: uint
   9 IN: compiler.codegen.gc-maps.tests
  10
  11 SINGLETON: fake-cpu
  12
  13 fake-cpu \ cpu set
  14
  15 M: fake-cpu gc-root-offset ;
  16
  17 [
  18     init-relocation
  19     V{ } clone return-addresses set
  20     V{ } clone gc-maps set
  21
  22     50 <byte-array> %
  23
  24     <gc-map> gc-map-here
  25
  26     50 <byte-array> %
  27
  28     T{ gc-map
  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 29 bytes -- 15 bytes padding needed to
  42     ! align
  43     15 <byte-array> %
  44
  45     ! Bitmap - 1 byte
  46     ?{
  47         ! gc-roots
  48         f t f t
  49     } underlying>> %
  50
  51     ! Derived pointers - 12 bytes
  52     uint-array{ -1 -1 4 } underlying>> %
  53
  54     ! Return addresses - 4 bytes
  55     uint-array{ 100 } underlying>> %
  56
  57     ! GC info footer - 12 bytes
  58     S{ vm:gc-info
  59        { gc-root-count 4 }
  60        { derived-root-count 3 }
  61        { return-address-count 1 }
  62     } (underlying)>> %
  63 ] B{ } make
  64 "expect" set
  65
  66 { t } [ "result" get length "expect" get length = ] unit-test
  67 { t } [ "result" get "expect" get = ] unit-test
  68
  69 ! Fix the gc root offset calculations
  70 SINGLETON: linux-x86.64
  71 M: linux-x86.64 reserved-stack-space 0 ;
  72 M: linux-x86.64 gc-root-offset
  73     n>> spill-offset cell + cell /i ;
  74
  75 : cfg-w-spill-area-base ( base -- cfg )
  76     stack-frame new swap >>spill-area-base
  77     { } insns>cfg swap >>stack-frame ;
  78
  79 : array>spill-slots ( seq -- spills )
  80     [ spill-slot boa ] map ;
  81
  82 : <gc-map/spills> ( spills -- gc-map )
  83     array>spill-slots { } gc-map boa ;
  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             { 0 16 } <gc-map/spills> gc-root-offsets
  92         ] with-variable
  93     ] unit-test
  94
  95     { { 6 10 } } [
  96         32 cfg-w-spill-area-base cfg [
  97             { 8 40 } <gc-map/spills> gc-root-offsets
  98         ] with-variable
  99     ] unit-test
 100
 101     { 5 B{ 18 } } [
 102         0 cfg-w-spill-area-base cfg [
 103             { 0 24 } <gc-map/spills> 1array
 104             [ emit-gc-info-bitmap ] B{ } make
 105         ] with-variable
 106     ] unit-test
 107
 108     ! scrub-d scrub-r gc-roots
 109     { 9 B{ 32 1 } } [
 110         32 cfg-w-spill-area-base cfg [
 111             { 0 24 } <gc-map/spills> 1array
 112             [ emit-gc-info-bitmap ] B{ } make
 113         ] with-variable
 114     ] unit-test
 115
 116     fake-cpu \ cpu set
 117 ] when
 118
 119 ! largest-spill-slot
 120 {
 121     5 0 4 1
 122 } [
 123     { { 4 } } largest-spill-slot
 124     { { } } largest-spill-slot
 125     { { 2 3 } { 0 } } largest-spill-slot
 126     { { 0 } } largest-spill-slot
 127 ] unit-test
 128
 129 ! gc-map-needed?
 130 { f } [
 131     T{ gc-map } gc-map-needed?
 132 ] unit-test
 133
 134 ! emit-gc-info-bitmap
 135 {
 136     0 V{ }
 137 } [
 138     { T{ gc-map } } [ emit-gc-info-bitmap ] V{ } make
 139 ] unit-test
 140
 141 ! ! derived-root-offsets
 142 {
 143     V{ { 2 4 } }
 144 } [
 145     T{ gc-map { derived-roots V{ { 2 4 } } } }
 146     derived-root-offsets
 147 ] unit-test
 148
 149 ! emit-base-tables
 150 {
 151     3 B{ 255 255 255 255 255 255 255 255 4 0 0 0 }
 152 } [
 153     { T{ gc-map { derived-roots V{ { 2 4 } } } } }
 154     [ emit-base-tables ] B{ } make
 155 ] unit-test
 156
 157 ! serialize-gc-maps
 158 {
 159     B{ 0 0 0 0 }
 160 } [
 161     { } return-addresses set serialize-gc-maps
 162 ] unit-test
 163
 164 {
 165     B{ 123 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 }
 166 } [
 167     { 123 } return-addresses set
 168     { T{ gc-map } } gc-maps set
 169     serialize-gc-maps
 170 ] unit-test
 171
 172 ! gc-info + ret-addr + 9bits (5+2+2) = 20 + 4 + 2 = 26
 173 { 17 } [
 174     {
 175         T{ gc-map
 176            { gc-roots V{ 1 3 } }
 177         }
 178     } gc-maps set
 179     { 123 } return-addresses set
 180     serialize-gc-maps length
 181 ] unit-test
 182
 183 ! gc-info + ret-addr + 3 base-pointers + 9bits = 20 + 4 + 12 + 2 = 38
 184 { 29 } [
 185     {
 186         T{ gc-map
 187            { gc-roots V{ 1 3 } }
 188            { derived-roots V{ { 2 4 } } }
 189         }
 190     } gc-maps set
 191     { 123 } return-addresses set
 192     serialize-gc-maps length
 193 ] unit-test