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

Alloc closures as needed

Browse source
This commit is contained in:
Justin Ethier 2018-10-24 18:18:42 -04:00
parent c914d80e7f
commit 7e6ad07d9f
1 changed files with 32 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
scheme/cyclone/cgen.sld
View file

@ -649,19 +649,15 @@
(and (> len 0) (and (> len 0)
(equal? end (substring str (- len 1) len))))) (equal? end (substring str (- len 1) len)))))
;;TODO: move this into prim module, integrate with existing function somehow ;; Use alloca() for stack allocations?
;;;;(define (prim->c-func* p use-alloca?) (define (alloca? ast-id)
;;;; (cond (let ((ast-fnc (adb:get/default ast-id #f)))
;;;; (else (and ast-fnc
;;;; (prim->c-func p)))) (adbf:calls-self? ast-fnc))))
;;TODO: add use-alloca? param to prim:allocates-object? and modify per above
;; c-compile-prim : prim-exp -> string -> string ;; c-compile-prim : prim-exp -> string -> string
(define (c-compile-prim p cont ast-id) (define (c-compile-prim p cont ast-id)
(let* ((ast-fnc (adb:get/default ast-id #f)) (let* ((use-alloca? (alloca? ast-id))
;; Use alloca for stack allocations?
(use-alloca? (and ast-fnc
(adbf:calls-self? ast-fnc)))
(c-func (c-func
(if (prim:udf? p) (if (prim:udf? p)
(string-append (string-append
@ -1435,6 +1431,7 @@
;; ;;
(define (c-compile-closure exp append-preamble cont ast-id trace cps?) (define (c-compile-closure exp append-preamble cont ast-id trace cps?)
(let* ((lam (closure->lam exp)) (let* ((lam (closure->lam exp))
(use-alloca? (alloca? ast-id))
(free-vars (free-vars
(map (map
(lambda (free-var) (lambda (free-var)
@ -1470,26 +1467,31 @@
(car free-vars) (car free-vars)
(list)))) (list))))
(create-nclosure (lambda () (create-nclosure (lambda ()
(string-append (let ((decl (if use-alloca?
"closureN_type " cv-name ";\n" (string-append "closureN_type * " cv-name " = alloca(sizeof(closureN_type));\n")
;; Not ideal, but one more special case to type check call/cc (string-append "closureN_type " cv-name ";\n")))
(if call/cc? "Cyc_check_proc(data, f);\n" "") (sep (if use-alloca? "->" "."))
cv-name ".hdr.mark = gc_color_red;\n " )
cv-name ".hdr.grayed = 0;\n" (string-append
cv-name ".tag = closureN_tag;\n " decl
cv-name ".fn = (function_type)__lambda_" (number->string lid) ";\n" ;; Not ideal, but one more special case to type check call/cc
cv-name ".num_args = " num-args-str ";\n" (if call/cc? "Cyc_check_proc(data, f);\n" "")
cv-name ".num_elements = " (number->string (length free-vars)) ";\n" cv-name sep "hdr.mark = gc_color_red;\n "
cv-name ".elements = (object *)alloca(sizeof(object) * " cv-name sep "hdr.grayed = 0;\n"
(number->string (length free-vars)) ");\n" cv-name sep "tag = closureN_tag;\n "
(let loop ((i 0) cv-name sep "fn = (function_type)__lambda_" (number->string lid) ";\n"
(vars free-vars)) cv-name sep "num_args = " num-args-str ";\n"
(if (null? vars) cv-name sep "num_elements = " (number->string (length free-vars)) ";\n"
"" cv-name sep "elements = (object *)alloca(sizeof(object) * "
(string-append (number->string (length free-vars)) ");\n"
cv-name ".elements[" (number->string i) "] = " (let loop ((i 0)
(car vars) ";\n" (vars free-vars))
(loop (+ i 1) (cdr vars)))))))) (if (null? vars)
""
(string-append
cv-name sep "elements[" (number->string i) "] = "
(car vars) ";\n"
(loop (+ i 1) (cdr vars)))))))))
(create-mclosure (lambda () (create-mclosure (lambda ()
(let ((prefix (let ((prefix
(if macro? (if macro?