From 6c9158ed20871e7a530a0553cce3b1c69577e76e Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 8 Oct 2009 17:03:33 -0400 Subject: [PATCH] Moved vector copy to the library instead of the VM. 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 | 45 ++++++++++++------------ encoding.scm | 8 +---- env.scm | 9 +---- gc.c | 2 -- library.scm | 21 ++++++++--- picobit-vm.h | 2 -- primitives.c | 111 ++++------------------------------------------------------- 7 files changed, 46 insertions(+), 152 deletions(-) diff --git a/dispatch.c b/dispatch.c index 073a8ef..0697956 100644 --- a/dispatch.c +++ b/dispatch.c @@ -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; diff --git a/encoding.scm b/encoding.scm index fe2228c..e0def39 100644 --- a/encoding.scm +++ b/encoding.scm @@ -373,7 +373,7 @@ (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)) @@ -390,9 +390,7 @@ (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)) @@ -425,7 +423,6 @@ (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)) @@ -586,9 +583,7 @@ ((#%neg) (prim.neg)) ((#%=) (prim.=)) ((#%<) (prim.<)) - ((#%<=) (prim.<=)) ((#%>) (prim.>)) - ((#%>=) (prim.>=)) ((#%pair?) (prim.pair?)) ((#%cons) (prim.cons)) ((#%car) (prim.car)) @@ -621,7 +616,6 @@ ((#%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 --- 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) @@ -126,8 +121,6 @@ (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 --- 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")); diff --git a/library.scm b/library.scm index 6c4056b..5142131 100644 --- a/library.scm +++ b/library.scm @@ -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) @@ -505,7 +505,7 @@ (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 @@ -518,10 +518,21 @@ (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))) diff --git a/picobit-vm.h b/picobit-vm.h index 3bdd3ee..607476d 100644 --- a/picobit-vm.h +++ b/picobit-vm.h @@ -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 (); diff --git a/primitives.c b/primitives.c index af10b44..cb61ce8 100644 --- a/primitives.c +++ b/primitives.c @@ -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; -} /*---------------------------------------------------------------------------*/ -- 2.11.4.GIT