mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-06 04:36:36 +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
|
||||
|
||||
- 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
|
||||
is there anything we can do?
|
||||
are closures being packed/unpacked unnecessarily?
|
||||
|
|
52
cgen.scm
52
cgen.scm
|
@ -17,6 +17,9 @@
|
|||
(define (emits str)
|
||||
(display str))
|
||||
|
||||
(define (emits* . strs)
|
||||
(for-each emits strs))
|
||||
|
||||
(define (emit-newline)
|
||||
(newline))
|
||||
|
||||
|
@ -946,20 +949,19 @@
|
|||
;; Emit symbols
|
||||
(for-each
|
||||
(lambda (sym)
|
||||
(emit
|
||||
(string-append
|
||||
"defsymbol(" (mangle sym) ", " (symbol->string sym) ");")))
|
||||
(emit*
|
||||
"defsymbol(" (mangle sym) ", " (symbol->string sym) ");"))
|
||||
*symbols*)
|
||||
|
||||
;; Emit lambdas:
|
||||
; Print the prototypes:
|
||||
(for-each
|
||||
(lambda (l)
|
||||
(emit (string-append
|
||||
"static void __lambda_"
|
||||
(number->string (car l)) "(int argc, "
|
||||
(cdadr l)
|
||||
") ;")))
|
||||
(emit*
|
||||
"static void __lambda_"
|
||||
(number->string (car l)) "(int argc, "
|
||||
(cdadr l)
|
||||
") ;"))
|
||||
lambdas)
|
||||
|
||||
(emit "")
|
||||
|
@ -976,11 +978,11 @@
|
|||
(emit "static void c_entry_pt_first_lambda();")
|
||||
(for-each
|
||||
(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)
|
||||
(emit "static void c_entry_pt(argc, env,cont) int argc; closure env,cont; { "))
|
||||
(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\");"))
|
||||
))
|
||||
|
||||
|
@ -996,7 +998,7 @@
|
|||
;; Initialize symbol table
|
||||
(for-each
|
||||
(lambda (sym)
|
||||
(emit (string-append " add_symbol(quote_" (mangle sym) ");")))
|
||||
(emit* " add_symbol(quote_" (mangle sym) ");"))
|
||||
*symbols*)
|
||||
|
||||
;; Initialize globals
|
||||
|
@ -1021,14 +1023,12 @@
|
|||
(lambda (g)
|
||||
(let ((cvar-sym (mangle (gensym 'cvar)))
|
||||
(pair-sym (mangle (gensym 'pair))))
|
||||
(emits
|
||||
(string-append
|
||||
(emits*
|
||||
" make_cvar(" cvar-sym
|
||||
", (object *)&" (mangle-global (car g)) ");"))
|
||||
(emits
|
||||
(string-append
|
||||
", (object *)&" (mangle-global (car g)) ");")
|
||||
(emits*
|
||||
"make_cons(" pair-sym ", find_or_add_symbol(\"" (symbol->string (car g))
|
||||
"\"), &" cvar-sym ");\n"))
|
||||
"\"), &" cvar-sym ");\n")
|
||||
(set! pairs (cons pair-sym pairs))
|
||||
))
|
||||
*globals*)
|
||||
|
@ -1054,32 +1054,30 @@
|
|||
(cdr ps)
|
||||
(cdr cs)))))
|
||||
(if head-pair
|
||||
(emit
|
||||
(string-append "Cyc_global_variables = &" head-pair ";"))))
|
||||
(emit*
|
||||
"Cyc_global_variables = &" head-pair ";")))
|
||||
|
||||
(cond
|
||||
(program?
|
||||
;; Emit code to initialize each module (compiled Scheme library)
|
||||
(let ((this-clo "c_done")
|
||||
(prev-clo "c_done"))
|
||||
(emit
|
||||
(string-append
|
||||
(emit*
|
||||
"mclosure1(" this-clo
|
||||
", c_entry_pt_first_lambda, &" prev-clo ");"))
|
||||
", c_entry_pt_first_lambda, &" prev-clo ");")
|
||||
(for-each
|
||||
(lambda (lib-name)
|
||||
(set! prev-clo this-clo)
|
||||
(set! this-clo (mangle (gensym "c")))
|
||||
(emit
|
||||
(string-append
|
||||
(emit*
|
||||
"mclosure1(" this-clo
|
||||
", c_" (lib:name->string lib-name) "_entry_pt"
|
||||
", &" prev-clo ");"))
|
||||
", &" prev-clo ");")
|
||||
)
|
||||
required-libs)
|
||||
(emit
|
||||
(emit*
|
||||
;; 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 "static void c_entry_pt_first_lambda(int argc, closure cont, object value) {")
|
||||
; DEBUG (emit (string-append "printf(\"init first lambda\\n\");"))
|
||||
|
|
Loading…
Add table
Reference in a new issue