diff options
author | Andy Wingo <wingo@pobox.com> | 2009-05-29 16:01:43 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-05-29 16:01:43 +0200 |
commit | 938d46a35d39ec5d7b5fa858a8783136ce24d10d (patch) | |
tree | 17153f062515c4ae74815f65c4aa1f30a92e1ce4 /doc/ref/compiler.texi | |
parent | 1ee2c72eafaae5f91f4c899bc4b4853af5c16f28 (diff) | |
parent | e3c5df539640a36eb1493f581087d54a4714f337 (diff) | |
download | guile-938d46a35d39ec5d7b5fa858a8783136ce24d10d.tar.gz |
Merge branch 'syncase-in-boot-9'
Conflicts:
module/Makefile.am
Diffstat (limited to 'doc/ref/compiler.texi')
-rw-r--r-- | doc/ref/compiler.texi | 761 |
1 files changed, 404 insertions, 357 deletions
diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi index 27d8f79c8..0d68abfc6 100644 --- a/doc/ref/compiler.texi +++ b/doc/ref/compiler.texi @@ -22,9 +22,10 @@ know how to compile your .scm file. @menu * Compiler Tower:: * The Scheme Compiler:: -* GHIL:: +* Tree-IL:: * GLIL:: -* Object Code:: +* Assembly:: +* Bytecode and Objcode:: * Extending the Compiler:: @end menu @@ -52,7 +53,7 @@ They are registered with the @code{define-language} form. @deffn {Scheme Syntax} define-language @ name title version reader printer @ -[parser=#f] [read-file=#f] [compilers='()] [evaluator=#f] +[parser=#f] [compilers='()] [decompilers='()] [evaluator=#f] Define a language. This syntax defines a @code{#<language>} object, bound to @var{name} @@ -62,17 +63,15 @@ for Scheme: @example (define-language scheme - #:title "Guile Scheme" - #:version "0.5" - #:reader read - #:read-file read-file - #:compilers `((,ghil . ,compile-ghil)) - #:evaluator (lambda (x module) (primitive-eval x)) - #:printer write) + #:title "Guile Scheme" + #:version "0.5" + #:reader read + #:compilers `((tree-il . ,compile-tree-il) + (ghil . ,compile-ghil)) + #:decompilers `((tree-il . ,decompile-tree-il)) + #:evaluator (lambda (x module) (primitive-eval x)) + #:printer write) @end example - -In this example, from @code{(language scheme spec)}, @code{read-file} -reads expressions from a port and wraps them in a @code{begin} block. @end deffn The interesting thing about having languages defined this way is that @@ -85,12 +84,12 @@ Guile Scheme interpreter 0.5 on Guile 1.9.0 Copyright (C) 2001-2008 Free Software Foundation, Inc. Enter `,help' for help. -scheme@@(guile-user)> ,language ghil -Guile High Intermediate Language (GHIL) interpreter 0.3 on Guile 1.9.0 +scheme@@(guile-user)> ,language tree-il +Tree Intermediate Language interpreter 1.0 on Guile 1.9.0 Copyright (C) 2001-2008 Free Software Foundation, Inc. Enter `,help' for help. -ghil@@(guile-user)> +tree-il@@(guile-user)> @end example Languages can be looked up by name, as they were above. @@ -128,17 +127,25 @@ The normal tower of languages when compiling Scheme goes like this: @itemize @item Scheme, which we know and love -@item Guile High Intermediate Language (GHIL) +@item Tree Intermediate Language (Tree-IL) @item Guile Low Intermediate Language (GLIL) -@item Object code +@item Assembly +@item Bytecode +@item Objcode @end itemize Object code may be serialized to disk directly, though it has a cookie -and version prepended to the front. But when compiling Scheme at -run time, you want a Scheme value, e.g. a compiled procedure. For this -reason, so as not to break the abstraction, Guile defines a fake -language, @code{value}. Compiling to @code{value} loads the object -code into a procedure, and wakes the sleeping giant. +and version prepended to the front. But when compiling Scheme at run +time, you want a Scheme value: for example, a compiled procedure. For +this reason, so as not to break the abstraction, Guile defines a fake +language at the bottom of the tower: + +@itemize +@item Value +@end itemize + +Compiling to @code{value} loads the object code into a procedure, and +wakes the sleeping giant. Perhaps this strangeness can be explained by example: @code{compile-file} defaults to compiling to object code, because it @@ -156,340 +163,254 @@ different worlds indefinitely, as shown by the following quine: @node The Scheme Compiler @subsection The Scheme Compiler -The job of the Scheme compiler is to expand all macros and to resolve -all symbols to lexical variables. Its target language, GHIL, is fairly -close to Scheme itself, so this process is not very complicated. - -The Scheme compiler is driven by a table of @dfn{translators}, -declared with the @code{define-scheme-translator} form, defined in the -module, @code{(language scheme compile-ghil)}. - -@deffn {Scheme Syntax} define-scheme-translator head clause1 clause2... -The best documentation of this form is probably an example. Here is -the translator for @code{if}: - -@example -(define-scheme-translator if - ;; (if TEST THEN [ELSE]) - ((,test ,then) - (make-ghil-if e l (retrans test) (retrans then) (retrans '(begin)))) - ((,test ,then ,else) - (make-ghil-if e l (retrans test) (retrans then) (retrans else)))) -@end example - -The match syntax is from the @code{pmatch} macro, defined in -@code{(system base pmatch)}. The result of a clause should be a valid -GHIL value. If no clause matches, a syntax error is signalled. - -In the body of the clauses, the following bindings are introduced: -@itemize -@item @code{e}, the current environment -@item @code{l}, the current source location (or @code{#f}) -@item @code{retrans}, a procedure that may be called to compile -subexpressions -@end itemize - -Note that translators are looked up by @emph{value}, not by name. That -is to say, the translator is keyed under the @emph{value} of -@code{if}, which normally prints as @code{#<primitive-builtin-macro! -if>}. -@end deffn - -Users can extend the compiler by defining new translators. -Additionally, some forms can be inlined directly to -instructions -- @xref{Inlined Scheme Instructions}, for a list. The -actual inliners are defined in @code{(language scheme inline)}: - -@deffn {Scheme Syntax} define-inline head arity1 result1 arity2 result2... -Defines an inliner for @code{head}. As in -@code{define-scheme-translator}, inliners are keyed by value and not -by name. - -Expressions are matched on their arities. For example: - -@example -(define-inline eq? - (x y) (eq? x y)) -@end example - -This inlines calls to the Scheme procedure, @code{eq?}, to the -instruction @code{eq?}. - -A more complicated example would be: - -@example -(define-inline + - () 0 - (x) x - (x y) (add x y) - (x y . rest) (add x (+ y . rest))) -@end example -@end deffn - -Compilers take two arguments, an expression and an environment, and -return two values as well: an expression in the target language, and -an environment suitable for the target language. The format of the -environment is language-dependent. - -For Scheme, an environment may be one of three things: +The job of the Scheme compiler is to expand all macros and all of +Scheme to its most primitive expressions. The definition of +``primitive'' is given by the inventory of constructs provided by +Tree-IL, the target language of the Scheme compiler: procedure +applications, conditionals, lexical references, etc. This is described +more fully in the next section. + +The tricky and amusing thing about the Scheme-to-Tree-IL compiler is +that it is completely implemented by the macro expander. Since the +macro expander has to run over all of the source code already in order +to expand macros, it might as well do the analysis at the same time, +producing Tree-IL expressions directly. + +Because this compiler is actually the macro expander, it is +extensible. Any macro which the user writes becomes part of the +compiler. + +The Scheme-to-Tree-IL expander may be invoked using the generic +@code{compile} procedure: + +@lisp +(compile '(+ 1 2) #:from 'scheme #:to 'tree-il) +@result{} + #<<application> src: #f + proc: #<<toplevel-ref> src: #f name: +> + args: (#<<const> src: #f exp: 1> + #<<const> src: #f exp: 2>)> +@end lisp + +Or, since Tree-IL is so close to Scheme, it is often useful to expand +Scheme to Tree-IL, then translate back to Scheme. For that reason the +expander provides two interfaces. The former is equivalent to calling +@code{(sc-expand '(+ 1 2) 'c)}, where the @code{'c} is for +``compile''. With @code{'e} (the default), the result is translated +back to Scheme: + +@lisp +(sc-expand '(+ 1 2)) +@result{} (+ 1 2) +(sc-expand '(let ((x 10)) (* x x))) +@result{} (let ((x84 10)) (* x84 x84)) +@end lisp + +The second example shows that as part of its job, the macro expander +renames lexically-bound variables. The original names are preserved +when compiling to Tree-IL, but can't be represented in Scheme: a +lexical binding only has one name. It is for this reason that the +@emph{native} output of the expander is @emph{not} Scheme. There's too +much information we would lose if we translated to Scheme directly: +lexical variable names, source locations, and module hygiene. + +Note however that @code{sc-expand} does not have the same signature as +@code{compile-tree-il}. @code{compile-tree-il} is a small wrapper +around @code{sc-expand}, to make it conform to the general form of +compiler procedures in Guile's language tower. + +Compiler procedures take two arguments, an expression and an +environment. They return three values: the compiled expression, the +corresponding environment for the target language, and a +``continuation environment''. The compiled expression and environment +will serve as input to the next language's compiler. The +``continuation environment'' can be used to compile another expression +from the same source language within the same module. + +For example, you might compile the expression, @code{(define-module +(foo))}. This will result in a Tree-IL expression and environment. But +if you compiled a second expression, you would want to take into +account the compile-time effect of compiling the previous expression, +which puts the user in the @code{(foo)} module. That is purpose of the +``continuation environment''; you would pass it as the environment +when compiling the subsequent expression. + +For Scheme, an environment may be one of two things: @itemize @item @code{#f}, in which case compilation is performed in the context -of the current module; -@item a module, which specifies the context of the compilation; or -@item a @dfn{compile environment}, which specifies lexical variables -as well. +of the current module; or +@item a module, which specifies the context of the compilation. @end itemize -The format of a compile environment for scheme is @code{(@var{module} -@var{lexicals} . @var{externals})}, though users are strongly -discouraged from constructing these environments themselves. Instead, -if you need this functionality -- as in GOOPS' dynamic method compiler --- capture an environment with @code{compile-time-environment}, then -pass that environment to @code{compile}. - -@deffn {Scheme Procedure} compile-time-environment -A special function known to the compiler that, when compiled, will -return a representation of the lexical environment in place at compile -time. Useful for supporting some forms of dynamic compilation. Returns -@code{#f} if called from the interpreter. -@end deffn - -@node GHIL -@subsection GHIL +@node Tree-IL +@subsection Tree-IL -Guile High Intermediate Language (GHIL) is a structured intermediate +Tree Intermediate Language (Tree-IL) is a structured intermediate language that is close in expressive power to Scheme. It is an expanded, pre-analyzed Scheme. -GHIL is ``structured'' in the sense that its representation is based -on records, not S-expressions. This gives a rigidity to the language -that ensures that compiling to a lower-level language only requires a -limited set of transformations. Practically speaking, consider the -GHIL type, @code{<ghil-quote>}, which has fields named @code{env}, -@code{loc}, and @code{exp}. Instances of this type are records created -via @code{make-ghil-quote}, and whose fields are accessed as -@code{ghil-quote-env}, @code{ghil-quote-loc}, and -@code{ghil-quote-exp}. There is also a predicate, @code{ghil-quote?}. -@xref{Records}, for more information on records. - -Expressions of GHIL name their environments explicitly, and all -variables are referenced by identity in addition to by name. -@code{(language ghil)} defines a number of routines to deal explicitly -with variables and environments: - -@deftp {Scheme Variable} <ghil-toplevel-env> [table='()] -A toplevel environment. The @var{table} holds all toplevel variables -that have been resolved in this environment. -@end deftp -@deftp {Scheme Variable} <ghil-env> parent [table='()] [variables='()] -A lexical environment. @var{parent} will be the enclosing lexical -environment, or a toplevel environment. @var{table} holds an alist -mapping symbols to variables bound in this environment, while -@var{variables} holds a cumulative list of all variables ever defined -in this environment. - -Lexical environments correspond to procedures. Bindings introduced -e.g. by Scheme's @code{let} add to the bindings in a lexical -environment. An example of a case in which a variable might be in -@var{variables} but not in @var{table} would be a variable that is in -the same procedure, but is out of scope. -@end deftp -@deftp {Scheme Variable} <ghil-var> env name kind [index=#f] -A variable. @var{kind} is one of @code{argument}, @code{local}, -@code{external}, @code{toplevel}, @code{public}, or @code{private}; -see the procedures below for more information. @var{index} is used in -compilation. -@end deftp - -@deffn {Scheme Procedure} ghil-var-is-bound? env sym -Recursively look up a variable named @var{sym} in @var{env}, and -return it or @code{#f} if none is found. -@end deffn -@deffn {Scheme Procedure} ghil-var-for-ref! env sym -Recursively look up a variable named @var{sym} in @var{env}, and -return it. If the symbol was not bound, return a new toplevel -variable. -@end deffn -@deffn {Scheme Procedure} ghil-var-for-set! env sym -Like @code{ghil-var-for-ref!}, except that the returned variable will -be marked as @code{external}. @xref{Variables and the VM}. -@end deffn -@deffn {Scheme Procedure} ghil-var-define! toplevel-env sym -Return an existing or new toplevel variable named @var{sym}. -@var{toplevel-env} must be a toplevel environment. -@end deffn -@deffn {Scheme Procedure} ghil-var-at-module! env modname sym interface? -Return a variable that will be resolved at run-time with respect to a -specific module named @var{modname}. If @var{interface?} is true, the -variable will be of type @code{public}, otherwise @code{private}. -@end deffn -@deffn {Scheme Procedure} call-with-ghil-environment env syms func -Bind @var{syms} to fresh variables within a new lexical environment -whose parent is @var{env}, and call @var{func} as @code{(@var{func} -@var{new-env} @var{new-vars})}. -@end deffn -@deffn {Scheme Procedure} call-with-ghil-bindings env syms func -Like @code{call-with-ghil-environment}, except the existing -environment @var{env} is re-used. For that reason, @var{func} is -invoked as @code{(@var{func} @var{new-vars})} -@end deffn - -In the aforementioned @code{<ghil-quote>} type, the @var{env} slot -holds a pointer to the environment in which the expression occurs. The -@var{loc} slot holds source location information, so that errors -corresponding to this expression can be mapped back to the initial -expression in the higher-level language, e.g. Scheme. @xref{Compiled -Procedures}, for more information on source location objects. - -GHIL also has a declarative serialization format, which makes writing -and reading it a tractable problem for the human mind. Since all GHIL -language constructs contain @code{env} and @code{loc} pointers, they -are left out of the serialization. (Serializing @code{env} structures -would be difficult, as they are often circular.) What is left is the -type of expression, and the remaining slots defined in the expression -type. - -For example, an S-expression representation of the @code{<ghil-quote>} -expression would be: +Tree-IL is ``structured'' in the sense that its representation is +based on records, not S-expressions. This gives a rigidity to the +language that ensures that compiling to a lower-level language only +requires a limited set of transformations. Practically speaking, +consider the Tree-IL type, @code{<const>}, which has two fields, +@code{src} and @code{exp}. Instances of this type are records created +via @code{make-const}, and whose fields are accessed as +@code{const-src}, and @code{const-exp}. There is also a predicate, +@code{const?}. @xref{Records}, for more information on records. + +@c alpha renaming + +All Tree-IL types have a @code{src} slot, which holds source location +information for the expression. This information, if present, will be +residualized into the compiled object code, allowing backtraces to +show source information. The format of @code{src} is the same as that +returned by Guile's @code{source-properties} function. @xref{Source +Properties}, for more information. + +Although Tree-IL objects are represented internally using records, +there is also an equivalent S-expression external representation for +each kind of Tree-IL. For example, an the S-expression representation +of @code{#<const src: #f exp: 3>} expression would be: @example -(quote 3) +(const 3) @end example -It's deceptively like Scheme. The general rule is, for a type defined -as @code{<ghil-@var{foo}> env loc @var{slot1} @var{slot2}...}, the -S-expression representation will be @code{(@var{foo} @var{slot1} -@var{slot2}...)}. Users may program with this format directly at the -REPL: +Users may program with this format directly at the REPL: @example -scheme@@(guile-user)> ,language ghil -Guile High Intermediate Language (GHIL) interpreter 0.3 on Guile 1.9.0 +scheme@@(guile-user)> ,language tree-il +Tree Intermediate Language interpreter 1.0 on Guile 1.9.0 Copyright (C) 2001-2008 Free Software Foundation, Inc. Enter `,help' for help. -ghil@@(guile-user)> (call (ref +) (quote 32) (quote 10)) +tree-il@@(guile-user)> (apply (primitive +) (const 32) (const 10)) @result{} 42 @end example -For convenience, some slots are serialized as rest arguments; those -are noted below. The other caveat is that variables are serialized as -their names only, and not their identities. - -@deftp {Scheme Variable} <ghil-void> env loc -The unspecified value. -@end deftp -@deftp {Scheme Variable} <ghil-quote> env loc exp -A quoted expression. - -Note that unlike in Scheme, there are no self-quoting expressions; all -constants must come from @code{quote} expressions. -@end deftp -@deftp {Scheme Variable} <ghil-quasiquote> env loc exp -A quasiquoted expression. The expression is treated as a constant, -except for embedded @code{unquote} and @code{unquote-splicing} forms. -@end deftp -@deftp {Scheme Variable} <ghil-unquote> env loc exp -Like Scheme's @code{unquote}; only valid within a quasiquote. -@end deftp -@deftp {Scheme Variable} <ghil-unquote-splicing> env loc exp -Like Scheme's @code{unquote-splicing}; only valid within a quasiquote. -@end deftp -@deftp {Scheme Variable} <ghil-ref> env loc var -A variable reference. Note that for purposes of serialization, -@var{var} is serialized as its name, as a symbol. -@end deftp -@deftp {Scheme Variable} <ghil-set> env loc var val -A variable mutation. @var{var} is serialized as a symbol. -@end deftp -@deftp {Scheme Variable} <ghil-define> env loc var val -A toplevel variable definition. See @code{ghil-var-define!}. -@end deftp -@deftp {Scheme Variable} <ghil-if> env loc test then else +The @code{src} fields are left out of the external representation. + +@deftp {Scheme Variable} <void> src +@deftpx {External Representation} (void) +An empty expression. In practice, equivalent to Scheme's @code{(if #f +#f)}. +@end deftp +@deftp {Scheme Variable} <const> src exp +@deftpx {External Representation} (const @var{exp}) +A constant. +@end deftp +@deftp {Scheme Variable} <primitive-ref> src name +@deftpx {External Representation} (primitive @var{name}) +A reference to a ``primitive''. A primitive is a procedure that, when +compiled, may be open-coded. For example, @code{cons} is usually +recognized as a primitive, so that it compiles down to a single +instruction. + +Compilation of Tree-IL usually begins with a pass that resolves some +@code{<module-ref>} and @code{<toplevel-ref>} expressions to +@code{<primitive-ref>} expressions. The actual compilation pass +has special cases for applications of certain primitives, like +@code{apply} or @code{cons}. +@end deftp +@deftp {Scheme Variable} <lexical-ref> src name gensym +@deftpx {External Representation} (lexical @var{name} @var{gensym}) +A reference to a lexically-bound variable. The @var{name} is the +original name of the variable in the source program. @var{gensym} is a +unique identifier for this variable. +@end deftp +@deftp {Scheme Variable} <lexical-set> src name gensym exp +@deftpx {External Representation} (set! (lexical @var{name} @var{gensym}) @var{exp}) +Sets a lexically-bound variable. +@end deftp +@deftp {Scheme Variable} <module-ref> src mod name public? +@deftpx {External Representation} (@@ @var{mod} @var{name}) +@deftpx {External Representation} (@@@@ @var{mod} @var{name}) +A reference to a variable in a specific module. @var{mod} should be +the name of the module, e.g. @code{(guile-user)}. + +If @var{public?} is true, the variable named @var{name} will be looked +up in @var{mod}'s public interface, and serialized with @code{@@}; +otherwise it will be looked up among the module's private bindings, +and is serialized with @code{@@@@}. +@end deftp +@deftp {Scheme Variable} <module-set> src mod name public? exp +@deftpx {External Representation} (set! (@@ @var{mod} @var{name}) @var{exp}) +@deftpx {External Representation} (set! (@@@@ @var{mod} @var{name}) @var{exp}) +Sets a variable in a specific module. +@end deftp +@deftp {Scheme Variable} <toplevel-ref> src name +@deftpx {External Representation} (toplevel @var{name}) +References a variable from the current procedure's module. +@end deftp +@deftp {Scheme Variable} <toplevel-set> src name exp +@deftpx {External Representation} (set! (toplevel @var{name}) @var{exp}) +Sets a variable in the current procedure's module. +@end deftp +@deftp {Scheme Variable} <toplevel-define> src name exp +@deftpx {External Representation} (define (toplevel @var{name}) @var{exp}) +Defines a new top-level variable in the current procedure's module. +@end deftp +@deftp {Scheme Variable} <conditional> src test then else +@deftpx {External Representation} (if @var{test} @var{then} @var{else}) A conditional. Note that @var{else} is not optional. @end deftp -@deftp {Scheme Variable} <ghil-and> env loc . exps -Like Scheme's @code{and}. -@end deftp -@deftp {Scheme Variable} <ghil-or> env loc . exps -Like Scheme's @code{or}. -@end deftp -@deftp {Scheme Variable} <ghil-begin> env loc . body -Like Scheme's @code{begin}. -@end deftp -@deftp {Scheme Variable} <ghil-bind> env loc vars exprs . body -Like a deconstructed @code{let}: each element of @var{vars} will be -bound to the corresponding GHIL expression in @var{exprs}. - -Note that for purposes of the serialization format, @var{exprs} are -evaluated before the new bindings are added to the environment. For -@code{letrec} semantics, there also exists a @code{bindrec} parse -flavor. This is useful for writing GHIL at the REPL, but the -serializer does not currently have the cleverness needed to determine -whether a @code{<ghil-bind>} has @code{let} or @code{letrec} -semantics, and thus only serializes @code{<ghil-bind>} as @code{bind}. -@end deftp -@deftp {Scheme Variable} <ghil-mv-bind> env loc vars rest producer . body -Like Scheme's @code{receive} -- binds the values returned by -applying @code{producer}, which should be a thunk, to the -@code{lambda}-like bindings described by @var{vars} and @var{rest}. -@end deftp -@deftp {Scheme Variable} <ghil-lambda> env loc vars rest meta . body -A closure. @var{vars} is the argument list, serialized as a list of -symbols. @var{rest} is a boolean, which is @code{#t} iff the last -argument is a rest argument. @var{meta} is an association list of -properties. The actual @var{body} should be a list of GHIL -expressions. -@end deftp -@deftp {Scheme Variable} <ghil-call> env loc proc . args +@deftp {Scheme Variable} <application> src proc args +@deftpx {External Representation} (apply @var{proc} . @var{args}) A procedure call. @end deftp -@deftp {Scheme Variable} <ghil-mv-call> env loc producer consumer -Like Scheme's @code{call-with-values}. -@end deftp -@deftp {Scheme Variable} <ghil-inline> env loc op . args -An inlined VM instruction. @var{op} should be the instruction name as -a symbol, and @var{args} should be its arguments, as GHIL expressions. -@end deftp -@deftp {Scheme Variable} <ghil-values> env loc . values -Like Scheme's @code{values}. -@end deftp -@deftp {Scheme Variable} <ghil-values*> env loc . values -@var{values} are as in the Scheme expression, @code{(apply values . -@var{vals})}. -@end deftp -@deftp {Scheme Variable} <ghil-reified-env> env loc -Produces, at run-time, a reification of the environment at compile -time. Used in the implementation of Scheme's -@code{compile-time-environment}. +@deftp {Scheme Variable} <sequence> src exps +@deftpx {External Representation} (begin . @var{exps}) +Like Scheme's @code{begin}. @end deftp - -GHIL implements a compiler to GLIL that recursively traverses GHIL -expressions, writing out GLIL expressions into a linear list. The -compiler also keeps some state as to whether the current expression is -in tail context, and whether its value will be used in future -computations. This state allows the compiler not to emit code for -constant expressions that will not be used (e.g. docstrings), and to -perform tail calls when in tail position. - -Just as the Scheme to GHIL compiler introduced new hidden state---the -environment---the GHIL to GLIL compiler introduces more state, the -stack. While not represented explicitly, the stack is present in the -compilation of each GHIL expression: compiling a GHIL expression -should leave the run-time value stack in the same state. For example, -if the intermediate value stack has two elements before evaluating an -@code{if} expression, it should have two elements after that -expression. +@deftp {Scheme Variable} <lambda> src names vars meta body +@deftpx {External Representation} (lambda @var{names} @var{vars} @var{meta} @var{body}) +A closure. @var{names} is original binding form, as given in the +source code, which may be an improper list. @var{vars} are gensyms +corresponding to the @var{names}. @var{meta} is an association list of +properties. The actual @var{body} is a single Tree-IL expression. +@end deftp +@deftp {Scheme Variable} <let> src names vars vals exp +@deftpx {External Representation} (let @var{names} @var{vars} @var{vals} @var{exp}) +Lexical binding, like Scheme's @code{let}. @var{names} are the +original binding names, @var{vars} are gensyms corresponding to the +@var{names}, and @var{vals} are Tree-IL expressions for the values. +@var{exp} is a single Tree-IL expression. +@end deftp +@deftp {Scheme Variable} <letrec> src names vars vals exp +@deftpx {External Representation} (letrec @var{names} @var{vars} @var{vals} @var{exp}) +A version of @code{<let>} that creates recursive bindings, like +Scheme's @code{letrec}. +@end deftp + +@c FIXME -- need to revive this one +@c @deftp {Scheme Variable} <ghil-mv-bind> src vars rest producer . body +@c Like Scheme's @code{receive} -- binds the values returned by +@c applying @code{producer}, which should be a thunk, to the +@c @code{lambda}-like bindings described by @var{vars} and @var{rest}. +@c @end deftp + +Tree-IL implements a compiler to GLIL that recursively traverses +Tree-IL expressions, writing out GLIL expressions into a linear list. +The compiler also keeps some state as to whether the current +expression is in tail context, and whether its value will be used in +future computations. This state allows the compiler not to emit code +for constant expressions that will not be used (e.g. docstrings), and +to perform tail calls when in tail position. + +In the future, there will be a pass at the beginning of the +Tree-IL->GLIL compilation step to perform inlining, copy propagation, +dead code elimination, and constant folding. Interested readers are encouraged to read the implementation in -@code{(language ghil compile-glil)} for more details. +@code{(language tree-il compile-glil)} for more details. @node GLIL @subsection GLIL Guile Low Intermediate Language (GLIL) is a structured intermediate -language whose expressions closely mirror the functionality of Guile's -VM instruction set. +language whose expressions more closely approximate Guile's VM +instruction set. Its expression types are defined in @code{(language glil)}, and as with GHIL, some of its fields parse as rest arguments. @@ -499,8 +420,8 @@ A unit of code that at run-time will correspond to a compiled procedure. @var{nargs} @var{nrest} @var{nlocs}, and @var{nexts} collectively define the program's arity; see @ref{Compiled Procedures}, for more information. @var{meta} should be an alist of -properties, as in @code{<ghil-lambda>}. @var{body} is a list of GLIL -expressions. +properties, as in Tree IL's @code{<lambda>}. @var{body} is a list of +GLIL expressions. @end deftp @deftp {Scheme Variable} <glil-bind> . vars An advisory expression that notes a liveness extent for a set of @@ -534,24 +455,23 @@ offset within a VM program. @end deftp @deftp {Scheme Variable} <glil-source> loc Records source information for the preceding expression. @var{loc} -should be a vector, @code{#(@var{line} @var{column} @var{filename})}. +should be an association list of containing @code{line} @code{column}, +and @code{filename} keys, e.g. as returned by +@code{source-properties}. @end deftp @deftp {Scheme Variable} <glil-void> Pushes the unspecified value on the stack. @end deftp @deftp {Scheme Variable} <glil-const> obj Pushes a constant value onto the stack. @var{obj} must be a number, -string, symbol, keyword, boolean, character, or a pair or vector or -list thereof, or the empty list. -@end deftp -@deftp {Scheme Variable} <glil-argument> op index -Accesses an argument on the stack. If @var{op} is @code{ref}, the -argument is pushed onto the stack; if it is @code{set}, the argument -is set from the top value on the stack, which is popped off. +string, symbol, keyword, boolean, character, the empty list, or a pair +or vector of constants. @end deftp @deftp {Scheme Variable} <glil-local> op index -Like @code{<glil-argument>}, but for local variables. @xref{Stack -Layout}, for more information. +Accesses a lexically bound variable from the stack. If @var{op} is +@code{ref}, the value is pushed onto the stack; if it is @code{set}, +the variable is set from the top value on the stack, which is popped +off. @xref{Stack Layout}, for more information. @end deftp @deftp {Scheme Variable} <glil-external> op depth index Accesses a heap-allocated variable, addressed by @var{depth}, the nth @@ -563,8 +483,8 @@ Accesses a toplevel variable. @var{op} may be @code{ref}, @code{set}, or @code{define}. @end deftp @deftp {Scheme Variable} <glil-module> op mod name public? -Accesses a variable within a specific module. See -@code{ghil-var-at-module!}, for more information. +Accesses a variable within a specific module. See Tree-IL's +@code{<module-ref>}, for more information. @end deftp @deftp {Scheme Variable} <glil-label> label Creates a new label. @var{label} can be any Scheme value, and should @@ -607,23 +527,143 @@ Just as in all of Guile's compilers, an environment is passed to the GLIL-to-object code compiler, and one is returned as well, along with the object code. -@node Object Code -@subsection Object Code +@node Assembly +@subsection Assembly + +Assembly is an S-expression-based, human-readable representation of +the actual bytecodes that will be emitted for the VM. As such, it is a +useful intermediate language both for compilation and for +decompilation. -Object code is the serialization of the raw instruction stream of a -program, ready for interpretation by the VM. Procedures related to -object code are defined in the @code{(system vm objcode)} module. +Besides the fact that it is not a record-based language, assembly +differs from GLIL in four main ways: + +@itemize +@item Labels have been resolved to byte offsets in the program. +@item Constants inside procedures have either been expressed as inline +instructions, and possibly cached in object arrays. +@item Procedures with metadata (source location information, liveness +extents, procedure names, generic properties, etc) have had their +metadata serialized out to thunks. +@item All expressions correspond directly to VM instructions -- i.e., +there is no @code{<glil-local>} which can be a ref or a set. +@end itemize + +Assembly is isomorphic to the bytecode that it compiles to. You can +compile to bytecode, then decompile back to assembly, and you have the +same assembly code. + +The general form of assembly instructions is the following: + +@lisp +(@var{inst} @var{arg} ...) +@end lisp + +The @var{inst} names a VM instruction, and its @var{arg}s will be +embedded in the instruction stream. The easiest way to see assembly is +to play around with it at the REPL, as can be seen in this annotated +example: + +@example +scheme@@(guile-user)> (compile '(lambda (x) (+ x x)) #:to 'assembly) +(load-program 0 0 0 0 + () ; Labels + 60 ; Length + #f ; Metadata + (make-false) ; object table for the returned lambda + (nop) + (nop) ; Alignment. Since assembly has already resolved its labels + (nop) ; to offsets, and programs must be 8-byte aligned since their + (nop) ; object code is mmap'd directly to structures, assembly + (nop) ; has to have the alignment embedded in it. + (nop) + (load-program 1 0 0 0 + () + 6 + ; This is the metadata thunk for the returned procedure. + (load-program 0 0 0 0 () 21 #f + (load-symbol "x") ; Name and liveness extent for @code{x}. + (make-false) + (make-int8:0) ; Some instruction+arg combinations + (make-int8:0) ; have abbreviations. + (make-int8 6) + (list 0 5) + (list 0 1) + (make-eol) + (list 0 2) + (return)) + ; And here, the actual code. + (local-ref 0) + (local-ref 0) + (add) + (return)) + ; Return our new procedure. + (return)) +@end example + +Of course you can switch the REPL to assembly and enter in assembly +S-expressions directly, like with other languages, though it is more +difficult, given that the length fields have to be correct. + +@node Bytecode and Objcode +@subsection Bytecode and Objcode + +Finally, the raw bytes. There are actually two different ``languages'' +here, corresponding to two different ways to represent the bytes. + +``Bytecode'' represents code as uniform byte vectors, useful for +structuring and destructuring code on the Scheme level. Bytecode is +the next step down from assembly: + +@example +scheme@@(guile-user)> (compile '(+ 32 10) #:to 'assembly) +@result{} (load-program 0 0 0 0 () 6 #f + (make-int8 32) (make-int8 10) (add) (return)) +scheme@@(guile-user)> (compile '(+ 32 10) #:to 'bytecode) +@result{} #u8(0 0 0 0 6 0 0 0 0 0 0 0 10 32 10 10 100 48) +@end example + +``Objcode'' is bytecode, but mapped directly to a C structure, +@code{struct scm_objcode}: + +@example +struct scm_objcode @{ + scm_t_uint8 nargs; + scm_t_uint8 nrest; + scm_t_uint8 nlocs; + scm_t_uint8 nexts; + scm_t_uint32 len; + scm_t_uint32 metalen; + scm_t_uint8 base[0]; +@}; +@end example + +As one might imagine, objcode imposes a minimum length on the +bytecode. Also, the multibyte fields are in native endianness, which +makes objcode (and bytecode) system-dependent. Indeed, in the short +example above, all but the last 5 bytes were the program's header. + +Objcode also has a couple of important efficiency hacks. First, +objcode may be mapped directly from disk, allowing compiled code to be +loaded quickly, often from the system's disk cache, and shared among +multiple processes. Secondly, objcode may be embedded in other +objcode, allowing procedures to have the text of other procedures +inlined into their bodies, without the need for separate allocation of +the code. Of course, the objcode object itself does need to be +allocated. + +Procedures related to objcode are defined in the @code{(system vm +objcode)} module. @deffn {Scheme Procedure} objcode? obj @deffnx {C Function} scm_objcode_p (obj) Returns @code{#f} iff @var{obj} is object code, @code{#f} otherwise. @end deffn -@deffn {Scheme Procedure} bytecode->objcode bytecode nlocs nexts -@deffnx {C Function} scm_bytecode_to_objcode (bytecode, nlocs, nexts) +@deffn {Scheme Procedure} bytecode->objcode bytecode +@deffnx {C Function} scm_bytecode_to_objcode (bytecode,) Makes a bytecode object from @var{bytecode}, which should be a -@code{u8vector}. @var{nlocs} and @var{nexts} denote the number of -stack and heap variables to reserve when this objcode is executed. +@code{u8vector}. @end deffn @deffn {Scheme Variable} load-objcode file @@ -631,21 +671,28 @@ stack and heap variables to reserve when this objcode is executed. Load object code from a file named @var{file}. The file will be mapped into memory via @code{mmap}, so this is a very fast operation. -On disk, object code has an eight-byte cookie prepended to it, so that -we will not execute arbitrary garbage. In addition, two more bytes are -reserved for @var{nlocs} and @var{nexts}. +On disk, object code has an eight-byte cookie prepended to it, to +prevent accidental loading of arbitrary garbage. +@end deffn + +@deffn {Scheme Variable} write-objcode objcode file +@deffnx {C Function} scm_write_objcode (objcode) +Write object code out to a file, prepending the eight-byte cookie. @end deffn @deffn {Scheme Variable} objcode->u8vector objcode @deffnx {C Function} scm_objcode_to_u8vector (objcode) -Copy object code out to a @code{u8vector} for analysis by Scheme. The -ten-byte header is included. +Copy object code out to a @code{u8vector} for analysis by Scheme. @end deffn -@deffn {Scheme Variable} objcode->program objcode [external='()] -@deffnx {C Function} scm_objcode_to_program (objcode, external) +The following procedure is actually in @code{(system vm program)}, but +we'll mention it here: + +@deffn {Scheme Variable} make-program objcode objtable [external='()] +@deffnx {C Function} scm_make_program (objcode, objtable, external) Load up object code into a Scheme program. The resulting program will -be a thunk that captures closure variables from @var{external}. +have @var{objtable} as its object table, which should be a vector or +@code{#f}, and will capture the closure variables from @var{external}. @end deffn Object code from a file may be disassembled at the REPL via the @@ -689,7 +736,7 @@ fruit, running programs of interest under a system-level profiler and determining which improvements would give the most bang for the buck. There are many well-known efficiency hacks in the literature: Dybvig's letrec optimization, individual boxing of heap-allocated values (and -then store the boxes on the stack directory), optimized case-lambda +then store the boxes on the stack directly), optimized case-lambda expressions, stack underflow and overflow handlers, etc. Highly recommended papers: Dybvig's HOCS, Ghuloum's compiler paper. |