tests/picobit/picobit-vm-sixpic.c

   1 // TODO at least, use #include and #define, but #define would require me to start all over...
   2 // no typedefs
   3 // no forward declarations
   4 // Scheme-style hex literals
   5 // no explicit casts (intermediate variables instead)
   6 // removed functions that interact with the firmware, and with rom
   7 // had some case labels that were not literals (but could have been constant folded) in the dispatch
   8
   9 /* typedef char int8; */
  10 /* typedef short int16; */
  11 /* typedef long int32; */
  12 /* typedef unsigned char uint8; */
  13 /* typedef unsigned short uint16; */
  14 /* typedef unsigned long uint32; */
  15
  16 /* typedef uint8 word; */
  17
  18 /* typedef uint16 ram_addr; */
  19 /* typedef uint16 rom_addr; */
  20
  21 uint16 arg1;
  22 uint16 arg2;
  23 uint16 arg3;
  24 uint16 arg4;
  25 uint16 arg5;
  26 uint16 cont;
  27 uint16 env;
  28
  29 uint8 na;
  30 uint16 pc;
  31 uint8 glovars;
  32 uint16 entry;
  33 uint8 bytecode;
  34 uint8 bytecode_hi4;
  35 uint8 bytecode_lo4;
  36 uint16 a1;
  37 uint16 a2;
  38 uint16 a3;
  39
  40 void halt_with_error (){
  41   uart_write(101); // e
  42   uart_write(114); // r
  43   uart_write(114); // r
  44   uart_write(13);
  45   uart_write(10);
  46   exit();
  47 }
  48
  49
  50 /* typedef uint16 obj; */
  51 /* uint8 ram_get_gc_tags (uint16 o); */
  52 /* uint8 ram_get_gc_tag0 (uint16 o); */
  53 /* uint8 ram_get_gc_tag1 (uint16 o); */
  54 /* void ram_set_gc_tags (uint16 o, uint8 tags); */
  55 /* void ram_set_gc_tag0 (uint16 o, uint8 tag); */
  56 /* void ram_set_gc_tag1 (uint16 o, uint8 tag); */
  57 /* uint8 ram_get_field0 (uint16 o); */
  58 /* uint8 ram_get_field1 (uint16 o); */
  59 /* uint8 ram_get_field2 (uint16 o); */
  60 /* uint8 ram_get_field3 (uint16 o); */
  61 /* uint8 ram_get_fieldn (uint16 o, uint8 n); */
  62 /* void ram_set_field0 (uint16 o, uint8 val); */
  63 /* void ram_set_field1 (uint16 o, uint8 val); */
  64 /* void ram_set_field2 (uint16 o, uint8 val); */
  65 /* void ram_set_field3 (uint16 o, uint8 val); */
  66 /* void ram_set_fieldn (uint16 o, uint8 n, uint8 val); */
  67 /* uint8 rom_get_field0 (uint16 o); */
  68 /* uint8 rom_get_field1 (uint16 o); */
  69 /* uint8 rom_get_field2 (uint16 o); */
  70 /* uint8 rom_get_field3 (uint16 o); */
  71 uint8 ram_get_gc_tags (uint16 o) {
  72   uint16 t2 = o - 512;
  73   return (*(((t2 << 2))+#x200) & #x60); // TODO having these as multiplications instead increases the size by ~10 bytes apiece
  74 }
  75 uint8 ram_get_gc_tag0 (uint16 o) {
  76   uint16 t2 = o - 512;
  77   return (*(((t2 << 2))+#x200) & #x20);
  78 }
  79 uint8 ram_get_gc_tag1 (uint16 o) {
  80   uint16 t2 = o - 512;
  81   return (*(((t2 << 2))+#x200) & #x40);
  82 }
  83 void ram_set_gc_tags (uint16 o, uint8 tags) {
  84   uint16 t2 = (o - 512) << 2; // TODO optimized a couple of things
  85   *((t2)+#x200) = ((*((t2)+#x200) & #x9f) | (tags));
  86 }
  87 void ram_set_gc_tag0 (uint16 o, uint8 tag) {
  88   uint16 t2 = (o - 512) << 2; // TODO same here
  89   *(t2+#x200) = ((*(t2+#x200) & #xdf) | (tag));
  90 }
  91 void ram_set_gc_tag1 (uint16 o, uint8 tag) {
  92   uint16 t2 = (o - 512) << 2; // TODO same here
  93   *(t2+#x200) = ((*(t2+#x200) & #xbf) | (tag));
  94 }
  95 uint8 ram_get_field0 (uint16 o) { uint16 t2 = o - 512; return *(((t2 << 2) + (0))+#x200); }
  96 uint8 ram_get_field1 (uint16 o) { uint16 t2 = o - 512; return *(((t2 << 2) + (1))+#x200); }
  97 uint8 ram_get_field2 (uint16 o) { uint16 t2 = o - 512; return *(((t2 << 2) + (2))+#x200); }
  98 uint8 ram_get_field3 (uint16 o) { uint16 t2 = o - 512; return *(((t2 << 2) + (3))+#x200); }
  99 uint8 ram_get_fieldn (uint16 o, uint8 n) {
 100   switch (n) {
 101   case 0: return ram_get_field0 (o);
 102   case 1: return ram_get_field1 (o);
 103   case 2: return ram_get_field2 (o);
 104   case 3: return ram_get_field3 (o);
 105   }
 106 }
 107 void ram_set_field0 (uint16 o, uint8 val) { uint16 t2 = o - 512; *(((t2 << 2) + (0))+#x200) = (val); }
 108 void ram_set_field1 (uint16 o, uint8 val) { uint16 t2 = o - 512; *(((t2 << 2) + (1))+#x200) = (val); }
 109 void ram_set_field2 (uint16 o, uint8 val) { uint16 t2 = o - 512; *(((t2 << 2) + (2))+#x200) = (val); }
 110 void ram_set_field3 (uint16 o, uint8 val) { uint16 t2 = o - 512; *(((t2 << 2) + (3))+#x200) = (val); }
 111 void ram_set_fieldn (uint16 o, uint8 n, uint8 val) {
 112   switch (n) {
 113   case 0: ram_set_field0 (o, val); break;
 114   case 1: ram_set_field1 (o, val); break;
 115   case 2: ram_set_field2 (o, val); break;
 116   case 3: ram_set_field3 (o, val); break;
 117   }
 118 }
 119 uint8 rom_get_field0 (uint16 o) { uint16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x8000 + 4 + (0)))); }
 120 uint8 rom_get_field1 (uint16 o) { uint16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x8000 + 4 + (1)))); }
 121 uint8 rom_get_field2 (uint16 o) { uint16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x8000 + 4 + (2)))); }
 122 uint8 rom_get_field3 (uint16 o) { uint16 t2 = (o) - (3 +255 - -1 +1); return rom_get (((t2 << 2) + (#x8000 + 4 + (3)))); }
 123
 124
 125 /* uint16 ram_get_car (uint16 o); */
 126 /* uint16 rom_get_car (uint16 o); */
 127 /* uint16 ram_get_cdr (uint16 o); */
 128 /* uint16 rom_get_cdr (uint16 o); */
 129 /* void ram_set_car (uint16 o, uint16 val); */
 130 /* void ram_set_cdr (uint16 o, uint16 val); */
 131
 132 /* uint16 ram_get_entry (uint16 o); */
 133 /* uint16 rom_get_entry (uint16 o); */
 134
 135 uint16 ram_get_car (uint16 o)
 136 { uint16 tmp = (ram_get_field0 (o) & #x1f); return (tmp << 8) | ram_get_field1 (o); }
 137 uint16 rom_get_car (uint16 o)
 138 { uint16 tmp = (rom_get_field0 (o) & #x1f); return (tmp << 8) | rom_get_field1 (o); }
 139 uint16 ram_get_cdr (uint16 o)
 140 { uint16 tmp = (ram_get_field2 (o) & #x1f); return (tmp << 8) | ram_get_field3 (o); }
 141 uint16 rom_get_cdr (uint16 o)
 142 { uint16 tmp = (rom_get_field2 (o) & #x1f); return (tmp << 8) | rom_get_field3 (o); }
 143
 144 void ram_set_car (uint16 o, uint16 val) {
 145   ram_set_field0 (o, (val >> 8) | (ram_get_field0 (o) & #xe0));
 146   ram_set_field1 (o, val & #xff);
 147 }
 148 void ram_set_cdr (uint16 o, uint16 val) {
 149   ram_set_field2 (o, (val >> 8) | (ram_get_field2 (o) & #xe0));
 150   ram_set_field3 (o, val & #xff);
 151 }
 152
 153
 154 uint16 ram_get_entry (uint16 o) {
 155   uint16 tmp  = (ram_get_field0 (o) & #x1f);
 156   uint16 tmp2 = ram_get_field1 (o); // TODO this cast is necessary because literals are of the smallest type possible in SIXPIC, not always int (not standard)
 157   return ((tmp << 11)
 158           | (tmp2 << 3)
 159           | (ram_get_field2 (o) >> 5));
 160 }
 161 uint16 rom_get_entry (uint16 o){
 162   uint16 tmp = (rom_get_field0 (o) & #x1f);
 163   uint16 tmp2 = rom_get_field1 (o);
 164   return ((tmp << 11)
 165    | (tmp2 << 3)
 166    | (rom_get_field2 (o) >> 5));
 167 }
 168
 169
 170 /* uint16 get_global (uint8 i); */
 171 /* void set_global (uint8 i, uint16 o); */
 172
 173 uint16 get_global (uint8 i) {
 174
 175   if (i & 1)
 176     return ram_get_cdr (512 + (i >> 1));
 177   else
 178     return ram_get_car (512 + (i >> 1));
 179 }
 180 void set_global (uint8 i, uint16 o) {
 181   if (i & 1)
 182     ram_set_cdr (512 + (i >> 1), o);
 183   else
 184     ram_set_car (512 + (i >> 1), o);
 185 }
 186
 187 uint16 free_list;
 188 uint16 free_list_vec;
 189
 190 void mark (uint16 temp) {
 191
 192
 193   uint16 stack;
 194   uint16 visit;
 195
 196   if ((!((temp) >= 1280) && ((temp) >= 512))) {
 197     visit = 0;
 198
 199   push:
 200
 201     stack = visit;
 202     visit = temp;
 203
 204     ;
 205
 206     if (((((ram_get_field0 (visit) & #x80) == #x80) || ((ram_get_field0 (visit) & #xc0) == #x40) || ((ram_get_field0 (visit) & #xc0) == 0)) && ram_get_gc_tag0 (visit))
 207  || (((((ram_get_field0 (visit) & #x80) == #x80) && ((ram_get_field2 (visit) & #xe0) == 0)) || (((ram_get_field0 (visit) & #x80) == #x80) && ((ram_get_field2 (visit) & #xe0) == #x80)))
 208      && (ram_get_gc_tags (visit) != (0<<5))))
 209       ;
 210     else {
 211       if (((((ram_get_field0 (visit) & #x80) == #x80) && ((ram_get_field2 (visit) & #xe0) == 0)) || (((ram_get_field0 (visit) & #x80) == #x80) && ((ram_get_field2 (visit) & #xe0) == #x80)))) {
 212  ;
 213
 214       visit_field2:
 215
 216  temp = ram_get_cdr (visit);
 217
 218  if ((!((temp) >= 1280) && ((temp) >= 512))) {
 219    ;
 220    uint16 tmp = 2;
 221    ram_set_gc_tags (visit, (tmp<<5));
 222    ram_set_cdr (visit, stack);
 223    goto push;
 224  }
 225
 226  ;
 227
 228  goto visit_field1;
 229       }
 230
 231       if ((((ram_get_field0 (visit) & #x80) == #x80) || ((ram_get_field0 (visit) & #xc0) == #x40) || ((ram_get_field0 (visit) & #xc0) == 0))) {
 232  ;
 233
 234       visit_field1:
 235
 236
 237  if (((ram_get_field0 (visit) & #xc0) == #x40))
 238    temp = ram_get_cdr (visit);
 239  else
 240    temp = ram_get_car (visit);
 241
 242  if ((!((temp) >= 1280) && ((temp) >= 512))) {
 243    ;
 244    uint16 tmp = 1;
 245    ram_set_gc_tag0 (visit, (tmp<<5));
 246    if (((ram_get_field0 (visit) & #xc0) == #x40))
 247      ram_set_cdr (visit, stack);
 248    else
 249      ram_set_car (visit, stack);
 250
 251    goto push;
 252  }
 253
 254  ;
 255       }
 256       else
 257  ;
 258       uint16 tmp = 1;
 259       ram_set_gc_tag0 (visit, (tmp<<5));
 260     }
 261
 262   pop:
 263
 264     ;
 265
 266     if (stack != 0) {
 267       if (((((ram_get_field0 (stack) & #x80) == #x80) && ((ram_get_field2 (stack) & #xe0) == 0)) || (((ram_get_field0 (stack) & #x80) == #x80) && ((ram_get_field2 (stack) & #xe0) == #x80))) && ram_get_gc_tag1 (stack)) {
 268  ;
 269
 270  temp = ram_get_cdr (stack);
 271  ram_set_cdr (stack, visit);
 272  visit = stack;
 273  stack = temp;
 274
 275  ram_set_gc_tag1(visit, (0<<5));
 276
 277
 278  goto visit_field1;
 279       }
 280
 281       if (((ram_get_field0 (stack) & #xc0) == #x40)) {
 282
 283  ;
 284
 285  temp = ram_get_cdr (stack);
 286  ram_set_cdr (stack, visit);
 287  visit = stack;
 288  stack = temp;
 289
 290  goto pop;
 291       }
 292
 293       ;
 294
 295       temp = ram_get_car (stack);
 296       ram_set_car (stack, visit);
 297       visit = stack;
 298       stack = temp;
 299
 300       goto pop;
 301     }
 302   }
 303 }
 304
 305
 306
 307
 308
 309 void sweep () {
 310
 311
 312
 313
 314
 315
 316   uint16 visit = 1279;
 317
 318   free_list = 0;
 319
 320   while (visit >= (512 + ((glovars + 1) >> 1))) {
 321
 322     uint16 tmp = 1;
 323     if ((((ram_get_field0 (visit) & #x80) == #x80)
 324   && (ram_get_gc_tags (visit) == (0<<5)))
 325  || !(ram_get_gc_tags (visit) & (tmp<<5))) {
 326
 327       if ((((ram_get_field0 (visit) & #x80) == #x80) && ((ram_get_field2 (visit) & #xe0) == #x60))) {
 328
 329  uint16 o = ram_get_cdr (visit);
 330  uint16 i = ram_get_car (visit);
 331  ram_set_car (o, free_list_vec);
 332  ram_set_cdr (o, (i + 3) >> 2);
 333  free_list_vec = o;
 334
 335       }
 336       ram_set_car (visit, free_list);
 337       free_list = visit;
 338       }
 339     else {
 340       if (((ram_get_field0 (visit) & #x80) == #x80))
 341  ram_set_gc_tags (visit, (0<<5));
 342       else
 343  ram_set_gc_tag0 (visit, (0<<5));
 344
 345
 346
 347     }
 348     visit--;
 349   }
 350 }
 351
 352 void gc () {
 353
 354   uint8 i;
 355
 356   ;
 357
 358   ;
 359   mark (arg1);
 360   ;
 361   mark (arg2);
 362   ;
 363   mark (arg3);
 364   ;
 365   mark (arg4);
 366   ;
 367   mark (arg5);
 368   ;
 369   mark (cont);
 370   ;
 371   mark (env);
 372
 373   ;
 374   for (i=0; i<glovars; i++)
 375     mark (get_global (i));
 376
 377   sweep ();
 378 }
 379
 380
 381 uint16 alloc_ram_cell () {
 382   uint16 o;
 383
 384
 385
 386
 387
 388   if (free_list == 0) {
 389
 390     gc ();
 391     if (free_list == 0)
 392
 393       halt_with_error();
 394   }
 395
 396   o = free_list;
 397
 398   free_list = ram_get_car (o);
 399
 400
 401   return o;
 402 }
 403
 404 uint16 alloc_ram_cell_init (uint8 f0, uint8 f1, uint8 f2, uint8 f3) {
 405   uint16 o = alloc_ram_cell ();
 406
 407   ram_set_field0 (o, f0);
 408   ram_set_field1 (o, f1);
 409   ram_set_field2 (o, f2);
 410   ram_set_field3 (o, f3);
 411
 412   return o;
 413 }
 414
 415 uint16 alloc_vec_cell (uint16 n) {
 416   uint16 o = free_list_vec;
 417   uint16 prec = 0;
 418   uint8 gc_done = 0;
 419
 420
 421
 422
 423
 424
 425   while ((ram_get_cdr (o) * 4) < n) {
 426     if (o == 0) {
 427       if (gc_done)
 428  halt_with_error();
 429
 430       gc ();
 431       gc_done = 1;
 432
 433       o = free_list_vec;
 434       prec = 0;
 435       continue;
 436     }
 437     prec = o;
 438     o = ram_get_car (o);
 439   }
 440
 441
 442
 443   if (((ram_get_cdr(o) * 4) - n) < 4) {
 444     if (prec)
 445       ram_set_car (prec, ram_get_car (o));
 446     else
 447       free_list_vec = ram_get_car (o);
 448   }
 449
 450
 451   else {
 452     uint16 new_free = o + ((n + 3) >> 2);
 453     if (prec)
 454       ram_set_car (prec, new_free);
 455     else
 456       free_list_vec = new_free;
 457     ram_set_car (new_free, ram_get_car (o));
 458     ram_set_cdr (new_free, ram_get_cdr (o) - ((n + 3) >> 2));
 459   }
 460
 461   return o;
 462 }
 463
 464
 465
 466 /* typedef uint16 integer; */
 467 /* typedef uint16 digit; */
 468 /* typedef uint32 two_digit; */
 469 /* uint16 make_integer (uint16 lo, uint16 hi); */
 470 /* uint16 integer_hi (uint16 x); */
 471 /* uint16 integer_lo (uint16 x); */
 472 uint16 make_integer (uint16 lo_make_integer, uint16 hi_make_integer) {
 473   return alloc_ram_cell_init (0 | (hi_make_integer >> 8), hi_make_integer, lo_make_integer >> 8, lo_make_integer);
 474 }
 475
 476 uint16 integer_hi (uint16 x) {
 477   if ((!((x) >= 1280) // bb 0
 478        && ((x) >= 512))) // bb 4
 479     return ram_get_car (x); // bb 2
 480   else if ((!((x) >= 1280) // bb 3
 481             && !(!((x) >= 1280) // bb 10
 482                  && ((x) >= 512)) // bb 11
 483             && ((x) >= (3 +255 - -1 +1)))) // bb 9
 484     return rom_get_car (x); // bb 7
 485   else if (x < (3 - -1)){ // bb 8
 486     return ((0 + (3 - -1))-1); // bb 14
 487   }
 488   else {
 489     return (0 + (3 - -1)); // bb 15
 490   }
 491 }
 492
 493 uint16 integer_lo (uint16 x) {
 494   if ((!((x) >= 1280) && ((x) >= 512))) {
 495     uint16 t = ram_get_field2 (x);
 496     return (t << 8) + ram_get_field3 (x);
 497   }
 498   else if ((!((x) >= 1280) && !(!((x) >= 1280) && ((x) >= 512)) && ((x) >= (3 +255 - -1 +1)))) {
 499     uint16 t = rom_get_field2 (x);
 500     return (t << 8) + rom_get_field3 (x);
 501   }
 502   else
 503     return x - (3 - -1);
 504 }
 505
 506
 507 /* uint16 norm (uint16 prefix, uint16 n); */
 508 /* uint8 negp (uint16 x); */
 509 /* uint8 cmp (uint16 x, uint16 y); */
 510 /* uint16 integer_length (uint16 x); */
 511 /* uint16 shr (uint16 x); */
 512 /* uint16 negative_carry (uint16 carry); */
 513 /* uint16 shl (uint16 x); */
 514 /* uint16 shift_left (uint16 x, uint16 n); */
 515 /* uint16 add (uint16 x, uint16 y); */
 516 /* uint16 invert (uint16 x); */
 517 /* uint16 sub (uint16 x, uint16 y); */
 518 /* uint16 neg (uint16 x); */
 519 /* uint16 scale (uint16 n, uint16 x); */
 520 /* uint16 mulnonneg (uint16 x, uint16 y); */
 521 /* uint16 divnonneg (uint16 x, uint16 y); */
 522
 523 uint16 decode_int (uint16 o) {
 524   uint8 result;
 525   if (o < 3)
 526     halt_with_error();
 527
 528   if (o <= (3 + (255 - -1)))
 529     return (o - (3 - -1));
 530
 531   if ((!((o) >= 1280) && ((o) >= 512))) {
 532     if (!((ram_get_field0 (o) & #xc0) == 0))
 533       halt_with_error();
 534     return ram_get_field3 (o);
 535   }
 536   else if ((!((o) >= 1280) && !(!((o) >= 1280) && ((o) >= 512)) && ((o) >= (3 +255 - -1 +1)))) {
 537     if (!((rom_get_field0 (o) & #xc0) == 0))
 538       halt_with_error();
 539     return rom_get_field3 (o);
 540   }
 541   else
 542     halt_with_error();
 543 }
 544
 545 /* uint16 decode_int (uint16 o); */
 546 /* uint16 encode_int (uint16 n); */
 547
 548 uint16 norm (uint16 prefix, uint16 n_norm) {
 549
 550
 551
 552   while (prefix != 0) { // bbs 1 and 4
 553     uint16 d = integer_lo (prefix); // bb 3
 554     uint16 temp = prefix;
 555
 556     prefix = integer_hi (temp);
 557
 558     if (((n_norm) == ((0 + (3 - -1))))) { // bb 3 and 8
 559       if (d <= 255) { // bb 6
 560         n_norm = (d + (3 - -1)); // bb 10
 561         continue;
 562       }
 563     }
 564     else if (((n_norm) == (((0 + (3 - -1))-1)))) { // bbs 7 and 13
 565       uint16 tmp = 1; // bb 12
 566 /*       if (d >= (tmp<<16) - 1) { // bb 12 // TODO was + MIN_FIXNUM, but -1 is not a valid literal FOO would be better with just 0-1, but the constant folding will get it, and put -1. */
 567       if (d >= #xffff) { // FOO this is what the above really meant, since d is a 16 bit value
 568         uint16 t = d/*  - (tmp << 16) */; // bb 15 // FOO that part was useless with 16 bit values
 569         n_norm = (t + (3 - -1));
 570         continue;
 571       }
 572     }
 573
 574     ram_set_car (temp, n_norm); // bb 5
 575     n_norm = temp;
 576   }
 577
 578   return n_norm; // bb 2
 579 }
 580
 581 uint8 negp (uint16 x_negp) {
 582
 583
 584   do {
 585     x_negp = integer_hi (x_negp); // bb 1
 586     if (((x_negp) == ((0 + (3 - -1))))) // bbs 1 and 6
 587       return 0; // bb 5
 588   } while (!((x_negp) == (((0 + (3 - -1))-1)))); // bbs 2 and 8
 589
 590   return 1; // bb 3
 591 }
 592
 593 uint8 cmp (uint16 x_cmp, uint16 y_cmp) { // TODO changed. used to return -1, 0 and 1, now is 0, 1, 2
 594
 595
 596   uint8 result = 1;
 597   uint16 xlo;
 598   uint16 ylo;
 599
 600   for (;;) { // bb 2
 601     if (((x_cmp) == ((0 + (3 - -1)))) // bbs 2 and 8
 602         || ((x_cmp) == (((0 + (3 - -1))-1)))) { // bbs 7 and 9
 603       if (!((x_cmp) == (y_cmp))) // bbs 6 and 12
 604         { if (negp (y_cmp)) // bb 11
 605             result = 2; // bb 14
 606           else result = 0; } // bb 15
 607       break; // bb 10
 608     }
 609
 610     if (((y_cmp) == ((0 + (3 - -1)))) // bbs 5 and 19
 611         || ((y_cmp) == (((0 + (3 - -1))-1)))) { // bbs 18 and 20
 612       if (negp (x_cmp)) // bb 17
 613         result = 0; // bb 22
 614       else result = 2; // bb 23
 615       break; // bb 21
 616     }
 617
 618     xlo = integer_lo (x_cmp); // bb 16
 619     ylo = integer_lo (y_cmp);
 620     x_cmp = integer_hi (x_cmp);
 621     y_cmp = integer_hi (y_cmp);
 622     if (xlo != ylo) // bb 16 and 26
 623       { if (xlo < ylo) // bb 25
 624           result = 0; // bb 28
 625         else result = 2; } // bb 29
 626   }
 627   return result; // bb 4
 628 }
 629
 630 uint16 integer_length (uint16 x) {
 631
 632
 633
 634   uint16 result = 0;
 635   uint16 next;
 636   uint16 d;
 637
 638   while (!(((next = integer_hi (x))) == ((0 + (3 - -1))))) {
 639     result += 16;
 640     x = next;
 641   }
 642
 643   d = integer_lo (x);
 644
 645   while (d > 0) {
 646     result++;
 647     d >>= 1;
 648   }
 649
 650   return result;
 651 }
 652
 653 uint16 shr (uint16 x) {
 654
 655
 656   uint16 result = 0;
 657   uint16 d;
 658
 659   for (;;) {
 660     if (((x) == ((0 + (3 - -1)))) || ((x) == (((0 + (3 - -1))-1)))) {
 661       result = norm (result, x);
 662       break;
 663     }
 664
 665     d = integer_lo (x);
 666     x = integer_hi (x);
 667     uint16 tmp = 1;
 668     result = make_integer ((d >> 1) |
 669                            ((integer_lo (x) & 1) ? (tmp<<(16-1)) : 0),
 670                            result);
 671   }
 672
 673   return result;
 674 }
 675
 676 uint16 negative_carry (uint16 carry) {
 677   if (carry)
 678     return ((0 + (3 - -1))-1);
 679   else
 680     return (0 + (3 - -1));
 681 }
 682
 683 uint16 shl (uint16 x) {
 684
 685
 686   uint16 negc = (0 + (3 - -1));
 687   uint16 temp;
 688   uint16 result = 0;
 689   uint16 d;
 690
 691   for (;;) {
 692     if (((x) == (negc))) {
 693       result = norm (result, x);
 694       break;
 695     }
 696
 697     d = integer_lo (x);
 698     x = integer_hi (x);
 699     temp = negc;
 700     uint16 tmp = 1;
 701     negc = negative_carry (d & (tmp<<15));
 702     result = make_integer ((d << 1) | ((temp) == ((0 + (3 - -1))-1)), result);
 703   }
 704
 705   return result;
 706 }
 707
 708 uint16 shift_left (uint16 x, uint16 n) {
 709
 710
 711   if (((x) == ((0 + (3 - -1)))))
 712     return x;
 713
 714   while (n & (16 -1)) {
 715     x = shl (x);
 716     n--;
 717   }
 718
 719   while (n > 0) {
 720     x = make_integer (0, x);
 721     n -= 16;
 722   }
 723
 724   return x;
 725 }
 726
 727 uint16 add (uint16 x, uint16 y) {
 728
 729
 730   uint16 negc = (0 + (3 - -1));
 731   uint16 result = 0;
 732   uint16 dx;
 733   uint16 dy;
 734
 735   for (;;) { // bb 2
 736     if (((x) == (negc))) { // bbs 2 and 7
 737       result = norm (result, y); // bb 6
 738       break;
 739     }
 740
 741     if (((y) == (negc))) { // bbs 5 and 10
 742       result = norm (result, x); // bb 9
 743       break;
 744     }
 745
 746     dx = integer_lo (x); // bb 8
 747     dy = integer_lo (y);
 748     dx = dx + dy;
 749
 750     if (((negc) == ((0 + (3 - -1))))) // bbs 8 and 14
 751       negc = negative_carry (dx < dy); // bbs 12, 15, 16, 17
 752     else { // bb 13
 753       dx++;
 754       negc = negative_carry (dx <= dy); // bbs 13, 18, 19, 20
 755     }
 756
 757     x = integer_hi (x); // bb 11
 758     y = integer_hi (y);
 759
 760     result = make_integer (dx, result);
 761   }
 762
 763   return result; // bb 4
 764 }
 765
 766 uint16 invert (uint16 x) {
 767   if (((x) == ((0 + (3 - -1)))))
 768     return ((0 + (3 - -1))-1);
 769   else
 770     return (0 + (3 - -1));
 771 }
 772
 773 uint16 sub (uint16 x, uint16 y) {
 774
 775   uint16 negc = ((0 + (3 - -1))-1);
 776   uint16 result_sub = 0; // TODO name changed
 777   uint16 dx_sub; // TODO changed
 778   uint16 dy_sub;
 779
 780   for (;;) { // bb 2
 781     if (((x) == (negc)) // bbs 2 and 8
 782         && (((y) == ((0 + (3 - -1)))) // bbs 7 and 10
 783             || ((y) == (((0 + (3 - -1))-1))))) { // bbs 9 and 11
 784       result_sub = norm (result_sub, invert (y)); // bb 6
 785       break;
 786     }
 787
 788     if (((y) == (invert (negc)))) { // bbs 5 and 14
 789       result_sub = norm (result_sub, x); // bb 13
 790       break;
 791     }
 792
 793     dx_sub = integer_lo (x); // bb 12
 794     dy_sub = ~integer_lo (y);
 795     dx_sub = dx_sub + dy_sub;
 796
 797     if (((negc) == ((0 + (3 - -1))))) // bbs 12 and 18
 798       negc = negative_carry (dx_sub < dy_sub); // bbs 16, 19, 20, 21
 799     else { // bb 17, 22, 23, 24
 800       dx_sub++;
 801       negc = negative_carry (dx_sub <= dy_sub);
 802     }
 803
 804     x = integer_hi (x); // bb 15
 805     y = integer_hi (y);
 806
 807     result_sub = make_integer (dx_sub, result_sub);
 808   }
 809
 810   return result_sub; // bb 4
 811 }
 812
 813 uint16 neg (uint16 x) {
 814
 815
 816   return sub ((0 + (3 - -1)), x);
 817 }
 818
 819 uint16 scale (uint16 n, uint16 x) {
 820
 821
 822   uint16 result;
 823   uint16 carry;
 824   uint32 m;
 825
 826   if ((n == 0) || ((x) == ((0 + (3 - -1)))))
 827     return (0 + (3 - -1));
 828
 829   if (n == 1)
 830     return x;
 831
 832   result = 0;
 833   carry = 0;
 834
 835   for (;;) {
 836     if (((x) == ((0 + (3 - -1))))){
 837       if (carry <= 255)
 838         result = norm (result, (carry + (3 - -1)));
 839       else
 840         result = norm (result, make_integer (carry, (0 + (3 - -1))));
 841       break;
 842     }
 843
 844     if (((x) == (((0 + (3 - -1))-1)))) {
 845       carry = carry - n;
 846       uint16 tmp = 1;
 847       if (carry >= ((tmp<<16) - 1)) // TODO -1 not a good literal
 848         result = norm (result, ((carry & #xff) + (3 - -1)));
 849       else
 850         result = norm (result, make_integer (carry, ((0 + (3 - -1))-1)));
 851       break;
 852     }
 853
 854     uint32 tmp1 = integer_lo (x);
 855     m = tmp1 * n + carry;
 856
 857     x = integer_hi (x);
 858     carry = m >> 16;
 859     uint16 tmp2 = m;
 860     result = make_integer (tmp2, result);
 861   }
 862
 863   return result;
 864 }
 865
 866 uint16 mulnonneg (uint16 x, uint16 y) {
 867
 868
 869
 870   uint16 result = 0;
 871   uint16 s = scale (integer_lo (x), y);
 872
 873   for (;;) {
 874     result = make_integer (integer_lo (s), result);
 875     s = integer_hi (s);
 876     x = integer_hi (x);
 877
 878     if (((x) == ((0 + (3 - -1)))))
 879       break;
 880
 881     s = add (s, scale (integer_lo (x), y));
 882   }
 883
 884   return norm (result, s);
 885 }
 886
 887
 888 uint16 divnonneg (uint16 x, uint16 y) {
 889
 890
 891
 892   uint16 result = (0 + (3 - -1)); // bb 0
 893   uint16 lx = integer_length (x);
 894   uint16 ly = integer_length (y);
 895
 896   if (lx >= ly) { // bb 0
 897     lx = lx - ly; // bb 2
 898
 899     y = shift_left (y, lx);
 900
 901     do {
 902       result = shl (result); // bb 3
 903       if (cmp (x, y) >= 1) {
 904         x = sub (x, y); // bb 7
 905         result = add (((0 + (3 - -1))+1), result);
 906       }
 907       y = shr (y); // bb 6 ?
 908     } while (lx-- != 0); // bbs 4 and 8
 909   }
 910
 911   return result; // bb 1
 912 }
 913
 914 uint16 bitwise_ior (uint16 x, uint16 y) {
 915
 916
 917   uint16 result = 0;
 918
 919   for (;;){
 920     if (((x) == ((0 + (3 - -1)))))
 921       return norm(result, y);
 922     if (((x) == (((0 + (3 - -1))-1))))
 923       return norm(result, x);
 924     result = make_integer(integer_lo(x) | integer_lo(y),
 925                           result);
 926     x = integer_hi(x);
 927     y = integer_hi(y);
 928   }
 929 }
 930
 931 uint16 bitwise_xor (uint16 x, uint16 y) {
 932
 933
 934   uint16 result = 0;
 935
 936   for (;;){
 937     if (((x) == ((0 + (3 - -1)))))
 938       return norm(result, y);
 939     if (((x) == (((0 + (3 - -1))-1))))
 940       return norm(result, x);
 941     result = make_integer(integer_lo(x) ^ integer_lo(y),
 942      result);
 943     x = integer_hi(x);
 944     y = integer_hi(y);
 945   }
 946 }
 947
 948
 949
 950 uint16 encode_int (uint16 n) {
 951   if (/* n >= -1 && */ n <= 255) { // TODO should be n >= -1, but -1 as a literal is not good. since only primitives (i.e. not the bignum code) uses it, shouldn't be a problem
 952     return (n + (3 - -1));
 953   }
 954
 955   return alloc_ram_cell_init (0, (0 + (3 - -1)), n >> 8, n);
 956 }
 957 void decode_2_int_args () {
 958   a1 = decode_int (arg1);
 959   a2 = decode_int (arg2);
 960 }
 961
 962
 963
 964
 965
 966 void prim_numberp () {
 967   if (arg1 >= 3
 968       && arg1 <= (3 + (255 - -1)))
 969     arg1 = 1;
 970   else {
 971     if ((!((arg1) >= 1280) && ((arg1) >= 512))){
 972       arg1 = (ram_get_field0 (arg1) & #xc0) == 0;
 973     }
 974     else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1))))
 975       arg1 = (rom_get_field0 (arg1) & #xc0) == 0;
 976     else
 977       arg1 = 0;
 978   }
 979 }
 980 void prim_add () {
 981
 982   arg1 = add (arg1, arg2);
 983
 984
 985
 986
 987   arg2 = 0;
 988 }
 989
 990 void prim_sub () {
 991
 992   arg1 = sub (arg1, arg2);
 993
 994
 995
 996
 997   arg2 = 0;
 998 }
 999
1000 void prim_mul () {
1001
1002   a1 = negp (arg1);
1003   a2 = negp (arg2);
1004   arg1 = mulnonneg (a1 ? neg(arg1) : arg1,
1005       a2 ? neg(arg2) : arg2);
1006   if (a1 + a2 == 1)
1007     arg1 = neg(arg1);
1008
1009
1010
1011
1012   arg2 = 0;
1013 }
1014
1015 void prim_div () {
1016
1017   if (((arg2) == (((0) + (3 - -1)))))
1018     halt_with_error();
1019   a1 = negp (arg1);
1020   a2 = negp (arg2);
1021   arg1 = divnonneg (a1 ? neg(arg1) : arg1,
1022       a2 ? neg(arg2) : arg2);
1023   if (a1 + a2 == 1)
1024     arg1 = neg(arg1);
1025
1026
1027
1028
1029
1030
1031   arg2 = 0;
1032 }
1033
1034 void prim_rem () {
1035
1036   if (((arg2) == (((0) + (3 - -1)))))
1037     halt_with_error();
1038   if (negp(arg1) || negp(arg2))
1039     halt_with_error();
1040
1041
1042   arg3 = divnonneg (arg1, arg2);
1043   arg4 = mulnonneg (arg2, arg3);
1044   arg1 = sub(arg1, arg4 );
1045   arg3 = 0;
1046   arg4 = 0;
1047
1048
1049
1050
1051
1052
1053   arg2 = 0;
1054 }
1055
1056 void prim_neg () {
1057
1058   arg1 = neg (arg1);
1059
1060
1061
1062
1063 }
1064
1065 void prim_eq () {
1066
1067   arg1 = ((cmp (arg1, arg2) == 1));
1068
1069
1070
1071
1072   arg2 = 0;
1073 }
1074
1075 void prim_lt () {
1076
1077   arg1 = ((cmp (arg1, arg2) < 1));
1078
1079
1080
1081
1082   arg2 = 0;
1083 }
1084
1085 void prim_gt () {
1086
1087   arg1 = ((cmp (arg1, arg2) > 1));
1088
1089
1090
1091
1092   arg2 = 0;
1093 }
1094
1095 void prim_leq () {
1096
1097   arg1 = ((cmp (arg1, arg2) <= 1));
1098
1099
1100
1101
1102   arg2 = 0;
1103
1104 }
1105
1106 void prim_geq () {
1107
1108   arg1 = ((cmp (arg1, arg2) >= 1));
1109
1110
1111
1112
1113   arg2 = 0;
1114 }
1115
1116 void prim_ior () {
1117
1118   arg1 = bitwise_ior(arg1, arg2);
1119
1120
1121
1122
1123   arg2 = 0;
1124 }
1125
1126 void prim_xor () {
1127
1128   arg1 = bitwise_xor(arg1, arg2);
1129
1130
1131
1132
1133   arg2 = 0;
1134 }
1135
1136
1137
1138
1139
1140
1141
1142 void prim_pairp () {
1143   if ((!((arg1) >= 1280) && ((arg1) >= 512)))
1144     arg1 = (((((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0))));
1145   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1))))
1146     arg1 = (((((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == 0))));
1147   else
1148     arg1 = 0;
1149 }
1150
1151 uint16 cons (uint16 car, uint16 cdr) {
1152   return alloc_ram_cell_init (#x80 | (car >> 8),
1153          car & #xff,
1154          0 | (cdr >> 8),
1155          cdr & #xff);
1156 }
1157
1158 void prim_cons () {
1159   arg1 = cons (arg1, arg2);
1160   arg2 = 0;
1161 }
1162
1163 void prim_car () {
1164   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1165     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0)))
1166       halt_with_error();
1167     arg1 = ram_get_car (arg1);
1168   }
1169   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) {
1170     if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == 0)))
1171       halt_with_error();
1172     arg1 = rom_get_car (arg1);
1173   }
1174   else
1175     halt_with_error();
1176 }
1177
1178 void prim_cdr () {
1179   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1180     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0)))
1181       halt_with_error();
1182     arg1 = ram_get_cdr (arg1);
1183   }
1184   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) {
1185     if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == 0)))
1186       halt_with_error();
1187     arg1 = rom_get_cdr (arg1);
1188   }
1189   else
1190     halt_with_error();
1191 }
1192
1193 void prim_set_car () {
1194   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1195     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0)))
1196       halt_with_error();
1197
1198     ram_set_car (arg1, arg2);
1199     arg1 = 0;
1200     arg2 = 0;
1201   }
1202   else
1203     halt_with_error();
1204 }
1205
1206 void prim_set_cdr () {
1207   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1208     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == 0)))
1209       halt_with_error();
1210
1211     ram_set_cdr (arg1, arg2);
1212     arg1 = 0;
1213     arg2 = 0;
1214   }
1215   else
1216     halt_with_error();
1217 }
1218
1219 void prim_nullp () {
1220   arg1 = ((arg1 == 2));
1221 }
1222
1223
1224
1225
1226
1227 void prim_u8vectorp () {
1228   if ((!((arg1) >= 1280) && ((arg1) >= 512)))
1229     arg1 = (((((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60))));
1230   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1))))
1231     arg1 = (((((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x60))));
1232   else
1233     arg1 = 0;
1234 }
1235
1236 void prim_make_u8vector () {
1237   decode_2_int_args ();
1238
1239   if (a2 > 255)
1240     halt_with_error();
1241
1242   arg3 = alloc_vec_cell (a1);
1243   arg1 = alloc_ram_cell_init (#x80 | (a1 >> 8),
1244          a1 & #xff,         #x60 | (arg3 >> 8),
1245          arg3 & #xff);
1246
1247   a1 = (a1 + 3) >> 2;
1248   while (a1--) {
1249     ram_set_field0 (arg3, a2);
1250     ram_set_field1 (arg3, a2);
1251     ram_set_field2 (arg3, a2);
1252     ram_set_field3 (arg3, a2);
1253     arg3++;
1254   }
1255 }
1256
1257 void prim_u8vector_ref () {
1258   a2 = decode_int (arg2);
1259
1260   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1261     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60)))
1262       halt_with_error();
1263     if ((ram_get_car (arg1) <= a2)/*  || (a2 < 0) */) // FOO makes no sense with unsigned values
1264       halt_with_error();
1265     arg1 = ram_get_cdr (arg1);
1266   }
1267   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) {
1268     if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x60)))
1269       halt_with_error();
1270     if ((rom_get_car (arg1) <= a2)/*  || (a2 < 0) */)
1271       halt_with_error();
1272     arg1 = rom_get_cdr (arg1);
1273   }
1274   else
1275     halt_with_error();
1276
1277   if (((arg1) >= 1280)) {
1278     arg1 += (a2 >> 2);
1279     a2 %= 4;
1280
1281     arg1 = encode_int (ram_get_fieldn (arg1, a2));
1282   }
1283   else {
1284     while (a2--)
1285       arg1 = rom_get_cdr (arg1);
1286
1287
1288     arg1 = rom_get_car (arg1);
1289   }
1290
1291   arg2 = 0;
1292   arg3 = 0;
1293   arg4 = 0;
1294 }
1295
1296 void prim_u8vector_set () {
1297   a2 = decode_int (arg2);
1298   a3 = decode_int (arg3);
1299
1300   if (a3 > 255)
1301     halt_with_error();
1302
1303   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1304     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60)))
1305       halt_with_error();
1306     if ((ram_get_car (arg1) <= a2)/*  || (a2 < 0) */)
1307       halt_with_error();
1308     arg1 = ram_get_cdr (arg1);
1309   }
1310   else
1311     halt_with_error();
1312
1313   arg1 += (a2 >> 2);
1314   a2 %= 4;
1315
1316   ram_set_fieldn (arg1, a2, a3);
1317
1318   arg1 = 0;
1319   arg2 = 0;
1320   arg3 = 0;
1321 }
1322
1323 void prim_u8vector_length () {
1324   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1325     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60)))
1326       halt_with_error();
1327     arg1 = encode_int (ram_get_car (arg1));
1328   }
1329   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) {
1330     if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x60)))
1331       halt_with_error();
1332     arg1 = encode_int (rom_get_car (arg1));
1333   }
1334   else
1335     halt_with_error();
1336 }
1337
1338 void prim_u8vector_copy () {
1339
1340
1341
1342   a1 = decode_int (arg2);
1343   a2 = decode_int (arg4);
1344   a3 = decode_int (arg5);
1345
1346
1347   if ((!((arg1) >= 1280) && ((arg1) >= 512)) && (!((arg3) >= 1280) && ((arg3) >= 512))) {
1348     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60)) || !(((ram_get_field0 (arg3) & #x80) == #x80) && ((ram_get_field2 (arg3) & #xe0) == #x60)))
1349       halt_with_error();
1350     if ((ram_get_car (arg1) < (a1 + a3)) /* || (a1 < 0) */ ||
1351  (ram_get_car (arg3) < (a2 + a3)) /* || (a2 < 0) */)
1352       halt_with_error();
1353
1354
1355     arg1 = ram_get_cdr (arg1);
1356     arg1 += (a1 >> 2);
1357     a1 %= 4;
1358     arg3 = ram_get_cdr (arg3);
1359     arg3 += (a2 >> 2);
1360     a2 %= 4;
1361
1362
1363     while (a3--) {
1364       ram_set_fieldn (arg3, a2, ram_get_fieldn (arg1, a1));
1365
1366       a1++;
1367       arg1 += (a1 >> 2);
1368       a1 %= 4;
1369       a2++;
1370       arg3 += (a2 >> 2);
1371       a2 %= 4;
1372     }
1373   }
1374
1375   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1))) && (!((arg3) >= 1280) && ((arg3) >= 512))) {
1376     if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x60)) || !(((ram_get_field0 (arg3) & #x80) == #x80) && ((ram_get_field2 (arg3) & #xe0) == #x60)))
1377       halt_with_error();
1378     if ((rom_get_car (arg1) < (a1 + a3)) /* || (a1 < 0) */ ||
1379  (ram_get_car (arg3) < (a2 + a3)) /* || (a2 < 0) */)
1380       halt_with_error();
1381
1382     arg1 = rom_get_cdr (arg1);
1383     while (a1--)
1384       arg1 = rom_get_cdr (arg1);
1385
1386     arg3 = ram_get_cdr (arg3);
1387     arg3 += (a2 >> 2);
1388     a2 %= 4;
1389
1390     while (a3--) {
1391       ram_set_fieldn (arg3, a2, decode_int (rom_get_car (arg1)));
1392
1393       arg1 = rom_get_cdr (arg1);
1394       a2++;
1395       arg3 += (a2 >> 2);
1396       a2 %= 4;
1397     }
1398   }
1399   else
1400     halt_with_error();
1401
1402   arg1 = 0;
1403   arg2 = 0;
1404   arg3 = 0;
1405   arg4 = 0;
1406   arg5 = 0;
1407 }
1408
1409
1410
1411
1412
1413 void prim_eqp () {
1414   arg1 = ((arg1 == arg2));
1415   arg2 = 0;
1416 }
1417
1418 void prim_not () {
1419   arg1 = ((arg1 == 0));
1420 }
1421
1422 void prim_symbolp () {
1423   if ((!((arg1) >= 1280) && ((arg1) >= 512)))
1424     arg1 = (((((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x20))));
1425   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1))))
1426     arg1 = (((((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x20))));
1427   else
1428     arg1 = 0;
1429 }
1430
1431 void prim_stringp () {
1432   if ((!((arg1) >= 1280) && ((arg1) >= 512)))
1433     arg1 = (((((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x40))));
1434   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1))))
1435     arg1 = (((((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x40))));
1436   else
1437     arg1 = 0;
1438 }
1439
1440 void prim_string2list () {
1441   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1442     if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x40)))
1443       halt_with_error();
1444
1445     arg1 = ram_get_car (arg1);
1446   }
1447   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) {
1448     if (!(((rom_get_field0 (arg1) & #x80) == #x80) && ((rom_get_field2 (arg1) & #xe0) == #x40)))
1449       halt_with_error();
1450
1451     arg1 = rom_get_car (arg1);
1452     }
1453   else
1454     halt_with_error();
1455 }
1456
1457 void prim_list2string () {
1458   arg1 = alloc_ram_cell_init (#x80 | ((arg1 & #x1f00) >> 8),
1459          arg1 & #xff,         #x40,
1460          0);
1461 }
1462
1463 void prim_booleanp () {
1464   arg1 = ((arg1 < 2));
1465 }
1466
1467
1468
1469
1470
1471 void prim_print () {
1472
1473
1474
1475
1476   arg1 = 0;
1477 }
1478
1479 uint32 read_clock () {
1480   uint32 now = 0;
1481
1482
1483   /* now = from_now( 0 ); */ // TODO
1484   return now;
1485 }
1486
1487 void prim_clock () {
1488   arg1 = encode_int (read_clock ());
1489 }
1490
1491 void prim_motor () {
1492   decode_2_int_args ();
1493
1494   if (a1 < 1 || a1 > 2 || a2 < -100 || a2 > 100)
1495     halt_with_error();
1496
1497
1498   /*   MOTOR_set( a1, a2 ); */ // TODO
1499
1500
1501
1502
1503
1504
1505
1506   arg1 = 0;
1507   arg2 = 0;
1508 }
1509
1510
1511 void prim_led () {
1512   decode_2_int_args ();
1513   a3 = decode_int (arg3);
1514
1515   if (a1 < 1 || a1 > 3 /* || a2 < 0 || a3 < 0 */)
1516     halt_with_error();
1517
1518
1519   /*   LED_set( a1, a2, a3 ); */ // TODO
1520
1521
1522
1523
1524
1525
1526
1527   arg1 = 0;
1528   arg2 = 0;
1529   arg3 = 0;
1530 }
1531
1532
1533 void prim_led2_color () {
1534   a1 = decode_int (arg1);
1535
1536   if (/* a1 < 0 || */ a1 > 1)
1537     halt_with_error();
1538
1539
1540   /*   LED2_color_set( a1 ); */ // TODO
1541
1542
1543
1544
1545
1546
1547
1548   arg1 = 0;
1549 }
1550
1551
1552 void prim_getchar_wait () {
1553   decode_2_int_args();
1554   a1 = read_clock () + a1;
1555
1556   if (/* a1 < 0 || */ a2 < 1 || a2 > 3)
1557     halt_with_error();
1558
1559
1560   arg1 = 0;
1561   /*   { */ // TODO
1562 /*     serial_port_set ports; */
1563 /*     ports = serial_rx_wait_with_timeout( a2, a1 ); */
1564 /*     if (ports != 0) */
1565 /*       arg1 = encode_int (serial_rx_read( ports )); */
1566 /*   } */
1567 }
1568
1569
1570 void prim_putchar () {
1571   decode_2_int_args ();
1572
1573   if (/* a1 < 0 || */ a1 > 255 || a2 < 1 || a2 > 3)
1574     halt_with_error();
1575
1576
1577   /*   serial_tx_write( a2, a1 ); */ // TODO
1578   uart_write(a1);
1579
1580
1581
1582
1583
1584
1585   arg1 = 0;
1586   arg2 = 0;
1587 }
1588
1589
1590 void prim_beep () {
1591   decode_2_int_args ();
1592
1593   if (a1 < 1 || a1 > 255 /* || a2 < 0 */)
1594     halt_with_error();
1595
1596
1597 /*   beep( a1, from_now( a2 ) ); */
1598
1599
1600
1601
1602
1603
1604
1605   arg1 = 0;
1606   arg2 = 0;
1607 }
1608
1609
1610 void prim_adc () {
1611   uint16 x;
1612
1613   a1 = decode_int (arg1);
1614
1615   if (a1 < 1 || a1 > 3)
1616     halt_with_error();
1617
1618
1619 /*   x = adc( a1 ); */
1620   arg1 = encode_int (x);
1621 }
1622
1623 void prim_sernum () {
1624   uint16 x;
1625
1626
1627 /*   x = serial_num (); */
1628
1629
1630
1631
1632
1633
1634   arg1 = encode_int (x);
1635 }
1636
1637
1638
1639
1640
1641 void prim_network_init () {
1642
1643
1644
1645
1646
1647 }
1648
1649 void prim_network_cleanup () {
1650
1651
1652
1653 }
1654
1655 void prim_receive_packet_to_u8vector () {
1656
1657   if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60)))
1658     halt_with_error();
1659 }
1660
1661 void prim_send_packet_from_u8vector () {
1662
1663
1664
1665   if (!(((ram_get_field0 (arg1) & #x80) == #x80) && ((ram_get_field2 (arg1) & #xe0) == #x60)))
1666     halt_with_error();
1667
1668   a2 = decode_int (arg2);
1669   a1 = 0;
1670
1671
1672   if (ram_get_car (arg1) < a2)
1673     halt_with_error();
1674
1675   arg1 = ram_get_cdr (arg1);
1676   arg2 = 0;
1677 }
1678
1679 /* void push_arg1 (); */
1680 /* uint16 pop (); */
1681 /* void pop_procedure (); */
1682 /* void handle_arity_and_rest_param (); */
1683 /* void build_env (); */
1684 /* void save_cont (); */
1685 /* void interpreter (); */
1686
1687 void push_arg1 () {
1688   env = cons (arg1, env);
1689   arg1 = 0;
1690 }
1691
1692 uint16 pop () {
1693   uint16 o = ram_get_car (env);
1694   env = ram_get_cdr (env);
1695   return o;
1696 }
1697
1698 void pop_procedure () {
1699   arg1 = pop();
1700
1701   if ((!((arg1) >= 1280) && ((arg1) >= 512))) {
1702     if (!((ram_get_field0 (arg1) & #xc0) == #x40))
1703       halt_with_error();
1704
1705     entry = ram_get_entry (arg1) + #x8000;
1706   }
1707   else if ((!((arg1) >= 1280) && !(!((arg1) >= 1280) && ((arg1) >= 512)) && ((arg1) >= (3 +255 - -1 +1)))) {
1708     if (!((rom_get_field0 (arg1) & #xc0) == #x40))
1709       halt_with_error();
1710
1711     entry = rom_get_entry (arg1) + #x8000;
1712   }
1713   else
1714     halt_with_error();
1715 }
1716
1717 void handle_arity_and_rest_param () {
1718   uint8 np;
1719
1720   np = rom_get (entry++);
1721
1722   if ((np & #x80) == 0) {
1723     if (na != np)
1724       halt_with_error();
1725   }
1726   else {
1727     np = ~np;
1728
1729     if (na < np)
1730       halt_with_error();
1731
1732     arg3 = 2;
1733
1734     while (na > np) {
1735       arg4 = pop();
1736
1737       arg3 = cons (arg4, arg3);
1738       arg4 = 0;
1739
1740       na--;
1741     }
1742
1743     arg1 = cons (arg3, arg1);
1744     arg3 = 0;
1745   }
1746 }
1747
1748 void build_env () {
1749   while (na != 0) {
1750     arg3 = pop();
1751
1752     arg1 = cons (arg3, arg1);
1753
1754     na--;
1755   }
1756
1757   arg3 = 0;
1758 }
1759
1760 void save_cont () {
1761
1762   arg3 = alloc_ram_cell_init (#x40 | (pc >> 11),
1763          (pc >> 3) & #xff,
1764          ((pc & #x0007) << 5) | (env >> 8),
1765          env & #xff);
1766   cont = alloc_ram_cell_init (#x80 | (cont >> 8),
1767                               cont & #xff,         #x80 | (arg3 >> 8),
1768                               arg3 & #xff);
1769   arg3 = 0;
1770 }
1771
1772 void init_ram_heap () {
1773   uint8 i;
1774   uint16 o = 1279;
1775
1776   free_list = 0;
1777
1778   uint16 tmp = (512 + ((glovars + 1) >> 1)); // FOO having this here instead of in the while saves ~200 bytes
1779   while (o > tmp) {
1780
1781
1782     ram_set_gc_tags (o, (0<<5));
1783     ram_set_car (o, free_list);
1784     free_list = o;
1785     o--;
1786   }
1787
1788   free_list_vec = 1280;
1789   ram_set_car (free_list_vec, 0);
1790
1791
1792
1793   ram_set_cdr (free_list_vec, ((2047 - 1280 + 1)*4) >> 2);
1794
1795   for (i=0; i<glovars; i++)
1796     set_global (i, 0);
1797
1798   arg1 = 0;
1799   arg2 = 0;
1800   arg3 = 0;
1801   arg4 = 0;
1802   cont = 0;
1803   env = 2;
1804 }
1805
1806
1807 void interpreter () {
1808   uint16 tmp = rom_get (#x8000 +2);
1809   pc = (#x8000 + 4) + (tmp << 2);
1810
1811   glovars = rom_get (#x8000 +3);
1812
1813   init_ram_heap ();
1814
1815  dispatch: ;
1816   bytecode = rom_get (pc++);
1817   bytecode_hi4 = bytecode & #xf0;
1818   bytecode_lo4 = bytecode & #x0f;
1819   switch (bytecode_hi4 >> 4) {;
1820
1821
1822   case 0: // push-constant // TODO used to be #x00 >> 4
1823
1824   ;
1825
1826   arg1 = bytecode_lo4;
1827
1828   push_arg1 ();
1829
1830   ; goto dispatch;;
1831
1832
1833   case 1:;; // push-constant
1834
1835   ;
1836   arg1 = bytecode_lo4+16;
1837
1838   push_arg1 ();
1839
1840   ; goto dispatch;;
1841
1842
1843   case 2:;; // push-stack
1844
1845   ;
1846
1847   arg1 = env;
1848
1849   while (bytecode_lo4 != 0) {
1850     arg1 = ram_get_cdr (arg1);
1851     bytecode_lo4--;
1852   }
1853
1854   arg1 = ram_get_car (arg1);
1855
1856   push_arg1 ();
1857
1858   ; goto dispatch;;
1859
1860
1861   case 3:;; // push-stack
1862
1863   ;
1864
1865   bytecode_lo4 += 16;
1866
1867   arg1 = env;
1868
1869   while (bytecode_lo4 != 0) {
1870     arg1 = ram_get_cdr (arg1);
1871     bytecode_lo4--;
1872   }
1873
1874   arg1 = ram_get_car (arg1);
1875
1876   push_arg1 ();
1877
1878   ; goto dispatch;;
1879
1880
1881   case 4:;; // push-global
1882
1883   ;
1884
1885   arg1 = get_global (bytecode_lo4);
1886
1887   push_arg1 ();
1888
1889   ; goto dispatch;;
1890
1891
1892   case 5:;; // set-global
1893
1894   ;
1895
1896   set_global (bytecode_lo4, pop());
1897
1898   ; goto dispatch;;
1899
1900
1901   case 6:;; // call
1902
1903   ;
1904
1905   na = bytecode_lo4;
1906
1907   pop_procedure ();
1908   handle_arity_and_rest_param ();
1909   build_env ();
1910   save_cont ();
1911
1912   env = arg1;
1913   pc = entry;
1914
1915   arg1 = 0;
1916
1917   ; goto dispatch;;
1918
1919
1920   case 7:;; // jump
1921
1922   ;
1923
1924   na = bytecode_lo4;
1925
1926   pop_procedure ();
1927   handle_arity_and_rest_param ();
1928   build_env ();
1929
1930   env = arg1;
1931   pc = entry;
1932
1933   arg1 = 0;
1934
1935   ; goto dispatch;;
1936
1937
1938   case 8:;;
1939
1940   switch (bytecode_lo4) {
1941   case 0: // call-toplevel
1942     bytecode = rom_get (pc++);
1943     arg2 = bytecode;
1944
1945     bytecode = rom_get (pc++);
1946
1947     ;
1948
1949
1950     entry = (arg2 << 8) + bytecode + #x8000;
1951     arg1 = 2;
1952
1953     na = rom_get (entry++);
1954
1955     build_env ();
1956     save_cont ();
1957
1958     env = arg1;
1959     pc = entry;
1960
1961     arg1 = 0;
1962     arg2 = 0;
1963
1964     break;
1965
1966   case 1: // jump-toplevel
1967     bytecode = rom_get (pc++);
1968     arg2 = bytecode;
1969
1970     bytecode = rom_get (pc++);
1971
1972     ;
1973
1974
1975     entry = (arg2 << 8) + bytecode + #x8000;
1976     arg1 = 2;
1977
1978     na = rom_get (entry++);
1979
1980     build_env ();
1981
1982     env = arg1;
1983     pc = entry;
1984
1985     arg1 = 0;
1986     arg2 = 0;
1987
1988     break;
1989
1990   case 2: // goto
1991     bytecode = rom_get (pc++);
1992     arg2 = bytecode;
1993
1994     bytecode = rom_get (pc++);
1995
1996     ;
1997
1998
1999     pc = (arg2 << 8) + bytecode + #x8000;
2000
2001     break;
2002
2003   case 3: // goto-if-false
2004     bytecode = rom_get (pc++);
2005     arg2 = bytecode;
2006
2007     bytecode = rom_get (pc++);
2008
2009     ;
2010
2011
2012     if (pop() == 0)
2013       pc = (arg2 << 8) + bytecode + #x8000;
2014
2015     break;
2016
2017   case 4: // closure
2018     bytecode = rom_get (pc++);
2019     arg2 = bytecode;
2020
2021     bytecode = rom_get (pc++);
2022
2023     ;
2024
2025     arg3 = pop();
2026
2027     entry = (arg2 << 8) | bytecode;
2028
2029     uint16 tmp = (bytecode & #x07);
2030     arg1 = alloc_ram_cell_init (#x40 | (arg2 >> 3),
2031                                 ((arg2 & #x07) << 5) | (bytecode >> 3),
2032                                 (tmp << 5) |((arg3 &#x1f00) >>8),
2033     arg3 & #xff);
2034
2035     push_arg1 ();
2036
2037     arg2 = 0;
2038     arg3 = 0;
2039
2040     break;
2041
2042     /*   case 5: */ // TODO useless, they don't work in the regular PICOBIT
2043 /*     bytecode = rom_get (pc++); */
2044
2045 /*     ; */
2046
2047
2048 /*     entry = pc + bytecode + #x8000; */
2049 /*     arg1 = 2; */
2050
2051 /*     na = rom_get (entry++); */
2052
2053 /*     build_env (); */
2054 /*     save_cont (); */
2055
2056 /*     env = arg1; */
2057 /*     pc = entry; */
2058
2059 /*     arg1 = 0; */
2060
2061 /*     break; */
2062
2063 /*   case 6: */
2064 /*     bytecode = rom_get (pc++); */
2065
2066 /*     ; */
2067
2068
2069 /*     entry = pc + bytecode + #x8000; */
2070 /*     arg1 = 2; */
2071
2072 /*     na = rom_get (entry++); */
2073
2074 /*     build_env (); */
2075
2076 /*     env = arg1; */
2077 /*     pc = entry; */
2078
2079 /*     arg1 = 0; */
2080
2081 /*     break; */
2082
2083 /*   case 7: */
2084 /*     bytecode = rom_get (pc++); */
2085
2086 /*     ; */
2087
2088 /*     pc = pc + bytecode + #x8000; */
2089
2090 /*     break; */
2091
2092 /*   case 8: */
2093 /*     bytecode = rom_get (pc++); */
2094
2095 /*     ; */
2096
2097
2098 /*     if (pop() == 0) */
2099 /*       pc = pc + bytecode + #x8000; */
2100
2101 /*     break; */
2102
2103 /*   case 9: */
2104 /*     bytecode = rom_get (pc++); */
2105
2106 /*     ; */
2107
2108 /*     arg3 = pop(); */
2109
2110 /*     entry = pc + bytecode; */
2111
2112 /*     arg1 = alloc_ram_cell_init (#x40 | (arg2 >> 3), */
2113 /*     ((arg2 & #x07) << 5) | (bytecode >> 3), */
2114 /*     ((bytecode &#x07) <<5) |((arg3 &#x1f00) >>8), */
2115 /*     arg3 & #xff); */
2116
2117 /*     push_arg1 (); */
2118
2119 /*     arg3 = 0; */
2120
2121 /*     break; */
2122   case 14: // push-global [long]
2123     bytecode = rom_get (pc++);
2124
2125     ;
2126
2127     arg1 = get_global (bytecode);
2128
2129     push_arg1 ();
2130
2131     break;
2132
2133   case 15: // set-global [long]
2134     bytecode = rom_get (pc++);
2135
2136     ;
2137
2138     set_global (bytecode, pop());
2139
2140     break;
2141   }
2142
2143   ; goto dispatch;;
2144
2145
2146   case 9:;; // push-constant [long]
2147
2148
2149
2150   bytecode = rom_get (pc++);
2151
2152   ;
2153
2154   uint16 tmp = bytecode_lo4; // TODO ugly patch. not needed with gcc since the 8 is an int, and would make all the other operands ints, whereas we keep using uint8, and truncate the value
2155   arg1 = (tmp << 8) | bytecode;
2156   push_arg1 ();
2157
2158   ; goto dispatch;;
2159
2160
2161   case 10:;;
2162
2163   ; goto dispatch;;
2164
2165
2166   case 11:;;
2167
2168   ; goto dispatch;;
2169
2170
2171   case 12:;;
2172
2173   ;
2174
2175   switch (bytecode_lo4) {
2176   case 0:
2177     arg1 = pop(); prim_numberp (); push_arg1 (); break;
2178   case 1:
2179     arg2 = pop(); arg1 = pop(); prim_add (); push_arg1 (); break;
2180   case 2:
2181     arg2 = pop(); arg1 = pop(); prim_sub (); push_arg1 (); break;
2182   case 3:
2183     arg2 = pop(); arg1 = pop(); prim_mul (); push_arg1 (); break;
2184   case 4:
2185     arg2 = pop(); arg1 = pop(); prim_div (); push_arg1 (); break;
2186   case 5:
2187     arg2 = pop(); arg1 = pop(); prim_rem (); push_arg1 (); break;
2188   case 6:
2189     arg1 = pop(); prim_neg (); push_arg1 (); break;
2190   case 7:
2191     arg2 = pop(); arg1 = pop(); prim_eq (); push_arg1 (); break;
2192   case 8:
2193     arg2 = pop(); arg1 = pop(); prim_lt (); push_arg1 (); break;
2194   case 9:
2195     arg2 = pop(); arg1 = pop(); prim_leq (); push_arg1 (); break;
2196   case 10:
2197     arg2 = pop(); arg1 = pop(); prim_gt (); push_arg1 (); break;
2198   case 11:
2199     arg2 = pop(); arg1 = pop(); prim_geq (); push_arg1 (); break;
2200   case 12:
2201     arg1 = pop(); prim_pairp (); push_arg1 (); break;
2202   case 13:
2203     arg2 = pop(); arg1 = pop(); prim_cons (); push_arg1 (); break;
2204   case 14:
2205     arg1 = pop(); prim_car (); push_arg1 (); break;
2206   case 15:
2207     arg1 = pop(); prim_cdr (); push_arg1 (); break;
2208   }
2209
2210   ; goto dispatch;;
2211
2212
2213   case 13:;;
2214
2215   ;
2216
2217   switch (bytecode_lo4) {
2218   case 0:
2219     arg2 = pop(); arg1 = pop(); prim_set_car (); break;
2220   case 1:
2221     arg2 = pop(); arg1 = pop(); prim_set_cdr (); break;
2222   case 2:
2223     arg1 = pop(); prim_nullp (); push_arg1 (); break;
2224   case 3:
2225     arg2 = pop(); arg1 = pop(); prim_eqp (); push_arg1 (); break;
2226   case 4:
2227     arg1 = pop(); prim_not (); push_arg1 (); break;
2228   case 5: // get-cont
2229
2230     arg1 = cont;
2231     push_arg1 ();
2232     break;
2233   case 6: // graft-to-cont
2234
2235
2236     arg1 = pop();
2237     cont = pop();
2238
2239     push_arg1 ();
2240
2241     na = 0;
2242
2243     pop_procedure ();
2244     handle_arity_and_rest_param ();
2245     build_env ();
2246
2247     env = arg1;
2248     pc = entry;
2249
2250     arg1 = 0;
2251
2252     break;
2253   case 7: // return-to-cont
2254
2255
2256     arg1 = pop();
2257     cont = pop();
2258
2259     arg2 = ram_get_cdr (cont);
2260
2261     pc = ram_get_entry (arg2);
2262
2263     env = ram_get_cdr (arg2);
2264     cont = ram_get_car (cont);
2265
2266     push_arg1 ();
2267     arg2 = 0;
2268
2269     break;
2270   case 8: // halt
2271
2272     return;
2273   case 9:
2274
2275     arg1 = pop(); prim_symbolp (); push_arg1 (); break;
2276   case 10:
2277
2278     arg1 = pop(); prim_stringp (); push_arg1 (); break;
2279   case 11:
2280
2281     arg1 = pop(); prim_string2list (); push_arg1 (); break;
2282   case 12:
2283
2284     arg1 = pop(); prim_list2string (); push_arg1 (); break;
2285   case 13:
2286
2287     arg2 = pop(); arg1 = pop(); prim_make_u8vector (); push_arg1 (); break;
2288   case 14:
2289
2290     arg2 = pop(); arg1 = pop(); prim_u8vector_ref (); push_arg1 (); break;
2291   case 15:
2292
2293     arg3 = pop(); arg2 = pop(); arg1 = pop(); prim_u8vector_set (); break;
2294   }
2295
2296   ; goto dispatch;;
2297
2298
2299   case 14:;;
2300
2301   ;
2302
2303   switch (bytecode_lo4) {
2304   case 0:
2305
2306     arg1 = pop();
2307     prim_print ();
2308     break;
2309   case 1:
2310
2311     prim_clock (); push_arg1 (); break;
2312   case 2:
2313
2314     arg2 = pop(); arg1 = pop(); prim_motor (); break;
2315   case 3:
2316
2317     arg3 = pop(); arg2 = pop(); arg1 = pop(); prim_led (); ;break;
2318   case 4:
2319
2320     arg1 = pop(); prim_led2_color (); break;
2321   case 5:
2322
2323     arg2 = pop(); arg1 = pop(); prim_getchar_wait (); push_arg1 (); break;
2324   case 6:
2325
2326     arg2 = pop(); arg1 = pop(); prim_putchar (); break;
2327   case 7:
2328
2329     arg2 = pop(); arg1 = pop(); prim_beep (); break;
2330   case 8:
2331
2332     arg1 = pop(); prim_adc (); push_arg1 (); break;
2333   case 9:
2334
2335     arg1 = pop(); prim_u8vectorp (); push_arg1 (); break;
2336   case 10:
2337
2338     prim_sernum (); push_arg1 (); break;
2339   case 11:
2340
2341     arg1 = pop(); prim_u8vector_length (); push_arg1 (); break;
2342   case 12:
2343
2344     arg5 = pop(); arg4 = pop(); arg3 = pop(); arg2 = pop(); arg1 = pop();
2345     prim_u8vector_copy (); break;
2346   case 13: // shift
2347
2348     arg1 = pop();
2349     pop();
2350     push_arg1 ();
2351     break;
2352   case 14: // pop
2353
2354     pop();
2355     break;
2356   case 15: // return
2357
2358     arg1 = pop();
2359     arg2 = ram_get_cdr (cont);
2360     pc = ram_get_entry (arg2);
2361     env = ram_get_cdr (arg2);
2362     cont = ram_get_car (cont);
2363     push_arg1 ();
2364     arg2 = 0;
2365     break;
2366   }
2367
2368   ; goto dispatch;;
2369
2370
2371
2372   case 15:;;
2373
2374   ;
2375
2376   switch (bytecode_lo4) {
2377   case 0:
2378
2379     arg1 = pop(); prim_booleanp (); push_arg1 (); break;
2380   case 1:
2381
2382     prim_network_init (); break;
2383   case 2:
2384
2385     prim_network_cleanup (); break;
2386   case 3:
2387
2388     arg1 = pop(); prim_receive_packet_to_u8vector (); push_arg1 (); break;
2389   case 4:
2390
2391     arg2 = pop(); arg1 = pop(); prim_send_packet_from_u8vector ();
2392     push_arg1 (); break;
2393   case 5:
2394     arg2 = pop(); arg1 = pop(); prim_ior (); push_arg1 (); break;
2395   case 6:
2396     arg2 = pop(); arg1 = pop(); prim_xor (); push_arg1 (); break;
2397   }
2398
2399   ; goto dispatch;;
2400
2401
2402
2403   };
2404 }
2405
2406 interpreter();