This commit is contained in:
Justin Ethier 2018-11-21 18:53:50 -05:00
parent b0d599c0de
commit 03b2dd7181

View file

@ -493,6 +493,9 @@
(define (c-compile-bytevector exp use-alloca) (define (c-compile-bytevector exp use-alloca)
(letrec ((cvar-name (mangle (gensym 'vec))) (letrec ((cvar-name (mangle (gensym 'vec)))
(len (bytevector-length exp)) (len (bytevector-length exp))
(addr-op (if use-alloca "" "&"))
(deref-op (if use-alloca "->" "."))
(c-make-macro (if use-alloca "alloca_empty_bytevector" "make_empty_bytevector"))
;; Generate code for each member of the vector ;; Generate code for each member of the vector
(loop (loop
(lambda (i code) (lambda (i code)
@ -509,7 +512,7 @@
(c:allocs code) ;; Vector alloc (c:allocs code) ;; Vector alloc
(list ;; Assign this member to vector (list ;; Assign this member to vector
(string-append (string-append
cvar-name ".data[" (number->string i) "] = (unsigned char)" cvar-name deref-op "data[" (number->string i) "] = (unsigned char)"
byte-val byte-val
";")))) ";"))))
)))) ))))
@ -518,19 +521,19 @@
(cond (cond
((zero? len) ((zero? len)
(c-code/vars (c-code/vars
(string-append "&" cvar-name) ; Code is just the variable name (string-append addr-op cvar-name) ; Code is just the variable name
(list ; Allocate empty vector (list ; Allocate empty vector
(string-append (string-append
"make_empty_bytevector(" cvar-name ");")))) c-make-macro "(" cvar-name ");"))))
(else (else
(let ((code (let ((code
(c-code/vars (c-code/vars
(string-append "&" cvar-name) ; Code body is just var name (string-append addr-op cvar-name) ; Code body is just var name
(list ; Allocate the vector (list ; Allocate the vector
(string-append (string-append
"make_empty_bytevector(" cvar-name ");" c-make-macro "(" cvar-name ");"
cvar-name ".len = " (number->string len) ";" cvar-name deref-op "len = " (number->string len) ";"
cvar-name ".data = alloca(sizeof(char) * " cvar-name deref-op "data = alloca(sizeof(char) * "
(number->string len) ");"))))) (number->string len) ");")))))
(loop 0 code)))))) (loop 0 code))))))
@ -590,7 +593,6 @@
;; TODO: use-alloc support ;; TODO: use-alloc support
(c-compile-vector exp use-alloca)) (c-compile-vector exp use-alloca))
((bytevector? exp) ((bytevector? exp)
;; TODO: use-alloc support
(c-compile-bytevector exp use-alloca)) (c-compile-bytevector exp use-alloca))
((bignum? exp) ((bignum? exp)
(let ((cvar-name (mangle (gensym 'c))) (let ((cvar-name (mangle (gensym 'c)))