073a8ef2b11d0347e69813124007bc2d191925d5
1 /* file: "dispatch.c" */
4 * Copyright 2004-2009 by Marc Feeley and Vincent St-Amour, All Rights Reserved.
7 #include "picobit-vm.h"
10 env
= cons (arg1
, env
);
15 obj o
= ram_get_car (env
);
16 env
= ram_get_cdr (env
);
20 void pop_procedure () {
24 if (!RAM_CLOSURE(arg1
))
25 TYPE_ERROR("pop_procedure.0", "procedure");
27 entry
= ram_get_entry (arg1
) + CODE_START
;
29 else if (IN_ROM(arg1
)) {
30 if (!ROM_CLOSURE(arg1
))
31 TYPE_ERROR("pop_procedure.1", "procedure");
33 entry
= rom_get_entry (arg1
) + CODE_START
;
36 TYPE_ERROR("pop_procedure.2", "procedure");
39 uint8
handle_arity_and_rest_param (uint8 na
) {
42 np
= rom_get (entry
++);
44 if ((np
& 0x80) == 0) {
46 ERROR("handle_arity_and_rest_param.0", "wrong number of arguments");
52 ERROR("handle_arity_and_rest_param.1", "wrong number of arguments");
59 arg3
= cons (arg4
, arg3
);
65 arg1
= cons (arg3
, arg1
);
72 uint8
build_env (uint8 na
) {
76 arg1
= cons (arg3
, arg1
);
85 // the second half is a closure
86 arg3
= alloc_ram_cell_init (CLOSURE_FIELD0
| (pc
>> 11),
88 ((pc
& 0x0007) << 5) | (env
>> 8),
90 cont
= alloc_ram_cell_init (COMPOSITE_FIELD0
| (cont
>> 8),
92 CONTINUATION_FIELD2
| (arg3
>> 8),
98 pc
= rom_get (CODE_START
+2);
99 pc
= (CODE_START
+ 4) + (pc
<< 2);
101 glovars
= rom_get (CODE_START
+3); // number of global variables
106 IF_TRACE(show_state (pc
));
107 FETCH_NEXT_BYTECODE();
108 bytecode_hi4
= bytecode
& 0xf0;
109 bytecode_lo4
= bytecode
& 0x0f;
111 switch (bytecode_hi4
>> 4) {
113 /*************************************************************************/
114 case PUSH_CONSTANT1
:
116 IF_TRACE(printf(" (push-constant "); show (bytecode_lo4
); printf (")\n"));
124 /*************************************************************************/
125 case PUSH_CONSTANT2
:
127 IF_TRACE(printf(" (push-constant "); show (bytecode_lo4
+16); printf (")\n"));
128 arg1
= bytecode_lo4
+16;
134 /*************************************************************************/
137 IF_TRACE(printf(" (push-stack %d)\n", bytecode_lo4
));
141 while (bytecode_lo4
!= 0) {
142 arg1
= ram_get_cdr (arg1
);
146 arg1
= ram_get_car (arg1
);
152 /*************************************************************************/
155 IF_TRACE(printf(" (push-stack %d)\n", bytecode_lo4
+16));
161 while (bytecode_lo4
!= 0) {
162 arg1
= ram_get_cdr (arg1
);
166 arg1
= ram_get_car (arg1
);
172 /*************************************************************************/
175 IF_TRACE(printf(" (push-global %d)\n", bytecode_lo4
));
177 arg1
= get_global (bytecode_lo4
);
183 /*************************************************************************/
186 IF_TRACE(printf(" (set-global %d)\n", bytecode_lo4
));
188 set_global (bytecode_lo4
, pop());
192 /*************************************************************************/
195 IF_TRACE(printf(" (call %d)\n", bytecode_lo4
));
198 build_env (handle_arity_and_rest_param (bytecode_lo4
));
208 /*************************************************************************/
211 IF_TRACE(printf(" (jump %d)\n", bytecode_lo4
));
214 build_env (handle_arity_and_rest_param (bytecode_lo4
));
223 /*************************************************************************/
226 switch (bytecode_lo4
) {
227 case 0: // call-toplevel
228 FETCH_NEXT_BYTECODE();
231 FETCH_NEXT_BYTECODE();
233 IF_TRACE(printf(" (call-toplevel 0x%04x)\n",
234 ((arg2
<< 8) | bytecode
) + CODE_START
));
236 entry
= (arg2
<< 8) + bytecode
+ CODE_START
;
239 build_env (rom_get (entry
++));
250 case 1: // jump-toplevel
251 FETCH_NEXT_BYTECODE();
254 FETCH_NEXT_BYTECODE();
256 IF_TRACE(printf(" (jump-toplevel 0x%04x)\n",
257 ((arg2
<< 8) | bytecode
) + CODE_START
));
259 entry
= (arg2
<< 8) + bytecode
+ CODE_START
;
262 build_env (rom_get (entry
++));
273 FETCH_NEXT_BYTECODE();
276 FETCH_NEXT_BYTECODE();
278 IF_TRACE(printf(" (goto 0x%04x)\n",
279 (arg2
<< 8) + bytecode
+ CODE_START
));
281 pc
= (arg2
<< 8) + bytecode
+ CODE_START
;
285 case 3: // goto-if-false
286 FETCH_NEXT_BYTECODE();
289 FETCH_NEXT_BYTECODE();
291 IF_TRACE(printf(" (goto-if-false 0x%04x)\n",
292 (arg2
<< 8) + bytecode
+ CODE_START
));
294 if (pop() == OBJ_FALSE
)
295 pc
= (arg2
<< 8) + bytecode
+ CODE_START
;
300 FETCH_NEXT_BYTECODE();
303 FETCH_NEXT_BYTECODE();
305 entry
= (arg2
<< 8) | bytecode
;
307 IF_TRACE(printf(" (closure 0x%04x)\n", entry
));
311 arg1
= alloc_ram_cell_init (CLOSURE_FIELD0
| (entry
>> 11),
313 ((entry
& 0x07) <<5) | ((arg3
>> 8) & 0x1f),
318 alloc_ram_cell_init (CLOSURE_FIELD0
| (arg2
>> 3),
319 ((arg2
& 0x07) << 5) | (bytecode
>> 3),
320 ((bytecode
& 0x07) << 5) | ((arg3
& 0x1f00) >> 8),
332 case 5: // call-toplevel-rel8
333 FETCH_NEXT_BYTECODE(); // TODO the short version have a lot in common with the long ones, abstract ?
335 IF_TRACE(printf(" (call-toplevel-rel8 0x%04x)\n", pc
+ bytecode
- 128));
337 entry
= pc
+ bytecode
- 128;
340 build_env (rom_get (entry
++));
350 case 6: // jump-toplevel-rel8
351 FETCH_NEXT_BYTECODE();
353 IF_TRACE(printf(" (jump-toplevel-rel8 0x%04x)\n", pc
+ bytecode
- 128));
355 entry
= pc
+ bytecode
- 128;
358 build_env (rom_get (entry
++));
368 FETCH_NEXT_BYTECODE();
370 IF_TRACE(printf(" (goto-rel8 0x%04x)\n", pc
+ bytecode
- 128));
372 pc
= pc
+ bytecode
- 128;
376 case 8: // goto-if-false-rel8
377 FETCH_NEXT_BYTECODE();
379 IF_TRACE(printf(" (goto-if-false-rel8 0x%04x)\n", pc
+ bytecode
- 128));
381 if (pop() == OBJ_FALSE
)
382 pc
= pc
+ bytecode
- 128;
388 // FOO why does this not work? don't worry about it now.
390 case 9: // closure-rel8
391 FETCH_NEXT_BYTECODE();
393 entry
= pc
+ bytecode
- 128;
395 IF_TRACE(printf(" (closure-rel8 0x%04x)\n", entry
));
399 arg1
= alloc_ram_cell_init (CLOSURE_FIELD0
| (entry
>> 11),
401 ((entry
& 0x07) << 5) | ((arg3
>> 8) & 0x1f),
423 case 14: // push_global [long]
424 FETCH_NEXT_BYTECODE();
426 IF_TRACE(printf(" (push-global [long] %d)\n", bytecode
));
428 arg1
= get_global (bytecode
);
434 case 15: // set_global [long]
435 FETCH_NEXT_BYTECODE();
437 IF_TRACE(printf(" (set-global [long] %d)\n", bytecode
));
439 set_global (bytecode
, pop());
446 /*************************************************************************/
447 case PUSH_CONSTANT_LONG
:
449 /* push-constant [long] */
451 FETCH_NEXT_BYTECODE();
453 IF_TRACE(printf(" (push [long] 0x%04x)\n", (bytecode_lo4
<< 8) + bytecode
));
455 // necessary since SIXPIC would have kept the result of the shift at 8 bits
457 arg1
= (arg1
<< 8) | bytecode
;
462 /*************************************************************************/
464 case JUMP_TOPLEVEL_REL4
:
466 IF_TRACE(printf(" (jump-toplevel-rel4 0x%04x)\n", pc
+ (bytecode
& 0x0f)));
468 entry
= pc
+ (bytecode
& 0x0f);
471 build_env (rom_get (entry
++));
480 /*************************************************************************/
482 case GOTO_IF_FALSE_REL4
:
484 IF_TRACE(printf(" (goto-if-false-rel4 0x%04x)\n", pc
+ (bytecode
& 0x0f)));
486 if (pop() == OBJ_FALSE
)
487 pc
= pc
+ (bytecode
& 0x0f);
491 /*************************************************************************/
494 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
]));
496 switch (bytecode_lo4
) {
498 arg1
= pop(); prim_numberp (); push_arg1(); break;
500 arg2
= pop(); arg1
= pop(); prim_add (); push_arg1(); break;
502 arg2
= pop(); arg1
= pop(); prim_sub (); push_arg1(); break;
504 arg2
= pop(); arg1
= pop(); prim_mul (); push_arg1(); break;
506 arg2
= pop(); arg1
= pop(); prim_div (); push_arg1(); break;
508 arg2
= pop(); arg1
= pop(); prim_rem (); push_arg1(); break;
510 arg1
= pop(); prim_neg (); push_arg1(); break;
512 arg2
= pop(); arg1
= pop(); prim_eq (); push_arg1(); break;
514 arg2
= pop(); arg1
= pop(); prim_lt (); push_arg1(); break;
516 arg2
= pop(); arg1
= pop(); prim_leq (); push_arg1(); break;
518 arg2
= pop(); arg1
= pop(); prim_gt (); push_arg1(); break;
520 arg2
= pop(); arg1
= pop(); prim_geq (); push_arg1(); break;
522 arg1
= pop(); prim_pairp (); push_arg1(); break;
524 arg2
= pop(); arg1
= pop(); prim_cons (); push_arg1(); break;
526 arg1
= pop(); prim_car (); push_arg1(); break;
528 arg1
= pop(); prim_cdr (); push_arg1(); break;
533 /*************************************************************************/
536 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
+16]));
538 switch (bytecode_lo4
) {
540 arg2
= pop(); arg1
= pop(); prim_set_car (); break;
542 arg2
= pop(); arg1
= pop(); prim_set_cdr (); break;
544 arg1
= pop(); prim_nullp (); push_arg1(); break;
546 arg2
= pop(); arg1
= pop(); prim_eqp (); push_arg1(); break;
548 arg1
= pop(); prim_not (); push_arg1(); break;
550 /* prim #%get-cont */
555 /* prim #%graft-to-cont */
557 arg1
= pop(); /* thunk to call */
558 cont
= pop(); /* continuation */
563 build_env (handle_arity_and_rest_param (0));
572 /* prim #%return-to-cont */
574 arg1
= pop(); /* value to return */
575 cont
= pop(); /* continuation */
577 arg2
= ram_get_cdr (cont
);
579 pc
= ram_get_entry (arg2
);
581 env
= ram_get_cdr (arg2
);
582 cont
= ram_get_car (cont
);
593 arg1
= pop(); prim_symbolp (); push_arg1(); break;
596 arg1
= pop(); prim_stringp (); push_arg1(); break;
598 /* prim #%string->list */
599 arg1
= pop(); prim_string2list (); push_arg1(); break;
601 /* prim #%list->string */
602 arg1
= pop(); prim_list2string (); push_arg1(); break;
604 /* prim #%make-u8vector */
605 arg2
= pop(); arg1
= pop(); prim_make_u8vector (); push_arg1(); break;
607 /* prim #%u8vector-ref */
608 arg2
= pop(); arg1
= pop(); prim_u8vector_ref (); push_arg1(); break;
610 /* prim #%u8vector-set! */
611 arg3
= pop(); arg2
= pop(); arg1
= pop(); prim_u8vector_set (); break;
616 /*************************************************************************/
619 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
+32]));
621 switch (bytecode_lo4
) {
629 prim_clock (); push_arg1(); break;
632 arg2
= pop(); arg1
= pop(); prim_motor (); break;
635 arg3
= pop(); arg2
= pop(); arg1
= pop(); prim_led (); ;break;
637 /* prim #%led2-color */
638 arg1
= pop(); prim_led2_color (); break;
640 /* prim #%getchar-wait */
641 arg2
= pop(); arg1
= pop(); prim_getchar_wait (); push_arg1(); break;
644 arg2
= pop(); arg1
= pop(); prim_putchar (); break;
647 arg2
= pop(); arg1
= pop(); prim_beep (); break;
650 arg1
= pop(); prim_adc (); push_arg1(); break;
652 /* prim #%u8vector? */
653 arg1
= pop(); prim_u8vectorp (); push_arg1(); break;
656 prim_sernum (); push_arg1(); break;
658 /* prim #%u8vector-length */
659 arg1
= pop(); prim_u8vector_length (); push_arg1(); break;
661 /* prim #%u8vector-copy! */
662 arg5
= pop(); arg4
= pop(); arg3
= pop(); arg2
= pop(); arg1
= pop();
663 prim_u8vector_copy (); break;
678 arg2
= ram_get_cdr (cont
);
679 pc
= ram_get_entry (arg2
);
680 env
= ram_get_cdr (arg2
);
681 cont
= ram_get_car (cont
);
689 /*************************************************************************/
693 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
]));
695 switch (bytecode_lo4
) {
697 /* prim #%boolean? */
698 arg1
= pop(); prim_booleanp (); push_arg1(); break;
700 /* prim #%network-init */
701 prim_network_init (); break;
703 /* prim #%network-cleanup */
704 prim_network_cleanup (); break;
706 /* prim #%receive-packet-to-u8vector */
707 arg1
= pop(); prim_receive_packet_to_u8vector (); push_arg1(); break;
709 /* prim #%send-packet-from-u8vector */
710 arg2
= pop(); arg1
= pop(); prim_send_packet_from_u8vector ();
713 arg2
= pop(); arg1
= pop(); prim_ior (); push_arg1(); break;
716 arg2
= pop(); arg1
= pop(); prim_xor (); push_arg1(); break;
742 /*************************************************************************/