mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-06 12:46:35 +02:00
Do not use (string-append) when emitting code
This commit is contained in:
parent
28f7085c37
commit
753c2a9b3b
2 changed files with 25 additions and 31 deletions
4
TODO
4
TODO
|
@ -4,10 +4,6 @@ Working TODO list:
|
||||||
|
|
||||||
- seems to be working! next step is to get parser, eval, and icyc (in that order) to work with libs
|
- seems to be working! next step is to get parser, eval, and icyc (in that order) to work with libs
|
||||||
|
|
||||||
- In cgen, start using (emit*) instead of (string-append).
|
|
||||||
There is no reason to allocate a bunch of strings if they are
|
|
||||||
just going to be deallocated after printing
|
|
||||||
|
|
||||||
- Reduction in size of generated code
|
- Reduction in size of generated code
|
||||||
is there anything we can do?
|
is there anything we can do?
|
||||||
are closures being packed/unpacked unnecessarily?
|
are closures being packed/unpacked unnecessarily?
|
||||||
|
|
52
cgen.scm
52
cgen.scm
|
@ -17,6 +17,9 @@
|
||||||
(define (emits str)
|
(define (emits str)
|
||||||
(display str))
|
(display str))
|
||||||
|
|
||||||
|
(define (emits* . strs)
|
||||||
|
(for-each emits strs))
|
||||||
|
|
||||||
(define (emit-newline)
|
(define (emit-newline)
|
||||||
(newline))
|
(newline))
|
||||||
|
|
||||||
|
@ -946,20 +949,19 @@
|
||||||
;; Emit symbols
|
;; Emit symbols
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(emit
|
(emit*
|
||||||
(string-append
|
"defsymbol(" (mangle sym) ", " (symbol->string sym) ");"))
|
||||||
"defsymbol(" (mangle sym) ", " (symbol->string sym) ");")))
|
|
||||||
*symbols*)
|
*symbols*)
|
||||||
|
|
||||||
;; Emit lambdas:
|
;; Emit lambdas:
|
||||||
; Print the prototypes:
|
; Print the prototypes:
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (l)
|
(lambda (l)
|
||||||
(emit (string-append
|
(emit*
|
||||||
"static void __lambda_"
|
"static void __lambda_"
|
||||||
(number->string (car l)) "(int argc, "
|
(number->string (car l)) "(int argc, "
|
||||||
(cdadr l)
|
(cdadr l)
|
||||||
") ;")))
|
") ;"))
|
||||||
lambdas)
|
lambdas)
|
||||||
|
|
||||||
(emit "")
|
(emit "")
|
||||||
|
@ -976,11 +978,11 @@
|
||||||
(emit "static void c_entry_pt_first_lambda();")
|
(emit "static void c_entry_pt_first_lambda();")
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (lib-name)
|
(lambda (lib-name)
|
||||||
(emit (string-append "extern void c_" (lib:name->string lib-name) "_entry_pt(int argc, closure cont, object value);")))
|
(emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(int argc, closure cont, object value);"))
|
||||||
required-libs)
|
required-libs)
|
||||||
(emit "static void c_entry_pt(argc, env,cont) int argc; closure env,cont; { "))
|
(emit "static void c_entry_pt(argc, env,cont) int argc; closure env,cont; { "))
|
||||||
(else
|
(else
|
||||||
(emit (string-append "void c_" (lib:name->string lib-name) "_entry_pt(argc, cont,value) int argc; closure cont; object value;{ "))
|
(emit* "void c_" (lib:name->string lib-name) "_entry_pt(argc, cont,value) int argc; closure cont; object value;{ ")
|
||||||
; DEBUG (emit (string-append "printf(\"init " (lib:name->string lib-name) "\\n\");"))
|
; DEBUG (emit (string-append "printf(\"init " (lib:name->string lib-name) "\\n\");"))
|
||||||
))
|
))
|
||||||
|
|
||||||
|
@ -996,7 +998,7 @@
|
||||||
;; Initialize symbol table
|
;; Initialize symbol table
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(emit (string-append " add_symbol(quote_" (mangle sym) ");")))
|
(emit* " add_symbol(quote_" (mangle sym) ");"))
|
||||||
*symbols*)
|
*symbols*)
|
||||||
|
|
||||||
;; Initialize globals
|
;; Initialize globals
|
||||||
|
@ -1021,14 +1023,12 @@
|
||||||
(lambda (g)
|
(lambda (g)
|
||||||
(let ((cvar-sym (mangle (gensym 'cvar)))
|
(let ((cvar-sym (mangle (gensym 'cvar)))
|
||||||
(pair-sym (mangle (gensym 'pair))))
|
(pair-sym (mangle (gensym 'pair))))
|
||||||
(emits
|
(emits*
|
||||||
(string-append
|
|
||||||
" make_cvar(" cvar-sym
|
" make_cvar(" cvar-sym
|
||||||
", (object *)&" (mangle-global (car g)) ");"))
|
", (object *)&" (mangle-global (car g)) ");")
|
||||||
(emits
|
(emits*
|
||||||
(string-append
|
|
||||||
"make_cons(" pair-sym ", find_or_add_symbol(\"" (symbol->string (car g))
|
"make_cons(" pair-sym ", find_or_add_symbol(\"" (symbol->string (car g))
|
||||||
"\"), &" cvar-sym ");\n"))
|
"\"), &" cvar-sym ");\n")
|
||||||
(set! pairs (cons pair-sym pairs))
|
(set! pairs (cons pair-sym pairs))
|
||||||
))
|
))
|
||||||
*globals*)
|
*globals*)
|
||||||
|
@ -1054,32 +1054,30 @@
|
||||||
(cdr ps)
|
(cdr ps)
|
||||||
(cdr cs)))))
|
(cdr cs)))))
|
||||||
(if head-pair
|
(if head-pair
|
||||||
(emit
|
(emit*
|
||||||
(string-append "Cyc_global_variables = &" head-pair ";"))))
|
"Cyc_global_variables = &" head-pair ";")))
|
||||||
|
|
||||||
(cond
|
(cond
|
||||||
(program?
|
(program?
|
||||||
;; Emit code to initialize each module (compiled Scheme library)
|
;; Emit code to initialize each module (compiled Scheme library)
|
||||||
(let ((this-clo "c_done")
|
(let ((this-clo "c_done")
|
||||||
(prev-clo "c_done"))
|
(prev-clo "c_done"))
|
||||||
(emit
|
(emit*
|
||||||
(string-append
|
|
||||||
"mclosure1(" this-clo
|
"mclosure1(" this-clo
|
||||||
", c_entry_pt_first_lambda, &" prev-clo ");"))
|
", c_entry_pt_first_lambda, &" prev-clo ");")
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (lib-name)
|
(lambda (lib-name)
|
||||||
(set! prev-clo this-clo)
|
(set! prev-clo this-clo)
|
||||||
(set! this-clo (mangle (gensym "c")))
|
(set! this-clo (mangle (gensym "c")))
|
||||||
(emit
|
(emit*
|
||||||
(string-append
|
|
||||||
"mclosure1(" this-clo
|
"mclosure1(" this-clo
|
||||||
", c_" (lib:name->string lib-name) "_entry_pt"
|
", c_" (lib:name->string lib-name) "_entry_pt"
|
||||||
", &" prev-clo ");"))
|
", &" prev-clo ");")
|
||||||
)
|
)
|
||||||
required-libs)
|
required-libs)
|
||||||
(emit
|
(emit*
|
||||||
;; Start cont chain, but do not assume funcall1 macro was defined
|
;; Start cont chain, but do not assume funcall1 macro was defined
|
||||||
(string-append "(" this-clo ".fn)(0, &" this-clo ", &" this-clo ");"))
|
"(" this-clo ".fn)(0, &" this-clo ", &" this-clo ");")
|
||||||
(emit "}")
|
(emit "}")
|
||||||
(emit "static void c_entry_pt_first_lambda(int argc, closure cont, object value) {")
|
(emit "static void c_entry_pt_first_lambda(int argc, closure cont, object value) {")
|
||||||
; DEBUG (emit (string-append "printf(\"init first lambda\\n\");"))
|
; DEBUG (emit (string-append "printf(\"init first lambda\\n\");"))
|
||||||
|
|
Loading…
Add table
Reference in a new issue