Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-14 00:07:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Emit immutable bytevectors and strings when quoted

Browse source
This commit is contained in:
Justin Ethier 2019-05-16 13:03:28 -04:00
parent 8c7bd7f96b
commit cb0d72a6df
1 changed files with 16 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
scheme/cyclone/cgen.sld
View file

@ -515,7 +515,7 @@
))))) )))))
(loop 0 code)))))) (loop 0 code))))))
(define (c-compile-bytevector exp use-alloca) (define (c-compile-bytevector exp use-alloca immutable)
(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 "" "&")) (addr-op (if use-alloca "" "&"))
@ -546,7 +546,9 @@
(string-append addr-op 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
c-make-macro "(" cvar-name ");")))) c-make-macro "(" cvar-name ");"
(c-set-immutable-field cvar-name use-alloca immutable)
))))
(else (else
(let ((code (let ((code
(c-code/vars (c-code/vars
@ -556,10 +558,12 @@
c-make-macro "(" cvar-name ");" c-make-macro "(" cvar-name ");"
cvar-name deref-op "len = " (number->string len) ";" cvar-name deref-op "len = " (number->string len) ";"
cvar-name deref-op "data = alloca(sizeof(char) * " cvar-name deref-op "data = alloca(sizeof(char) * "
(number->string len) ");"))))) (number->string len) ");"
(c-set-immutable-field cvar-name use-alloca immutable)
)))))
(loop 0 code)))))) (loop 0 code))))))
(define (c-compile-string exp use-alloca) (define (c-compile-string exp use-alloca immutable)
(let ((cvar-name (mangle (gensym 'c)))) (let ((cvar-name (mangle (gensym 'c))))
(cond (cond
(use-alloca (use-alloca
@ -581,7 +585,9 @@
(->cstr exp) (->cstr exp)
";\n" ";\n"
"memcpy(((string_type *)" cvar-name ")->str, " tmp-name "," blen ");\n" "memcpy(((string_type *)" cvar-name ")->str, " tmp-name "," blen ");\n"
"((string_type *)" cvar-name ")->str[" blen "] = '\\0';"))))) "((string_type *)" cvar-name ")->str[" blen "] = '\\0';"
(c-set-immutable-field cvar-name use-alloca immutable)
)))))
(else (else
(c-code/vars (c-code/vars
(string-append "&" cvar-name) ; Code is just the variable name (string-append "&" cvar-name) ; Code is just the variable name
@ -595,7 +601,9 @@
(number->string (string-byte-length exp)) (number->string (string-byte-length exp))
", " ", "
(number->string (string-length exp)) (number->string (string-length exp))
");"))))))) ");"
(c-set-immutable-field cvar-name use-alloca immutable)
)))))))
;; c-compile-const : const-exp -> c-pair ;; c-compile-const : const-exp -> c-pair
;; ;;
@ -615,7 +623,7 @@
((vector? exp) ((vector? exp)
(c-compile-vector exp use-alloca immutable)) (c-compile-vector exp use-alloca immutable))
((bytevector? exp) ((bytevector? exp)
(c-compile-bytevector exp use-alloca)) (c-compile-bytevector exp use-alloca immutable))
((bignum? exp) ((bignum? exp)
(let ((cvar-name (mangle (gensym 'c))) (let ((cvar-name (mangle (gensym 'c)))
(num2str (cond (num2str (cond
@ -673,7 +681,7 @@
(c-code (string-append "obj_char2obj(" (c-code (string-append "obj_char2obj("
(number->string (char->integer exp)) ")"))) (number->string (char->integer exp)) ")")))
((string? exp) ((string? exp)
(c-compile-string exp use-alloca)) (c-compile-string exp use-alloca immutable))
;TODO: not good enough, need to store new symbols in a table so they can ;TODO: not good enough, need to store new symbols in a table so they can
;be inserted into the C program ;be inserted into the C program
((symbol? exp) ((symbol? exp)