Permalink
Browse files

Prepare for new back-ends (gsc option -target). Replace compile-file-…

…to-c by compile-file-to-target. Preliminary version of a universal back-end to generate JavaScript, Python, PHP, etc.
  • Loading branch information...
1 parent fbb1e78 commit 095a64308c3edcaecf7ca077b3f5405c33d10f83 @feeley feeley committed May 17, 2012
Showing with 5,020 additions and 113 deletions.
  1. +12 −12 doc/gambit-c.txi
  2. +16 −8 gsc/_back.scm
  3. +35 −35 gsc/_front.scm
  4. +40 −32 gsc/_gsclib.scm
  5. +8 −12 gsc/_t-c-1.scm
  6. +4,367 −0 gsc/_t-univ.c
  7. +528 −0 gsc/_t-univ.scm
  8. +7 −7 gsc/makefile.in
  9. +4 −4 gsi/main.scm
  10. +2 −2 include/stamp.h
  11. +1 −1 lib/gambit#.scm
View
@@ -754,7 +754,7 @@ When no command line argument is present other than options the
compiler behaves like the interpreter in interactive mode. The only
difference with the interpreter is that the compilation related
procedures listed in this chapter are also available
-(i.e. @code{compile-file}, @code{compile-file-to-c}, etc).
+(i.e. @code{compile-file}, @code{compile-file-to-target}, etc).
@node GSC customization, GSC batch mode, GSC interactive mode, GSC
@section Customization
@@ -1509,7 +1509,7 @@ which flag you need.
The Gambit Scheme compiler features the following procedures that
are not available in the Gambit Scheme interpreter.
-@deffn procedure compile-file-to-c @var{file} @r{[}@code{options:} @var{options}@r{]} @r{[}@code{output:} @var{output}@r{]} @r{[}@code{module-name:} @var{module-name}@r{]}
+@deffn procedure compile-file-to-target @var{file} @r{[}@code{options:} @var{options}@r{]} @r{[}@code{output:} @var{output}@r{]} @r{[}@code{module-name:} @var{module-name}@r{]}
@pindex gsc
The @var{file} parameter must be a string naming an existing file
@@ -1531,7 +1531,7 @@ which must be a list of symbols. Any combination of the following
options can be used: @samp{verbose}, @samp{report}, @samp{expansion},
@samp{gvm}, and @samp{debug}.
-When the compilation is successful, @code{compile-file-to-c} returns
+When the compilation is successful, @code{compile-file-to-target} returns
the name of the C file generated. When there is a compilation error,
@code{#f} is returned.
@@ -1541,7 +1541,7 @@ $ @b{cat h.scm}
$ @b{gsc}
Gambit @value{VERSION}
-> @b{(compile-file-to-c "h")}
+> @b{(compile-file-to-target "h")}
"/Users/feeley/gambit/doc/h.c"
@end smallexample
@end deffn
@@ -1552,10 +1552,10 @@ Gambit @value{VERSION}
@cindex object file
The @var{file}, @var{options}, and @var{output} parameters have the
-same meaning as for the @code{compile-file-to-c} procedure, except that
+same meaning as for the @code{compile-file-to-target} procedure, except that
@var{file} may be a Scheme source file or a
C file possibly generated by the Gambit Scheme compiler (for example
-with the @code{compile-file-to-c} procedure). The
+with the @code{compile-file-to-target} procedure). The
@var{cc-options} parameter is a string containing the options to pass
to the C compiler and the @var{ld-options-prelude} and
@var{ld-options} parameters are strings containing the options to pass
@@ -1616,14 +1616,14 @@ Gambit @value{VERSION}
> @b{(load "h")}
hello
"/Users/feeley/gambit/doc/h.o1"
-> @b{(compile-file-to-c "h" output: "h.o99.c")}
+> @b{(compile-file-to-target "h" output: "h.o99.c")}
"/Users/feeley/gambit/doc/h.o99.c"
> @b{(compile-file "h.o99.c")}
"/Users/feeley/gambit/doc/h.o99"
> @b{(load "h.o99")}
hello
"/Users/feeley/gambit/doc/h.o99"
-> @b{(compile-file-to-c "h")}
+> @b{(compile-file-to-target "h")}
"/Users/feeley/gambit/doc/h.c"
> @b{(compile-file "h.c" options: '(obj))}
"/Users/feeley/gambit/doc/h.o"
@@ -1668,9 +1668,9 @@ display("world"); newline();
$ @b{gsc}
Gambit @value{VERSION}
-> @b{(compile-file-to-c "h")}
+> @b{(compile-file-to-target "h")}
"/Users/feeley/gambit/doc/h.c"
-> @b{(compile-file-to-c "w")}
+> @b{(compile-file-to-target "w")}
"/Users/feeley/gambit/doc/w.c"
> @b{(link-incremental '("h" "w") output: "hello.c")}
"/Users/feeley/gambit/doc/hello_.c"
@@ -1723,9 +1723,9 @@ $ @b{cat m7.scm}
$ @b{gsc}
Gambit @value{VERSION}
-> @b{(compile-file-to-c "m6")}
+> @b{(compile-file-to-target "m6")}
"/Users/feeley/gambit/doc/m6.c"
-> @b{(compile-file-to-c "m7")}
+> @b{(compile-file-to-target "m7")}
"/Users/feeley/gambit/doc/m7.c"
> @b{(link-flat '("m6" "m7") output: "lib.o1.c")}
*** WARNING -- "*" is not defined,
View
@@ -43,7 +43,7 @@
;; References to the other fields in the module should thus
;; happen inside calls to 'begin!' and 'end!'.
;;
-;; dump Procedure (lambda (procs output output-root c-intf script-line
+;; dump Procedure (lambda (procs output c-intf script-line
;; options) ...)
;; This procedure takes a list of 'procedure objects' and dumps
;; the corresponding loader-compatible object file to the
@@ -61,10 +61,8 @@
;; will NOT produce the C interface file automatically as is
;; normally the case (this is useful in the case of a back-end
;; generating C that will itself be creating this file).
-;; The 'output' argument specifies the file name of the
-;; file to produce. If it is #f, 'output-root' concatenated
-;; with the appropriate extension should be used as a
-;; file name. The 'script-line' argument indicates the text
+;; The 'output' argument specifies the file name of the file
+;; to produce. The 'script-line' argument indicates the text
;; on the first line of the source file (after the #! or @;)
;; if the source file is a script or #f if it is not a script.
;;
@@ -102,20 +100,26 @@
;; task-return GVM location.
;; This value is the GVM register where the task's return address
;; is passed.
+;;
+;; switch-testable? Function.
+;; This function tests whether an object can be tested
+;; in a GVM "switch" instruction.
+;;
+;; file-extension The file extension for generated files.
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; Target description object manipulation
(define (make-target version name)
- (define current-target-version 6) ; number for this version of the module
+ (define current-target-version 7) ; number for this version of the module
(if (not (= version current-target-version))
(compiler-internal-error
"make-target, version of target module is not current" name))
- (let ((x (make-vector 13)))
+ (let ((x (make-vector 14)))
(vector-set! x 0 'target)
(vector-set! x 1 name)
x))
@@ -145,6 +149,8 @@
(define (target-task-return-set! x y) (vector-set! x 11 y))
(define (target-switch-testable? x) (vector-ref x 12))
(define (target-switch-testable?-set! x y) (vector-set! x 12 y))
+(define (target-file-extension x) (vector-ref x 13))
+(define (target-file-extension-set! x y) (vector-set! x 13 y))
;;;; Frame constraints structure
@@ -194,7 +200,8 @@
(set! target.frame-constraints (target-frame-constraints target))
(set! target.proc-result (target-proc-result target))
(set! target.task-return (target-task-return target))
- (set! target.switch-testable? (target-switch-testable? target))
+ (set! target.switch-testable? (target-switch-testable? target))
+ (set! target.file-extension (target-file-extension target))
(set! **not-proc-obj
(target.prim-info **not-sym))
@@ -247,6 +254,7 @@
(define target.proc-result #f)
(define target.task-return #f)
(define target.switch-testable? #f)
+(define target.file-extension #f)
;; procedures defined in back-end:
View
@@ -2,7 +2,7 @@
;;; File: "_front.scm"
-;;; Copyright (c) 1994-2011 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2012 by Marc Feeley, All Rights Reserved.
(include "fixnum.scm")
@@ -52,22 +52,17 @@
(define cf #f)
(set! cf
- (lambda (input opts output mod-name)
+ (lambda (input opts output-filename-gen mod-name)
(let ((remaining-opts
(handle-options opts)))
(set! warnings-requested? compiler-option-warnings)
- (let* ((output-root
- (if output
- #f
- (path-strip-directory
- (path-strip-extension input))))
- (info-port
+ (let* ((info-port
(if compiler-option-verbose
(current-output-port)
#f))
- (successful
+ (result
(with-exception-handling
(lambda ()
(if (not (null? remaining-opts))
@@ -79,12 +74,11 @@
opts
(cons (list 'target (default-target)) opts))
remaining-opts
- output
- output-root
+ output-filename-gen
mod-name
info-port)))))
- successful))))
+ result))))
(define (handle-options opts)
(reset-options)
@@ -189,15 +183,35 @@
input
opts
remaining-opts
- output
- output-root
+ output-filename-gen
mod-name
info-port)
(define (compiler-body)
- (let* ((root
- (or output-root
- (path-strip-extension output)))
+
+ (scheme-global-var-define!
+ (scheme-global-var
+ (string->canonical-symbol "##compilation-options"))
+ opts)
+
+ (env.begin!)
+ (ptree.begin! info-port)
+ (virtual.begin!)
+
+ (let ((target-name (cadr (assq 'target opts))))
+ (target-select! target-name info-port))
+
+ (let* ((output-filename
+ (and output-filename-gen
+ (output-filename-gen)))
+ (root
+ (if output-filename
+ (path-strip-extension output-filename)
+ (path-strip-directory (path-strip-extension input))))
+ (output
+ (if output-filename
+ output-filename
+ (string-append root target.file-extension)))
(module-name
(or mod-name
(path-strip-directory root))))
@@ -207,19 +221,6 @@
"Invalid characters in file name (must be a symbol with no \"#\")")
(begin
- (scheme-global-var-define!
- (scheme-global-var
- (string->canonical-symbol "##compilation-options"))
- opts)
-
- (env.begin!)
- (ptree.begin! info-port)
- (virtual.begin!)
-
- (let ((target-name
- (cadr (assq 'target opts))))
- (target-select! target-name info-port))
-
(let ((x (read-source input #f #t)))
(parse-program
(expand-source (wrap-program (##vector-ref x 1)));;;;;;;;;;;;;;
@@ -259,7 +260,6 @@
(target.dump
module-procs
output
- output-root
c-intf
(##vector-ref x 0);;;;;;;;;;;;;;;;;;;;
opts)
@@ -271,22 +271,22 @@
(ptree.end!)
(env.end!)
- #t))))
+ output))))
(set! warnings-requested? compiler-option-warnings)
- (let ((successful (with-exception-handling compiler-body)))
+ (let ((result (with-exception-handling compiler-body)))
(if info-port
- (if successful
+ (if result
(begin
(display "Compilation finished." info-port)
(newline info-port))
(begin
(display "Compilation terminated abnormally." info-port)
(newline info-port))))
- successful))
+ result))
(define (valid-module-name? module-name)
Oops, something went wrong.

0 comments on commit 095a643

Please sign in to comment.