more bytevector ops/procedures

i.c

@@ -1192,6 +1192,23 @@ define_instruction(bput) {
   gonexti();
 }
 
+define_instruction(bsub) {
+  obj x = spop(), y = spop(); int is, ie, *d; 
+  ckb(ac); ckk(x); ckk(y); 
+  is = fixnum_from_obj(x), ie = fixnum_from_obj(y);
+  if (is > ie) failtype(x, "valid start bytevector index");
+  if (ie > bytevectorlen(ac)) failtype(y, "valid end bytevector index");
+  d = subbytevector(bytevectordata(ac), is, ie);
+  ac = bytevector_obj(d);
+  gonexti();
+}
+
+define_instruction(beq) {
+  obj x = ac, y = spop(); ckb(x); ckb(y);
+  ac = bool_obj(bytevectoreq(bytevectordata(x), bytevectordata(y)));
+  gonexti(); 
+}
+
 
 define_instruction(vecp) {
   ac = bool_obj(isvector(ac));

i.h

@@ -426,6 +426,8 @@ declare_instruction(bmk,        "B2\0'0",       0,  "make-bytevector",     'b',
 declare_instruction(blen,       "B3",           0,  "bytevector-length",   '1', AUTOGL)
 declare_instruction(bget,       "B4",           0,  "bytevector-u8-ref",   '2', AUTOGL)
 declare_instruction(bput,       "B5",           0,  "bytevector-u8-set!",  '3', AUTOGL)
+declare_instruction(bsub,       "B7",           0,  "subbytevector",       '3', AUTOGL)
+declare_instruction(beq,        "B=",           0,  "bytevector=?",        'c', AUTOGL)
 declare_instruction(vtol,       "X0",           0,  "%vector->list1",      '1', AUTOGL)
 declare_instruction(ltov,       "X1",           0,  "list->vector",        '1', AUTOGL)
 declare_instruction(stol,       "X2",           0,  "%string->list1",      '1', AUTOGL)

s.c

@@ -372,6 +372,50 @@ char *s_code[] = {
   ";l2:py1:_;y1:r;;py14:%25vector-append;y1:r;;;l2:y1:_;y14:%25vector-app"
   "end;;",
 
+  "P", "subbytevector->list",
+  "%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2B4c,'1,.2I-,:1^[22}"
+  ".!0.0^_1[32",
+
+  "C", 0,
+  "&0{%3.2,.2,.2,@(y19:subbytevector->list)[33}%x,&0{%2.0B3,.2,.2,@(y19:s"
+  "ubbytevector->list)[23}%x,&0{%1.0B3,'0,.2,@(y19:subbytevector->list)[1"
+  "3}%x,&3{|10|21|32%%}@!(y16:bytevector->list)",
+
+  "P", "subbytevector-copy!",
+  "%5.1,.1B3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.0,.5,.8,.6,&4{%2:0,.2I<!?{]2"
+  "}.1,:1B4,.1,:2B5'1,.2I+,'1,.2I+,:3^[22}.!0.0^_1[62}'1,.1I-,'1,.6,.8I-I"
+  "-,.4I+,,#0.0,.5,.8,.(i10),&4{%2:0,.2I<?{]2}.1,:1B4,.1,:2B5'1,.2I-,'1,."
+  "2I-,:3^[22}.!0.0^_1[62",
+
+  "C", 0,
+  "&0{%5.4,.4,.4,.4,.4,@(y19:subbytevector-copy!)[55}%x,&0{%4.2B3,.4,.4,."
+  "4,.4,@(y19:subbytevector-copy!)[45}%x,&0{%3.2B3,'0,.4,.4,.4,@(y19:subb"
+  "ytevector-copy!)[35}%x,&3{|30|41|52%%}@!(y16:bytevector-copy!)",
+
+  "C", 0,
+  "&0{%3.2,.2,.2B7]3}%x,&0{%2.0B3,.2,.2B7]2}%x,&0{%1.0B3,'0,.2B7]1}%x,&3{"
+  "|10|21|32%%}@!(y15:bytevector-copy)",
+
+  "P", "subbytevector-fill!",
+  "%4.2,,#0.0,.3,.5,.8,&4{%1:0,.1I<!?{]1}:1,.1,:2B5'1,.1I+,:3^[11}.!0.0^_"
+  "1[41",
+
+  "C", 0,
+  "&0{%4.3,.3,.3,.3,@(y19:subbytevector-fill!)[44}%x,&0{%3.0B3,.3,.3,.3,@"
+  "(y19:subbytevector-fill!)[34}%x,&0{%2.0B3,'0,.3,.3,@(y19:subbytevector"
+  "-fill!)[24}%x,&3{|20|31|42%%}@!(y16:bytevector-fill!)",
+
+  "P", "%bytevectors-sum-length",
+  "%1'0,.1,,#0.0,&1{%2.0u?{.1]2}.0aB3,.2I+,.1d,:0^[22}.!0.0^_1[12",
+
+  "P", "%bytevectors-copy-into!",
+  "%2'0,.2,,#0.0,.4,&2{%2.0u?{:0]2}.0d,.1a,.0B3,${.2,'0,.5,.9,:0,@(y19:su"
+  "bbytevector-copy!)[05}.0,.5I+,.3,:1^[52}.!0.0^_1[22",
+
+  "P", "bytevector-append",
+  "%!0.0,'0,${.4,@(y23:%25bytevectors-sum-length)[01}B2,@(y23:%25bytevect"
+  "ors-copy-into!)[12",
+
   "P", "%apply",
   "%!2${.2,.5,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[02},."
   "2,@(y13:apply-to-list)[32",
@@ -453,6 +497,9 @@ char *s_code[] = {
   "P", "error",
   "%!1.0,.2Z7]2",
 
+  "P", "read-error",
+  "%!1.0,.2Z7]2",
+
   "P", "port?",
   "%1.0P00,.0?{.0]2}.1P01]2",
 

src/s.scm

@@ -832,10 +832,66 @@
 ; (bytevector-length b)
 ; (bytevector-u8-ref b i)
 ; (bytevector-u8-set! b i u8)
+; (list->bytevector l)
+; (subbytevector b from to)
+; (bytevector=? b1 b2 b ...)
+
+(define (subbytevector->list bvec start end)
+  (let loop ([i (fx- end 1)] [l '()])
+    (if (fx<? i start) l (loop (fx- i 1) (cons (bytevector-u8-ref bvec i) l)))))
+
+(define bytevector->list
+  (case-lambda
+     [(bvec) (subbytevector->list bvec 0 (bytevector-length bvec))]
+     [(bvec start) (subbytevector->list bvec start (bytevector-length bvec))]
+     [(bvec start end) (subbytevector->list bvec start end)]))
+
+(define (subbytevector-copy! to at from start end)
+  (let ([limit (fxmin end (fx+ start (fx- (bytevector-length to) at)))])
+    (if (fx<=? at start)
+        (do ([i at (fx+ i 1)] [j start (fx+ j 1)]) 
+          [(fx>=? j limit)]
+          (bytevector-u8-set! to i (bytevector-u8-ref from j)))
+        (do ([i (fx+ at (fx- end start 1)) (fx- i 1)] [j (fx- limit 1) (fx- j 1)])
+          [(fx<? j start)]
+          (bytevector-u8-set! to i (bytevector-u8-ref from j))))))
+
+(define bytevector-copy!
+  (case-lambda
+     [(to at from) (subbytevector-copy! to at from 0 (bytevector-length from))]
+     [(to at from start) (subbytevector-copy! to at from start (bytevector-length from))]
+     [(to at from start end) (subbytevector-copy! to at from start end)]))
+
+(define bytevector-copy
+  (case-lambda
+     [(bvec) (subbytevector bvec 0 (bytevector-length bvec))]
+     [(bvec start) (subbytevector bvec start (bytevector-length bvec))]
+     [(bvec start end) (subbytevector bvec start end)]))
+
+(define (subbytevector-fill! bvec b start end)
+  (do ([i start (fx+ i 1)]) [(fx>=? i end)] (bytevector-u8-set! bvec i b)))
+
+(define bytevector-fill!
+  (case-lambda
+     [(bvec b) (subbytevector-fill! bvec b 0 (bytevector-length bvec))]
+     [(bvec b start) (subbytevector-fill! bvec b start (bytevector-length bvec))]
+     [(bvec b start end) (subbytevector-fill! bvec b start end)]))
+
+(define (%bytevectors-sum-length bvecs)
+  (let loop ([bvecs bvecs] [l 0])
+    (if (null? bvecs) l (loop (cdr bvecs) (fx+ l (bytevector-length (car bvecs)))))))
+
+(define (%bytevectors-copy-into! to bvecs)
+  (let loop ([bvecs bvecs] [i 0])
+    (if (null? bvecs) to
+        (let ([bvec (car bvecs)] [bvecs (cdr bvecs)])
+          (let ([len (bytevector-length bvec)])
+            (subbytevector-copy! to i bvec 0 len)
+            (loop bvecs (fx+ i len)))))))  
+
+(define (bytevector-append . bvecs)
+  (%bytevectors-copy-into! (make-bytevector (%bytevectors-sum-length bvecs)) bvecs))
 
-;bytevector-copy
-;bytevector-copy!
-;bytevector-append
 ;utf8->string
 ;string->utf8