From eadaf8c6c04a11e997a31f28b92c367a51b5eb59 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 31 Jul 2008 12:38:43 -0400 Subject: [PATCH] Work has begun on efficient vector copy. However, rom vectors as dotted lists end up complicating this, and will be removed. --- library.scm | 3 ++ picobit-vm.c | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++++++----- picobit.scm | 16 ++++----- 3 files changed, 117 insertions(+), 17 deletions(-) diff --git a/library.scm b/library.scm index ec33b73..8ba45bd 100644 --- a/library.scm +++ b/library.scm @@ -512,3 +512,6 @@ ;; (begin ;; (display "loop\n") ;; (make-u8vector-loop v (#%- n 1) x))))) ;; ;; TODO with named lets ? +(define u8vector-copy! + (lambda (source source-start target target-start n) + (#%u8vector-copy! source source-start target target-start n))) diff --git a/picobit-vm.c b/picobit-vm.c index a73a960..be07896 100644 --- a/picobit-vm.c +++ b/picobit-vm.c @@ -523,7 +523,8 @@ obj free_list_vec; /* list of unused cells in vector space */ obj arg1; /* root set */ obj arg2; obj arg3; -obj arg4; +obj arg4; // TODO only used once as a true arg, is swap space the rest of the time +obj arg5; // OOPS we need that for u8vector-copy! obj cont; obj env; @@ -1327,8 +1328,8 @@ void prim_u8vector_ref (void) { if (!RAM_VECTOR(arg1)) TYPE_ERROR("u8vector-ref", "vector"); - if (ram_get_car (arg1) <= a2) - ERROR("vector index too large"); + if ((ram_get_car (arg1) <= a2) || (a2 < 0)) + ERROR("vector index invalid"); arg1 = ram_get_cdr (arg1); } else if (IN_ROM(arg1)) @@ -1336,8 +1337,8 @@ void prim_u8vector_ref (void) if (!ROM_VECTOR(arg1)) TYPE_ERROR("u8vector-ref", "vector"); a3 = rom_get_car (arg1); // we'll need the length later - if (a3 <= a2) - ERROR("vector index too large"); + if ((a3 <= a2) || (a2 < 0)) + ERROR("vector index invalid"); arg1 = rom_get_cdr (arg1); } else @@ -1391,8 +1392,8 @@ void prim_u8vector_set (void) { if (!RAM_VECTOR(arg1)) TYPE_ERROR("u8vector-set!", "vector"); - if (ram_get_car (arg1) <= a2) - ERROR("vector index too large"); + if ((ram_get_car (arg1) <= a2) || (a2 < 0)) + ERROR("vector index invalid"); arg1 = ram_get_cdr (arg1); } else @@ -1436,6 +1437,100 @@ void prim_u8vector_length (void) TYPE_ERROR("u8vector-length", "vector"); } +void prim_u8vector_copy (void) +{ + // 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!", "vector"); + if ((ram_get_car (arg1) < (a1 + a3)) || (a1 < 0) || + (ram_get_car (arg3) < (a2 + a3)) || (a2 < 0)) + ERROR("vector index invalid"); + + // position to the start + arg1 += (a1 / 4); + a1 %= 4; + arg3 += (a2 / 4); + a2 %= 4; + + // copy + while (a3--) + { + switch (a1) + { + case 0: + arg2 = ram_get_field0 (arg1); + break; + case 1: + arg2 = ram_get_field1 (arg1); + break; + case 2: + arg2 = ram_get_field2 (arg1); + break; + case 3: + arg2 = ram_get_field3 (arg1); + break; + } + + switch (a2) + { + case 0: + ram_set_field0 (arg3, arg2); + break; + case 1: + ram_set_field1 (arg3, arg2); + break; + case 2: + ram_set_field2 (arg3, arg2); + break; + case 3: + ram_set_field3 (arg3, arg2); + break; + } + + a1++; + arg1 += (a1 / 4); + a1 %= 4; // TODO any way to merge with the previous similar block ? + a2++; + arg3 += (a2 / 4); + 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!", "vector"); + if ((rom_get_car (arg1) < (a1 + a3)) || (a1 < 0) || + (ram_get_car (arg3) < (a2 + a3)) || (a2 < 0)) + ERROR("vector index invalid"); + + while (a1--) + arg1 = rom_get_cdr (arg1); // TODO get rid of pointed lists for vectors ? pain in the ass + + // TODO position the rom vector + arg3 += (a2 / 4); + a2 %= 4; + // TODO do ACTUAL copy + } + else + TYPE_ERROR("u8vector-copy!", "vector"); + + arg1 = OBJ_FALSE; + arg2 = OBJ_FALSE; + arg3 = OBJ_FALSE; + arg4 = OBJ_FALSE; + arg5 = OBJ_FALSE; +} + /*---------------------------------------------------------------------------*/ /* Miscellaneous operations */ @@ -2073,7 +2168,7 @@ char *prim_name[64] = "prim #%u8vector?", // TODO was dac, but it's not plugged to anything "prim #%sernum", "prim #%u8vector-length", - "push-constant [long]", + "prim #%u8vector-copy!", "shift", "pop", "return", @@ -2745,7 +2840,9 @@ void interpreter (void) /* prim #%u8vector-length */ arg1 = POP(); prim_u8vector_length (); PUSH_ARG1(); break; case 12: - // FREE find something to do with this + /* prim #%u8vector-copy! */ + arg5 = POP(); arg4 = POP(); arg3 = POP(); arg2 = POP(); arg1 = POP(); + prim_u8vector_copy (); break; break; case 13: /* shift */ diff --git a/picobit.scm b/picobit.scm index d632bfd..004b374 100644 --- a/picobit.scm +++ b/picobit.scm @@ -232,9 +232,9 @@ (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)) ;; ADDED - (make-var '#%u8vector-ref #t '() '() '() #f (make-primitive 2 #f #f)) ;; ADDED - (make-var '#%u8vector-set! #t '() '() '() #f (make-primitive 3 #f #t)) ;; ADDED + (make-var '#%make-u8vector #t '() '() '() #f (make-primitive 2 #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)) (make-var '#%clock #t '() '() '() #f (make-primitive 0 #f #f)) @@ -247,10 +247,10 @@ (make-var '#%adc #t '() '() '() #f (make-primitive 1 #f #f)) (make-var '#%u8vector? #t '() '() '() #f (make-primitive 1 #f #f)) ;; ADDED, was dac (make-var '#%sernum #t '() '() '() #f (make-primitive 0 #f #f)) - (make-var '#%u8vector-length #t '() '() '() #f (make-primitive 1 #f #f)) ;; ADDED + (make-var '#%u8vector-length #t '() '() '() #f (make-primitive 1 #f #f)) + (make-var '#%u8vector-copy! #t '() '() '() #f (make-primitive 5 #f #t)) (make-var '#%readyq #t '() '() '() #f #f) - ))) ;; list of primitives that can be safely substituted for the equivalent @@ -291,6 +291,7 @@ (u8vector-ref . #%u8vector-ref) (u8vector-set! . #%u8vector-set!) (make-u8vector . #%make-u8vector) + (u8vector-copy! . #%u8vector-copy!) )) (define env-lookup @@ -2892,11 +2893,9 @@ (define (prim.string?) (prim 26)) (define (prim.string->list) (prim 27)) (define (prim.list->string) (prim 28)) - (define (prim.make-u8vector) (prim 29)) (define (prim.u8vector-ref) (prim 30)) (define (prim.u8vector-set!) (prim 31)) - (define (prim.print) (prim 32)) (define (prim.clock) (prim 33)) (define (prim.motor) (prim 34)) @@ -2909,7 +2908,7 @@ (define (prim.u8vector?) (prim 41)) ;; TODO was dac (define (prim.sernum) (prim 42)) ;; TODO necessary ? (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)) @@ -3080,6 +3079,7 @@ ((#%u8vector?) (prim.u8vector?)) ;; TODO was dac ((#%sernum) (prim.sernum)) ((#%u8vector-length) (prim.u8vector-length)) + ((#%u8vector-copy!) (prim.u8vector-copy!)) (else (compiler-error "unknown primitive" (cadr instr))))) -- 2.11.4.GIT