bytevector fixes

This commit is contained in:
Justin Ethier 2016-03-24 00:14:57 -04:00
parent fe0abb2d3e
commit e9ed4abcc5
5 changed files with 54 additions and 1 deletions

View file

@ -1,5 +1,6 @@
(import (scheme base) (scheme write)) (import (scheme base) (scheme write))
(write #u8(1 2 3 4 5))
(write (make-bytevector 2 12)) ; =⇒ #u8(12 12) (write (make-bytevector 2 12)) ; =⇒ #u8(12 12)
;(write (bytevector 1 3 5 1 3 5)) ; =⇒ #u8(1 3 5 1 3 5) ;(write (bytevector 1 3 5 1 3 5)) ; =⇒ #u8(1 3 5 1 3 5)
;(write (bytevector)) ;=⇒ #u8() ;(write (bytevector)) ;=⇒ #u8()

View file

@ -158,6 +158,7 @@ object Cyc_make_vector(void *data, object cont, int argc, object len, ...);
object Cyc_make_bytevector(void *data, object cont, int argc, object len, ...); object Cyc_make_bytevector(void *data, object cont, int argc, object len, ...);
object Cyc_bytevector(void *data, object cont, int argc, object bval, ...); object Cyc_bytevector(void *data, object cont, int argc, object bval, ...);
object Cyc_bytevector_length(void *data, object bv); object Cyc_bytevector_length(void *data, object bv);
object Cyc_bytevector_append(void *data, object cont, int _argc, object bv, ...);
object Cyc_bytevector_u8_ref(void *data, object bv, object k); object Cyc_bytevector_u8_ref(void *data, object bv, object k);
object Cyc_bytevector_u8_set(void *data, object bv, object k, object b); object Cyc_bytevector_u8_set(void *data, object bv, object k, object b);
object Cyc_list2vector(void *data, object cont, object l); object Cyc_list2vector(void *data, object cont, object l);

View file

@ -1464,7 +1464,7 @@ void dispatch_bytevector_91append(void *data, int _argc, object clo, object cont
Cyc_bytevector_append_va_list((_argc - 1)); Cyc_bytevector_append_va_list((_argc - 1));
} }
object Cyc_bytevector_append(void *data, object cont, int _argc, object bval, ...) { object Cyc_bytevector_append(void *data, object cont, int _argc, object bv, ...) {
Cyc_bytevector_append_va_list(_argc); Cyc_bytevector_append_va_list(_argc);
} }

View file

@ -391,6 +391,50 @@
(number->string len) ");"))))) (number->string len) ");")))))
(loop 0 code)))))) (loop 0 code))))))
(define (c-compile-bytevector exp)
(letrec ((cvar-name (mangle (gensym 'vec)))
(len (bytevector-length exp))
;; Generate code for each member of the vector
(loop
(lambda (i code)
(if (= i len)
code
(let ((byte-val (number->string (bytevector-u8-ref exp i))))
(loop
(+ i 1)
(c-code/vars
;; The bytevector's C variable
(c:body code)
;; Allocations
(append
(c:allocs code) ;; Vector alloc
(list ;; Assign this member to vector
(string-append
cvar-name ".data[" (number->string i) "] = (unsigned char)"
byte-val
";"))))
))))
)
)
(cond
((zero? len)
(c-code/vars
(string-append "&" cvar-name) ; Code is just the variable name
(list ; Allocate empty vector
(string-append
"make_empty_bytevector(" cvar-name ");"))))
(else
(let ((code
(c-code/vars
(string-append "&" cvar-name) ; Code body is just var name
(list ; Allocate the vector
(string-append
"make_empty_bytevector(" cvar-name ");"
cvar-name ".len = " (number->string len) ";"
cvar-name ".data = alloca(sizeof(char) * "
(number->string len) ");")))))
(loop 0 code))))))
;; c-compile-const : const-exp -> c-pair ;; c-compile-const : const-exp -> c-pair
;; ;;
;; Typically this function is used to compile constant values such as ;; Typically this function is used to compile constant values such as
@ -404,6 +448,8 @@
(c-compile-scalars exp)) (c-compile-scalars exp))
((vector? exp) ((vector? exp)
(c-compile-vector exp)) (c-compile-vector exp))
((bytevector? exp)
(c-compile-bytevector exp))
((integer? exp) ((integer? exp)
; (let ((cvar-name (mangle (gensym 'c)))) ; (let ((cvar-name (mangle (gensym 'c))))
; (c-code/vars ; (c-code/vars
@ -671,6 +717,8 @@
((eq? p 'symbol->string) "object") ((eq? p 'symbol->string) "object")
((eq? p 'substring) "object") ((eq? p 'substring) "object")
((eq? p 'make-bytevector) "object") ((eq? p 'make-bytevector) "object")
((eq? p 'bytevector) "object")
((eq? p 'bytevector-append) "object")
((eq? p 'make-vector) "object") ((eq? p 'make-vector) "object")
((eq? p 'list->string) "object") ((eq? p 'list->string) "object")
((eq? p 'list->vector) "object") ((eq? p 'list->vector) "object")
@ -690,6 +738,8 @@
string->number string->number
string-append list->string string-append list->string
make-bytevector make-bytevector
bytevector
bytevector-append
make-vector list->vector make-vector list->vector
symbol->string number->string symbol->string number->string
substring substring

View file

@ -277,6 +277,7 @@
(real? exp) (real? exp)
(string? exp) (string? exp)
(vector? exp) (vector? exp)
(bytevector? exp)
(char? exp) (char? exp)
(boolean? exp))) (boolean? exp)))