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

66
scheme/cyclone/cgen.sld
View file

@ -765,17 +765,27 @@
(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?)))
(set-c-call-arity! (c:num-args cargs)) (cond
(c-code ((not cps?)
(string-append (c-code
(c:allocs->str (c:allocs cfun) "\n") (string-append
(c:allocs->str (c:allocs cargs) "\n") (c:allocs->str (c:allocs cfun) "\n")
"return_closcall" (number->string (c:num-args cargs)) (c:allocs->str (c:allocs cargs) "\n")
"(data," "return_copy(ptr,"
this-cont (c:body cargs)
(if (> (c:num-args cargs) 0) "," "") ");")))
(c:body cargs) (else
");")))) (set-c-call-arity! (c:num-args cargs))
(c-code
(string-append
(c:allocs->str (c:allocs cfun) "\n")
(c:allocs->str (c:allocs cargs) "\n")
"return_closcall" (number->string (c:num-args cargs))
"(data,"
this-cont
(if (> (c:num-args cargs) 0) "," "")
(c:body cargs)
");"))))))
((tagged-list? '%closure fun) ((tagged-list? '%closure fun)
(let* ((cfun (c-compile-closure (let* ((cfun (c-compile-closure
@ -784,17 +794,27 @@
(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)))
(set-c-call-arity! num-cargs) (cond
(c-code ((not cps?)
(string-append (c-code
(c:allocs->str (c:allocs cfun) "\n") (string-append
(c:allocs->str (c:allocs cargs) "\n") (c:allocs->str (c:allocs cfun) "\n")
"return_closcall" (number->string num-cargs) (c:allocs->str (c:allocs cargs) "\n")
"(data," "return_copy(ptr,"
this-cont (c:body cargs)
(if (> num-cargs 0) "," "") ");")))
(c:body cargs) (else ;; CPS, IE normal behavior
");")))) (set-c-call-arity! num-cargs)
(c-code
(string-append
(c:allocs->str (c:allocs cfun) "\n")
(c:allocs->str (c:allocs cargs) "\n")
"return_closcall" (number->string num-cargs)
"(data,"
this-cont
(if (> num-cargs 0) "," "")
(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