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