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

Generate code using new return_copy macro

Browse source
This commit is contained in:
Justin Ethier 2017-04-18 20:36:05 +00:00
parent bd9119c274
commit 506a7e6136
1 changed files with 43 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
scheme/cyclone/cgen.sld
View file

@ -765,6 +765,16 @@
(let* ((cfun (c-compile-args (list (car args)) append-preamble " " cont trace cps?)) (let* ((cfun (c-compile-args (list (car args)) append-preamble " " cont trace cps?))
(this-cont (c:body cfun)) (this-cont (c:body cfun))
(cargs (c-compile-args (cdr args) append-preamble " " this-cont trace cps?))) (cargs (c-compile-args (cdr args) append-preamble " " this-cont trace cps?)))
(cond
((not cps?)
(c-code
(string-append
(c:allocs->str (c:allocs cfun) "\n")
(c:allocs->str (c:allocs cargs) "\n")
"return_copy(ptr,"
(c:body cargs)
");")))
(else
(set-c-call-arity! (c:num-args cargs)) (set-c-call-arity! (c:num-args cargs))
(c-code (c-code
(string-append (string-append
@ -775,7 +785,7 @@
this-cont this-cont
(if (> (c:num-args cargs) 0) "," "") (if (> (c:num-args cargs) 0) "," "")
(c:body cargs) (c:body cargs)
");")))) ");"))))))
((tagged-list? '%closure fun) ((tagged-list? '%closure fun)
(let* ((cfun (c-compile-closure (let* ((cfun (c-compile-closure
@ -784,6 +794,16 @@
(cargs (c-compile-args (cargs (c-compile-args
args append-preamble " " this-cont trace cps?)) args append-preamble " " this-cont trace cps?))
(num-cargs (c:num-args cargs))) (num-cargs (c:num-args cargs)))
(cond
((not cps?)
(c-code
(string-append
(c:allocs->str (c:allocs cfun) "\n")
(c:allocs->str (c:allocs cargs) "\n")
"return_copy(ptr,"
(c:body cargs)
");")))
(else ;; CPS, IE normal behavior
(set-c-call-arity! num-cargs) (set-c-call-arity! num-cargs)
(c-code (c-code
(string-append (string-append
@ -794,7 +814,7 @@
this-cont this-cont
(if (> num-cargs 0) "," "") (if (> num-cargs 0) "," "")
(c:body cargs) (c:body cargs)
");")))) ");"))))))
(else (else
(error `(Unsupported function application ,exp))))))) (error `(Unsupported function application ,exp)))))))
@ -1162,7 +1182,7 @@
append-preamble append-preamble
(mangle env-closure) (mangle env-closure)
trace trace
#t))) cps?)))
(cons (cons
(lambda (name) (lambda (name)
(string-append "static " return-type " " name (string-append "static " return-type " " name