core/compiler/test/intrinsics.factor

   1 IN: temporary
   2 USING: arrays compiler kernel kernel.private math
   3 math.private sequences strings tools.test words continuations
   4 sequences.private hashtables.private byte-arrays
   5 strings.private system random math.vectors layouts
   6 vectors.private sbufs.private strings.private slots.private
   7 alien alien.c-types alien.syntax namespaces libc math.constants
   8 math.functions ;
   9
  10 ! Make sure that intrinsic ops compile to correct code.
  11 [ ] [ 1 [ drop ] compile-1 ] unit-test
  12 [ ] [ 1 2 [ 2drop ] compile-1 ] unit-test
  13 [ ] [ 1 2 3 [ 3drop ] compile-1 ] unit-test
  14 [ 1 1 ] [ 1 [ dup ] compile-1 ] unit-test
  15 [ 1 2 1 2 ] [ 1 2 [ 2dup ] compile-1 ] unit-test
  16 [ 1 2 3 1 2 3 ] [ 1 2 3 [ 3dup ] compile-1 ] unit-test
  17 [ 2 3 1 ] [ 1 2 3 [ rot ] compile-1 ] unit-test
  18 [ 3 1 2 ] [ 1 2 3 [ -rot ] compile-1 ] unit-test
  19 [ 1 1 2 ] [ 1 2 [ dupd ] compile-1 ] unit-test
  20 [ 2 1 3 ] [ 1 2 3 [ swapd ] compile-1 ] unit-test
  21 [ 2 ] [ 1 2 [ nip ] compile-1 ] unit-test
  22 [ 3 ] [ 1 2 3 [ 2nip ] compile-1 ] unit-test
  23 [ 2 1 2 ] [ 1 2 [ tuck ] compile-1 ] unit-test
  24 [ 1 2 1 ] [ 1 2 [ over ] compile-1 ] unit-test
  25 [ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-1 ] unit-test
  26 [ 2 1 ] [ 1 2 [ swap ] compile-1 ] unit-test
  27
  28 [ 1 ] [ { 1 2 } [ 2 slot ] compile-1 ] unit-test
  29 [ 1 ] [ [ { 1 2 } 2 slot ] compile-1 ] unit-test
  30 [ 3 ] [ 3 1 2 2array [ [ 2 set-slot ] keep ] compile-1 first ] unit-test
  31 [ 3 ] [ 3 1 2 [ 2array [ 2 set-slot ] keep ] compile-1 first ] unit-test
  32 [ 3 ] [ [ 3 1 2 2array [ 2 set-slot ] keep ] compile-1 first ] unit-test
  33 [ 3 ] [ 3 1 2 2array [ [ 3 set-slot ] keep ] compile-1 second ] unit-test
  34 [ 3 ] [ 3 1 2 [ 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
  35 [ 3 ] [ [ 3 1 2 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
  36
  37 ! Write barrier hits on the wrong value were causing segfaults
  38 [ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-1 second ] unit-test
  39
  40 [ CHAR: b ] [ 1 "abc" [ char-slot ] compile-1 ] unit-test
  41 [ CHAR: b ] [ 1 [ "abc" char-slot ] compile-1 ] unit-test
  42 [ CHAR: b ] [ [ 1 "abc" char-slot ] compile-1 ] unit-test
  43
  44 [ "axc" ] [ CHAR: x 1 "abc" [ [ set-char-slot ] keep { string } declare dup rehash-string ] compile-1 ] unit-test
  45 [ "axc" ] [ CHAR: x 1 [ "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-1 ] unit-test
  46 [ "axc" ] [ CHAR: x [ 1 "abc" [ set-char-slot ] keep { string } declare dup rehash-string ] compile-1 ] unit-test
  47
  48 [ ] [ [ 0 getenv ] compile-1 drop ] unit-test
  49 [ ] [ 1 getenv [ 1 setenv ] compile-1 ] unit-test
  50
  51 [ ] [ 1 [ drop ] compile-1 ] unit-test
  52 [ ] [ [ 1 drop ] compile-1 ] unit-test
  53 [ ] [ [ 1 2 2drop ] compile-1 ] unit-test
  54 [ ] [ 1 [ 2 2drop ] compile-1 ] unit-test
  55 [ ] [ 1 2 [ 2drop ] compile-1 ] unit-test
  56 [ 2 1 ] [ [ 1 2 swap ] compile-1 ] unit-test
  57 [ 2 1 ] [ 1 [ 2 swap ] compile-1 ] unit-test
  58 [ 2 1 ] [ 1 2 [ swap ] compile-1 ] unit-test
  59 [ 1 1 ] [ 1 [ dup ] compile-1 ] unit-test
  60 [ 1 1 ] [ [ 1 dup ] compile-1 ] unit-test
  61 [ 1 2 1 ] [ [ 1 2 over ] compile-1 ] unit-test
  62 [ 1 2 1 ] [ 1 [ 2 over ] compile-1 ] unit-test
  63 [ 1 2 1 ] [ 1 2 [ over ] compile-1 ] unit-test
  64 [ 1 2 3 1 ] [ [ 1 2 3 pick ] compile-1 ] unit-test
  65 [ 1 2 3 1 ] [ 1 [ 2 3 pick ] compile-1 ] unit-test
  66 [ 1 2 3 1 ] [ 1 2 [ 3 pick ] compile-1 ] unit-test
  67 [ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-1 ] unit-test
  68 [ 1 1 2 ] [ [ 1 2 dupd ] compile-1 ] unit-test
  69 [ 1 1 2 ] [ 1 [ 2 dupd ] compile-1 ] unit-test
  70 [ 1 1 2 ] [ 1 2 [ dupd ] compile-1 ] unit-test
  71 [ 2 ] [ [ 1 2 nip ] compile-1 ] unit-test
  72 [ 2 ] [ 1 [ 2 nip ] compile-1 ] unit-test
  73 [ 2 ] [ 1 2 [ nip ] compile-1 ] unit-test
  74
  75 [ 2 1 "hi" ] [ 1 2 [ swap "hi" ] compile-1 ] unit-test
  76
  77 [ 4 ] [ 12 7 [ fixnum-bitand ] compile-1 ] unit-test
  78 [ 4 ] [ 12 [ 7 fixnum-bitand ] compile-1 ] unit-test
  79 [ 4 ] [ [ 12 7 fixnum-bitand ] compile-1 ] unit-test
  80
  81 [ 15 ] [ 12 7 [ fixnum-bitor ] compile-1 ] unit-test
  82 [ 15 ] [ 12 [ 7 fixnum-bitor ] compile-1 ] unit-test
  83 [ 15 ] [ [ 12 7 fixnum-bitor ] compile-1 ] unit-test
  84
  85 [ 11 ] [ 12 7 [ fixnum-bitxor ] compile-1 ] unit-test
  86 [ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-1 ] unit-test
  87 [ 11 ] [ [ 12 7 fixnum-bitxor ] compile-1 ] unit-test
  88
  89 [ f ] [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
  90 [ f ] [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
  91 [ f ] [ [ 12 7 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
  92 [ f ] [ [ 12 12 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
  93 [ f ] [ 12 12 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
  94
  95 [ t ] [ 12 70 [ fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
  96 [ t ] [ 12 [ 70 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
  97 [ t ] [ [ 12 70 fixnum< [ t ] [ f ] if ] compile-1 ] unit-test
  98
  99 [ f ] [ 12 7 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 100 [ f ] [ 12 [ 7 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 101 [ f ] [ [ 12 7 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 102 [ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 103 [ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 104 [ t ] [ 12 12 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 105
 106 [ t ] [ 12 70 [ fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 107 [ t ] [ 12 [ 70 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 108 [ t ] [ [ 12 70 fixnum<= [ t ] [ f ] if ] compile-1 ] unit-test
 109
 110 [ t ] [ 12 7 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 111 [ t ] [ 12 [ 7 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 112 [ t ] [ [ 12 7 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 113 [ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 114 [ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 115 [ f ] [ 12 12 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 116
 117 [ f ] [ 12 70 [ fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 118 [ f ] [ 12 [ 70 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 119 [ f ] [ [ 12 70 fixnum> [ t ] [ f ] if ] compile-1 ] unit-test
 120
 121 [ t ] [ 12 7 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 122 [ t ] [ 12 [ 7 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 123 [ t ] [ [ 12 7 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 124 [ t ] [ [ 12 12 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 125 [ t ] [ 12 12 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 126
 127 [ f ] [ 12 70 [ fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 128 [ f ] [ 12 [ 70 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 129 [ f ] [ [ 12 70 fixnum>= [ t ] [ f ] if ] compile-1 ] unit-test
 130
 131 [ f ] [ 1 2 [ eq? [ t ] [ f ] if ] compile-1 ] unit-test
 132 [ f ] [ 1 [ 2 eq? [ t ] [ f ] if ] compile-1 ] unit-test
 133 [ f ] [ [ 1 2 eq? [ t ] [ f ] if ] compile-1 ] unit-test
 134 [ t ] [ 3 3 [ eq? [ t ] [ f ] if ] compile-1 ] unit-test
 135 [ t ] [ 3 [ 3 eq? [ t ] [ f ] if ] compile-1 ] unit-test
 136 [ t ] [ [ 3 3 eq? [ t ] [ f ] if ] compile-1 ] unit-test
 137
 138 [ -1 ] [ 0 [ fixnum-bitnot ] compile-1 ] unit-test
 139 [ -1 ] [ [ 0 fixnum-bitnot ] compile-1 ] unit-test
 140
 141 [ 3 ] [ 13 10 [ fixnum-mod ] compile-1 ] unit-test
 142 [ 3 ] [ 13 [ 10 fixnum-mod ] compile-1 ] unit-test
 143 [ 3 ] [ [ 13 10 fixnum-mod ] compile-1 ] unit-test
 144 [ -3 ] [ -13 10 [ fixnum-mod ] compile-1 ] unit-test
 145 [ -3 ] [ -13 [ 10 fixnum-mod ] compile-1 ] unit-test
 146 [ -3 ] [ [ -13 10 fixnum-mod ] compile-1 ] unit-test
 147
 148 [ 2 ] [ 4 2 [ fixnum/i ] compile-1 ] unit-test
 149 [ 2 ] [ 4 [ 2 fixnum/i ] compile-1 ] unit-test
 150 [ -2 ] [ 4 [ -2 fixnum/i ] compile-1 ] unit-test
 151 [ 3 1 ] [ 10 3 [ fixnum/mod ] compile-1 ] unit-test
 152
 153 [ 4 ] [ 1 3 [ fixnum+ ] compile-1 ] unit-test
 154 [ 4 ] [ 1 [ 3 fixnum+ ] compile-1 ] unit-test
 155 [ 4 ] [ [ 1 3 fixnum+ ] compile-1 ] unit-test
 156
 157 [ 4 ] [ 1 3 [ fixnum+fast ] compile-1 ] unit-test
 158 [ 4 ] [ 1 [ 3 fixnum+fast ] compile-1 ] unit-test
 159 [ 4 ] [ [ 1 3 fixnum+fast ] compile-1 ] unit-test
 160
 161 [ 30001 ] [ 1 [ 30000 fixnum+fast ] compile-1 ] unit-test
 162
 163 [ 6 ] [ 2 3 [ fixnum*fast ] compile-1 ] unit-test
 164 [ 6 ] [ 2 [ 3 fixnum*fast ] compile-1 ] unit-test
 165 [ 6 ] [ [ 2 3 fixnum*fast ] compile-1 ] unit-test
 166 [ -6 ] [ 2 -3 [ fixnum*fast ] compile-1 ] unit-test
 167 [ -6 ] [ 2 [ -3 fixnum*fast ] compile-1 ] unit-test
 168 [ -6 ] [ [ 2 -3 fixnum*fast ] compile-1 ] unit-test
 169
 170 [ 6 ] [ 2 3 [ fixnum* ] compile-1 ] unit-test
 171 [ 6 ] [ 2 [ 3 fixnum* ] compile-1 ] unit-test
 172 [ 6 ] [ [ 2 3 fixnum* ] compile-1 ] unit-test
 173 [ -6 ] [ 2 -3 [ fixnum* ] compile-1 ] unit-test
 174 [ -6 ] [ 2 [ -3 fixnum* ] compile-1 ] unit-test
 175 [ -6 ] [ [ 2 -3 fixnum* ] compile-1 ] unit-test
 176
 177 [ t ] [ 3 type 3 [ type ] compile-1 eq? ] unit-test
 178 [ t ] [ 3 >bignum type 3 >bignum [ type ] compile-1 eq? ] unit-test
 179 [ t ] [ "hey" type "hey" [ type ] compile-1 eq? ] unit-test
 180 [ t ] [ f type f [ type ] compile-1 eq? ] unit-test
 181
 182 [ 5 ] [ 1 2 [ eq? [ 3 ] [ 5 ] if ] compile-1 ] unit-test
 183 [ 3 ] [ 2 2 [ eq? [ 3 ] [ 5 ] if ] compile-1 ] unit-test
 184 [ 3 ] [ 1 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-1 ] unit-test
 185 [ 5 ] [ 2 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-1 ] unit-test
 186
 187 [ 8 ] [ 1 3 [ fixnum-shift ] compile-1 ] unit-test
 188 [ 8 ] [ 1 [ 3 fixnum-shift ] compile-1 ] unit-test
 189 [ 8 ] [ [ 1 3 fixnum-shift ] compile-1 ] unit-test
 190 [ -8 ] [ -1 3 [ fixnum-shift ] compile-1 ] unit-test
 191 [ -8 ] [ -1 [ 3 fixnum-shift ] compile-1 ] unit-test
 192 [ -8 ] [ [ -1 3 fixnum-shift ] compile-1 ] unit-test
 193
 194 [ 2 ] [ 8 -2 [ fixnum-shift ] compile-1 ] unit-test
 195 [ 2 ] [ 8 [ -2 fixnum-shift ] compile-1 ] unit-test
 196
 197 [ 0 ] [ [ 123 -64 fixnum-shift ] compile-1 ] unit-test
 198 [ 0 ] [ 123 -64 [ fixnum-shift ] compile-1 ] unit-test
 199 [ -1 ] [ [ -123 -64 fixnum-shift ] compile-1 ] unit-test
 200 [ -1 ] [ -123 -64 [ fixnum-shift ] compile-1 ] unit-test
 201
 202 [ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-1 ] unit-test
 203 [ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-1 ] unit-test
 204
 205 [ t ] [ 1 27 fixnum-shift dup [ fixnum+ ] compile-1 1 28 fixnum-shift = ] unit-test
 206 [ -268435457 ] [ 1 28 shift neg >fixnum [ -1 fixnum+ ] compile-1 ] unit-test
 207
 208 [ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-1 ] unit-test
 209 [ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-1 ] unit-test
 210 [ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
 211 [ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-1 ] unit-test
 212 [ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-1 ] unit-test
 213 [ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
 214
 215 [ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-1 1 40 shift = ] unit-test
 216 [ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-1 1 40 shift neg = ] unit-test
 217 [ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-1 1 40 shift = ] unit-test
 218 [ -351382792 ] [ -43922849 [ 3 fixnum-shift ] compile-1 ] unit-test
 219
 220 [ 268435456 ] [ -268435456 >fixnum -1 [ fixnum/i ] compile-1 ] unit-test
 221
 222 [ 268435456 0 ] [ -268435456 >fixnum -1 [ fixnum/mod ] compile-1 ] unit-test
 223
 224 [ t ] [ f [ f eq? ] compile-1 ] unit-test
 225
 226 ! regression
 227 [ t ] [ { 1 2 3 } { 1 2 3 } [ over type over type eq? ] compile-1 2nip ] unit-test
 228
 229 ! regression
 230 [ 3 ] [
 231     100001 f <array> 3 100000 pick set-nth
 232     [ 100000 swap array-nth ] compile-1
 233 ] unit-test
 234
 235 ! 64-bit overflow
 236 cell 8 = [
 237     [ t ] [ 1 59 fixnum-shift dup [ fixnum+ ] compile-1 1 60 fixnum-shift = ] unit-test
 238     [ -1152921504606846977 ] [ 1 60 shift neg >fixnum [ -1 fixnum+ ] compile-1 ] unit-test
 239
 240     [ t ] [ 1 40 shift 1 40 shift [ fixnum* ] compile-1 1 80 shift = ] unit-test
 241     [ t ] [ 1 40 shift neg 1 40 shift [ fixnum* ] compile-1 1 80 shift neg = ] unit-test
 242     [ t ] [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
 243     [ t ] [ 1 30 shift neg 1 50 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
 244     [ t ] [ 1 50 shift neg 1 30 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
 245
 246     [ 18446744073709551616 ] [ 1 64 [ fixnum-shift ] compile-1 ] unit-test
 247     [ 18446744073709551616 ] [ 1 [ 64 fixnum-shift ] compile-1 ] unit-test
 248     [ 18446744073709551616 ] [ 1 [ 32 fixnum-shift 32 fixnum-shift ] compile-1 ] unit-test
 249     [ -18446744073709551616 ] [ -1 64 [ fixnum-shift ] compile-1 ] unit-test
 250     [ -18446744073709551616 ] [ -1 [ 64 fixnum-shift ] compile-1 ] unit-test
 251     [ -18446744073709551616 ] [ -1 [ 32 fixnum-shift 32 fixnum-shift ] compile-1 ] unit-test
 252
 253     [ 1152921504606846976 ] [ -1152921504606846976 >fixnum -1 [ fixnum/i ] compile-1 ] unit-test
 254
 255     [ 1152921504606846976 0 ] [ -1152921504606846976 >fixnum -1 [ fixnum/mod ] compile-1 ] unit-test
 256
 257     [ -268435457 ] [ 28 2^ [ fixnum-bitnot ] compile-1 ] unit-test
 258 ] when
 259
 260 ! Some randomized tests
 261 : compiled-fixnum* fixnum* ;
 262 \ compiled-fixnum* compile
 263
 264 : test-fixnum*
 265     (random) >fixnum (random) >fixnum
 266     2dup
 267     [ fixnum* ] 2keep compiled-fixnum* =
 268     [ 2drop ] [ "Oops" throw ] if ;
 269
 270 [ ] [ 10000 [ test-fixnum* ] times ] unit-test
 271
 272 : compiled-fixnum>bignum fixnum>bignum ;
 273 \ compiled-fixnum>bignum compile
 274
 275 : test-fixnum>bignum
 276     (random) >fixnum
 277     dup [ fixnum>bignum ] keep compiled-fixnum>bignum =
 278     [ drop ] [ "Oops" throw ] if ;
 279
 280 [ ] [ 10000 [ test-fixnum>bignum ] times ] unit-test
 281
 282 : compiled-bignum>fixnum bignum>fixnum ;
 283 \ compiled-bignum>fixnum compile
 284
 285 : test-bignum>fixnum
 286     5 random [ drop (random) ] map product >bignum
 287     dup [ bignum>fixnum ] keep compiled-bignum>fixnum =
 288     [ drop ] [ "Oops" throw ] if ;
 289
 290 [ ] [ 10000 [ test-bignum>fixnum ] times ] unit-test
 291
 292 ! Test overflow check removal
 293 [ t ] [
 294     most-positive-fixnum 100 - >fixnum
 295     200
 296     [ [ fixnum+ ] compile-1 [ bignum>fixnum ] compile-1 ] 2keep
 297     [ fixnum+ >fixnum ] compile-1
 298     =
 299 ] unit-test
 300
 301 [ t ] [
 302     most-negative-fixnum 100 + >fixnum
 303     -200
 304     [ [ fixnum+ ] compile-1 [ bignum>fixnum ] compile-1 ] 2keep
 305     [ fixnum+ >fixnum ] compile-1
 306     =
 307 ] unit-test
 308
 309 [ t ] [
 310     most-negative-fixnum 100 + >fixnum
 311     200
 312     [ [ fixnum- ] compile-1 [ bignum>fixnum ] compile-1 ] 2keep
 313     [ fixnum- >fixnum ] compile-1
 314     =
 315 ] unit-test
 316
 317 ! Test inline allocators
 318 [ { 1 1 1 } ] [
 319     [ 3 1 <array> ] compile-1
 320 ] unit-test
 321
 322 [ B{ 0 0 0 } ] [
 323     [ 3 <byte-array> ] compile-1
 324 ] unit-test
 325
 326 [ 500 ] [
 327     [ 500 <byte-array> length ] compile-1
 328 ] unit-test
 329
 330 [ C{ 1 2 } ] [ 1 2 [ <complex> ] compile-1 ] unit-test
 331
 332 [ 1/2 ] [ 1 2 [ <ratio> ] compile-1 ] unit-test
 333
 334 [ \ + ] [ \ + [ <wrapper> ] compile-1 ] unit-test
 335
 336 [ H{ } ] [
 337     100 [ (hashtable) ] compile-1 [ reset-hash ] keep
 338 ] unit-test
 339
 340 [ B{ 0 0 0 0 0 } ] [
 341     [ 5 <byte-array> ] compile-1
 342 ] unit-test
 343
 344 [ V{ 1 2 } ] [
 345     { 1 2 3 } 2 [ array>vector ] compile-1
 346 ] unit-test
 347
 348 [ SBUF" hello" ] [
 349     "hello world" 5 [ string>sbuf ] compile-1
 350 ] unit-test
 351
 352 [ [ 3 + ] ] [
 353     3 [ + ] [ curry ] compile-1
 354 ] unit-test
 355
 356 ! Alien intrinsics
 357 [ 3 ] [ B{ 1 2 3 4 5 } 2 [ alien-unsigned-1 ] compile-1 ] unit-test
 358 [ 3 ] [ [ B{ 1 2 3 4 5 } 2 alien-unsigned-1 ] compile-1 ] unit-test
 359 [ 3 ] [ B{ 1 2 3 4 5 } 2 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
 360 [ 3 ] [ B{ 1 2 3 4 5 } 2 [ { simple-c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
 361
 362 [ ] [ B{ 1 2 3 4 5 } malloc-byte-array "b" set ] unit-test
 363
 364 [ 3 ] [ "b" get 2 [ alien-unsigned-1 ] compile-1 ] unit-test
 365 [ 3 ] [ "b" get [ { simple-alien } declare 2 alien-unsigned-1 ] compile-1 ] unit-test
 366 [ 3 ] [ "b" get 2 [ { simple-alien fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
 367 [ 3 ] [ "b" get 2 [ { simple-c-ptr fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
 368
 369 [ ] [ "b" get free ] unit-test
 370
 371 [ ] [ "hello world" malloc-char-string "s" set ] unit-test
 372
 373 [ "hello world" ] [ "s" get <void*> [ { byte-array } declare *void* ] compile-1 alien>char-string ] unit-test
 374 [ "hello world" ] [ "s" get <void*> [ { simple-c-ptr } declare *void* ] compile-1 alien>char-string ] unit-test
 375
 376 [ ] [ "s" get free ] unit-test
 377
 378 [ ALIEN: 1234 ] [ ALIEN: 1234 [ { simple-alien } declare <void*> ] compile-1 *void* ] unit-test
 379 [ ALIEN: 1234 ] [ ALIEN: 1234 [ { simple-c-ptr } declare <void*> ] compile-1 *void* ] unit-test
 380 [ f ] [ f [ { POSTPONE: f } declare <void*> ] compile-1 *void* ] unit-test
 381
 382 [ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-1 ] unit-test
 383 [ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-1 ] unit-test
 384
 385 : xword-def word-def [ { fixnum } declare ] swap append ;
 386
 387 [ -100 ] [ -100 <char> [ { byte-array } declare *char ] compile-1 ] unit-test
 388 [ 156 ] [ -100 <uchar> [ { byte-array } declare *uchar ] compile-1 ] unit-test
 389
 390 [ -100 ] [ -100 \ <char> xword-def compile-1 *char ] unit-test
 391 [ 156 ] [ -100 \ <uchar> xword-def compile-1 *uchar ] unit-test
 392
 393 [ -1000 ] [ -1000 <short> [ { byte-array } declare *short ] compile-1 ] unit-test
 394 [ 64536 ] [ -1000 <ushort> [ { byte-array } declare *ushort ] compile-1 ] unit-test
 395
 396 [ -1000 ] [ -1000 \ <short> xword-def compile-1 *short ] unit-test
 397 [ 64536 ] [ -1000 \ <ushort> xword-def compile-1 *ushort ] unit-test
 398
 399 [ -100000 ] [ -100000 <int> [ { byte-array } declare *int ] compile-1 ] unit-test
 400 [ 4294867296 ] [ -100000 <uint> [ { byte-array } declare *uint ] compile-1 ] unit-test
 401
 402 [ -100000 ] [ -100000 \ <int> xword-def compile-1 *int ] unit-test
 403 [ 4294867296 ] [ -100000 \ <uint> xword-def compile-1 *uint ] unit-test
 404
 405 [ t ] [ pi pi <double> *double = ] unit-test
 406
 407 [ t ] [ pi <double> [ { byte-array } declare *double ] compile-1 pi = ] unit-test
 408
 409 ! Silly
 410 [ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-1 ] keep *float pi - abs 0.001 < ] unit-test
 411 [ t ] [ pi <float> [ { byte-array } declare *float ] compile-1 pi - abs 0.001 < ] unit-test
 412
 413 [ t ] [ pi 8 <byte-array> [ [ { float byte-array } declare 0 set-alien-double ] compile-1 ] keep *double pi = ] unit-test