91 lines
2.6 KiB
Scheme
91 lines
2.6 KiB
Scheme
|
;;
|
||
|
;; Copyright (c) 2005,2006 and onwards Colin Smith.
|
||
|
;;
|
||
|
;; compile-file.scm: reads a file and compiles it to bytecode; dumps the
|
||
|
;; bytecode which can then be linked to a compiler-free VM. This essentially
|
||
|
;; allows for the the translation of Scheme code to VM code with the minimum
|
||
|
;; runtime (that this implementation allows for, anyway).
|
||
|
;;
|
||
|
;; Arguments expected:
|
||
|
;;
|
||
|
;; 1) Name of source file
|
||
|
|
||
|
(display "#include \"vx-scheme.h\"\n\n")
|
||
|
|
||
|
(define form-counter 0)
|
||
|
|
||
|
(define (get-form-name)
|
||
|
(set! form-counter (+ form-counter 1))
|
||
|
(string-append "__f" (number->string form-counter)))
|
||
|
|
||
|
(define filename (vector-ref *argv* 0))
|
||
|
|
||
|
(with-input-from-file filename
|
||
|
(lambda ()
|
||
|
(let loop ((form (read)))
|
||
|
(if (eof-object? form) '/**/
|
||
|
(begin
|
||
|
(write-compiled-procedure (link2 (compile form)) (get-form-name))
|
||
|
(loop (read)))))))
|
||
|
|
||
|
;; rewind the form counter and generate an expression that will invoke each
|
||
|
;; of the forms in turn.
|
||
|
|
||
|
(define form-count form-counter)
|
||
|
|
||
|
(set! form-counter 0)
|
||
|
(define executor-form
|
||
|
(do
|
||
|
((form '(begin) (append form
|
||
|
(list (list (string->symbol (get-form-name))))))
|
||
|
(i 0 (+ i 1)))
|
||
|
((= i form-count) form)))
|
||
|
|
||
|
(write-compiled-procedure (link2 (compile executor-form)) "__RUN")
|
||
|
|
||
|
;; Now write a load-and-go routine.
|
||
|
|
||
|
(set! form-counter 0)
|
||
|
|
||
|
(let ((module-name "module"))
|
||
|
(display*
|
||
|
"class " module-name " : SchemeExtension { \n"
|
||
|
"public:\n"
|
||
|
" " module-name "() {\n"
|
||
|
" Register(this);\n"
|
||
|
" }\n"
|
||
|
" virtual ~" module-name "() {}\n"
|
||
|
" struct expression_table {\n"
|
||
|
" const char* n; // expression name\n"
|
||
|
" vm_cproc* cp; // compiled form of expression\n"
|
||
|
" Cell* c; // cell holding procedure object\n"
|
||
|
" };\n"
|
||
|
" static expression_table exptab[];\n"
|
||
|
" static const int num_exps;\n"
|
||
|
" virtual void Install(Context* ctx, Cell* envt) { \n"
|
||
|
" for (int ix = 0; ix < num_exps; ++ix) {\n"
|
||
|
" exptab[ix].c = ctx->load_compiled_procedure(exptab[ix].cp);\n"
|
||
|
" ctx->set_var(envt, intern(exptab[ix].n), exptab[ix].c);\n"
|
||
|
" }\n"
|
||
|
" MainProcedure(this);\n"
|
||
|
" }\n"
|
||
|
" virtual Cell* Run(Context* ctx) {\n"
|
||
|
" return ctx->execute(exptab[num_exps-1].c, nil);\n"
|
||
|
" };\n"
|
||
|
"};\n\n"
|
||
|
"static " module-name " _mod;\n\n"
|
||
|
"module::expression_table module::exptab[] = {\n")
|
||
|
|
||
|
(do
|
||
|
((i 0 (+ i 1))
|
||
|
(form-name (get-form-name) (get-form-name)))
|
||
|
((= i form-count) (display* " { \"__RUN\", &__RUN, 0 }, \n"))
|
||
|
(display* " { \"" form-name "\", &" form-name ", 0 },\n"))
|
||
|
|
||
|
(display*
|
||
|
"};\n"
|
||
|
"const int module::num_exps = "
|
||
|
"sizeof(module::exptab) / sizeof(*module::exptab);\n"))
|
||
|
|
||
|
|