mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-14 08:17:35 +02:00
bytevector fixes
This commit is contained in:
parent
fe0abb2d3e
commit
e9ed4abcc5
5 changed files with 54 additions and 1 deletions
|
@ -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()
|
||||||
|
|
|
@ -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);
|
||||||
|
|
|
@ -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);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue