diff --git a/src/CHANGELOG b/src/CHANGELOG index 392769319..c163e4f5c 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -796,6 +796,34 @@ ECLS 0.4 - Implemented WITH-STANDARD-IO-SYNTAX. +ECLS 0.5 +======== + +* System design and portability: + + - Remove function_entry_table. + +* Visible changes and ANSI compatibility: + + - The value of *package* is correctly set and restored while loading + compiled code. This way, 'ecls -eval "(print *package*)"' produces + the expected result #<"COMMON-LISP-USER" package> + + - COMPILE-FILE now outputs three values. + + - The value of si::*keep-definitions* determines whether the + interpreter keeps the source of defined functions, for later use + with COMPILE and DISASSEMBLE. For instance, + > (set si::*keep-definitions* t) + > (defun foo (x) (1+ x)) + > (compile 'foo) + > (foo 2) + 3 + > (compile 'foo) + ;;; Error .... + These definitions are lost once the function is compiled, hence + the second error message. + TODO: ===== diff --git a/src/c/all_functions.d b/src/c/all_functions.d index b9a9468ca..2eeea5a84 100644 --- a/src/c/all_functions.d +++ b/src/c/all_functions.d @@ -92,6 +92,7 @@ const struct function_info all_functions[] = { {"COMPILED-FUNCTION-NAME", siLcompiled_function_name, si}, {"COMPILED-FUNCTION-BLOCK", siLcompiled_function_block, si}, + {"COMPILED-FUNCTION-SOURCE", siLcompiled_function_source, si}, /* character.d */ @@ -144,9 +145,6 @@ const struct function_info all_functions[] = { /* error.c */ -#if defined(FRAME_CHAIN) && !defined(RUNTIME) - {"BT", siLbacktrace, si}, -#endif {"ERROR", clLerror, cl}, {"CERROR", clLcerror, cl}, diff --git a/src/c/all_symbols.d b/src/c/all_symbols.d index c3c6f28c6..4861ce1bd 100644 --- a/src/c/all_symbols.d +++ b/src/c/all_symbols.d @@ -39,6 +39,7 @@ const struct symbol_info all_symbols[] = { /* compiler.c */ {&clSlambda_block, "LAMBDA-BLOCK", CL_ORDINARY}, +{&siVkeep_definitions, "*KEEP-DEFINITIONS*", SI_SPECIAL}, /* conditional.c */ {&clSotherwise, "OTHERWISE", CL_ORDINARY}, diff --git a/src/c/cfun.d b/src/c/cfun.d index ac7302359..1f8505ada 100644 --- a/src/c/cfun.d +++ b/src/c/cfun.d @@ -21,8 +21,6 @@ cl_object @'defun', @'defmacro'; #endif PDE -static void record_fun_entry (cl_object sym, void *addr); - cl_object make_cfun(cl_object (*self)(), cl_object name, cl_object cblock) { @@ -57,9 +55,6 @@ MF(cl_object sym, cl_object (*self)(), cl_object block) if (sym->symbol.isform && sym->symbol.mflag) sym->symbol.isform = FALSE; clear_compiler_properties(sym); -#ifndef RUNTIME - record_fun_entry(sym, self); -#endif #ifdef PDE record_source_pathname(sym, @'defun'); #endif PDE @@ -81,9 +76,6 @@ MM(cl_object sym, cl_object (*self)(), cl_object block) if (sym->symbol.isform && sym->symbol.mflag) sym->symbol.isform = FALSE; clear_compiler_properties(sym); -#ifndef RUNTIME - record_fun_entry(sym, self); -#endif #ifdef PDE record_source_pathname(sym, @'defmacro'); #endif PDE @@ -103,9 +95,6 @@ make_function(char *s, cl_object (*f)()) x = make_ordinary(s); SYM_FUN(x) = make_cfun(f, x, NULL); x->symbol.mflag = FALSE; -#ifndef RUNTIME - record_fun_entry(x, f); -#endif return(x); } @@ -117,9 +106,6 @@ make_si_function(char *s, cl_object (*f)()) x = make_si_ordinary(s); SYM_FUN(x) = make_cfun(f, x, NULL); x->symbol.mflag = FALSE; -#ifndef RUNTIME - record_fun_entry(x, f); -#endif return(x); } @@ -139,6 +125,27 @@ make_si_function(char *s, cl_object (*f)()) @(return output) @) +@(defun si::compiled_function_source (fun) + cl_object output; +@ + switch(type_of(fun)) { + case t_bytecodes: + if (!Null(fun->bytecodes.lex)) + output = Cnil; + else { + output = fun->bytecodes.data[fun->bytecodes.size-1]; + if (!CONSP(output)) output = Cnil; + } + break; + case t_cfun: + case t_cclosure: + output = Cnil; break; + default: + FEerror("~S is not a compiled-function.", 1, fun); + } + @(return output) +@) + @(defun si::compiled_function_block (fun) cl_object output; @ @@ -152,107 +159,3 @@ make_si_function(char *s, cl_object (*f)()) } @(return output) @) - - -#ifndef RUNTIME - -#define FUN_TABLE_INC 256 -void **function_entry_table; -int function_entries_max; -int function_entries; - -/*---------------------------------------------------------------------- - * fun_entry_search -- - * function_entry_table is an array containing alternated addr, sym values - * sorted in increasing addr value. - * Result: - * the index of the largest addr which is smaller than key - * -2 if no such addr is present - *---------------------------------------------------------------------- - */ -static int -fun_entry_search(char *key) -{ - void **table = function_entry_table; - int len = function_entries; - int low = 0; - int high = len; - int mid, probe; - char *entry; - if (len == 0) - return(-2); - while (TRUE) { - mid = (low + high) / 2; - probe = mid * 2; - entry = (char *)table[probe]; - if (entry == key) - return(probe); - if (entry < key) { - if (mid + 1 == len || (char*)table[probe+2] > key) - return(probe); - else - low = mid; - } else { - if (probe == 0) - return(-2); - else - high = mid; - } - } -} - -/* - *---------------------------------------------------------------------- - * record_fun_entry -- - * records the code start of function bound to symbol, so that - * one can determine which function is executing - * - *---------------------------------------------------------------------- - */ -static void -record_fun_entry(cl_object sym, void *addr) -{ - cl_object def; - register int i, end; - - end = 2*function_entries; - def = SYM_FUN(sym); - if (def != OBJNULL && type_of(def) == t_cfun) { - /* clear previous definition */ - void *prevaddr = (void *)def->cfun.entry; - i = fun_entry_search(prevaddr); - if (i >= 0 && function_entry_table[i] == prevaddr) { - function_entries--; - end -= 2; - memmove(&function_entry_table[i], &function_entry_table[i+2], - sizeof(void *) * (end - i)); - } - } - i = fun_entry_search(addr); - if (i < 0 || function_entry_table[i] != (char*)addr) { - if (2*function_entries_max == end) { - function_entries_max += FUN_TABLE_INC; - function_entry_table = realloc(function_entry_table, - 2 * function_entries_max * sizeof(void *)); - } - i += 2; - memmove(&function_entry_table[i+2], &function_entry_table[i], - sizeof(void *) * (end - i)); - function_entries++; - } - function_entry_table[i++] = (char *)addr; - function_entry_table[i++] = (char *)sym; -} - -cl_object -get_function_entry(void *addr) -{ - int i; - i = fun_entry_search(addr); - if (i >= 0) - return((cl_object)function_entry_table[i+1]); - else - return(OBJNULL); -} - -#endif RUNTIME diff --git a/src/c/compiler.d b/src/c/compiler.d index c0cb7d692..b13e5b500 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -24,6 +24,7 @@ cl_object @'defun'; cl_object @'compile', @'load', @'eval', @'progn', @'warn', @'typep', @'otherwise'; cl_object @':execute', @':compile-toplevel', @':load-toplevel'; cl_object @'si::*inhibit-macro-special*'; +cl_object @'si::*keep-definitions*'; cl_object @'&optional'; cl_object @'&rest'; @@ -2124,6 +2125,9 @@ make_lambda(cl_object name, cl_object lambda) { compile_body(body); asm_op(OP_HALT); + if (!Null(SYM_VAL(@'si::*keep-definitions*'))) + asm1(lambda); + c_env = old_c_env; return asm_end(handle, Cnil); diff --git a/src/c/error.d b/src/c/error.d index ea0605fcd..015c9dd8e 100644 --- a/src/c/error.d +++ b/src/c/error.d @@ -327,51 +327,6 @@ not_a_variable(cl_object obj) rest)); @) -#if defined(FRAME_CHAIN) && !defined(RUNTIME) -static char * -get_current_frame(void) -{ - char *frame; - GET_CURRENT_FRAME(frame); - return frame; -} - -@(defun si::backtrace () - char *this_frame, *next_frame, *next_pc; - bool first = TRUE; - cl_object sym; - jmp_buf buf; -@ - /* ensure flushing of register caches */ - if (ecls_setjmp(buf) == 0) ecls_longjmp(buf, 1); - - this_frame = get_current_frame(); - while (TRUE) { - next_frame = FRAME_CHAIN(this_frame); - next_pc = FRAME_SAVED_PC(this_frame); -#ifdef DOWN_STACK - if (next_frame == 0 || next_frame > (char *)cs_org) break; -#else - if (next_frame < (char *)cs_org) break; -#endif - sym = (cl_object)get_function_entry(next_pc); - if (sym) { - if (!first) - printf(" < "); - else - first = FALSE; - princ(sym, Cnil); - } -/* - else - printf("FP: 0x%x, PC: 0x%x\n", next_frame, next_pc); -*/ - this_frame = next_frame; - } - @(return) -@) -#endif - void init_error(void) { diff --git a/src/c/init.d b/src/c/init.d index 34c2b965b..537d22681 100644 --- a/src/c/init.d +++ b/src/c/init.d @@ -23,9 +23,6 @@ extern void init_CLOS(); void init_lisp(void) { -#ifndef RUNTIME - function_entry_table = (void *)malloc(2 * function_entries_max * sizeof(void *)); -#endif init_symbol(); init_package(); diff --git a/src/c/read.d b/src/c/read.d index 5f84b8f30..22e0a4452 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -2318,9 +2318,7 @@ read_VV(cl_object block, void *entry) entry_point_ptr entry_point = entry; cl_object *VV; int len; -#ifdef PDE bds_ptr old_bds_top = bds_top; -#endif if (block == NULL) block = alloc_object(t_codeblock); @@ -2341,7 +2339,7 @@ read_VV(cl_object block, void *entry) old_backq_level = backq_level; old_package = SYM_VAL(@'*package*'); - SYM_VAL(@'*package*') = lisp_package; + bds_bind(@'*package*', lisp_package); setup_standard_READ(); @@ -2377,9 +2375,7 @@ read_VV(cl_object block, void *entry) close_stream(in, 0); read_VV_block = OBJNULL; -#ifdef PDE bds_unwind(old_bds_top); -#endif READtable = old_READtable; READdefault_float_format = old_READdefault_float_format; diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index 16e3e251c..45d04a1de 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -172,7 +172,7 @@ main(int argc, char **argv) Cannot compile ~a." (namestring input-pathname)) (setq *error-p* t) - (return-from compile-file (values))) + (return-from compile-file (values nil t t))) (setq *error-p* nil *compiler-in-use* t) @@ -181,7 +181,7 @@ Cannot compile ~a." (format t "~&;;; The source file ~a is not found.~%" (namestring input-pathname)) (setq *error-p* t) - (return-from compile-file (values))) + (return-from compile-file (values nil t t))) (when *compile-verbose* (format t "~&;;; Compiling ~a." @@ -277,7 +277,7 @@ Cannot compile ~a." #+dlopen (if system-p o-pathname so-pathname) #-dlopen - o-pathname) + (values o-pathname nil nil)) (progn (when (probe-file c-pathname) (delete-file c-pathname)) @@ -286,7 +286,7 @@ Cannot compile ~a." (when (probe-file o-pathname) (delete-file o-pathname)) (format t "~&;;; No FASL generated.~%") (setq *error-p* t) - (values)) + (values nil t t)) )) ) @@ -327,29 +327,9 @@ Cannot compile ~a." `(defun ,name ,@(cdr def)) `(set 'GAZONK #',def)))) ((and (fboundp name) - (consp (setq def (symbol-function name)))) - (cond ((and (eq (car def) 'LAMBDA-BLOCK) - (consp (cdr def)) (consp (cddr def))) - (if (eq (cadr def) name) - (setq form `(defun ,name ,@(cddr def))) - (setq form `(defun ,name ,(caddr def) - (block ,(cadr def) ,@(cdddr def)))))) - ((eq (car def) 'LAMBDA) - (setq form `(defun ,name ,@(cdr def)))) - ((and (eq (car def) 'LAMBDA-CLOSURE) - (consp (cdr def)) (null (cadr def)) - (consp (cddr def)) (null (caddr def)) - (consp (cdddr def)) (null (cadddr def))) - (setq form `(defun ,name ,@(cddddr def)))) - ((and (eq (car def) 'LAMBDA-BLOCK-CLOSURE) - (consp (cdr def)) (null (cadr def)) - (consp (cddr def)) (null (caddr def)) - (consp (cdddr def)) (null (cadddr def)) - (consp (cddddr def))) - (setq form `(defun ,name - (block ,(car (cddddr def)) - ,@(cdr (cddddr def)))))) - (t (error "I cannot compile such ~Ss, sorry." (car def))))) + (setq def (symbol-function name)) + (setq form (si::compiled-function-source def))) + (setq form `(defun ,name ,@form))) (t (error "No lambda expression is assigned to the symbol ~s." name))) (dotimes (n 1000 @@ -420,28 +400,31 @@ Cannot compile ~a." &aux def disassembled-form (*compiler-in-use* *compiler-in-use*) (*print-pretty* nil)) - (when *compiler-in-use* - (format t "~&;;; The compiler was called recursively.~ - ~%Cannot disassemble ~a." thing) - (setq *error-p* t) - (return-from disassemble)) - (setq *error-p* nil - *compiler-in-use* t) - - (cond ((null thing)) - ((symbolp thing) - (setq def (symbol-function thing)) - (when (macro-function thing) - (setq def (cdr def))) - (if (and (consp def) - (eq (car def) 'LAMBDA-BLOCK) - (consp (cdr def))) - (setq disassembled-form `(defun ,thing ,@(cddr def))) - (error "The function object ~s cannot be disassembled." def))) - ((and (consp thing) (eq (car thing) 'LAMBDA)) - (setq disassembled-form `(defun gazonk ,@(cdr thing)))) + (cond ((null thing)) + ((symbolp thing) + (setq def (symbol-function thing)) + (when (macro-function thing) + (setq def (cdr def))) + (return-from disassemble (disassemble def))) + ((functionp thing) + (if (setq def (si::compiled-function-source thing)) + (setq disassembled-form + `(defun ,(or (si::compiled-function-name thing) + GAZONK) + ,@def)) + (error "The function definition for ~S was lost." thing))) + ((and (consp thing) (eq (car thing) 'LAMBDA)) + (setq disassembled-form `(defun gazonk ,@(cdr thing)))) (t (setq disassembled-form thing))) + (when *compiler-in-use* + (format t "~&;;; The compiler was called recursively.~ + ~%Cannot disassemble ~a." thing) + (setq *error-p* t) + (return-from disassemble)) + (setq *error-p* nil + *compiler-in-use* t) + (let* ((null-stream (make-broadcast-stream)) (*compiler-output1* null-stream) (*compiler-output2* (if h-file diff --git a/src/doc/head b/src/doc/head index 6ead8721f..8bff7f1da 100644 --- a/src/doc/head +++ b/src/doc/head @@ -25,6 +25,7 @@ User's guide Benchmarks Distribution + Mailing list Browse CVS diff --git a/src/doc/user.txi b/src/doc/user.txi index 598240cd0..4f647d53b 100644 --- a/src/doc/user.txi +++ b/src/doc/user.txi @@ -136,13 +136,8 @@ Copyright @copyright{} 2000, Juan Jose Garcia Ripoll @ecls{} is an implementation of @clisp{} originally designed for being @emph{embeddable} into C based applications. - This document describes the @ecls{} implementation and how it differs from -@bibcite{ANSI} and @bibcite{Steele:84}. In general, as work in @ecls{} is -completed section by section, we will drop compatibility with -@bibcite{Steele:84} and the corresponding chapter will be updated to document -@emph{only} the differences with @bibcite{ANSI}. - +@bibcite{ANSI} and @bibcite{Steele:84}. This manual also documents some implementation facilities, such as the multithread facility of @ecls{} or the foreign function interface. And finally this manual is the main source of information to understand @@ -1182,56 +1177,31 @@ There are no implementation-dependent features for structures. @node Functions, Unreadable data objects, Structures, Standards @section Functions -@table @code -@item (lambda @var{lambda-list} . body) -A lambda-expression with null lexical environment and with no implicit block -around it. This type of function typically appears when @code{`(lambda -@var{lambda-list} . body)} is evaluated. - -@item (lambda-block @var{block-name lambda-list} . body) -A lambda-expression with null lexical environment but with an implicit block -around it. This type of function typically appears when @code{(defun -@var{function-name lambda-list} . body)} is evaluated. In this case, -@var{block-name} is identical to @var{function-name} . - -@item (lambda-closure @var{env1 env2 env3 lambda-list} . body) - -A lambda-expression with lexical environments but with no implicit block around -it. This type of function typically appears when @code{#`(lambda -@var{lambda-list} . body)} (or, equivalently, @code{(function (lambda -@var{lambda-list} . body))}) is evaluated. @var{env1}, @var{env2}, and -@var{env3} represent the variable bindings, the local function/macro -definitions, and the tag/block-name establishments, respectively, at the time -the closure was created. - -@item (lambda-block-closure @var{env1 env2 env3 block-name lambda-list} . body) - -A lambda-expression with lexical environments and with an implicit block around -it. Local functions and local macros are represented in this -format. @var{env1}, @var{env2}, and @var{env3} represent the variable bindings, -the local function/macro bindings, and the tag/block-name establishments, -respectively, at the time the local function/macro was created by @code{flet}, -@code{labels}, or @code{macrolet}. The @var{block-name} is identical to the -local function/macro name. -@end table - -Compiled functions (including compiled macro-expansion functions) are printed -in the following formats. - +All functions in @ecls{} are either compiled into bytecodes to be interpreted, +or they are translated into C and then compiled using a native C compiler. +Interpreted functions are printed using the formats +@example +# +# +@end example +@noindent Compiled functions (including compiled macro-expansion functions) +are printed in the following formats. @example # -@end example -or -@example # @end example -Incidentally, the value of @code{(symbol-function @var{special-form-name})} is -a list, -@example -(special . @var{address}) -@end example -@noindent if @var{special-form-name} names a special form. +The output of @code{(symbol-function @var{fun})} is a list, is either a +function object if @code{'fun} is has a function definition, +@code{(macro . function-object)} if @code{'fun} is a macro, and @code{'special} +if @code{'fun} is a special form. + +@ecls{} usually drops the source code of a function unless the global +variable @var{si:*keep-definitions*} was true when the function was +translated into bytecodes. Therefore, if you wish to use +@code{#'compile} and @code{#'disassemble} on defined functions, you +should issue @code{(setq si:*keep-definitions* t)} at the beginning of +your session. @clisp{} constants related to functions have the following values in @ecls{}. @@ -2539,17 +2509,52 @@ If @var{package} is @nil{}, then all packages are searched. @node The interpreter, The compiler, Program development, Top @chapter The Interpreter +Former versions of @ecls{}, as well as many other lisps, used linked lists to +represent code. As of version 0.3 a bytecodes compiler and a bytecodes +interpreter were developed to circumvent the limitations of linked lists. + When you enter code at the lisp prompt, or when you load a source file, @ecls{} begins a process known as minimal compilation. Barely this process consists on parsing each form, macroexpanding it and translating it into an intermediate language made of @emph{bytecodes}. -@menu -* The bytecodes:: -@end menu +The bytecodes compiler is implemented in @file{src/c/compiler.d}. The main +entry point is the lisp function @code{SI::MAKE-LAMBDA}, which takes a +name for the function and the body of the lambda lists, and produces a +lisp object that can be invoked. For instance, -@node The bytecodes, , The interpreter, The interpreter -@section The intermediate language +@example +> (defvar fun (si::make-lambda 'f '((x) (1+ x)))) +*FUN* +> (funcall fun 2) +3 +@end example + +@ecls{} can only execute bytecodes. When a list is passed to @code{EVAL} it +must be first compiled to bytecodes and, if the process succeeds, then the +resulting bytecodes are passed to the interpreter. Similarly, every time a +function object is created, such as in @code{DEFUN} or @code{DEFMACRO}, the +bytecodes compiler processes the lambda form to produce a suitable bytecodes +object. + +The fact that @ecls{} performs this eager compilation means that changes on +a macro are not immediately seen in code which was already compiled. This has +subtle implications. Take the following code: +@example +> (defmacro f (a b) `(+ ,a ,b)) +F +> (defun g (x y) (f x y)) +G +> (g 1 2) +3 +> (defmacro f (a b) `(- ,a ,b)) +F +> (g 1 2) +3 +@end example + +@noindent The last statement always outputs @code{3} while in former +implementations based on processing of lambda lists it would produce @code{-1}. @node The compiler, Declarations, The interpreter, Top @@ -4331,106 +4336,85 @@ that case @code{suspend} will return the values specified by @code{resume}. * @ecls{} and @clisp{}:: * @ecls{} is written in C and Lisp:: * Porting @ecls{}:: +* Extending @ecls{}:: * The @ecls{} Compiler:: * The C language interface:: -* @ecls{} size:: -* Gabriel benchmark:: @end menu @node @ecls{} and @clisp{}, @ecls{} is written in C and Lisp, Implementation details, Implementation details @section @ecls{} is a full @clisp{} system. -@ecls{} is a full implementation of the @clisp{} language described in the book - -@display -@cltl{}. -by Guy L. Steele Jr. et al. -Digital Press, 1984 -@end display - -@noindent @ecls{} supports all @clisp{} functions, macros, and special forms defined in -it, and all @clisp{} variables and constants are defined in @ecls{} exactly as -described in the @cltl{}. +@ecls{} is an implementation of the @clisp{} which aims to comply with +the @ansi{} language described in the X3J13 specification. @ecls{} +supports most @clisp{} functions, macros, and special forms defined in +that reference, and all @clisp{} variables and constants should be in +@ecls{} exactly as described in the @ansi{}. Any deviation should be +noticed to the maintainers. @node @ecls{} is written in C and Lisp, Porting @ecls{}, @ecls{} and @clisp{}, Implementation details @section @ecls{} is written in C and Lisp -The kernel of @ecls{} is written in C, including: - +@noindent The kernel of @ecls{} is written in C, including: @itemize @item memory management and garbage collection -@item the evaluator (or interpreter) -@item @clisp{} special forms +@item the bytecodes compiler and interpreter @end itemize -The @ecls{} compiler is entirely written in @clisp{}. - -Each @clisp{} function or macro is written either in C or in Lisp. - -@example - in C: - 418 @clisp{} functions - 11 @clisp{} macros - - in Lisp: - 133 @clisp{} functions - 59 @clisp{} macros -@end example - -The size of the source code is: - -@example - C code 705 Kbytes - @clisp{} functions and macros written in Lisp - 173 Kbytes - The compiler 264 Kbytes - --------------------------- - total 1142 Kbytes -@end example - -Three routines in the kernel are partly written in assembly language: - +The kernel understands all special forms from @clisp{}, and it supplies +enough functions to create and manipulate all lisp objects. @ecls{} can +start up using just the C core, as it contains enough functions to +manipulate all lisp objects. However, in order to support the most of +the @clisp{} language, @ecls{} also needs lisp implementations of @itemize -@item bignum multiplication -@item bignum division -@item function call +@item macros, +@item CLOS, and +@item the translator to C. @end itemize - -@noindent The total size of assembly code is 20 to 30 lines, depending on the -version of @ecls{}. C version of these routines are however also available. +@noindent These items are stored as lisp source, that can be either interpreter +(as during the bootstrap process) or translated to C and later compiled +(to build the final program). -@node Porting @ecls{}, The @ecls{} Compiler, @ecls{} is written in C and Lisp, Implementation details +@node Porting @ecls{}, Extending @ecls{}, @ecls{} is written in C and Lisp, Implementation details @section Porting @ecls{} To port @ecls{} to a new architecture, the following steps are required: @enumerate -@item Compile all source C code with a GCC compiler. +@item Ensure that the GNU Multiprecision library supports this machine. -@item Compile the Lisp libraries and the Lisp compiler, -supplied already translated into C, except for one file in the compiler -which contains machine dependencies. +@item Ensure that the Boehm-Weiser garbage collector is supported by that +architecture. Alternatively, port ECLS's own garbage collector +@file{src/c/alloc.d} and @file{src/c/gbc.d} to that platform. -@item Link the binaries and create an executable. +@item Fix @file{src/configure.in} and @file{src/h/machines.h} so that they +both supply flags for the new host machine. -@item Use the executable to compile the machine dependent compiler file +@item Fix the machine dependent code in @file{src/c/}. The most critical +parts are in the @file{unix*.d} files. -@item Build the full image +@item Compile as in any other platform. + +@item Run the tests and compare to the results of other platforms. @end enumerate +@node Extending @ecls{}, The @ecls{} Compiler, Porting @ecls{}, Implementation details +@section Extending @ecls{} + +If you want to extend, fix or simply customize @ecls{} for your own needs, +you should understand how the implementation works. + @menu * Objects Representation:: -* The heap:: * @ecls{} stacks:: * Procedure Call Conventions:: -* The interpreter guts:: -* The Invocation History Stack:: +* The lexical environment:: +* The interpreter stack:: @end menu -@node Objects Representation, The heap, Porting @ecls{}, Porting @ecls{} +@node Objects Representation, @ecls{} stacks, Extending @ecls{}, Extending @ecls{} @subsection Objects Representation @ecls{} supports immediate data for representing fixnum's and @@ -4449,11 +4433,6 @@ Fixnum and characters are represented as follows: |------------|------|--| @end example -A third kind of immediate data is the @code{locative}, which constains -an indirect pointer to another object. @code{locative} are useful for -the efficient representation of logical variables when implementing -unifcation or Prolog. - Other @ecls{} objects are represented as (a pointer to) a cell that is allocated on the heap. Each cell consists of several words (1 word = 32 bit) whose first half word is in the format common to all data types: @@ -4482,76 +4461,7 @@ may be represented by its fixnum value, and a character object may be represented by its character code. -@node The heap, @ecls{} stacks, Objects Representation, Porting @ecls{} -@subsection The heap - -The whole heap of @ecls{} is divided into pages (1 page = 2048 -bytes). Each page falls in one of the following classes: - -@itemize -@item pages that contain @emph{cells} consisting of the same number of words -@item pages that contain @emph{blocks} of variable size -@item pages that contain @emph{relocatable blocks}: i.e. blocks of variable size -which can be moved in memory, such as array elements. -@end itemize - -Free cells (i.e., those cells that are not used any more) consisting -of the same number of words are linked together to form a free list. -When a new cell is requested, the first cell in the free list (if it -is not empty) is used and is removed from the list. If the free list -is empty, then the garbage collector is invoked to collect unused -cells. If the new free list is too short after the garbage -collection, then new pages are allocated dynamically. Free blocks are -also linked together in the order of the size so that, when a block is -being allocated on the heap, the smallest free area that is large -enough to hold the block datum will be used. Cell pages are never -compactified. Once a page is allocated for cells with @emph{n} words, -the page is used for cells with @emph{n} words only, even after all the -cells in the page become garbage. The same rule holds for block -pages. In contrast, relocatable pages are sometimes compactified. -That is, each relocatable datum may be moved to another place. - -The actual configuration of the @ecls{} heap is: - -@example -lower address higher address - +-----------------------------+----------+---------------------+ - | cell pages and block pages | hole | relocatable pages | - +-----------------------------+----------+---------------------+ -@end example - -There is a ``hole'' between the area for cell/block pages -and the area for relocatable pages. New pages are allocated in the -hole for cell/block pages, whereas new relocatable pages are -allocated by expanding the heap to the higher address, i.e., to the -right in this figure. When the hole becomes empty, the area for -relocatable pages are shifted to the right to reserve a certain number -of pages as the hole. During this process, the relocatable data in -the relocatable pages are compactified. No free list is maintained -for relocatable data. - -Symbol print names and string bodies are usually allocated -in relocatable pages. However, when the @ecls{} system is created, i.e., -when the object module of @ecls{} is created, such relocatable data are -moved towards the area for cell/block pages and then the pages for -relocatable data are marked ``static''. The garbage collector never -tries to sweep static pages. Thus, within the object module of @ecls{}, -the heap looks like: - -@example -lower address higher address - +--------------------------------------+ - | cell/block pages and static pages | - +--------------------------------------+ -@end example - -Notice that the hole is not included in the object module; -it is allocated only when the @ecls{} system is started. This saves -secondary storage a little bit. The maximum size of the hole is about -100 pages (= 200 Kbytes). - - -@node @ecls{} stacks, Procedure Call Conventions, The heap, Porting @ecls{} +@node @ecls{} stacks, Procedure Call Conventions, Objects Representation, Extending @ecls{} @subsection @ecls{} stacks @ecls{} uses the following stacks: @@ -4563,110 +4473,111 @@ consisting of catch, block, tagbody frames @item Bind Stack for shallow binding of dynamic variables -@item Invocation History Stack -maintaining information for debugging +@item Interpreter Stack +acts as a Forth data stack, keeping intermediate arguments to +interpreted functions, plus a history of called functions. @item C Control Stack -used for: -@itemize -@item arguments/values passing -@item typed lexical variables -@item temporary values -@item function invocation -@end itemize +used for arguments/values passing, typed lexical variables, +temporary values, and function invocation. @end table -@node Procedure Call Conventions, The interpreter guts, @ecls{} stacks, Porting @ecls{} +@node Procedure Call Conventions, The lexical environment, @ecls{} stacks, Extending @ecls{} @subsection Procedure Call Conventions @ecls{} employs standard C calling conventions to achieve efficiency and interoperability with other languages. Each Lisp function is implemented as a C function whcih takes as many argument as the Lisp original plus one additional integer argument -which holds the number of actual arguments. The function returns an -integer which is the number of multiple Lisp values produced. The actual vales -themselves are placed in a global (per thread) array (@code{VALUES}). +which holds the number of actual arguments. The function sets @code{NValues} +to the number of Lisp values produced, it returns the first one and the +remaining ones are kept in a global (per thread) array (@code{VALUES}). To show the argument/value passing mechanism, here we list the actual code for the @clisp{} function @code{cons}. @example -Lcons(int narg, object car, object cdr) +clLcons(int narg, object car, object cdr) @{ object x; check_arg(2); x = alloc_object(t_cons); CAR(x) = car; CDR(x) = cdr; - VALUES(0) = x; - RETURN(1); + NValues = 1; + return x; @} @end example -@ecls{} adopts the convention that the name of a function that -implements a @clisp{} function begins with @code{L}, followed by the -name of the @clisp{} function. (Strictly speaking, `@code{-}' and -`@code{*}' in the @clisp{} function name are replaced by `@code{_}' and -`@code{A}', respectively, to obey the syntax of C.) +@ecls{} adopts the convention that the name of a function that implements a +@clisp{} function begins with a short package name (@code{cl} for COMMON-LISP, +@code{si} for SYSTEM, etc), followed by @code{L}, and followed by the name of +the @clisp{} function. (Strictly speaking, `@code{-}' and `@code{*}' in the +@clisp{} function name are replaced by `@code{_}' and `@code{A}', respectively, +to obey the syntax of C.) -@code{check_arg(2)} in the code of @code{Lcons} checks that exactly two +@code{check_arg(2)} in the code of @code{clLcons} checks that exactly two arguments are supplied to @code{cons}. That is, it checks that @code{narg} is 2, and otherwise, it causes an error. @code{allocate_object(t_cons)} allocates a cons cell in the heap and returns the pointer to the cell. After the @code{CAR} and the @code{CDR} fields of the cell are set, the cell pointer is -put in the @code{VALUES} array. The integer returned by the function (1 in this -case) represents the number of values of the function. +returned directly. The number assigned to NValues set by the function (1 in +this case) represents the number of values of the function. +In general, if one is to play with the C kernel of @ecls{} there is no need to +know about all these conventions. There is a preprocessor that takes care of +the details, by using a lispy representation of the statements that output +values, and of the function definitions. For instance, the actual source code +for @code{clLcons} in @file{src/c/lists.d} -@node The interpreter guts, The Invocation History Stack, Procedure Call Conventions, Porting @ecls{} -@subsection The interpreter +@example +@@(defun cons (car cdr) +@@ + @@(return CONS(car, cdr)) +@@) +@end example -The @ecls{} interpreter uses three A-lists (Association lists) to +@node The lexical environment, The interpreter stack, Procedure Call Conventions, Extending @ecls{} +@subsection The lexical environment + +The @ecls{} interpreter uses two A-lists (Association lists) to represent lexical environments. @itemize @item One for variable bindings -@item One for local function/macro definitions -@item One for tag/block bindings +@item One for local function/macro/tag/block bindings @end itemize -When a function closure is created, the current three A-lists are +When a function closure is created, the current two A-lists are saved in the closure along with the lambda expression. Later, when the closure is invoked, the saved A-lists are used to recover the lexical environment. -@node The Invocation History Stack, , The interpreter guts, Porting @ecls{} -@subsection The Invocation History Stack +@node The interpreter stack, , The lexical environment, Extending @ecls{} +@subsection The interpreter stack -The invocation history stack consists of two kinds of elements. Each element -may be either a pair of a Lisp form and a pointer to lexical environment: +The bytecodes interpreter uses a stack of its own to save and restore values +from intermediate calculations. This Forth-like data stack is also used in +other parts of the C kernel for various purposes, such as saving compiled code, +keeping arguments to FORMAT, etc. +However, one of the most important roles of the Interpreter Stack is to keep a +log of the functions which are called during the execution of bytecodes. For +each function invoked, the interpreter keeps three lisp objects on the stack: @example -+----------+------------------------+ -| form | environment-pointer | -+----------+------------------------+ ++----------+------------------------------------------------+ +| function | lexical environment | index to previous record | ++----------+---------------------+--------------------------+ @end example -@noindent or a pair of a function name and a pointer to the value stack: +The first item is the object which is funcalled. It can be a bytecodes object, +a compiled function or a generic function. In the last two cases the lexical +environment is just NIL. In the first case, the second item on the stack is +the lexical environment on which the code is executed. Each of these records +are popped out of the stack after function invocation. -@example -+-----------------+-----------------+ -| function-name | stack-pointer | -+-----------------+-----------------+ -@end example - -The former is pushed on the invocation history stack when an -interpreted code is evaluated. The @emph{form} is the interpreted code -itself and the @emph{environment-pointer} points to a three elements -array which holds the three elements that represent the lexical -environment. The latter is pushed when a compiled function is -invoked. The @emph{function-name} is the name of the called function -and the @emph{stack-pointer} points to the position of the first -argument to the function. For both kinds, the element on the -invocation history stack is popped at the end of the evaluation. - -Let us see how the invocation history stack is used for debugging. +Let us see how these invocation records are used for debugging. @example >(defun fact (x) ;;; Wrong definition of the @@ -4740,7 +4651,7 @@ Block names: FACT. ;;; The block FACT is established. @end example -@node The @ecls{} Compiler, The C language interface, Porting @ecls{}, Implementation details +@node The @ecls{} Compiler, The C language interface, Extending @ecls{}, Implementation details @section The @ecls{} Compiler The @ecls{} compiler is essentially a translator from @clisp{} to C. Given @@ -4826,8 +4737,8 @@ init_code(char *start,int size,object data) static L1(int narg, object V1) @{ check_arg(1); - VALUES(0)=one_plus(V1); - RETURN(1); + NValues=1; + return one_plus(V1); @} @end example @@ -5003,7 +4914,7 @@ TTL: @end example -@node The C language interface, @ecls{} size, The @ecls{} Compiler, Implementation details +@node The C language interface, , The @ecls{} Compiler, Implementation details @section The C language interface There are several mechanism to integrate C code within @ecls{}. @@ -5030,63 +4941,6 @@ of the specified C function from @ecls{}. (defentry tak (int int int) (int "tak")) @end lisp -@node @ecls{} size, Gabriel benchmark, The C language interface, Implementation details -@section @ecls{} size - -The size of the object module of the whole @ecls{} system (including the -Compiler) is -@example - @ecls{}/SUN 2.04 Mbytes -@end example - -Since all system initialization (such as loading the database of the @ecls{} -compiler) has been done when the object module is created, the object module -size roughly corresponds to the initial size of the @ecls{} process when a -@ecls{} session is started, minus the initial size of the hole in the heap -(about 200 Kbytes). - - -@node Gabriel benchmark, , @ecls{} size, Implementation details -@section Gabriel benchmark - -The following table shows the results of Richard Gabriel's Lisp benchmark tests -in @ecls{}. The results with five other public domain @clisp{} implementation -are also listed for comparison. Each number represents the CPU time (in -seconds) for the compiled program. The code for the benchmark is taken from: - -@display -@emph{Performance and Evaluation of Lisp Systems} -by Richard P. Gabriel -Computer Systems Ser. Research Reports -MIT Press, 1985 -@end display - -For the details of the benchmark tests, refer to the book above. - -@multitable {Benchmark} {Sun ELC} -@item Benchmark @tab Sun ELC -@item Test @tab -@item Boyer @tab 2.067 -@item Browse @tab 3.750 -@item Ctak @tab 0.967 -@item Dderiv @tab 1.717 -@item Deriv @tab 1.200 -@item Destru @tab 0.350 -@item Div2 @tab 2.467 -@item Fft @tab 2.317 -@item Fprint @tab 0.167 -@item Fread @tab 0.133 -@item Puzzle @tab 1.833 -@item Stak @tab 0.000 -@item Tak @tab 0.200 -@item Takl @tab 0.267 -@item Takr @tab 0.233 -@item Tprint @tab 0.117 -@item Traverse @tab 6.783 -@item Triang @tab 10.067 -@end multitable - - @node Everything, Bibliography, Implementation details, Top @chapter Everything diff --git a/src/h/external.h b/src/h/external.h index a42c97fbc..2daa94d48 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -132,19 +132,12 @@ extern void init_catch(void); /* cfun.c */ -#ifndef RUNTIME -#define FUN_TABLE_SIZE 256 -extern void **function_entry_table; -extern int function_entries_max; -extern int function_entries; -#endif extern cl_object make_cfun(cl_object (*self)(), cl_object name, cl_object block); extern cl_object make_cclosure(cl_object (*self)(), cl_object env, cl_object block); extern void MF(cl_object sym, cl_object (*self)(), cl_object block); extern void MM(cl_object sym, cl_object (*self)(), cl_object block); extern cl_object make_function(char *s, cl_object (*f)()); extern cl_object make_si_function(char *s, cl_object (*f)()); -extern cl_object get_function_entry(void *); extern void init_cfun(void); diff --git a/src/h/lisp_external.h b/src/h/lisp_external.h index 80d47f7dd..798ae23e0 100644 --- a/src/h/lisp_external.h +++ b/src/h/lisp_external.h @@ -87,6 +87,7 @@ extern cl_object siSdefmacro; #endif extern cl_object siLcompiled_function_name _ARGS((int narg, cl_object fun)); extern cl_object siLcompiled_function_block _ARGS((int narg, cl_object fun)); +extern cl_object siLcompiled_function_source _ARGS((int narg, cl_object fun)); /* character.c */ @@ -153,6 +154,7 @@ extern cl_object Kexecute; extern cl_object Kcompile_toplevel; extern cl_object Kload_toplevel; extern cl_object clSotherwise; +extern cl_object siVkeep_definitions; extern cl_object siLprocess_declarations _ARGS((int narg, cl_object body, ...)); extern cl_object siLprocess_lambda_list _ARGS((int narg, cl_object lambda)); extern cl_object siLmake_lambda _ARGS((int narg, cl_object name, cl_object body)); @@ -183,9 +185,6 @@ extern cl_object Kformat_control, Kformat_arguments; extern cl_object siSuniversal_error_handler; extern cl_object siSterminal_interrupt; -#if defined(FRAME_CHAIN) && !defined(RUNTIME) -extern cl_object siLbacktrace _ARGS((int narg)); -#endif extern cl_object clLerror _ARGS((int narg, cl_object eformat, ...)); extern cl_object clLcerror _ARGS((int narg, cl_object cformat, cl_object eformat, ...));