basis/compiler/tests/spilling.factor

   1 USING: math.private kernel combinators accessors arrays
   2 generalizations tools.test ;
   3 IN: compiler.tests
   4
   5 : float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
   6     {
   7         [ dup float+ ]
   8         [ dup float+ ]
   9         [ dup float+ ]
  10         [ dup float+ ]
  11         [ dup float+ ]
  12         [ dup float+ ]
  13         [ dup float+ ]
  14         [ dup float+ ]
  15         [ dup float+ ]
  16         [ dup float+ ]
  17         [ dup float+ ]
  18         [ dup float+ ]
  19         [ dup float+ ]
  20         [ dup float+ ]
  21         [ dup float+ ]
  22         [ dup float+ ]
  23         [ dup float+ ]
  24         [ dup float+ ]
  25         [ dup float+ ]
  26         [ dup float+ ]
  27         [ dup float+ ]
  28         [ dup float+ ]
  29         [ dup float+ ]
  30         [ dup float+ ]
  31         [ dup float+ ]
  32         [ dup float+ ]
  33         [ dup float+ ]
  34         [ dup float+ ]
  35         [ dup float+ ]
  36         [ dup float+ ]
  37         [ dup float+ ]
  38         [ dup float+ ]
  39         [ dup float+ ]
  40         [ dup float+ ]
  41         [ dup float+ ]
  42         [ dup float+ ]
  43         [ dup float+ ]
  44         [ dup float+ ]
  45     } cleave ;
  46
  47 [ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
  48 [ 1.0 float-spill-bug ] unit-test
  49
  50 [ t ] [ \ float-spill-bug optimized>> ] unit-test
  51
  52 : float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
  53     {
  54         [ dup float+ ]
  55         [ float>fixnum dup fixnum+fast ]
  56         [ dup float+ ]
  57         [ float>fixnum dup fixnum+fast ]
  58         [ dup float+ ]
  59         [ float>fixnum dup fixnum+fast ]
  60         [ dup float+ ]
  61         [ float>fixnum dup fixnum+fast ]
  62         [ dup float+ ]
  63         [ float>fixnum dup fixnum+fast ]
  64         [ dup float+ ]
  65         [ float>fixnum dup fixnum+fast ]
  66         [ dup float+ ]
  67         [ float>fixnum dup fixnum+fast ]
  68         [ dup float+ ]
  69         [ float>fixnum dup fixnum+fast ]
  70         [ dup float+ ]
  71         [ float>fixnum dup fixnum+fast ]
  72         [ dup float+ ]
  73         [ float>fixnum dup fixnum+fast ]
  74         [ dup float+ ]
  75         [ float>fixnum dup fixnum+fast ]
  76         [ dup float+ ]
  77         [ float>fixnum dup fixnum+fast ]
  78         [ dup float+ ]
  79         [ float>fixnum dup fixnum+fast ]
  80         [ dup float+ ]
  81         [ float>fixnum dup fixnum+fast ]
  82         [ dup float+ ]
  83         [ float>fixnum dup fixnum+fast ]
  84         [ dup float+ ]
  85         [ float>fixnum dup fixnum+fast ]
  86         [ dup float+ ]
  87         [ float>fixnum dup fixnum+fast ]
  88         [ dup float+ ]
  89         [ float>fixnum dup fixnum+fast ]
  90         [ dup float+ ]
  91         [ float>fixnum dup fixnum+fast ]
  92         [ dup float+ ]
  93         [ float>fixnum dup fixnum+fast ]
  94         [ dup float+ ]
  95         [ float>fixnum dup fixnum+fast ]
  96         [ dup float+ ]
  97         [ float>fixnum dup fixnum+fast ]
  98         [ dup float+ ]
  99         [ float>fixnum dup fixnum+fast ]
 100         [ dup float+ ]
 101         [ float>fixnum dup fixnum+fast ]
 102         [ dup float+ ]
 103         [ float>fixnum dup fixnum+fast ]
 104         [ dup float+ ]
 105         [ float>fixnum dup fixnum+fast ]
 106         [ dup float+ ]
 107         [ float>fixnum dup fixnum+fast ]
 108         [ dup float+ ]
 109         [ float>fixnum dup fixnum+fast ]
 110         [ dup float+ ]
 111         [ float>fixnum dup fixnum+fast ]
 112         [ dup float+ ]
 113         [ float>fixnum dup fixnum+fast ]
 114         [ dup float+ ]
 115         [ float>fixnum dup fixnum+fast ]
 116         [ dup float+ ]
 117         [ float>fixnum dup fixnum+fast ]
 118         [ dup float+ ]
 119         [ float>fixnum dup fixnum+fast ]
 120         [ dup float+ ]
 121         [ float>fixnum dup fixnum+fast ]
 122         [ dup float+ ]
 123         [ float>fixnum dup fixnum+fast ]
 124         [ dup float+ ]
 125         [ float>fixnum dup fixnum+fast ]
 126         [ dup float+ ]
 127         [ float>fixnum dup fixnum+fast ]
 128         [ dup float+ ]
 129         [ float>fixnum dup fixnum+fast ]
 130     } cleave ;
 131
 132 [ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
 133 [ 1.0 float-fixnum-spill-bug ] unit-test
 134
 135 [ t ] [ \ float-fixnum-spill-bug optimized>> ] unit-test
 136
 137 : resolve-spill-bug ( a b -- c )
 138     [ 1 fixnum+fast ] bi@ dup 10 fixnum< [
 139         nip 2 fixnum+fast
 140     ] [
 141         drop {
 142             [ dup fixnum+fast ]
 143             [ dup fixnum+fast ]
 144             [ dup fixnum+fast ]
 145             [ dup fixnum+fast ]
 146             [ dup fixnum+fast ]
 147             [ dup fixnum+fast ]
 148             [ dup fixnum+fast ]
 149             [ dup fixnum+fast ]
 150             [ dup fixnum+fast ]
 151             [ dup fixnum+fast ]
 152             [ dup fixnum+fast ]
 153             [ dup fixnum+fast ]
 154             [ dup fixnum+fast ]
 155             [ dup fixnum+fast ]
 156             [ dup fixnum+fast ]
 157             [ dup fixnum+fast ]
 158         } cleave
 159         16 narray
 160     ] if ;
 161
 162 [ t ] [ \ resolve-spill-bug optimized>> ] unit-test
 163
 164 [ 4 ] [ 1 1 resolve-spill-bug ] unit-test
 165
 166 ! The above don't really test spilling...
 167 : spill-test-1 ( a -- b )
 168     dup 1 fixnum+fast
 169     dup 1 fixnum+fast
 170     dup 1 fixnum+fast
 171     dup 1 fixnum+fast
 172     dup 1 fixnum+fast
 173     dup 1 fixnum+fast
 174     dup 1 fixnum+fast
 175     dup 1 fixnum+fast
 176     dup 1 fixnum+fast
 177     dup 1 fixnum+fast
 178     dup 1 fixnum+fast
 179     dup 1 fixnum+fast
 180     dup 1 fixnum+fast
 181     dup 1 fixnum+fast
 182     dup 1 fixnum+fast
 183     dup 1 fixnum+fast
 184     dup 1 fixnum+fast
 185     dup 1 fixnum+fast
 186     dup 1 fixnum+fast
 187     dup 1 fixnum+fast
 188     dup 1 fixnum+fast
 189     dup 1 fixnum+fast
 190     dup 1 fixnum+fast
 191     dup 1 fixnum+fast
 192     dup 1 fixnum+fast
 193     dup 1 fixnum+fast
 194     dup 1 fixnum+fast
 195     dup 1 fixnum+fast
 196     dup 1 fixnum+fast fixnum>float
 197     3array
 198     3array [ 8 narray ] dip 2array
 199     [ 8 narray [ 8 narray ] dip 2array ] dip 2array
 200     2array ;
 201
 202 [
 203     {
 204         1
 205         {
 206             { { 2 3 4 5 6 7 8 9 } { 10 11 12 13 14 15 16 17 } }
 207             {
 208                 { 18 19 20 21 22 23 24 25 }
 209                 { 26 27 { 28 29 30.0 } }
 210             }
 211         }
 212     }
 213 ] [ 1 spill-test-1 ] unit-test
 214
 215 : spill-test-2 ( a -- b )
 216     dup 1.0 float+
 217     dup 1.0 float+
 218     dup 1.0 float+
 219     dup 1.0 float+
 220     dup 1.0 float+
 221     dup 1.0 float+
 222     dup 1.0 float+
 223     dup 1.0 float+
 224     dup 1.0 float+
 225     dup 1.0 float+
 226     dup 1.0 float+
 227     dup 1.0 float+
 228     dup 1.0 float+
 229     dup 1.0 float+
 230     dup 1.0 float+
 231     dup 1.0 float+
 232     dup 1.0 float+
 233     dup 1.0 float+
 234     dup 1.0 float+
 235     dup 1.0 float+
 236     dup 1.0 float+
 237     dup 1.0 float+
 238     dup 1.0 float+
 239     dup 1.0 float+
 240     dup 1.0 float+
 241     dup 1.0 float+
 242     dup 1.0 float+
 243     dup 1.0 float+
 244     dup 1.0 float+
 245     dup 1.0 float+
 246     dup 1.0 float+
 247     dup 1.0 float+
 248     dup 1.0 float+
 249     dup 1.0 float+
 250     dup 1.0 float+
 251     dup 1.0 float+
 252     dup 1.0 float+
 253     dup 1.0 float+
 254     dup 1.0 float+
 255     dup 1.0 float+
 256     dup 1.0 float+
 257     dup 1.0 float+
 258     dup 1.0 float+
 259     dup 1.0 float+
 260     dup 1.0 float+
 261     dup 1.0 float+
 262     dup 1.0 float+
 263     dup 1.0 float+
 264     dup 1.0 float+
 265     dup 1.0 float+
 266     dup 1.0 float+
 267     dup 1.0 float+
 268     dup 1.0 float+
 269     dup 1.0 float+
 270     dup 1.0 float+
 271     dup 1.0 float+
 272     dup 1.0 float+
 273     dup 1.0 float+
 274     dup 1.0 float+
 275     dup 1.0 float+
 276     dup 1.0 float+
 277     dup 1.0 float+
 278     dup 1.0 float+
 279     float*
 280     float*
 281     float*
 282     float*
 283     float*
 284     float*
 285     float*
 286     float*
 287     float*
 288     float*
 289     float*
 290     float*
 291     float*
 292     float*
 293     float*
 294     float*
 295     float*
 296     float*
 297     float*
 298     float*
 299     float*
 300     float*
 301     float*
 302     float*
 303     float*
 304     float*
 305     float*
 306     float*
 307     float*
 308     float*
 309     float*
 310     float*
 311     float*
 312     float*
 313     float*
 314     float*
 315     float*
 316     float*
 317     float*
 318     float*
 319     float*
 320     float*
 321     float*
 322     float*
 323     float*
 324     float*
 325     float*
 326     float*
 327     float*
 328     float*
 329     float*
 330     float*
 331     float*
 332     float*
 333     float*
 334     float*
 335     float*
 336     float*
 337     float*
 338     float*
 339     float*
 340     float*
 341     float* ;
 342
 343 [ t ] [ 1.0 spill-test-2 1.0 \ spill-test-2 def>> call = ] unit-test