mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Tried compiling more code; augmented the doc.
* module/language/Makefile.am: New. * module/language/scheme/Makefile.am: New. * configure.in: Produce these two new Makefiles. * doc/guile-vm.texi: Documented `compile-file', `compiled-file-name', and `compile-in'. * module/system/base/compile.scm: Cosmetic changes. * module/system/base/language.scm: Likewise. * module/system/il/Makefile.am: Tried (and failed) to compile more things. * module/system/vm/Makefile.am: All source files in here can now be compiled without harming further compilation. * module/system/vm/assemble.scm: Select only specific bindings from `(system vm core)'. (dump-object!): Show a more meaningful error message. * module/system/vm/conv.scm: Select only specific bindings from `(system vm core)'. * module/system/vm/debug.scm: Likewise. * module/system/vm/frame.scm: Changed the header. Use a renamer for `(system vm core)'. * src/guilec.in: Added options, via `getopt-long'. git-archimport-id: lcourtes@laas.fr--2005-mobile/guile-vm--mobile--0.6--patch-6
This commit is contained in:
Ludovic Courtes
Ludovic Courtès
parent
b6368dbbb9
commit
884d46de23
15 changed files with 220 additions and 66 deletions
18
configure.in
18
configure.in
|
|
@ -1,12 +1,19 @@
|
|||
AC_INIT(src/guile-vm.c)
|
||||
AM_INIT_AUTOMAKE(guile-vm, 0.5)
|
||||
AM_CONFIG_HEADER(src/config.h)
|
||||
# Guile-VM.
|
||||
|
||||
AC_PREREQ(2.59)
|
||||
AC_INIT(guile-vm, 0.6, ludovic.courtes@laas.fr)
|
||||
AM_INIT_AUTOMAKE(guile-vm, 0.6)
|
||||
|
||||
AC_CONFIG_SRCDIR(src/guile-vm.c)
|
||||
AC_CONFIG_HEADER(src/config.h)
|
||||
|
||||
# Guile.
|
||||
GUILE_FLAGS
|
||||
if test "`guile -c '(display (string>=? (version) "1.4.1"))'`" != "#t"; then
|
||||
AC_MSG_ERROR([Your Guile is too old. You need guile-1.4.1 or later.])
|
||||
if test "`guile -c '(display (string>=? (version) "1.7"))'`" != "#t"; then
|
||||
AC_MSG_ERROR([Your Guile is too old. You need Guile 1.7.2 or later.])
|
||||
fi
|
||||
|
||||
# C Compiler.
|
||||
AC_PROG_CC
|
||||
AC_PROG_LN_S
|
||||
AM_PROG_LIBTOOL
|
||||
|
|
@ -24,4 +31,5 @@ AC_OUTPUT(Makefile src/Makefile doc/Makefile module/Makefile
|
|||
module/system/Makefile module/system/base/Makefile
|
||||
module/system/vm/Makefile module/system/il/Makefile
|
||||
module/system/repl/Makefile
|
||||
module/language/Makefile module/language/scheme/Makefile
|
||||
testsuite/Makefile)
|
||||
|
|
|
|||
|
|
@ -766,13 +766,32 @@ The use of two separate intermediate languages eases the
|
|||
implementation of front-ends since the gap between high-level
|
||||
languages like Scheme and GHIL is relatively small.
|
||||
|
||||
@findex compile-file
|
||||
@vindex guilec
|
||||
From an end-user viewpoint, compiling a Guile program into bytecode
|
||||
can be done either by using the @command{guilec} command-line tool, or
|
||||
by using the @code{compile-file} procedure exported by the
|
||||
@code{(system base compile)} module.
|
||||
|
||||
@deffn @scmproc{} compile-file file . opts
|
||||
Compile Scheme source code from file @var{file} using compilation
|
||||
options @var{opts}. The resulting file, a Guile object file, will be
|
||||
name according the application of the @code{compiled-file-name}
|
||||
procedure to @var{file}. The possible values for @var{opts} are the
|
||||
same as for the @code{compile-in} procedure (see below, @pxref{The Language
|
||||
Front-Ends}).
|
||||
@end deffn
|
||||
|
||||
@deffn @scmproc{} compiled-file-name file
|
||||
Given source file name @var{file} (a string), return a string that
|
||||
denotes the name of the Guile object file corresponding to
|
||||
@var{file}. By default, the file name returned is @var{file} minus
|
||||
its extension and plus the @code{.go} file extension.
|
||||
@end deffn
|
||||
|
||||
@cindex self-hosting
|
||||
It is worth noting, as you might have already guessed, that Guile-VM's
|
||||
compiler is written in Guile Scheme and is @dfn{self-hosted}: it can
|
||||
compile itself.
|
||||
|
||||
@node The Language Front-Ends, GHIL, Overview, The Compiler
|
||||
@section The Language Front-Ends
|
||||
|
|
@ -804,6 +823,34 @@ this procedure assumes that language @var{symbol} exists if there
|
|||
exist a @code{(language @var{symbol} spec)} module.
|
||||
@end deffn
|
||||
|
||||
The @code{(system base compile)} module defines a procedure similar to
|
||||
@code{compile-file} but that is not limited to the Scheme language:
|
||||
|
||||
@deffn @scmproc{} compile-in expr env lang . opts
|
||||
Compile expression @var{expr}, which is written in language @var{lang}
|
||||
(a @code{<language>} object), using compilation options @var{opts},
|
||||
and return bytecode as produced by the assembler (@pxref{The
|
||||
Assembler}).
|
||||
|
||||
Options @var{opts} may contain the following keywords:
|
||||
|
||||
@table @code
|
||||
@item :e
|
||||
compilation will stop after the code expansion phase.
|
||||
@item :t
|
||||
compilation will stop after the code translation phase, i.e. after
|
||||
code in the source language @var{lang} has been translated into GHIL
|
||||
(@pxref{GHIL}).
|
||||
@item :c
|
||||
compilation will stop after the compilation phase and before the
|
||||
assembly phase, i.e. once GHIL has been translated into GLIL
|
||||
(@pxref{GLIL}).
|
||||
@end table
|
||||
|
||||
Additionally, @var{opts} may contain any option understood by the
|
||||
GHIL-to-GLIL compiler described in @xref{GLIL}.
|
||||
@end deffn
|
||||
|
||||
|
||||
@node GHIL, GLIL, The Language Front-Ends, The Compiler
|
||||
@section Guile's High-Level Intermediate Language
|
||||
|
|
@ -874,6 +921,10 @@ instruction sequence. The option list @var{opts} may be either the
|
|||
empty list or a list containing the @code{:O} keyword in which case
|
||||
@code{compile} will first go through an optimization stage of
|
||||
@var{ghil}.
|
||||
|
||||
Note that the @code{:O} option may be passed at a higher-level to the
|
||||
@code{compile-file} and @code{compile-in} procedures (@pxref{The
|
||||
Language Front-Ends}).
|
||||
@end deffn
|
||||
|
||||
@deffn @scmproc{} pprint-glil glil . port
|
||||
|
|
|
|||
1
module/language/Makefile.am
Normal file
1
module/language/Makefile.am
Normal file
|
|
@ -0,0 +1 @@
|
|||
SUBDIRS = scheme
|
||||
17
module/language/scheme/Makefile.am
Normal file
17
module/language/scheme/Makefile.am
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
SOURCES =
|
||||
## FIXME: There's a bug showing up when compiling `translate.scm'.
|
||||
##
|
||||
## `spec.scm' cannot be compiled because it uses the `define-language'
|
||||
## macro which introduces an unregular object, namely the first-class
|
||||
## `<language>' procedure.
|
||||
GOBJECTS = $(SOURCES:%.scm=%.go)
|
||||
|
||||
vmdir = $(guiledir)/language/scheme
|
||||
vm_DATA = $(SOURCES) $(GOBJECTS)
|
||||
|
||||
CLEANFILES = $(GOBJECTS)
|
||||
MAINTAINERCLEANFILES = Makefile.in
|
||||
|
||||
SUFFIXES = .scm .go
|
||||
%.go: %.scm
|
||||
$(GUILEC) $<
|
||||
|
|
@ -1,12 +1,13 @@
|
|||
SOURCES = syntax.scm language.scm compile.scm
|
||||
OBJECTS = syntax.go language.go compile.go
|
||||
SOURCES = compile.scm language.scm module.scm
|
||||
## syntax.scm
|
||||
GOBJECTS = $(SOURCES:%.scm=%.go)
|
||||
|
||||
vmdir = $(guiledir)/system/vm
|
||||
vm_DATA = $(SOURCES) $(OBJECTS)
|
||||
vm_DATA = $(SOURCES) $(GOBJECTS)
|
||||
|
||||
DISTCLEANFILES = $(OBJECTS)
|
||||
CLEANFILES = $(GOBJECTS)
|
||||
MAINTAINERCLEANFILES = Makefile.in
|
||||
|
||||
SUFFIXES = .scm .go
|
||||
.scm.go:
|
||||
%.go: %.scm
|
||||
$(GUILEC) $<
|
||||
|
|
|
|||
|
|
@ -68,7 +68,7 @@
|
|||
(if (memq :c opts)
|
||||
(pprint-glil objcode port)
|
||||
(uniform-vector-write (objcode->u8vector objcode) port)))))
|
||||
(format #t "wrote ~A\n" comp))
|
||||
(format #t "wrote `~A'\n" comp))
|
||||
(lambda (key . args)
|
||||
(format #t "ERROR: during compilation of ~A:\n" file)
|
||||
(display "ERROR: ")
|
||||
|
|
|
|||
|
|
@ -42,4 +42,4 @@
|
|||
(let ((m (resolve-module `(language ,name spec))))
|
||||
(if (module-bound? m name)
|
||||
(module-ref m name)
|
||||
(error "No such language:" name))))
|
||||
(error "no such language" name))))
|
||||
|
|
|
|||
|
|
@ -1,12 +1,14 @@
|
|||
SOURCES = glil.scm ghil.scm macros.scm compile.scm
|
||||
OBJECTS = glil.go ghil.go macros.go compile.go
|
||||
SOURCES = glil.scm macros.scm
|
||||
## FIXME: There's a bug showing up when compiling `ghil.scm' and
|
||||
## `compile.scm'!
|
||||
GOBJECTS = $(SOURCES:%.scm=%.go)
|
||||
|
||||
vmdir = $(guiledir)/system/il
|
||||
vm_DATA = $(SOURCES) $(OBJECTS)
|
||||
vm_DATA = $(SOURCES) $(GOBJECTS)
|
||||
|
||||
DISTCLEANFILES = $(OBJECTS)
|
||||
CLEANFILES = $(GOBJECTS)
|
||||
MAINTAINERCLEANFILES = Makefile.in
|
||||
|
||||
SUFFIXES = .scm .go
|
||||
.scm.go:
|
||||
%.go: %.scm
|
||||
$(GUILEC) $<
|
||||
|
|
|
|||
|
|
@ -1,12 +1,13 @@
|
|||
SOURCES = repl.scm common.scm command.scm
|
||||
OBJECTS = repl.go common.go command.go
|
||||
##describe.scm
|
||||
GOBJECTS = $(SOURCES:%.scm=%.go)
|
||||
|
||||
vmdir = $(guiledir)/system/repl
|
||||
vm_DATA = $(SOURCES) $(OBJECTS)
|
||||
vm_DATA = $(SOURCES) $(GOBJECTS)
|
||||
|
||||
DISTCLEANFILES = $(OBJECTS)
|
||||
CLEANFILES = $(GOBJECTS)
|
||||
MAINTAINERCLEANFILES = Makefile.in
|
||||
|
||||
SUFFIXES = .scm .go
|
||||
.scm.go:
|
||||
%.go: %.scm
|
||||
$(GUILEC) $<
|
||||
|
|
|
|||
|
|
@ -1,12 +1,13 @@
|
|||
SOURCES = assemble.scm conv.scm core.scm disasm.scm profile.scm trace.scm
|
||||
OBJECTS = assemble.go conv.go core.go disasm.go profile.go trace.go
|
||||
SOURCES = assemble.scm conv.scm core.scm debug.scm \
|
||||
disasm.scm frame.scm profile.scm trace.scm
|
||||
GOBJECTS = $(SOURCES:%.scm=%.go)
|
||||
|
||||
vmdir = $(guiledir)/system/vm
|
||||
vm_DATA = $(SOURCES) $(OBJECTS)
|
||||
vm_DATA = $(SOURCES) $(GOBJECTS)
|
||||
|
||||
DISTCLEANFILES = $(OBJECTS)
|
||||
CLEANFILES = $(GOBJECTS)
|
||||
MAINTAINERCLEANFILES = Makefile.in
|
||||
|
||||
SUFFIXES = .scm .go
|
||||
.scm.go:
|
||||
%.go: %.scm
|
||||
$(GUILEC) $<
|
||||
|
|
|
|||
|
|
@ -22,7 +22,10 @@
|
|||
(define-module (system vm assemble)
|
||||
:use-syntax (system base syntax)
|
||||
:use-module (system il glil)
|
||||
:use-module (system vm core)
|
||||
:use-module ((system vm core)
|
||||
:select (instruction? instruction-pops
|
||||
make-binding
|
||||
bytecode->objcode))
|
||||
:use-module (system vm conv)
|
||||
:use-module (ice-9 match)
|
||||
:use-module (ice-9 regex)
|
||||
|
|
@ -275,4 +278,4 @@
|
|||
(for-each dump! (vector->list x))
|
||||
(push-code! `(vector ,(vector-length x))))
|
||||
(else
|
||||
(error "Cannot dump:" x)))))))
|
||||
(error "assemble: unrecognized object" x)))))))
|
||||
|
|
|
|||
|
|
@ -20,7 +20,9 @@
|
|||
;;; Code:
|
||||
|
||||
(define-module (system vm conv)
|
||||
:use-module (system vm core)
|
||||
:use-module ((system vm core)
|
||||
:select (instruction? instruction-length
|
||||
instruction->opcode))
|
||||
:use-module (ice-9 match)
|
||||
:use-module (ice-9 regex)
|
||||
:use-module (srfi srfi-4)
|
||||
|
|
|
|||
|
|
@ -21,7 +21,8 @@
|
|||
|
||||
(define-module (system vm debug)
|
||||
:use-syntax (system base syntax)
|
||||
:use-module (system vm core)
|
||||
;; :use-module ((system vm core)
|
||||
;; :select (vm-last-frame-chain vm-backtrace))
|
||||
:use-module (system vm frame)
|
||||
:use-module (ice-9 format)
|
||||
:export (vm-debugger vm-backtrace))
|
||||
|
|
|
|||
|
|
@ -1,26 +1,26 @@
|
|||
;;; Guile VM frame functions
|
||||
|
||||
;; Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
;;; Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
;;; Copyright (C) 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
|
||||
;;;
|
||||
;;; This program is free software; you can redistribute it and/or modify
|
||||
;;; it under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 2 of the License, or
|
||||
;;; (at your option) any later version.
|
||||
;;;
|
||||
;;; This program is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with this program; if not, write to the Free Software
|
||||
;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
;;; Code:
|
||||
|
||||
(define-module (system vm frame)
|
||||
:use-module (system vm core))
|
||||
:use-module ((system vm core) :renamer (symbol-prefix-proc 'vm:)))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -31,19 +31,20 @@
|
|||
(define-public frame-address (make-object-property))
|
||||
|
||||
(define-public (vm-current-frame-chain vm)
|
||||
(make-frame-chain (vm-this-frame vm) (vm:ip vm)))
|
||||
(make-frame-chain (vm:vm-this-frame vm) (vm:vm:ip vm)))
|
||||
|
||||
(define-public (vm-last-frame-chain vm)
|
||||
(make-frame-chain (vm-last-frame vm) (vm:ip vm)))
|
||||
(make-frame-chain (vm:vm-last-frame vm) (vm:vm:ip vm)))
|
||||
|
||||
(define (make-frame-chain frame addr)
|
||||
(let* ((link (frame-dynamic-link frame))
|
||||
(let* ((link (vm:frame-dynamic-link frame))
|
||||
(chain (if (eq? link #t)
|
||||
'()
|
||||
(cons frame (make-frame-chain
|
||||
link (frame-return-address frame))))))
|
||||
(set! (frame-number frame) (length chain))
|
||||
(set! (frame-address frame) (- addr (program-base (frame-program frame))))
|
||||
(cons frame (vm:make-frame-chain
|
||||
link (vm:frame-return-address frame))))))
|
||||
(set! (vm:frame-number frame) (length chain))
|
||||
(set! (vm:frame-address frame)
|
||||
(- addr (program-base (vm:frame-program frame))))
|
||||
chain))
|
||||
|
||||
|
||||
|
|
@ -52,7 +53,7 @@
|
|||
;;;
|
||||
|
||||
(define-public (print-frame frame)
|
||||
(format #t "#~A " (frame-number frame))
|
||||
(format #t "#~A " (vm:frame-number frame))
|
||||
(print-frame-call frame)
|
||||
(newline))
|
||||
|
||||
|
|
@ -67,12 +68,13 @@
|
|||
((1) (vector (abbrev (vector-ref x 0))))
|
||||
(else (vector (abbrev (vector-ref x 0)) '...))))
|
||||
(else x)))
|
||||
(write (abbrev (cons (program-name frame) (frame-arguments frame)))))
|
||||
(write (abbrev (cons (program-name frame)
|
||||
(vm:frame-arguments frame)))))
|
||||
|
||||
(define (program-name frame)
|
||||
(let ((prog (frame-program frame))
|
||||
(link (frame-dynamic-link frame)))
|
||||
(let ((prog (vm:frame-program frame))
|
||||
(link (vm:frame-dynamic-link frame)))
|
||||
(or (object-property prog 'name)
|
||||
(frame-object-name link (1- (frame-address link)) prog)
|
||||
(vm:frame-object-name link (1- (vm:frame-address link)) prog)
|
||||
(hash-fold (lambda (s v d) (if (eq? prog (variable-ref v)) s d))
|
||||
prog (module-obarray (current-module))))))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,69 @@
|
|||
#!@guile@ -s
|
||||
# -*- Scheme -*-
|
||||
!#
|
||||
;;; guilec -- Command-line Guile Scheme compiler.
|
||||
;;;
|
||||
;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
|
||||
;;;
|
||||
;;;
|
||||
;;; This program is free software; you can redistribute it and/or modify
|
||||
;;; it under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 2 of the License, or
|
||||
;;; (at your option) any later version.
|
||||
;;;
|
||||
;;; This program is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with this program; if not, write to the Free Software
|
||||
;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
(use-modules (system base compile))
|
||||
(for-each compile-file (cdr (command-line)))
|
||||
(use-modules (system base compile)
|
||||
(ice-9 getopt-long))
|
||||
|
||||
(read-set! keywords 'prefix)
|
||||
|
||||
(define %guilec-options
|
||||
'((help (single-char #\h) (value #f))
|
||||
(optimize (single-char #\O) (value #f))
|
||||
(expand-only (single-char #\e) (value #f))
|
||||
(translate-only (single-char #\t) (value #f))
|
||||
(compile-only (single-char #\c) (value #f))))
|
||||
|
||||
(let* ((options (getopt-long (command-line) %guilec-options))
|
||||
(help? (option-ref options 'help #f))
|
||||
(optimize? (option-ref options 'optimize #f))
|
||||
(expand-only? (option-ref options 'expand-only #f))
|
||||
(translate-only? (option-ref options 'translate-only #f))
|
||||
(compile-only? (option-ref options 'compile-only #f)))
|
||||
(if help?
|
||||
(begin
|
||||
(format #t "Usage: guilec [OPTION] FILE...
|
||||
Compile each Guile Scheme source file FILE into a Guile object.
|
||||
|
||||
-h, --help print this help message
|
||||
-O, --optimize turn on optimizations
|
||||
-e, --expand-only only go through the code expansion stage
|
||||
-t, --translate-only stop after the translation to GHIL
|
||||
-c, --compile-only stop after the compilation to GLIL
|
||||
|
||||
Report bugs to <guile-user@gnu.org>.~%")
|
||||
(exit 0)))
|
||||
|
||||
(let ((compile-opts (append (if optimize? '(:O) '())
|
||||
(if expand-only? '(:e) '())
|
||||
(if translate-only? '(:t) '())
|
||||
(if compile-only? '(:c) '()))))
|
||||
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(for-each (lambda (file)
|
||||
(apply compile-file (cons file compile-opts)))
|
||||
(option-ref options '() '())))
|
||||
(lambda ()
|
||||
(format (current-error-port) "removing compiled files due to errors~%")
|
||||
(false-if-exception
|
||||
(for-each unlink (map compiled-file-name files)))
|
||||
(exit 1)))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue