Moved vector copy to the library instead of the VM.
authorVincent St-Amour <stamourv@iro.umontreal.ca>
Thu, 8 Oct 2009 21:03:33 +0000 (8 17:03 -0400)
committerVincent St-Amour <stamourv@iro.umontreal.ca>
Thu, 8 Oct 2009 21:03:33 +0000 (8 17:03 -0400)
Moved >= and <= to the library instead of the VM.
Simplified prim-make-u8vector, so that it doesnt fill the vector (done in lib).
Deactivated 8-bit offset closures, which didn't work.
Added some ifdefs in the dispatch for networking primitives.
Removed dead code.

dispatch.c
encoding.scm
env.scm
gc.c
library.scm
picobit-vm.h
primitives.c

index 073a8ef..0697956 100644 (file)
@@ -313,14 +313,6 @@ void interpreter () {
                                   ((entry & 0x07) <<5) | ((arg3 >> 8) & 0x1f),
                                   arg3 & 0xff);
 
-#if 0
-      arg1 = // FOO remove
-        alloc_ram_cell_init (CLOSURE_FIELD0 | (arg2 >> 3),
-                             ((arg2 & 0x07) << 5) | (bytecode >> 3),
-                             ((bytecode & 0x07) << 5) | ((arg3 & 0x1f00) >> 8),
-                             arg3 & 0xff);
-#endif
-
       push_arg1();
 
       arg2 = OBJ_FALSE;
@@ -383,9 +375,7 @@ void interpreter () {
 
       break;
 
-      /* #if 0 */ // FOO
-
-    // FOO why does this not work?  don't worry about it now.
+    // TODO why does this not work?  don't worry about it now, as it is disabled in the compiler
 
     case 9: // closure-rel8
       FETCH_NEXT_BYTECODE();
@@ -406,8 +396,6 @@ void interpreter () {
       arg3 = OBJ_FALSE;
 
       break;
-      /* #endif */ // FOO
-
 #endif
 
 #if 0
@@ -513,11 +501,11 @@ void interpreter () {
     case 8:
       arg2 = pop();  arg1 = pop();  prim_lt ();       push_arg1();  break;
     case 9:
-      arg2 = pop();  arg1 = pop();  prim_leq ();      push_arg1();  break;
+      break; // FREE
     case 10:
       arg2 = pop();  arg1 = pop();  prim_gt ();       push_arg1();  break;
     case 11:
-      arg2 = pop();  arg1 = pop();  prim_geq ();      push_arg1();  break;
+      break; // FREE
     case 12:
       arg1 = pop();  prim_pairp ();    push_arg1();  break;
     case 13:
@@ -602,7 +590,9 @@ void interpreter () {
       arg1 = pop();  prim_list2string ();  push_arg1();  break;
     case 13:
       /* prim #%make-u8vector */
-      arg2 = pop(); arg1 = pop(); prim_make_u8vector (); push_arg1(); break;
+      // not exactly like the standard Scheme function.
+      // only takes one argument, and does not fill the vector
+      arg1 = pop(); prim_make_u8vector (); push_arg1(); break;
     case 14:
       /* prim #%u8vector-ref */
       arg2 = pop(); arg1 = pop(); prim_u8vector_ref (); push_arg1(); break;
@@ -658,9 +648,7 @@ void interpreter () {
       /* prim #%u8vector-length */
       arg1 = pop(); prim_u8vector_length (); push_arg1(); break;
     case 12:
-      /* prim #%u8vector-copy! */
-      arg5 = pop(); arg4 = pop(); arg3 = pop(); arg2 = pop(); arg1 = pop();
-      prim_u8vector_copy (); break;
+      // FREE
       break;
     case 13:
       /* shift */
@@ -698,16 +686,27 @@ void interpreter () {
       arg1 = pop(); prim_booleanp (); push_arg1(); break;
     case 1:
       /* prim #%network-init */
-      prim_network_init (); break;
+#ifdef NETWORKING
+      prim_network_init ();
+#endif
+      break;
     case 2:
       /* prim #%network-cleanup */
-      prim_network_cleanup (); break;
+#ifdef NETWORKING
+      prim_network_cleanup ();
+#endif
+      break;
     case 3:
       /* prim #%receive-packet-to-u8vector */
-      arg1 = pop(); prim_receive_packet_to_u8vector (); push_arg1(); break;
+#ifdef NETWORKING
+      arg1 = pop(); prim_receive_packet_to_u8vector (); push_arg1();
+#endif
+      break;
     case 4:
       /* prim #%send-packet-from-u8vector */
+#ifdef NETWORKING
       arg2 = pop(); arg1 = pop(); prim_send_packet_from_u8vector ();
+#endif
       push_arg1(); break;
     case 5:
       arg2 = pop(); arg1 = pop(); prim_ior (); push_arg1(); break;
@@ -716,7 +715,7 @@ void interpreter () {
       arg2 = pop(); arg1 = pop(); prim_xor (); push_arg1(); break;
       break;
 #if 0
-    case 7:
+    case 7: // FREE
       break;
     case 8:
       break;
index fe2228c..e0def39 100644 (file)
             (define (closure label)
               (label-instr label
                            #f ;; saves 50 (48)
-                           #xb9 ;; #f;; does not work!!! #xb9 ;; saves 27, 52 (51) FOO
+                           #f ;; #xb9 ;; #f;; does not work!!! #xb9 ;; saves 27, 52 (51) TODO
                            #f ;; saves 34, 59 (58)
                            #xb4
                            'closure))
             (define (prim.neg)             (prim 6))
             (define (prim.=)               (prim 7))
             (define (prim.<)               (prim 8))
-           (define (prim.<=)              (prim 9))
             (define (prim.>)               (prim 10))
-           (define (prim.>=)              (prim 11))
             (define (prim.pair?)           (prim 12))
             (define (prim.cons)            (prim 13))
             (define (prim.car)             (prim 14))
            (define (prim.u8vector?)       (prim 41))
            (define (prim.sernum)          (prim 42))
            (define (prim.u8vector-length) (prim 43))
-           (define (prim.u8vector-copy!)  (prim 44))
             (define (prim.shift)           (prim 45))
             (define (prim.pop)             (prim 46))
             (define (prim.return)          (prim 47))
                              ((#%neg)             (prim.neg))
                              ((#%=)               (prim.=))
                              ((#%<)               (prim.<))
-                            ((#%<=)              (prim.<=))
                              ((#%>)               (prim.>))
-                             ((#%>=)              (prim.>=))
                              ((#%pair?)           (prim.pair?))
                              ((#%cons)            (prim.cons))
                              ((#%car)             (prim.car))
                              ((#%u8vector?)       (prim.u8vector?))
                              ((#%sernum)          (prim.sernum))
                             ((#%u8vector-length) (prim.u8vector-length))
-                            ((#%u8vector-copy!)  (prim.u8vector-copy!))
                             ((#%boolean?)        (prim.boolean?))
                             ((#%network-init)    (prim.network-init))
                             ((#%network-cleanup) (prim.network-cleanup))
diff --git a/env.scm b/env.scm
index a15eabc..0eedeaf 100644 (file)
--- a/env.scm
+++ b/env.scm
@@ -37,9 +37,7 @@
      (make-var '#%neg #t '() '() '() #f (make-primitive 1 #f #f))
      (make-var '#%= #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%< #t '() '() '() #f (make-primitive 2 #f #f))
-     (make-var '#%<= #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%> #t '() '() '() #f (make-primitive 2 #f #f))
-     (make-var '#%>= #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%pair? #t '() '() '() #f (make-primitive 1 #f #f))
      (make-var '#%cons #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%car #t '() '() '() #f (make-primitive 1 #f #f))
@@ -57,7 +55,7 @@
      (make-var '#%string? #t '() '() '() #f (make-primitive 1 #f #f))
      (make-var '#%string->list #t '() '() '() #f (make-primitive 1 #f #f))
      (make-var '#%list->string #t '() '() '() #f (make-primitive 1 #f #f))     
-     (make-var '#%make-u8vector #t '() '() '() #f (make-primitive 2 #f #f))
+     (make-var '#%make-u8vector #t '() '() '() #f (make-primitive 1 #f #f))
      (make-var '#%u8vector-ref #t '() '() '() #f (make-primitive 2 #f #f))
      (make-var '#%u8vector-set! #t '() '() '() #f (make-primitive 3 #f #t))
      (make-var '#%print #t '() '() '() #f (make-primitive 1 #f #t))
@@ -72,7 +70,6 @@
      (make-var '#%u8vector? #t '() '() '() #f (make-primitive 1 #f #f))
      (make-var '#%sernum #t '() '() '() #f (make-primitive 0 #f #f))
      (make-var '#%u8vector-length #t '() '() '() #f (make-primitive 1 #f #f))
-     (make-var '#%u8vector-copy! #t '() '() '() #f (make-primitive 5 #f #t))
      (make-var '#%boolean? #t '() '() '() #f (make-primitive 1 #f #f))
      (make-var '#%network-init #t '() '() '() #f (make-primitive 0 #f #t))
      (make-var '#%network-cleanup #t '() '() '() #f (make-primitive 0 #f #t))
@@ -97,8 +94,6 @@
     (= . #%=)
     (< . #%<)
     (> . #%>)
-    (<= . #%<=)
-    (>= . #%>=)
     (pair? . #%pair?)
     (cons . #%cons)
     (car . #%car)
     (u8vector-length . #%u8vector-length)
     (u8vector-ref . #%u8vector-ref)
     (u8vector-set! . #%u8vector-set!)
-    (make-u8vector . #%make-u8vector)
-    (u8vector-copy! . #%u8vector-copy!)
     (boolean? . #%boolean?)
     (network-init . #%network-init)
     (network-cleanup . #%network-cleanup)
diff --git a/gc.c b/gc.c
index 657e794..d658f92 100644 (file)
--- a/gc.c
+++ b/gc.c
@@ -221,8 +221,6 @@ void gc () {
   mark (arg3);
   IF_GC_TRACE(printf("arg4\n"));
   mark (arg4);
-  IF_GC_TRACE(printf("arg5\n"));
-  mark (arg5);
   IF_GC_TRACE(printf("cont\n"));
   mark (cont);
   IF_GC_TRACE(printf("env\n"));
index 6c4056b..5142131 100644 (file)
@@ -75,7 +75,7 @@
 
 (define <=
   (lambda (x y)
-    (#%<= x y)))
+    (or (< x y) (= x y))))
 
 (define >
   (lambda (x y)
@@ -83,7 +83,7 @@
 
 (define >=
   (lambda (x y)
-    (#%>= x y)))
+    (or (> x y) (= x y))))
 
 (define pair?
   (lambda (x)
 (define list->u8vector
   (lambda (x)
     (let* ((n (length x))
-          (v (#%make-u8vector n 0)))
+          (v (#%make-u8vector n)))
       (list->u8vector-loop v 0 x)
       v)))
 (define list->u8vector-loop
 (define u8vector-set! (lambda (x y z) (#%u8vector-set! x y z)))
 (define make-u8vector
   (lambda (n x)
-    (#%make-u8vector n x)))
+    (make-u8vector-loop (#%make-u8vector n) (- n 1) x)))
+(define make-u8vector-loop
+  (lambda (v n x)
+    (if (>= n 0)
+        (begin (u8vector-set! v n x)
+               (make-u8vector-loop v (- n 1) x))
+        v)))
 (define u8vector-copy!
   (lambda (source source-start target target-start n)
-    (#%u8vector-copy! source source-start target target-start n)))
+    (if (> n 0)
+        (begin (u8vector-set! target target-start
+                              (u8vector-ref source source-start))
+               (u8vector-copy! source (+ source-start 1)
+                               target (+ target-start 1)
+                               (- n 1))))))
 
 (define network-init (lambda () (#%network-init)))
 (define network-cleanup (lambda () (#%network-cleanup)))
index 3bdd3ee..607476d 100644 (file)
@@ -591,7 +591,6 @@ obj arg1; /* root set */
 obj arg2;
 obj arg3;
 obj arg4;
-obj arg5;
 obj cont;
 obj env;
 
@@ -640,7 +639,6 @@ void prim_make_u8vector ();
 void prim_u8vector_ref ();
 void prim_u8vector_set ();
 void prim_u8vector_length ();
-void prim_u8vector_copy ();
 
 void prim_eqp ();
 void prim_not ();
index af10b44..cb61ce8 100644 (file)
@@ -55,7 +55,7 @@ char *prim_name[64] =
     "prim #%u8vector?",
     "prim #%sernum",
     "prim #%u8vector-length",
-    "prim #%u8vector-copy!",
+    "prim 44"
     "shift",
     "pop",
     "return",
@@ -211,27 +211,6 @@ void prim_gt () {
   arg2 = OBJ_FALSE;
 }
 
-void prim_leq () { // TODO these 2 are useful, but they add to the code size, is it worth it ?
-#ifdef INFINITE_PRECISION_BIGNUMS
-  arg1 = encode_bool(cmp (arg1, arg2) <= 1);
-#else
-  decode_2_int_args ();
-  arg1 = encode_bool(a1 <= a2);
-#endif
-  arg2 = OBJ_FALSE;
-  
-}
-
-void prim_geq () {
-#ifdef INFINITE_PRECISION_BIGNUMS
-  arg1 = encode_bool(cmp (arg1, arg2) >= 1);
-#else
-  decode_2_int_args ();
-  arg1 = encode_bool(a1 >= a2);
-#endif
-  arg2 = OBJ_FALSE;
-}
-
 void prim_ior () {
 #ifdef INFINITE_PRECISION_BIGNUMS
   arg1 = bitwise_ior(arg1, arg2);
@@ -353,25 +332,15 @@ void prim_u8vectorp () {
 }
 
 void prim_make_u8vector () {
-  decode_2_int_args (); // arg1 is length, arg2 is contents
+  a1 = decode_int (arg1); // arg1 is length
   // TODO adapt for the new bignums
-  if (a2 > 255)
-    ERROR("make-u8vector", "byte vectors can only contain bytes");
   
-  arg3 = alloc_vec_cell (a1);
+  arg2 = alloc_vec_cell (a1);
   arg1 = alloc_ram_cell_init (COMPOSITE_FIELD0 | (a1 >> 8),
                              a1 & 0xff,
-                             VECTOR_FIELD2 | (arg3 >> 8),
-                             arg3 & 0xff);
-
-  a1 = (a1 + 3) >> 2; // actual length, in words
-  while (a1--) {
-    ram_set_field0 (arg3, a2);
-    ram_set_field1 (arg3, a2);
-    ram_set_field2 (arg3, a2);
-    ram_set_field3 (arg3, a2);
-    arg3++;
-  }
+                             VECTOR_FIELD2 | (arg2 >> 8),
+                             arg2 & 0xff);
+  arg2 = OBJ_FALSE;
 }
 
 void prim_u8vector_ref () {
@@ -455,74 +424,6 @@ void prim_u8vector_length () {
     TYPE_ERROR("u8vector-length.2", "vector");
 }
 
-void prim_u8vector_copy () {
-  // arg1 is source, arg2 is source-start, arg3 is target, arg4 is target-start
-  // arg5 is number of bytes to copy
-  
-  a1 = decode_int (arg2);
-  a2 = decode_int (arg4);
-  a3 = decode_int (arg5);
-  
-  // case 1 : ram to ram
-  if (IN_RAM(arg1) && IN_RAM(arg3)) {
-    if (!RAM_VECTOR(arg1) || !RAM_VECTOR(arg3))
-      TYPE_ERROR("u8vector-copy!.0", "vector");
-    if ((ram_get_car (arg1) < (a1 + a3)) || (ram_get_car (arg3) < (a2 + a3)))
-      ERROR("u8vector-copy!.0", "vector index invalid");
-    
-    // position to the start
-    arg1 = ram_get_cdr (arg1);
-    arg1 += (a1 >> 2);
-    a1 %= 4;
-    arg3 = ram_get_cdr (arg3);
-    arg3 += (a2 >> 2);
-    a2 %= 4;
-    
-    // copy
-    while (a3--) {
-      ram_set_fieldn (arg3, a2, ram_get_fieldn (arg1, a1));
-      
-      a1++;
-      arg1 += (a1 >> 2);
-      a1 %= 4; // TODO merge with the previous similar block ?
-      a2++;
-      arg3 += (a2 >> 2);
-      a2 %= 4;
-    }
-  }
-  // case 2 : rom to ram
-  else if (IN_ROM(arg1) && IN_RAM(arg3)) {
-    if (!ROM_VECTOR(arg1) || !RAM_VECTOR(arg3))
-      TYPE_ERROR("u8vector-copy!.1", "vector");
-    if ((rom_get_car (arg1) < (a1 + a3)) || (ram_get_car (arg3) < (a2 + a3)))
-      ERROR("u8vector-copy!.1", "vector index invalid");
-    
-    arg1 = rom_get_cdr (arg1);
-    while (a1--)
-      arg1 = rom_get_cdr (arg1);
-    
-    arg3 = ram_get_cdr (arg3);
-    arg3 += (a2 >> 2);
-    a2 %= 4;
-    
-    while (a3--) {
-      ram_set_fieldn (arg3, a2, decode_int (rom_get_car (arg1)));
-      
-      arg1 = rom_get_cdr (arg1);
-      a2++;
-      arg3 += (a2 >> 2);
-      a2 %= 4; // TODO very similar to the other case
-    }
-  }
-  else
-    TYPE_ERROR("u8vector-copy!.2", "vector");
-  
-  arg1 = OBJ_FALSE;
-  arg2 = OBJ_FALSE;
-  arg3 = OBJ_FALSE;
-  arg4 = OBJ_FALSE;
-  arg5 = OBJ_FALSE;
-}
 
 /*---------------------------------------------------------------------------*/