Removed code that dealt with ROM closure, since these don't exist.
[picobit.git] / primitives.c
blob8d33917b7f5bb00225bb9572b708cde8bde5ba9b
1 /* file: "primitives.c" */
3 /*
4 * Copyright 2004-2009 by Marc Feeley and Vincent St-Amour, All Rights Reserved.
5 */
7 #include "picobit-vm.h"
9 /*---------------------------------------------------------------------------*/
11 #ifdef WORKSTATION
12 char *prim_name[64] =
14 "prim #%number?",
15 "prim #%+",
16 "prim #%-",
17 "prim #%mul-non-neg",
18 "prim #%quotient",
19 "prim #%remainder",
20 "prim 6",
21 "prim #%=",
22 "prim #%<",
23 "prim 9",
24 "prim #%>",
25 "prim 11",
26 "prim #%pair?",
27 "prim #%cons",
28 "prim #%car",
29 "prim #%cdr",
30 "prim #%set-car!",
31 "prim #%set-cdr!",
32 "prim #%null?",
33 "prim #%eq?",
34 "prim #%not",
35 "prim #%get-cont",
36 "prim #%graft-to-cont",
37 "prim #%return-to-cont",
38 "prim #%halt",
39 "prim #%symbol?",
40 "prim #%string?",
41 "prim #%string->list",
42 "prim #%list->string",
43 "prim #%make-u8vector",
44 "prim #%u8vector-ref",
45 "prim #%u8vector-set!",
46 "prim #%print",
47 "prim #%clock",
48 "prim #%motor",
49 "prim #%led",
50 "prim #%led2-color",
51 "prim #%getchar-wait",
52 "prim #%putchar",
53 "prim #%beep",
54 "prim #%adc",
55 "prim #%u8vector?",
56 "prim #%sernum",
57 "prim #%u8vector-length",
58 "prim 44"
59 "shift",
60 "pop",
61 "return",
62 "prim #%boolean?",
63 "prim #%network-init",
64 "prim #%network-cleanup",
65 "prim #%receive-packet-to-u8vector",
66 "prim #%send-packet-from-u8vector",
67 "prim #%ior",
68 "prim #%xor",
69 "prim 55",
70 "prim 56",
71 "prim 57",
72 "prim 58",
73 "prim 59",
74 "prim 60",
75 "prim 61",
76 "prim 62",
77 "prim 63"
79 #endif
81 /*---------------------------------------------------------------------------*/
83 // numerical primitives
85 void prim_numberp () {
86 if (arg1 >= MIN_FIXNUM_ENCODING
87 && arg1 <= (MIN_FIXNUM_ENCODING + (MAX_FIXNUM - MIN_FIXNUM)))
88 arg1 = OBJ_TRUE;
89 else {
90 if (IN_RAM(arg1))
91 arg1 = encode_bool (RAM_BIGNUM(arg1));
92 else if (IN_ROM(arg1))
93 arg1 = encode_bool (ROM_BIGNUM(arg1));
94 else
95 arg1 = OBJ_FALSE;
99 void prim_add () {
100 #ifdef INFINITE_PRECISION_BIGNUMS
101 arg1 = add (arg1, arg2);
102 #else
103 decode_2_int_args ();
104 arg1 = encode_int (a1 + a2);
105 #endif
106 arg2 = OBJ_FALSE;
109 void prim_sub () {
110 #ifdef INFINITE_PRECISION_BIGNUMS
111 arg1 = sub (arg1, arg2);
112 #else
113 decode_2_int_args ();
114 arg1 = encode_int (a1 - a2);
115 #endif
116 arg2 = OBJ_FALSE;
119 void prim_mul_non_neg () {
120 #ifdef INFINITE_PRECISION_BIGNUMS
121 arg1 = mulnonneg (arg1, arg2);
122 #else
123 decode_2_int_args ();
124 arg1 = encode_int (a1 * a2);
125 #endif
126 arg2 = OBJ_FALSE;
129 void prim_div_non_neg () {
130 #ifdef INFINITE_PRECISION_BIGNUMS
131 if (obj_eq(arg2, ZERO))
132 ERROR("quotient", "divide by 0");
133 arg1 = divnonneg (arg1, arg2);
134 #else
135 decode_2_int_args ();
136 if (a2 == 0)
137 ERROR("quotient", "divide by 0");
138 arg1 = encode_int (a1 / a2);
139 #endif
140 arg2 = OBJ_FALSE;
143 void prim_rem () {
144 #ifdef INFINITE_PRECISION_BIGNUMS
145 if (obj_eq(arg2, ZERO))
146 ERROR("remainder", "divide by 0");
147 if (negp(arg1) || negp(arg2))
148 ERROR("remainder", "only positive numbers are supported");
149 // TODO fix this to handle negatives
150 // TODO logic quite similar to mul and div (likely, once we fix), abstract ?
151 arg3 = divnonneg (arg1, arg2);
152 arg4 = mulnonneg (arg2, arg3);
153 arg1 = sub(arg1, arg4);
154 arg3 = OBJ_FALSE;
155 arg4 = OBJ_FALSE;
156 #else
157 decode_2_int_args ();
158 if (a2 == 0)
159 ERROR("remainder", "divide by 0");
160 arg1 = encode_int (a1 % a2);
161 #endif
162 arg2 = OBJ_FALSE;
165 void prim_eq () {
166 #ifdef INFINITE_PRECISION_BIGNUMS
167 arg1 = encode_bool(cmp (arg1, arg2) == 1);
168 #else
169 decode_2_int_args ();
170 arg1 = encode_bool(a1 == a2);
171 #endif
172 arg2 = OBJ_FALSE;
175 void prim_lt () {
176 #ifdef INFINITE_PRECISION_BIGNUMS
177 arg1 = encode_bool(cmp (arg1, arg2) < 1);
178 #else
179 decode_2_int_args ();
180 arg1 = encode_bool(a1 < a2);
181 #endif
182 arg2 = OBJ_FALSE;
185 void prim_gt () {
186 #ifdef INFINITE_PRECISION_BIGNUMS
187 arg1 = encode_bool(cmp (arg1, arg2) > 1);
188 #else
189 decode_2_int_args ();
190 arg1 = encode_bool(a1 > a2);
191 #endif
192 arg2 = OBJ_FALSE;
195 void prim_ior () {
196 #ifdef INFINITE_PRECISION_BIGNUMS
197 arg1 = bitwise_ior(arg1, arg2);
198 #else
199 decode_2_int_args ();
200 arg1 = encode_int (a1 | a2);
201 #endif
202 arg2 = OBJ_FALSE;
205 void prim_xor () {
206 #ifdef INFINITE_PRECISION_BIGNUMS
207 arg1 = bitwise_xor(arg1, arg2);
208 #else
209 decode_2_int_args ();
210 arg1 = encode_int (a1 ^ a2);
211 #endif
212 arg2 = OBJ_FALSE;
215 // TODO primitives for shifting ?
217 /*---------------------------------------------------------------------------*/
219 // list primitives
221 void prim_pairp () {
222 if (IN_RAM(arg1))
223 arg1 = encode_bool (RAM_PAIR(arg1));
224 else if (IN_ROM(arg1))
225 arg1 = encode_bool (ROM_PAIR(arg1));
226 else
227 arg1 = OBJ_FALSE;
230 obj cons (obj car, obj cdr) {
231 return alloc_ram_cell_init (COMPOSITE_FIELD0 | (car >> 8),
232 car & 0xff,
233 PAIR_FIELD2 | (cdr >> 8),
234 cdr & 0xff);
237 void prim_cons () {
238 arg1 = cons (arg1, arg2);
239 arg2 = OBJ_FALSE;
242 void prim_car () {
243 if (IN_RAM(arg1)) {
244 if (!RAM_PAIR(arg1))
245 TYPE_ERROR("car.0", "pair");
246 arg1 = ram_get_car (arg1);
248 else if (IN_ROM(arg1)) {
249 if (!ROM_PAIR(arg1))
250 TYPE_ERROR("car.1", "pair");
251 arg1 = rom_get_car (arg1);
253 else
254 TYPE_ERROR("car.2", "pair");
257 void prim_cdr () {
258 if (IN_RAM(arg1)) {
259 if (!RAM_PAIR(arg1))
260 TYPE_ERROR("cdr.0", "pair");
261 arg1 = ram_get_cdr (arg1);
263 else if (IN_ROM(arg1)) {
264 if (!ROM_PAIR(arg1))
265 TYPE_ERROR("cdr.1", "pair");
266 arg1 = rom_get_cdr (arg1);
268 else
269 TYPE_ERROR("cdr.2", "pair");
272 void prim_set_car () {
273 if (IN_RAM(arg1)) {
274 if (!RAM_PAIR(arg1))
275 TYPE_ERROR("set-car!.0", "pair");
277 ram_set_car (arg1, arg2);
278 arg1 = OBJ_FALSE;
279 arg2 = OBJ_FALSE;
281 else
282 TYPE_ERROR("set-car!.1", "pair");
285 void prim_set_cdr () {
286 if (IN_RAM(arg1)) {
287 if (!RAM_PAIR(arg1))
288 TYPE_ERROR("set-cdr!.0", "pair");
290 ram_set_cdr (arg1, arg2);
291 arg1 = OBJ_FALSE;
292 arg2 = OBJ_FALSE;
294 else
295 TYPE_ERROR("set-cdr!.1", "pair");
298 void prim_nullp () {
299 arg1 = encode_bool (arg1 == OBJ_NULL);
302 /*---------------------------------------------------------------------------*/
304 // vector primitives
306 void prim_u8vectorp () {
307 if (IN_RAM(arg1))
308 arg1 = encode_bool (RAM_VECTOR(arg1));
309 else if (IN_ROM(arg1))
310 arg1 = encode_bool (ROM_VECTOR(arg1));
311 else
312 arg1 = OBJ_FALSE;
315 void prim_make_u8vector () {
316 a1 = decode_int (arg1); // arg1 is length
317 // TODO adapt for the new bignums
319 arg2 = alloc_vec_cell (a1);
320 arg1 = alloc_ram_cell_init (COMPOSITE_FIELD0 | (a1 >> 8),
321 a1 & 0xff,
322 VECTOR_FIELD2 | (arg2 >> 8),
323 arg2 & 0xff);
324 arg2 = OBJ_FALSE;
327 void prim_u8vector_ref () {
328 a2 = decode_int (arg2);
329 // TODO adapt for the new bignums
330 if (IN_RAM(arg1)) {
331 if (!RAM_VECTOR(arg1))
332 TYPE_ERROR("u8vector-ref.0", "vector");
333 if (ram_get_car (arg1) <= a2)
334 ERROR("u8vector-ref.0", "vector index invalid");
335 arg1 = ram_get_cdr (arg1);
337 else if (IN_ROM(arg1)) {
338 if (!ROM_VECTOR(arg1))
339 TYPE_ERROR("u8vector-ref.1", "vector");
340 if (rom_get_car (arg1) <= a2)
341 ERROR("u8vector-ref.1", "vector index invalid");
342 arg1 = rom_get_cdr (arg1);
344 else
345 TYPE_ERROR("u8vector-ref.2", "vector");
347 if (IN_VEC(arg1)) {
348 arg1 += (a2 >> 2);
349 a2 %= 4;
351 arg1 = encode_int (ram_get_fieldn (arg1, a2));
353 else { // rom vector, stored as a list
354 while (a2--)
355 arg1 = rom_get_cdr (arg1);
357 // the contents are already encoded as fixnums
358 arg1 = rom_get_car (arg1);
361 arg2 = OBJ_FALSE;
362 arg3 = OBJ_FALSE;
363 arg4 = OBJ_FALSE;
366 void prim_u8vector_set () { // TODO a lot in common with ref, abstract that
367 a2 = decode_int (arg2); // TODO adapt for bignums
368 a3 = decode_int (arg3);
370 if (a3 > 255)
371 ERROR("u8vector-set!", "byte vectors can only contain bytes");
373 if (IN_RAM(arg1)) {
374 if (!RAM_VECTOR(arg1))
375 TYPE_ERROR("u8vector-set!.0", "vector");
376 if (ram_get_car (arg1) <= a2)
377 ERROR("u8vector-set!", "vector index invalid");
378 arg1 = ram_get_cdr (arg1);
380 else
381 TYPE_ERROR("u8vector-set!.1", "vector");
383 arg1 += (a2 >> 2);
384 a2 %= 4;
386 ram_set_fieldn (arg1, a2, a3);
388 arg1 = OBJ_FALSE;
389 arg2 = OBJ_FALSE;
390 arg3 = OBJ_FALSE;
393 void prim_u8vector_length () {
394 if (IN_RAM(arg1)) {
395 if (!RAM_VECTOR(arg1))
396 TYPE_ERROR("u8vector-length.0", "vector");
397 arg1 = encode_int (ram_get_car (arg1));
399 else if (IN_ROM(arg1)) {
400 if (!ROM_VECTOR(arg1))
401 TYPE_ERROR("u8vector-length.1", "vector");
402 arg1 = encode_int (rom_get_car (arg1));
404 else
405 TYPE_ERROR("u8vector-length.2", "vector");
409 /*---------------------------------------------------------------------------*/
411 // miscellaneous primitives
413 void prim_eqp () {
414 arg1 = encode_bool (arg1 == arg2);
415 arg2 = OBJ_FALSE;
418 void prim_not () {
419 arg1 = encode_bool (arg1 == OBJ_FALSE);
422 void prim_symbolp () {
423 if (IN_RAM(arg1))
424 arg1 = encode_bool (RAM_SYMBOL(arg1));
425 else if (IN_ROM(arg1))
426 arg1 = encode_bool (ROM_SYMBOL(arg1));
427 else
428 arg1 = OBJ_FALSE;
431 void prim_stringp () {
432 if (IN_RAM(arg1))
433 arg1 = encode_bool (RAM_STRING(arg1));
434 else if (IN_ROM(arg1))
435 arg1 = encode_bool (ROM_STRING(arg1));
436 else
437 arg1 = OBJ_FALSE;
440 void prim_string2list () {
441 if (IN_RAM(arg1)) {
442 if (!RAM_STRING(arg1))
443 TYPE_ERROR("string->list.0", "string");
445 arg1 = ram_get_car (arg1);
447 else if (IN_ROM(arg1)) {
448 if (!ROM_STRING(arg1))
449 TYPE_ERROR("string->list.1", "string");
451 arg1 = rom_get_car (arg1);
453 else
454 TYPE_ERROR("string->list.2", "string");
457 void prim_list2string () {
458 arg1 = alloc_ram_cell_init (COMPOSITE_FIELD0 | ((arg1 & 0x1f00) >> 8),
459 arg1 & 0xff,
460 STRING_FIELD2,
464 void prim_booleanp () {
465 arg1 = encode_bool (arg1 < 2);
468 /*---------------------------------------------------------------------------*/
470 // robot-specific primitives
472 #ifdef WORKSTATION
474 void show (obj o) {
475 #if 0
476 printf ("[%d]", o);
477 #endif
479 if (o == OBJ_FALSE)
480 printf ("#f");
481 else if (o == OBJ_TRUE)
482 printf ("#t");
483 else if (o == OBJ_NULL)
484 printf ("()");
485 else if (o <= (MIN_FIXNUM_ENCODING + (MAX_FIXNUM - MIN_FIXNUM)))
486 printf ("%d", DECODE_FIXNUM(o));
487 else {
488 uint8 in_ram;
490 if (IN_RAM(o))
491 in_ram = 1;
492 else
493 in_ram = 0;
495 if ((in_ram && RAM_BIGNUM(o)) || (!in_ram && ROM_BIGNUM(o))) // TODO fix for new bignums, especially for the sign, a -5 is displayed as 251
496 printf ("%d", decode_int (o));
497 else if ((in_ram && RAM_COMPOSITE(o)) || (!in_ram && ROM_COMPOSITE(o))) {
498 obj car;
499 obj cdr;
501 if ((in_ram && RAM_PAIR(o)) || (!in_ram && ROM_PAIR(o))) {
502 if (in_ram) {
503 car = ram_get_car (o);
504 cdr = ram_get_cdr (o);
506 else {
507 car = rom_get_car (o);
508 cdr = rom_get_cdr (o);
511 printf ("(");
513 loop:
515 show (car);
517 if (cdr == OBJ_NULL)
518 printf (")");
519 else if ((IN_RAM(cdr) && RAM_PAIR(cdr))
520 || (IN_ROM(cdr) && ROM_PAIR(cdr))) {
521 if (IN_RAM(cdr)) {
522 car = ram_get_car (cdr);
523 cdr = ram_get_cdr (cdr);
525 else {
526 car = rom_get_car (cdr);
527 cdr = rom_get_cdr (cdr);
530 printf (" ");
531 goto loop;
533 else {
534 printf (" . ");
535 show (cdr);
536 printf (")");
539 else if ((in_ram && RAM_SYMBOL(o)) || (!in_ram && ROM_SYMBOL(o)))
540 printf ("#<symbol>");
541 else if ((in_ram && RAM_STRING(o)) || (!in_ram && ROM_STRING(o)))
542 printf ("#<string>");
543 else if ((in_ram && RAM_VECTOR(o)) || (!in_ram && ROM_VECTOR(o)))
544 printf ("#<vector %d>", o);
545 else {
546 printf ("(");
547 cdr = ram_get_car (o);
548 car = ram_get_cdr (o);
549 // ugly hack, takes advantage of the fact that pairs and
550 // continuations have the same layout
551 goto loop;
554 else { // closure
555 obj env;
556 rom_addr pc;
558 env = ram_get_car (o);
559 pc = ram_get_entry (o);
561 printf ("{0x%04x ", pc);
562 show (env);
563 printf ("}");
567 fflush (stdout);
570 void print (obj o) {
571 show (o);
572 printf ("\n");
573 fflush (stdout);
576 #endif
578 void prim_print () {
579 #ifdef WORKSTATION
580 print (arg1);
581 #endif
583 arg1 = OBJ_FALSE;
586 uint32 read_clock () {
587 uint32 now = 0;
589 #ifdef PICOBOARD2
590 now = from_now( 0 );
591 #endif
593 #ifdef WORKSTATION
594 #ifdef _WIN32
595 static int32 start = 0;
596 struct timeb tb;
597 ftime (&tb);
598 now = tb.time * 1000 + tb.millitm;
599 if (start == 0)
600 start = now;
601 now -= start;
602 #else
603 static int32 start = 0;
604 struct timeval tv;
605 if (gettimeofday (&tv, NULL) == 0) {
606 now = tv.tv_sec * 1000 + tv.tv_usec / 1000;
607 if (start == 0)
608 start = now;
609 now -= start;
611 #endif
612 #endif
614 return now;
617 void prim_clock () {
618 arg1 = encode_int (read_clock ());
621 void prim_motor () {
622 decode_2_int_args ();
624 if (a1 < 1 || a1 > 2 || a2 < -100 || a2 > 100) // TODO since we now use undigned values, we can't go backwards anymore
625 ERROR("motor", "argument out of range");
627 #ifdef PICOBOARD2
628 MOTOR_set( a1, a2 );
629 #endif
631 #ifdef WORKSTATION
632 printf ("motor %d -> power=%d\n", a1, a2);
633 fflush (stdout);
634 #endif
636 arg1 = OBJ_FALSE;
637 arg2 = OBJ_FALSE;
641 void prim_led () {
642 decode_2_int_args ();
643 a3 = decode_int (arg3);
645 if (a1 < 1 || a1 > 3)
646 ERROR("led", "argument out of range");
648 #ifdef PICOBOARD2
649 LED_set( a1, a2, a3 );
650 #endif
652 #ifdef WORKSTATION
653 printf ("led %d -> duty=%d period=%d\n", a1, a2, a3 );
654 fflush (stdout);
655 #endif
657 arg1 = OBJ_FALSE;
658 arg2 = OBJ_FALSE;
659 arg3 = OBJ_FALSE;
663 void prim_led2_color () {
664 a1 = decode_int (arg1);
666 if (a1 > 1)
667 ERROR("led2-colors", "argument out of range");
669 #ifdef PICOBOARD2
670 LED2_color_set( a1 );
671 #endif
673 #ifdef WORKSTATION
674 printf ("led2-color -> %s\n", (a1==0)?"green":"red");
675 fflush (stdout);
676 #endif
678 arg1 = OBJ_FALSE;
682 void prim_getchar_wait () {
683 decode_2_int_args();
684 a1 = read_clock () + a1;
686 if (a2 < 1 || a2 > 3)
687 ERROR("getchar-wait", "argument out of range");
689 arg1 = OBJ_FALSE;
691 #ifdef PICOBOARD2
693 serial_port_set ports;
694 ports = serial_rx_wait_with_timeout( a2, a1 );
695 if (ports != 0)
696 arg1 = encode_int (serial_rx_read( ports ));
698 #endif
700 #ifdef WORKSTATION
701 #ifdef _WIN32
702 arg1 = OBJ_FALSE;
703 do {
704 if (_kbhit ()) {
705 arg1 = encode_int (_getch ());
706 break;
708 } while (read_clock () < a1);
709 #else
710 arg1 = encode_int (getchar ());
711 #endif
712 #endif
716 void prim_putchar () {
717 decode_2_int_args ();
719 if (a1 > 255 || a2 < 1 || a2 > 3)
720 ERROR("putchar", "argument out of range");
722 #ifdef PICOBOARD2
723 serial_tx_write( a2, a1 );
724 #endif
725 #ifdef SIXPIC
726 uart_write(a1);
727 #endif
729 #ifdef WORKSTATION
730 putchar (a1);
731 fflush (stdout);
732 #endif
734 arg1 = OBJ_FALSE;
735 arg2 = OBJ_FALSE;
739 void prim_beep () {
740 decode_2_int_args ();
742 if (a1 < 1 || a1 > 255)
743 ERROR("beep", "argument out of range");
745 #ifdef PICOBOARD2
746 beep( a1, from_now( a2 ) );
747 #endif
749 #ifdef WORKSTATION
750 printf ("beep -> freq-div=%d duration=%d\n", a1, a2 );
751 fflush (stdout);
752 #endif
754 arg1 = OBJ_FALSE;
755 arg2 = OBJ_FALSE;
759 void prim_adc () {
760 uint16 x;
762 a1 = decode_int (arg1);
764 if (a1 < 1 || a1 > 3)
765 ERROR("adc", "argument out of range");
767 #ifdef PICOBOARD2
768 x = adc( a1 );
769 #endif
771 #ifdef WORKSTATION
772 x = read_clock () & 255;
773 if (x > 127) x = 256 - x;
774 x += 200;
775 #endif
777 arg1 = encode_int (x);
780 void prim_sernum () {
781 uint16 x;
783 #ifdef PICOBOARD2
784 x = serial_num ();
785 #endif
787 #ifdef WORKSTATION
788 x = 0;
789 #endif
791 arg1 = encode_int (x);
794 /*---------------------------------------------------------------------------*/
796 // networking primitives
798 void prim_network_init () { // TODO maybe put in the initialization of the vm
799 #ifdef NETWORKING
800 handle = pcap_open_live(INTERFACE, MAX_PACKET_SIZE, PROMISC, TO_MSEC, errbuf);
801 if (handle == NULL)
802 ERROR("network-init", "interface not responding");
803 #endif
806 void prim_network_cleanup () { // TODO maybe put in halt ?
807 #ifdef NETWORKING
808 pcap_close(handle);
809 #endif
812 void prim_receive_packet_to_u8vector () {
813 // arg1 is the vector in which to put the received packet
814 if (!RAM_VECTOR(arg1))
815 TYPE_ERROR("receive-packet-to-u8vector", "vector");
817 #ifdef NETWORKING
818 // receive the packet in the buffer
819 struct pcap_pkthdr header;
820 const u_char *packet;
822 packet = pcap_next(handle, &header);
824 if (packet == NULL)
825 header.len = 0;
827 if (ram_get_car (arg1) < header.len)
828 ERROR("receive-packet-to-u8vector", "packet longer than vector");
830 if (header.len > 0) { // we have received a packet, write it in the vector
831 arg2 = rom_get_cdr (arg1);
832 arg1 = header.len; // we return the length of the received packet
833 a1 = 0;
835 while (a1 < arg1) {
836 ram_set_fieldn (arg2, a1 % 4, (char)packet[a1]);
837 a1++;
838 arg2 += (a1 % 4) ? 0 : 1;
841 arg2 = OBJ_FALSE;
843 else // no packet to be read
844 arg1 = OBJ_FALSE;
845 #endif
848 void prim_send_packet_from_u8vector () {
849 // arg1 is the vector which contains the packet to be sent
850 // arg2 is the length of the packet
851 // TODO only works with ram vectors for now
852 if (!RAM_VECTOR(arg1))
853 TYPE_ERROR("send-packet-from-vector!", "vector");
855 a2 = decode_int (arg2); // TODO fix for bignums
856 a1 = 0;
858 // TODO test if the length of the packet is longer than the length of the vector
859 if (ram_get_car (arg1) < a2)
860 ERROR("send-packet-from-u8vector", "packet cannot be longer than vector");
862 arg1 = ram_get_cdr (arg1);
864 #ifdef NETWORKING
865 // copy the packet to the output buffer
866 while (a1 < a2)
867 buf[a1] = ram_get_fieldn (arg1, a1 % 4);
868 // TODO maybe I could just give pcap the pointer to the memory
870 if (pcap_sendpacket(handle, buf, a2) < 0) // TODO an error has occurred, can we reuse the interface ?
871 arg1 = OBJ_FALSE;
872 else
873 arg1 = OBJ_TRUE;
874 #endif
876 arg2 = OBJ_FALSE;