Initial revision

89 files changed, 69922 insertions, 0 deletions

diff --git a/lisp/README b/lisp/README
new file mode 100644
index 0000000..b375d86
--- /dev/null
+++ b/lisp/README
@@ -0,0 +1,195 @@
+$XFree86: xc/programs/xedit/lisp/README,v 1.13 2002/12/16 03:59:27 paulo Exp $
+
+LAST UPDATED:	$Date$
+
+
+    SUMMARY
+
+  This is a small lisp interpreter for xedit. It implements a subset of
+Common Lisp and the xedit package implements several of the basic Emacs
+lisp functions.
+
+(shared modules not broken, but needs a redesign for better performance,
+ but won't be made available in the default build probably for a long time,
+ it would be really better to generate the interface dinamically, and/or just
+ link agains't the required libraries and use a ffi interface)
++------------------------------------------------------------------------
+|   It has a very simple method for loading shared modules, slightly based on
+| the XFree86 loader code, that is currently disabled by default. To enable it,
+| edit lisp.cf and change BuildSharedLispModules to YES.
+|
+|   Assuming you have built it with BuildSharedLispModules enabled, you can build
+| a small test application can be built in this directory running "make lsp".
+| Two lisp programs are available in the test directory. To test the programs
+| run "./lsp test/hello.lsp" or "./lsp test/widgets.lsp".
++------------------------------------------------------------------------
+
+  Currently, it should be used as an helper and/or a small calculator embedded
+in xedit. For the future it should be possible to write entire interfaces
+in the xedit text buffers.
+
+
+    USAGE SUMMARY
+
+  To evaluate lisp expressions, put the text cursor just after the
+lisp expression and press:
+C-x,C-e	- will evaluate it, and print the result to the message window
+C-j	- will evaluate it, and print the result to the edit window, any
+	  errors are printed to the message window.
+C-g	- will send an SIGINT to the lisp process, and that process will
+	  stop whatever it was processing and jump to the toplevel,
+	  to wait for more input.
+
+Note that C-j will only work in the *scratch* buffer.
+
+
+     NOTES
+
+  The improvements to xedit including the several possibilites to extend
+the editor using Lisp are expected to allow making of xedit a versatile
+text editor for programming, but there is code being (slowly) developed
+that should also make it useable as a small word processor, for things
+like WYSIWYG html, etc.
+  The xedit development is being done very slowly, maybe it will get
+somewhere someday, but it is a pet/hobby project, there is no intention
+of making of it an end user editor (the idea is to make it an useful
+development tool).
+  In some aspects the development is trying to mimic several Emacs
+features, but there is no intention of competition (if xedit ever get
+something better than Emacs, I hope that it serves as a motivation to
+make of Emacs an even better editor), actually it is expected to explore
+different areas and use alternate solutions for the implementation.
+  Most work in a computer is done in a text editor and the more the editor
+can help the user the better.
+
+
+(debugger is broken and very slow, no prevision for fixing it, but is
+ expected to work correctly for interpreted only code)
++------------------------------------------------------------------------
+|     DEBUGGER
+|
+|   There is a, currently, very simple debugger implement in the interpreter.
+| The debugger is now optional, and off by default. To make it available,
+| you need to recompile with -DDEBUGGER.
+| To use the debugger, run the lsp sample program as "./lsp -d", and optionally
+| pass a second parameter, for the file to be interpreted. Once the debugger
+| prompt is visible, type "help" for a summary of options. To leave the debugger
+| type "continue".
+|   Note that the debugger is still very simple, it won't work from xedit, and
+| won't drop to the debugger on "fatal errors". It allows adding breakpoints to
+| functions and watchpoints to variables. Support for changing data and going to
+| the debugger on fatal errors should be added at some time.
++------------------------------------------------------------------------
+
+
+    COMPILER
+
+  Now there is a very simple bytecode compiler. It is far from finished, but
+for simple code can show significant better performance.
+  There is not yet an interface to compile entire files and no interface to
+store the generated bytecode in disk. There is an interface to bytecode
+compile toplevel forms as a LAMBDA NIL, but it is not yet exported.
+  If your code needs to call GO/RETURN/RETURN-FROM as the result of an EVAL,
+it must jump to code in the interpreter, after compiling all calls to
+GO/RETURN/RETURN-FROM are just stack adjusting and jumps in the bytecode.
+CATCH/THROW and UNWIND-PROTECT are running as interpreted code for now, so it
+is safe to use these, but code in such blocks is not compiled/optimized
+(not even macro expansion is done, as it understands that while not compiled,
+everything is candidate to redefinition at any time).
+  To compile the code, just write a function, and compile it, example:
+
+	(defun fact (n)
+	    (if (< n 2)
+		1
+		(* n (fact (1- n)))
+	    )
+	)
+	FACT
+
+	(compile 'fact)
+	FACT
+	NIL
+	NIL
+
+	(disassemble 'fact)
+	Function FACT:
+	1 required argument: N
+	0 optional arguments
+	0 keyword parameters
+	No rest argument
+
+	Bytecode header:
+	1 element used in the stack
+	2 elements used in the builtin stack
+	0 elements used in the protected stack
+	Constant 0 = 1
+	Constant 1 = (2)
+	Symbol 0 = N
+	Builtin 0 = *
+	Builtin 1 = 1-
+	Builtin 2 = <
+
+	Initial stack:
+	0 = N
+
+	Bytecode stream:
+	   0  LOAD&PUSH (0)
+	   2  LOADCON&PUSH [1]	    ;  (2)
+	   4  CALL 2 [2]	    ;  <
+	   7  JUMPNIL 8
+	  10  LOADCON [0]	    ;  1
+	  12  NOOP
+	  13  JUMP 19
+	  16  LOAD&PUSH (0)
+	  18  LOAD&PUSH (0)
+	  20  CALL 1 [1]	    ;  1-
+	  23  LET* [0]		    ;  N
+	  25  LETREC 1
+	  27  UNLET 1
+	  29  BCONS1
+	  30  CALL 1 [0]	    ;  *
+	  33  RETURN
+	FACT
+
+
+  There are several optimizations that should be done at some time, I don't
+think adding NOOP opcodes will help everywhere to make aligned memory reads
+of shorts and ints.
+  It should have explicitly visible registers, not the abstraction of "the
+current value", so the code generator can choose register allocation for
+loop control variables, commonly used variables, etc, for example. Jumps
+should have 3 types: byte relative, 2 bytes relative and 4 bytes relative.
+For now there is only 2 byte relative jumps, byte relative jumps
+can show a significant performance increase, but they are disable until
+it is decided how inlined functions will work, if it just updates the bytecode
+header and cut&past the bytecode, jumps must be updated, and some jumps
+may not fit anymore in a byte.
+
+
+    OPTIMIZATION
+
+  There are plenty of possibilities to make the interpreter run faster. Some
+optimizations that can make it run quite faster in certain cases are:
+  o Better object memory layout and gc. The current memory allocation code
+    is very bad, it try to keep 3 times more free objects than the currently
+    used number, this can consume a lot of memory. The reason is to reduce
+    the gc time cost so that it will in average miss only one in every 4
+    collect tries.
+  o Implement real vectors, currently they are just a list, so it cannot
+    just deference a given index, and gc time is very long also.
+  o Most lists are never changed once created, it could somehow add an index
+    field in the cons cell, so that NTH/NTHCDR/LENGTH like code could just
+    deference the correct object, instead of traversing the CDR of every
+    cons. This would probably require implementing lists as vectors, while
+    making it easy to deference would make life harder when deleting/inserting
+    sublists in a list. It should also better be done in a way that does
+    not require a lot of objects allocated linearly.
+
+
+    HELPING
+
+  Send comments and code to me (paulo@XFree86.Org) or to the XFree86
+mailing/patch lists.
+
+--
+Paulo
diff --git a/lisp/TODO b/lisp/TODO
new file mode 100644
index 0000000..01babd6
--- /dev/null
+++ b/lisp/TODO
@@ -0,0 +1,81 @@
+$XFree86: xc/programs/xedit/lisp/TODO,v 1.9 2002/12/16 03:59:27 paulo Exp $
+
+LAST UPDATED:	$Date$
+
+  Small todo list
+
+o Change function/macro body to know if a &key or &optional argument was not
+  provided, and initialize to the default value in the function, for
+  interpreted and builtin functions it is better done before the function is
+  called, but for bytecode it is better in the function.
+o Following the previous idea, change function definitions in the format:
+  (defun afun (a &aux b (c (some-code))) ...)
+  to
+  (defun afun (a) (let* ((b (c (some-code)))) ...))
+  This can significatively reduce bytecode size, and also simplify function
+  calls.
+o Optimize text redisplay in Xaw, instead of allocating a copy of the buffer
+  for the paint-list, should use the text in place, and only allocate small
+  buffers when required, i.e. displaying control characters, etc.
+o Add an interface to create new object types dinamically.
+o Add a special string object to simplify and avoid too many copies of
+  portions of the text buffers. This special string should be read-only
+  and not gc-collected.
+o Make the bytecode compiler smarter to detect some constructs like:
+  (builtin-or-bytecode-function-call arg1 arg2 (return))
+  this will not properly restore the internal stacks.
+
+o When an Init function is present in every file, call LispAddBuiltin from
+  that initialization function.
+o Cleanup the code, make it optional to build some uncommon features (as well
+  as the entire interpreter?). Implement more functions directly in lisp.
+o Finish an "specification" for loadable modules. Write a FFI interface.
+  Without the possibility of using already existing libraries, the interpreter
+  won't be too much useful due to a poor library. It is very desirable to
+  "auto-generate" directly from C header files the interface to the lisp
+  code, and from that, dlload a shared library. In some cases, it is required
+  to link statically with a new interpreter binary, make it easy.
+o Implement a better string type. That should support characters larger than
+  8 bits, and that should allow embeded nuls.
+o Implement a richer set of math functions. This, if properly done can be
+  made a loadable module.
+o Optmize mathimp.c, comparing a double with a bignum should never cause an
+  error. Implement mp?_initsetXXX functions?
+o Finish missing features in read.c, and simplify it.
+o (close) probably should not send a signal when closing a pipe.
+o Implement "real" vectors, they exist to make access to field elements
+  at constant time, implementing vectors as lists may be very slow.
+o Use float and double as floating points formats.
+o Implement support for vectors of "atomic" types. Vectors of floats would
+  be useful for example if a OpenGL binding is done.
+o Implement a multiple precision floating point format. Either a 128 bits
+  (or configurable length?) IEEE 754 like number, or some format using
+  ratios, a epsilon for rouding, rounding modes, exact/inexact flag, a good
+  amount of guard digits, etc.
+o Write more functions and optimization for bignums. Try to make the code
+  as reusable as possible, either by other software or at least by the
+  different number types.
+o Instead of using mathimp.c for a large amount of functions, implement a
+  "generic number" type and implement the calculations directly in the
+  mp library.
+o Add more missing Common Lisp features, like &allow-other-keys for function
+  definitions, the missing structure features, CLOS etc.
+o Fix the Postgresql module, make it compile everywhere.
+o Add support for multi-threaded applications?
+o Make it possible to know if a object has only one reference, this is
+  required to make "inplace" changes of variables. Very useful for things
+  like (incf) and (decf), and also when dealing with bignums.
+o Maybe have a freelist for objects depending on the type. Bignums can be
+  reused, and having some large ones expecting to be freed by the gc can
+  consume a lot of memory.
+o Internationalization. Support ',' in floats? Correctly treat characters
+  for {up,down}-casing.
+o Synch the Xaw text code for supporting tables, text alignment/paragraphs,
+  etc, and add bindings to the interpreter. Add support for incremental
+  changes of those properties, currently it is "read-only".
+o Write some type of "hyperlinks", this is the only feature missing to even
+  allow writting a web browser inside xedit.
+o Write some "demos" (maybe a file manager or a simple mail reader) using the
+  Xt/Xaw bindings (needs modules working in all systems).
+o Remove all calls to the macros GCDisable and GCEnable. This is unsafe
+  and should be removed.
diff --git a/lisp/bytecode.c b/lisp/bytecode.c
new file mode 100644
index 0000000..39667b0
--- /dev/null
+++ b/lisp/bytecode.c
@@ -0,0 +1,3707 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/bytecode.c,v 1.15 2003/01/29 03:05:53 paulo Exp $ */
+
+
+/*
+somethings TODO:
+
+ o Write code for allowing storing the bytecode on disk. Basically
+   write a section of the bytecode with the package name of the symbol
+   pointers, and after that, the symbols used. At load time just put
+   the pointers in the bytecode. Constants can be stored as the string
+   representation. Probably just storing the gc protected code as a
+   string is enough to rebuild it.
+
+ o Write code to store tags of BLOCK/CATCH and setjump buffer stacks,
+   and, only keep track of this if non byte-compiled code is called,
+   as after byte-compilation RETURN and THROW are just jumps.
+
+ o Remove not reliable "optmization code" code from Com_XXX functions
+   and do it later, removing dead code, tests with a constant argument,
+   etc, in the "link time". Frequently joining sequential opcodes to a
+   compound version.
+
+ o Write an optimizer to do code transformation.
+
+ o Write code to know when variables can be changed in place, this
+   can save a huge time in loop counters.
+
+ o Write code for fast garbage collection of objects that can be
+   safely collected.
+
+ o Cleanup of interpreted code. Having bytecode mean that the interpreter
+   now is better having a clean and small code. If speed is important,
+   it should be byte compiled.
+
+ o Limit the stacks length. So that instead of using an index, use the
+   pointer where an object value should be read/stored as the stack address
+   would not change during the program execution.
+
+ o Optimize jump to jump. Common in code like:
+	(IF test
+	    (GO somewhere)
+	    (GO elsewhere)
+	)
+	(GO there)
+   that generates a bytecode like:
+	<code to evaluate test>
+	JUMPNIL :NIL-RESULT
+	:T-RESULT
+	    JUMP :SOMEWHERE
+	JUMP :END-OF-IF			;; <- this is not required, or even
+	:NIL-RESULT			;;    better, notice the jump after
+	    JUMP :ELSEWHERE		;;    the if and transform it into
+	:END-OF-IF			;;    a JUMP :THERE (assuming there
+	JUMP :THERE			;;    (was no jump in the T code).
+
+ o Optimize variables that are known to not change it's value, i.e. pseudo
+   constants. Loading the value of a constant should be faster than loading
+   the current value of a variable; the constant table could fit in the
+   processor cache line and needs less calculation to find the object address.
+
+ o Fix some known problems, like when calling return or return-from while
+   building the argument list to a builtin function, or inline of recursive
+   functions.
+ */
+
+
+#include "bytecode.h"
+#include "write.h"
+
+#define	SYMBOL_KEYWORD	-1	/* A keyword, load as constant */
+#define	SYMBOL_CONSTANT	-2	/* Defined as constant at compile time */
+#define	SYMBOL_UNBOUND	-3	/* Not a local variable */
+
+#define NEW_TREE(type)		CompileNewTree(com, type)
+
+/* If in tagbody, ignore anything that is not code */
+#define	IN_TAGBODY()		(com->block->type == LispBlockBody && \
+				 com->level == com->tagbody)
+#define	FORM_ENTER()		++com->level
+#define	FORM_LEAVE()		--com->level
+
+#define COMPILE_FAILURE(message)			\
+    LispMessage("COMPILE: %s", message);		\
+    longjmp(com->jmp, 1)
+
+/*
+ * Types
+ */
+typedef struct _CodeTree CodeTree;
+typedef struct _CodeBlock CodeBlock;
+
+typedef enum {
+    CodeTreeBytecode,
+    CodeTreeLabel,
+    CodeTreeGo,
+    CodeTreeJump,
+    CodeTreeJumpIf,
+    CodeTreeCond,
+    CodeTreeBlock,
+    CodeTreeReturn
+} CodeTreeType;
+
+struct _CodeTree {
+    CodeTreeType type;
+
+    /* Resolved when linking, may be adjusted while optimizing */
+    long offset;
+
+    LispByteOpcode code;
+
+    union {
+	signed char signed_char;
+	signed short signed_short;
+	signed int signed_int;
+	LispAtom *atom;
+	LispObj *object;
+	CodeTree *tree;
+	CodeBlock *block;
+	struct {
+	    unsigned char num_arguments;
+	    LispBuiltin *builtin;
+	    signed short offset;	/* Used if opcode is XBC_CALL_SET */
+	} builtin;
+	struct {
+	    unsigned char num_arguments;
+	    LispObj *name;
+	    LispObj *lambda;
+	} call;
+	struct {
+	    unsigned char num_arguments;
+	    LispObj *code;
+	} bytecall;
+	struct {
+	    short offset;
+	    LispAtom *name;
+	} let;
+	struct {
+	    LispAtom *symbol;
+	    LispAtom *name;
+	} let_sym;
+	struct {
+	    LispObj *object;
+	    LispAtom *name;
+	} let_con;
+	struct {
+	    signed short load;
+	    signed short set;
+	} load_set;
+	struct {
+	    LispObj *object;
+	    signed short offset;
+	} load_con_set;
+	struct {
+	    LispObj *car;
+	    LispObj *cdr;
+	} cons;
+	struct {
+	    short offset;
+	    LispObj *definition;
+	} struc;
+    } data;
+
+    CodeTree *next;
+    CodeTree *group;
+    CodeBlock *block;
+};
+
+struct _CodeBlock {
+    LispBlockType type;
+    LispObj *tag;
+
+    struct {
+	LispObj **labels;
+	CodeTree **codes;	/* Filled at link time */
+	int length;
+	int space;
+    } tagbody;
+
+    struct {
+	LispAtom **symbols;	/* Identifiers of variables in a block */
+	int *flags;		/* Information about usage of the variable */
+	int length;
+    } variables;
+
+    int bind;			/* Used in case of RETURN from LET */
+    int level;			/* Nesting level block was created */
+
+    CodeTree *tree, *tail;
+    CodeBlock *prev;		/* Linked list as a stack */
+    CodeTree *parent;		/* Back reference */
+};
+
+struct _LispCom {
+    unsigned char *bytecode;	/* Bytecode generated so far */
+    long length;
+
+    CodeBlock *block, *toplevel;
+
+    int tagbody;		/* Inside a tagbody block? */
+    int level;			/* Nesting level */
+    int macro;			/* Expanding a macro? */
+
+    int lex;
+
+    int warnings;
+
+    LispObj *form, *plist;
+
+    jmp_buf jmp;		/* Used if compilation cannot be finished */
+
+    struct {
+	int cstack;	/* Current number of objects in forms evaluation */
+	int cbstack;
+	int cpstack;
+	int stack;	/* max number of objects will be loaded in stack */
+	int bstack;
+	int pstack;
+    } stack;
+
+    struct {
+	/* Constant table */
+	LispObj **constants;
+	int num_constants;
+	/* Symbol table */
+	LispAtom **symbols;
+	int num_symbols;
+	/* Builtin table */
+	LispBuiltin **builtins;
+	int num_builtins;
+	/* Bytecode table */
+	LispObj **bytecodes;
+	int num_bytecodes;
+    } table;
+};
+
+/*
+ * Prototypes
+ */
+static LispObj *MakeBytecodeObject(LispCom*, LispObj*, LispObj*);
+
+static CodeTree *CompileNewTree(LispCom*, CodeTreeType);
+static void CompileFreeState(LispCom*);
+static void CompileFreeBlock(CodeBlock*);
+static void CompileFreeTree(CodeTree*);
+
+static void CompileIniBlock(LispCom*, LispBlockType, LispObj*);
+static void CompileFiniBlock(LispCom*);
+
+static void com_BytecodeChar(LispCom*, LispByteOpcode, char);
+static void com_BytecodeShort(LispCom*, LispByteOpcode, short);
+static void com_BytecodeObject(LispCom*, LispByteOpcode, LispObj*);
+static void com_BytecodeCons(LispCom*, LispByteOpcode, LispObj*, LispObj*);
+
+static void com_BytecodeAtom(LispCom*, LispByteOpcode, LispAtom*);
+
+static void com_Bytecode(LispCom*, LispByteOpcode);
+
+static void com_Load(LispCom*, short);
+static void com_LoadLet(LispCom*, short, LispAtom*);
+static void com_LoadPush(LispCom*, short);
+
+static void com_Let(LispCom*, LispAtom*);
+
+static void com_Bind(LispCom*, short);
+static void com_Unbind(LispCom*, short);
+
+static void com_LoadSym(LispCom*, LispAtom*);
+static void com_LoadSymLet(LispCom*, LispAtom*, LispAtom*);
+static void com_LoadSymPush(LispCom*, LispAtom*);
+
+static void com_LoadCon(LispCom*, LispObj*);
+static void com_LoadConLet(LispCom*, LispObj*, LispAtom*);
+static void com_LoadConPush(LispCom*, LispObj*);
+
+static void com_Set(LispCom*, short);
+static void com_SetSym(LispCom*, LispAtom*);
+
+static void com_Struct(LispCom*, short, LispObj*);
+static void com_Structp(LispCom*, LispObj*);
+
+static void com_Call(LispCom*, unsigned char, LispBuiltin*);
+static void com_Bytecall(LispCom*, unsigned char, LispObj*);
+static void com_Funcall(LispCom*, LispObj*, LispObj*);
+
+static void CompileStackEnter(LispCom*, int, int);
+static void CompileStackLeave(LispCom*, int, int);
+
+static void LinkBytecode(LispCom*);
+
+static LispObj *ExecuteBytecode(unsigned char*);
+
+
+/* Defined in lisp.c */
+void LispMoreStack(void);
+void LispMoreEnvironment(void);
+void LispMoreGlobals(LispPackage*);
+LispObj *LispEvalBackquote(LispObj*, int);
+void LispSetAtomObjectProperty(LispAtom*, LispObj*);
+
+/*
+ * Initialization
+ */
+extern int pagesize;
+
+LispObj x_cons[8];
+static LispObj *cons, *cons1, *cons2, *cons3, *cons4, *cons5, *cons6, *cons7;
+
+/*
+ * Implementation
+ */
+#include "compile.c"
+
+void
+LispBytecodeInit(void)
+{
+    cons = &x_cons[7];
+    cons->type = LispCons_t;
+    CDR(cons) = NIL;
+    cons1 = &x_cons[6];
+    cons1->type = LispCons_t;
+    CDR(cons1) = cons;
+    cons2 = &x_cons[5];
+    cons2->type = LispCons_t;
+    CDR(cons2) = cons1;
+    cons3 = &x_cons[4];
+    cons3->type = LispCons_t;
+    CDR(cons3) = cons2;
+    cons4 = &x_cons[3];
+    cons4->type = LispCons_t;
+    CDR(cons4) = cons3;
+    cons5 = &x_cons[2];
+    cons5->type = LispCons_t;
+    CDR(cons5) = cons4;
+    cons6 = &x_cons[1];
+    cons6->type = LispCons_t;
+    CDR(cons6) = cons5;
+    cons7 = &x_cons[0];
+    cons7->type = LispCons_t;
+    CDR(cons7) = cons6;
+}
+
+LispObj *
+Lisp_Compile(LispBuiltin *builtin)
+/*
+ compile name &optional definition
+ */
+{
+    GC_ENTER();
+    LispObj *result, *warnings_p, *failure_p;
+
+    LispObj *name, *definition;
+
+    definition = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    result = name;
+    warnings_p = NIL;
+    failure_p = T;
+
+    if (name != NIL) {
+	LispAtom *atom;
+
+	CHECK_SYMBOL(name);
+	atom = name->data.atom;
+	if (atom->a_builtin || atom->a_compiled)
+	    goto finished_compilation;
+	else if (atom->a_function) {
+	    LispCom com;
+	    int failed, *pfailed;
+	    int lex, base, *plex, *pbase;
+	    LispArgList *alist;
+	    LispObj *lambda, *form, *arguments, **parguments;
+	    LispObj **presult, **pwarnings_p, **pfailure_p, **pform;
+
+	    lambda = atom->property->fun.function;
+	    if (definition != UNSPEC || lambda->funtype != LispFunction)
+		/* XXX TODO replace definition etc. */
+		goto finished_compilation;
+	    alist = atom->property->alist;
+
+	    memset(&com, 0, sizeof(LispCom));
+	    com.toplevel = com.block = LispCalloc(1, sizeof(CodeBlock));
+	    com.block->type = LispBlockClosure;
+	    com.block->tag = name;
+
+	    /*  Create a fake argument list to avoid yet another flag
+	     * for ComCall. The value does not matter, just the fact
+	     * that the symbol will be bound or not in the implicit
+	     * PROGN of the function body. */
+	    base = alist->num_arguments - alist->auxs.num_symbols;
+	    if (base) {
+		LispObj *argument;
+		int i, sforms;
+
+		for (i = sforms = 0; i < alist->optionals.num_symbols; i++)
+		    if (alist->optionals.sforms[i])
+			++sforms;
+
+		arguments = form = NIL;
+		i = sforms +
+		    alist->normals.num_symbols + alist->optionals.num_symbols;
+
+		if (i) {
+		    arguments = form = CONS(NIL, NIL);
+		    GC_PROTECT(arguments);
+		    for (--i; i > 0; i--) {
+			RPLACD(form, CONS(NIL, NIL));
+			form = CDR(form);
+		    }
+		}
+
+		for (i = 0; i < alist->keys.num_symbols; i++) {
+		    /* key symbol */
+		    if (alist->keys.keys[i])
+			argument = QUOTE(alist->keys.keys[i]);
+		    else
+			argument = alist->keys.symbols[i];
+
+		    /* add key */
+		    if (arguments == NIL) {
+			arguments = form = CONS(argument, NIL);
+			GC_PROTECT(arguments);
+		    }
+		    else {
+			RPLACD(form, CONS(argument, NIL));
+			form = CDR(form);
+		    }
+
+		    /* add value */
+		    RPLACD(form, CONS(NIL, NIL));
+		    form = CDR(form);
+
+		    if (alist->keys.sforms[i]) {
+			RPLACD(form, CONS(NIL, NIL));
+			form = CDR(form);
+		    }
+		}
+
+		if (alist->rest) {
+		    if (arguments == NIL) {
+			arguments = form = CONS(NIL, NIL);
+			GC_PROTECT(arguments);
+		    }
+		    else {
+			RPLACD(form, CONS(NIL, NIL));
+			form = CDR(form);
+		    }
+		}
+	    }
+	    else
+		arguments = NIL;
+
+	    form = CONS(lambda->data.lambda.code, NIL);
+	    GC_PROTECT(form);
+	    com.form = form;
+	    com.plist = CONS(NIL, NIL);
+	    GC_PROTECT(com.plist);
+
+	    pfailed = &failed;
+	    plex = &lex;
+	    pbase = &base;
+	    pform = &form;
+	    presult = &result;
+	    pwarnings_p = &warnings_p;
+	    pfailure_p = &failure_p;
+	    parguments = &arguments;
+	    failed = 1;
+	    if (setjmp(com.jmp) == 0) {
+		/* Save interpreter state */
+		lex = com.lex = lisp__data.env.lex;
+		base = ComCall(&com, alist, name, arguments, 1, 0, 1);
+
+		/* Generate code tree */
+		lisp__data.env.lex = base;
+		ComProgn(&com, CAR(form));
+		failed = 0;
+	    }
+
+	    /* Restore interpreter state */
+	    lisp__data.env.lex = lex;
+	    lisp__data.env.head = lisp__data.env.length = base;
+
+	    if (!failed) {
+		failure_p = NIL;
+		result = MakeBytecodeObject(&com, name,
+					    lambda->data.lambda.data);
+		LispSetAtomCompiledProperty(atom, result);
+		result = name;
+	    }
+	    if (com.warnings)
+		warnings_p = FIXNUM(com.warnings);
+	    goto finished_compilation;
+	}
+	else
+	    goto undefined_function;
+    }
+
+undefined_function:
+    LispDestroy("%s: the function %s is undefined",
+		STRFUN(builtin), STROBJ(name));
+
+finished_compilation:
+    RETURN(0) = warnings_p;
+    RETURN(1) = failure_p;
+    RETURN_COUNT = 2;
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Disassemble(LispBuiltin *builtin)
+/*
+ disassemble function
+ */
+{
+    int macro;
+    char buffer[128];
+    LispAtom *atom;
+    LispArgList *alist;
+    LispBuiltin *xbuiltin;
+    LispObj *name, *lambda, *bytecode;
+
+    LispObj *function;
+
+    function = ARGUMENT(0);
+
+    macro = 0;
+    alist = NULL;
+    xbuiltin = NULL;
+    name = bytecode = NULL;
+
+    switch (OBJECT_TYPE(function)) {
+	case LispAtom_t:
+	    name = function;
+	    atom = function->data.atom;
+	    alist = atom->property->alist;
+	    if (atom->a_builtin) {
+		xbuiltin = atom->property->fun.builtin;
+		macro = xbuiltin->type == LispMacro;
+	    }
+	    else if (atom->a_compiled)
+		bytecode = atom->property->fun.function;
+	    else if (atom->a_function) {
+		lambda = atom->property->fun.function;
+		macro = lambda->funtype == LispMacro;
+	    }
+	    else if (atom->a_defstruct &&
+		     atom->property->structure.function != STRUCT_NAME) {
+		if (atom->property->structure.function == STRUCT_CONSTRUCTOR)
+		    atom = Omake_struct->data.atom;
+		else if (atom->property->structure.function == STRUCT_CHECK)
+		    atom = Ostruct_type->data.atom;
+		else
+		    atom = Ostruct_access->data.atom;
+		xbuiltin = atom->property->fun.builtin;
+	    }
+	    else
+		LispDestroy("%s: the function %s is not defined",
+			    STRFUN(builtin), STROBJ(function));
+	    break;
+	case LispBytecode_t:
+	    name = Olambda;
+	    bytecode = function;
+	    break;
+	case LispLambda_t:
+	    name = Olambda;
+	    alist = (LispArgList*)function->data.lambda.name->data.opaque.data;
+	    break;
+	case LispCons_t:
+	    if (CAR(function) == Olambda) {
+		function = EVAL(function);
+		if (OBJECT_TYPE(function) == LispLambda_t) {
+		    name = Olambda;
+		    alist = (LispArgList*)
+			function->data.lambda.name->data.opaque.data;
+		    break;
+		}
+	    }
+	default:
+	    LispDestroy("%s: %s is not a function",
+			STRFUN(builtin), STROBJ(function));
+	    break;
+    }
+
+    if (xbuiltin) {
+	LispWriteStr(NIL, "Builtin ", 8);
+	if (macro)
+	    LispWriteStr(NIL, "macro ", 6);
+	else
+	    LispWriteStr(NIL, "function ", 9);
+    }
+    else if (macro)
+	LispWriteStr(NIL, "Macro ", 6);
+    else
+	LispWriteStr(NIL, "Function ", 9);
+    LispWriteObject(NIL, name);
+    LispWriteStr(NIL, ":\n", 2);
+
+    if (alist) {
+	int i;
+
+	sprintf(buffer, "%d required argument%s",
+		alist->normals.num_symbols,
+		alist->normals.num_symbols != 1 ? "s" : "");
+	LispWriteStr(NIL, buffer, strlen(buffer));
+	for (i = 0; i < alist->normals.num_symbols; i++) {
+	    LispWriteChar(NIL, i ? ',' : ':');
+	    LispWriteChar(NIL, ' ');
+	    LispWriteStr(NIL, ATOMID(alist->normals.symbols[i]),
+			 strlen(ATOMID(alist->normals.symbols[i])));
+	}
+	LispWriteChar(NIL, '\n');
+
+	sprintf(buffer, "%d optional argument%s",
+		alist->optionals.num_symbols,
+		alist->optionals.num_symbols != 1 ? "s" : "");
+	LispWriteStr(NIL, buffer, strlen(buffer));
+	for (i = 0; i < alist->optionals.num_symbols; i++) {
+	    LispWriteChar(NIL, i ? ',' : ':');
+	    LispWriteChar(NIL, ' ');
+	    LispWriteStr(NIL, ATOMID(alist->optionals.symbols[i]),
+			 strlen(ATOMID(alist->optionals.symbols[i])));
+	}
+	LispWriteChar(NIL, '\n');
+
+	sprintf(buffer, "%d keyword parameter%s",
+		alist->keys.num_symbols,
+		alist->keys.num_symbols != 1 ? "s" : "");
+	LispWriteStr(NIL, buffer, strlen(buffer));
+	for (i = 0; i < alist->keys.num_symbols; i++) {
+	    LispWriteChar(NIL, i ? ',' : ':');
+	    LispWriteChar(NIL, ' ');
+	    LispWriteObject(NIL, alist->keys.symbols[i]);
+	}
+	LispWriteChar(NIL, '\n');
+
+	if (alist->rest) {
+	    LispWriteStr(NIL, "Rest argument: ", 15);
+	    LispWriteStr(NIL, ATOMID(alist->rest),
+			 strlen(ATOMID(alist->rest)));
+	    LispWriteChar(NIL, '\n');
+	}
+	else
+	    LispWriteStr(NIL, "No rest argument\n", 17);
+    }
+
+    if (bytecode) {
+	char *ptr;
+	int *offsets[4];
+	int i, done, j, sym0, sym1, con0, con1, bui0, byt0, strd, strf;
+	LispObj **constants;
+	LispAtom **symbols;
+	LispBuiltin **builtins;
+	unsigned char **codes;
+	LispObj **names;
+	short stack, num_constants, num_symbols, num_builtins, num_bytecodes;
+	unsigned char *base, *stream = bytecode->data.bytecode.bytecode->code;
+
+	LispWriteStr(NIL, "\nBytecode header:\n", 18);
+
+	/* Header information */
+	stack = *(short*)stream;
+	stream += sizeof(short);
+	sprintf(buffer, "%d element%s used in the stack\n",
+		stack, stack != 1 ? "s" : "");
+	LispWriteStr(NIL, buffer, strlen(buffer));
+	stack = *(short*)stream;
+	stream += sizeof(short);
+	sprintf(buffer, "%d element%s used in the builtin stack\n",
+		stack, stack != 1 ? "s" : "");
+	LispWriteStr(NIL, buffer, strlen(buffer));
+	stack = *(short*)stream;
+	stream += sizeof(short);
+	sprintf(buffer, "%d element%s used in the protected stack\n",
+		stack, stack != 1 ? "s" : "");
+	LispWriteStr(NIL, buffer, strlen(buffer));
+
+	num_constants = *(short*)stream;
+	stream += sizeof(short);
+	num_symbols = *(short*)stream;
+	stream += sizeof(short);
+	num_builtins = *(short*)stream;
+	stream += sizeof(short);
+	num_bytecodes = *(short*)stream;
+	stream += sizeof(short);
+
+	constants = (LispObj**)stream;
+	stream += num_constants * sizeof(LispObj*);
+	symbols = (LispAtom**)stream;
+	stream += num_symbols * sizeof(LispAtom*);
+	builtins = (LispBuiltin**)stream;
+	stream += num_builtins * sizeof(LispBuiltin*);
+	codes = (unsigned char**)stream;
+	stream += num_bytecodes * sizeof(unsigned char*);
+	names = (LispObj**)stream;
+	stream += num_bytecodes * sizeof(LispObj*);
+
+	for (i = 0; i < num_constants; i++) {
+	    sprintf(buffer, "Constant %d = %s\n", i, STROBJ(constants[i]));
+	    LispWriteStr(NIL, buffer, strlen(buffer));
+	}
+
+/* Macro XSTRING avoids some noisy in the output, if it were defined as
+ * #define XSTRING(object) object ? STROBJ(object) : #<UNBOUND>
+ *	and called as XSTRING(atom->object)
+ * it would also print the package name were the symbol was first defined,
+ * but for local variables, only the symbol string is important. */
+#define XSTRING(string)		string ? string : "#<UNBOUND>"
+
+	for (i = 0; i < num_symbols; i++) {
+	    sprintf(buffer, "Symbol %d = %s\n",
+		    i, XSTRING(symbols[i]->string));
+	    LispWriteStr(NIL, buffer, strlen(buffer));
+	}
+	for (i = 0; i < num_builtins; i++) {
+	    sprintf(buffer, "Builtin %d = %s\n",
+		    i, STROBJ(builtins[i]->symbol));
+	    LispWriteStr(NIL, buffer, strlen(buffer));
+	}
+	for (i = 0; i < num_bytecodes; i++) {
+	    sprintf(buffer, "Bytecode %d = %s\n",
+		    i, STROBJ(names[i]));
+	    LispWriteStr(NIL, buffer, strlen(buffer));
+	}
+
+	/*  Make readability slightly easier printing the names of local
+	 * variables where it's offset is known, i.e. function arguments. */
+	if (alist) {
+	    if (alist->num_arguments == 0)
+		LispWriteStr(NIL, "\nNo initial stack\n", 18);
+	    else {
+		int len1, len2;
+
+		j = 0;
+		LispWriteStr(NIL, "\nInitial stack:\n", 16);
+
+		for (i = 0; i < alist->normals.num_symbols; i++, j++) {
+		    sprintf(buffer, "%d = ", j);
+		    LispWriteStr(NIL, buffer, strlen(buffer));
+		    ptr = alist->normals.symbols[i]->data.atom->string;
+		    LispWriteStr(NIL, ptr, strlen(ptr));
+		    LispWriteChar(NIL, '\n');
+		}
+
+		for (i = 0; i < alist->optionals.num_symbols; i++, j++) {
+		    sprintf(buffer, "%d = ", j);
+		    LispWriteStr(NIL, buffer, strlen(buffer));
+		    ptr = alist->optionals.symbols[i]->data.atom->string;
+		    LispWriteStr(NIL, ptr, strlen(ptr));
+		    LispWriteChar(NIL, '\n');
+		    if (alist->optionals.sforms[i]) {
+			sprintf(buffer, "%d = ", j);
+			len1 = strlen(buffer);
+			LispWriteStr(NIL, buffer, len1);
+			ptr = alist->optionals.sforms[i]->data.atom->string;
+			len2 = strlen(ptr);
+			LispWriteStr(NIL, ptr, len2);
+			LispWriteChars(NIL, ' ', 28 - (len1 + len2));
+			LispWriteStr(NIL, ";  sform\n", 9);
+			j++;
+		    }
+		}
+
+		for (i = 0; i < alist->keys.num_symbols; i++, j++) {
+		    sprintf(buffer, "%d = ", j);
+		    len1 = strlen(buffer);
+		    LispWriteStr(NIL, buffer, len1);
+		    if (alist->keys.keys[i]) {
+			ptr = alist->keys.keys[i]->data.atom->string;
+			len2 = strlen(ptr);
+			LispWriteStr(NIL, ptr, strlen(ptr));
+			LispWriteChars(NIL, ' ', 28 - (len1 + len2));
+			LispWriteStr(NIL, ";  special key", 14);
+		    }
+		    else {
+			ptr = alist->keys.symbols[i]->data.atom->string;
+			LispWriteStr(NIL, ptr, strlen(ptr));
+		    }
+		    LispWriteChar(NIL, '\n');
+		    if (alist->keys.sforms[i]) {
+			sprintf(buffer, "%d = ", j);
+			len1 = strlen(buffer);
+			LispWriteStr(NIL, buffer, len1);
+			ptr = alist->keys.sforms[i]->data.atom->string;
+			len2 = strlen(ptr);
+			LispWriteStr(NIL, ptr, len2);
+			LispWriteChars(NIL, ' ', 28 - (len1 + len2));
+			LispWriteStr(NIL, ";  sform\n", 9);
+			j++;
+		    }
+		}
+
+		if (alist->rest) {
+		    sprintf(buffer, "%d = ", j);
+		    len1 = strlen(buffer);
+		    LispWriteStr(NIL, buffer, len1);
+		    ptr = alist->rest->data.atom->string;
+		    len2 = strlen(ptr);
+		    LispWriteStr(NIL, ptr, len2);
+		    LispWriteChar(NIL, '\n');
+		    j++;
+		}
+
+		for (i = 0; i < alist->auxs.num_symbols; i++, j++) {
+		    sprintf(buffer, "%d = ", j);
+		    len1 = strlen(buffer);
+		    LispWriteStr(NIL, buffer, len1);
+		    ptr = alist->auxs.symbols[i]->data.atom->string;
+		    len2 = strlen(ptr);
+		    LispWriteStr(NIL, ptr, len2);
+		    LispWriteChars(NIL, ' ', 28 - (len1 + len2));
+		    LispWriteStr(NIL, ";  aux\n", 7);
+		}
+	    }
+	}
+
+	LispWriteStr(NIL, "\nBytecode stream:\n", 18);
+
+	base = stream;
+	for (done = j = 0; !done; j = 0) {
+	    sym0 = sym1 = con0 = con1 = bui0 = byt0 = strd = strf = -1;
+	    sprintf(buffer, "%4ld  ", (long)(stream - base));
+	    ptr = buffer + strlen(buffer);
+	    switch (*stream++) {
+		case XBC_NOOP:	strcpy(ptr, "NOOP");	break;
+		case XBC_PRED:
+		    strcpy(ptr, "PRED:");
+		    ptr += strlen(ptr);
+		    goto predicate;
+		case XBC_INV:	strcpy(ptr, "INV");	break;
+		case XBC_NIL:	strcpy(ptr, "NIL");	break;
+		case XBC_T:	strcpy(ptr, "T");	break;
+		case XBC_CAR:	strcpy(ptr, "CAR");	break;
+		case XBC_CDR:	strcpy(ptr, "CDR");	break;
+		case XBC_RPLACA:strcpy(ptr, "RPLACA");	break;
+		case XBC_RPLACD:strcpy(ptr, "RPLACD");	break;
+		case XBC_EQ:	strcpy(ptr, "EQ");	break;
+		case XBC_EQL:	strcpy(ptr, "EQL");	break;
+		case XBC_EQUAL:	strcpy(ptr, "EQUAL");	break;
+		case XBC_EQUALP:strcpy(ptr, "EQUALP");	break;
+		case XBC_LENGTH:strcpy(ptr, "LENGTH");	break;
+		case XBC_LAST:	strcpy(ptr, "LAST");	break;
+		case XBC_NTHCDR:strcpy(ptr, "NTHCDR");	break;
+		case XBC_PUSH:	strcpy(ptr, "PUSH");	break;
+		case XBC_CAR_PUSH:
+		    strcpy(ptr, "CAR&PUSH");
+		    break;
+		case XBC_CDR_PUSH:
+		    strcpy(ptr, "CDR&PUSH");
+		    break;
+		case XBC_PUSH_NIL:
+		    strcpy(ptr, "PUSH NIL");
+		    break;
+		case XBC_PUSH_UNSPEC:
+		    strcpy(ptr, "PUSH #<UNSPEC>");
+		    break;
+		case XBC_PUSH_T:
+		    strcpy(ptr, "PUSH T");
+		    break;
+		case XBC_PUSH_NIL_N:
+		    strcpy(ptr, "PUSH NIL ");
+		    ptr += strlen(ptr);
+		    sprintf(ptr, "%d", (int)(*stream++));
+		    break;
+		case XBC_PUSH_UNSPEC_N:
+		    strcpy(ptr, "PUSH #<UNSPEC> ");
+		    ptr += strlen(ptr);
+		    sprintf(ptr, "%d", (int)(*stream++));
+		    break;
+		case XBC_LET:
+		    strcpy(ptr, "LET");
+/* update sym0 */
+symbol:
+		    offsets[j++] = &sym0;
+/* update <offsets> - print [byte] */
+offset:
+		    ptr += strlen(ptr);
+		    i = *stream++;
+		    *(offsets[j - 1]) = i;
+		    sprintf(ptr, " [%d]", i);
+		    break;
+		case XBC_LETX:
+		    strcpy(ptr, "LET*");
+		    goto symbol;
+		case XBC_LET_NIL:
+		    strcpy(ptr, "LET NIL");
+		    goto symbol;
+		case XBC_LETX_NIL:
+		    strcpy(ptr, "LET* NIL");
+		    goto symbol;
+		case XBC_LETBIND:
+		    strcpy(ptr, "LETBIND");
+/* print byte */
+value:
+		    ptr += strlen(ptr);
+		    sprintf(ptr, " %d", (int)(*stream++));
+		    break;
+		case XBC_UNLET:strcpy(ptr, "UNLET");	goto value;
+		case XBC_LOAD:
+		    strcpy(ptr, "LOAD");
+/* print (byte) */
+reference:
+		    ptr += strlen(ptr);
+		    i = *stream++;
+		    sprintf(ptr, " (%d)", i);
+		    break;
+		case XBC_LOAD_CAR:
+		    strcpy(ptr, "LOAD&CAR");
+		    goto reference;
+		case XBC_LOAD_CDR:
+		    strcpy(ptr, "LOAD&CDR");
+		    goto reference;
+		case XBC_LOAD_CAR_STORE:
+		    strcpy(ptr, "LOAD&CAR&STORE");
+		    goto reference;
+		case XBC_LOAD_CDR_STORE:
+		    strcpy(ptr, "LOAD&CDR&STORE");
+		    goto reference;
+		case XBC_LOAD_LET:
+		    strcpy(ptr, "LOAD&LET");
+load_let:
+		    offsets[j++] = &sym0;
+		    i = *stream++;
+		    ptr += strlen(ptr);
+		    sprintf(ptr, " (%d)", i);
+		    goto offset;
+		case XBC_LOAD_LETX:
+		    strcpy(ptr, "LOAD&LET*");
+		    goto load_let;
+		case XBC_STRUCT:
+		    strcpy(ptr, "STRUCT");
+		    offsets[j++] = &strf;
+		    offsets[j++] = &strd;
+/* update <offsets> - print [byte] - update <offsets> - print [byte] */
+offset_offset:
+		    ptr += strlen(ptr);
+		    i = *stream++;
+		    *(offsets[j - 2]) = i;
+		    sprintf(ptr, " [%d]", i);
+		    goto offset;
+		case XBC_LOAD_PUSH:
+		    strcpy(ptr, "LOAD&PUSH");
+		    goto reference;
+		case XBC_LOADCON:
+		    strcpy(ptr, "LOADCON");
+constant:
+		    offsets[j++] = &con0;
+		    goto offset;
+		case XBC_LOADCON_SET:
+		    strcpy(ptr, "LOADCON&SET");
+		    offsets[j++] = &con0;
+/* update <offsets> - print [byte] - print (byte) */
+offset_reference:
+		    i = *stream++;
+		    *(offsets[j - 1]) = i;
+		    ptr += strlen(ptr);
+		    sprintf(ptr, " [%d]", i);
+		    goto reference;
+		case XBC_STRUCTP:
+		    strcpy(ptr, "STRUCTP");
+		    offsets[j++] = &strd;
+		    goto offset;
+		case XBC_LOADCON_LET:
+		    strcpy(ptr, "LOADCON&LET");
+loadcon_let:
+		    offsets[j++] = &con0;
+		    offsets[j++] = &sym0;
+		    goto offset_offset;
+		case XBC_LOADCON_LETX:
+		    strcpy(ptr, "LOADCON&LET*");
+		    goto loadcon_let;
+		case XBC_LOADCON_PUSH:
+		    strcpy(ptr, "LOADCON&PUSH");
+		    goto constant;
+		case XBC_LOADSYM:
+		    strcpy(ptr, "LOADSYM");
+		    goto symbol;
+		case XBC_LOADSYM_LET:
+		    strcpy(ptr, "LOADSYM&LET");
+loadsym_let:
+		    offsets[j++] = &sym0;
+		    offsets[j++] = &sym1;
+		    goto offset_offset;
+		case XBC_LOADSYM_LETX:
+		    strcpy(ptr, "LOADSYM&LET*");
+		    goto loadsym_let;
+		case XBC_LOADSYM_PUSH:
+		    strcpy(ptr, "LOADSYM&PUSH");
+		    goto symbol;
+		case XBC_LOAD_SET:
+		    strcpy(ptr, "LOAD&SET");
+/* print (byte) - print (byte) */
+reference_reference:
+		    ptr += strlen(ptr);
+		    i = *stream++;
+		    sprintf(ptr, " (%d)", i);
+		    goto reference;
+		case XBC_LOAD_CAR_SET:
+		    strcpy(ptr, "LOAD&CAR&SET");
+		    goto reference_reference;
+		case XBC_LOAD_CDR_SET:
+		    strcpy(ptr, "LOAD&CDR&SET");
+		    goto reference_reference;
+		case XBC_CAR_SET:
+		    strcpy(ptr, "CAR&SET");
+		    goto reference;
+		case XBC_CDR_SET:
+		    strcpy(ptr, "CDR&SET");
+		    goto reference;
+		case XBC_SET:
+		    strcpy(ptr, "SET");
+		    goto reference;
+		case XBC_SETSYM:
+		    strcpy(ptr, "SETSYM");
+		    goto symbol;
+		case XBC_SET_NIL:
+		    strcpy(ptr, "SET NIL");
+		    goto reference;
+		case XBC_CALL:
+		    strcpy(ptr, "CALL");
+		    ptr += strlen(ptr);
+		    sprintf(ptr, " %d", (int)(*stream++));
+		    offsets[j++] = &bui0;
+		    goto offset;
+		case XBC_CALL_SET:
+		    strcpy(ptr, "CALL&SET");
+		    ptr += strlen(ptr);
+		    sprintf(ptr, " %d", (int)(*stream++));
+		    offsets[j++] = &bui0;
+		    goto offset_reference;
+		case XBC_BYTECALL:
+		    strcpy(ptr, "BYTECALL");
+		    ptr += strlen(ptr);
+		    sprintf(ptr, " %d", (int)(*stream++));
+		    offsets[j++] = &byt0;
+		    goto offset;
+		case XBC_FUNCALL:
+		    strcpy(ptr, "FUNCALL");
+constant_constant:
+		    offsets[j++] = &con0;
+		    offsets[j++] = &con1;
+		    goto offset_offset;
+		case XBC_CCONS:
+		    strcpy(ptr, "CCONS");
+		    goto constant_constant;
+		case XBC_CSTAR:	strcpy(ptr, "CSTAR");	break;
+		case XBC_CFINI:	strcpy(ptr, "CFINI");	break;
+		case XBC_LSTAR:	strcpy(ptr, "LSTAR");	break;
+		case XBC_LCONS:	strcpy(ptr, "LCONS");	break;
+		case XBC_LFINI:	strcpy(ptr, "LFINI");	break;
+		case XBC_BCONS:	strcpy(ptr, "BCONS");	break;
+		case XBC_BCONS1:	case XBC_BCONS2:	case XBC_BCONS3:
+		case XBC_BCONS4:	case XBC_BCONS5:	case XBC_BCONS6:
+		case XBC_BCONS7:
+		    strcpy(ptr, "BCONS");
+		    ptr += strlen(ptr);
+		    sprintf(ptr, "%d", (int)(stream[-1] - XBC_BCONS));
+		    break;
+		case XBC_JUMP:
+		    strcpy(ptr, "JUMP");
+integer:
+		    ptr += strlen(ptr);
+		    sprintf(ptr, " %d", *(signed short*)stream);
+		    stream += sizeof(short);
+		    break;
+		case XBC_JUMPT:
+		    strcpy(ptr, "JUMPT");
+		    goto integer;
+		case XBC_JUMPNIL:
+		    strcpy(ptr, "JUMPNIL");
+		    goto integer;
+		case XBC_LETREC:
+		    strcpy(ptr, "LETREC");
+		    ptr += strlen(ptr);
+		    sprintf(ptr, " %d", (int)*stream++);
+		    break;
+		case XBC_RETURN:
+		    strcpy(ptr, "RETURN");
+		    done = 1;
+		    break;
+	    }
+	    i = ptr - buffer + strlen(ptr);
+	    LispWriteStr(NIL, buffer, i);
+	    if (j) {
+
+		/* Pad */
+		LispWriteChars(NIL, ' ', 28 - i);
+		LispWriteChar(NIL, ';');
+
+		ptr = buffer;
+
+		/* Structure */
+		if (strf >= 0) {
+		    /* strd is valid if strf set */
+		    LispObj *fields = constants[strd];
+
+		    for (; strf >= 0; strf--)
+			fields = CDR(fields);		    
+		    strcpy(ptr, "  ");	    ptr += 2;
+		    strcpy(ptr, CAR(fields)->data.atom->string);
+		    ptr += strlen(ptr);
+		}
+		if (strd >= 0) {
+		    strcpy(ptr, "  ");		ptr += 2;
+		    strcpy(ptr, STROBJ(CAR(constants[strd])));
+		    ptr += strlen(ptr);
+		}
+
+		/* Constants */
+		if (con0 >= 0) {
+		    strcpy(ptr, "  ");	ptr += 2;
+		    strcpy(ptr, STROBJ(constants[con0]));
+		    ptr += strlen(ptr);
+		    if (con1 >= 0) {
+			strcpy(ptr, "  ");	ptr += 2;
+			strcpy(ptr, STROBJ(constants[con1]));
+			ptr += strlen(ptr);
+		    }
+		}
+
+		/* Builtin */
+		if (bui0 >= 0) {
+		    strcpy(ptr, "  ");	ptr += 2;
+		    strcpy(ptr, STROBJ(builtins[bui0]->symbol));
+		    ptr += strlen(ptr);
+		}
+
+		/* Bytecode */
+		if (byt0 >= 0) {
+		    strcpy(ptr, "  ");	ptr += 2;
+		    strcpy(ptr, STROBJ(names[byt0]));
+		    ptr += strlen(ptr);
+		}
+
+		/* Symbols */
+		if (sym0 >= 0) {
+		    strcpy(ptr, "  ");	ptr += 2;
+		    strcpy(ptr, XSTRING(symbols[sym0]->string));
+		    ptr += strlen(ptr);
+		    if (sym1 >= 0) {
+			strcpy(ptr, "  ");	ptr += 2;
+			strcpy(ptr, XSTRING(symbols[sym1]->string));
+			ptr += strlen(ptr);
+		    }
+		}
+
+		i = ptr - buffer;
+		LispWriteStr(NIL, buffer, i);
+	    }
+	    LispWriteChar(NIL, '\n');
+	    continue;
+predicate:
+	    switch (*stream++) {
+		case XBP_CONSP:     strcpy(ptr, "CONSP");   break;
+		case XBP_LISTP:     strcpy(ptr, "LISTP");   break;
+		case XBP_NUMBERP:   strcpy(ptr, "NUMBERP"); break;
+	    }
+	    LispWriteStr(NIL, buffer, ptr - buffer + strlen(ptr));
+	    LispWriteChar(NIL, '\n');
+	}
+#undef XSTRING
+    }
+
+    return (function);
+}
+
+
+
+LispObj *
+LispCompileForm(LispObj *form)
+{
+    GC_ENTER();
+    int failed, *pfailed;
+    LispCom com;
+    LispObj *code, **pform;
+
+    if (!CONSP(form))
+	/* Incorrect call or NIL */
+	return (form);
+
+    memset(&com, 0, sizeof(LispCom));
+
+    com.toplevel = com.block = LispCalloc(1, sizeof(CodeBlock));
+    com.block->type = LispBlockNone;
+    com.lex = lisp__data.env.lex;
+
+    com.plist = CONS(NIL, NIL);
+    GC_PROTECT(com.plist);
+
+    pfailed = &failed;
+    pform = &form;
+    failed = 1;
+    if (setjmp(com.jmp) == 0) {
+	for (code = form; CONSP(form); form = CDR(form)) {
+	    com.form = form;
+	    ComEval(&com, CAR(form));
+	}
+	failed = 0;
+    }
+    GC_LEAVE();
+
+    return (failed ? NIL : MakeBytecodeObject(&com, NIL, NIL));
+}
+
+LispObj *
+LispExecuteBytecode(LispObj *object)
+{
+    if (!BYTECODEP(object))
+	return (EVAL(object));
+
+    return (ExecuteBytecode(object->data.bytecode.bytecode->code));
+}
+
+static LispObj *
+MakeBytecodeObject(LispCom *com, LispObj *name, LispObj *plist)
+{
+    LispObj *object;
+    LispBytecode *bytecode;
+
+    GC_ENTER();
+    unsigned char *stream;
+    short i, num_constants;
+    LispObj **constants, *code, *cons, *prev;
+
+    /* Resolve dependencies, optimize and create byte stream */
+    LinkBytecode(com);
+
+    object = LispNew(NIL, NIL);
+    GC_PROTECT(object);
+    bytecode = LispMalloc(sizeof(LispBytecode));
+    bytecode->code = com->bytecode;
+    bytecode->length = com->length;
+
+
+    stream = bytecode->code;
+
+    /* Skip stack information */
+    stream += sizeof(short) * 3;
+
+    /* Get information */
+    num_constants = *(short*)stream;
+    stream += sizeof(short) * 4;
+    constants = (LispObj**)stream;
+
+    GC_PROTECT(plist);
+    code = cons = prev = NIL;
+    for (i = 0; i < num_constants; i++) {
+	if (POINTERP(constants[i]) && !XSYMBOLP(constants[i])) {
+	    if (code == NIL) {
+		code = cons = prev = CONS(constants[i], NIL);
+		GC_PROTECT(code);
+	    }
+	    else {
+		RPLACD(cons, CONS(constants[i], NIL));
+		prev = cons;
+		cons = CDR(cons);
+	    }
+	}
+    }
+
+    /* Protect this in case the function is redefined */
+    for (i = 0; i < com->table.num_bytecodes; i++) {	
+	if (code == NIL) {
+	    code = cons = prev = CONS(com->table.bytecodes[i], NIL);
+	    GC_PROTECT(code);
+	}
+	else {
+	    RPLACD(cons, CONS(com->table.bytecodes[i], NIL));
+	    prev = cons;
+	    cons = CDR(cons);
+	}
+    }
+
+    /* Free everything, but the LispCom structure and the generated bytecode */
+    CompileFreeState(com);
+    
+    /* Allocate the minimum required number of cons cells to protect objects */
+    if (!CONSP(code))
+	code = plist;
+    else if (CONSP(plist)) {
+	if (code == cons)
+	    RPLACD(code, plist);
+	else
+	    RPLACD(cons, plist);
+    }
+    else {
+	if (code == cons)
+	    code = CAR(code);
+	else
+	    CDR(prev) = CAR(cons);
+    }
+
+    object->data.bytecode.bytecode = bytecode;
+    /* Byte code references this object, so it cannot be garbage collected */
+    object->data.bytecode.code = code;
+    object->data.bytecode.name = name;
+    object->type = LispBytecode_t;
+
+    LispMused(bytecode);
+    LispMused(bytecode->code);
+    GC_LEAVE();
+
+    return (object);
+}
+
+static void
+CompileFreeTree(CodeTree *tree)
+{
+    if (tree->type == CodeTreeBlock)
+	CompileFreeBlock(tree->data.block);
+    LispFree(tree);
+}
+
+static void
+CompileFreeBlock(CodeBlock *block)
+{
+    CodeTree *tree = block->tree, *next;
+
+    while (tree) {
+	next = tree->next;
+	CompileFreeTree(tree);
+	tree = next;
+    }
+    if (block->type == LispBlockBody) {
+	LispFree(block->tagbody.labels);
+	LispFree(block->tagbody.codes);
+    }
+    LispFree(block->variables.symbols);
+    LispFree(block->variables.flags);
+    LispFree(block);
+}
+
+static void
+CompileFreeState(LispCom *com)
+{
+    CompileFreeBlock(com->block);
+    LispFree(com->table.constants);
+    LispFree(com->table.symbols);
+    LispFree(com->table.builtins);
+    LispFree(com->table.bytecodes);
+}
+
+/* XXX Put a breakpoint here when changing the macro expansion code.
+ *     No opcodes should be generated during macro expansion. */
+static CodeTree *
+CompileNewTree(LispCom *com, CodeTreeType type)
+{
+    CodeTree *tree = LispMalloc(sizeof(CodeTree));
+
+    tree->type = type;
+    tree->next = NULL;
+    tree->block = com->block;
+    if (com->block->tree == NULL)
+	com->block->tree = tree;
+    else
+	com->block->tail->next = tree;
+    com->block->tail = tree;
+
+    return (tree);
+}
+
+static void
+CompileIniBlock(LispCom *com, LispBlockType type, LispObj *tag)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBlock);
+    CodeBlock *block = LispCalloc(1, sizeof(CodeBlock));
+
+    tree->data.block = block;
+
+    block->type = type;
+    block->tag = tag;
+    block->prev = com->block;
+    block->parent = tree;
+    block->level = com->level;
+    com->block = block;
+
+    if (type == LispBlockBody)
+	com->tagbody = com->level;
+}
+
+static void
+CompileFiniBlock(LispCom *com)
+{
+    com->block = com->block->prev;
+    if (com->block && com->block->type == LispBlockBody)
+	com->tagbody = com->block->level;
+}
+
+static void
+com_BytecodeChar(LispCom *com, LispByteOpcode code, char value)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = code;
+    tree->data.signed_char = value;
+}
+
+static void
+com_BytecodeShort(LispCom *com, LispByteOpcode code, short value)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = code;
+    tree->data.signed_short = value;
+}
+
+static void
+com_BytecodeAtom(LispCom *com, LispByteOpcode code, LispAtom *atom)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = code;
+    tree->data.atom = atom;
+}
+
+static void
+com_BytecodeObject(LispCom *com, LispByteOpcode code, LispObj *object)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = code;
+    tree->data.object = object;
+}
+
+static void
+com_BytecodeCons(LispCom *com, LispByteOpcode code, LispObj *car, LispObj *cdr)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = code;
+    tree->data.cons.car = car;
+    tree->data.cons.cdr = cdr;
+}
+
+static void
+com_Bytecode(LispCom *com, LispByteOpcode code)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = code;
+}
+
+static void
+com_Load(LispCom *com, short offset)
+{
+    com_BytecodeShort(com, XBC_LOAD, offset);
+}
+
+static void
+com_LoadLet(LispCom *com, short offset, LispAtom *name)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = XBC_LOAD_LET;
+    tree->data.let.offset = offset;
+    tree->data.let.name = name;
+}
+
+static void
+com_LoadPush(LispCom *com, short offset)
+{
+    com_BytecodeShort(com, XBC_LOAD_PUSH, offset);
+}
+
+static void
+com_Let(LispCom *com, LispAtom *name)
+{
+    com_BytecodeAtom(com, XBC_LET, name);
+}
+
+static void
+com_Bind(LispCom *com, short count)
+{
+    if (count)
+	com_BytecodeShort(com, XBC_LETBIND, count);
+}
+
+static void
+com_Unbind(LispCom *com, short count)
+{
+    if (count)
+	com_BytecodeShort(com, XBC_UNLET, count);
+}
+
+static void
+com_LoadSym(LispCom *com, LispAtom *atom)
+{
+    com_BytecodeAtom(com, XBC_LOADSYM, atom);
+}
+
+static void
+com_LoadSymLet(LispCom *com, LispAtom *symbol, LispAtom *name)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = XBC_LOADSYM_LET;
+    tree->data.let_sym.symbol = symbol;
+    tree->data.let_sym.name = name;
+}
+
+static void
+com_LoadSymPush(LispCom *com, LispAtom *name)
+{
+    com_BytecodeAtom(com, XBC_LOADSYM_PUSH, name);
+}
+
+static void
+com_LoadCon(LispCom *com, LispObj *constant)
+{
+    if (constant == NIL)
+	com_Bytecode(com, XBC_NIL);
+    else if (constant == T)
+	com_Bytecode(com, XBC_T);
+    else if (constant == UNSPEC) {
+	COMPILE_FAILURE("internal error: loading #<UNSPEC>");
+    }
+    else
+	com_BytecodeObject(com, XBC_LOADCON, constant);
+}
+
+static void
+com_LoadConLet(LispCom *com, LispObj *constant, LispAtom *name)
+{
+    if (constant == NIL)
+	com_BytecodeAtom(com, XBC_LET_NIL, name);
+    else {
+	CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+	tree->code = XBC_LOADCON_LET;
+	tree->data.let_con.object = constant;
+	tree->data.let_con.name = name;
+    }
+}
+
+static void
+com_LoadConPush(LispCom *com, LispObj *constant)
+{
+    if (constant == NIL)
+	com_Bytecode(com, XBC_PUSH_NIL);
+    else if (constant == T)
+	com_Bytecode(com, XBC_PUSH_T);
+    else if (constant == UNSPEC)
+	com_Bytecode(com, XBC_PUSH_UNSPEC);
+    else
+	com_BytecodeObject(com, XBC_LOADCON_PUSH, constant);
+}
+
+static void
+com_Set(LispCom *com, short offset)
+{
+    com_BytecodeShort(com, XBC_SET, offset);
+}
+
+static void
+com_SetSym(LispCom *com, LispAtom *symbol)
+{
+    com_BytecodeAtom(com, XBC_SETSYM, symbol);
+}
+
+static void
+com_Struct(LispCom *com, short offset, LispObj *definition)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = XBC_STRUCT;
+    tree->data.struc.offset = offset;
+    tree->data.struc.definition = definition;
+}
+
+static void
+com_Structp(LispCom *com, LispObj *definition)
+{
+    com_BytecodeObject(com, XBC_STRUCTP, definition);
+}
+
+static void
+com_Call(LispCom *com, unsigned char num_arguments, LispBuiltin *builtin)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = XBC_CALL;
+    tree->data.builtin.num_arguments = num_arguments;
+    tree->data.builtin.builtin = builtin;
+}
+
+static void
+com_Bytecall(LispCom *com, unsigned char num_arguments, LispObj *code)
+{
+    CodeTree *tree = NEW_TREE(CodeTreeBytecode);
+
+    tree->code = XBC_BYTECALL;
+    tree->data.bytecall.num_arguments = num_arguments;
+    tree->data.bytecall.code = code;
+}
+
+static void
+com_Funcall(LispCom *com, LispObj *function, LispObj *arguments)
+{
+    com_BytecodeCons(com, XBC_FUNCALL, function, arguments);
+}
+
+static void
+CompileStackEnter(LispCom *com, int count, int builtin)
+{
+    if (!com->macro) {
+	if (builtin) {
+	    com->stack.cbstack += count;
+	    if (com->stack.bstack < com->stack.cbstack)
+		com->stack.bstack = com->stack.cbstack;
+	}
+	else {
+	    com->stack.cstack += count;
+	    if (com->stack.stack < com->stack.cstack)
+		com->stack.stack = com->stack.cstack;
+	}
+    }
+}
+
+static void
+CompileStackLeave(LispCom *com, int count, int builtin)
+{
+    if (!com->macro) {
+	if (builtin)
+	    com->stack.cbstack -= count;
+	else
+	    com->stack.cstack -= count;
+    }
+}
+
+static void
+LinkWarnUnused(LispCom *com, CodeBlock *block)
+{
+    int i;
+    CodeTree *tree;
+
+    for (tree = block->tree; tree; tree = tree->next) {
+	if (tree->type == CodeTreeBlock)
+	    LinkWarnUnused(com, tree->data.block);
+    }
+
+    for (i = 0; i < block->variables.length; i++)
+	if (!(block->variables.flags[i] & (VARIABLE_USED | VARIABLE_ARGUMENT))) {
+	    ++com->warnings;
+	    LispWarning("the variable %s is unused",
+			block->variables.symbols[i]->string);
+	}
+}
+
+#define	INTERNAL_ERROR_STRING "COMPILE: internal error #%d"
+#define	INTERNAL_ERROR(value) LispDestroy(INTERNAL_ERROR_STRING, value)
+static long
+LinkBuildOffsets(LispCom *com, CodeTree *tree, long offset)
+{
+    for (; tree; tree = tree->next) {
+	tree->offset = offset;
+	switch (tree->type) {
+	    case CodeTreeBytecode:
+		switch (tree->code) {
+		    case XBC_NOOP:
+			INTERNAL_ERROR(__LINE__);
+			break;
+
+		    /* byte */
+		    case XBC_BCONS:
+		    case XBC_BCONS1:
+		    case XBC_BCONS2:
+		    case XBC_BCONS3:
+		    case XBC_BCONS4:
+		    case XBC_BCONS5:
+		    case XBC_BCONS6:
+		    case XBC_BCONS7:
+		    case XBC_INV:
+		    case XBC_NIL:
+		    case XBC_T:
+		    case XBC_PUSH:
+		    case XBC_CAR_PUSH:
+		    case XBC_CDR_PUSH:
+		    case XBC_PUSH_NIL:
+		    case XBC_PUSH_UNSPEC:
+		    case XBC_PUSH_T:
+		    case XBC_LSTAR:
+		    case XBC_LCONS:
+		    case XBC_LFINI:
+		    case XBC_RETURN:
+		    case XBC_CSTAR:
+		    case XBC_CFINI:
+		    case XBC_CAR:
+		    case XBC_CDR:
+		    case XBC_RPLACA:
+		    case XBC_RPLACD:
+		    case XBC_EQ:
+		    case XBC_EQL:
+		    case XBC_EQUAL:
+		    case XBC_EQUALP:
+		    case XBC_LENGTH:
+		    case XBC_LAST:
+		    case XBC_NTHCDR:
+			++offset;
+			break;
+
+		    /* byte + byte */
+		    case XBC_PUSH_NIL_N:
+		    case XBC_PUSH_UNSPEC_N:
+		    case XBC_PRED:
+		    case XBC_LETREC:
+		    case XBC_LOAD_PUSH:
+		    case XBC_CAR_SET:
+		    case XBC_CDR_SET:
+		    case XBC_SET:
+		    case XBC_SET_NIL:
+		    case XBC_LETBIND:
+		    case XBC_UNLET:
+		    case XBC_LOAD:
+		    case XBC_LOAD_CAR:
+		    case XBC_LOAD_CDR:
+		    case XBC_LOAD_CAR_STORE:
+		    case XBC_LOAD_CDR_STORE:
+		    case XBC_LET:
+		    case XBC_LETX:
+		    case XBC_LET_NIL:
+		    case XBC_LETX_NIL:
+		    case XBC_STRUCTP:
+		    case XBC_SETSYM:
+		    case XBC_LOADCON_PUSH:
+		    case XBC_LOADSYM_PUSH:
+		    case XBC_LOADCON:
+		    case XBC_LOADSYM:
+			offset += 2;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_CALL:
+		    case XBC_BYTECALL:
+		    case XBC_LOAD_SET:
+		    case XBC_LOAD_CAR_SET:
+		    case XBC_LOAD_CDR_SET:
+		    case XBC_LOADCON_SET:
+		    case XBC_LOAD_LET:
+		    case XBC_LOAD_LETX:
+		    case XBC_STRUCT:
+		    case XBC_LOADCON_LET:
+		    case XBC_LOADCON_LETX:
+		    case XBC_LOADSYM_LET:
+		    case XBC_LOADSYM_LETX:
+		    case XBC_CCONS:
+		    case XBC_FUNCALL:
+			offset += 3;
+			break;
+
+		    /* byte + short */
+		    case XBC_JUMP:
+		    case XBC_JUMPT:
+		    case XBC_JUMPNIL:
+			/* XXX this is likely a jump to random address here */
+			INTERNAL_ERROR(__LINE__);
+			offset += sizeof(short) + 1;
+			break;
+
+		    /* byte + byte + byte + byte */
+		    case XBC_CALL_SET:
+			offset += 4;
+			break;
+		}
+		break;
+	    case CodeTreeLabel:
+		/* Labels are not loaded */
+		break;
+	    case CodeTreeJump:
+	    case CodeTreeJumpIf:
+	    case CodeTreeCond:
+		/* If not the point where the conditional block finishes */
+		if (tree->code != XBC_NOOP)
+		    /* Reserve space for the jump opcode */
+		    offset += sizeof(short) + 1;
+		break;
+	    case CodeTreeGo:
+	    case CodeTreeReturn:
+		/* Reserve space for the jump opcode */
+		offset += sizeof(short) + 1;
+		break;
+	    case CodeTreeBlock:
+		offset = LinkBuildOffsets(com, tree->data.block->tree, offset);
+		break;
+	}
+    }
+
+    return (offset);
+}
+
+static void
+LinkDoOptimize_0(LispCom *com, CodeBlock *block)
+{
+    CodeTree *tree, *prev, *next;
+
+    /*  Remove redundant or join opcodes that can be joined. Do it here
+     * because some of these are hard to detect earlier, and/or would
+     * require a lot of duplicated code or more time. */
+    tree = prev = block->tree;
+    while (tree) {
+	next = tree->next;
+
+	/* LET -> LET* */
+	if (next &&
+	    next->type == CodeTreeBytecode &&
+	    next->code == XBC_LETBIND &&
+	    next->data.signed_short == 1) {
+	    switch (tree->code) {
+		case XBC_LET:
+		    tree->code = XBC_LETX;
+		    goto remove_next_label;
+		case XBC_LET_NIL:
+		    tree->code = XBC_LETX_NIL;
+		    goto remove_next_label;
+		case XBC_LOAD_LET:
+		    tree->code = XBC_LOAD_LETX;
+		    goto remove_next_label;
+		case XBC_LOADCON_LET:
+		    tree->code = XBC_LOADCON_LETX;
+		    goto remove_next_label;
+		case XBC_LOADSYM_LET:
+		    tree->code = XBC_LOADSYM_LETX;
+		    goto remove_next_label;
+		default:
+		    break;
+	    }
+	}
+
+	switch (tree->type) {
+	    case CodeTreeBytecode:
+		switch (tree->code) {
+		    case XBC_LOADCON:
+			if (next && next->type == CodeTreeBytecode) {
+			    switch (next->code) {
+				case XBC_LET:
+				    next->code = XBC_LOADCON_LET;
+				    next->data.let_con.name =
+					next->data.atom;
+				    next->data.let_con.object =
+					tree->data.object;
+				    goto remove_label;
+				case XBC_PUSH:
+				    next->code = XBC_LOADCON_PUSH;
+				    next->data.object = tree->data.object;
+				    goto remove_label;
+				case XBC_CAR:
+				    if (tree->data.object != NIL) {
+					if (!CONSP(tree->data.object))
+					    LispDestroy("CAR: %s is not a list",
+						        STROBJ(
+							tree->data.object));
+					next->code = XBC_LOADCON;
+					next->data.object =
+					    CAR(tree->data.object);
+				    }
+				    goto remove_label;
+				case XBC_CDR:
+				    if (tree->data.object != NIL) {
+					if (!CONSP(tree->data.object))
+					    LispDestroy("CAR: %s is not a list",
+						        STROBJ(
+							tree->data.object));
+					next->code = XBC_LOADCON;
+					next->data.object =
+					    CDR(tree->data.object);
+				    }
+				    goto remove_label;
+				case XBC_SET:
+				    next->code = XBC_LOADCON_SET;
+				    next->data.load_con_set.offset =
+					next->data.signed_short;
+				    next->data.load_con_set.object =
+					tree->data.object;
+				    goto remove_label;
+				default:
+				    break;
+			    }
+			}
+			break;
+		    case XBC_LOADSYM:
+			if (next && next->type == CodeTreeBytecode) {
+			    switch (next->code) {
+				case XBC_LET:
+				    next->code = XBC_LOADSYM_LET;
+				    next->data.let_sym.name =
+					next->data.atom;
+				    next->data.let_sym.symbol =
+					tree->data.atom;
+				    goto remove_label;
+				case XBC_PUSH:
+				    next->code = XBC_LOADSYM_PUSH;
+				    next->data.atom = tree->data.atom;
+				    goto remove_label;
+				default:
+				    break;
+			    }
+			}
+			break;
+		    case XBC_LOAD:
+			if (next && next->type == CodeTreeBytecode) {
+			    switch (next->code) {
+				case XBC_SET:
+				    next->code = XBC_LOAD_SET;
+				    next->data.load_set.set =
+					next->data.signed_short;
+				    next->data.load_set.load =
+					tree->data.signed_short;
+				    goto remove_label;
+				/* TODO add XBC_LOAD_SETSYM */
+				case XBC_CAR:
+				    next->code = XBC_LOAD_CAR;
+				    next->data.signed_short =
+					tree->data.signed_short;
+				    goto remove_label;
+				case XBC_CDR:
+				    next->code = XBC_LOAD_CDR;
+				    next->data.signed_short =
+					tree->data.signed_short;
+				    goto remove_label;
+				case XBC_PUSH:
+				    tree->code = XBC_LOAD_PUSH;
+				    goto remove_next_label;
+				case XBC_LET:
+				    next->code = XBC_LOAD_LET;
+				    next->data.let.name = next->data.atom;
+				    next->data.let.offset =
+					tree->data.signed_short;
+				    goto remove_label;
+				default:
+				    break;
+			    }
+			}
+			break;
+		    case XBC_LOAD_CAR:
+			if (next && next->type == CodeTreeBytecode &&
+			    next->code == XBC_SET) {
+			    if (next->data.signed_short ==
+				tree->data.signed_short)
+				next->code = XBC_LOAD_CAR_STORE;
+			    else {
+				next->code = XBC_LOAD_CAR_SET;
+				next->data.load_set.set =
+				    next->data.signed_short;
+				next->data.load_set.load =
+				    tree->data.signed_short;
+			    }
+			    goto remove_label;
+			}
+			break;
+		    case XBC_LOAD_CDR:
+			if (next && next->type == CodeTreeBytecode &&
+			    next->code == XBC_SET) {
+			    if (next->data.signed_short ==
+				tree->data.signed_short)
+				next->code = XBC_LOAD_CDR_STORE;
+			    else {
+				next->code = XBC_LOAD_CDR_SET;
+				next->data.load_set.set =
+				    next->data.signed_short;
+				next->data.load_set.load =
+				    tree->data.signed_short;
+			    }
+			    goto remove_label;
+			}
+			break;
+		    case XBC_CALL:
+			if (next && next->type == CodeTreeBytecode) {
+			    switch (next->code) {
+				case XBC_SET:
+				    next->code = XBC_CALL_SET;
+				    next->data.builtin.offset =
+					next->data.signed_short;
+				    next->data.builtin.num_arguments =
+					tree->data.builtin.num_arguments;
+				    next->data.builtin.builtin =
+					tree->data.builtin.builtin;
+				    goto remove_label;
+				/* TODO add XBC_CALL_SETSYM */
+				default:
+				    break;
+			    }
+			}
+			break;
+		    case XBC_CAR:
+			if (next && next->type == CodeTreeBytecode) {
+			    switch (next->code) {
+				case XBC_SET:
+				    next->code = XBC_CAR_SET;
+				    goto remove_label;
+				/* TODO add XBC_CAR_SETSYM */
+				case XBC_PUSH:
+				    next->code = XBC_CAR_PUSH;
+				    goto remove_label;
+				default:
+				    break;
+			    }
+			}
+			break;
+		    case XBC_CDR:
+			if (next && next->type == CodeTreeBytecode) {
+			    switch (next->code) {
+				case XBC_SET:
+				    next->code = XBC_CDR_SET;
+				    goto remove_label;
+				/* TODO add XBC_CDR_SETSYM */
+				case XBC_PUSH:
+				    next->code = XBC_CDR_PUSH;
+				    goto remove_label;
+				default:
+				    break;
+			    }
+			}
+			break;
+		    case XBC_NIL:
+			if (next && next->type == CodeTreeBytecode) {
+			    switch (next->code) {
+				case XBC_SET:
+				    next->code = XBC_SET_NIL;
+				    goto remove_label;
+				/* TODO add XBC_SETSYM_NIL */
+				default:
+				    break;
+			    }
+			}
+			break;
+		    case XBC_PUSH_NIL:
+			if (next && next->type == CodeTreeBytecode &&
+			    next->code == XBC_PUSH_NIL) {
+			    next->code = XBC_PUSH_NIL_N;
+			    next->data.signed_char = 2;
+			    goto remove_label;
+			}
+			break;
+		    case XBC_PUSH_NIL_N:
+			if (next && next->type == CodeTreeBytecode &&
+			    next->code == XBC_PUSH_NIL) {
+			    next->code = XBC_PUSH_NIL_N;
+			    next->data.signed_char = tree->data.signed_char + 1;
+			    goto remove_label;
+			}
+			break;
+		    case XBC_PUSH_UNSPEC:
+			if (next && next->type == CodeTreeBytecode &&
+			    next->code == XBC_PUSH_UNSPEC) {
+			    next->code = XBC_PUSH_UNSPEC_N;
+			    next->data.signed_char = 2;
+			    goto remove_label;
+			}
+			break;
+		    case XBC_PUSH_UNSPEC_N:
+			if (next && next->type == CodeTreeBytecode &&
+			    next->code == XBC_PUSH_UNSPEC) {
+			    next->code = XBC_PUSH_UNSPEC_N;
+			    next->data.signed_char = tree->data.signed_char + 1;
+			    goto remove_label;
+			}
+			break;
+		    default:
+			break;
+		}
+		break;
+	    case CodeTreeBlock:
+		LinkDoOptimize_0(com, tree->data.block);
+		break;
+	    default:
+		break;
+	}
+	goto update_label;
+remove_label:
+	if (tree == block->tree) {
+	    block->tree = prev = next;
+	    if (tree == block->tail)
+		block->tail = tree;
+	}
+	else
+	    prev->next = next;
+	CompileFreeTree(tree);
+	tree = next;
+	continue;
+remove_next_label:
+	tree->next = next->next;
+	CompileFreeTree(next);
+	continue;
+update_label:
+	prev = tree;
+	tree = tree->next;
+    }
+}
+
+static void
+LinkOptimize_0(LispCom *com)
+{
+    /* Recursive */
+    LinkDoOptimize_0(com, com->block);
+}
+
+static void
+LinkResolveLabels(LispCom *com, CodeBlock *block)
+{
+    int i;
+    CodeTree *tree = block->tree;
+
+    for (; tree; tree = tree->next) {
+	if (tree->type == CodeTreeBlock)
+	    LinkResolveLabels(com, tree->data.block);
+	else if (tree->type == CodeTreeLabel) {
+	    for (i = 0; i < block->tagbody.length; i++)
+		if (tree->data.object == block->tagbody.labels[i]) {
+		    block->tagbody.codes[i] = tree;
+		    break;
+		}
+	}
+    }
+}
+
+static void
+LinkResolveJumps(LispCom *com, CodeBlock *block)
+{
+    int i;
+    CodeBlock *body = block;
+    CodeTree *ptr, *tree = block->tree;
+
+    /* Check if there is a tagbody. Error checking already done */
+    while (body && body->type != LispBlockBody)
+	body = body->prev;
+
+    for (; tree; tree = tree->next) {
+	switch (tree->type) {
+	    case CodeTreeBytecode:
+	    case CodeTreeLabel:
+		break;
+
+	    case CodeTreeBlock:
+		LinkResolveJumps(com, tree->data.block);
+		break;
+
+	    case CodeTreeGo:
+		for (i = 0; i < body->tagbody.length; i++)
+		    if (tree->data.object == body->tagbody.labels[i])
+			break;
+		if (i == body->tagbody.length)
+		    LispDestroy("COMPILE: no visible tag %s to GO",
+				STROBJ(tree->data.object));
+		/* Now the jump code is known */
+		tree->data.tree = body->tagbody.codes[i];
+		break;
+
+	    case CodeTreeCond:
+		if (tree->code == XBC_JUMPNIL)
+		    /* If test is NIL, go to next test */
+		    tree->data.tree = tree->group->next;
+		else if (tree->code == XBC_JUMPT) {
+		    /* After executing code, test was T */
+		    for (ptr = tree->group;
+			 ptr->code != XBC_NOOP;
+			 ptr = ptr->group)
+			;
+		    tree->data.tree = ptr;
+		}
+		break;
+
+	    case CodeTreeJumpIf:
+		if (tree->code != XBC_NOOP) {
+		    for (ptr = tree->group;
+			 ptr->code != XBC_NOOP;
+			 ptr = ptr->group) {
+			if (ptr->type == CodeTreeJump) {
+			    /* ELSE code of IF */
+			    ptr = ptr->next;
+			    /* Skip inconditional jump node */
+			    break;
+			}
+		    }
+		    tree->data.tree = ptr;
+		}
+		break;
+
+	    case CodeTreeJump:
+		if (tree->code != XBC_NOOP)
+		    tree->data.tree = tree->group;
+		break;
+
+	    case CodeTreeReturn:
+		/* One bytecode is guaranteed to exist in the code tree */
+		if (tree->data.block->parent == NULL)
+		    /* Returning from the function or toplevel form */
+		    tree->data.tree = tree->data.block->tail;
+		else {
+		    for (;;) {
+			ptr = tree->data.block->parent->next;
+			if (ptr) {
+			    tree->data.tree = ptr;
+			    break;
+			}
+			else
+			    /* Move one BLOCK up */
+			    tree->data.block = tree->data.block->prev;
+		    }
+		}
+		break;
+	}
+    }
+}
+
+static long
+LinkPad(long offset, long adjust, int preffix, int datalen)
+{
+    /* If byte or aligned data */
+    if (datalen <= preffix || ((offset + adjust + preffix) % datalen) == 0)
+	return (adjust);
+
+    return (adjust + (datalen - ((offset + adjust + preffix) % datalen)));
+}
+
+static long
+LinkFixupOffsets(LispCom *com, CodeTree *tree, long adjust)
+{
+    for (; tree; tree = tree->next) {
+	switch (tree->type) {
+	    case CodeTreeBytecode:
+		switch (tree->code) {
+		    /* byte + short */
+		    case XBC_JUMP:
+		    case XBC_JUMPT:
+		    case XBC_JUMPNIL:
+			adjust = LinkPad(tree->offset, adjust, 1,
+					 sizeof(short));
+			/*FALLTROUGH*/
+		    default:
+			tree->offset += adjust;
+			break;
+		}
+		break;
+	    case CodeTreeLabel:
+		/* Labels are not loaded, just adjust offset */
+		tree->offset += adjust;
+		break;
+	    case CodeTreeJump:
+	    case CodeTreeCond:
+	    case CodeTreeJumpIf:
+		/* If an opcode will be generated. */
+		if (tree->code != XBC_NOOP)
+		    adjust = LinkPad(tree->offset, adjust, 1, sizeof(short));
+		tree->offset += adjust;
+		break;
+	    case CodeTreeGo:
+	    case CodeTreeReturn:
+		adjust = LinkPad(tree->offset, adjust, 1, sizeof(short));
+		tree->offset += adjust;
+		break;
+	    case CodeTreeBlock:
+		adjust = LinkFixupOffsets(com, tree->data.block->tree, adjust);
+		break;
+	}
+    }
+
+    return (adjust);
+}
+
+static void
+LinkSkipPadding(LispCom *com, CodeTree *tree)
+{
+    int found;
+    CodeTree *ptr;
+
+    /* Recurse to adjust forward jumps or jumps to the start of the block */
+    for (ptr = tree; ptr; ptr = ptr->next) {
+	if (ptr->type == CodeTreeBlock) {
+	    LinkSkipPadding(com, ptr->data.block->tree);
+	    ptr->offset = ptr->data.block->tree->offset;
+	}
+    }
+
+    /* Adjust the nodes offsets */
+    for (; tree; tree = tree->next) {
+	switch (tree->type) {
+	    case CodeTreeBytecode:
+	    case CodeTreeBlock:
+	    case CodeTreeGo:
+	    case CodeTreeReturn:
+		break;
+	    case CodeTreeJump:
+	    case CodeTreeCond:
+	    case CodeTreeJumpIf:
+		if (tree->code != XBC_NOOP)
+		    /* If code will be generated */
+		    break;
+	    case CodeTreeLabel:
+		/* This should be done in reversed order, but to avoid
+		 * the requirement of a prev pointer, do the job in a
+		 * harder way here. */
+		for (found = 0, ptr = tree->next; ptr; ptr = ptr->next) {
+		    switch (ptr->type) {
+			case CodeTreeBytecode:
+			case CodeTreeBlock:
+			case CodeTreeGo:
+			case CodeTreeReturn:
+			    found = 1;
+			    break;
+			case CodeTreeJump:
+			case CodeTreeCond:
+			case CodeTreeJumpIf:
+			    if (ptr->code != XBC_NOOP)
+				found = 1;
+			    break;
+			case CodeTreeLabel:
+			    break;
+		    }
+		    if (found)
+			break;
+		}
+		if (found)
+		    tree->offset = ptr->offset;
+		break;
+	}
+    }
+}
+
+static void
+LinkCalculateJump(LispCom *com, CodeTree *tree, LispByteOpcode code)
+{
+    long jumpto, offset, distance;
+
+    tree->type = CodeTreeBytecode;
+    /* After the opcode */
+    offset = tree->offset + 1;
+    jumpto = tree->data.tree->offset;
+    /* Effective distance */
+    distance = jumpto - offset;
+    tree->code = code;
+    if (distance < -32768 || distance > 32767) {
+	COMPILE_FAILURE("jump too long");
+    }
+    tree->data.signed_int = distance;
+}
+
+static void
+LinkFixupJumps(LispCom *com, CodeTree *tree)
+{
+    for (; tree; tree = tree->next) {
+	switch (tree->type) {
+	    case CodeTreeBytecode:
+	    case CodeTreeLabel:
+		break;
+	    case CodeTreeCond:
+		if (tree->code == XBC_JUMPNIL)
+		    /* Go to next test if NIL */
+		    LinkCalculateJump(com, tree, XBC_JUMPNIL);
+		else if (tree->code == XBC_JUMPT)
+		    /* After executing T code */
+		    LinkCalculateJump(com, tree, XBC_JUMP);
+		break;
+	    case CodeTreeJumpIf:
+		if (tree->code != XBC_NOOP)
+		    LinkCalculateJump(com, tree, tree->code);
+		break;
+	    case CodeTreeGo:
+		/* Inconditional jump */
+		LinkCalculateJump(com, tree, XBC_JUMP);
+		break;
+	    case CodeTreeReturn:
+		/* Inconditional jump */
+		if (tree->data.tree != tree)
+		    /* If need to skip something */
+		    LinkCalculateJump(com, tree, XBC_JUMP);
+		break;
+	    case CodeTreeBlock:
+		LinkFixupJumps(com, tree->data.block->tree);
+		break;
+	    case CodeTreeJump:
+		if (tree->code != XBC_NOOP)
+		    LinkCalculateJump(com, tree, tree->code);
+	}
+    }
+}
+
+static void
+LinkBuildTableSymbol(LispCom *com, LispAtom *symbol)
+{
+    if (BuildTablePointer(symbol, (void***)&com->table.symbols,
+			  &com->table.num_symbols) > 0xff) {
+	COMPILE_FAILURE("more than 256 symbols");
+    }
+}
+
+static void
+LinkBuildTableConstant(LispCom *com, LispObj *constant)
+{
+    if (BuildTablePointer(constant, (void***)&com->table.constants,
+			  &com->table.num_constants) > 0xff) {
+	COMPILE_FAILURE("more than 256 constants");
+    }
+}
+
+static void
+LinkBuildTableBuiltin(LispCom *com, LispBuiltin *builtin)
+{
+    if (BuildTablePointer(builtin, (void***)&com->table.builtins,
+			  &com->table.num_builtins) > 0xff) {
+	COMPILE_FAILURE("more than 256 functions");
+    }
+}
+
+static void
+LinkBuildTableBytecode(LispCom *com, LispObj *bytecode)
+{
+    if (BuildTablePointer(bytecode, (void***)&com->table.bytecodes,
+			  &com->table.num_bytecodes) > 0xff) {
+	COMPILE_FAILURE("more than 256 bytecode functions");
+    }
+}
+
+static void
+LinkBuildTables(LispCom *com, CodeBlock *block)
+{
+    CodeTree *tree;
+
+    for (tree = block->tree; tree; tree = tree->next) {
+	switch (tree->type) {
+	    case CodeTreeBytecode:
+		switch (tree->code) {
+		    case XBC_LET:
+		    case XBC_LETX:
+		    case XBC_LET_NIL:
+		    case XBC_LETX_NIL:
+		    case XBC_SETSYM:
+		    case XBC_LOADSYM:
+		    case XBC_LOADSYM_PUSH:
+			LinkBuildTableSymbol(com, tree->data.atom);
+			break;
+		    case XBC_STRUCTP:
+		    case XBC_LOADCON:
+		    case XBC_LOADCON_PUSH:
+			LinkBuildTableConstant(com, tree->data.object);
+			break;
+		    case XBC_LOADCON_SET:
+			LinkBuildTableConstant(com, tree->data.load_con_set.object);
+			break;
+		    case XBC_CALL:
+		    case XBC_CALL_SET:
+			LinkBuildTableBuiltin(com, tree->data.builtin.builtin);
+			break;
+		    case XBC_BYTECALL:
+			LinkBuildTableBytecode(com, tree->data.bytecall.code);
+			break;
+		    case XBC_LOAD_LET:
+		    case XBC_LOAD_LETX:
+			LinkBuildTableSymbol(com, tree->data.let.name);
+			break;
+		    case XBC_STRUCT:
+			LinkBuildTableConstant(com, tree->data.struc.definition);
+			break;
+		    case XBC_LOADSYM_LET:
+		    case XBC_LOADSYM_LETX:
+			LinkBuildTableSymbol(com, tree->data.let_sym.symbol);
+			LinkBuildTableSymbol(com, tree->data.let_sym.name);
+			break;
+		    case XBC_LOADCON_LET:
+		    case XBC_LOADCON_LETX:
+			LinkBuildTableConstant(com, tree->data.let_con.object);
+			LinkBuildTableSymbol(com, tree->data.let_con.name);
+			break;
+		    case XBC_CCONS:
+		    case XBC_FUNCALL:
+			LinkBuildTableConstant(com, tree->data.cons.car);
+			LinkBuildTableConstant(com, tree->data.cons.cdr);
+			break;
+		    default:
+			break;
+		}
+		break;
+	    case CodeTreeBlock:
+		LinkBuildTables(com, tree->data.block);
+		break;
+	    default:
+		break;
+	}
+    }
+}
+
+static long
+LinkEmmitBytecode(LispCom *com, CodeTree *tree,
+		  unsigned char *bytecode, long offset)
+{
+    short i;
+
+    for (; tree; tree = tree->next) {
+	/* Fill padding */
+	while (offset < tree->offset)
+	    bytecode[offset++] = XBC_NOOP;
+
+	switch (tree->type) {
+	    case CodeTreeBytecode:
+		bytecode[offset++] = tree->code;
+		switch (tree->code) {
+		    /* Noop should not enter the CodeTree */
+		    case XBC_NOOP:
+			INTERNAL_ERROR(__LINE__);
+			break;
+
+		    /* byte */
+		    case XBC_BCONS:
+		    case XBC_BCONS1:
+		    case XBC_BCONS2:
+		    case XBC_BCONS3:
+		    case XBC_BCONS4:
+		    case XBC_BCONS5:
+		    case XBC_BCONS6:
+		    case XBC_BCONS7:
+		    case XBC_INV:
+		    case XBC_NIL:
+		    case XBC_T:
+		    case XBC_PUSH_NIL:
+		    case XBC_PUSH_UNSPEC:
+		    case XBC_PUSH_T:
+		    case XBC_CAR_PUSH:
+		    case XBC_CDR_PUSH:
+		    case XBC_PUSH:
+		    case XBC_LSTAR:
+		    case XBC_LCONS:
+		    case XBC_LFINI:
+		    case XBC_RETURN:
+		    case XBC_CSTAR:
+		    case XBC_CFINI:
+		    case XBC_CAR:
+		    case XBC_CDR:
+		    case XBC_RPLACA:
+		    case XBC_RPLACD:
+		    case XBC_EQ:
+		    case XBC_EQL:
+		    case XBC_EQUAL:
+		    case XBC_EQUALP:
+		    case XBC_LENGTH:
+		    case XBC_LAST:
+		    case XBC_NTHCDR:
+			break;
+
+		    /* byte + byte */
+		    case XBC_LETREC:
+		    case XBC_PRED:
+		    case XBC_PUSH_NIL_N:
+		    case XBC_PUSH_UNSPEC_N:
+			bytecode[offset++] = tree->data.signed_char;
+			break;
+
+		    /* byte + byte */
+		    case XBC_CAR_SET:
+		    case XBC_CDR_SET:
+		    case XBC_SET:
+		    case XBC_SET_NIL:
+		    case XBC_LETBIND:
+		    case XBC_UNLET:
+		    case XBC_LOAD_PUSH:
+		    case XBC_LOAD:
+		    case XBC_LOAD_CAR:
+		    case XBC_LOAD_CDR:
+		    case XBC_LOAD_CAR_STORE:
+		    case XBC_LOAD_CDR_STORE:
+			bytecode[offset++] = tree->data.signed_short;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_LOAD_SET:
+		    case XBC_LOAD_CAR_SET:
+		    case XBC_LOAD_CDR_SET:
+			bytecode[offset++] = tree->data.load_set.load;
+			bytecode[offset++] = tree->data.load_set.set;
+			break;
+
+		    /* byte + short */
+		    case XBC_JUMP:
+		    case XBC_JUMPT:
+		    case XBC_JUMPNIL:
+			*(short*)(bytecode + offset) = tree->data.signed_int;
+			offset += sizeof(short);
+			break;
+
+		    /* byte + byte */
+		    case XBC_LET:
+		    case XBC_LETX:
+		    case XBC_LET_NIL:
+		    case XBC_LETX_NIL:
+		    case XBC_SETSYM:
+		    case XBC_LOADSYM:
+		    case XBC_LOADSYM_PUSH:
+			i = FindIndex(tree->data.atom,
+				      (void**)com->table.symbols,
+				      com->table.num_symbols);
+			bytecode[offset++] = i;
+			break;
+
+		    /* byte + byte */
+		    case XBC_STRUCTP:
+		    case XBC_LOADCON:
+		    case XBC_LOADCON_PUSH:
+			i = FindIndex(tree->data.object,
+				      (void**)com->table.constants,
+				      com->table.num_constants);
+			bytecode[offset++] = i;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_LOADCON_SET:
+			i = FindIndex(tree->data.load_con_set.object,
+				      (void**)com->table.constants,
+				      com->table.num_constants);
+			bytecode[offset++] = i;
+			bytecode[offset++] = tree->data.load_con_set.offset;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_CALL:
+			bytecode[offset++] = tree->data.builtin.num_arguments;
+			i = FindIndex(tree->data.builtin.builtin,
+				      (void**)com->table.builtins,
+				      com->table.num_builtins);
+			bytecode[offset++] = i;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_BYTECALL:
+			bytecode[offset++] = tree->data.bytecall.num_arguments;
+			i = FindIndex(tree->data.bytecall.code,
+				      (void**)com->table.bytecodes,
+				      com->table.num_bytecodes);
+			bytecode[offset++] = i;
+			break;
+
+		    /* byte + byte + byte + byte */
+		    case XBC_CALL_SET:
+			bytecode[offset++] = tree->data.builtin.num_arguments;
+			i = FindIndex(tree->data.builtin.builtin,
+				      (void**)com->table.builtins,
+				      com->table.num_builtins);
+			bytecode[offset++] = i;
+			bytecode[offset++] = tree->data.builtin.offset;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_LOAD_LET:
+		    case XBC_LOAD_LETX:
+			bytecode[offset++] = tree->data.let.offset;
+			i = FindIndex(tree->data.let.name,
+				      (void**)com->table.symbols,
+				      com->table.num_symbols);
+			bytecode[offset++] = i;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_STRUCT:
+			bytecode[offset++] = tree->data.struc.offset;
+			i = FindIndex(tree->data.struc.definition,
+				      (void**)com->table.constants,
+				      com->table.num_constants);
+			bytecode[offset++] = i;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_LOADSYM_LET:
+		    case XBC_LOADSYM_LETX:
+			i = FindIndex(tree->data.let_sym.symbol,
+				      (void**)com->table.symbols,
+				      com->table.num_symbols);
+			bytecode[offset++] = i;
+			i = FindIndex(tree->data.let_sym.name,
+				      (void**)com->table.symbols,
+				      com->table.num_symbols);
+			bytecode[offset++] = i;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_LOADCON_LET:
+		    case XBC_LOADCON_LETX:
+			i = FindIndex(tree->data.let_con.object,
+				      (void**)com->table.constants,
+				      com->table.num_constants);
+			bytecode[offset++] = i;
+			i = FindIndex(tree->data.let_con.name,
+				      (void**)com->table.symbols,
+				      com->table.num_symbols);
+			bytecode[offset++] = i;
+			break;
+
+		    /* byte + byte + byte */
+		    case XBC_CCONS:
+		    case XBC_FUNCALL:
+			i = FindIndex(tree->data.cons.car,
+				      (void**)com->table.constants,
+				      com->table.num_constants);
+			bytecode[offset++] = i;
+			i = FindIndex(tree->data.cons.cdr,
+				      (void**)com->table.constants,
+				      com->table.num_constants);
+			bytecode[offset++] = i;
+			break;
+		}
+		break;
+	    case CodeTreeLabel:
+		/* Labels are not loaded */
+		break;
+	    case CodeTreeCond:
+	    case CodeTreeJump:
+	    case CodeTreeJumpIf:
+		if (tree->code != XBC_NOOP)
+		    INTERNAL_ERROR(__LINE__);
+		break;
+	    case CodeTreeGo:
+		INTERNAL_ERROR(__LINE__);
+		break;
+	    case CodeTreeReturn:
+		if (tree->data.tree != tree)
+		    INTERNAL_ERROR(__LINE__);
+		break;
+	    case CodeTreeBlock:
+		offset = LinkEmmitBytecode(com, tree->data.block->tree,
+					   bytecode, offset);
+		break;
+	}
+    }
+
+    return (offset);
+}
+
+static void
+LinkBytecode(LispCom *com)
+{
+    long offset, count;
+    unsigned char **codes;
+    LispObj **names;
+
+    /* Close bytecode */
+    com_Bytecode(com, XBC_RETURN);
+
+    /* The only usage of this information for now, and still may generate
+     * false positives because arguments to unamed functions are not being
+     * parsed as well as arguments to yet undefined function/maros.
+     * XXX should also add declaim/declare to let the code specify that
+     * the argument is unused */
+    LinkWarnUnused(com, com->block);
+
+    /* First level optimization */
+    LinkOptimize_0(com);
+
+    /* Resolve tagbody labels */
+    LinkResolveLabels(com, com->block);
+
+    /* Resolve any pending jumps */
+    LinkResolveJumps(com, com->block);
+
+    /* Calculate unpadded offsets */
+    LinkBuildOffsets(com, com->block->tree, 0);
+
+    /* Do padding for aligned memory reads */
+    LinkFixupOffsets(com, com->block->tree, 0);
+
+    /* Jumps normally are to a node that does not generate code,
+     * and due to padding, the jump may go to a address with a
+     * XBC_NOOP, so adjust the jump to the next useful opcode. */
+    LinkSkipPadding(com, com->block->tree);
+
+    /* Now addresses are known */
+    LinkFixupJumps(com, com->block->tree);
+
+    /* Build symbol, constant and builtin tables */
+    LinkBuildTables(com, com->block);
+
+    /* Stack info */
+    com->length = sizeof(short) * 3;
+    /* Tables info */
+    com->length += sizeof(short) * 4;
+    com->length += com->table.num_constants * sizeof(LispObj*);
+    com->length += com->table.num_symbols * sizeof(LispAtom*);
+    com->length += com->table.num_builtins * sizeof(LispBuiltin*);
+    com->length += com->table.num_bytecodes * sizeof(unsigned char*);
+    com->length += com->table.num_bytecodes * sizeof(LispObj*);
+
+    /* Allocate space for the bytecode stream */
+    com->length += com->block->tail->offset + 1;
+    com->bytecode = LispMalloc(com->length);
+
+    /* Add header */
+    offset = 0;
+    *(short*)(com->bytecode + offset) = com->stack.stack;
+    offset += sizeof(short);
+    *(short*)(com->bytecode + offset) = com->stack.bstack;
+    offset += sizeof(short);
+    *(short*)(com->bytecode + offset) = com->stack.pstack;
+    offset += sizeof(short);
+
+    *(short*)(com->bytecode + offset) = com->table.num_constants;
+    offset += sizeof(short);
+    *(short*)(com->bytecode + offset) = com->table.num_symbols;
+    offset += sizeof(short);
+    *(short*)(com->bytecode + offset) = com->table.num_builtins;
+    offset += sizeof(short);
+    *(short*)(com->bytecode + offset) = com->table.num_bytecodes;
+    offset += sizeof(short);
+
+    count = sizeof(LispObj*) * com->table.num_constants;
+    memcpy(com->bytecode + offset, com->table.constants, count);
+    offset += count;
+    count = sizeof(LispAtom*) * com->table.num_symbols;
+    memcpy(com->bytecode + offset, com->table.symbols, count);
+    offset += count;
+    count = sizeof(LispBuiltin*) * com->table.num_builtins;
+    memcpy(com->bytecode + offset, com->table.builtins, count);
+    offset += count;
+
+    /* Store bytecode information */
+    for (count = 0, codes = (unsigned char**)(com->bytecode + offset);
+	 count < com->table.num_bytecodes; count++, codes++)
+	*codes = com->table.bytecodes[count]->data.bytecode.bytecode->code;
+    offset += com->table.num_bytecodes * sizeof(unsigned char*);
+    /* Store names, only useful for disassemble but may also be used
+     * to check if a function was redefined, and the bytecode is referencing
+     * the older version, the current version can be checked looking at
+     * <name>->data.atom */
+    for (count = 0, names = (LispObj**)(com->bytecode + offset);
+	 count < com->table.num_bytecodes; count++, names++)
+	*names = com->table.bytecodes[count]->data.bytecode.name;
+    offset += com->table.num_bytecodes * sizeof(LispObj*);
+
+    /* Generate it */
+    LinkEmmitBytecode(com, com->block->tree, com->bytecode + offset, 0);
+}
+
+static LispObj *
+ExecuteBytecode(register unsigned char *stream)
+{
+    register LispObj *reg0;
+    register LispAtom *atom;
+    register short offset;
+    LispObj *reg1;
+    LispBuiltin *builtin;
+    LispObj *lambda;
+    LispObj *arguments;
+    unsigned char *bytecode;
+
+    LispObj **constants;
+    LispAtom **symbols;
+    LispBuiltin **builtins;
+    unsigned char **codes;
+    short num_constants, num_symbols, num_builtins, num_codes;
+
+    int lex, len;
+
+    /* To control gc protected slots */
+    int phead, pbase;
+
+    long fixnum = 0;
+
+#if defined(__GNUC__) && !defined(ANSI_SOURCE)
+#define ALLOW_GOTO_ADDRESS
+#endif
+
+#ifdef ALLOW_GOTO_ADDRESS
+#define JUMP_ADDRESS(label)	&&label
+    static const void *opcode_labels[] = {
+	JUMP_ADDRESS(XBC_NOOP),
+	JUMP_ADDRESS(XBC_INV),
+	JUMP_ADDRESS(XBC_NIL),
+	JUMP_ADDRESS(XBC_T),
+	JUMP_ADDRESS(XBC_PRED),
+	JUMP_ADDRESS(XBC_CAR),
+	JUMP_ADDRESS(XBC_CDR),
+	JUMP_ADDRESS(XBC_CAR_SET),
+	JUMP_ADDRESS(XBC_CDR_SET),
+	JUMP_ADDRESS(XBC_RPLACA),
+	JUMP_ADDRESS(XBC_RPLACD),
+	JUMP_ADDRESS(XBC_EQ),
+	JUMP_ADDRESS(XBC_EQL),
+	JUMP_ADDRESS(XBC_EQUAL),
+	JUMP_ADDRESS(XBC_EQUALP),
+	JUMP_ADDRESS(XBC_LENGTH),
+	JUMP_ADDRESS(XBC_LAST),
+	JUMP_ADDRESS(XBC_NTHCDR),
+	JUMP_ADDRESS(XBC_CAR_PUSH),
+	JUMP_ADDRESS(XBC_CDR_PUSH),
+	JUMP_ADDRESS(XBC_PUSH),
+	JUMP_ADDRESS(XBC_PUSH_NIL),
+	JUMP_ADDRESS(XBC_PUSH_UNSPEC),
+	JUMP_ADDRESS(XBC_PUSH_T),
+	JUMP_ADDRESS(XBC_PUSH_NIL_N),
+	JUMP_ADDRESS(XBC_PUSH_UNSPEC_N),
+	JUMP_ADDRESS(XBC_LET),
+	JUMP_ADDRESS(XBC_LETX),
+	JUMP_ADDRESS(XBC_LET_NIL),
+	JUMP_ADDRESS(XBC_LETX_NIL),
+	JUMP_ADDRESS(XBC_LETBIND),
+	JUMP_ADDRESS(XBC_UNLET),
+	JUMP_ADDRESS(XBC_LOAD),
+	JUMP_ADDRESS(XBC_LOAD_LET),
+	JUMP_ADDRESS(XBC_LOAD_LETX),
+	JUMP_ADDRESS(XBC_LOAD_PUSH),
+	JUMP_ADDRESS(XBC_LOADCON),
+	JUMP_ADDRESS(XBC_LOADCON_LET),
+	JUMP_ADDRESS(XBC_LOADCON_LETX),
+	JUMP_ADDRESS(XBC_LOADCON_PUSH),
+	JUMP_ADDRESS(XBC_LOAD_CAR),
+	JUMP_ADDRESS(XBC_LOAD_CDR),
+	JUMP_ADDRESS(XBC_LOAD_CAR_STORE),
+	JUMP_ADDRESS(XBC_LOAD_CDR_STORE),
+	JUMP_ADDRESS(XBC_LOADCON_SET),
+	JUMP_ADDRESS(XBC_LOADSYM),
+	JUMP_ADDRESS(XBC_LOADSYM_LET),
+	JUMP_ADDRESS(XBC_LOADSYM_LETX),
+	JUMP_ADDRESS(XBC_LOADSYM_PUSH),
+	JUMP_ADDRESS(XBC_LOAD_SET),
+	JUMP_ADDRESS(XBC_LOAD_CAR_SET),
+	JUMP_ADDRESS(XBC_LOAD_CDR_SET),
+	JUMP_ADDRESS(XBC_SET),
+	JUMP_ADDRESS(XBC_SETSYM),
+	JUMP_ADDRESS(XBC_SET_NIL),
+	JUMP_ADDRESS(XBC_CALL),
+	JUMP_ADDRESS(XBC_CALL_SET),
+	JUMP_ADDRESS(XBC_BYTECALL),
+	JUMP_ADDRESS(XBC_FUNCALL),
+	JUMP_ADDRESS(XBC_LETREC),
+	JUMP_ADDRESS(XBC_BCONS),
+	JUMP_ADDRESS(XBC_BCONS1),
+	JUMP_ADDRESS(XBC_BCONS2),
+	JUMP_ADDRESS(XBC_BCONS3),
+	JUMP_ADDRESS(XBC_BCONS4),
+	JUMP_ADDRESS(XBC_BCONS5),
+	JUMP_ADDRESS(XBC_BCONS6),
+	JUMP_ADDRESS(XBC_BCONS7),
+	JUMP_ADDRESS(XBC_CCONS),
+	JUMP_ADDRESS(XBC_CSTAR),
+	JUMP_ADDRESS(XBC_CFINI),
+	JUMP_ADDRESS(XBC_LSTAR),
+	JUMP_ADDRESS(XBC_LCONS),
+	JUMP_ADDRESS(XBC_LFINI),
+	JUMP_ADDRESS(XBC_JUMP),
+	JUMP_ADDRESS(XBC_JUMPT),
+	JUMP_ADDRESS(XBC_JUMPNIL),
+	JUMP_ADDRESS(XBC_STRUCT),
+	JUMP_ADDRESS(XBC_STRUCTP),
+	JUMP_ADDRESS(XBC_RETURN)
+    };
+    static const void *predicate_opcode_labels[] = {
+	JUMP_ADDRESS(XBP_CONSP),
+	JUMP_ADDRESS(XBP_LISTP),
+	JUMP_ADDRESS(XBP_NUMBERP)
+    };
+#endif
+
+    reg0 = NIL;
+
+    bytecode = stream;
+    pbase = lisp__data.protect.length;
+
+    /* stack */
+    offset = *(short*)stream;
+    stream += sizeof(short);
+    if (lisp__data.env.length + offset > lisp__data.env.space) {
+	do
+	    LispMoreEnvironment();
+	while (lisp__data.env.length + offset >= lisp__data.env.space);
+    }
+    /* builtin stack */
+    offset = *(short*)stream;
+    stream += sizeof(short);
+    if (lisp__data.stack.length + offset >= lisp__data.stack.space) {
+	do
+	    LispMoreStack();
+	while (lisp__data.stack.length + offset >= lisp__data.stack.space);
+    }
+    /* protect stack */
+    phead = *(short*)stream;
+    stream += sizeof(short);
+    if (lisp__data.protect.length + phead > lisp__data.protect.space) {
+	do
+	    LispMoreProtects();
+	while (lisp__data.protect.length + phead >= lisp__data.protect.space);
+    }
+
+    num_constants = *(short*)stream;
+    stream += sizeof(short);
+    num_symbols = *(short*)stream;
+    stream += sizeof(short);
+    num_builtins = *(short*)stream;
+    stream += sizeof(short);
+    num_codes = *(short*)stream;
+    stream += sizeof(short);
+
+    constants = (LispObj**)stream;
+    stream += num_constants * sizeof(LispObj*);
+    symbols = (LispAtom**)stream;
+    stream += num_symbols * sizeof(LispAtom*);
+    builtins = (LispBuiltin**)stream;
+    stream += num_builtins * sizeof(LispBuiltin*);
+    codes = (unsigned char**)stream;
+    stream += num_codes * (sizeof(unsigned char*) + sizeof(LispObj*));
+
+    for (; phead > 0; phead--)
+	lisp__data.protect.objects[lisp__data.protect.length++] = NIL;
+    phead = pbase;
+
+#ifdef ALLOW_GOTO_ADDRESS
+#define OPCODE_LABEL(label)	label
+#define NEXT_OPCODE()		goto *opcode_labels[*stream++]
+#define GOTO_PREDICATE()	goto *predicate_opcode_labels[*stream++]
+#else
+#define OPCODE_LABEL(label)	case label
+#define NEXT_OPCODE()		goto next_opcode
+#define GOTO_PREDICATE()	goto predicate_label
+    for (;;) {
+next_opcode:
+	switch (*stream++) {
+#endif	/* ALLOW_GOTO_ADDRESS */
+
+OPCODE_LABEL(XBC_NOOP):
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_PRED):
+	GOTO_PREDICATE();
+
+OPCODE_LABEL(XBC_INV):
+	reg0 = reg0 == NIL ? T : NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_NIL):
+	reg0 = NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_T):
+	reg0 = T;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_CAR):
+car:
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("CAR: %s is not a list", STROBJ(reg0));
+	    reg0 = CAR(reg0);
+	}
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_CDR):
+cdr:
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("CDR: %s is not a list", STROBJ(reg0));
+	    reg0 = CDR(reg0);
+	}
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_RPLACA):
+	reg1 = lisp__data.stack.values[--lisp__data.stack.length];
+	if (!CONSP(reg1))
+	    LispDestroy("RPLACA: %s is not a cons", STROBJ(reg1));
+	RPLACA(reg1, reg0);
+	reg0 = reg1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_RPLACD):
+	reg1 = lisp__data.stack.values[--lisp__data.stack.length];
+	if (!CONSP(reg1))
+	    LispDestroy("RPLACD: %s is not a cons", STROBJ(reg1));
+	RPLACD(reg1, reg0);
+	reg0 = reg1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_BCONS):
+	CAR(cons) = reg0;
+	lisp__data.stack.values[lisp__data.stack.length++] = cons;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_BCONS1):
+	offset = lisp__data.stack.length - 1;
+	CAR(cons) = reg0;
+	CAR(cons1) = lisp__data.stack.values[offset];
+	lisp__data.stack.values[offset] = cons1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_BCONS2):
+	offset = lisp__data.stack.length;
+	CAR(cons) = reg0;
+	CAR(cons1) = lisp__data.stack.values[--offset];
+	CAR(cons2) = lisp__data.stack.values[--offset];
+	lisp__data.stack.values[offset] = cons2;
+	lisp__data.stack.length = offset + 1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_BCONS3):
+	offset = lisp__data.stack.length;
+	CAR(cons) = reg0;
+	CAR(cons1) = lisp__data.stack.values[--offset];
+	CAR(cons2) = lisp__data.stack.values[--offset];
+	CAR(cons3) = lisp__data.stack.values[--offset];
+	lisp__data.stack.values[offset] = cons3;
+	lisp__data.stack.length = offset + 1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_BCONS4):
+	offset = lisp__data.stack.length;
+	CAR(cons) = reg0;
+	CAR(cons1) = lisp__data.stack.values[--offset];
+	CAR(cons2) = lisp__data.stack.values[--offset];
+	CAR(cons3) = lisp__data.stack.values[--offset];
+	CAR(cons4) = lisp__data.stack.values[--offset];
+	lisp__data.stack.values[offset] = cons4;
+	lisp__data.stack.length = offset + 1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_BCONS5):
+	offset = lisp__data.stack.length;
+	CAR(cons) = reg0;
+	CAR(cons1) = lisp__data.stack.values[--offset];
+	CAR(cons2) = lisp__data.stack.values[--offset];
+	CAR(cons3) = lisp__data.stack.values[--offset];
+	CAR(cons4) = lisp__data.stack.values[--offset];
+	CAR(cons5) = lisp__data.stack.values[--offset];
+	lisp__data.stack.values[offset] = cons5;
+	lisp__data.stack.length = offset + 1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_BCONS6):
+	offset = lisp__data.stack.length;
+	CAR(cons) = reg0;
+	CAR(cons1) = lisp__data.stack.values[--offset];
+	CAR(cons2) = lisp__data.stack.values[--offset];
+	CAR(cons3) = lisp__data.stack.values[--offset];
+	CAR(cons4) = lisp__data.stack.values[--offset];
+	CAR(cons5) = lisp__data.stack.values[--offset];
+	CAR(cons6) = lisp__data.stack.values[--offset];
+	lisp__data.stack.values[offset] = cons6;
+	lisp__data.stack.length = offset + 1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_BCONS7):
+	offset = lisp__data.stack.length;
+	CAR(cons) = reg0;
+	CAR(cons1) = lisp__data.stack.values[--offset];
+	CAR(cons2) = lisp__data.stack.values[--offset];
+	CAR(cons3) = lisp__data.stack.values[--offset];
+	CAR(cons4) = lisp__data.stack.values[--offset];
+	CAR(cons5) = lisp__data.stack.values[--offset];
+	CAR(cons6) = lisp__data.stack.values[--offset];
+	CAR(cons7) = lisp__data.stack.values[--offset];
+	lisp__data.stack.values[offset] = cons7;
+	lisp__data.stack.length = offset + 1;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_EQ):
+	reg0 = reg0 == lisp__data.stack.values[--lisp__data.stack.length] ? T : NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_EQL):
+	reg1 = lisp__data.stack.values[--lisp__data.stack.length];
+	reg0 = XEQL(reg1, reg0);
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_EQUAL):
+	reg1 = lisp__data.stack.values[--lisp__data.stack.length];
+	reg0 = XEQUAL(reg1, reg0);
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_EQUALP):
+	reg1 = lisp__data.stack.values[--lisp__data.stack.length];
+	reg0 = XEQUALP(reg1, reg0);
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LENGTH):
+	reg0 = FIXNUM(LispLength(reg0));
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LAST):
+    {
+	long length;
+
+	reg1 = lisp__data.stack.values[--lisp__data.stack.length];
+	if (CONSP(reg1)) {
+	    if (reg0 != NIL) {
+		if (!FIXNUMP(reg0) || (fixnum = FIXNUM_VALUE(reg0)) < 0)
+		    LispDestroy("LAST: %s is not a positive fixnum",
+				STROBJ(reg0));
+	    }
+	    else
+		fixnum = 1;
+	    reg0 = reg1;
+	    for (reg0 = reg1, length = 0;
+		 CONSP(reg0);
+		 reg0 = CDR(reg0), length++)
+		;
+	    for (length -= fixnum, reg0 = reg1; length > 0; length--)
+		reg0 = CDR(reg0);
+	}
+	else
+	    reg0 = reg1;
+    }	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_NTHCDR):
+	reg1 = lisp__data.stack.values[--lisp__data.stack.length];
+	if (!FIXNUMP(reg1) || (fixnum = FIXNUM_VALUE(reg1)) < 0)
+	    LispDestroy("NTHCDR: %s is not a positive fixnum",
+			STROBJ(reg1));
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("NTHCDR: %s is not a list", STROBJ(reg0));
+	    for (; fixnum > 0; fixnum--) {
+		if (!CONSP(reg0))
+		    break;
+		reg0 = CDR(reg0);
+	    }
+	}
+	NEXT_OPCODE();
+
+	/* Push to builtin stack */
+OPCODE_LABEL(XBC_CAR_PUSH):
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("CAR: %s is not a list", STROBJ(reg0));
+	    reg0 = CAR(reg0);
+	}
+	goto push_builtin;
+
+OPCODE_LABEL(XBC_CDR_PUSH):
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("CDR: %s is not a list", STROBJ(reg0));
+	    reg0 = CDR(reg0);
+	}
+	/*FALLTROUGH*/
+
+OPCODE_LABEL(XBC_PUSH):
+push_builtin:
+	lisp__data.stack.values[lisp__data.stack.length++] = reg0;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_PUSH_NIL):
+	lisp__data.stack.values[lisp__data.stack.length++] = NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_PUSH_UNSPEC):
+	lisp__data.stack.values[lisp__data.stack.length++] = UNSPEC;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_PUSH_T):
+	lisp__data.stack.values[lisp__data.stack.length++] = T;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_PUSH_NIL_N):
+	for (offset = *stream++; offset > 0; offset--)
+	    lisp__data.stack.values[lisp__data.stack.length++] = NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_PUSH_UNSPEC_N):
+	for (offset = *stream++; offset > 0; offset--)
+	    lisp__data.stack.values[lisp__data.stack.length++] = UNSPEC;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LET):
+let_argument:
+	/*  The global object value is not changed, so it does not
+	 * matter if it is a constant symbol. An error would be
+	 * generated if it was declared as constant at the time of
+	 * bytecode generation. Check can be done looking at the
+	 * atom->constant field. */
+	atom = symbols[*stream++];
+	atom->offset = lisp__data.env.length;
+	lisp__data.env.names[lisp__data.env.length] = atom->string;
+	lisp__data.env.values[lisp__data.env.length++] = reg0;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LETX):
+letx_argument:
+	atom = symbols[*stream++];
+	atom->offset = lisp__data.env.length;
+	lisp__data.env.names[lisp__data.env.length] = atom->string;
+	lisp__data.env.values[lisp__data.env.length++] = reg0;
+	lisp__data.env.head++;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LET_NIL):
+	atom = symbols[*stream++];
+	atom->offset = lisp__data.env.length;
+	lisp__data.env.names[lisp__data.env.length] = atom->string;
+	lisp__data.env.values[lisp__data.env.length++] = NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LETX_NIL):
+	atom = symbols[*stream++];
+	atom->offset = lisp__data.env.length;
+	lisp__data.env.names[lisp__data.env.length] = atom->string;
+	lisp__data.env.values[lisp__data.env.length++] = NIL;
+	lisp__data.env.head++;
+	NEXT_OPCODE();
+
+	/* Bind locally added variables to a block */
+OPCODE_LABEL(XBC_LETBIND):
+	offset = *stream++;
+	lisp__data.env.head += offset;
+	NEXT_OPCODE();
+
+	/* Unbind locally added variables to a block */
+OPCODE_LABEL(XBC_UNLET):
+	offset = *stream++;
+	lisp__data.env.head -= offset;
+	lisp__data.env.length -= offset;
+	NEXT_OPCODE();
+
+	/* Load value from stack */
+OPCODE_LABEL(XBC_LOAD):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LOAD_CAR):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	goto car;
+
+OPCODE_LABEL(XBC_LOAD_CDR):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	goto cdr;
+
+OPCODE_LABEL(XBC_LOAD_CAR_STORE):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("CAR: %s is not a list", STROBJ(reg0));
+	    reg0 = CAR(reg0);
+	    lisp__data.env.values[lisp__data.env.lex + offset] = reg0;
+	}
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LOAD_CDR_STORE):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("CDR: %s is not a list", STROBJ(reg0));
+	    reg0 = CDR(reg0);
+	    lisp__data.env.values[lisp__data.env.lex + offset] = reg0;
+	}
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LOAD_LET):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	goto let_argument;
+
+OPCODE_LABEL(XBC_LOAD_LETX):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	goto letx_argument;
+
+OPCODE_LABEL(XBC_LOAD_PUSH):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	lisp__data.stack.values[lisp__data.stack.length++] = reg0;
+	NEXT_OPCODE();
+
+	/* Load pointer to constant */
+OPCODE_LABEL(XBC_LOADCON):
+	reg0 = constants[*stream++];
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LOADCON_LET):
+	reg0 = constants[*stream++];
+	goto let_argument;
+
+OPCODE_LABEL(XBC_LOADCON_LETX):
+	reg0 = constants[*stream++];
+	goto letx_argument;
+
+OPCODE_LABEL(XBC_LOADCON_PUSH):
+	reg0 = constants[*stream++];
+	lisp__data.stack.values[lisp__data.stack.length++] = reg0;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LOADCON_SET):
+	reg0 = constants[*stream++];
+	offset = *stream++;
+	lisp__data.env.values[lisp__data.env.lex + offset] = reg0;
+	NEXT_OPCODE();
+
+	/* Change value of local variable */
+OPCODE_LABEL(XBC_CAR_SET):
+car_set:
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("CAR: %s is not a list", STROBJ(reg0));
+	    reg0 = CAR(reg0);
+	}
+	goto set_local_variable;
+
+OPCODE_LABEL(XBC_CDR_SET):
+cdr_set:
+	if (reg0 != NIL) {
+	    if (!CONSP(reg0))
+		LispDestroy("CDR: %s is not a list", STROBJ(reg0));
+	    reg0 = CDR(reg0);
+	}
+	goto set_local_variable;
+
+OPCODE_LABEL(XBC_LOAD_CAR_SET):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	goto car_set;
+
+OPCODE_LABEL(XBC_LOAD_CDR_SET):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	goto cdr_set;
+
+OPCODE_LABEL(XBC_LOAD_SET):
+	offset = *stream++;
+	reg0 = lisp__data.env.values[lisp__data.env.lex + offset];
+	/*FALLTROUGH*/
+
+OPCODE_LABEL(XBC_SET):
+set_local_variable:
+	offset = *stream++;
+	lisp__data.env.values[lisp__data.env.lex + offset] = reg0;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_SET_NIL):
+	offset = *stream++;
+	lisp__data.env.values[lisp__data.env.lex + offset] = NIL;
+	NEXT_OPCODE();
+
+	/* Change value of a global/special variable */
+OPCODE_LABEL(XBC_SETSYM):
+	    atom = symbols[*stream++];
+	    if (atom->dyn) {
+		/*  atom->dyn and atom->constant are exclusive, no
+		 * need to check if variable declared as constant. */
+		if (atom->offset < lisp__data.env.head &&
+		    lisp__data.env.names[atom->offset] == atom->string)
+		    lisp__data.env.values[atom->offset] = reg0;
+		else {
+		    if (atom->watch)
+			LispSetAtomObjectProperty(atom, reg0);
+		    else
+			SETVALUE(atom, reg0);
+		}
+	    }
+	    else if (atom->a_object) {
+		if (atom->constant)
+		    LispDestroy("EVAL: %s is a constant",
+				STROBJ(atom->object));
+		else if (atom->watch)
+		    LispSetAtomObjectProperty(atom, reg0);
+		else
+		    SETVALUE(atom, reg0);
+	    }
+	    else {
+		/* Create new global variable */
+		LispPackage *pack;
+
+		LispWarning("the variable %s was not declared",
+			    atom->string);
+		LispSetAtomObjectProperty(atom, reg0);
+		pack = atom->package->data.package.package;
+		if (pack->glb.length >= pack->glb.space)
+		    LispMoreGlobals(pack);
+		pack->glb.pairs[pack->glb.length++] = atom->object;
+	    }
+	    NEXT_OPCODE();
+
+/* Resolve symbol value at runtime */
+#define LOAD_SYMBOL_VALUE()					    \
+    atom = symbols[*stream++];					    \
+    if (atom->dyn) {						    \
+	if (atom->offset < lisp__data.env.head &&		    \
+	    lisp__data.env.names[atom->offset] == atom->string)	    \
+	    reg0 = lisp__data.env.values[atom->offset];		    \
+	else {							    \
+	    reg0 = atom->property->value;			    \
+	    if (reg0 == UNBOUND)				    \
+		LispDestroy("EVAL: the symbol %s is unbound",  \
+			    STROBJ(atom->object));		    \
+	}							    \
+    }								    \
+    else {							    \
+	if (atom->a_object)					    \
+	    reg0 = atom->property->value;			    \
+	else							    \
+	    LispDestroy("EVAL: the symbol %s is unbound",	    \
+			STROBJ(atom->object));			    \
+    }
+
+OPCODE_LABEL(XBC_LOADSYM):
+	LOAD_SYMBOL_VALUE();
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LOADSYM_LET):
+	LOAD_SYMBOL_VALUE();
+	goto let_argument;
+
+OPCODE_LABEL(XBC_LOADSYM_LETX):
+	LOAD_SYMBOL_VALUE();
+	goto letx_argument;
+
+OPCODE_LABEL(XBC_LOADSYM_PUSH):
+	LOAD_SYMBOL_VALUE();
+	lisp__data.stack.values[lisp__data.stack.length++] = reg0;
+	NEXT_OPCODE();
+
+	    /* Builtin function */
+OPCODE_LABEL(XBC_CALL):
+	offset = *stream++;
+	lisp__data.stack.base = lisp__data.stack.length - offset;
+	builtin = builtins[*stream++];
+	if (builtin->multiple_values) {
+	    RETURN_COUNT = 0;
+	    reg0 = builtin->function(builtin);
+	}
+	else {
+	    reg0 = builtin->function(builtin);
+	    RETURN_COUNT = 0;
+	}
+	lisp__data.stack.length -= offset;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_CALL_SET):
+	offset = *stream++;
+	lisp__data.stack.base = lisp__data.stack.length - offset;
+	builtin = builtins[*stream++];
+	if (builtin->multiple_values) {
+	    RETURN_COUNT = 0;
+	    reg0 = builtin->function(builtin);
+	}
+	else {
+	    reg0 = builtin->function(builtin);
+	    RETURN_COUNT = 0;
+	}
+	lisp__data.stack.length -= offset;
+	offset = *stream++;
+	lisp__data.env.values[lisp__data.env.lex + offset] = reg0;
+	NEXT_OPCODE();
+
+	/* Bytecode call */
+OPCODE_LABEL(XBC_BYTECALL):
+	lex = lisp__data.env.lex;
+	offset = *stream++;
+	lisp__data.env.head = lisp__data.env.length;
+	len = lisp__data.env.lex = lisp__data.env.length - offset;
+	reg0 = ExecuteBytecode(codes[*stream++]);
+	lisp__data.env.length = lisp__data.env.head = len;
+	lisp__data.env.lex = lex;
+	NEXT_OPCODE();
+
+	/* Unimplemented function/macro call */
+OPCODE_LABEL(XBC_FUNCALL):
+	lambda = constants[*stream++];
+	arguments = constants[*stream++];
+	reg0 = LispFuncall(lambda, arguments, 1);
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_JUMP):
+	stream += *(signed short*)stream;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_JUMPT):
+	if (reg0 != NIL)
+	    stream += *(signed short*)stream;
+	else
+	    /* skip jump relative offset */
+	    stream += sizeof(signed short);
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_JUMPNIL):
+	if (reg0 == NIL)
+	    stream += *(signed short*)stream;
+	else
+	    /* skip jump relative offset */
+	    stream += sizeof(signed short);
+	NEXT_OPCODE();
+
+	/* Build CONS of two constant arguments */
+OPCODE_LABEL(XBC_CCONS):
+	reg0 = constants[*stream++];
+	reg1 = constants[*stream++];
+	reg0 = CONS(reg0, reg1);
+	NEXT_OPCODE();
+
+	/* Start CONS */
+OPCODE_LABEL(XBC_CSTAR):
+	/* This the CAR of the CONS */
+	lisp__data.protect.objects[phead++] = reg0;
+	NEXT_OPCODE();
+
+	/* Finish CONS */
+OPCODE_LABEL(XBC_CFINI):
+	reg0 = CONS(lisp__data.protect.objects[--phead], reg0);
+	NEXT_OPCODE();
+
+	/* Start building list */
+OPCODE_LABEL(XBC_LSTAR):
+	reg1 = CONS(reg0, NIL);
+	/* Start of list stored here */
+	lisp__data.protect.objects[phead++] = reg1;
+	/* Tail of list stored here */
+	lisp__data.protect.objects[phead++] = reg1;
+	NEXT_OPCODE();
+
+	/* Add to list */
+OPCODE_LABEL(XBC_LCONS):
+	reg1 = lisp__data.protect.objects[phead - 2];
+	RPLACD(reg1, CONS(reg0, NIL));
+	 lisp__data.protect.objects[phead - 2] = CDR(reg1);
+	NEXT_OPCODE();
+
+	/* Finish list */
+OPCODE_LABEL(XBC_LFINI):
+	phead -= 2;
+	reg0 = lisp__data.protect.objects[phead + 1];
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_STRUCT):
+	offset = *stream++;
+	reg1 = constants[*stream++];
+	if (!STRUCTP(reg0) || reg0->data.struc.def != reg1) {
+	    char *name = ATOMID(CAR(reg1));
+
+	    for (reg1 = CDR(reg1); offset; offset--)
+		reg1 = CDR(reg1);
+	    LispDestroy("%s-%s: %s is not a %s",
+			name, ATOMID(CAR(reg1)), STROBJ(reg0), name);
+	}
+	for (reg0 = reg0->data.struc.fields; offset; offset--)
+	    reg0 = CDR(reg0);
+	reg0 = CAR(reg0);
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_STRUCTP):
+	reg1 = constants[*stream++];
+	reg0 = STRUCTP(reg0) && reg0->data.struc.def == reg1 ? T : NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_LETREC):
+	/* XXX could/should optimize, shouldn't need to parse
+	 * the bytecode header again */
+	lex = lisp__data.env.lex;
+	offset = *stream++;
+	lisp__data.env.head = lisp__data.env.length;
+	len = lisp__data.env.lex = lisp__data.env.length - offset;
+	reg0 = ExecuteBytecode(bytecode);
+	lisp__data.env.length = lisp__data.env.head = len;
+	lisp__data.env.lex = lex;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBC_RETURN):
+	lisp__data.protect.length = pbase;
+	return (reg0);
+
+#ifndef ALLOW_GOTO_ADDRESS
+	}	/* end of switch */
+
+predicate_label:
+	switch (*stream++) {
+#endif
+
+OPCODE_LABEL(XBP_CONSP):
+	reg0 = CONSP(reg0) ? T : NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBP_LISTP):
+	reg0 = LISTP(reg0) ? T : NIL;
+	NEXT_OPCODE();
+
+OPCODE_LABEL(XBP_NUMBERP):
+	reg0 = NUMBERP(reg0) ? T : NIL;
+	NEXT_OPCODE();
+
+#ifndef ALLOW_GOTO_ADDRESS
+	}	/* end of switch */
+    }
+#endif
+
+    /*NOTREACHED*/
+    return (reg0);
+}
diff --git a/lisp/bytecode.h b/lisp/bytecode.h
new file mode 100644
index 0000000..40d8444
--- /dev/null
+++ b/lisp/bytecode.h
@@ -0,0 +1,268 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/bytecode.h,v 1.5 2002/11/23 08:26:48 paulo Exp $ */
+
+#include "private.h"
+
+#ifndef Lisp_Bytecode_h
+#define Lisp_Bytecode_h
+
+/* Number of arguments for &REST functions with no side effects,
+ * i.e. does not need to allocate new cells to build argument list.
+ * If this value is changed, it is also required to add more
+ * XBC_BCONS? opcodes and change ExecuteBytecode() */
+#define MAX_BCONS	8
+
+typedef enum {
+    XBP_CONSP,
+    XBP_LISTP,
+    XBP_NUMBERP
+} LispBytePredicate;
+
+typedef enum {
+    XBC_NOOP,
+
+    XBC_INV,		/* If NIL loaded, change to T else to NIL */
+    XBC_NIL,		/* Load NIL */
+    XBC_T,		/* Load T */
+
+    XBC_PRED,		/* Preffix for predicate test */
+	/* Followed by byte indicating test */
+
+    XBC_CAR,		/* Set loaded value to it's car */
+    XBC_CDR,		/* Set loaded value to it's cdr */
+
+    XBC_CAR_SET,	/* Set local variable to CAR or CDR of loaded value */
+    XBC_CDR_SET,
+	/* Offset of local variable follows */
+
+    /* Sets C[AD]R of top of builtin stack with
+     * loaded value and pop builtin stack */
+    XBC_RPLACA,
+    XBC_RPLACD,
+
+    /* Push only one argument in builtin stack, and call directly
+     * LispObjectCompare without the need of pushing the second arguument */
+    XBC_EQ,
+    XBC_EQL,
+    XBC_EQUAL,
+    XBC_EQUALP,
+
+    XBC_LENGTH,
+    XBC_LAST,
+    XBC_NTHCDR,
+
+    XBC_CAR_PUSH,	/* Pushes CAR or CDR of loaded value to builtin stack */
+    XBC_CDR_PUSH,
+
+    XBC_PUSH,		/* Push argument in builtin stack */
+    XBC_PUSH_NIL,	/* Pushes NIL in builtin stack */
+    XBC_PUSH_UNSPEC,	/* Pushes #<UNSPEC> in builtin stack */
+    XBC_PUSH_T,		/* Pushes T in builtin stack */
+    XBC_PUSH_NIL_N,	/* Pushes NIL in the builtin stack N times */
+    XBC_PUSH_UNSPEC_N,	/* Pushes #<UNSPEC> in the builtin stack N times */
+
+
+	/* The builtin stack base is saved when entering the bytecode
+	 * interpreter, and the bytecode does not reenter from builtin
+	 * functions, yet, so there is no need, for XBC_BSAVE and
+	 * XBC_BREST instructions */
+
+    XBC_LET,		/* Push loaded value to stack */
+    XBC_LETX,		/* Push loaded value to stack and bind */
+	/*  Next byte(s) are the symbol offset */
+    XBC_LET_NIL,	/* Push loaded value to stack */
+    XBC_LETX_NIL,	/* Push loaded value to stack and bind */
+	/*  Next byte(s) are the symbol offset */
+
+    XBC_LETBIND,	/* Bind locally added variables */
+	/* Followed by number of symbols to bind */
+
+    XBC_UNLET,		/* Unbind locally binded variables */
+	/* Followed by number of symbols to unbind */
+
+    XBC_LOAD,		/* Load argument already from the stack */
+	/* Followed by  offset follows the opcode */
+    XBC_LOAD_LET,	/* Load argument and push */
+    XBC_LOAD_LETX,	/* Load argument,  push and bind */
+	/* Followed by a short and the atom to be bound */
+    XBC_LOAD_PUSH,
+
+    XBC_LOADCON,	/* Load a literal constant */
+	/* Next bytes are the constant object */
+    XBC_LOADCON_LET,	/* Load a literal constant and push */
+    XBC_LOADCON_LETX,	/* Load a literal constant, push and bind */
+	/* Followed by object constant and symbol to be bound */
+    XBC_LOADCON_PUSH,
+
+    /* Load CAR or CDR of local variable */
+    XBC_LOAD_CAR,
+    XBC_LOAD_CDR,
+
+    /* Change local variable value to it's CAR or CDR */
+    XBC_LOAD_CAR_STORE,
+    XBC_LOAD_CDR_STORE,
+
+    XBC_LOADCON_SET,
+	/* Followed by constant offset and local variable offset */
+
+    XBC_LOADSYM,	/* Load object symbol value */
+	/* The object atom pointer follows de opcode */
+    XBC_LOADSYM_LET,	/* Load object symbol value and push */
+    XBC_LOADSYM_LETX,	/* Load object symbol value, push and bind */
+	/* The symbol atom name and bounded atom name to be bound follows */
+    XBC_LOADSYM_PUSH,
+
+    XBC_LOAD_SET,	/* Set value of local variable to the value of another */
+	/* Followed by two shorts */
+    XBC_LOAD_CAR_SET,	/* Like LOAD_SET, but apply CAR or CDR in the value */
+    XBC_LOAD_CDR_SET,
+
+    XBC_SET,		/* Change value of local variable */
+	/* A short integer with relative offset follows opcode */
+    XBC_SETSYM,		/* Change value of symbol */
+	/* The atom symbol pointer follows opcode */
+
+    XBC_SET_NIL,	/* Like XBC_SET but sets the local variable to NIL */
+
+    XBC_CALL,		/* Call builtin function */
+	/* 1 byte follows telling how many arguments to use */
+	/* LispBuiltin pointer follows opcode */
+
+    XBC_CALL_SET,
+	/* Like BCALL, but also followed by an short index of local variable */
+
+    XBC_BYTECALL,	/* Call bytecode */
+	/* 1 byte for number of arguments */
+	/* 1 byte for index in bytecode table */
+
+    XBC_FUNCALL,
+	/* Opcode followed by function and arguments objects, to
+	 * be evaluated at run time, as it was not resolved at
+	 * bytecode generation time (or is not implemented in
+	 * the bytecode compiler) */
+
+
+    XBC_LETREC,		/* Recursive function call */
+	/* 1 byte follows telling how many arguments the funtion receives */
+
+    /* Helper for math functions. Uses a preallocated CONS,
+     * setting it's CAR to the loaded value, and in the same step
+     * pushes the CONS to the builtin stack */
+    XBC_BCONS,
+    /* Like BCONS but it is a list of 2 arguments, first argument
+     * is saved on the stack, replace with list of 2 arguments */
+    XBC_BCONS1,
+    /* Like BCONS1 but it is a list of 3 arguments, first arguments
+     * are saved on the stack, replace with list of first stack
+     * argument with list or 3 arguments, and pop stack  */
+    XBC_BCONS2,
+    XBC_BCONS3,
+    XBC_BCONS4,
+    XBC_BCONS5,
+    XBC_BCONS6,
+    XBC_BCONS7,
+
+    /* Build a CONS */
+    XBC_CCONS,		/* Make CONS of two constants */
+	/* Constants follow opcode */
+    XBC_CSTAR,		/* Save the CAR of the CONS */
+    XBC_CFINI,		/* Loaded value is the CDR */
+
+    /* These are to help in interactively building lists */
+    XBC_LSTAR,		/* Start building a list in the gc protected stack */
+    XBC_LCONS,		/* Add loaded object to list */
+    XBC_LFINI,		/* List is finished */
+
+    /* Inconditional jumps */
+    XBC_JUMP,		/* Jump relative to following signed int */
+
+    /* Conditional jumps, if true */
+    XBC_JUMPT,		/* Jump relative to following signed int */
+
+    /* Conditional jumps, if false */
+    XBC_JUMPNIL,	/* Jump relative to following signed int */
+
+    /* Structure field access and type check */
+    XBC_STRUCT,
+    XBC_STRUCTP,
+
+    XBC_RETURN		/* Resume bytecode execution */
+} LispByteOpcode;
+
+
+struct _LispBytecode {
+    unsigned char *code;	/* Bytecode data */
+    long length;		/* length of bytecode stream */
+};
+
+/*
+ * Prototypes
+ */
+void LispBytecodeInit(void);
+
+LispObj *Lisp_Compile(LispBuiltin*);
+LispObj *Lisp_Disassemble(LispBuiltin*);
+
+LispObj *LispCompileForm(LispObj*);
+LispObj *LispExecuteBytecode(LispObj*);
+
+void Com_And(LispCom*, LispBuiltin*);
+void Com_Block(LispCom*, LispBuiltin*);
+void Com_C_r(LispCom*, LispBuiltin*);
+void Com_Cond(LispCom*, LispBuiltin*);
+void Com_Cons(LispCom*, LispBuiltin*);
+void Com_Consp(LispCom*, LispBuiltin*);
+void Com_Dolist(LispCom*, LispBuiltin*);
+void Com_Eq(LispCom*, LispBuiltin*);
+void Com_Go(LispCom*, LispBuiltin*);
+void Com_If(LispCom*, LispBuiltin*);
+void Com_Last(LispCom*, LispBuiltin*);
+void Com_Length(LispCom*, LispBuiltin*);
+void Com_Let(LispCom*, LispBuiltin*);
+void Com_Letx(LispCom*, LispBuiltin*);
+void Com_Listp(LispCom*, LispBuiltin*);
+void Com_Loop(LispCom*, LispBuiltin*);
+void Com_Nthcdr(LispCom*, LispBuiltin*);
+void Com_Null(LispCom*, LispBuiltin*);
+void Com_Numberp(LispCom*, LispBuiltin*);
+void Com_Or(LispCom*, LispBuiltin*);
+void Com_Progn(LispCom*, LispBuiltin*);
+void Com_Return(LispCom*, LispBuiltin*);
+void Com_ReturnFrom(LispCom*, LispBuiltin*);
+void Com_Rplac_(LispCom*, LispBuiltin*);
+void Com_Setq(LispCom*, LispBuiltin*);
+void Com_Tagbody(LispCom*, LispBuiltin*);
+void Com_Unless(LispCom*, LispBuiltin*);
+void Com_Until(LispCom*, LispBuiltin*);
+void Com_When(LispCom*, LispBuiltin*);
+void Com_While(LispCom*, LispBuiltin*);
+
+#endif /* Lisp_Bytecode_h */
diff --git a/lisp/compile.c b/lisp/compile.c
new file mode 100644
index 0000000..f699f39
--- /dev/null
+++ b/lisp/compile.c
@@ -0,0 +1,2225 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/compile.c,v 1.14 2003/01/30 02:46:25 paulo Exp $ */
+
+#define VARIABLE_USED		0x0001
+#define VARIABLE_ARGUMENT	0x0002
+
+/*
+ * Prototypes
+ */
+static void ComPredicate(LispCom*, LispBuiltin*, LispBytePredicate);
+static void ComReturnFrom(LispCom*, LispBuiltin*, int);
+
+static int ComConstantp(LispCom*, LispObj*);
+static void ComAddVariable(LispCom*, LispObj*, LispObj*);
+static int ComGetVariable(LispCom*, LispObj*);
+static void ComVariableSetFlag(LispCom*, LispAtom*, int);
+#define COM_VARIABLE_USED(atom)				\
+    ComVariableSetFlag(com, atom, VARIABLE_USED)
+#define COM_VARIABLE_ARGUMENT(atom)			\
+	ComVariableSetFlag(com, atom, VARIABLE_ARGUMENT)
+
+static int FindIndex(void*, void**, int);
+static int compare(const void*, const void*);
+static int BuildTablePointer(void*, void***, int*);
+
+static void ComLabel(LispCom*, LispObj*);
+static void ComPush(LispCom*, LispObj*, LispObj*, int, int, int);
+static int ComCall(LispCom*, LispArgList*, LispObj*, LispObj*, int, int, int);
+static void ComFuncall(LispCom*, LispObj*, LispObj*, int);
+static void ComProgn(LispCom*, LispObj*);
+static void ComEval(LispCom*, LispObj*);
+
+static void ComRecursiveCall(LispCom*, LispArgList*, LispObj*, LispObj*);
+static void ComInlineCall(LispCom*, LispArgList*, LispObj*, LispObj*, LispObj*);
+
+static void ComMacroBackquote(LispCom*, LispObj*);
+static void ComMacroCall(LispCom*, LispArgList*, LispObj*, LispObj*, LispObj*);
+static LispObj *ComMacroExpandBackquote(LispCom*, LispObj*);
+static LispObj *ComMacroExpand(LispCom*, LispObj*);
+static LispObj *ComMacroExpandFuncall(LispCom*, LispObj*, LispObj*);
+static LispObj *ComMacroExpandEval(LispCom*, LispObj*);
+
+/*
+ * Implementation
+ */
+void
+Com_And(LispCom *com, LispBuiltin *builtin)
+/*
+ and &rest args
+ */
+{
+    LispObj *args;
+
+    args = ARGUMENT(0);
+
+    if (CONSP(args)) {
+	/* Evaluate first argument */
+	ComEval(com, CAR(args));
+	args = CDR(args);
+
+	/* If more than one argument, create jump list */
+	if (CONSP(args)) {
+	    CodeTree *tree = NULL, *group;
+
+	    group = NEW_TREE(CodeTreeJumpIf);
+	    group->code = XBC_JUMPNIL;
+
+	    for (; CONSP(args); args = CDR(args)) {
+		ComEval(com, CAR(args));
+		tree = NEW_TREE(CodeTreeJumpIf);
+		tree->code = XBC_JUMPNIL;
+		group->group = tree;
+		group = tree;
+	    }
+	    /*  Finish form the last CodeTree code is changed to sign the
+	     * end of the AND list */
+	    group->code = XBC_NOOP;
+	    if (group)
+		group->group = tree;
+	}
+    }
+    else
+	/* Identity of AND is T */
+	com_Bytecode(com, XBC_T);
+}
+
+void
+Com_Block(LispCom *com, LispBuiltin *builtin)
+/*
+ block name &rest body
+ */
+{
+
+    LispObj *name, *body;
+
+    body = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    if (name != NIL && name != T && !SYMBOLP(name))
+	LispDestroy("%s: %s cannot name a block",
+		    STRFUN(builtin), STROBJ(name));
+    if (CONSP(body)) {
+	CompileIniBlock(com, LispBlockTag, name);
+	ComProgn(com, body);
+	CompileFiniBlock(com);
+    }
+    else
+	/* Just load NIL without starting an empty block */
+	com_Bytecode(com, XBC_NIL);
+}
+
+void
+Com_C_r(LispCom *com, LispBuiltin *builtin)
+/*
+ c[ad]{1,4}r list
+ */
+{
+    LispObj *list;
+    char *desc;
+
+    list = ARGUMENT(0);
+
+    desc = STRFUN(builtin);
+    if (*desc == 'F')		/* FIRST */
+	desc = "CAR";
+    else if (*desc == 'R')	/* REST */
+	desc = "CDR";
+
+    /* Check if it is a list of constants */
+    while (desc[1] != 'R')
+	desc++;
+    ComEval(com, list);
+    while (*desc != 'C') {
+	com_Bytecode(com, *desc == 'A' ? XBC_CAR : XBC_CDR);
+	--desc;
+    }
+}
+
+void
+Com_Cond(LispCom *com, LispBuiltin *builtin)
+/*
+ cond &rest body
+ */
+{
+    int count;
+    LispObj *code, *body;
+    CodeTree *group, *tree;
+
+    body = ARGUMENT(0);
+
+    count = 0;
+    group = NULL;
+    if (CONSP(body)) {
+	for (; CONSP(body); body = CDR(body)) {
+	    code = CAR(body);
+	    CHECK_CONS(code);
+	    ++count;
+	    ComEval(com, CAR(code));
+	    tree = NEW_TREE(CodeTreeCond);
+	    if (group)
+		group->group = tree;
+	    tree->code = XBC_JUMPNIL;
+	    group = tree;
+	    /* The code to execute if the test is true */
+	    ComProgn(com, CDR(code));
+	    /* Add a node signaling the end of the PROGN code */
+	    tree = NEW_TREE(CodeTreeCond);
+	    tree->code = XBC_JUMPT;
+	    if (group)
+		group->group = tree;
+	    group = tree;
+	}
+    }
+    if (!count)
+	com_Bytecode(com, XBC_NIL);
+    else
+	/* Where to jump after T progn */
+	group->code = XBC_NOOP;
+}
+
+void
+Com_Cons(LispCom *com, LispBuiltin *builtin)
+/*
+ cons car cdr
+ */
+{
+    LispObj *car, *cdr;
+
+    cdr = ARGUMENT(1);
+    car = ARGUMENT(0);
+
+    if (ComConstantp(com, car) && ComConstantp(com, cdr))
+	com_BytecodeCons(com, XBC_CCONS, car, cdr);
+    else {
+	++com->stack.cpstack;
+	if (com->stack.pstack < com->stack.cpstack)
+	    com->stack.pstack = com->stack.cpstack;
+	ComEval(com, car);
+	com_Bytecode(com, XBC_CSTAR);
+	ComEval(com, cdr);
+	com_Bytecode(com, XBC_CFINI);
+	--com->stack.cpstack;
+    }
+}
+
+void
+Com_Consp(LispCom *com, LispBuiltin *builtin)
+/*
+ consp object
+ */
+{
+    ComPredicate(com, builtin, XBP_CONSP);
+}
+
+void
+Com_Dolist(LispCom *com, LispBuiltin *builtin)
+/*
+ dolist init &rest body
+ */
+{
+    int unbound, item;
+    LispObj *symbol, *list, *result;
+    LispObj *init, *body;
+    CodeTree *group, *tree;
+
+    body = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    CHECK_CONS(init);
+    symbol = CAR(init);
+    CHECK_SYMBOL(symbol);
+    CHECK_CONSTANT(symbol);
+    init = CDR(init);
+    if (CONSP(init)) {
+	list = CAR(init);
+	init = CDR(init);
+    }
+    else
+	list = NIL;
+    if (CONSP(init)) {
+	result = CAR(init);
+	if (CONSP(CDR(init)))
+	    LispDestroy("%s: too many arguments %s",
+			STRFUN(builtin), STROBJ(CDR(init)));
+    }
+    else
+	result = NIL;
+
+    /*	Generate code for the body of the form.
+     *	The generated code uses two objects unavailable to user code,
+     * in the format:
+     *	(block NIL
+     *	    (let ((? list) (item NIL))
+     *		(tagbody
+     *		    .			    ; the DOT object as a label
+     *		    (when (consp list)
+     *			(setq item (car ?))
+     *			@body		    ; code to be executed
+     *			(setq ? (cdr ?))
+     *			(go .)
+     *		    )
+     *		)
+     *		(setq item nil)
+     *		result
+     *	    )
+     *	)
+     */
+
+    /* XXX All of the logic below should be simplified at some time
+     * by adding more opcodes for compound operations ... */
+
+    /* Relative offsets the locally added variables will have at run time */
+    unbound = lisp__data.env.length - lisp__data.env.lex;
+    item = unbound + 1;
+
+    /* Start BLOCK NIL */
+    FORM_ENTER();
+    CompileIniBlock(com, LispBlockTag, NIL);
+
+    /* Add the <?> variable */
+    ComPush(com, UNBOUND, list, 1, 0, 0);
+    /* Add the <item> variable */
+    ComPush(com, symbol, NIL, 0, 0, 0);
+    /* Stack length is increased */
+    CompileStackEnter(com, 2, 0);
+    /* Bind variables */
+    com_Bind(com, 2);
+    com->block->bind += 2;
+    lisp__data.env.head += 2;
+
+    /* Remember that iteration variable is used even if it not referenced */
+    COM_VARIABLE_USED(symbol->data.atom);
+
+    /* Initialize the TAGBODY */
+    FORM_ENTER();
+    CompileIniBlock(com, LispBlockBody, NIL);
+
+    /* Create the <.> label */
+    ComLabel(com, DOT);
+
+    /* Load <?> variable */
+    com_BytecodeShort(com, XBC_LOAD, unbound);
+    /* Check if <?> is a list */
+    com_BytecodeChar(com, XBC_PRED, XBP_CONSP);
+
+    /* Start WHEN block */
+    group = NEW_TREE(CodeTreeJumpIf);
+    group->code = XBC_JUMPNIL;
+    /* Load <?> again */
+    com_BytecodeShort(com, XBC_LOAD, unbound);
+    /* Get CAR of <?> */
+    com_Bytecode(com, XBC_CAR);
+    /* Store it in <item> */
+    com_BytecodeShort(com, XBC_SET, item);
+    /* Execute @BODY */
+    ComProgn(com, body);
+
+    /* Load <?> again */
+    com_BytecodeShort(com, XBC_LOAD, unbound);
+    /* Get CDR of <?> */
+    com_Bytecode(com, XBC_CDR);
+    /* Change value of <?> */
+    com_BytecodeShort(com, XBC_SET, unbound);
+
+    /* GO back to <.> */
+    tree = NEW_TREE(CodeTreeGo);
+    tree->data.object = DOT;
+
+    /* Finish WHEN block */
+    tree = NEW_TREE(CodeTreeJumpIf);
+    tree->code = XBC_NOOP;
+    group->group = tree;
+
+    /* Finish the TAGBODY */
+    CompileFiniBlock(com);
+    FORM_LEAVE();
+
+    /* Set <item> to NIL, in case result references it...
+     * Loaded value is NIL as the CONSP predicate */
+    com_BytecodeShort(com, XBC_SET, item);
+
+    /* Evaluate <result> */
+    ComEval(com, result);
+
+    /* Unbind variables */
+    lisp__data.env.head -= 2;
+    lisp__data.env.length -= 2;
+    com->block->bind -= 2;
+    com_Unbind(com, 2);
+    /* Stack length is reduced. */
+    CompileStackLeave(com, 2, 0);
+
+    /* Finish BLOCK NIL */
+    CompileFiniBlock(com);
+    FORM_LEAVE();
+}
+
+void
+Com_Eq(LispCom *com, LispBuiltin *builtin)
+/*
+ eq left right
+ eql left right
+ equal left right
+ equalp left right
+ */
+{
+    LispObj *left, *right;
+    LispByteOpcode code;
+    char *name;
+
+    right = ARGUMENT(1);
+    left = ARGUMENT(0);
+
+    CompileStackEnter(com, 1, 1);
+    /* Just like preparing to call a builtin function */
+    ComEval(com, left);
+    com_Bytecode(com, XBC_PUSH);
+    /* The second argument is now loaded */
+    ComEval(com, right);
+
+    /* Compare arguments and restore builtin stack */
+    name = STRFUN(builtin);
+    switch (name[3]) {
+	case 'L':
+	    code = XBC_EQL;
+	    break;
+	case 'U':
+	    code = name[5] == 'P' ? XBC_EQUALP : XBC_EQUAL;
+	    break;
+	default:
+	    code = XBC_EQ;
+	    break;
+    }
+    com_Bytecode(com, code);
+
+    CompileStackLeave(com, 1, 1);
+}
+
+void
+Com_Go(LispCom *com, LispBuiltin *builtin)
+/*
+ go tag
+ */
+{
+    int bind;
+    LispObj *tag;
+    CodeTree *tree;
+    CodeBlock *block;
+
+    tag = ARGUMENT(0);
+
+    block = com->block;
+    bind = block->bind;
+
+    while (block) {
+	if (block->type == LispBlockClosure || block->type == LispBlockBody)
+	    break;
+	block = block->prev;
+	if (block)
+	    bind += block->bind;
+    }
+
+    if (!block || block->type != LispBlockBody)
+	LispDestroy("%s called not within a block", STRFUN(builtin));
+
+    /* Unbind any local variables */
+    com_Unbind(com, bind);
+    tree = NEW_TREE(CodeTreeGo);
+    tree->data.object = tag;
+}
+
+void
+Com_If(LispCom *com, LispBuiltin *builtin)
+/*
+ if test then &optional else
+ */
+{
+    CodeTree *group, *tree;
+    LispObj *test, *then, *oelse;
+
+    oelse = ARGUMENT(2);
+    then = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    /* Build code to execute test */
+    ComEval(com, test);
+
+    /* Add jump node to use if test is NIL */
+    group = NEW_TREE(CodeTreeJumpIf);
+    group->code = XBC_JUMPNIL;
+
+    /* Build T code */
+    ComEval(com, then);
+
+    if (oelse != UNSPEC) {
+	/* Remember start of NIL code */
+	tree = NEW_TREE(CodeTreeJump);
+	tree->code = XBC_JUMP;
+	group->group = tree;
+	group = tree;
+	/* Build NIL code */
+	ComEval(com, oelse);
+    }
+
+    /* Remember jump of T code */
+    tree = NEW_TREE(CodeTreeJumpIf);
+    tree->code = XBC_NOOP;
+    group->group = tree;
+}
+
+void
+Com_Last(LispCom *com, LispBuiltin *builtin)
+/*
+ last list &optional count
+ */
+{
+    LispObj *list, *count;
+
+    count = ARGUMENT(1);
+    list = ARGUMENT(0);
+
+    ComEval(com, list);
+    CompileStackEnter(com, 1, 1);
+    com_Bytecode(com, XBC_PUSH);
+    if (count == UNSPEC)
+	count = FIXNUM(1);
+    ComEval(com, count);
+    CompileStackLeave(com, 1, 1);
+    com_Bytecode(com, XBC_LAST);
+}
+
+void
+Com_Length(LispCom *com, LispBuiltin *builtin)
+/*
+ length sequence
+ */
+{
+    LispObj *sequence;
+
+    sequence = ARGUMENT(0);
+
+    ComEval(com, sequence);
+    com_Bytecode(com, XBC_LENGTH);
+}
+
+void
+Com_Let(LispCom *com, LispBuiltin *builtin)
+/*
+ let init &rest body
+ */
+{
+    int count;
+    LispObj *symbol, *value, *pair;
+
+    LispObj *init, *body;
+
+    body = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    if (init == NIL) {
+	/* If no local variables */
+	ComProgn(com, body);
+	return;
+    }
+    CHECK_CONS(init);
+
+    /* Could optimize if the body is empty and the
+     * init form is known to have no side effects */
+
+    for (count = 0; CONSP(init); init = CDR(init), count++) {
+	pair = CAR(init);
+	if (CONSP(pair)) {
+	    symbol = CAR(pair);
+	    pair = CDR(pair);
+	    if (CONSP(pair)) {
+		value = CAR(pair);
+		if (CDR(pair) != NIL)
+		    LispDestroy("%s: too much arguments to initialize %s",
+				STRFUN(builtin), STROBJ(symbol));
+	    }
+	    else
+		value = NIL;
+	}
+	else {
+	    symbol = pair;
+	    value = NIL;
+	}
+	CHECK_SYMBOL(symbol);
+	CHECK_CONSTANT(symbol);
+
+	/* Add the variable */
+	ComPush(com, symbol, value, 1, 0, 0);
+    }
+
+    /* Stack length is increased */
+    CompileStackEnter(com, count, 0);
+    /* Bind the added variables */
+    com_Bind(com, count);
+    com->block->bind += count;
+    lisp__data.env.head += count;
+    /* Generate code for the body of the form */
+    ComProgn(com, body);
+    /* Unbind the added variables */
+    lisp__data.env.head -= count;
+    lisp__data.env.length -= count;
+    com->block->bind -= count;
+    com_Unbind(com, count);
+    /* Stack length is reduced. */
+    CompileStackLeave(com, count, 0);
+}
+
+void
+Com_Letx(LispCom *com, LispBuiltin *builtin)
+/*
+ let* init &rest body
+ */
+{
+    int count;
+    LispObj *symbol, *value, *pair;
+
+    LispObj *init, *body;
+
+    body = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    if (init == NIL) {
+	/* If no local variables */
+	ComProgn(com, body);
+	return;
+    }
+    CHECK_CONS(body);
+
+    /* Could optimize if the body is empty and the
+     * init form is known to have no side effects */
+
+    for (count = 0; CONSP(init); init = CDR(init), count++) {
+	pair = CAR(init);
+	if (CONSP(pair)) {
+	    symbol = CAR(pair);
+	    pair = CDR(pair);
+	    if (CONSP(pair)) {
+		value = CAR(pair);
+		if (CDR(pair) != NIL)
+		    LispDestroy("%s: too much arguments to initialize %s",
+				STRFUN(builtin), STROBJ(symbol));
+	    }
+	    else
+		value = NIL;
+	}
+	else {
+	    symbol = pair;
+	    value = NIL;
+	}
+	CHECK_SYMBOL(symbol);
+	CHECK_CONSTANT(symbol);
+
+	/* LET* is identical to &AUX arguments, just bind the symbol */
+	ComPush(com, symbol, value, 1, 0, 0);
+	/* Every added variable is binded */
+	com_Bind(com, 1);
+	/* Must be binded at compile time also */
+	++lisp__data.env.head;
+	++com->block->bind;
+    }
+
+    /* Generate code for the body of the form */
+    CompileStackEnter(com, count, 0);
+    ComProgn(com, body);
+    com_Unbind(com, count);
+    com->block->bind -= count;
+    lisp__data.env.head -= count;
+    lisp__data.env.length -= count;
+    CompileStackLeave(com, count, 0);
+}
+
+void
+Com_Listp(LispCom *com, LispBuiltin *builtin)
+/*
+ listp object
+ */
+{
+    ComPredicate(com, builtin, XBP_LISTP);
+}
+
+void
+Com_Loop(LispCom *com, LispBuiltin *builtin)
+/*
+ loop &rest body
+ */
+{
+    CodeTree *tree, *group;
+    LispObj *body;
+
+    body = ARGUMENT(0);
+
+    /* Start NIL block */
+    CompileIniBlock(com, LispBlockTag, NIL);
+
+    /* Insert node to mark LOOP start */
+    tree = NEW_TREE(CodeTreeJump);
+    tree->code = XBC_NOOP;
+
+    /* Execute @BODY */
+    if (CONSP(body))
+	ComProgn(com, body);
+    else
+	/* XXX bytecode.c code require that blocks have at least one opcode */
+	com_Bytecode(com, XBC_NIL);
+
+    /* Insert node to jump of start of LOOP */
+    group = NEW_TREE(CodeTreeJump);
+    group->code = XBC_JUMP;
+    group->group = tree;
+
+    /* Finish NIL block */
+    CompileFiniBlock(com);
+}
+
+void
+Com_Nthcdr(LispCom *com, LispBuiltin *builtin)
+/*
+ nthcdr index list
+ */
+{
+    LispObj *oindex, *list;
+
+    list = ARGUMENT(1);
+    oindex = ARGUMENT(0);
+
+    ComEval(com, oindex);
+    CompileStackEnter(com, 1, 1);
+    com_Bytecode(com, XBC_PUSH);
+    ComEval(com, list);
+    CompileStackLeave(com, 1, 1);
+    com_Bytecode(com, XBC_NTHCDR);
+}
+
+void
+Com_Null(LispCom *com, LispBuiltin *builtin)
+/*
+ null list
+ */
+{
+    LispObj *list;
+
+    list = ARGUMENT(0);
+
+    if (list == NIL)
+	com_Bytecode(com, XBC_T);
+    else if (ComConstantp(com, list))
+	com_Bytecode(com, XBC_NIL);
+    else {
+	ComEval(com, list);
+	com_Bytecode(com, XBC_INV);
+    }
+}
+
+void
+Com_Numberp(LispCom *com, LispBuiltin *builtin)
+/*
+ numberp object
+ */
+{
+    ComPredicate(com, builtin, XBP_NUMBERP);
+}
+
+void
+Com_Or(LispCom *com, LispBuiltin *builtin)
+/*
+ or &rest args
+ */
+{
+    LispObj *args;
+
+    args = ARGUMENT(0);
+
+    if (CONSP(args)) {
+	/* Evaluate first argument */
+	ComEval(com, CAR(args));
+	args = CDR(args);
+
+	/* If more than one argument, create jump list */
+	if (CONSP(args)) {
+	    CodeTree *tree = NULL, *group;
+
+	    group = NEW_TREE(CodeTreeJumpIf);
+	    group->code = XBC_JUMPT;
+
+	    for (; CONSP(args); args = CDR(args)) {
+		ComEval(com, CAR(args));
+		tree = NEW_TREE(CodeTreeJumpIf);
+		tree->code = XBC_JUMPT;
+		group->group = tree;
+		group = tree;
+	    }
+	    /*  Finish form the last CodeTree code is changed to sign the
+	     * end of the AND list */
+	    group->code = XBC_NOOP;
+	    group->group = tree;
+	}
+    }
+    else
+	/* Identity of OR is NIL */
+	com_Bytecode(com, XBC_NIL);
+}
+
+void
+Com_Progn(LispCom *com, LispBuiltin *builtin)
+/*
+ progn &rest body
+ */
+{
+    LispObj *body;
+
+    body = ARGUMENT(0);
+
+    ComProgn(com, body);
+}
+
+void
+Com_Return(LispCom *com, LispBuiltin *builtin)
+/*
+ return &optional result
+ */
+{
+    ComReturnFrom(com, builtin, 0);
+}
+
+void
+Com_ReturnFrom(LispCom *com, LispBuiltin *builtin)
+/*
+ return-from name &optional result
+ */
+{
+    ComReturnFrom(com, builtin, 1);
+}
+
+void
+Com_Rplac_(LispCom *com, LispBuiltin *builtin)
+/*
+ rplac[ad] place value
+ */
+{
+    LispObj *place, *value;
+
+    value = ARGUMENT(1);
+    place = ARGUMENT(0);
+
+    CompileStackEnter(com, 1, 1);
+    ComEval(com, place);
+    com_Bytecode(com, XBC_PUSH);
+    ComEval(com, value);
+    com_Bytecode(com, STRFUN(builtin)[5] == 'A' ? XBC_RPLACA : XBC_RPLACD);
+    CompileStackLeave(com, 1, 1);
+}
+
+void
+Com_Setq(LispCom *com, LispBuiltin *builtin)
+/*
+ setq &rest form
+ */
+{
+    int offset;
+    LispObj *form, *symbol, *value;
+
+    form = ARGUMENT(0);
+
+    for (; CONSP(form); form = CDR(form)) {
+	symbol = CAR(form);
+	CHECK_SYMBOL(symbol);
+	CHECK_CONSTANT(symbol);
+	form = CDR(form);
+	if (!CONSP(form))
+	    LispDestroy("%s: odd number of arguments", STRFUN(builtin));
+	value = CAR(form);
+	/* Generate code to load value */
+	ComEval(com, value);
+	offset = ComGetVariable(com, symbol);
+	if (offset >= 0)
+	    com_Set(com, offset);
+	else
+	    com_SetSym(com, symbol->data.atom);
+    }
+}
+
+void
+Com_Tagbody(LispCom *com, LispBuiltin *builtin)
+/*
+ tagbody &rest body
+ */
+{
+    LispObj *body;
+
+    body = ARGUMENT(0);
+
+    if (CONSP(body)) {
+	CompileIniBlock(com, LispBlockBody, NIL);
+	ComProgn(com, body);
+	/* Tagbody returns NIL */
+	com_Bytecode(com, XBC_NIL);
+	CompileFiniBlock(com);
+    }
+    else
+	/* Tagbody always returns NIL */
+	com_Bytecode(com, XBC_NIL);
+}
+
+void
+Com_Unless(LispCom *com, LispBuiltin *builtin)
+/*
+ unless test &rest body
+ */
+{
+    CodeTree *group, *tree;
+    LispObj *test, *body;
+
+    body = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    /* Generate code to evaluate test */
+    ComEval(com, test);
+    /* Add node after test */
+    group = NEW_TREE(CodeTreeJumpIf);
+    group->code = XBC_JUMPT;
+    /* Generate NIL code */
+    ComProgn(com, body);
+    /* Insert node to know where to jump if test is T */
+    tree = NEW_TREE(CodeTreeJumpIf);
+    tree->code = XBC_NOOP;
+    group->group = tree;
+}
+
+void
+Com_Until(LispCom *com, LispBuiltin *builtin)
+/*
+ until test &rest body
+ */
+{
+    CodeTree *tree, *group, *ltree, *lgroup;
+    LispObj *test, *body;
+
+    body = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    /* Insert node to mark LOOP start */
+    ltree = NEW_TREE(CodeTreeJump);
+    ltree->code = XBC_NOOP;
+
+    /* Build code for test */
+    ComEval(com, test);
+    group = NEW_TREE(CodeTreeJumpIf);
+    group->code = XBC_JUMPT;
+
+    /* Execute @BODY */
+    ComProgn(com, body);
+
+    /* Insert node to jump to test again */
+    lgroup = NEW_TREE(CodeTreeJump);
+    lgroup->code = XBC_JUMP;
+    lgroup->group = ltree;
+
+    /* Insert node to know where to jump if test is T */
+    tree = NEW_TREE(CodeTreeJumpIf);
+    tree->code = XBC_NOOP;
+    group->group = tree;
+}
+
+void
+Com_When(LispCom *com, LispBuiltin *builtin)
+/*
+ when test &rest body
+ */
+{
+    CodeTree *group, *tree;
+    LispObj *test, *body;
+
+    body = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    /* Generate code to evaluate test */
+    ComEval(com, test);
+    /* Add node after test */
+    group = NEW_TREE(CodeTreeJumpIf);
+    group->code = XBC_JUMPNIL;
+    /* Generate T code */
+    ComProgn(com, body);
+    /* Insert node to know where to jump if test is NIL */
+    tree = NEW_TREE(CodeTreeJumpIf);
+    tree->code = XBC_NOOP;
+    group->group = tree;
+}
+
+void
+Com_While(LispCom *com, LispBuiltin *builtin)
+/*
+ while test &rest body
+ */
+{
+    CodeTree *tree, *group, *ltree, *lgroup;
+    LispObj *test, *body;
+
+    body = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    /* Insert node to mark LOOP start */
+    ltree = NEW_TREE(CodeTreeJump);
+    ltree->code = XBC_NOOP;
+
+    /* Build code for test */
+    ComEval(com, test);
+    group = NEW_TREE(CodeTreeJumpIf);
+    group->code = XBC_JUMPNIL;
+
+    /* Execute @BODY */
+    ComProgn(com, body);
+
+    /* Insert node to jump to test again */
+    lgroup = NEW_TREE(CodeTreeJump);
+    lgroup->code = XBC_JUMP;
+    lgroup->group = ltree;
+
+    /* Insert node to know where to jump if test is NIL */
+    tree = NEW_TREE(CodeTreeJumpIf);
+    tree->code = XBC_NOOP;
+    group->group = tree;
+}
+
+
+/***********************************************************************
+ * Com_XXX helper functions
+ ***********************************************************************/
+static void
+ComPredicate(LispCom *com, LispBuiltin *builtin, LispBytePredicate predicate)
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (ComConstantp(com, object)) {
+	switch (predicate) {
+	    case XBP_CONSP:
+		com_Bytecode(com, CONSP(object) ? XBC_T : XBC_NIL);
+		break;
+	    case XBP_LISTP:
+		com_Bytecode(com, CONSP(object) || object == NIL ?
+			     XBC_T : XBC_NIL);
+		break;
+	    case XBP_NUMBERP:
+		com_Bytecode(com, NUMBERP(object) ? XBC_T : XBC_NIL);
+		break;
+	}
+    }
+    else {
+	ComEval(com, object);
+	com_BytecodeChar(com, XBC_PRED, predicate);
+    }
+}
+
+/* XXX Could receive an argument telling if is the last statement in the
+ * block(s), i.e. if a jump opcode should be generated or just the
+ * evaluation of the returned value. Probably this is better done in
+ * an optimization step. */
+static void
+ComReturnFrom(LispCom *com, LispBuiltin *builtin, int from)
+{
+    int bind;
+    CodeTree *tree;
+    LispObj *name, *result;
+    CodeBlock *block = com->block;
+
+    if (from) {
+	result = ARGUMENT(1);
+	name = ARGUMENT(0);
+    }
+    else {
+	result = ARGUMENT(0);
+	name = NIL;
+    }
+    if (result == UNSPEC)
+	result = NIL;
+
+    bind = block->bind;
+    while (block) {
+	if (block->type == LispBlockClosure)
+	    /* A function call */
+	    break;
+	else if (block->type == LispBlockTag && block->tag == name)
+	    break;
+	block = block->prev;
+	if (block)
+	    bind += block->bind;
+    }
+
+    if (!block || block->tag != name)
+	LispDestroy("%s: no visible %s block", STRFUN(builtin), STROBJ(name));
+
+    /* Generate code to load result */
+    ComEval(com, result);
+
+    /* Check for added variables that the jump is skiping the unbind opcode */
+    com_Unbind(com, bind);
+
+    tree = NEW_TREE(CodeTreeReturn);
+    tree->data.block = block;
+}
+
+/***********************************************************************
+ * Helper functions
+ ***********************************************************************/
+static int
+ComConstantp(LispCom *com, LispObj *object)
+{
+    switch (OBJECT_TYPE(object)) {
+	case LispAtom_t:
+	    /* Keywords are guaranteed to evaluate to itself */
+	    if (object->data.atom->package == lisp__data.keyword)
+		break;
+	    return (0);
+
+	    /* Function call */
+	case LispCons_t:
+
+	    /* Need macro expansion, these are special abstract objects */
+	case LispQuote_t:
+	case LispBackquote_t:
+	case LispComma_t:
+	case LispFunctionQuote_t:
+	    return (0);
+
+	    /* Anything else is a literal constant */
+	default:
+	    break;
+    }
+
+    return (1);
+}
+
+static int
+FindIndex(void *item, void **table, int length)
+{
+    long cmp;
+    int left, right, i;
+
+    left = 0;
+    right = length - 1;
+    while (left <= right) {
+	i = (left + right) >> 1;
+	cmp = (char*)item - (char*)table[i];
+	if (cmp == 0)
+	    return (i);
+	else if (cmp < 0)
+	    right = i - 1;
+	else
+	    left = i + 1;
+    }
+
+    return (-1);
+}
+
+static int
+compare(const void *left, const void *right)
+{
+    long cmp = *(char**)left - *(char**)right;
+
+    return (cmp < 0 ? -1 : 1);
+}
+
+static int
+BuildTablePointer(void *pointer, void ***pointers, int *num_pointers)
+{
+    int i;
+
+    if ((i = FindIndex(pointer, *pointers, *num_pointers)) < 0) {
+	*pointers = LispRealloc(*pointers,
+				sizeof(void*) * (*num_pointers + 1));
+	(*pointers)[*num_pointers] = pointer;
+	if (++*num_pointers > 1)
+	    qsort(*pointers, *num_pointers, sizeof(void*), compare);
+	i = FindIndex(pointer, *pointers, *num_pointers);
+    }
+
+    return (i);
+}
+
+static void
+ComAddVariable(LispCom *com, LispObj *symbol, LispObj *value)
+{
+    LispAtom *atom = symbol->data.atom;
+
+    if (atom && atom->string && !com->macro) {
+	int i, length = com->block->variables.length;
+
+	i = BuildTablePointer(atom, (void***)&com->block->variables.symbols,
+			      &com->block->variables.length);
+
+	if (com->block->variables.length != length) {
+	    com->block->variables.flags =
+		LispRealloc(com->block->variables.flags,
+			    com->block->variables.length * sizeof(int));
+
+	    /* Variable was inserted in the middle of the list */
+	    if (i < length)
+		memmove(com->block->variables.flags + i + 1,
+			com->block->variables.flags + i,
+			(length - i) * sizeof(int));
+
+	    com->block->variables.flags[i] = 0;
+	}
+    }
+
+    LispAddVar(symbol, value);
+}
+
+static int
+ComGetVariable(LispCom *com, LispObj *symbol)
+{
+    LispAtom *name;
+    int i, base, offset;
+    Atom_id id;
+
+    name = symbol->data.atom;
+    if (name->constant) {
+	if (name->package == lisp__data.keyword)
+	    /*	Just load <symbol> from the byte stream, keywords are
+	     * guaranteed to evaluate to itself. */
+	    return (SYMBOL_KEYWORD);
+	return (SYMBOL_CONSTANT);
+    }
+
+    offset = name->offset;
+    id = name->string;
+    base = lisp__data.env.lex;
+    i = lisp__data.env.head - 1;
+
+    /* If variable is local */
+    if (offset <= i && offset >= com->lex && lisp__data.env.names[offset] == id) {
+	COM_VARIABLE_USED(name);
+	/* Relative offset */
+	return (offset - base);
+    }
+
+    /* name->offset may have been changed in a macro expansion */
+    for (; i >= com->lex; i--)
+	if (lisp__data.env.names[i] == id) {
+	    name->offset = i;
+	    COM_VARIABLE_USED(name);
+	    return (i - base);
+	}
+
+    if (!name->a_object) {
+	++com->warnings;
+	LispWarning("variable %s is neither declared nor bound",
+		    name->string);
+    }
+
+    /* Not found, resolve <symbol> at run time */
+    return (SYMBOL_UNBOUND);
+}
+
+static void
+ComVariableSetFlag(LispCom *com, LispAtom *atom, int flag)
+{
+    int i;
+    CodeBlock *block = com->block;
+
+    while (block) {
+	i = FindIndex(atom, (void**)block->variables.symbols,
+		      block->variables.length);
+	if (i >= 0) {
+	    block->variables.flags[i] |= flag;
+	    /*  Descend block list if an argument to function being called
+	     * has the same name as a bound variable in the current function.
+	     */
+	    if ((flag & VARIABLE_ARGUMENT) ||
+		!(block->variables.flags[i] & VARIABLE_ARGUMENT))
+		break;
+	}
+	block = block->prev;
+    }
+}
+
+/***********************************************************************
+ * Bytecode compiler functions
+ ***********************************************************************/
+static void
+ComLabel(LispCom *com, LispObj *label)
+{
+    int i;
+    CodeTree *tree;
+
+    for (i = 0; i < com->block->tagbody.length; i++)
+	if (label == com->block->tagbody.labels[i])
+	    LispDestroy("TAGBODY: tag %s specified more than once",
+			STROBJ(label));
+
+    if (com->block->tagbody.length >= com->block->tagbody.space) {
+	com->block->tagbody.labels =
+	    LispRealloc(com->block->tagbody.labels,
+			sizeof(LispObj*) * (com->block->tagbody.space + 8));
+	/*  Reserve space, will be used at link time when
+	 * resolving GO jumps. */
+	com->block->tagbody.codes =
+	    LispRealloc(com->block->tagbody.codes,
+			sizeof(CodeTree*) * (com->block->tagbody.space + 8));
+	com->block->tagbody.space += 8;
+    }
+
+    com->block->tagbody.labels[com->block->tagbody.length++] = label;
+    tree = NEW_TREE(CodeTreeLabel);
+    tree->data.object = label;
+}
+
+static void
+ComPush(LispCom *com, LispObj *symbol, LispObj *value,
+	int eval, int builtin, int compile)
+{
+    /*  If <compile> is set, it is pushing an argument to one of
+     * Com_XXX functions. */
+    if (compile) {
+	if (builtin)
+	    lisp__data.stack.values[lisp__data.stack.length++] = value;
+	else
+	    ComAddVariable(com, symbol, value);
+	return;
+    }
+
+    /*  If <com->macro> is set, it is expanding a macro, just add the local
+     * variable <symbol> bounded to <value>, so that it will be available
+     * when calling the interpreter to expand the macro. */
+    else if (com->macro) {
+	ComAddVariable(com, symbol, value);
+	return;
+    }
+
+    /*  If <eval> is set, it must generate the opcodes to evaluate <value>.
+     * If <value> is a constant, just generate the opcodes to load it. */
+    else if (eval && !ComConstantp(com, value)) {
+	switch (OBJECT_TYPE(value)) {
+	    case LispAtom_t: {
+		int offset = ComGetVariable(com, value);
+
+		if (offset >= 0) {
+		    /* Load <value> from user stack at the relative offset */
+		    if (builtin)
+			com_LoadPush(com, offset);
+		    else
+			com_LoadLet(com, offset, symbol->data.atom);
+		}
+		/* ComConstantp() does not return true for this, as the
+		 * current value must be computed. */
+		else if (offset == SYMBOL_CONSTANT) {
+		    value = value->data.atom->property->value;
+		    if (builtin)
+			com_LoadConPush(com, value);
+		    else
+			com_LoadConLet(com, value, symbol->data.atom);
+		}
+		else {
+		    /* Load value bound to <value> at run time */
+		    if (builtin)
+			com_LoadSymPush(com, value->data.atom);
+		    else
+			com_LoadSymLet(com, value->data.atom,
+				       symbol->data.atom);
+		}
+	    }	break;
+
+	    default:
+		/* Generate code to evaluate <value> */
+		ComEval(com, value);
+		if (builtin)
+		    com_Bytecode(com, XBC_PUSH);
+		else
+		    com_Let(com, symbol->data.atom);
+		break;
+	}
+
+	/*  Remember <symbol> will be bound, <value> only matters for
+	 * the Com_XXX  functions */
+	if (builtin)
+	    lisp__data.stack.values[lisp__data.stack.length++] = value;
+	else
+	    ComAddVariable(com, symbol, value);
+	return;
+    }
+
+    if (builtin) {
+	/* Load <value> as a constant in builtin stack */
+	com_LoadConPush(com, value);
+	lisp__data.stack.values[lisp__data.stack.length++] = value;
+    }
+    else {
+	/* Load <value> as a constant in stack */
+	com_LoadConLet(com, value, symbol->data.atom);
+	/* Remember <symbol> will be bound */
+	ComAddVariable(com, symbol, value);
+    }
+}
+
+/*  This function does almost the same job as LispMakeEnvironment, but
+ * it is not optimized for speed, as it is not building argument lists
+ * to user code, but to Com_XXX functions, or helping in generating the
+ * opcodes to load arguments at bytecode run time. */
+static int
+ComCall(LispCom *com, LispArgList *alist,
+	LispObj *name, LispObj *values,
+	int eval, int builtin, int compile)
+{
+    char *desc;
+    int i, count, base;
+    LispObj **symbols, **defaults, **sforms;
+
+    if (builtin) {
+	base = lisp__data.stack.length;
+	/* This should never be executed, but make the check for safety */
+	if (base + alist->num_arguments > lisp__data.stack.space) {
+	    do
+		LispMoreStack();
+	    while (base + alist->num_arguments > lisp__data.stack.space);
+	}
+    }
+    else
+	base = lisp__data.env.length;
+
+    desc = alist->description;
+    switch (*desc++) {
+	case '.':
+	    goto normal_label;
+	case 'o':
+	    goto optional_label;
+	case 'k':
+	    goto key_label;
+	case 'r':
+	    goto rest_label;
+	case 'a':
+	    goto aux_label;
+	default:
+	    goto done_label;
+    }
+
+
+    /* Normal arguments */
+normal_label:
+    i = 0;
+    symbols = alist->normals.symbols;
+    count = alist->normals.num_symbols;
+    for (; i < count && CONSP(values); i++, values = CDR(values)) {
+	ComPush(com, symbols[i], CAR(values), eval, builtin, compile);
+	if (!builtin && !com->macro)
+	    COM_VARIABLE_ARGUMENT(symbols[i]->data.atom);
+    }
+    if (i < count)
+	LispDestroy("%s: too few arguments", STROBJ(name));
+
+    switch (*desc++) {
+	case 'o':
+	    goto optional_label;
+	case 'k':
+	    goto key_label;
+	case 'r':
+	    goto rest_label;
+	case 'a':
+	    goto aux_label;
+	default:
+	    goto done_label;
+    }
+
+
+    /* &OPTIONAL */
+optional_label:
+    i = 0;
+    count = alist->optionals.num_symbols;
+    symbols = alist->optionals.symbols;
+    defaults = alist->optionals.defaults;
+    sforms = alist->optionals.sforms;
+    for (; i < count && CONSP(values); i++, values = CDR(values)) {
+	ComPush(com, symbols[i], CAR(values), eval, builtin, compile);
+	if (!builtin && !com->macro)
+	    COM_VARIABLE_ARGUMENT(symbols[i]->data.atom);
+	if (sforms[i]) {
+	    ComPush(com, sforms[i], T, 0, builtin, compile);
+	    if (!builtin && !com->macro)
+		COM_VARIABLE_ARGUMENT(sforms[i]->data.atom);
+	}
+    }
+    for (; i < count; i++) {
+	if (!builtin) {
+	    int lex = com->lex;
+	    int head = lisp__data.env.head;
+
+	    com->lex = base;
+	    lisp__data.env.head = lisp__data.env.length;
+	    /* default arguments are evaluated for macros */
+	    ComPush(com, symbols[i], defaults[i], 1, 0, compile);
+	    if (!com->macro)
+		COM_VARIABLE_ARGUMENT(symbols[i]->data.atom);
+	    lisp__data.env.head = head;
+	    com->lex = lex;
+	}
+	else
+	    ComPush(com, symbols[i], defaults[i], eval, 1, compile);
+	if (sforms[i]) {
+	    ComPush(com, sforms[i], NIL, 0, builtin, compile);
+	    if (!builtin && !com->macro)
+		COM_VARIABLE_ARGUMENT(sforms[i]->data.atom);
+	}
+    }
+
+    switch (*desc++) {
+	case 'k':
+	    goto key_label;
+	case 'r':
+	    goto rest_label;
+	case 'a':
+	    goto aux_label;
+	default:
+	    goto done_label;
+    }
+
+
+    /* &KEY */
+key_label:
+    {
+	int varset;
+	LispObj *val, *karg, **keys;
+
+	count = alist->keys.num_symbols;
+	symbols = alist->keys.symbols;
+	defaults = alist->keys.defaults;
+	sforms = alist->keys.sforms;
+	keys = alist->keys.keys;
+
+	/* Check if arguments are correctly specified */
+	for (karg = values; CONSP(karg); karg = CDR(karg)) {
+	    val = CAR(karg);
+	    if (KEYWORDP(val)) {
+		for (i = 0; i < alist->keys.num_symbols; i++)
+		    if (!keys[i] && symbols[i] == val)
+			break;
+	    }
+
+	    else if (!builtin &&
+		     QUOTEP(val) && SYMBOLP(val->data.quote)) {
+		for (i = 0; i < alist->keys.num_symbols; i++)
+		    if (keys[i] && ATOMID(keys[i]) == ATOMID(val->data.quote))
+			break;
+	    }
+
+	    else
+		/* Just make the error test true */
+		i = alist->keys.num_symbols;
+
+	    if (i == alist->keys.num_symbols) {
+		/* If not in argument specification list... */
+		char function_name[36];
+
+		strcpy(function_name, STROBJ(name));
+		LispDestroy("%s: invalid keyword %s",
+			    function_name, STROBJ(val));
+	    }
+
+	    karg = CDR(karg);
+	    if (!CONSP(karg))
+		LispDestroy("%s: &KEY needs arguments as pairs",
+			    STROBJ(name));
+	}
+
+	/* Add variables */
+	for (i = 0; i < alist->keys.num_symbols; i++) {
+	    val = defaults[i];
+	    varset = 0;
+	    if (!builtin && keys[i]) {
+		Atom_id atom = ATOMID(keys[i]);
+
+		/* Special keyword specification, need to compare ATOMID
+		 * and keyword specification must be a quoted object */
+		for (karg = values; CONSP(karg); karg = CDR(karg)) {
+		    val = CAR(karg);
+		    if (QUOTEP(val) && atom == ATOMID(val->data.quote)) {
+			val = CADR(karg);
+			varset = 1;
+			break;
+		    }
+		    karg = CDR(karg);
+		}
+	    }
+
+	    else {
+		/* Normal keyword specification, can compare object pointers,
+		 * as they point to the same object in the keyword package */
+		for (karg = values; CONSP(karg); karg = CDR(karg)) {
+		    /* Don't check if argument is a valid keyword or
+		     * special quoted keyword */
+		    if (symbols[i] == CAR(karg)) {
+			val = CADR(karg);
+			varset = 1;
+			break;
+		    }
+		    karg = CDR(karg);
+		}
+	    }
+
+	    /* Add the variable to environment */
+	    if (varset) {
+		ComPush(com, symbols[i], val, eval, builtin, compile);
+		if (sforms[i])
+		    ComPush(com, sforms[i], T, 0, builtin, compile);
+	    }
+	    else {
+		/* default arguments are evaluated for macros */
+		if (!builtin) {
+		    int lex = com->lex;
+		    int head = lisp__data.env.head;
+
+		    com->lex = base;
+		    lisp__data.env.head = lisp__data.env.length;
+		    ComPush(com, symbols[i], val, eval, 0, compile);
+		    lisp__data.env.head = head;
+		    com->lex = lex;
+		}
+		else
+		    ComPush(com, symbols[i], val, eval, builtin, compile);
+		if (sforms[i])
+		    ComPush(com, sforms[i], NIL, 0, builtin, compile);
+	    }
+	    if (!builtin && !com->macro) {
+		COM_VARIABLE_ARGUMENT(symbols[i]->data.atom);
+		if (sforms[i])
+		    COM_VARIABLE_ARGUMENT(sforms[i]->data.atom);
+	    }
+	}
+    }
+
+    if (*desc == 'a') {
+	/* &KEY uses all remaining arguments */
+	values = NIL;
+	goto aux_label;
+    }
+    goto finished_label;
+
+
+    /* &REST */
+rest_label:
+    if (!eval || !CONSP(values) || (compile && !builtin))
+	ComPush(com, alist->rest, values, eval, builtin, compile);
+    else {
+	char *string;
+	LispObj *list, *car = NIL;
+	int count, constantp;
+
+	/* Count number of arguments and check if it is a list of constants */
+	for (count = 0, constantp = 1, list = values;
+	     CONSP(list);
+	     list = CDR(list), count++) {
+	    car = CAR(list);
+	    if (!ComConstantp(com, car))
+		constantp = 0;
+	}
+
+	string = builtin ? ATOMID(name) : NULL;
+	/* XXX FIXME should have a flag indicating if function call
+	 * change the &REST arguments even if it is a constant list
+	 * (or if the returned value may be changed). */
+	if (string && (count < MAX_BCONS || constantp) &&
+	    strcmp(string, "LIST") &&
+	    strcmp(string, "APPLY") &&	/* XXX depends on function argument */
+	    strcmp(string, "VECTOR") &&
+	    /* Append does not copy the last/single list */
+	    (strcmp(string, "APPEND") || !CONSP(car))) {
+	    if (constantp) {
+		/* If the builtin function changes the &REST parameters, must
+		 * define a Com_XXX function for it. */
+		ComPush(com, alist->rest, values, 0, builtin, compile);
+	    }
+	    else {
+		CompileStackEnter(com, count - 1, 1);
+		for (; CONSP(CDR(values)); values = CDR(values)) {
+		    /* Evaluate this argument */
+		    ComEval(com, CAR(values));
+		    /* Save result in builtin stack */
+		    com_Bytecode(com, XBC_PUSH);
+		}
+		CompileStackLeave(com, count - 1, 1);
+		/* The last argument is not saved in the stack */
+		ComEval(com, CAR(values));
+		values = NIL;
+		com_Bytecode(com, XBC_BCONS + (count - 1));
+	    }
+	}
+	else {
+	    /* Allocate a fresh list of cons */
+
+	    /* Generate code to load object */
+	    ComEval(com, CAR(values));
+
+	    com->stack.cpstack += 2;
+	    if (com->stack.pstack < com->stack.cpstack)
+		com->stack.pstack = com->stack.cpstack;
+	    /* Start building a gc protected list, with the loaded value */
+	    com_Bytecode(com, XBC_LSTAR);
+
+	    for (values = CDR(values); CONSP(values); values = CDR(values)) {
+		/* Generate code to load object */
+		ComEval(com, CAR(values));
+
+		/* Add loaded value to gc protected list */
+		com_Bytecode(com, XBC_LCONS);
+	    }
+
+	    /* Finish gc protected list */
+	    com_Bytecode(com, XBC_LFINI);
+
+	    /* Push loaded value */
+	    if (builtin)
+		com_Bytecode(com, XBC_PUSH);
+	    else {
+		com_Let(com, alist->rest->data.atom);
+
+		/* Remember this symbol will be bound */
+		ComAddVariable(com, alist->rest, values);
+	    }
+	    com->stack.cpstack -= 2;
+	}
+    }
+    if (!builtin && !com->macro)
+	COM_VARIABLE_ARGUMENT(alist->rest->data.atom);
+    if (*desc != 'a')
+	goto finished_label;
+
+
+    /* &AUX */
+aux_label:
+    i = 0;
+    count = alist->auxs.num_symbols;
+    symbols = alist->auxs.symbols;
+    defaults = alist->auxs.initials;
+    if (!builtin && !compile) {
+	int lex = com->lex;
+
+	com->lex = base;
+	lisp__data.env.head = lisp__data.env.length;
+	for (; i < count; i++) {
+	    ComPush(com, symbols[i], defaults[i], 1, 0, 0);
+	    if (!com->macro)
+		COM_VARIABLE_ARGUMENT(symbols[i]->data.atom);
+	    ++lisp__data.env.head;
+	}
+	com->lex = lex;
+    }
+    else {
+	for (; i < count; i++) {
+	    ComPush(com, symbols[i], defaults[i], eval, builtin, compile);
+	    if (!builtin && !com->macro)
+		COM_VARIABLE_ARGUMENT(symbols[i]->data.atom);
+	}
+    }
+
+done_label:
+    if (CONSP(values))
+	LispDestroy("%s: too many arguments", STROBJ(name));
+
+finished_label:
+    if (builtin)
+	lisp__data.stack.base = base;
+    else
+	lisp__data.env.head = lisp__data.env.length;
+
+    return (base);
+}
+
+static void
+ComFuncall(LispCom *com, LispObj *function, LispObj *arguments, int eval)
+{
+    int base, compile;
+    LispAtom *atom;
+    LispArgList *alist;
+    LispBuiltin *builtin;
+    LispObj *lambda;
+
+    switch (OBJECT_TYPE(function)) {
+	case LispFunction_t:
+	    function = function->data.atom->object;
+	case LispAtom_t:
+	    atom = function->data.atom;
+	    alist = atom->property->alist;
+
+	    if (atom->a_builtin) {
+		builtin = atom->property->fun.builtin;
+		compile = builtin->compile != NULL;
+
+		/*  If one of:
+		 * 	o expanding a macro
+		 *	o calling a builtin special form
+		 *	o builtin function is a macro
+		 * don't evaluate arguments. */
+		if (com->macro || compile || builtin->type == LispMacro)
+		    eval = 0;
+
+		if (!com->macro && builtin->type == LispMacro) {
+		    /* Set flag of variable used, in case variable is only
+		     * used as a builtin macro argument. */
+		    LispObj *obj;
+
+		    for (obj = arguments; CONSP(obj); obj = CDR(obj)) {
+			if (SYMBOLP(CAR(obj)))
+			    COM_VARIABLE_USED(CAR(obj)->data.atom);
+		    }
+		}
+
+		FORM_ENTER();
+		if (!compile && !com->macro)
+		    CompileStackEnter(com, alist->num_arguments, 1);
+
+		/* Build argument list in the interpreter stacks */
+		base = ComCall(com, alist, function, arguments,
+			       eval, 1, compile);
+
+		/* If <compile> is set, it is a special form */
+		if (compile)
+		    builtin->compile(com, builtin);
+
+		/* Else, generate opcodes to call builtin function */
+		else {
+		    com_Call(com, alist->num_arguments, builtin);
+		    CompileStackLeave(com, alist->num_arguments, 1);
+		}
+		lisp__data.stack.base = lisp__data.stack.length = base;
+		FORM_LEAVE();
+	    }
+	    else if (atom->a_function) {
+		int macro;
+
+		lambda = atom->property->fun.function;
+		macro = lambda->funtype == LispMacro;
+
+		/* If <macro> is set, expand macro */
+		if (macro)
+		    ComMacroCall(com, alist, function, lambda, arguments);
+
+		else {
+		    if (com->toplevel->type == LispBlockClosure &&
+			com->toplevel->tag == function)
+			ComRecursiveCall(com, alist, function, arguments);
+		    else {
+#if 0
+			ComInlineCall(com, alist, function, arguments,
+				      lambda->data.lambda.code);
+#else
+			com_Funcall(com, function, arguments);
+#endif
+		    }
+		}
+	    }
+	    else if (atom->a_defstruct &&
+		     atom->property->structure.function != STRUCT_NAME &&
+		     atom->property->structure.function != STRUCT_CONSTRUCTOR) {
+		LispObj *definition = atom->property->structure.definition;
+
+		if (!CONSP(arguments) || CONSP(CDR(arguments)))
+		    LispDestroy("%s: too %s arguments", atom->string,
+				CONSP(arguments) ? "many" : "few");
+
+		ComEval(com, CAR(arguments));
+		if (atom->property->structure.function == STRUCT_CHECK)
+		    com_Structp(com, definition);
+		else
+		    com_Struct(com,
+			       atom->property->structure.function, definition);
+	    }
+	    else if (atom->a_compiled) {
+		FORM_ENTER();
+		CompileStackEnter(com, alist->num_arguments, 0);
+
+		/* Build argument list in the interpreter stacks */
+		base = ComCall(com, alist, function, arguments, 1, 0, 0);
+		com_Bytecall(com, alist->num_arguments,
+			     atom->property->fun.function);
+		CompileStackLeave(com, alist->num_arguments, 0);
+		lisp__data.env.head = lisp__data.env.length = base;
+		FORM_LEAVE();
+	    }
+	    else {
+		/* Not yet defined function/macro. */
+		++com->warnings;
+		LispWarning("call to undefined function %s", atom->string);
+		com_Funcall(com, function, arguments);
+	    }
+	    break;
+
+	case LispLambda_t:
+	    lambda = function->data.lambda.code;
+	    alist = (LispArgList*)function->data.lambda.name->data.opaque.data;
+	    ComInlineCall(com, alist, NIL, arguments, lambda->data.lambda.code);
+	    break;
+
+	case LispCons_t:
+	    if (CAR(function) == Olambda) {
+		function = EVAL(function);
+		if (LAMBDAP(function)) {
+		    GC_ENTER();
+
+		    GC_PROTECT(function);
+		    lambda = function->data.lambda.code;
+		    alist = (LispArgList*)function->data.lambda.name->data.opaque.data;
+		    ComInlineCall(com, alist, NIL, arguments, lambda->data.lambda.code);
+		    GC_LEAVE();
+		    break;
+		}
+	    }
+
+	default:
+	    /*  XXX If bytecode objects are made available, should
+	     * handle it here. */
+	    LispDestroy("EVAL: %s is invalid as a function",
+			STROBJ(function));
+	    /*NOTREACHED*/
+	    break;
+    }
+}
+
+/* Generate opcodes for an implicit PROGN */
+static void
+ComProgn(LispCom *com, LispObj *code)
+{
+    if (CONSP(code)) {
+	for (; CONSP(code); code = CDR(code))
+	    ComEval(com, CAR(code));
+    }
+    else
+	/* If no code to execute, empty PROGN returns NIL */
+	com_Bytecode(com, XBC_NIL);
+}
+
+/* Generate opcodes to evaluate <object>. */
+static void
+ComEval(LispCom *com, LispObj *object)
+{
+    int offset;
+    LispObj *form;
+
+    switch (OBJECT_TYPE(object)) {
+	case LispAtom_t:
+	    if (IN_TAGBODY())
+		ComLabel(com, object);
+	    else {
+		offset = ComGetVariable(com, object);
+		if (offset >= 0)
+		    /* Load from user stack at relative offset */
+		    com_Load(com, offset);
+		else if (offset == SYMBOL_KEYWORD)
+		    com_LoadCon(com, object);
+		else if (offset == SYMBOL_CONSTANT)
+		    /* Symbol defined as constant, just load it's value */
+		    com_LoadCon(com, LispGetVar(object));
+		else
+		    /* Load value bound to symbol at run time */
+		    com_LoadSym(com, object->data.atom);
+	    }
+	    break;
+
+	case LispCons_t: {
+	    /* Macro expansion may be done in the object form */
+	    form = com->form;
+	    com->form = object;
+	    ComFuncall(com, CAR(object), CDR(object), 1);
+	    com->form = form;
+	}   break;
+
+	case LispQuote_t:
+	    com_LoadCon(com, object->data.quote);
+	    break;
+
+	case LispBackquote_t:
+	    /* Macro expansion is stored in the current value of com->form */
+	    ComMacroBackquote(com, object);
+	    break;
+
+	case LispComma_t:
+	    LispDestroy("EVAL: comma outside of backquote");
+	    break;
+
+	case LispFunctionQuote_t:
+	    object = object->data.quote;
+	    if (SYMBOLP(object))
+		object = LispSymbolFunction(object);
+	    else if (CONSP(object) && CAR(object) == Olambda) {
+		/* object will only be associated with bytecode later,
+		 * so, make sure it is protected until compilation finishes */
+		object = EVAL(object);
+		RPLACD(com->plist, CONS(CAR(com->plist), CDR(com->plist)));
+		RPLACA(com->plist, object);
+	    }
+	    else
+		LispDestroy("FUNCTION: %s is not a function", STROBJ(object));
+	    com_LoadCon(com, object);
+	    break;
+
+	case LispFixnum_t:
+	    if (IN_TAGBODY()) {
+		ComLabel(com, object);
+		break;
+	    }
+	    /*FALLTROUGH*/
+
+	default:
+	    /* Constant object */
+	    com_LoadCon(com, object);
+	    break;
+    }
+}
+
+/***********************************************************************
+ * Lambda expansion helper functions
+ ***********************************************************************/
+static void
+ComRecursiveCall(LispCom *com, LispArgList *alist,
+		 LispObj *name, LispObj *arguments)
+{
+    int base, lex;
+
+    /* Save state */
+    lex = lisp__data.env.lex;
+
+    FORM_ENTER();
+
+    /* Generate code to push function arguments in the stack */
+    base = ComCall(com, alist, name, arguments, 1, 0, 0);
+
+    /* Stack will grow this amount */
+    CompileStackEnter(com, alist->num_arguments, 0);
+
+#if 0
+    /* Make the variables available at run time */
+    com_Bind(com, alist->num_arguments);
+    com->block->bind += alist->num_arguments;
+#endif
+
+    com_BytecodeChar(com, XBC_LETREC, alist->num_arguments);
+
+#if 0
+    /* The variables are now unbound */
+    com_Unbind(com, alist->num_arguments);
+    com->block->bind -= alist->num_arguments;
+#endif
+
+    /* Stack length is reduced */
+    CompileStackLeave(com, alist->num_arguments, 0);
+    FORM_LEAVE();
+
+    /* Restore state */
+    lisp__data.env.lex = lex;
+    lisp__data.env.head = lisp__data.env.length = base;
+}
+
+static void
+ComInlineCall(LispCom *com, LispArgList *alist,
+	      LispObj *name, LispObj *arguments, LispObj *lambda)
+{
+    int base, lex;
+
+    /* Save state */
+    lex = lisp__data.env.lex;
+
+    FORM_ENTER();
+    /* Start the inline function block */
+    CompileIniBlock(com, LispBlockClosure, name);
+
+    /* Generate code to push function arguments in the stack */
+    base = ComCall(com, alist, name, arguments, 1, 0, 0);
+
+    /* Stack will grow this amount */
+    CompileStackEnter(com, alist->num_arguments, 0);
+
+    /* Make the variables available at run time */
+    com_Bind(com, alist->num_arguments);
+    com->block->bind += alist->num_arguments;
+
+    /* Expand the lambda list */
+    ComProgn(com, lambda);
+
+    /* The variables are now unbound */
+    com_Unbind(com, alist->num_arguments);
+    com->block->bind -= alist->num_arguments;
+
+    /* Stack length is reduced */
+    CompileStackLeave(com, alist->num_arguments, 0);
+
+    /* Finish the inline function block */
+    CompileFiniBlock(com);
+    FORM_LEAVE();
+
+    /* Restore state */
+    lisp__data.env.lex = lex;
+    lisp__data.env.head = lisp__data.env.length = base;
+}
+
+/***********************************************************************
+ * Macro expansion helper functions.
+ ***********************************************************************/
+static LispObj *
+ComMacroExpandBackquote(LispCom *com, LispObj *object)
+{
+    return (LispEvalBackquote(object->data.quote, 1));
+}
+
+static LispObj *
+ComMacroExpandFuncall(LispCom *com, LispObj *function, LispObj *arguments)
+{
+    return (LispFuncall(function, arguments, 1));
+}
+
+static LispObj *
+ComMacroExpandEval(LispCom *com, LispObj *object)
+{
+    LispObj *result;
+
+    switch (OBJECT_TYPE(object)) {
+	case LispAtom_t:
+	    result = LispGetVar(object);
+
+	    /* Macro expansion requires bounded symbols */
+	    if (result == NULL)
+		LispDestroy("EVAL: the variable %s is unbound",
+			    STROBJ(object));
+	    break;
+
+	case LispCons_t:
+	    result = ComMacroExpandFuncall(com, CAR(object), CDR(object));
+	    break;
+
+	case LispQuote_t:
+	    result = object->data.quote;
+	    break;
+
+	case LispBackquote_t:
+	    result = ComMacroExpandBackquote(com, object);
+	    break;
+
+	case LispComma_t:
+	    LispDestroy("EVAL: comma outside of backquote");
+
+	case LispFunctionQuote_t:
+	    result = EVAL(object);
+	    break;
+
+	default:
+	    result = object;
+	    break;
+    }
+
+    return (result);
+}
+
+static LispObj *
+ComMacroExpand(LispCom *com, LispObj *lambda)
+{
+    LispObj *result, **presult = &result, **plambda;
+    int jumped, *pjumped = &jumped, backquote, *pbackquote = &backquote;
+    LispBlock *block;
+
+    int interpreter_lex, interpreter_head, interpreter_base;
+
+    /* Save interpreter state */
+    interpreter_base = lisp__data.stack.length;
+    interpreter_head = lisp__data.env.length;
+    interpreter_lex = lisp__data.env.lex;
+
+    /* Use the variables */
+    plambda = &lambda;
+    *presult = NIL;
+    *pjumped = 1;
+    *pbackquote = !CONSP(lambda);
+
+    block = LispBeginBlock(NIL, LispBlockProtect);
+    if (setjmp(block->jmp) == 0) {
+	if (!backquote) {
+	    for (; CONSP(lambda); lambda = CDR(lambda))
+		result = ComMacroExpandEval(com, CAR(lambda));
+	}
+	else
+	    result = ComMacroExpandBackquote(com, lambda);
+
+	*pjumped = 0;
+    }
+    LispEndBlock(block);
+
+    /* If tried to jump out of the macro expansion block */
+    if (!lisp__data.destroyed && jumped)
+	LispDestroy("*** EVAL: bad jump in macro expansion");
+
+    /* Macro expansion did something wrong */
+    if (lisp__data.destroyed) {
+	LispMessage("*** EVAL: aborting macro expansion");
+	LispDestroy(".");
+    }
+
+    /* Restore interpreter state */
+    lisp__data.env.lex = interpreter_lex;
+    lisp__data.stack.length = interpreter_base;
+    lisp__data.env.head = lisp__data.env.length = interpreter_head;
+
+    return (result);
+}
+
+static void
+ComMacroCall(LispCom *com, LispArgList *alist,
+	     LispObj *name, LispObj *lambda, LispObj *arguments)
+{
+    int base;
+    LispObj *body;
+
+    ++com->macro;
+    base = ComCall(com, alist, name, arguments, 0, 0, 0);
+    body = lambda->data.lambda.code;
+    body = ComMacroExpand(com, body);
+    --com->macro;
+    lisp__data.env.head = lisp__data.env.length = base;
+
+    /* Macro is expanded, store the result */
+    CAR(com->form) = body;
+    ComEval(com, body);
+}
+
+static void
+ComMacroBackquote(LispCom *com, LispObj *lambda)
+{
+    LispObj *body;
+
+    ++com->macro;
+    body = ComMacroExpand(com, lambda);
+    --com->macro;
+
+    /* Macro is expanded, store the result */
+    CAR(com->form) = body;
+
+    com_LoadCon(com, body);
+}
diff --git a/lisp/core.c b/lisp/core.c
new file mode 100644
index 0000000..d834dd5
--- /dev/null
+++ b/lisp/core.c
@@ -0,0 +1,7040 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/core.c,v 1.69 2002/12/20 04:32:45 paulo Exp $ */
+
+#include "io.h"
+#include "core.h"
+#include "format.h"
+#include "helper.h"
+#include "package.h"
+#include "private.h"
+#include "write.h"
+
+/*
+ * Types
+ */
+typedef struct _SeqInfo {
+    LispType type;
+    union {
+	LispObj *list;
+	LispObj **vector;
+	unsigned char *string;
+    } data;
+} SeqInfo;
+
+#define SETSEQ(seq, object)						\
+    switch (seq.type = XOBJECT_TYPE(object)) {				\
+	case LispString_t:						\
+	    seq.data.string = (unsigned char*)THESTR(object);		\
+	    break;							\
+	case LispCons_t:						\
+	    seq.data.list = object;					\
+	    break;							\
+	default:							\
+	    seq.data.list = object->data.array.list;			\
+	    break;							\
+    }
+
+#ifdef NEED_SETENV
+extern int setenv(const char *name, const char *value, int overwrite);
+extern void unsetenv(const char *name);
+#endif
+
+/*
+ * Prototypes
+ */
+#define NONE		0
+
+#define	REMOVE		1
+#define	SUBSTITUTE	2
+#define DELETE		3
+#define	NSUBSTITUTE	4
+
+#define ASSOC		1
+#define MEMBER		2
+
+#define FIND		1
+#define POSITION	2
+
+#define	IF		1
+#define	IFNOT		2
+
+#define UNION		1
+#define INTERSECTION	2
+#define SETDIFFERENCE	3
+#define SETEXCLUSIVEOR	4
+#define SUBSETP		5
+#define NSETDIFFERENCE	6
+#define NINTERSECTION	7
+#define NUNION		8
+#define NSETEXCLUSIVEOR	9
+
+#define COPY_LIST	1
+#define COPY_ALIST	2
+#define COPY_TREE	3
+
+#define EVERY		1
+#define SOME		2
+#define NOTEVERY	3
+#define NOTANY		4
+
+/* Call directly LispObjectCompare() if possible */
+#define FCODE(predicate)					\
+    predicate == Oeql ? FEQL :					\
+	predicate == Oequal ? FEQUAL :				\
+	    predicate == Oeq ? FEQ :				\
+		predicate == Oequalp ? FEQUALP : 0
+#define FCOMPARE(predicate, left, right, code)			\
+    code == FEQ ? left == right :				\
+	code ? LispObjectCompare(left, right, code) != NIL :	\
+	       APPLY2(predicate, left, right) != NIL
+
+#define FUNCTION_CHECK(predicate)				\
+    if (FUNCTIONP(predicate))					\
+	predicate = (predicate)->data.atom->object
+
+#define CHECK_TEST_0()						\
+    if (test != UNSPEC && test_not != UNSPEC)			\
+	LispDestroy("%s: specify either :TEST or :TEST-NOT",	\
+		    STRFUN(builtin))
+
+#define CHECK_TEST()						\
+    CHECK_TEST_0();						\
+    if (test_not == UNSPEC) {					\
+	if (test == UNSPEC)					\
+	    lambda = Oeql;					\
+	else							\
+	    lambda = test;					\
+	expect = 1;						\
+    }								\
+    else {							\
+	lambda = test_not;					\
+	expect = 0;						\
+    }								\
+    FUNCTION_CHECK(lambda);					\
+    code = FCODE(lambda)
+
+
+static LispObj *LispAdjoin(LispBuiltin*,
+			   LispObj*, LispObj*, LispObj*, LispObj*, LispObj*);
+static LispObj *LispAssocOrMember(LispBuiltin*, int, int);
+static LispObj *LispEverySomeAnyNot(LispBuiltin*, int);
+static LispObj *LispFindOrPosition(LispBuiltin*, int, int);
+static LispObj *LispDeleteOrRemoveDuplicates(LispBuiltin*, int);
+static LispObj *LispDeleteRemoveXSubstitute(LispBuiltin*, int, int);
+static LispObj *LispListSet(LispBuiltin*, int);
+static LispObj *LispMapc(LispBuiltin*, int);
+static LispObj *LispMapl(LispBuiltin*, int);
+static LispObj *LispMapnconc(LispObj*);
+extern LispObj *LispRunSetf(LispArgList*, LispObj*, LispObj*, LispObj*);
+extern LispObj *LispRunSetfMacro(LispAtom*, LispObj*, LispObj*);
+static LispObj *LispMergeSort(LispObj*, LispObj*, LispObj*, int);
+static LispObj *LispXReverse(LispBuiltin*, int);
+static LispObj *LispCopyList(LispBuiltin*, LispObj*, int);
+static LispObj *LispValuesList(LispBuiltin*, int);
+static LispObj *LispTreeEqual(LispObj*, LispObj*, LispObj*, int);
+static LispDocType_t LispDocumentationType(LispBuiltin*, LispObj*);
+
+extern void LispSetAtomObjectProperty(LispAtom*, LispObj*);
+
+/*
+ * Initialization
+ */
+LispObj *Oeq, *Oeql, *Oequal, *Oequalp, *Omake_array,
+	*Kinitial_contents, *Osetf, *Ootherwise, *Oquote;
+LispObj *Ogensym_counter;
+
+Atom_id Svariable, Sstructure, Stype, Ssetf;
+
+/*
+ * Implementation
+ */
+void
+LispCoreInit(void)
+{
+    Oeq			= STATIC_ATOM("EQ");
+    Oeql		= STATIC_ATOM("EQL");
+    Oequal		= STATIC_ATOM("EQUAL");
+    Oequalp		= STATIC_ATOM("EQUALP");
+    Omake_array		= STATIC_ATOM("MAKE-ARRAY");
+    Kinitial_contents	= KEYWORD("INITIAL-CONTENTS");
+    Osetf		= STATIC_ATOM("SETF");
+    Ootherwise		= STATIC_ATOM("OTHERWISE");
+    LispExportSymbol(Ootherwise);
+    Oquote		= STATIC_ATOM("QUOTE");
+    LispExportSymbol(Oquote);
+
+    Svariable		= GETATOMID("VARIABLE");
+    Sstructure		= GETATOMID("STRUCTURE");
+    Stype		= GETATOMID("TYPE");
+
+    /* Create as a constant so that only the C code should change the value */
+    Ogensym_counter	= STATIC_ATOM("*GENSYM-COUNTER*");
+    LispDefconstant(Ogensym_counter, FIXNUM(0), NIL);
+    LispExportSymbol(Ogensym_counter);
+
+    Ssetf	= ATOMID(Osetf);
+}
+
+LispObj *
+Lisp_Acons(LispBuiltin *builtin)
+/*
+ acons key datum alist
+ */
+{
+    LispObj *key, *datum, *alist;
+
+    alist = ARGUMENT(2);
+    datum = ARGUMENT(1);
+    key = ARGUMENT(0);
+
+    return (CONS(CONS(key, datum), alist));
+}
+
+static LispObj *
+LispAdjoin(LispBuiltin*builtin, LispObj *item, LispObj *list,
+	   LispObj *key, LispObj *test, LispObj *test_not)
+{
+    GC_ENTER();
+    int code, expect, value;
+    LispObj *lambda, *compare, *object;
+
+    CHECK_LIST(list);
+    CHECK_TEST();
+
+    if (key != UNSPEC) {
+	item = APPLY1(key, item);
+	/* Result is not guaranteed to be gc protected */
+	GC_PROTECT(item);
+    }
+
+    /* Check if item is not already in place */
+    for (object = list; CONSP(object); object = CDR(object)) {
+	compare = CAR(object);
+	if (key != UNSPEC) {
+	    compare = APPLY1(key, compare);
+	    GC_PROTECT(compare);
+	    value = FCOMPARE(lambda, item, compare, code);
+	    /* Unprotect compare... */
+	    --lisp__data.protect.length;
+	}
+	else
+	    value = FCOMPARE(lambda, item, compare, code);
+
+	if (value == expect) {
+	    /* Item is already in list */
+	    GC_LEAVE();
+
+	    return (list);
+	}
+    }
+    GC_LEAVE();
+
+    return (CONS(item, list));
+}
+
+LispObj *
+Lisp_Adjoin(LispBuiltin *builtin)
+/*
+ adjoin item list &key key test test-not
+ */
+{
+    LispObj *item, *list, *key, *test, *test_not;
+
+    test_not = ARGUMENT(4);
+    test = ARGUMENT(3);
+    key = ARGUMENT(2);
+    list = ARGUMENT(1);
+    item = ARGUMENT(0);
+
+    return (LispAdjoin(builtin, item, list, key, test, test_not));
+}
+
+LispObj *
+Lisp_Append(LispBuiltin *builtin)
+/*
+ append &rest lists
+ */
+{
+    GC_ENTER();
+    LispObj *result, *cons, *list;
+
+    LispObj *lists;
+
+    lists = ARGUMENT(0);
+
+    /* no arguments */
+    if (!CONSP(lists))
+	return (NIL);
+
+    /* skip initial nil lists */
+    for (; CONSP(CDR(lists)) && CAR(lists) == NIL; lists = CDR(lists))
+	;
+
+    /* last argument is not copied (even if it is the single argument) */
+    if (!CONSP(CDR(lists)))
+	return (CAR(lists));
+
+    /* make sure result is a list */
+    list = CAR(lists);
+    CHECK_CONS(list);
+    result = cons = CONS(CAR(list), NIL);
+    GC_PROTECT(result);
+    for (list = CDR(list); CONSP(list); list = CDR(list)) {
+	RPLACD(cons, CONS(CAR(list), NIL));
+	cons = CDR(cons);
+    }
+    lists = CDR(lists);
+
+    /* copy intermediate lists */
+    for (; CONSP(CDR(lists)); lists = CDR(lists)) {
+	list = CAR(lists);
+	if (list == NIL)
+	    continue;
+	/* intermediate elements must be lists */
+	CHECK_CONS(list);
+	for (; CONSP(list); list = CDR(list)) {
+	    RPLACD(cons, CONS(CAR(list), NIL));
+	    cons = CDR(cons);
+	}
+    }
+
+    /* add last element */
+    RPLACD(cons, CAR(lists));
+
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Aref(LispBuiltin *builtin)
+/*
+ aref array &rest subscripts
+ */
+{
+    long c, count, idx, seq;
+    LispObj *obj, *dim;
+
+    LispObj *array, *subscripts;
+
+    subscripts = ARGUMENT(1);
+    array = ARGUMENT(0);
+
+    /* accept strings also */
+    if (STRINGP(array) && CONSP(subscripts) && CDR(subscripts) == NIL) {
+	long offset, length = STRLEN(array);
+
+	CHECK_INDEX(CAR(subscripts));
+	offset = FIXNUM_VALUE(CAR(subscripts));
+
+	if (offset >= length)
+	    LispDestroy("%s: index %ld too large for sequence length %ld",
+			STRFUN(builtin), offset, length);
+
+	return (SCHAR(THESTR(array)[offset]));
+    }
+
+    CHECK_ARRAY(array);
+
+    for (count = 0, dim = subscripts, obj = array->data.array.dim; CONSP(dim);
+	 count++, dim = CDR(dim), obj = CDR(obj)) {
+	if (count >= array->data.array.rank)
+	    LispDestroy("%s: too many subscripts %s",
+			STRFUN(builtin), STROBJ(subscripts));
+	if (!INDEXP(CAR(dim)) ||
+	    FIXNUM_VALUE(CAR(dim)) >= FIXNUM_VALUE(CAR(obj)))
+	    LispDestroy("%s: %s is out of range or a bad index",
+			STRFUN(builtin), STROBJ(CAR(dim)));
+    }
+    if (count < array->data.array.rank)
+	LispDestroy("%s: too few subscripts %s",
+		    STRFUN(builtin), STROBJ(subscripts));
+
+    for (count = seq = 0, dim = subscripts; CONSP(dim); dim = CDR(dim), seq++) {
+	for (idx = 0, obj = array->data.array.dim; idx < seq;
+	     obj = CDR(obj), ++idx)
+	    ;
+	for (c = 1, obj = CDR(obj); obj != NIL; obj = CDR(obj))
+	    c *= FIXNUM_VALUE(CAR(obj));
+	count += c * FIXNUM_VALUE(CAR(dim));
+    }
+
+    for (array = array->data.array.list; count > 0; array = CDR(array), count--)
+	;
+
+    return (CAR(array));
+}
+
+static LispObj *
+LispAssocOrMember(LispBuiltin *builtin, int function, int comparison)
+/*
+ assoc item list &key test test-not key
+ assoc-if predicate list &key key
+ assoc-if-not predicate list &key key
+ member item list &key test test-not key
+ member-if predicate list &key key
+ member-if-not predicate list &key key
+ */
+{
+    int code = 0, expect, value;
+    LispObj *lambda, *result, *compare;
+
+    LispObj *item, *list, *test, *test_not, *key;
+
+    if (comparison == NONE) {
+	key = ARGUMENT(4);
+	test_not = ARGUMENT(3);
+	test = ARGUMENT(2);
+	list = ARGUMENT(1);
+	item = ARGUMENT(0);
+	lambda = NIL;
+    }
+    else {
+	key = ARGUMENT(2);
+	list = ARGUMENT(1);
+	lambda = ARGUMENT(0);
+	test = test_not = UNSPEC;
+	item = NIL;
+    }
+
+    if (list == NIL)
+	return (NIL);
+    CHECK_CONS(list);
+
+    /* Resolve compare function, and expected result of comparison */
+    if (comparison == NONE) {
+	CHECK_TEST();
+    }
+    else
+	expect = comparison == IFNOT ? 0 : 1;
+
+    result = NIL;
+    for (; CONSP(list); list = CDR(list)) {
+	compare = CAR(list);
+	if (function == ASSOC) {
+	    if (!CONSP(compare))
+		continue;
+	    compare = CAR(compare);
+	}
+	if (key != UNSPEC)
+	    compare = APPLY1(key, compare);
+
+	if (comparison == NONE)
+	    value = FCOMPARE(lambda, item, compare, code);
+	else
+	    value = APPLY1(lambda, compare) != NIL;
+	if (value == expect) {
+	    result = list;
+	    if (function == ASSOC)
+		result = CAR(result);
+	    break;
+	}
+    }
+    if (function == MEMBER) {
+	CHECK_LIST(list);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Assoc(LispBuiltin *builtin)
+/*
+ assoc item list &key test test-not key
+ */
+{
+    return (LispAssocOrMember(builtin, ASSOC, NONE));
+}
+
+LispObj *
+Lisp_AssocIf(LispBuiltin *builtin)
+/*
+ assoc-if predicate list &key key
+ */
+{
+    return (LispAssocOrMember(builtin, ASSOC, IF));
+}
+
+LispObj *
+Lisp_AssocIfNot(LispBuiltin *builtin)
+/*
+ assoc-if-not predicate list &key key
+ */
+{
+    return (LispAssocOrMember(builtin, ASSOC, IFNOT));
+}
+
+LispObj *
+Lisp_And(LispBuiltin *builtin)
+/*
+ and &rest args
+ */
+{
+    LispObj *result = T, *args;
+
+    args = ARGUMENT(0);
+
+    for (; CONSP(args); args = CDR(args)) {
+	result = EVAL(CAR(args));
+	if (result == NIL)
+	    break;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Apply(LispBuiltin *builtin)
+/*
+ apply function arg &rest more-args
+ */
+{
+    GC_ENTER();
+    LispObj *result, *arguments;
+
+    LispObj *function, *arg, *more_args;
+
+    more_args = ARGUMENT(2);
+    arg = ARGUMENT(1);
+    function = ARGUMENT(0);
+
+    if (more_args == NIL) {
+	CHECK_LIST(arg);
+	arguments = arg;
+	for (; CONSP(arg); arg = CDR(arg))
+	    ;
+	CHECK_LIST(arg);
+    }
+    else {
+	LispObj *cons;
+
+	CHECK_CONS(more_args);
+	arguments = cons = CONS(arg, NIL);
+	GC_PROTECT(arguments);
+	for (arg = CDR(more_args);
+	     CONSP(arg);
+	     more_args = arg, arg = CDR(arg)) {
+	    RPLACD(cons, CONS(CAR(more_args), NIL));
+	    cons = CDR(cons);
+	}
+	more_args = CAR(more_args);
+	if (more_args != NIL) {
+	    for (arg = more_args; CONSP(arg); arg = CDR(arg))
+		;
+	    CHECK_LIST(arg);
+	    RPLACD(cons, more_args);
+	}
+    }
+
+    result = APPLY(function, arguments);
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Atom(LispBuiltin *builtin)
+/*
+ atom object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (CONSP(object) ? NIL : T);
+}
+
+LispObj *
+Lisp_Block(LispBuiltin *builtin)
+/*
+ block name &rest body
+ */
+{
+    int did_jump, *pdid_jump = &did_jump;
+    LispObj *res, **pres = &res, **pbody;
+    LispBlock *block;
+
+    LispObj *name, *body;
+
+    body = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    if (!SYMBOLP(name) && name != NIL && name != T)
+	LispDestroy("%s: %s cannot name a block",
+		    STRFUN(builtin), STROBJ(name));
+
+    pbody = &body;
+    *pres = NIL;
+    *pdid_jump = 1;
+    block = LispBeginBlock(name, LispBlockTag);
+    if (setjmp(block->jmp) == 0) {
+	for (; CONSP(body); body = CDR(body))
+	    res = EVAL(CAR(body));
+	*pdid_jump = 0;
+    }
+    LispEndBlock(block);
+    if (*pdid_jump)
+	*pres = lisp__data.block.block_ret;
+
+    return (res);
+}
+
+LispObj *
+Lisp_Boundp(LispBuiltin *builtin)
+/*
+ boundp symbol
+ */
+{
+    LispAtom *atom;
+
+    LispObj *symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+
+    atom = symbol->data.atom;
+    if (atom->package == lisp__data.keyword ||
+	(atom->a_object && atom->property->value != UNBOUND))
+	return (T);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Butlast(LispBuiltin *builtin)
+/*
+ butlast list &optional count
+ */
+{
+    GC_ENTER();
+    long length, count;
+    LispObj *result, *cons, *list, *ocount;
+
+    ocount = ARGUMENT(1);
+    list = ARGUMENT(0);
+
+    CHECK_LIST(list);
+    if (ocount == UNSPEC)
+	count = 1;
+    else {
+	CHECK_INDEX(ocount);
+	count = FIXNUM_VALUE(ocount);
+    }
+    length = LispLength(list);
+
+    if (count == 0)
+	return (list);
+    else if (count >= length)
+	return (NIL);
+
+    length -= count + 1;
+    result = cons = CONS(CAR(list), NIL);
+    GC_PROTECT(result);
+    for (list = CDR(list); length > 0; list = CDR(list), length--) {
+	RPLACD(cons, CONS(CAR(list), NIL));
+	cons = CDR(cons);
+    }
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Nbutlast(LispBuiltin *builtin)
+/*
+ nbutlast list &optional count
+ */
+{
+    long length, count;
+    LispObj *result, *list, *ocount;
+
+    ocount = ARGUMENT(1);
+    list = ARGUMENT(0);
+
+    CHECK_LIST(list);
+    if (ocount == UNSPEC)
+	count = 1;
+    else {
+	CHECK_INDEX(ocount);
+	count = FIXNUM_VALUE(ocount);
+    }
+    length = LispLength(list);
+
+    if (count == 0)
+	return (list);
+    else if (count >= length)
+	return (NIL);
+
+    length -= count + 1;
+    result = list;
+    for (; length > 0; list = CDR(list), length--)
+	;
+    RPLACD(list, NIL);
+
+    return (result);
+}
+
+LispObj *
+Lisp_Car(LispBuiltin *builtin)
+/*
+ car list
+ */
+{
+    LispObj *list, *result = NULL;
+
+    list = ARGUMENT(0);
+
+    if (list == NIL)
+	result = NIL;
+    else {
+	CHECK_CONS(list);
+	result = CAR(list);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Case(LispBuiltin *builtin)
+/*
+ case keyform &rest body
+ */
+{
+    LispObj *result, *code, *keyform, *body, *form;
+
+    body = ARGUMENT(1);
+    keyform = ARGUMENT(0);
+
+    result = NIL;
+    keyform = EVAL(keyform);
+
+    for (; CONSP(body); body = CDR(body)) {
+	code = CAR(body);
+	CHECK_CONS(code);
+
+	form = CAR(code);
+	if (form == T || form == Ootherwise) {
+	    if (CONSP(CDR(body)))
+		LispDestroy("%s: %s must be the last clause",
+			    STRFUN(builtin), STROBJ(CAR(code)));
+	    result = CDR(code);
+	    break;
+	}
+	else if (CONSP(form)) {
+	    for (; CONSP(form); form = CDR(form))
+		if (XEQL(keyform, CAR(form)) == T) {
+		    result = CDR(code);
+		    break;
+		}
+	    if (CONSP(form))	/* if found match */
+		break;
+	}
+	else if (XEQL(keyform, form) == T) {
+	    result = CDR(code);
+	    break;
+	}
+    }
+
+    for (body = result; CONSP(body); body = CDR(body))
+	result = EVAL(CAR(body));
+
+    return (result);
+}
+
+LispObj *
+Lisp_Catch(LispBuiltin *builtin)
+/*
+ catch tag &rest body
+ */
+{
+    int did_jump, *pdid_jump = &did_jump;
+    LispObj *res, **pres = &res;
+    LispBlock *block;
+
+    LispObj *tag, *body, **pbody;
+
+    body = ARGUMENT(1);
+    tag = ARGUMENT(0);
+
+    pbody = &body;
+    *pres = NIL;
+    *pdid_jump = 1;
+    block = LispBeginBlock(tag, LispBlockCatch);
+    if (setjmp(block->jmp) == 0) {
+	for (; CONSP(body); body = CDR(body))
+	    res = EVAL(CAR(body));
+	*pdid_jump = 0;
+    }
+    LispEndBlock(block);
+    if (*pdid_jump)
+	*pres = lisp__data.block.block_ret;
+
+    return (res);
+}
+
+LispObj *
+Lisp_Coerce(LispBuiltin *builtin)
+/*
+ coerce object result-type
+ */
+{
+    LispObj *object, *result_type;
+
+    result_type = ARGUMENT(1);
+    object = ARGUMENT(0);
+
+    return (LispCoerce(builtin, object, result_type));
+}
+
+LispObj *
+Lisp_Cdr(LispBuiltin *builtin)
+/*
+ cdr list
+ */
+{
+    LispObj *list, *result = NULL;
+
+    list = ARGUMENT(0);
+
+    if (list == NIL)
+	result = NIL;
+    else {
+	CHECK_CONS(list);
+	result = CDR(list);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_C_r(LispBuiltin *builtin)
+/*
+ c[ad]{2,4}r list
+ */
+{
+    char *desc;
+
+    LispObj *list, *result = NULL;
+
+    list = ARGUMENT(0);
+
+    result = list;
+    desc = STRFUN(builtin);
+    while (desc[1] != 'R')
+	++desc;
+    while (*desc != 'C') {
+	if (result == NIL)
+	    break;
+	CHECK_CONS(result);
+	result = *desc == 'A' ? CAR(result) : CDR(result);
+	--desc;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Cond(LispBuiltin *builtin)
+/*
+ cond &rest body
+ */
+{
+    LispObj *result, *code, *body;
+
+    body = ARGUMENT(0);
+
+    result = NIL;
+    for (; CONSP(body); body = CDR(body)) {
+	code = CAR(body);
+
+	CHECK_CONS(code);
+	result = EVAL(CAR(code));
+	if (result == NIL)
+	    continue;
+	for (code = CDR(code); CONSP(code); code = CDR(code))
+	    result = EVAL(CAR(code));
+	break;
+    }
+
+    return (result);
+}
+
+static LispObj *
+LispCopyList(LispBuiltin *builtin, LispObj *list, int function)
+{
+    GC_ENTER();
+    LispObj *result, *cons;
+
+    if (list == NIL)
+	return (list);
+    CHECK_CONS(list);
+
+    result = cons = CONS(NIL, NIL);
+    GC_PROTECT(result);
+    if (CONSP(CAR(list))) {
+	switch (function) {
+	    case COPY_LIST:
+		RPLACA(result, CAR(list));
+		break;
+	    case COPY_ALIST:
+		RPLACA(result, CONS(CAR(CAR(list)), CDR(CAR(list))));
+		break;
+	    case COPY_TREE:
+		RPLACA(result, LispCopyList(builtin, CAR(list), COPY_TREE));
+		break;
+	}
+    }
+    else
+	RPLACA(result, CAR(list));
+
+    for (list = CDR(list); CONSP(list); list = CDR(list)) {
+	CDR(cons) = CONS(NIL, NIL);
+	cons = CDR(cons);
+	if (CONSP(CAR(list))) {
+	    switch (function) {
+		case COPY_LIST:
+		    RPLACA(cons, CAR(list));
+		    break;
+		case COPY_ALIST:
+		    RPLACA(cons, CONS(CAR(CAR(list)), CDR(CAR(list))));
+		    break;
+		case COPY_TREE:
+		    RPLACA(cons, LispCopyList(builtin, CAR(list), COPY_TREE));
+		    break;
+	    }
+	}
+	else
+	    RPLACA(cons, CAR(list));
+    }
+    /* in case list is dotted */
+    RPLACD(cons, list);
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_CopyAlist(LispBuiltin *builtin)
+/*
+ copy-alist list
+ */
+{
+    LispObj *list;
+
+    list = ARGUMENT(0);
+
+    return (LispCopyList(builtin, list, COPY_ALIST));
+}
+
+LispObj *
+Lisp_CopyList(LispBuiltin *builtin)
+/*
+ copy-list list
+ */
+{
+    LispObj *list;
+
+    list = ARGUMENT(0);
+
+    return (LispCopyList(builtin, list, COPY_LIST));
+}
+
+LispObj *
+Lisp_CopyTree(LispBuiltin *builtin)
+/*
+ copy-tree list
+ */
+{
+    LispObj *list;
+
+    list = ARGUMENT(0);
+
+    return (LispCopyList(builtin, list, COPY_TREE));
+}
+
+LispObj *
+Lisp_Cons(LispBuiltin *builtin)
+/*
+ cons car cdr
+ */
+{
+    LispObj *car, *cdr;
+
+    cdr = ARGUMENT(1);
+    car = ARGUMENT(0);
+
+    return (CONS(car, cdr));
+}
+
+LispObj *
+Lisp_Consp(LispBuiltin *builtin)
+/*
+ consp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (CONSP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_Constantp(LispBuiltin *builtin)
+/*
+ constantp form &optional environment
+ */
+{
+    LispObj *form, *environment;
+
+    environment = ARGUMENT(1);
+    form = ARGUMENT(0);
+
+    /* not all self-evaluating objects are considered constants */
+    if (!POINTERP(form) ||
+	NUMBERP(form) ||
+	XQUOTEP(form) ||
+	(XCONSP(form) && CAR(form) == Oquote) ||
+	(XSYMBOLP(form) && form->data.atom->constant) ||
+	XSTRINGP(form) ||
+	XARRAYP(form))
+	return (T);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Defconstant(LispBuiltin *builtin)
+/*
+ defconstant name initial-value &optional documentation
+ */
+{
+    LispObj *name, *initial_value, *documentation;
+
+    documentation = ARGUMENT(2);
+    initial_value = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    CHECK_SYMBOL(name);
+    if (documentation != UNSPEC) {
+	CHECK_STRING(documentation);
+    }
+    else
+	documentation = NIL;
+    LispDefconstant(name, EVAL(initial_value), documentation);
+
+    return (name);
+}
+
+LispObj *
+Lisp_Defmacro(LispBuiltin *builtin)
+/*
+ defmacro name lambda-list &rest body
+ */
+{
+    LispArgList *alist;
+
+    LispObj *lambda, *name, *lambda_list, *body;
+
+    body = ARGUMENT(2);
+    lambda_list = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    CHECK_SYMBOL(name);
+    alist = LispCheckArguments(LispMacro, lambda_list, ATOMID(name), 0);
+
+    if (CONSP(body) && STRINGP(CAR(body))) {
+	LispAddDocumentation(name, CAR(body), LispDocFunction);
+	body = CDR(body);
+    }
+
+    lambda_list = LispListProtectedArguments(alist);
+    lambda = LispNewLambda(name, body, lambda_list, LispMacro);
+
+    if (name->data.atom->a_builtin || name->data.atom->a_compiled) {
+	if (name->data.atom->a_builtin) {
+	    ERROR_CHECK_SPECIAL_FORM(name->data.atom);
+	}
+	/* redefining these may cause surprises if bytecode
+	 * compiled functions references them */
+	LispWarning("%s: %s is being redefined", STRFUN(builtin), ATOMID(name));
+
+	LispRemAtomBuiltinProperty(name->data.atom);
+    }
+
+    LispSetAtomFunctionProperty(name->data.atom, lambda, alist);
+    LispUseArgList(alist);
+
+    return (name);
+}
+
+LispObj *
+Lisp_Defun(LispBuiltin *builtin)
+/*
+ defun name lambda-list &rest body
+ */
+{
+    LispArgList *alist;
+
+    LispObj *lambda, *name, *lambda_list, *body;
+
+    body = ARGUMENT(2);
+    lambda_list = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    CHECK_SYMBOL(name);
+    alist = LispCheckArguments(LispFunction, lambda_list, ATOMID(name), 0);
+
+    if (CONSP(body) && STRINGP(CAR(body))) {
+	LispAddDocumentation(name, CAR(body), LispDocFunction);
+	body = CDR(body);
+    }
+
+    lambda_list = LispListProtectedArguments(alist);
+    lambda = LispNewLambda(name, body, lambda_list, LispFunction);
+
+    if (name->data.atom->a_builtin || name->data.atom->a_compiled) {
+	if (name->data.atom->a_builtin) {
+	    ERROR_CHECK_SPECIAL_FORM(name->data.atom);
+	}
+	/* redefining these may cause surprises if bytecode
+	 * compiled functions references them */
+	LispWarning("%s: %s is being redefined", STRFUN(builtin), ATOMID(name));
+
+	LispRemAtomBuiltinProperty(name->data.atom);
+    }
+    LispSetAtomFunctionProperty(name->data.atom, lambda, alist);
+    LispUseArgList(alist);
+
+    return (name);
+}
+
+LispObj *
+Lisp_Defsetf(LispBuiltin *builtin)
+/*
+ defsetf function lambda-list &rest body
+ */
+{
+    LispArgList *alist;
+    LispObj *obj;
+    LispObj *lambda, *function, *lambda_list, *store, *body;
+
+    body = ARGUMENT(2);
+    lambda_list = ARGUMENT(1);
+    function = ARGUMENT(0);
+
+    CHECK_SYMBOL(function);
+
+    if (body == NIL || (CONSP(body) && STRINGP(CAR(body)))) {
+	if (!SYMBOLP(lambda_list))
+	    LispDestroy("%s: syntax error %s %s",
+			STRFUN(builtin), STROBJ(function), STROBJ(lambda_list));
+	if (body != NIL)
+	    LispAddDocumentation(function, CAR(body), LispDocSetf);
+
+	LispSetAtomSetfProperty(function->data.atom, lambda_list, NULL);
+
+	return (function);
+    }
+
+    alist = LispCheckArguments(LispSetf, lambda_list, ATOMID(function), 0);
+
+    store = CAR(body);
+    if (!CONSP(store))
+	LispDestroy("%s: %s is a bad store value",
+		    STRFUN(builtin), STROBJ(store));
+    for (obj = store; CONSP(obj); obj = CDR(obj)) {
+	CHECK_SYMBOL(CAR(obj));
+    }
+
+    body = CDR(body);
+    if (CONSP(body) && STRINGP(CAR(body))) {
+	LispAddDocumentation(function, CAR(body), LispDocSetf);
+	body = CDR(body);
+    }
+
+    lambda = LispNewLambda(function, body, store, LispSetf);
+    LispSetAtomSetfProperty(function->data.atom, lambda, alist);
+    LispUseArgList(alist);
+
+    return (function);
+}
+
+LispObj *
+Lisp_Defparameter(LispBuiltin *builtin)
+/*
+ defparameter name initial-value &optional documentation
+ */
+{
+    LispObj *name, *initial_value, *documentation;
+
+    documentation = ARGUMENT(2);
+    initial_value = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    CHECK_SYMBOL(name);
+    if (documentation != UNSPEC) {
+	CHECK_STRING(documentation);
+    }
+    else
+	documentation = NIL;
+
+    LispProclaimSpecial(name, EVAL(initial_value), documentation);
+
+    return (name);
+}
+
+LispObj *
+Lisp_Defvar(LispBuiltin *builtin)
+/*
+ defvar name &optional initial-value documentation
+ */
+{
+    LispObj *name, *initial_value, *documentation;
+
+    documentation = ARGUMENT(2);
+    initial_value = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    CHECK_SYMBOL(name);
+    if (documentation != UNSPEC) {
+	CHECK_STRING(documentation);
+    }
+    else
+	documentation = NIL;
+
+    LispProclaimSpecial(name,
+			initial_value != UNSPEC ? EVAL(initial_value) : NULL,
+			documentation);
+
+    return (name);
+}
+
+LispObj *
+Lisp_Delete(LispBuiltin *builtin)
+/*
+ delete item sequence &key from-end test test-not start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, DELETE, NONE));
+}
+
+LispObj *
+Lisp_DeleteIf(LispBuiltin *builtin)
+/*
+ delete-if predicate sequence &key from-end start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, DELETE, IF));
+}
+
+LispObj *
+Lisp_DeleteIfNot(LispBuiltin *builtin)
+/*
+ delete-if-not predicate sequence &key from-end start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, DELETE, IFNOT));
+}
+
+LispObj *
+Lisp_DeleteDuplicates(LispBuiltin *builtin)
+/*
+ delete-duplicates sequence &key from-end test test-not start end key
+ */
+{
+    return (LispDeleteOrRemoveDuplicates(builtin, DELETE));
+}
+
+LispObj *
+Lisp_Do(LispBuiltin *builtin)
+/*
+ do init test &rest body
+ */
+{
+    return (LispDo(builtin, 0));
+}
+
+LispObj *
+Lisp_DoP(LispBuiltin *builtin)
+/*
+ do* init test &rest body
+ */
+{
+    return (LispDo(builtin, 1));
+}
+
+static LispDocType_t
+LispDocumentationType(LispBuiltin *builtin, LispObj *type)
+{
+    Atom_id atom;
+    LispDocType_t doc_type = LispDocVariable;
+
+    CHECK_SYMBOL(type);
+    atom = ATOMID(type);
+
+    if (atom == Svariable)
+	doc_type = LispDocVariable;
+    else if (atom == Sfunction)
+	doc_type = LispDocFunction;
+    else if (atom == Sstructure)
+	doc_type = LispDocStructure;
+    else if (atom == Stype)
+	doc_type = LispDocType;
+    else if (atom == Ssetf)
+	doc_type = LispDocSetf;
+    else {
+	LispDestroy("%s: unknown documentation type %s",
+		    STRFUN(builtin), STROBJ(type));
+	/*NOTREACHED*/
+    }
+
+    return (doc_type);
+}
+
+LispObj *
+Lisp_Documentation(LispBuiltin *builtin)
+/*
+ documentation symbol type
+ */
+{
+    LispObj *symbol, *type;
+
+    type = ARGUMENT(1);
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+    /* type is checked in LispDocumentationType() */
+
+    return (LispGetDocumentation(symbol, LispDocumentationType(builtin, type)));
+}
+
+LispObj *
+Lisp_DoList(LispBuiltin *builtin)
+{
+    return (LispDoListTimes(builtin, 0));
+}
+
+LispObj *
+Lisp_DoTimes(LispBuiltin *builtin)
+{
+    return (LispDoListTimes(builtin, 1));
+}
+
+LispObj *
+Lisp_Elt(LispBuiltin *builtin)
+/*
+ elt sequence index
+ svref sequence index
+ */
+{
+    long offset, length;
+    LispObj *result, *sequence, *oindex;
+
+    oindex = ARGUMENT(1);
+    sequence = ARGUMENT(0);
+
+    length = LispLength(sequence);
+
+    CHECK_INDEX(oindex);
+    offset = FIXNUM_VALUE(oindex);
+
+    if (offset >= length)
+	LispDestroy("%s: index %ld too large for sequence length %ld",
+		    STRFUN(builtin), offset, length);
+
+    if (STRINGP(sequence))
+	result = SCHAR(THESTR(sequence)[offset]);
+    else {
+	if (ARRAYP(sequence))
+	    sequence = sequence->data.array.list;
+
+	for (; offset > 0; offset--, sequence = CDR(sequence))
+	    ;
+	result = CAR(sequence);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Endp(LispBuiltin *builtin)
+/*
+ endp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (object == NIL)
+	return (T);
+    CHECK_CONS(object);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Eq(LispBuiltin *builtin)
+/*
+ eq left right
+ */
+{
+    LispObj *left, *right;
+
+    right = ARGUMENT(1);
+    left = ARGUMENT(0);
+
+    return (XEQ(left, right));
+}
+
+LispObj *
+Lisp_Eql(LispBuiltin *builtin)
+/*
+ eql left right
+ */
+{
+    LispObj *left, *right;
+
+    right = ARGUMENT(1);
+    left = ARGUMENT(0);
+
+    return (XEQL(left, right));
+}
+
+LispObj *
+Lisp_Equal(LispBuiltin *builtin)
+/*
+ equal left right
+ */
+{
+    LispObj *left, *right;
+
+    right = ARGUMENT(1);
+    left = ARGUMENT(0);
+
+    return (XEQUAL(left, right));
+}
+
+LispObj *
+Lisp_Equalp(LispBuiltin *builtin)
+/*
+ equalp left right
+ */
+{
+    LispObj *left, *right;
+
+    right = ARGUMENT(1);
+    left = ARGUMENT(0);
+
+    return (XEQUALP(left, right));
+}
+
+LispObj *
+Lisp_Error(LispBuiltin *builtin)
+/*
+ error control-string &rest arguments
+ */
+{
+    LispObj *string, *arglist;
+
+    LispObj *control_string, *arguments;
+
+    arguments = ARGUMENT(1);
+    control_string = ARGUMENT(0);
+
+    arglist = CONS(NIL, CONS(control_string, arguments));
+    GC_PROTECT(arglist);
+    string = APPLY(Oformat, arglist);
+    LispDestroy("%s", THESTR(string));
+    /*NOTREACHED*/
+
+    /* No need to call GC_ENTER() and GC_LEAVE() macros */
+    return (NIL);
+}
+
+LispObj *
+Lisp_Eval(LispBuiltin *builtin)
+/*
+ eval form
+ */
+{
+    int lex;
+    LispObj *form, *result;
+
+    form = ARGUMENT(0);
+
+    /* make sure eval form will not access local variables */
+    lex = lisp__data.env.lex;
+    lisp__data.env.lex = lisp__data.env.length;
+    result = EVAL(form);
+    lisp__data.env.lex = lex;
+
+    return (result);
+}
+
+static LispObj *
+LispEverySomeAnyNot(LispBuiltin *builtin, int function)
+/*
+ every predicate sequence &rest more-sequences
+ some predicate sequence &rest more-sequences
+ notevery predicate sequence &rest more-sequences
+ notany predicate sequence &rest more-sequences
+ */
+{
+    GC_ENTER();
+    long i, j, length, count;
+    LispObj *result, *list, *item, *arguments, *acons, *value;
+    SeqInfo stk[8], *seqs;
+
+    LispObj *predicate, *sequence, *more_sequences;
+
+    more_sequences = ARGUMENT(2);
+    sequence = ARGUMENT(1);
+    predicate = ARGUMENT(0);
+
+    count = 1;
+    length = LispLength(sequence);
+    for (list = more_sequences; CONSP(list); list = CDR(list), count++) {
+	i = LispLength(CAR(list));
+	if (i < length)
+	    length = i;
+    }
+
+    result = function == EVERY || function == NOTANY ? T : NIL;
+
+    /* if at least one sequence has length zero */
+    if (length == 0)
+	return (result);
+
+    if (count > sizeof(stk) / sizeof(stk[0]))
+	seqs = LispMalloc(count * sizeof(SeqInfo));
+    else
+	seqs = &stk[0];
+
+    /* build information about sequences */
+    SETSEQ(seqs[0], sequence);
+    for (i = 1, list = more_sequences; CONSP(list); list = CDR(list), i++) {
+	item = CAR(list);
+	SETSEQ(seqs[i], item);
+    }
+
+    /* prepare argument list */
+    arguments = acons = CONS(NIL, NIL);
+    GC_PROTECT(arguments);
+    for (i = 1; i < count; i++) {
+	RPLACD(acons, CONS(NIL, NIL));
+	acons = CDR(acons);
+    }
+
+    /* loop applying predicate in sequence elements */
+    for (i = 0; i < length; i++) {
+
+	/* build argument list */
+	for (acons = arguments, j = 0; j < count; acons = CDR(acons), j++) {
+	    if (seqs[j].type == LispString_t)
+		item = SCHAR(*seqs[j].data.string++);
+	    else {
+		item = CAR(seqs[j].data.list);
+		seqs[j].data.list = CDR(seqs[j].data.list);
+	    }
+	    RPLACA(acons, item);
+	}
+
+	/* apply predicate */
+	value = APPLY(predicate, arguments);
+
+	/* check if needs to terminate loop */
+	if (value == NIL) {
+	    if (function == EVERY) {
+		result = NIL;
+		break;
+	    }
+	    if (function == NOTEVERY) {
+		result = T;
+		break;
+	    }
+	}
+	else {
+	    if (function == SOME) {
+		result = value;
+		break;
+	    }
+	    if (function == NOTANY) {
+		result = NIL;
+		break;
+	    }
+	}
+    }
+
+    GC_LEAVE();
+    if (seqs != &stk[0])
+	LispFree(seqs);
+
+    return (result);
+}
+
+LispObj *
+Lisp_Every(LispBuiltin *builtin)
+/*
+ every predicate sequence &rest more-sequences
+ */
+{
+    return (LispEverySomeAnyNot(builtin, EVERY));
+}
+
+LispObj *
+Lisp_Some(LispBuiltin *builtin)
+/*
+ some predicate sequence &rest more-sequences
+ */
+{
+    return (LispEverySomeAnyNot(builtin, SOME));
+}
+
+LispObj *
+Lisp_Notevery(LispBuiltin *builtin)
+/*
+ notevery predicate sequence &rest more-sequences
+ */
+{
+    return (LispEverySomeAnyNot(builtin, NOTEVERY));
+}
+
+LispObj *
+Lisp_Notany(LispBuiltin *builtin)
+/*
+ notany predicate sequence &rest more-sequences
+ */
+{
+    return (LispEverySomeAnyNot(builtin, NOTANY));
+}
+
+LispObj *
+Lisp_Fboundp(LispBuiltin *builtin)
+/*
+ fboundp symbol
+ */
+{
+    LispAtom *atom;
+
+    LispObj *symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+
+    atom = symbol->data.atom;
+    if (atom->a_function || atom->a_builtin || atom->a_compiled)
+	return (T);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Find(LispBuiltin *builtin)
+/*
+ find item sequence &key from-end test test-not start end key
+ */
+{
+    return (LispFindOrPosition(builtin, FIND, NONE));
+}
+
+LispObj *
+Lisp_FindIf(LispBuiltin *builtin)
+/*
+ find-if predicate sequence &key from-end start end key
+ */
+{
+    return (LispFindOrPosition(builtin, FIND, IF));
+}
+
+LispObj *
+Lisp_FindIfNot(LispBuiltin *builtin)
+/*
+ find-if-not predicate sequence &key from-end start end key
+ */
+{
+    return (LispFindOrPosition(builtin, FIND, IFNOT));
+}
+
+LispObj *
+Lisp_Fill(LispBuiltin *builtin)
+/*
+ fill sequence item &key start end
+ */
+{
+    long i, start, end, length;
+
+    LispObj *sequence, *item, *ostart, *oend;
+
+    oend = ARGUMENT(3);
+    ostart = ARGUMENT(2);
+    item = ARGUMENT(1);
+    sequence = ARGUMENT(0);
+
+    LispCheckSequenceStartEnd(builtin, sequence, ostart, oend,
+			      &start, &end, &length);
+
+    if (STRINGP(sequence)) {
+	int ch;
+	char *string = THESTR(sequence);
+
+	CHECK_STRING_WRITABLE(sequence);
+	CHECK_SCHAR(item);
+	ch = SCHAR_VALUE(item);
+	for (i = start; i < end; i++)
+	    string[i] = ch;
+    }
+    else {
+	LispObj *list;
+
+	if (CONSP(sequence))
+	    list = sequence;
+	else
+	    list = sequence->data.array.list;
+
+	for (i = 0; i < start; i++, list = CDR(list))
+	    ;
+	for (; i < end; i++, list = CDR(list))
+	    RPLACA(list, item);
+    }
+
+    return (sequence);
+}
+
+LispObj *
+Lisp_Fmakunbound(LispBuiltin *builtin)
+/*
+ fmkaunbound symbol
+ */
+{
+    LispObj *symbol;
+
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+    if (symbol->data.atom->a_function)
+	LispRemAtomFunctionProperty(symbol->data.atom);
+    else if (symbol->data.atom->a_builtin)
+	LispRemAtomBuiltinProperty(symbol->data.atom);
+    else if (symbol->data.atom->a_compiled)
+	LispRemAtomCompiledProperty(symbol->data.atom);
+
+    return (symbol);
+}
+
+LispObj *
+Lisp_Funcall(LispBuiltin *builtin)
+/*
+ funcall function &rest arguments
+ */
+{
+    LispObj *result;
+
+    LispObj *function, *arguments;
+
+    arguments = ARGUMENT(1);
+    function = ARGUMENT(0);
+
+    result = APPLY(function, arguments);
+
+    return (result);
+}
+
+LispObj *
+Lisp_Functionp(LispBuiltin *builtin)
+/*
+ functionp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (FUNCTIONP(object) || LAMBDAP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_Get(LispBuiltin *builtin)
+/*
+ get symbol indicator &optional default
+ */
+{
+    LispObj *result;
+
+    LispObj *symbol, *indicator, *defalt;
+
+    defalt = ARGUMENT(2);
+    indicator = ARGUMENT(1);
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+
+    result = LispGetAtomProperty(symbol->data.atom, indicator);
+
+    if (result != NIL)
+	result = CAR(result);
+    else
+	result = defalt == UNSPEC ? NIL : defalt;
+
+    return (result);
+}
+
+/*
+ * ext::getenv
+ */
+LispObj *
+Lisp_Getenv(LispBuiltin *builtin)
+/*
+ getenv name
+ */
+{
+    char *value;
+
+    LispObj *name;
+
+    name = ARGUMENT(0);
+
+    CHECK_STRING(name);
+    value = getenv(THESTR(name));
+
+    return (value ? STRING(value) : NIL);
+}
+
+LispObj *
+Lisp_Gc(LispBuiltin *builtin)
+/*
+ gc &optional car cdr
+ */
+{
+    LispObj *car, *cdr;
+
+    cdr = ARGUMENT(1);
+    car = ARGUMENT(0);
+
+    LispGC(car, cdr);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Gensym(LispBuiltin *builtin)
+/*
+ gensym &optional arg
+ */
+{
+    char *preffix = "G", name[132];
+    long counter = LONGINT_VALUE(Ogensym_counter->data.atom->property->value);
+    LispObj *symbol;
+
+    LispObj *arg;
+
+    arg = ARGUMENT(0);
+    if (arg != UNSPEC) {
+	if (STRINGP(arg))
+	    preffix = THESTR(arg);
+	else {
+	    CHECK_INDEX(arg);
+	    counter = FIXNUM_VALUE(arg);
+	}
+    }
+    snprintf(name, sizeof(name), "%s%ld", preffix, counter);
+    if (strlen(name) >= 128)
+	LispDestroy("%s: name %s too long", STRFUN(builtin), name);
+    Ogensym_counter->data.atom->property->value = INTEGER(counter + 1);
+
+    symbol = UNINTERNED_ATOM(name);
+    symbol->data.atom->unreadable = !LispCheckAtomString(name);
+
+    return (symbol);
+}
+
+LispObj *
+Lisp_Go(LispBuiltin *builtin)
+/*
+ go tag
+ */
+{
+    unsigned blevel = lisp__data.block.block_level;
+
+    LispObj *tag;
+
+    tag = ARGUMENT(0);
+
+    while (blevel) {
+	LispBlock *block = lisp__data.block.block[--blevel];
+
+	if (block->type == LispBlockClosure)
+	    /* if reached a function call */
+	    break;
+	if (block->type == LispBlockBody) {
+	    lisp__data.block.block_ret = tag;
+	    LispBlockUnwind(block);
+	    BLOCKJUMP(block);
+	}
+     }
+
+    LispDestroy("%s: no visible tagbody for %s",
+		STRFUN(builtin), STROBJ(tag));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+Lisp_If(LispBuiltin *builtin)
+/*
+ if test then &optional else
+ */
+{
+    LispObj *result, *test, *then, *oelse;
+
+    oelse = ARGUMENT(2);
+    then = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    test = EVAL(test);
+    if (test != NIL)
+	result = EVAL(then);
+    else if (oelse != UNSPEC)
+	result = EVAL(oelse);
+    else
+	result = NIL;
+
+    return (result);
+}
+
+LispObj *
+Lisp_IgnoreErrors(LispBuiltin *builtin)
+/*
+ ignore-erros &rest body
+ */
+{
+    LispObj *result, **presult, **pbody;
+    int i, jumped, *pjumped;
+    LispBlock *block;
+
+    /* interpreter state */
+    GC_ENTER();
+    int stack, lex, length;
+
+    /* memory allocation */
+    int mem_level;
+    void **mem;
+
+    LispObj *body;
+
+    body = ARGUMENT(0);
+
+    /* Save environment information */
+    stack = lisp__data.stack.length;
+    lex = lisp__data.env.lex;
+    length = lisp__data.env.length;
+
+    /* Save memory allocation information */
+    mem_level = lisp__data.mem.level;
+    mem = LispMalloc(mem_level * sizeof(void*));
+    memcpy(mem, lisp__data.mem.mem, mem_level * sizeof(void*));
+
+    ++lisp__data.ignore_errors;
+    presult = &result;
+    pjumped = &jumped;
+    pbody = &body;
+    result = NIL;
+    jumped = 1;
+    block = LispBeginBlock(NIL, LispBlockProtect);
+    if (setjmp(block->jmp) == 0) {
+	for (; CONSP(body); body = CDR(body))
+	    result = EVAL(CAR(body));
+	jumped = 0;
+    }
+    LispEndBlock(block);
+    if (!lisp__data.destroyed && jumped)
+	result = lisp__data.block.block_ret;
+
+    if (lisp__data.destroyed) {
+	/* Restore environment */
+	lisp__data.stack.length = stack;
+	lisp__data.env.lex = lex;
+	lisp__data.env.head = lisp__data.env.length = length;
+	GC_LEAVE();
+
+	/* Check for possible leaks due to ignoring errors */
+	for (i = 0; i < mem_level; i++) {
+	    if (lisp__data.mem.mem[i] && mem[i] != lisp__data.mem.mem[i])
+		LispFree(lisp__data.mem.mem[i]);
+	}
+	for (; i < lisp__data.mem.level; i++) {
+	    if (lisp__data.mem.mem[i])
+		LispFree(lisp__data.mem.mem[i]);
+	}
+
+	lisp__data.destroyed = 0;
+	result = NIL;
+	RETURN_COUNT = 1;
+	RETURN(0) = lisp__data.error_condition;
+    }
+    LispFree(mem);
+    --lisp__data.ignore_errors;
+
+    return (result);
+}
+
+LispObj *
+Lisp_Intersection(LispBuiltin *builtin)
+/*
+ intersection list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, INTERSECTION));
+}
+
+LispObj *
+Lisp_Nintersection(LispBuiltin *builtin)
+/*
+ nintersection list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, NINTERSECTION));
+}
+
+LispObj *
+Lisp_Keywordp(LispBuiltin *builtin)
+/*
+ keywordp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (KEYWORDP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_Lambda(LispBuiltin *builtin)
+/*
+ lambda lambda-list &rest body
+ */
+{
+    GC_ENTER();
+    LispObj *name;
+    LispArgList *alist;
+
+    LispObj *lambda, *lambda_list, *body;
+
+    body = ARGUMENT(1);
+    lambda_list = ARGUMENT(0);
+
+    alist = LispCheckArguments(LispLambda, lambda_list, Snil, 0);
+
+    name = OPAQUE(alist, LispArgList_t);
+    lambda_list = LispListProtectedArguments(alist);
+    GC_PROTECT(name);
+    GC_PROTECT(lambda_list);
+    lambda = LispNewLambda(name, body, lambda_list, LispLambda);
+    LispUseArgList(alist);
+    GC_LEAVE();
+
+    return (lambda);
+}
+
+LispObj *
+Lisp_Last(LispBuiltin *builtin)
+/*
+ last list &optional count
+ */
+{
+    long count, length;
+    LispObj *list, *ocount;
+
+    ocount = ARGUMENT(1);
+    list = ARGUMENT(0);
+
+    if (!CONSP(list))
+	return (list);
+
+    length = LispLength(list);
+
+    if (ocount == UNSPEC)
+	count = 1;
+    else {
+	CHECK_INDEX(ocount);
+	count = FIXNUM_VALUE(ocount);
+    }
+
+    if (count >= length)
+	return (list);
+
+    length -= count;
+    for (; length > 0; length--)
+	list = CDR(list);
+
+    return (list);
+}
+
+LispObj *
+Lisp_Length(LispBuiltin *builtin)
+/*
+ length sequence
+ */
+{
+    LispObj *sequence;
+
+    sequence = ARGUMENT(0);
+
+    return (FIXNUM(LispLength(sequence)));
+}
+
+LispObj *
+Lisp_Let(LispBuiltin *builtin)
+/*
+ let init &rest body
+ */
+{
+    GC_ENTER();
+    int head = lisp__data.env.length;
+    LispObj *init, *body, *pair, *result, *list, *cons = NIL;
+
+    body = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    CHECK_LIST(init);
+    for (list = NIL; CONSP(init); init = CDR(init)) {
+	LispObj *symbol, *value;
+
+	pair = CAR(init);
+	if (SYMBOLP(pair)) {
+	    symbol = pair;
+	    value = NIL;
+	}
+	else {
+	    CHECK_CONS(pair);
+	    symbol = CAR(pair);
+	    CHECK_SYMBOL(symbol);
+	    pair = CDR(pair);
+	    if (CONSP(pair)) {
+		value = CAR(pair);
+		if (CDR(pair) != NIL)
+		    LispDestroy("%s: too much arguments to initialize %s",
+				STRFUN(builtin), STROBJ(symbol));
+		value = EVAL(value);
+	    }
+	    else
+		value = NIL;
+	}
+	pair = CONS(symbol, value);
+	if (list == NIL) {
+	    list = cons = CONS(pair, NIL);
+	    GC_PROTECT(list);
+	}
+	else {
+	    RPLACD(cons, CONS(pair, NIL));
+	    cons = CDR(cons);
+	}
+    }
+    /* Add variables */
+    for (; CONSP(list); list = CDR(list)) {
+	pair = CAR(list);
+	CHECK_CONSTANT(CAR(pair));
+	LispAddVar(CAR(pair), CDR(pair));
+	++lisp__data.env.head;
+    }
+    /* Values of symbols are now protected */
+    GC_LEAVE();
+
+    /* execute body */
+    for (result = NIL; CONSP(body); body = CDR(body))
+	result = EVAL(CAR(body));
+
+    lisp__data.env.head = lisp__data.env.length = head;
+
+    return (result);
+}
+
+LispObj *
+Lisp_LetP(LispBuiltin *builtin)
+/*
+ let* init &rest body
+ */
+{
+    int head = lisp__data.env.length;
+    LispObj *init, *body, *pair, *result;
+
+    body = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    CHECK_LIST(init);
+    for (; CONSP(init); init = CDR(init)) {
+	LispObj *symbol, *value;
+
+	pair = CAR(init);
+	if (SYMBOLP(pair)) {
+	    symbol = pair;
+	    value = NIL;
+	}
+	else {
+	    CHECK_CONS(pair);
+	    symbol = CAR(pair);
+	    CHECK_SYMBOL(symbol);
+	    pair = CDR(pair);
+	    if (CONSP(pair)) {
+		value = CAR(pair);
+		if (CDR(pair) != NIL)
+		    LispDestroy("%s: too much arguments to initialize %s",
+				STRFUN(builtin), STROBJ(symbol));
+		value = EVAL(value);
+	    }
+	    else
+		value = NIL;
+	}
+
+	CHECK_CONSTANT(symbol);
+	LispAddVar(symbol, value);
+	++lisp__data.env.head;
+    }
+
+    /* execute body */
+    for (result = NIL; CONSP(body); body = CDR(body))
+	result = EVAL(CAR(body));
+
+    lisp__data.env.head = lisp__data.env.length = head;
+
+    return (result);
+}
+
+LispObj *
+Lisp_List(LispBuiltin *builtin)
+/*
+ list &rest args
+ */
+{
+    LispObj *args;
+
+    args = ARGUMENT(0);
+
+    return (args);
+}
+
+LispObj *
+Lisp_ListP(LispBuiltin *builtin)
+/*
+ list* object &rest more-objects
+ */
+{
+    GC_ENTER();
+    LispObj *result, *cons;
+
+    LispObj *object, *more_objects;
+
+    more_objects = ARGUMENT(1);
+    object = ARGUMENT(0);
+
+    if (!CONSP(more_objects))
+	return (object);
+
+    result = cons = CONS(object, CAR(more_objects));
+    GC_PROTECT(result);
+    for (more_objects = CDR(more_objects); CONSP(more_objects);
+	 more_objects = CDR(more_objects)) {
+	object = CAR(more_objects);
+	RPLACD(cons, CONS(CDR(cons), object));
+	cons = CDR(cons);
+    }
+    GC_LEAVE();
+
+    return (result);
+}
+
+/* "classic" list-length */
+LispObj *
+Lisp_ListLength(LispBuiltin *builtin)
+/*
+ list-length list
+ */
+{
+    long length;
+    LispObj *fast, *slow;
+
+    LispObj *list;
+
+    list = ARGUMENT(0);
+
+    CHECK_LIST(list);
+    for (fast = slow = list, length = 0;
+	 CONSP(slow);
+	 slow = CDR(slow), length += 2) {
+	if (fast == NIL)
+	    break;
+	CHECK_CONS(fast);
+	fast = CDR(fast);
+	if (fast == NIL) {
+	    ++length;
+	    break;
+	}
+	CHECK_CONS(fast);
+	fast = CDR(fast);
+	if (slow == fast)
+	    /* circular list */
+	    return (NIL);
+    }
+
+    return (FIXNUM(length));
+}
+
+LispObj *
+Lisp_Listp(LispBuiltin *builtin)
+/*
+ listp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (object == NIL || CONSP(object) ? T : NIL);
+}
+
+static LispObj *
+LispListSet(LispBuiltin *builtin, int function)
+/*
+ intersection list1 list2 &key test test-not key
+ nintersection list1 list2 &key test test-not key
+ set-difference list1 list2 &key test test-not key
+ nset-difference list1 list2 &key test test-not key
+ set-exclusive-or list1 list2 &key test test-not key
+ nset-exclusive-or list1 list2 &key test test-not key
+ subsetp list1 list2 &key test test-not key
+ union list1 list2 &key test test-not key
+ nunion list1 list2 &key test test-not key
+ */
+{
+    GC_ENTER();
+    int code, expect, value, inplace, check_list2,
+	intersection, setdifference, xunion, setexclusiveor;
+    LispObj *lambda, *result, *cmp, *cmp1, *cmp2,
+	    *item, *clist1, *clist2, *cons, *cdr;
+
+    LispObj *list1, *list2, *test, *test_not, *key;
+
+    key = ARGUMENT(4);
+    test_not = ARGUMENT(3);
+    test = ARGUMENT(2);
+    list2 = ARGUMENT(1);
+    list1 = ARGUMENT(0);
+
+    /* Check if arguments are valid lists */
+    CHECK_LIST(list1);
+    CHECK_LIST(list2);
+
+    setdifference = intersection = xunion = setexclusiveor = inplace = 0;
+    switch (function) {
+	case NSETDIFFERENCE:
+	    inplace = 1;
+	case SETDIFFERENCE:
+	    setdifference = 1;
+	    break;
+	case NINTERSECTION:
+	    inplace = 1;
+	case INTERSECTION:
+	    intersection = 1;
+	    break;
+	case NUNION:
+	    inplace = 1;
+	case UNION:
+	    xunion = 1;
+	    break;
+	case NSETEXCLUSIVEOR:
+	    inplace = 1;
+	case SETEXCLUSIVEOR:
+	    setexclusiveor = 1;
+	    break;
+    }
+
+    /* Check for fast return */
+    if (list1 == NIL)
+	return (setdifference || intersection ?
+		NIL : function == SUBSETP ? T : list2);
+    if (list2 == NIL)
+	return (intersection || xunion || function == SUBSETP ? NIL : list1);
+
+    CHECK_TEST();
+    clist1 = cdr = NIL;
+
+    /* Make a copy of list2 with the key predicate applied */
+    if (key != UNSPEC) {
+	result = cons = CONS(APPLY1(key, CAR(list2)), NIL);
+	GC_PROTECT(result);
+	for (cmp2 = CDR(list2); CONSP(cmp2); cmp2 = CDR(cmp2)) {
+	    item = APPLY1(key, CAR(cmp2));
+	    RPLACD(cons, CONS(APPLY1(key, CAR(cmp2)), NIL));
+	    cons = CDR(cons);
+	}
+	/* check if list2 is a proper list */
+	CHECK_LIST(cmp2);
+	clist2 = result;
+	check_list2 = 0;
+    }
+    else {
+	clist2 = list2;
+	check_list2 = 1;
+    }
+    result = cons = NIL;
+
+    /* Compare elements of lists
+     * Logic:
+     *	   UNION
+     *		1) Walk list1 and if CAR(list1) not in list2, add it to result
+     *		2) Add list2 to result
+     *	   INTERSECTION
+     *		1) Walk list1 and if CAR(list1) in list2, add it to result
+     *	   SET-DIFFERENCE
+     *		1) Walk list1 and if CAR(list1) not in list2, add it to result
+     *	   SET-EXCLUSIVE-OR
+     *		1) Walk list1 and if CAR(list1) not in list2, add it to result
+     *		2) Walk list2 and if CAR(list2) not in list1, add it to result
+     *	   SUBSETP
+     *		1) Walk list1 and if CAR(list1) not in list2, return NIL
+     *		2) Return T
+     */
+    value = 0;
+    for (cmp1 = list1; CONSP(cmp1); cmp1 = CDR(cmp1)) {
+	item = CAR(cmp1);
+
+	/* Apply key predicate if required */
+	if (key != UNSPEC) {
+	    cmp = APPLY1(key, item);
+	    if (setexclusiveor) {
+		if (clist1 == NIL) {
+		    clist1 = cdr = CONS(cmp, NIL);
+		    GC_PROTECT(clist1);
+		}
+		else {
+		    RPLACD(cdr, CONS(cmp, NIL));
+		    cdr = CDR(cdr);
+		}
+	    }
+	}
+	else
+	    cmp = item;
+
+	/* Compare against list2 */
+	for (cmp2 = clist2; CONSP(cmp2); cmp2 = CDR(cmp2)) {
+	    value = FCOMPARE(lambda, cmp, CAR(cmp2), code);
+	    if (value == expect)
+		break;
+	}
+	if (check_list2 && value != expect) {
+	    /* check if list2 is a proper list */
+	    CHECK_LIST(cmp2);
+	    check_list2 = 0;
+	}
+
+	if (function == SUBSETP) {
+	    /* Element of list1 not in list2? */
+	    if (value != expect) {
+		GC_LEAVE();
+
+		return (NIL);
+	    }
+	}
+	/* If need to add item to result */
+	else if (((setdifference || xunion || setexclusiveor) &&
+		  value != expect) ||
+		 (intersection && value == expect)) {
+	    if (inplace) {
+		if (result == NIL)
+		    result = cons = cmp1;
+		else {
+		    if (setexclusiveor) {
+			/* don't remove elements yet, will need
+			 * to check agains't list2 later */
+			for (cmp2 = cons; CDR(cmp2) != cmp1; cmp2 = CDR(cmp2))
+			    ;
+			if (cmp2 != cons) {
+			    RPLACD(cmp2, list1);
+			    list1 = cmp2;
+			}
+		    }
+		    RPLACD(cons, cmp1);
+		    cons = cmp1;
+		}
+	    }
+	    else {
+		if (result == NIL) {
+		    result = cons = CONS(item, NIL);
+		    GC_PROTECT(result);
+		}
+		else {
+		    RPLACD(cons, CONS(item, NIL));
+		    cons = CDR(cons);
+		}
+	    }
+	}
+    }
+    /* check if list1 is a proper list */
+    CHECK_LIST(cmp1);
+
+    if (function == SUBSETP) {
+	GC_LEAVE();
+
+	return (T);
+    }
+    else if (xunion) {
+	/* Add list2 to tail of result */
+	if (result == NIL)
+	    result = list2;
+	else
+	    RPLACD(cons, list2);
+    }
+    else if (setexclusiveor) {
+	LispObj *result2, *cons2;
+
+	result2 = cons2 = NIL;
+	for (cmp2 = list2; CONSP(cmp2); cmp2 = CDR(cmp2)) {
+	    item = CAR(cmp2);
+
+	    if (key != UNSPEC) {
+		cmp = CAR(clist2);
+		/* XXX changing clist2 */
+		clist2 = CDR(clist2);
+		cmp1 = clist1;
+	    }
+	    else {
+		cmp = item;
+		cmp1 = list1;
+	    }
+
+	    /* Compare against list1 */
+	    for (; CONSP(cmp1); cmp1 = CDR(cmp1)) {
+		value = FCOMPARE(lambda, cmp, CAR(cmp1), code);
+		if (value == expect)
+		    break;
+	    }
+
+	    if (value != expect) {
+		if (inplace) {
+		    if (result2 == NIL)
+			result2 = cons2 = cmp2;
+		    else {
+			RPLACD(cons2, cmp2);
+			cons2 = cmp2;
+		    }
+		}
+		else {
+		    if (result == NIL) {
+			result = cons = CONS(item, NIL);
+			GC_PROTECT(result);
+		    }
+		    else {
+			RPLACD(cons, CONS(item, NIL));
+			cons = CDR(cons);
+		    }
+		}
+	    }
+	}
+	if (inplace) {
+	    if (CONSP(cons2))
+		RPLACD(cons2, NIL);
+	    if (result == NIL)
+		result = result2;
+	    else
+		RPLACD(cons, result2);
+	}
+    }
+    else if ((function == NSETDIFFERENCE || function == NINTERSECTION) &&
+	     CONSP(cons))
+	RPLACD(cons, NIL);
+
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Loop(LispBuiltin *builtin)
+/*
+ loop &rest body
+ */
+{
+    LispObj *code, *result;
+    LispBlock *block;
+
+    LispObj *body;
+
+    body = ARGUMENT(0);
+
+    result = NIL;
+    block = LispBeginBlock(NIL, LispBlockTag);
+    if (setjmp(block->jmp) == 0) {
+	for (;;)
+	    for (code = body; CONSP(code); code = CDR(code))
+		(void)EVAL(CAR(code));
+    }
+    LispEndBlock(block);
+    result = lisp__data.block.block_ret;
+
+    return (result);
+}
+
+/* XXX This function is broken, needs a review
+ (being delayed until true array/vectors be implemented) */
+LispObj *
+Lisp_MakeArray(LispBuiltin *builtin)
+/*
+ make-array dimensions &key element-type initial-element initial-contents
+			    adjustable fill-pointer displaced-to
+			    displaced-index-offset
+ */
+{
+    long rank = 0, count = 1, offset, zero, c;
+    LispObj *obj, *dim, *array;
+    LispType type;
+
+    LispObj *dimensions, *element_type, *initial_element, *initial_contents,
+	    *adjustable, *fill_pointer, *displaced_to,
+	    *displaced_index_offset;
+
+    dim = array = NIL;
+    type = LispNil_t;
+
+    displaced_index_offset = ARGUMENT(7);
+    displaced_to = ARGUMENT(6);
+    fill_pointer = ARGUMENT(5);
+    adjustable = ARGUMENT(4);
+    initial_contents = ARGUMENT(3);
+    initial_element = ARGUMENT(2);
+    element_type = ARGUMENT(1);
+    dimensions = ARGUMENT(0);
+
+    if (INDEXP(dimensions)) {
+	dim = CONS(dimensions, NIL);
+	rank = 1;
+	count = FIXNUM_VALUE(dimensions);
+    }
+    else if (CONSP(dimensions)) {
+	dim = dimensions;
+
+	for (rank = 0; CONSP(dim); rank++, dim = CDR(dim)) {
+	    obj = CAR(dim);
+	    CHECK_INDEX(obj);
+	    count *= FIXNUM_VALUE(obj);
+	}
+	dim = dimensions;
+    }
+    else if (dimensions == NIL) {
+	dim = NIL;
+	rank = count = 0;
+    }
+    else
+	LispDestroy("%s: %s is a bad array dimension",
+		    STRFUN(builtin), STROBJ(dimensions));
+
+    /* check element-type */
+    if (element_type != UNSPEC) {
+	if (element_type == T)
+	    type = LispNil_t;
+	else if (!SYMBOLP(element_type))
+	    LispDestroy("%s: unsupported element type %s",
+			STRFUN(builtin), STROBJ(element_type));
+	else {
+	    Atom_id atom = ATOMID(element_type);
+
+	    if (atom == Satom)
+		type = LispAtom_t;
+	    else if (atom == Sinteger)
+		type = LispInteger_t;
+	    else if (atom == Scharacter)
+		type = LispSChar_t;
+	    else if (atom == Sstring)
+		type = LispString_t;
+	    else if (atom == Slist)
+		type = LispCons_t;
+	    else if (atom == Sopaque)
+		type = LispOpaque_t;
+	    else
+		LispDestroy("%s: unsupported element type %s",
+			    STRFUN(builtin), ATOMID(element_type));
+	}
+    }
+
+    /* check initial-contents */
+    if (rank) {
+	CHECK_LIST(initial_contents);
+    }
+
+    /* check displaced-to */
+    if (displaced_to != UNSPEC) {
+	CHECK_ARRAY(displaced_to);
+    }
+
+    /* check displaced-index-offset */
+    offset = -1;
+    if (displaced_index_offset != UNSPEC) {
+	CHECK_INDEX(displaced_index_offset);
+	offset = FIXNUM_VALUE(displaced_index_offset);
+    }
+
+    c = 0;
+    if (initial_element != UNSPEC)
+	++c;
+    if (initial_contents != UNSPEC)
+	++c;
+    if (displaced_to != UNSPEC || offset >= 0)
+	++c;
+    if (c > 1)
+	LispDestroy("%s: more than one initialization specified",
+		    STRFUN(builtin));
+    if (initial_element == UNSPEC)
+	initial_element = NIL;
+
+    zero = count == 0;
+    if (displaced_to != UNSPEC) {
+	CHECK_ARRAY(displaced_to);
+	if (offset < 0)
+	    offset = 0;
+	for (c = 1, obj = displaced_to->data.array.dim; obj != NIL;
+	     obj = CDR(obj))
+	    c *= FIXNUM_VALUE(CAR(obj));
+	if (c < count + offset)
+	    LispDestroy("%s: array-total-size + displaced-index-offset "
+			"exceeds total size", STRFUN(builtin));
+	for (c = 0, array = displaced_to->data.array.list; c < offset; c++)
+	    array = CDR(array);
+    }
+    else if (initial_contents != UNSPEC) {
+	CHECK_CONS(initial_contents);
+	if (rank == 0)
+	    array = initial_contents;
+	else if (rank == 1) {
+	    for (array = initial_contents, c = 0; c < count;
+		 array = CDR(array), c++)
+		if (!CONSP(array))
+		    LispDestroy("%s: bad argument or size %s",
+				STRFUN(builtin), STROBJ(array));
+	    if (array != NIL)
+		LispDestroy("%s: bad argument or size %s",
+			    STRFUN(builtin), STROBJ(array));
+	    array = initial_contents;
+	}
+	else {
+	    LispObj *err = NIL;
+	    /* check if list matches */
+	    int i, j, k, *dims, *loop;
+
+	    /* create iteration variables */
+	    dims = LispMalloc(sizeof(int) * rank);
+	    loop = LispCalloc(1, sizeof(int) * (rank - 1));
+	    for (i = 0, obj = dim; CONSP(obj); i++, obj = CDR(obj))
+		dims[i] = FIXNUM_VALUE(CAR(obj));
+
+	    /* check if list matches specified dimensions */
+	    while (loop[0] < dims[0]) {
+		for (obj = initial_contents, i = 0; i < rank - 1; i++) {
+		    for (j = 0; j < loop[i]; j++)
+			obj = CDR(obj);
+		    err = obj;
+		    if (!CONSP(obj = CAR(obj)))
+			goto make_array_error;
+		    err = obj;
+		}
+		--i;
+		for (;;) {
+		    ++loop[i];
+		    if (i && loop[i] >= dims[i])
+			loop[i] = 0;
+		    else
+			break;
+		    --i;
+		}
+		for (k = 0; k < dims[rank - 1]; obj = CDR(obj), k++) {
+		    if (!CONSP(obj))
+			goto make_array_error;
+		}
+		if (obj == NIL)
+		    continue;
+make_array_error:
+		LispFree(dims);
+		LispFree(loop);
+		LispDestroy("%s: bad argument or size %s",
+			    STRFUN(builtin), STROBJ(err));
+	    }
+
+	    /* list is correct, use it to fill initial values */
+
+	    /* reset loop */
+	    memset(loop, 0, sizeof(int) * (rank - 1));
+
+	    GCDisable();
+	    /* fill array with supplied values */
+	    array = NIL;
+	    while (loop[0] < dims[0]) {
+		for (obj = initial_contents, i = 0; i < rank - 1; i++) {
+		    for (j = 0; j < loop[i]; j++)
+			obj = CDR(obj);
+		    obj = CAR(obj);
+		}
+		--i;
+		for (;;) {
+		    ++loop[i];
+		    if (i && loop[i] >= dims[i])
+			loop[i] = 0;
+		    else
+			break;
+		    --i;
+		}
+		for (k = 0; k < dims[rank - 1]; obj = CDR(obj), k++) {
+		    if (array == NIL)
+			array = CONS(CAR(obj), NIL);
+		    else {
+			RPLACD(array, CONS(CAR(array), CDR(array)));
+			RPLACA(array, CAR(obj));
+		    }
+		}
+	    }
+	    LispFree(dims);
+	    LispFree(loop);
+	    array = LispReverse(array);
+	    GCEnable();
+	}
+    }
+    else {
+	GCDisable();
+	/* allocate array */
+	if (count) {
+	    --count;
+	    array = CONS(initial_element, NIL);
+	    while (count) {
+		RPLACD(array, CONS(CAR(array), CDR(array)));
+		RPLACA(array, initial_element);
+		count--;
+	    }
+	}
+	GCEnable();
+    }
+
+    obj = LispNew(array, dim);
+    obj->type = LispArray_t;
+    obj->data.array.list = array;
+    obj->data.array.dim = dim;
+    obj->data.array.rank = rank;
+    obj->data.array.type = type;
+    obj->data.array.zero = zero;
+
+    return (obj);
+}
+
+LispObj *
+Lisp_MakeList(LispBuiltin *builtin)
+/*
+ make-list size &key initial-element
+ */
+{
+    GC_ENTER();
+    long count;
+    LispObj *result, *cons;
+
+    LispObj *size, *initial_element;
+
+    initial_element = ARGUMENT(1);
+    size = ARGUMENT(0);
+
+    CHECK_INDEX(size);
+    count = FIXNUM_VALUE(size);
+
+    if (count == 0)
+	return (NIL);
+    if (initial_element == UNSPEC)
+	initial_element = NIL;
+
+    result = cons = CONS(initial_element, NIL);
+    GC_PROTECT(result);
+    for (; count > 1; count--) {
+	RPLACD(cons, CONS(initial_element, NIL));
+	cons = CDR(cons);
+    }
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_MakeSymbol(LispBuiltin *builtin)
+/*
+ make-symbol name
+ */
+{
+    LispObj *name, *symbol;
+
+    name = ARGUMENT(0);
+    CHECK_STRING(name);
+
+    symbol = UNINTERNED_ATOM(THESTR(name));
+    symbol->data.atom->unreadable = !LispCheckAtomString(THESTR(name));
+
+    return (symbol);
+}
+
+LispObj *
+Lisp_Makunbound(LispBuiltin *builtin)
+/*
+ makunbound symbol
+ */
+{
+    LispObj *symbol;
+
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+    LispUnsetVar(symbol);
+
+    return (symbol);
+}
+
+LispObj *
+Lisp_Mapc(LispBuiltin *builtin)
+/*
+ mapc function list &rest more-lists
+ */
+{
+    return (LispMapc(builtin, 0));
+}
+
+LispObj *
+Lisp_Mapcar(LispBuiltin *builtin)
+/*
+ mapcar function list &rest more-lists
+ */
+{
+    return (LispMapc(builtin, 1));
+}
+
+/* Like nconc but ignore non list arguments */
+LispObj *
+LispMapnconc(LispObj *list)
+{
+    LispObj *result = NIL;
+
+    if (CONSP(list)) {
+	LispObj *cons, *head, *tail;
+
+	cons = NIL;
+	for (; CONSP(CDR(list)); list = CDR(list)) {
+	    head = CAR(list);
+	    if (CONSP(head)) {
+		for (tail = head; CONSP(CDR(tail)); tail = CDR(tail))
+		    ;
+		if (cons != NIL)
+		    RPLACD(cons, head);
+		else
+		    result = head;
+		cons = tail;
+	    }
+	}
+	head = CAR(list);
+	if (CONSP(head)) {
+	    if (cons != NIL)
+		RPLACD(cons, head);
+	    else
+		result = head;
+	}
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Mapcan(LispBuiltin *builtin)
+/*
+ mapcan function list &rest more-lists
+ */
+{
+    return (LispMapnconc(LispMapc(builtin, 1)));
+}
+
+static LispObj *
+LispMapc(LispBuiltin *builtin, int mapcar)
+{
+    GC_ENTER();
+    long i, offset, count, length;
+    LispObj *result = NIL, *cons, *arguments, *acons, *rest, *alist, *value;
+    LispObj *stk[8], **cdrs;
+
+    LispObj *function, *list, *more_lists;
+
+    more_lists = ARGUMENT(2);
+    list = ARGUMENT(1);
+    function = ARGUMENT(0);
+
+    /* Result will be no longer than this */
+    for (length = 0, alist = list; CONSP(alist); length++, alist = CDR(alist))
+	;
+
+    /* If first argument is not a list... */
+    if (length == 0)
+	return (NIL);
+
+    /* At least one argument will be passed to function, count how many
+     * extra arguments will be used, and calculate result length. */
+    count = 0;
+    for (rest = more_lists; CONSP(rest); rest = CDR(rest), count++) {
+
+	/* Check if extra list is really a list, and if it is smaller
+	 * than the first list */
+	for (i = 0, alist = CAR(rest);
+	     i < length && CONSP(alist);
+	     i++, alist = CDR(alist))
+	    ;
+
+	/* If it is not a true list */
+	if (i == 0)
+	    return (NIL);
+
+	/* If it is smaller than the currently calculated result length */
+	if (i < length)
+	    length = i;
+    }
+
+    if (mapcar) {
+	/* Initialize gc protected object cells for resulting list */
+	result = cons = CONS(NIL, NIL);
+	GC_PROTECT(result);
+    }
+    else
+	result = cons = list;
+
+    if (count >= sizeof(stk) / sizeof(stk[0]))
+	cdrs = LispMalloc(count * sizeof(LispObj*));
+    else
+	cdrs = &stk[0];
+    for (i = 0, rest = more_lists; i < count; i++, rest = CDR(rest))
+	cdrs[i] = CAR(rest);
+
+    /* Initialize gc protected object cells for argument list */
+    arguments = acons = CONS(NIL, NIL);
+    GC_PROTECT(arguments);
+
+    /* Allocate space for extra arguments */
+    for (i = 0; i < count; i++) {
+	RPLACD(acons, CONS(NIL, NIL));
+	acons = CDR(acons);
+    }
+
+    /* For every element of the list that will be used */
+    for (offset = 0;; list = CDR(list)) {
+	acons = arguments;
+
+	/* Add first argument */
+	RPLACA(acons, CAR(list));
+	acons = CDR(acons);
+
+	/* For every extra list argument */
+	for (i = 0; i < count; i++) {
+	    alist = cdrs[i];
+	    cdrs[i] = CDR(cdrs[i]);
+
+	    /* Add element to argument list */
+	    RPLACA(acons, CAR(alist));
+	    acons = CDR(acons);
+	}
+
+	value = APPLY(function, arguments);
+
+	if (mapcar) {
+	    /* Store result */
+	    RPLACA(cons, value);
+
+	    /* Allocate new result cell */
+	    if (++offset < length) {
+		RPLACD(cons, CONS(NIL, NIL));
+		cons = CDR(cons);
+	    }
+	    else
+		break;
+	}
+	else if (++offset >= length)
+	    break;
+    }
+
+    /* Unprotect argument and result list */
+    GC_LEAVE();
+    if (cdrs != &stk[0])
+	LispFree(cdrs);
+
+    return (result);
+}
+
+static LispObj *
+LispMapl(LispBuiltin *builtin, int maplist)
+{
+    GC_ENTER();
+    long i, offset, count, length;
+    LispObj *result = NIL, *cons, *arguments, *acons, *rest, *alist, *value;
+    LispObj *stk[8], **cdrs;
+
+    LispObj *function, *list, *more_lists;
+
+    more_lists = ARGUMENT(2);
+    list = ARGUMENT(1);
+    function = ARGUMENT(0);
+
+    /* count is the number of lists, length is the length of the result */
+    for (length = 0, alist = list; CONSP(alist); length++, alist = CDR(alist))
+	;
+
+    /* first argument is not a list */
+    if (length == 0)
+	return (NIL);
+
+    /* check remaining arguments */
+    for (count = 0, rest = more_lists; CONSP(rest); rest = CDR(rest), count++) {
+	for (i = 0, alist = CAR(rest);
+	     i < length && CONSP(alist);
+	     i++, alist = CDR(alist))
+	    ;
+	/* argument is not a list */
+	if (i == 0)
+	    return (NIL);
+	/* result will have the length of the smallest list */
+	if (i < length)
+	    length = i;
+    }
+
+    /* result will be a list */
+    if (maplist) {
+	result = cons = CONS(NIL, NIL);
+	GC_PROTECT(result);
+    }
+    else
+	result = cons = list;
+
+    if (count >= sizeof(stk) / sizeof(stk[0]))
+	cdrs = LispMalloc(count * sizeof(LispObj*));
+    else
+	cdrs = &stk[0];
+    for (i = 0, rest = more_lists; i < count; i++, rest = CDR(rest))
+	cdrs[i] = CAR(rest);
+
+    /* initialize argument list */
+    arguments = acons = CONS(NIL, NIL);
+    GC_PROTECT(arguments);
+    for (i = 0; i < count; i++) {
+	RPLACD(acons, CONS(NIL, NIL));
+	acons = CDR(acons);
+    }
+
+    /* for every used list element */
+    for (offset = 0;; list = CDR(list)) {
+	acons = arguments;
+
+	/* first argument */
+	RPLACA(acons, list);
+	acons = CDR(acons);
+
+	/* for every extra list */
+	for (i = 0; i < count; i++) {
+	    RPLACA(acons, cdrs[i]);
+	    cdrs[i] = CDR(cdrs[i]);
+	    acons = CDR(acons);
+	}
+
+	value = APPLY(function, arguments);
+
+	if (maplist) {
+	    /* store result */
+	    RPLACA(cons, value);
+
+	    /* allocate new cell */
+	    if (++offset < length) {
+		RPLACD(cons, CONS(NIL, NIL));
+		cons = CDR(cons);
+	    }
+	    else
+		break;
+	}
+	else if (++offset >= length)
+	    break;
+    }
+
+    GC_LEAVE();
+    if (cdrs != &stk[0])
+	LispFree(cdrs);
+
+    return (result);
+}
+
+LispObj *
+Lisp_Mapl(LispBuiltin *builtin)
+/*
+ mapl function list &rest more-lists
+ */
+{
+    return (LispMapl(builtin, 0));
+}
+
+LispObj *
+Lisp_Maplist(LispBuiltin *builtin)
+/*
+ maplist function list &rest more-lists
+ */
+{
+    return (LispMapl(builtin, 1));
+}
+
+LispObj *
+Lisp_Mapcon(LispBuiltin *builtin)
+/*
+ mapcon function list &rest more-lists
+ */
+{
+    return (LispMapnconc(LispMapl(builtin, 1)));
+}
+
+LispObj *
+Lisp_Member(LispBuiltin *builtin)
+/*
+ member item list &key test test-not key
+ */
+{
+    int code, expect;
+    LispObj *compare, *lambda;
+    LispObj *item, *list, *test, *test_not, *key;
+
+    key = ARGUMENT(4);
+    test_not = ARGUMENT(3);
+    test = ARGUMENT(2);
+    list = ARGUMENT(1);
+    item = ARGUMENT(0);
+
+    if (list == NIL)
+	return (NIL);
+    CHECK_CONS(list);
+
+    CHECK_TEST();
+    if (key == UNSPEC) {
+	if (code == FEQ) {
+	    for (; CONSP(list); list = CDR(list))
+		if (item == CAR(list))
+		    return (list);
+	}
+	else {
+	    for (; CONSP(list); list = CDR(list))
+		if (FCOMPARE(lambda, item, CAR(list), code) == expect)
+		    return (list);
+	}
+    }
+    else {
+	if (code == FEQ) {
+	    for (; CONSP(list); list = CDR(list))
+		if (item == APPLY1(key, CAR(list)))
+		    return (list);
+	}
+	else {
+	    for (; CONSP(list); list = CDR(list)) {
+		compare = APPLY1(key, CAR(list));
+		if (FCOMPARE(lambda, item, compare, code) == expect)
+		    return (list);
+	    }
+	}
+    }
+    /* check if is a proper list */
+    CHECK_LIST(list);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_MemberIf(LispBuiltin *builtin)
+/*
+ member-if predicate list &key key
+ */
+{
+    return (LispAssocOrMember(builtin, MEMBER, IF));
+}
+
+LispObj *
+Lisp_MemberIfNot(LispBuiltin *builtin)
+/*
+ member-if-not predicate list &key key
+ */
+{
+    return (LispAssocOrMember(builtin, MEMBER, IFNOT));
+}
+
+LispObj *
+Lisp_MultipleValueBind(LispBuiltin *builtin)
+/*
+ multiple-value-bind symbols values &rest body
+ */
+{
+    int i, head = lisp__data.env.length;
+    LispObj *result, *symbol, *value;
+
+    LispObj *symbols, *values, *body;
+
+    body = ARGUMENT(2);
+    values = ARGUMENT(1);
+    symbols = ARGUMENT(0);
+
+    result = EVAL(values);
+    for (i = -1; CONSP(symbols); symbols = CDR(symbols), i++) {
+	symbol = CAR(symbols);
+	CHECK_SYMBOL(symbol);
+	CHECK_CONSTANT(symbol);
+	if (i >= 0 && i < RETURN_COUNT)
+	    value = RETURN(i);
+	else if (i < 0)
+	    value = result;
+	else
+	    value = NIL;
+	LispAddVar(symbol, value);
+	++lisp__data.env.head;
+    }
+
+    /* Execute code with binded variables (if any) */
+    for (result = NIL; CONSP(body); body = CDR(body))
+	result = EVAL(CAR(body));
+
+    lisp__data.env.head = lisp__data.env.length = head;
+
+    return (result);
+}
+
+LispObj *
+Lisp_MultipleValueCall(LispBuiltin *builtin)
+/*
+ multiple-value-call function &rest form
+ */
+{
+    GC_ENTER();
+    int i;
+    LispObj *arguments, *cons, *result;
+
+    LispObj *function, *form;
+
+    form = ARGUMENT(1);
+    function = ARGUMENT(0);
+
+    /* build argument list */
+    arguments = cons = NIL;
+    for (; CONSP(form); form = CDR(form)) {
+	RETURN_COUNT = 0;
+	result = EVAL(CAR(form));
+	if (RETURN_COUNT >= 0) {
+	    if (arguments == NIL) {
+		arguments = cons = CONS(result, NIL);
+		GC_PROTECT(arguments);
+	    }
+	    else {
+		RPLACD(cons, CONS(result, NIL));
+		cons = CDR(cons);
+	    }
+	    for (i = 0; i < RETURN_COUNT; i++) {
+		RPLACD(cons, CONS(RETURN(i), NIL));
+		cons = CDR(cons);
+	    }
+	}
+    }
+
+    /* apply function */
+    if (POINTERP(function) && !XSYMBOLP(function) && !XFUNCTIONP(function)) {
+	function = EVAL(function);
+	GC_PROTECT(function);
+    }
+    result = APPLY(function, arguments);
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_MultipleValueProg1(LispBuiltin *builtin)
+/*
+ multiple-value-prog1 first-form &rest form
+ */
+{
+    GC_ENTER();
+    int i, count;
+    LispObj *values, *cons;
+
+    LispObj *first_form, *form;
+
+    form = ARGUMENT(1);
+    first_form = ARGUMENT(0);
+
+    values = EVAL(first_form);
+    if (!CONSP(form))
+	return (values);
+
+    cons = NIL;
+    count = RETURN_COUNT;
+    if (count < 0)
+	values = NIL;
+    else if (count == 0) {
+	GC_PROTECT(values);
+    }
+    else {
+	values = cons = CONS(values, NIL);
+	GC_PROTECT(values);
+	for (i = 0; i < count; i++) {
+	    RPLACD(cons, CONS(RETURN(i), NIL));
+	    cons = CDR(cons);
+	}
+    }
+
+    for (; CONSP(form); form = CDR(form))
+	EVAL(CAR(form));
+
+    RETURN_COUNT = count;
+    if (count > 0) {
+	for (i = 0, cons = CDR(values); CONSP(cons); cons = CDR(cons), i++)
+	    RETURN(i) = CAR(cons);
+	values = CAR(values);
+    }
+    GC_LEAVE();
+
+    return (values);
+}
+
+LispObj *
+Lisp_MultipleValueList(LispBuiltin *builtin)
+/*
+ multiple-value-list form
+ */
+{
+    int i;
+    GC_ENTER();
+    LispObj *form, *result, *cons;
+
+    form = ARGUMENT(0);
+
+    result = EVAL(form);
+
+    if (RETURN_COUNT < 0)
+	return (NIL);
+
+    result = cons = CONS(result, NIL);
+    GC_PROTECT(result);
+    for (i = 0; i < RETURN_COUNT; i++) {
+	RPLACD(cons, CONS(RETURN(i), NIL));
+	cons = CDR(cons);
+    }
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_MultipleValueSetq(LispBuiltin *builtin)
+/*
+ multiple-value-setq symbols form
+ */
+{
+    int i;
+    LispObj *result, *symbol, *value;
+
+    LispObj *symbols, *form;
+
+    form = ARGUMENT(1);
+    symbols = ARGUMENT(0);
+
+    CHECK_LIST(symbols);
+    result = EVAL(form);
+    if (CONSP(symbols)) {
+	symbol = CAR(symbols);
+	CHECK_SYMBOL(symbol);
+	CHECK_CONSTANT(symbol);
+	LispSetVar(symbol, result);
+	symbols = CDR(symbols);
+    }
+    for (i = 0; CONSP(symbols); symbols = CDR(symbols), i++) {
+	symbol = CAR(symbols);
+	CHECK_SYMBOL(symbol);
+	CHECK_CONSTANT(symbol);
+	if (i < RETURN_COUNT && RETURN_COUNT > 0)
+	    value = RETURN(i);
+	else
+	    value = NIL;
+	LispSetVar(symbol, value);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Nconc(LispBuiltin *builtin)
+/*
+ nconc &rest lists
+ */
+{
+    LispObj *list, *lists, *cons, *head, *tail;
+
+    lists = ARGUMENT(0);
+
+    /* skip any initial empty lists */
+    for (; CONSP(lists); lists = CDR(lists))
+	if (CAR(lists) != NIL)
+	    break;
+
+    /* don't check if a proper list */
+    if (!CONSP(lists))
+	return (lists);
+
+    /* setup to concatenate lists */
+    list = CAR(lists);
+    CHECK_CONS(list);
+    for (cons = list; CONSP(CDR(cons)); cons = CDR(cons))
+	;
+
+    /* if only two lists */
+    lists = CDR(lists);
+    if (!CONSP(lists)) {
+	RPLACD(cons, lists);
+
+	return (list);
+    }
+
+    /* concatenate */
+    for (; CONSP(CDR(lists)); lists = CDR(lists)) {
+	head = CAR(lists);
+	if (head == NIL)
+	    continue;
+	CHECK_CONS(head);
+	for (tail = head; CONSP(CDR(tail)); tail = CDR(tail))
+	    ;
+	RPLACD(cons, head);
+	cons = tail;
+    }
+    /* add last list */
+    RPLACD(cons, CAR(lists));
+
+    return (list);
+}
+
+LispObj *
+Lisp_Nreverse(LispBuiltin *builtin)
+/*
+ nreverse sequence
+ */
+{
+    return (LispXReverse(builtin, 1));
+}
+
+LispObj *
+Lisp_NsetDifference(LispBuiltin *builtin)
+/*
+ nset-difference list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, NSETDIFFERENCE));
+}
+
+LispObj *
+Lisp_Nsubstitute(LispBuiltin *builtin)
+/*
+ nsubstitute newitem olditem sequence &key from-end test test-not start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, NSUBSTITUTE, NONE));
+}
+
+LispObj *
+Lisp_NsubstituteIf(LispBuiltin *builtin)
+/*
+ nsubstitute-if newitem test sequence &key from-end start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, NSUBSTITUTE, IF));
+}
+
+LispObj *
+Lisp_NsubstituteIfNot(LispBuiltin *builtin)
+/*
+ nsubstitute-if-not newitem test sequence &key from-end start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, NSUBSTITUTE, IFNOT));
+}
+
+LispObj *
+Lisp_Nth(LispBuiltin *builtin)
+/*
+ nth index list
+ */
+{
+    long position;
+    LispObj *oindex, *list;
+
+    list = ARGUMENT(1);
+    oindex = ARGUMENT(0);
+
+    CHECK_INDEX(oindex);
+    position = FIXNUM_VALUE(oindex);
+
+    if (list == NIL)
+	return (NIL);
+
+    CHECK_CONS(list);
+    for (; position > 0; position--) {
+	if (!CONSP(list))
+	    return (NIL);
+	list = CDR(list);
+    }
+
+    return (CONSP(list) ? CAR(list) : NIL);
+}
+
+LispObj *
+Lisp_Nthcdr(LispBuiltin *builtin)
+/*
+ nthcdr index list
+ */
+{
+    long position;
+    LispObj *oindex, *list;
+
+    list = ARGUMENT(1);
+    oindex = ARGUMENT(0);
+
+    CHECK_INDEX(oindex);
+    position = FIXNUM_VALUE(oindex);
+
+    if (list == NIL)
+	return (NIL);
+    CHECK_CONS(list);
+
+    for (; position > 0; position--) {
+	if (!CONSP(list))
+	    return (NIL);
+	list = CDR(list);
+    }
+
+    return (list);
+}
+
+LispObj *
+Lisp_NthValue(LispBuiltin *builtin)
+/*
+ nth-value index form
+ */
+{
+    long i;
+    LispObj *oindex, *form, *result;
+
+    form = ARGUMENT(1);
+    oindex = ARGUMENT(0);
+
+    oindex = EVAL(oindex);
+    CHECK_INDEX(oindex);
+    i = FIXNUM_VALUE(oindex) - 1;
+
+    result = EVAL(form);
+    if (RETURN_COUNT < 0 || i >= RETURN_COUNT)
+	result = NIL;
+    else if (i >= 0)
+	result = RETURN(i);
+
+    return (result);
+}
+
+LispObj *
+Lisp_Null(LispBuiltin *builtin)
+/*
+ null list
+ */
+{
+    LispObj *list;
+
+    list = ARGUMENT(0);
+
+    return (list == NIL ? T : NIL);
+}
+
+LispObj *
+Lisp_Or(LispBuiltin *builtin)
+/*
+ or &rest args
+ */
+{
+    LispObj *result = NIL, *args;
+
+    args = ARGUMENT(0);
+
+    for (; CONSP(args); args = CDR(args)) {
+	result = EVAL(CAR(args));
+	if (result != NIL)
+	    break;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Pairlis(LispBuiltin *builtin)
+/*
+ pairlis key data &optional alist
+ */
+{
+    LispObj *result, *cons;
+
+    LispObj *key, *data, *alist;
+
+    alist = ARGUMENT(2);
+    data = ARGUMENT(1);
+    key = ARGUMENT(0);
+
+    if (CONSP(key) && CONSP(data)) {
+	GC_ENTER();
+
+	result = cons = CONS(CONS(CAR(key), CAR(data)), NIL);
+	GC_PROTECT(result);
+	key = CDR(key);
+	data = CDR(data);
+	for (; CONSP(key) && CONSP(data); key = CDR(key), data = CDR(data)) {
+	    RPLACD(cons, CONS(CONS(CAR(key), CAR(data)), NIL));
+	    cons = CDR(cons);
+	}
+	if (CONSP(key) || CONSP(data))
+	    LispDestroy("%s: different length lists", STRFUN(builtin));
+	GC_LEAVE();
+	if (alist != UNSPEC)
+	    RPLACD(cons, alist);
+    }
+    else
+	result = alist == UNSPEC ? NIL : alist;
+
+    return (result);
+}
+
+static LispObj *
+LispFindOrPosition(LispBuiltin *builtin,
+		   int function, int comparison)
+/*
+ find item sequence &key from-end test test-not start end key
+ find-if predicate sequence &key from-end start end key
+ find-if-not predicate sequence &key from-end start end key
+ position item sequence &key from-end test test-not start end key
+ position-if predicate sequence &key from-end start end key
+ position-if-not predicate sequence &key from-end start end key
+ */
+{
+    int code = 0, istring, expect, value;
+    char *string = NULL;
+    long offset = -1, start, end, length, i = comparison == NONE ? 7 : 5;
+    LispObj *cmp, *element, **objects = NULL;
+
+    LispObj *item, *predicate, *sequence, *from_end,
+	    *test, *test_not, *ostart, *oend, *key;
+
+    key = ARGUMENT(i);		--i;
+    oend = ARGUMENT(i);		--i;
+    ostart = ARGUMENT(i);	--i;
+    if (comparison == NONE) {
+	test_not = ARGUMENT(i);	--i;
+	test = ARGUMENT(i);	--i;
+    }
+    else
+	test_not = test = UNSPEC;
+    from_end = ARGUMENT(i);	--i;
+    if (from_end == UNSPEC)
+	from_end = NIL;
+    sequence = ARGUMENT(i);	--i;
+    if (comparison == NONE) {
+	item = ARGUMENT(i);
+	predicate = Oeql;
+    }
+    else {
+	predicate = ARGUMENT(i);
+	item = NIL;
+    }
+
+    LispCheckSequenceStartEnd(builtin, sequence, ostart, oend,
+			      &start, &end, &length);
+
+    if (sequence == NIL)
+	return (NIL);
+
+    /* Cannot specify both :test and :test-not */
+    if (test != UNSPEC && test_not != UNSPEC)
+	LispDestroy("%s: specify either :TEST or :TEST-NOT", STRFUN(builtin));
+
+    expect = 1;
+    if (comparison == NONE) {
+	if (test != UNSPEC)
+	    predicate = test;
+	else if (test_not != UNSPEC) {
+	    predicate = test_not;
+	    expect = 0;
+	}
+	FUNCTION_CHECK(predicate);
+	code = FCODE(predicate);
+    }
+
+    cmp = element = NIL;
+    istring = STRINGP(sequence);
+    if (istring)
+	string = THESTR(sequence);
+    else {
+	if (!CONSP(sequence))
+	    sequence = sequence->data.array.list;
+	for (i = 0; i < start; i++)
+	    sequence = CDR(sequence);
+    }
+
+    if ((length = end - start) == 0)
+	return (NIL);
+
+    if (from_end != NIL && !istring) {
+	objects = LispMalloc(sizeof(LispObj*) * length);
+	for (i = length - 1; i >= 0; i--, sequence = CDR(sequence))
+	    objects[i] = CAR(sequence);
+    }
+
+    for (i = 0; i < length; i++) {
+	if (istring)
+	    element = SCHAR(string[from_end == NIL ? i + start : end - i - 1]);
+	else
+	    element = from_end == NIL ? CAR(sequence) : objects[i];
+
+	if (key != UNSPEC)
+	    cmp = APPLY1(key, element);
+	else
+	    cmp = element;
+
+	/* Update list */
+	if (!istring && from_end == NIL)
+	    sequence = CDR(sequence);
+
+	if (comparison == NONE)
+	    value = FCOMPARE(predicate, item, cmp, code);
+	else
+	    value = APPLY1(predicate, cmp) != NIL;
+
+	if ((!value &&
+	     (comparison == IFNOT ||
+	      (comparison == NONE && !expect))) ||
+	    (value &&
+	     (comparison == IF ||
+	      (comparison == NONE && expect)))) {
+	    offset = from_end == NIL ? i + start : end - i - 1;
+	    break;
+	}
+    }
+
+    if (from_end != NIL && !istring)
+	LispFree(objects);
+
+    return (offset == -1 ? NIL : function == FIND ? element : FIXNUM(offset));
+}
+
+LispObj *
+Lisp_Pop(LispBuiltin *builtin)
+/*
+ pop place
+ */
+{
+    LispObj *result, *value;
+
+    LispObj *place;
+
+    place = ARGUMENT(0);
+
+    if (SYMBOLP(place)) {
+	result = LispGetVar(place);
+	if (result == NULL)
+	    LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
+	CHECK_CONSTANT(place);
+	if (result != NIL) {
+	    CHECK_CONS(result);
+	    value = CDR(result);
+	    result = CAR(result);
+	}
+	else
+	    value = NIL;
+	LispSetVar(place, value);
+    }
+    else {
+	GC_ENTER();
+	LispObj quote;
+
+	result = EVAL(place);
+	if (result != NIL) {
+	    CHECK_CONS(result);
+	    value = CDR(result);
+	    GC_PROTECT(value);
+	    result = CAR(result);
+	}
+	else
+	    value = NIL;
+	quote.type = LispQuote_t;
+	quote.data.quote = value;
+	APPLY2(Osetf, place, &quote);
+	GC_LEAVE();
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Position(LispBuiltin *builtin)
+/*
+ position item sequence &key from-end test test-not start end key
+ */
+{
+    return (LispFindOrPosition(builtin, POSITION, NONE));
+}
+
+LispObj *
+Lisp_PositionIf(LispBuiltin *builtin)
+/*
+ position-if predicate sequence &key from-end start end key
+ */
+{
+    return (LispFindOrPosition(builtin, POSITION, IF));
+}
+
+LispObj *
+Lisp_PositionIfNot(LispBuiltin *builtin)
+/*
+ position-if-not predicate sequence &key from-end start end key
+ */
+{
+    return (LispFindOrPosition(builtin, POSITION, IFNOT));
+}
+
+LispObj *
+Lisp_Proclaim(LispBuiltin *builtin)
+/*
+ proclaim declaration
+ */
+{
+    LispObj *arguments, *object;
+    char *operation;
+
+    LispObj *declaration;
+
+    declaration = ARGUMENT(0);
+
+    CHECK_CONS(declaration);
+
+    arguments = declaration;
+    object = CAR(arguments);
+    CHECK_SYMBOL(object);
+
+    operation = ATOMID(object);
+    if (strcmp(operation, "SPECIAL") == 0) {
+	for (arguments = CDR(arguments); CONSP(arguments);
+	     arguments = CDR(arguments)) {
+	    object = CAR(arguments);
+	    CHECK_SYMBOL(object);
+	    LispProclaimSpecial(object, NULL, NIL);
+	}
+    }
+    else if (strcmp(operation, "TYPE") == 0) {
+	/* XXX no type checking yet, but should be added */
+    }
+    /* else do nothing */
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Prog1(LispBuiltin *builtin)
+/*
+ prog1 first &rest body
+ */
+{
+    GC_ENTER();
+    LispObj *result;
+
+    LispObj *first, *body;
+
+    body = ARGUMENT(1);
+    first = ARGUMENT(0);
+
+    result = EVAL(first);
+
+    GC_PROTECT(result);
+    for (; CONSP(body); body = CDR(body))
+	(void)EVAL(CAR(body));
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Prog2(LispBuiltin *builtin)
+/*
+ prog2 first second &rest body
+ */
+{
+    GC_ENTER();
+    LispObj *result;
+
+    LispObj *first, *second, *body;
+
+    body = ARGUMENT(2);
+    second = ARGUMENT(1);
+    first = ARGUMENT(0);
+
+    (void)EVAL(first);
+    result = EVAL(second);
+    GC_PROTECT(result);
+    for (; CONSP(body); body = CDR(body))
+	(void)EVAL(CAR(body));
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Progn(LispBuiltin *builtin)
+/*
+ progn &rest body
+ */
+{
+    LispObj *result = NIL;
+
+    LispObj *body;
+
+    body = ARGUMENT(0);
+
+    for (; CONSP(body); body = CDR(body))
+	result = EVAL(CAR(body));
+
+    return (result);
+}
+
+/*
+ *  This does what I believe is the expected behaviour (or at least
+ * acceptable for the the interpreter), if the code being executed
+ * ever tries to change/bind a progv symbol, the symbol state will
+ * be restored when exiting the progv block, so, code like:
+ *	(progv '(*x*) '(1) (defvar *x* 10))
+ * when exiting the block, will have *x* unbound, and not a dynamic
+ * symbol; if it was already bound, will have the old value.
+ *  Symbols already dynamic can be freely changed, even unbounded in
+ * the progv block.
+ */
+LispObj *
+Lisp_Progv(LispBuiltin *builtin)
+/*
+ progv symbols values &rest body
+ */
+{
+    GC_ENTER();
+    int head = lisp__data.env.length, i, count, ostk[32], *offsets;
+    LispObj *result, *list, *symbol, *value, **presult, **psymbols, **pbody;
+    int jumped, *pjumped, *pcount, **poffsets;
+    char fstk[32], *flags, **pflags;
+    LispBlock *block;
+    LispAtom *atom;
+
+    LispObj *symbols, *values, *body;
+
+    /* Possible states */
+#define DYNAMIC_SYMBOL		1
+#define GLOBAL_SYMBOL		2
+#define UNBOUND_SYMBOL		3
+
+    body = ARGUMENT(2);
+    values = ARGUMENT(1);
+    symbols = ARGUMENT(0);
+
+    /* get symbol names */
+    symbols = EVAL(symbols);
+    GC_PROTECT(symbols);
+
+    /* get symbol values */
+    values = EVAL(values);
+    GC_PROTECT(values);
+
+    /* use variables */
+    pbody = &body;
+    psymbols = &symbols;
+    presult = &result;
+    pjumped = &jumped;
+    poffsets = &offsets;
+    pcount = &count;
+    pflags = &flags;
+
+    /* count/check symbols and allocate space to remember symbol state */
+    for (count = 0, list = symbols; CONSP(list); count++, list = CDR(list)) {
+	symbol = CAR(list);
+	CHECK_SYMBOL(symbol);
+	CHECK_CONSTANT(symbol);
+    }
+    if (count > sizeof(fstk)) {
+	flags = LispMalloc(count);
+	offsets = LispMalloc(count * sizeof(int));
+    }
+    else {
+	flags = &fstk[0];
+	offsets = &ostk[0];
+    }
+
+    /* store flags and save old value if required */
+    for (i = 0, list = symbols; i < count; i++, list = CDR(list)) {
+	atom = CAR(list)->data.atom;
+	if (atom->dyn)
+	    flags[i] = DYNAMIC_SYMBOL;
+	else if (atom->a_object) {
+	    flags[i] = GLOBAL_SYMBOL;
+	    offsets[i] = lisp__data.protect.length;
+	    GC_PROTECT(atom->property->value);
+	}
+	else
+	    flags[i] = UNBOUND_SYMBOL;
+    }
+
+    /* bind the symbols */
+    for (i = 0, list = symbols; i < count; i++, list = CDR(list)) {
+	symbol = CAR(list);
+	atom = symbol->data.atom;
+	if (CONSP(values)) {
+	    value = CAR(values);
+	    values = CDR(values);
+	}
+	else
+	    value = NIL;
+	if (flags[i] != DYNAMIC_SYMBOL) {
+	    if (!atom->a_object)
+		LispSetAtomObjectProperty(atom, value);
+	    else
+		SETVALUE(atom, value);
+	}
+	else
+	    LispAddVar(symbol, value);
+    }
+    /* bind dynamic symbols */
+    lisp__data.env.head = lisp__data.env.length;
+
+    jumped = 0;
+    result = NIL;
+    block = LispBeginBlock(NIL, LispBlockProtect);
+    if (setjmp(block->jmp) == 0) {
+	for (; CONSP(body); body = CDR(body))
+	    result = EVAL(CAR(body));
+    }
+
+    /* restore symbols */
+    for (i = 0, list = symbols; i < count; i++, list = CDR(list)) {
+	symbol = CAR(list);
+	atom = symbol->data.atom;
+	if (flags[i] != DYNAMIC_SYMBOL) {
+	    if (flags[i] == UNBOUND_SYMBOL)
+		LispUnsetVar(symbol);
+	    else {
+		/* restore global symbol value */
+		LispSetAtomObjectProperty(atom, lisp__data.protect.objects
+					  [offsets[i]]);
+		atom->dyn = 0;
+	    }
+	}
+    }
+    /* unbind dynamic symbols */
+    lisp__data.env.head = lisp__data.env.length = head;
+    GC_LEAVE();
+
+    if (count > sizeof(fstk)) {
+	LispFree(flags);
+	LispFree(offsets);
+    }
+
+    LispEndBlock(block);
+    if (!lisp__data.destroyed) {
+	if (jumped)
+	    result = lisp__data.block.block_ret;
+    }
+    else {
+	/* check if there is an unwind-protect block */
+	LispBlockUnwind(NULL);
+
+	/* no unwind-protect block, return to the toplevel */
+	LispDestroy(".");
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Provide(LispBuiltin *builtin)
+/*
+ provide module
+ */
+{
+    LispObj *module, *obj;
+
+    module = ARGUMENT(0);
+
+    CHECK_STRING(module);
+    for (obj = MOD; obj != NIL; obj = CDR(obj)) {
+	if (STRLEN(CAR(obj)) == STRLEN(module) &&
+	    memcmp(THESTR(CAR(obj)), THESTR(module), STRLEN(module)) == 0)
+	    return (module);
+    }
+
+    if (MOD == NIL)
+	MOD = CONS(module, NIL);
+    else {
+	RPLACD(MOD, CONS(CAR(MOD), CDR(MOD)));
+	RPLACA(MOD, module);
+    }
+
+    LispSetVar(lisp__data.modules, MOD);
+
+    return (MOD);
+}
+
+LispObj *
+Lisp_Push(LispBuiltin *builtin)
+/*
+ push item place
+ */
+{
+    LispObj *result, *list;
+
+    LispObj *item, *place;
+
+    place = ARGUMENT(1);
+    item = ARGUMENT(0);
+
+    item = EVAL(item);
+
+    if (SYMBOLP(place)) {
+	list = LispGetVar(place);
+	if (list == NULL)
+	    LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
+	CHECK_CONSTANT(place);
+	LispSetVar(place, result = CONS(item, list));
+    }
+    else {
+	GC_ENTER();
+	LispObj quote;
+
+	list = EVAL(place);
+	result = CONS(item, list);
+	GC_PROTECT(result);
+	quote.type = LispQuote_t;
+	quote.data.quote = result;
+	APPLY2(Osetf, place, &quote);
+	GC_LEAVE();
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Pushnew(LispBuiltin *builtin)
+/*
+ pushnew item place &key key test test-not
+ */
+{
+    GC_ENTER();
+    LispObj *result, *list;
+
+    LispObj *item, *place, *key, *test, *test_not;
+
+    test_not = ARGUMENT(4);
+    test = ARGUMENT(3);
+    key = ARGUMENT(2);
+    place = ARGUMENT(1);
+    item = ARGUMENT(0);
+
+    /* Evaluate place */
+    if (SYMBOLP(place)) {
+	list = LispGetVar(place);
+	if (list == NULL)
+	    LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
+	/* Do error checking now. */
+	CHECK_CONSTANT(place);
+    }
+    else
+	/* It is possible that list is not gc protected? */
+	list = EVAL(place);
+
+    item = EVAL(item);
+    GC_PROTECT(item);
+    if (key != UNSPEC) {
+	key = EVAL(key);
+	GC_PROTECT(key);
+    }
+    if (test != UNSPEC) {
+	test = EVAL(test);
+	GC_PROTECT(test);
+    }
+    else if (test_not != UNSPEC) {
+	test_not = EVAL(test_not);
+	GC_PROTECT(test_not);
+    }
+
+    result = LispAdjoin(builtin, item, list, key, test, test_not);
+
+    /* Item already in list */
+    if (result == list) {
+	GC_LEAVE();
+
+	return (result);
+    }
+
+    if (SYMBOLP(place)) {
+	CHECK_CONSTANT(place);
+	LispSetVar(place, result);
+    }
+    else {
+	LispObj quote;
+
+	GC_PROTECT(result);
+	quote.type = LispQuote_t;
+	quote.data.quote = result;
+	APPLY2(Osetf, place, &quote);
+    }
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Quit(LispBuiltin *builtin)
+/*
+ quit &optional status
+ */
+{
+    int status = 0;
+    LispObj *ostatus;
+
+    ostatus = ARGUMENT(0);
+
+    if (FIXNUMP(ostatus))
+	status = (int)FIXNUM_VALUE(ostatus);
+    else if (ostatus != UNSPEC)
+	LispDestroy("%s: bad exit status argument %s",
+		    STRFUN(builtin), STROBJ(ostatus));
+
+    exit(status);
+}
+
+LispObj *
+Lisp_Quote(LispBuiltin *builtin)
+/*
+ quote object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (object);
+}
+
+LispObj *
+Lisp_Replace(LispBuiltin *builtin)
+/*
+ replace sequence1 sequence2 &key start1 end1 start2 end2
+ */
+{
+    long length, length1, length2, start1, end1, start2, end2;
+    LispObj *sequence1, *sequence2, *ostart1, *oend1, *ostart2, *oend2;
+
+    oend2 = ARGUMENT(5);
+    ostart2 = ARGUMENT(4);
+    oend1 = ARGUMENT(3);
+    ostart1 = ARGUMENT(2);
+    sequence2 = ARGUMENT(1);
+    sequence1 = ARGUMENT(0);
+
+    LispCheckSequenceStartEnd(builtin, sequence1, ostart1, oend1,
+			      &start1, &end1, &length1);
+    LispCheckSequenceStartEnd(builtin, sequence2, ostart2, oend2,
+			      &start2, &end2, &length2);
+
+    if (start1 == end1 || start2 == end2)
+	return (sequence1);
+
+    length = end1 - start1;
+    if (length > end2 - start2)
+	length = end2 - start2;
+
+    if (STRINGP(sequence1)) {
+	CHECK_STRING_WRITABLE(sequence1);
+	if (!STRINGP(sequence2))
+	    LispDestroy("%s: cannot store %s in %s",
+			STRFUN(builtin), STROBJ(sequence2), THESTR(sequence1));
+
+	memmove(THESTR(sequence1) + start1, THESTR(sequence2) + start2, length);
+    }
+    else {
+	int i;
+	LispObj *from, *to;
+
+	if (ARRAYP(sequence1))
+	    sequence1 = sequence1->data.array.list;
+	if (ARRAYP(sequence2))
+	    sequence2 = sequence2->data.array.list;
+
+	/* adjust pointers */
+	for (i = 0, from = sequence2; i < start2; i++, from = CDR(from))
+	    ;
+	for (i = 0, to = sequence1; i < start1; i++, to = CDR(to))
+	    ;
+
+	/* copy data */
+	for (i = 0; i < length; i++, from = CDR(from), to = CDR(to))
+	    RPLACA(to, CAR(from));
+    }
+
+    return (sequence1);
+}
+
+static LispObj *
+LispDeleteOrRemoveDuplicates(LispBuiltin *builtin, int function)
+/*
+ delete-duplicates sequence &key from-end test test-not start end key
+ remove-duplicates sequence &key from-end test test-not start end key
+ */
+{
+    GC_ENTER();
+    int code, expect, value = 0;
+    long i, j, start, end, length, count;
+    LispObj *lambda, *result, *cons, *compare;
+
+    LispObj *sequence, *from_end, *test, *test_not, *ostart, *oend, *key;
+
+    key = ARGUMENT(6);
+    oend = ARGUMENT(5);
+    ostart = ARGUMENT(4);
+    test_not = ARGUMENT(3);
+    test = ARGUMENT(2);
+    from_end = ARGUMENT(1);
+    if (from_end == UNSPEC)
+	from_end = NIL;
+    sequence = ARGUMENT(0);
+
+    LispCheckSequenceStartEnd(builtin, sequence, ostart, oend,
+			      &start, &end, &length);
+
+    /* Check if need to do something */
+    if (start == end)
+	return (sequence);
+
+    CHECK_TEST();
+
+    /* Initialize */
+    count = 0;
+
+    result = cons = NIL;
+    if (STRINGP(sequence)) {
+	char *ptr, *string, *buffer = LispMalloc(length + 1);
+
+	/* Use same code, update start/end offsets */
+	if (from_end != NIL) {
+	    i = length - start;
+	    start = length - end;
+	    end = i;
+	}
+
+	if (from_end == NIL)
+	    string = THESTR(sequence);
+	else {
+	    /* Make a reversed copy of the sequence */
+	    string = LispMalloc(length + 1);
+	    for (ptr = THESTR(sequence) + length - 1, i = 0; i < length; i++)
+		string[i] = *ptr--;
+	    string[i] = '\0';
+	}
+
+	ptr = buffer;
+	/* Copy leading bytes */
+	for (i = 0; i < start; i++)
+	    *ptr++ = string[i];
+
+	compare = SCHAR(string[i]);
+	if (key != UNSPEC)
+	    compare = APPLY1(key, compare);
+	result = cons = CONS(compare, NIL);
+	GC_PROTECT(result);
+	for (++i; i < end; i++) {
+	    compare = SCHAR(string[i]);
+	    if (key != UNSPEC)
+		compare = APPLY1(key, compare);
+	    RPLACD(cons, CONS(compare, NIL));
+	    cons = CDR(cons);
+	}
+
+	for (i = start; i < end; i++, result = CDR(result)) {
+	    compare = CAR(result);
+	    for (j = i + 1, cons = CDR(result); j < end; j++, cons = CDR(cons)) {
+		value = FCOMPARE(lambda, compare, CAR(cons), code);
+		if (value == expect)
+		    break;
+	    }
+	    if (value != expect)
+		*ptr++ = string[i];
+	    else
+		++count;
+	}
+
+	if (count) {
+	    /* Copy ending bytes */
+	    for (; i <= length; i++)   /* Also copy the ending nul */
+		*ptr++ = string[i];
+
+	    if (from_end == NIL)
+		ptr = buffer;
+	    else {
+		for (i = 0, ptr = buffer + strlen(buffer);
+		     ptr > buffer;
+		     i++)
+		    string[i] = *--ptr;
+		string[i] = '\0';
+		ptr = string;
+		LispFree(buffer);
+	    }
+	    if (function == REMOVE)
+		result = STRING2(ptr);
+	    else {
+		CHECK_STRING_WRITABLE(sequence);
+		result = sequence;
+		free(THESTR(result));
+		THESTR(result) = ptr;
+		LispMused(ptr);
+	    }
+	}
+	else {
+	    result = sequence;
+	    if (from_end != NIL)
+		LispFree(string);
+	}
+    }
+    else {
+	long xlength = end - start;
+	LispObj *list, *object, **kobjects = NULL, **xobjects;
+	LispObj **objects = LispMalloc(sizeof(LispObj*) * xlength);
+
+	if (!CONSP(sequence))
+	    object = sequence->data.array.list;
+	else
+	    object = sequence;
+	list = object;
+
+	for (i = 0; i < start; i++)
+	    object = CDR(object);
+
+	/* Put data in a vector */
+	if (from_end == NIL) {
+	    for (i = 0; i < xlength; i++, object = CDR(object))
+		objects[i] = CAR(object);
+	}
+	else {
+	    for (i = xlength - 1; i >= 0; i--, object = CDR(object))
+		objects[i] = CAR(object);
+	}
+
+	/* Apply key predicate if required */
+	if (key != UNSPEC) {
+	    kobjects = LispMalloc(sizeof(LispObj*) * xlength);
+	    for (i = 0; i < xlength; i++) {
+		kobjects[i] = APPLY1(key, objects[i]);
+		GC_PROTECT(kobjects[i]);
+	    }
+	    xobjects = kobjects;
+	}
+	else
+	    xobjects = objects;
+
+	/* Check if needs to remove something */
+	for (i = 0; i < xlength; i++) {
+	    compare = xobjects[i];
+	    for (j = i + 1; j < xlength; j++) {
+		value = FCOMPARE(lambda, compare, xobjects[j], code);
+		if (value == expect) {
+		    objects[i] = NULL;
+		    ++count;
+		    break;
+		}
+	    }
+	}
+
+	if (count) {
+	    /* Create/set result list */
+	    object = list;
+
+	    if (start) {
+		/* Skip first elements of resulting list */
+		if (function == REMOVE) {
+		    result = cons = CONS(CAR(object), NIL);
+		    GC_PROTECT(result);
+		    for (i = 1, object = CDR(object);
+			 i < start;
+			 i++, object = CDR(object)) {
+			RPLACD(cons, CONS(CAR(object), NIL));
+			cons = CDR(cons);
+		    }
+		}
+		else {
+		    result = cons = object;
+		    for (i = 1; i < start; i++, cons = CDR(cons))
+			;
+		}
+	    }
+	    else if (function == DELETE)
+		result = list;
+
+	    /* Skip initial removed elements */
+	    if (function == REMOVE) {
+		for (i = 0; objects[i] == NULL && i < xlength; i++)
+		    ;
+	    }
+	    else
+		i = 0;
+
+	    if (i < xlength) {
+		int xstart, xlimit, xinc;
+
+		if (from_end == NIL) {
+		    xstart = i;
+		    xlimit = xlength;
+		    xinc = 1;
+		}
+		else {
+		    xstart = xlength - 1;
+		    xlimit = i - 1;
+		    xinc = -1;
+		}
+
+		if (function == REMOVE) {
+		    for (i = xstart; i != xlimit; i += xinc) {
+			if (objects[i] != NULL) {
+			    if (result == NIL) {
+				result = cons = CONS(objects[i], NIL);
+				GC_PROTECT(result);
+			    }
+			    else {
+				RPLACD(cons, CONS(objects[i], NIL));
+				cons = CDR(cons);
+			    }
+			}
+		    }
+		}
+		else {
+		    /* Delete duplicates */
+		    for (i = xstart; i != xlimit; i += xinc) {
+			if (objects[i] == NULL) {
+			    if (cons == NIL) {
+				if (CONSP(CDR(result))) {
+				    RPLACA(result, CADR(result));
+				    RPLACD(result, CDDR(result));
+				}
+				else {
+				    RPLACA(result, CDR(result));
+				    RPLACD(result, NIL);
+				}
+			    }
+			    else {
+				if (CONSP(CDR(cons)))
+				    RPLACD(cons, CDDR(cons));
+				else
+				    RPLACD(cons, NIL);
+			    }
+			}
+			else {
+			    if (cons == NIL)
+				cons = result;
+			    else
+				cons = CDR(cons);
+			}
+		    }
+		}
+	    }
+	    if (end < length && function == REMOVE) {
+		for (i = start; i < end; i++, object = CDR(object))
+		    ;
+		if (result == NIL) {
+		    result = cons = CONS(CAR(object), NIL);
+		    GC_PROTECT(result);
+		    ++i;
+		    object = CDR(object);
+		}
+		for (; i < length; i++, object = CDR(object)) {
+		    RPLACD(cons, CONS(CAR(object), NIL));
+		    cons = CDR(cons);
+		}
+	    }
+	}
+	else
+	    result = sequence;
+	LispFree(objects);
+	if (key != UNSPEC)
+	    LispFree(kobjects);
+
+	if (count && !CONSP(sequence)) {
+	    if (function == REMOVE)
+		result = VECTOR(result);
+	    else {
+		length = FIXNUM_VALUE(CAR(sequence->data.array.dim)) - count;
+		CAR(sequence->data.array.dim) = FIXNUM(length);
+		result = sequence;
+	    }
+	}
+    }
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_RemoveDuplicates(LispBuiltin *builtin)
+/*
+ remove-duplicates sequence &key from-end test test-not start end key
+ */
+{
+    return (LispDeleteOrRemoveDuplicates(builtin, REMOVE));
+}
+
+static LispObj *
+LispDeleteRemoveXSubstitute(LispBuiltin *builtin,
+			    int function, int comparison)
+/*
+ delete item sequence &key from-end test test-not start end count key
+ delete-if predicate sequence &key from-end start end count key
+ delete-if-not predicate sequence &key from-end start end count key
+ remove item sequence &key from-end test test-not start end count key
+ remove-if predicate sequence &key from-end start end count key
+ remove-if-not predicate sequence &key from-end start end count key
+ substitute newitem olditem sequence &key from-end test test-not start end count key
+ substitute-if newitem test sequence &key from-end start end count key
+ substitute-if-not newitem test sequence &key from-end start end count key
+ nsubstitute newitem olditem sequence &key from-end test test-not start end count key
+ nsubstitute-if newitem test sequence &key from-end start end count key
+ nsubstitute-if-not newitem test sequence &key from-end start end count key
+ */
+{
+    GC_ENTER();
+    int code, expect, value, inplace, substitute;
+    long i, j, start, end, length, copy, count, xstart, xend, xinc, xlength;
+
+    LispObj *result, *compare;
+
+    LispObj *item, *newitem, *lambda, *sequence, *from_end,
+	    *test, *test_not, *ostart, *oend, *ocount, *key;
+
+    substitute = function == SUBSTITUTE || function == NSUBSTITUTE;
+    if (!substitute)
+	i = comparison == NONE ? 8 : 6;
+    else /* substitute */
+	i = comparison == NONE ? 9 : 7;
+
+    /* Get function arguments */
+    key = ARGUMENT(i);			--i;
+    ocount = ARGUMENT(i);		--i;
+    oend = ARGUMENT(i);			--i;
+    ostart = ARGUMENT(i);		--i;
+    if (comparison == NONE) {
+	test_not = ARGUMENT(i);		--i;
+	test = ARGUMENT(i);		--i;
+    }
+    else
+	test_not = test = UNSPEC;
+    from_end = ARGUMENT(i);		--i;
+    if (from_end == UNSPEC)
+	from_end = NIL;
+    sequence = ARGUMENT(i);		--i;
+    if (comparison != NONE) {
+	lambda = ARGUMENT(i);	--i;
+	if (substitute)
+	    newitem = ARGUMENT(0);
+	else
+	    newitem = NIL;
+	item = NIL;
+    }
+    else {
+	lambda = NIL;
+	if (substitute) {
+	    item = ARGUMENT(1);
+	    newitem = ARGUMENT(0);
+	}
+	else {
+	    item = ARGUMENT(0);
+	    newitem = NIL;
+	}
+    }
+
+    /* Check if argument is a valid sequence, and if start/end
+     * are correctly specified. */
+    LispCheckSequenceStartEnd(builtin, sequence, ostart, oend,
+			      &start, &end, &length);
+
+    /* Check count argument */
+    if (ocount == UNSPEC) {
+	count = length;
+	/* Doesn't matter, but left to right should be slightly faster */
+	from_end = NIL;
+    }
+    else {
+	CHECK_INDEX(ocount);
+	count = FIXNUM_VALUE(ocount);
+    }
+
+    /* Check if need to do something */
+    if (start == end || count == 0)
+	return (sequence);
+
+    CHECK_TEST_0();
+
+    /* Resolve comparison function, and expected result of comparison */
+    if (comparison == NONE) {
+	if (test_not == UNSPEC) {
+	    if (test == UNSPEC)
+		lambda = Oeql;
+	    else
+		lambda = test;
+	    expect = 1;
+	}
+	else {
+	    lambda = test_not;
+	    expect = 0;
+	}
+	FUNCTION_CHECK(lambda);
+    }
+    else
+	expect = comparison == IFNOT ? 0 : 1;
+
+    /* Check for fast path to comparison function */
+    code = FCODE(lambda);
+
+    /* Initialize for loop */
+    copy = count;
+    result = sequence;
+    inplace = function == DELETE || function == NSUBSTITUTE;
+    xlength = end - start;
+
+    /* String is easier */
+    if (STRINGP(sequence)) {
+	char *buffer, *string;
+
+	if (comparison == NONE) {
+	    CHECK_SCHAR(item);
+	}
+	if (substitute) {
+	    CHECK_SCHAR(newitem);
+	}
+
+	if (from_end == NIL) {
+	    xstart = start;
+	    xend = end;
+	    xinc = 1;
+	}
+	else {
+	    xstart = end - 1;
+	    xend = start - 1;
+	    xinc = -1;
+	}
+
+	string = THESTR(sequence);
+	buffer = LispMalloc(length + 1);
+
+	/* Copy leading bytes, if any */
+	for (i = 0; i < start; i++)
+	    buffer[i] = string[i];
+
+	for (j = xstart; i != xend && count > 0; i += xinc) {
+	    compare = SCHAR(string[i]);
+	    if (key != UNSPEC) {
+		compare = APPLY1(key, compare);
+		/* Value returned by the key predicate may not be protected */
+		GC_PROTECT(compare);
+		if (comparison == NONE)
+		    value = FCOMPARE(lambda, item, compare, code);
+		else
+		    value = APPLY1(lambda, compare) != NIL;
+		/* Unprotect value returned by the key predicate */
+		GC_LEAVE();
+	    }
+	    else {
+		if (comparison == NONE)
+		    value = FCOMPARE(lambda, item, compare, code);
+		else
+		    value = APPLY1(lambda, compare) != NIL;
+	    }
+
+	    if (value != expect) {
+		buffer[j] = string[i];
+		j += xinc;
+	    }
+	    else {
+		if (substitute) {
+		    buffer[j] = SCHAR_VALUE(newitem);
+		    j += xinc;
+		}
+		else
+		    --count;
+	    }
+	}
+
+	if (count != copy && from_end != NIL)
+	    memmove(buffer + start, buffer + copy - count, count);
+
+	/* Copy remaining bytes, if any */
+	for (; i < length; i++, j++)
+	    buffer[j] = string[i];
+	buffer[j] = '\0';
+
+	xlength = length - (copy - count);
+	if (inplace) {
+	    CHECK_STRING_WRITABLE(sequence);
+	    /* result is a pointer to sequence */
+	    LispFree(THESTR(sequence));
+	    LispMused(buffer);
+	    THESTR(sequence) = buffer;
+	    STRLEN(sequence) = xlength;
+	}
+	else
+	    result = LSTRING2(buffer, xlength);
+    }
+
+    /* If inplace, need to update CAR and CDR of sequence */
+    else {
+	LispObj *list, *object;
+	LispObj **objects = LispMalloc(sizeof(LispObj*) * xlength);
+
+	if (!CONSP(sequence))
+	    list = sequence->data.array.list;
+	else
+	    list = sequence;
+
+	/* Put data in a vector */
+	for (i = 0, object = list; i < start; i++)
+	    object = CDR(object);
+
+	for (i = 0; i < xlength; i++, object = CDR(object))
+	    objects[i] = CAR(object);
+
+	if (from_end == NIL) {
+	    xstart = 0;
+	    xend = xlength;
+	    xinc = 1;
+	}
+	else {
+	    xstart = xlength - 1;
+	    xend = -1;
+	    xinc = -1;
+	}
+
+	/* Check if needs to remove something */
+	for (i = xstart; i != xend && count > 0; i += xinc) {
+	    compare = objects[i];
+	    if (key != UNSPEC) {
+		compare = APPLY1(key, compare);
+		GC_PROTECT(compare);
+		if (comparison == NONE)
+		    value = FCOMPARE(lambda, item, compare, code);
+		else
+		    value = APPLY1(lambda, compare) != NIL;
+		GC_LEAVE();
+	    }
+	    else {
+		if (comparison == NONE)
+		    value = FCOMPARE(lambda, item, compare, code);
+		else
+		    value = APPLY1(lambda, compare) != NIL;
+	    }
+	    if (value == expect) {
+		if (substitute)
+		    objects[i] = newitem;
+		else
+		    objects[i] = NULL;
+		--count;
+	    }
+	}
+
+	if (copy != count) {
+	    LispObj *cons = NIL;
+
+	    i = 0;
+	    object = list;
+	    if (inplace) {
+		/* While result is NIL, skip initial elements of sequence */
+		result = start ? list : NIL;
+
+		/* Skip initial elements, if any */
+		for (; i < start; i++, cons = object, object = CDR(object))
+		    ;
+	    }
+	    /* Copy initial elements, if any */
+	    else {
+		result = NIL;
+		if (start) {
+		    result = cons = CONS(CAR(list), NIL);
+		    GC_PROTECT(result);
+		    for (++i, object = CDR(list);
+			 i < start;
+			 i++, object = CDR(object)) {
+			RPLACD(cons, CONS(CAR(object), NIL));
+		 	cons = CDR(cons);
+		    }
+		}
+	    }
+
+	    /* Skip initial removed elements, if any */
+	    for (i = 0; objects[i] == NULL && i < xlength; i++)
+		;
+
+	    for (i = 0; i < xlength; i++, object = CDR(object)) {
+		if (objects[i]) {
+		    if (inplace) {
+			if (result == NIL)
+			    result = cons = object;
+			else {
+			    RPLACD(cons, object);
+			    cons = CDR(cons);
+			}
+			if (function == NSUBSTITUTE)
+			    RPLACA(cons, objects[i]);
+		    }
+		    else {
+			if (result == NIL) {
+			    result = cons = CONS(objects[i], NIL);
+			    GC_PROTECT(result);
+			}
+			else {
+			    RPLACD(cons, CONS(objects[i], NIL));
+			    cons = CDR(cons);
+			}
+		    }
+		}
+	    }
+
+	    if (inplace) {
+		if (result == NIL)
+		    result = object;
+		else
+		    RPLACD(cons, object);
+
+		if (!CONSP(sequence)) {
+		    result = sequence;
+		    CAR(result)->data.array.dim =
+			FIXNUM(length - (copy - count));
+		}
+	    }
+	    else if (end < length) {
+		i = end;
+		/* Copy ending elements, if any */
+		if (result == NIL) {
+		    result = cons = CONS(CAR(object), NIL);
+		    GC_PROTECT(result);
+		    object = CDR(object);
+		    i++;
+		}
+		for (; i < length; i++, object = CDR(object)) {
+		    RPLACD(cons, CONS(CAR(object), NIL));
+		    cons = CDR(cons);
+		}
+	    }
+	}
+
+	/* Release comparison vector */
+	LispFree(objects);
+    }
+
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Remove(LispBuiltin *builtin)
+/*
+ remove item sequence &key from-end test test-not start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, REMOVE, NONE));
+}
+
+LispObj *
+Lisp_RemoveIf(LispBuiltin *builtin)
+/*
+ remove-if predicate sequence &key from-end start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, REMOVE, IF));
+}
+
+LispObj *
+Lisp_RemoveIfNot(LispBuiltin *builtin)
+/*
+ remove-if-not predicate sequence &key from-end start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, REMOVE, IFNOT));
+}
+
+LispObj *
+Lisp_Remprop(LispBuiltin *builtin)
+/*
+ remprop symbol indicator
+ */
+{
+    LispObj *symbol, *indicator;
+
+    indicator = ARGUMENT(1);
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+
+    return (LispRemAtomProperty(symbol->data.atom, indicator));
+}
+
+LispObj *
+Lisp_Return(LispBuiltin *builtin)
+/*
+ return &optional result
+ */
+{
+    unsigned blevel = lisp__data.block.block_level;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    while (blevel) {
+	LispBlock *block = lisp__data.block.block[--blevel];
+
+	if (block->type == LispBlockClosure)
+	    /* if reached a function call */
+	    break;
+	if (block->type == LispBlockTag && block->tag == NIL) {
+	    lisp__data.block.block_ret = result == UNSPEC ? NIL : EVAL(result);
+	    LispBlockUnwind(block);
+	    BLOCKJUMP(block);
+	}
+    }
+    LispDestroy("%s: no visible NIL block", STRFUN(builtin));
+
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+Lisp_ReturnFrom(LispBuiltin *builtin)
+/*
+ return-from name &optional result
+ */
+{
+    unsigned blevel = lisp__data.block.block_level;
+
+    LispObj *name, *result;
+
+    result = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    if (name != NIL && name != T && !SYMBOLP(name))
+	LispDestroy("%s: %s is not a valid block name",
+		    STRFUN(builtin), STROBJ(name));
+
+    while (blevel) {
+	LispBlock *block = lisp__data.block.block[--blevel];
+
+	if (name == block->tag &&
+	    (block->type == LispBlockTag || block->type == LispBlockClosure)) {
+	    lisp__data.block.block_ret = result == UNSPEC ? NIL : EVAL(result);
+	    LispBlockUnwind(block);
+	    BLOCKJUMP(block);
+	}
+	if (block->type == LispBlockClosure)
+	    /* can use return-from only in the current function */
+	    break;
+    }
+    LispDestroy("%s: no visible block named %s",
+		STRFUN(builtin), STROBJ(name));
+
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+static LispObj *
+LispXReverse(LispBuiltin *builtin, int inplace)
+/*
+ nreverse sequence
+ reverse sequence
+ */
+{
+    long length;
+    LispObj *list, *result = NIL;
+
+    LispObj *sequence;
+
+    sequence = ARGUMENT(0);
+
+    /* Do error checking for arrays and object type. */
+    length = LispLength(sequence);
+    if (length <= 1)
+	return (sequence);
+
+    switch (XOBJECT_TYPE(sequence)) {
+	case LispString_t: {
+	    long i;
+	    char *from, *to;
+
+	    from = THESTR(sequence) + length - 1;
+	    if (inplace) {
+		char temp;
+
+		CHECK_STRING_WRITABLE(sequence);
+		to = THESTR(sequence);
+		for (i = 0; i < length / 2; i++) {
+		    temp = to[i];
+		    to[i] = from[-i];
+		    from[-i] = temp;
+		}
+		result = sequence;
+	    }
+	    else {
+		to = LispMalloc(length + 1);
+		to[length] = '\0';
+		for (i = 0; i < length; i++)
+		    to[i] = from[-i];
+		result = STRING2(to);
+	    }
+	}   return (result);
+	case LispCons_t:
+	    if (inplace) {
+		long i, j;
+		LispObj *temp;
+
+		/* For large lists this can be very slow, but for small
+		 * amounts of data, this avoid allocating a buffer to
+		 * to store the CAR of the sequence. This is only done
+		 * to not destroy the contents of a variable.
+		 */
+		for (i = 0, list = sequence;
+		     i < (length + 1) / 2;
+		     i++, list = CDR(list))
+		    ;
+		length /= 2;
+		for (i = 0; i < length; i++, list = CDR(list)) {
+		    for (j = length - i - 1, result = sequence;
+			 j > 0;
+			 j--, result = CDR(result))
+			;
+		    temp = CAR(list);
+		    RPLACA(list, CAR(result));
+		    RPLACA(result, temp);
+		}
+		return (sequence);
+	    }
+	    list = sequence;
+	    break;
+	case LispArray_t:
+	    if (inplace) {
+		sequence->data.array.list =
+		    LispReverse(sequence->data.array.list);
+		return (sequence);
+	    }
+	    list = sequence->data.array.list;
+	    break;
+	default:	/* LispNil_t */
+	    return (result);
+    }
+
+    {
+	GC_ENTER();
+	LispObj *cons;
+
+	result = cons = CONS(CAR(list), NIL);
+	GC_PROTECT(result);
+	for (list = CDR(list); CONSP(list); list = CDR(list)) {
+	    RPLACD(cons, CONS(CAR(list), NIL));
+	    cons = CDR(cons);
+	}
+	result = LispReverse(result);
+
+	GC_LEAVE();
+    }
+
+    if (ARRAYP(sequence)) {
+	list = result;
+
+	result = LispNew(list, NIL);
+	result->type = LispArray_t;
+	result->data.array.list = list;
+	result->data.array.dim = sequence->data.array.dim;
+	result->data.array.rank = sequence->data.array.rank;
+	result->data.array.type = sequence->data.array.type;
+	result->data.array.zero = sequence->data.array.zero;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Reverse(LispBuiltin *builtin)
+/*
+ reverse sequence
+ */
+{
+    return (LispXReverse(builtin, 0));
+}
+
+LispObj *
+Lisp_Rplaca(LispBuiltin *builtin)
+/*
+ rplaca place value
+ */
+{
+    LispObj *place, *value;
+
+    value = ARGUMENT(1);
+    place = ARGUMENT(0);
+
+    CHECK_CONS(place);
+    RPLACA(place, value);
+
+    return (place);
+}
+
+LispObj *
+Lisp_Rplacd(LispBuiltin *builtin)
+/*
+ rplacd place value
+ */
+{
+    LispObj *place, *value;
+
+    value = ARGUMENT(1);
+    place = ARGUMENT(0);
+
+    CHECK_CONS(place);
+    RPLACD(place, value);
+
+    return (place);
+}
+
+LispObj *
+Lisp_Search(LispBuiltin *builtin)
+/*
+ search sequence1 sequence2 &key from-end test test-not key start1 start2 end1 end2
+ */
+{
+    int code = 0, expect, value;
+    long start1, start2, end1, end2, length1, length2, off1, off2, offset = -1;
+    LispObj *cmp1, *cmp2, *list1 = NIL, *lambda;
+    SeqInfo seq1, seq2;
+
+    LispObj *sequence1, *sequence2, *from_end, *test, *test_not,
+	    *key, *ostart1, *ostart2, *oend1, *oend2;
+
+    oend2 = ARGUMENT(9);
+    oend1 = ARGUMENT(8);
+    ostart2 = ARGUMENT(7);
+    ostart1 = ARGUMENT(6);
+    key = ARGUMENT(5);
+    test_not = ARGUMENT(4);
+    test = ARGUMENT(3);
+    from_end = ARGUMENT(2);
+    sequence2 = ARGUMENT(1);
+    sequence1 = ARGUMENT(0);
+
+    LispCheckSequenceStartEnd(builtin, sequence1, ostart1, oend1,
+			      &start1, &end1, &length1);
+    LispCheckSequenceStartEnd(builtin, sequence2, ostart2, oend2,
+			      &start2, &end2, &length2);
+
+    /* Check for special conditions */
+    if (start1 == end1)
+	return (FIXNUM(end2));
+    else if (start2 == end2)
+	return (start1 == end1 ? FIXNUM(start2) : NIL);
+
+    CHECK_TEST();
+
+    if (from_end == UNSPEC)
+	from_end = NIL;
+
+    SETSEQ(seq1, sequence1);
+    SETSEQ(seq2, sequence2);
+
+    length1 = end1 - start1;
+    length2 = end2 - start2;
+
+    /* update start of sequences */
+    if (start1) {
+	if (seq1.type == LispString_t)
+	    seq1.data.string += start1;
+	else {
+	    for (cmp1 = seq1.data.list; start1; cmp1 = CDR(cmp1), --start1)
+		;
+	    seq1.data.list = cmp1;
+	}
+	end1 = length1;
+    }
+    if (start2) {
+	if (seq2.type == LispString_t)
+	    seq2.data.string += start2;
+	else {
+	    for (cmp2 = seq2.data.list; start2; cmp2 = CDR(cmp2), --start2)
+		;
+	    seq2.data.list = cmp2;
+	}
+	end2 = length2;
+    }
+
+    /* easier case */
+    if (from_end == NIL) {
+	LispObj *list2 = NIL;
+
+	/* while a match is possible */
+	while (end2 - start2 >= length1) {
+
+	    /* prepare to search */
+	    off1 = 0;
+	    off2 = start2;
+	    if (seq1.type != LispString_t)
+		list1 = seq1.data.list;
+	    if (seq2.type != LispString_t)
+		list2 = seq2.data.list;
+
+	    /* for every element that must match in sequence1 */
+	    while (off1 < length1) {
+		if (seq1.type == LispString_t)
+		    cmp1 = SCHAR(seq1.data.string[off1]);
+		else
+		    cmp1 = CAR(list1);
+		if (seq2.type == LispString_t)
+		    cmp2 = SCHAR(seq2.data.string[off2]);
+		else
+		    cmp2 = CAR(list2);
+		if (key != UNSPEC) {
+		    cmp1 = APPLY1(key, cmp1);
+		    cmp2 = APPLY1(key, cmp2);
+		}
+
+		/* compare elements */
+		value = FCOMPARE(lambda, cmp1, cmp2, code);
+		if (value != expect)
+		    break;
+
+		/* update offsets/sequence pointers */
+		++off1;
+		++off2;
+		if (seq1.type != LispString_t)
+		    list1 = CDR(list1);
+		if (seq2.type != LispString_t)
+		    list2 = CDR(list2);
+	    }
+
+	    /* if everything matched */
+	    if (off1 == end1) {
+		offset = off2 - length1;
+		break;
+	    }
+
+	    /* update offset/sequence2 pointer */
+	    ++start2;
+	    if (seq2.type != LispString_t)
+		seq2.data.list = CDR(seq2.data.list);
+	}
+    }
+    else {
+	/* allocate vector if required, only list2 requires it.
+	 * list1 can be traversed forward */
+	if (seq2.type != LispString_t) {
+	    cmp2 = seq2.data.list;
+	    seq2.data.vector = LispMalloc(sizeof(LispObj*) * length2);
+	    for (off2 = 0; off2 < end2; off2++, cmp2 = CDR(cmp2))
+		seq2.data.vector[off2] = CAR(cmp2);
+	}
+
+	/* while a match is possible */
+	while (end2 >= length1) {
+
+	    /* prepare to search */
+	    off1 = 0;
+	    off2 = end2 - length1;
+	    if (seq1.type != LispString_t)
+		list1 = seq1.data.list;
+
+	    /* for every element that must match in sequence1 */
+	    while (off1 < end1) {
+		if (seq1.type == LispString_t)
+		    cmp1 = SCHAR(seq1.data.string[off1]);
+		else
+		    cmp1 = CAR(list1);
+		if (seq2.type == LispString_t)
+		    cmp2 = SCHAR(seq2.data.string[off2]);
+		else
+		    cmp2 = seq2.data.vector[off2];
+		if (key != UNSPEC) {
+		    cmp1 = APPLY1(key, cmp1);
+		    cmp2 = APPLY1(key, cmp2);
+		}
+
+		/* Compare elements */
+		value = FCOMPARE(lambda, cmp1, cmp2, code);
+		if (value != expect)
+		    break;
+
+		/* Update offsets */
+		++off1;
+		++off2;
+		if (seq1.type != LispString_t)
+		    list1 = CDR(list1);
+	    }
+
+	    /* If all elements matched */
+	    if (off1 == end1) {
+		offset = off2 - length1;
+		break;
+	    }
+
+	    /* Update offset */
+	    --end2;
+	}
+
+	if (seq2.type != LispString_t)
+	    LispFree(seq2.data.vector);
+    }
+
+    return (offset == -1 ? NIL : FIXNUM(offset));
+}
+
+/*
+ * ext::getenv
+ */
+LispObj *
+Lisp_Setenv(LispBuiltin *builtin)
+/*
+ setenv name value &optional overwrite
+ */
+{
+    char *name, *value;
+
+    LispObj *oname, *ovalue, *overwrite;
+
+    overwrite = ARGUMENT(2);
+    ovalue = ARGUMENT(1);
+    oname = ARGUMENT(0);
+
+    CHECK_STRING(oname);
+    name = THESTR(oname);
+
+    CHECK_STRING(ovalue);
+    value = THESTR(ovalue);
+
+    setenv(name, value, overwrite != UNSPEC && overwrite != NIL);
+    value = getenv(name);
+
+    return (value ? STRING(value) : NIL);
+}
+
+LispObj *
+Lisp_Set(LispBuiltin *builtin)
+/*
+ set symbol value
+ */
+{
+    LispAtom *atom;
+    LispObj *symbol, *value;
+
+    value = ARGUMENT(1);
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+    atom = symbol->data.atom;
+    if (atom->dyn)
+	LispSetVar(symbol, value);
+    else if (atom->watch || !atom->a_object)
+	LispSetAtomObjectProperty(atom, value);
+    else {
+	CHECK_CONSTANT(symbol);
+	SETVALUE(atom, value);
+    }
+
+    return (value);
+}
+
+LispObj *
+Lisp_SetDifference(LispBuiltin *builtin)
+/*
+ set-difference list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, SETDIFFERENCE));
+}
+
+LispObj *
+Lisp_SetExclusiveOr(LispBuiltin *builtin)
+/*
+ set-exclusive-or list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, SETEXCLUSIVEOR));
+}
+
+LispObj *
+Lisp_NsetExclusiveOr(LispBuiltin *builtin)
+/*
+ nset-exclusive-or list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, NSETEXCLUSIVEOR));
+}
+
+LispObj *
+Lisp_SetQ(LispBuiltin *builtin)
+/*
+ setq &rest form
+ */
+{
+    LispObj *result, *variable, *form;
+
+    form = ARGUMENT(0);
+
+    result = NIL;
+    for (; CONSP(form); form = CDR(form)) {
+	variable = CAR(form);
+	CHECK_SYMBOL(variable);
+	CHECK_CONSTANT(variable);
+	form = CDR(form);
+	if (!CONSP(form))
+	    LispDestroy("%s: odd number of arguments", STRFUN(builtin));
+	result = EVAL(CAR(form));
+	LispSetVar(variable, result);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Psetq(LispBuiltin *builtin)
+/*
+ psetq &rest form
+ */
+{
+    GC_ENTER();
+    int base = gc__protect;
+    LispObj *value, *symbol, *list, *form;
+
+    form = ARGUMENT(0);
+
+    /* parallel setq, first pass evaluate values and basic error checking */
+    for (list = form; CONSP(list); list = CDR(list)) {
+	symbol = CAR(list);
+	CHECK_SYMBOL(symbol);
+	list = CDR(list);
+	if (!CONSP(list))
+	    LispDestroy("%s: odd number of arguments", STRFUN(builtin));
+	value = EVAL(CAR(list));
+	GC_PROTECT(value);
+    }
+
+    /* second pass, assign values */
+    for (; CONSP(form); form = CDDR(form)) {
+	symbol = CAR(form);
+	CHECK_CONSTANT(symbol);
+	LispSetVar(symbol, lisp__data.protect.objects[base++]);
+    }
+    GC_LEAVE();
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Setf(LispBuiltin *builtin)
+/*
+ setf &rest form
+ */
+{
+    LispAtom *atom;
+    LispObj *setf, *place, *value, *result = NIL, *data;
+
+    LispObj *form;
+
+    form = ARGUMENT(0);
+
+    for (; CONSP(form); form = CDR(form)) {
+	place = CAR(form);
+	form = CDR(form);
+	if (!CONSP(form))
+	    LispDestroy("%s: odd number of arguments", STRFUN(builtin));
+	value = CAR(form);
+
+	if (!POINTERP(place))
+	    goto invalid_place;
+	if (XSYMBOLP(place)) {
+	    CHECK_CONSTANT(place);
+	    result = EVAL(value);
+	    (void)LispSetVar(place, result);
+	}
+	else if (XCONSP(place)) {
+	    /* it really should not be required to protect any object
+	     * evaluated here, but is done for safety in case one of
+	     * the evaluated forms returns data not gc protected, what
+	     * could cause surprises if the object is garbage collected
+	     * before finishing setf. */
+	    GC_ENTER();
+
+	    setf = CAR(place);
+	    if (!SYMBOLP(setf))
+		goto invalid_place;
+	    if (!CONSP(CDR(place)))
+		goto invalid_place;
+
+	    value = EVAL(value);
+	    GC_PROTECT(value);
+
+	    atom = setf->data.atom;
+	    if (atom->a_defsetf == 0) {
+		if (atom->a_defstruct &&
+		    atom->property->structure.function >= 0) {
+		    /* Use a default setf method for the structure field, as
+		     * if this definition have been done
+		     *	(defsetf THE-STRUCT-FIELD (struct) (value)
+		     *	 `(lisp::struct-store 'THE-STRUCT-FIELD ,struct ,value))
+		     */
+		    place = CDR(place);
+		    data = CAR(place);
+		    if (CONSP(CDR(place)))
+			goto invalid_place;
+		    data = EVAL(data);
+		    GC_PROTECT(data);
+		    result = APPLY3(Ostruct_store, setf, data, value);
+		    GC_LEAVE();
+		    continue;
+		}
+		/* Must also expand macros */
+		else if (atom->a_function &&
+			 atom->property->fun.function->funtype == LispMacro) {
+		    result = LispRunSetfMacro(atom, CDR(place), value);
+		    continue;
+		}
+		goto invalid_place;
+	    }
+
+	    place = CDR(place);
+	    setf = setf->data.atom->property->setf;
+	    if (SYMBOLP(setf)) {
+		LispObj *arguments, *cons;
+
+		if (!CONSP(CDR(place))) {
+		    arguments = EVAL(CAR(place));
+		    GC_PROTECT(arguments);
+		    result = APPLY2(setf, arguments, value);
+		}
+		else if (!CONSP(CDDR(place))) {
+		    arguments = EVAL(CAR(place));
+		    GC_PROTECT(arguments);
+		    cons = EVAL(CADR(place));
+		    GC_PROTECT(cons);
+		    result = APPLY3(setf, arguments, cons, value);
+		}
+		else {
+		    arguments = cons = CONS(EVAL(CAR(place)), NIL);
+		    GC_PROTECT(arguments);
+		    for (place = CDR(place); CONSP(place); place = CDR(place)) {
+			RPLACD(cons, CONS(EVAL(CAR(place)), NIL));
+			cons = CDR(cons);
+		    }
+		    RPLACD(cons, CONS(value, NIL));
+		    result = APPLY(setf, arguments);
+		}
+	    }
+	    else
+		result = LispRunSetf(atom->property->salist, setf, place, value);
+	    GC_LEAVE();
+	}
+	else
+	    goto invalid_place;
+    }
+
+    return (result);
+invalid_place:
+    LispDestroy("%s: %s is an invalid place", STRFUN(builtin), STROBJ(place));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+Lisp_Psetf(LispBuiltin *builtin)
+/*
+ psetf &rest form
+ */
+{
+    int base;
+    GC_ENTER();
+    LispAtom *atom;
+    LispObj *setf, *place = NIL, *value, *data;
+
+    LispObj *form;
+
+    form = ARGUMENT(0);
+
+    /* parallel setf, first pass evaluate values and basic error checking */
+    base = gc__protect;
+    for (setf = form; CONSP(setf); setf = CDR(setf)) {
+	if (!POINTERP(CAR(setf)))
+	    goto invalid_place;
+	setf = CDR(setf);
+	if (!CONSP(setf))
+	    LispDestroy("%s: odd number of arguments", STRFUN(builtin));
+	value = EVAL(CAR(setf));
+	GC_PROTECT(value);
+    }
+
+    /* second pass, assign values */
+    for (; CONSP(form); form = CDDR(form)) {
+	place = CAR(form);
+	value = lisp__data.protect.objects[base++];
+
+	if (XSYMBOLP(place)) {
+	    CHECK_CONSTANT(place);
+	    (void)LispSetVar(place, value);
+	}
+	else if (XCONSP(place)) {
+	    LispObj *arguments, *cons;
+	    int xbase = lisp__data.protect.length;
+
+	    setf = CAR(place);
+	    if (!SYMBOLP(setf))
+		goto invalid_place;
+	    if (!CONSP(CDR(place)))
+		goto invalid_place;
+
+	    atom = setf->data.atom;
+	    if (atom->a_defsetf == 0) {
+		if (atom->a_defstruct &&
+		    atom->property->structure.function >= 0) {
+		    place = CDR(place);
+		    data = CAR(place);
+		    if (CONSP(CDR(place)))
+			goto invalid_place;
+		    data = EVAL(data);
+		    GC_PROTECT(data);
+		    (void)APPLY3(Ostruct_store, setf, data, value);
+		    lisp__data.protect.length = xbase;
+		    continue;
+		}
+		else if (atom->a_function &&
+			 atom->property->fun.function->funtype == LispMacro) {
+		    (void)LispRunSetfMacro(atom, CDR(place), value);
+		    lisp__data.protect.length = xbase;
+		    continue;
+		}
+		goto invalid_place;
+	    }
+
+	    place = CDR(place);
+	    setf = setf->data.atom->property->setf;
+	    if (SYMBOLP(setf)) {
+		if (!CONSP(CDR(place))) {
+		    arguments = EVAL(CAR(place));
+		    GC_PROTECT(arguments);
+		    (void)APPLY2(setf, arguments, value);
+		}
+		else if (!CONSP(CDDR(place))) {
+		    arguments = EVAL(CAR(place));
+		    GC_PROTECT(arguments);
+		    cons = EVAL(CADR(place));
+		    GC_PROTECT(cons);
+		    (void)APPLY3(setf, arguments, cons, value);
+		}
+		else {
+		    arguments = cons = CONS(EVAL(CAR(place)), NIL);
+		    GC_PROTECT(arguments);
+		    for (place = CDR(place); CONSP(place); place = CDR(place)) {
+			RPLACD(cons, CONS(EVAL(CAR(place)), NIL));
+			cons = CDR(cons);
+		    }
+		    RPLACD(cons, CONS(value, NIL));
+		    (void)APPLY(setf, arguments);
+		}
+		lisp__data.protect.length = xbase;
+	    }
+	    else
+		(void)LispRunSetf(atom->property->salist, setf, place, value);
+	}
+	else
+	    goto invalid_place;
+    }
+    GC_LEAVE();
+
+    return (NIL);
+invalid_place:
+    LispDestroy("%s: %s is an invalid place", STRFUN(builtin), STROBJ(place));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+Lisp_Sleep(LispBuiltin *builtin)
+/*
+ sleep seconds
+ */
+{
+    long sec, msec;
+    double value, dsec;
+
+    LispObj *seconds;
+
+    seconds = ARGUMENT(0);
+
+    value = -1.0;
+    switch (OBJECT_TYPE(seconds)) {
+	case LispFixnum_t:
+	    value = FIXNUM_VALUE(seconds);
+	    break;
+	case LispDFloat_t:
+	    value = DFLOAT_VALUE(seconds);
+	    break;
+	default:
+	    break;
+    }
+
+    if (value < 0.0 || value > MOST_POSITIVE_FIXNUM)
+	LispDestroy("%s: %s is not a positive fixnum",
+		    STRFUN(builtin), STROBJ(seconds));
+
+    msec = modf(value, &dsec) * 1e6;
+    sec = dsec;
+
+    if (sec)
+	sleep(sec);
+    if (msec)
+	usleep(msec);
+
+    return (NIL);
+}
+
+/*
+ *   This function is called recursively, but the contents of "list2" are
+ * kept gc protected until it returns to LispSort. This is required partly
+ * because the "gc protection logic" protects an object, not the contents
+ * of the c pointer.
+ */
+static LispObj *
+LispMergeSort(LispObj *list, LispObj *predicate, LispObj *key, int code)
+{
+    int protect;
+    LispObj *list1, *list2, *left, *right, *result, *cons;
+
+    /* Check if list length is larger than 1 */
+    if (!CONSP(list) || !CONSP(CDR(list)))
+	return (list);
+
+    list1 = list2 = list;
+    for (;;) {
+	list = CDR(list);
+	if (!CONSP(list))
+	    break;
+	list = CDR(list);
+	if (!CONSP(list))
+	    break;
+	list2 = CDR(list2);
+    }
+    cons = list2;
+    list2 = CDR(list2);
+    RPLACD(cons, NIL);
+
+    protect = 0;
+    if (lisp__data.protect.length + 2 >= lisp__data.protect.space)
+	LispMoreProtects();
+    lisp__data.protect.objects[lisp__data.protect.length++] = list2;
+    list1 = LispMergeSort(list1, predicate, key, code);
+    list2 = LispMergeSort(list2, predicate, key, code);
+
+    left = CAR(list1);
+    right = CAR(list2);
+    if (key != UNSPEC) {
+	protect = lisp__data.protect.length;
+	left = APPLY1(key, left);
+	lisp__data.protect.objects[protect] = left;
+	right = APPLY1(key, right);
+	lisp__data.protect.objects[protect + 1] = right;
+    }
+
+    result = NIL;
+    for (;;) {
+	if ((FCOMPARE(predicate, left, right, code)) == 0 &&
+	    (FCOMPARE(predicate, right, left, code)) == 1) {
+	    /* right is "smaller" */
+	    if (result == NIL)
+		result = list2;
+	    else
+		RPLACD(cons, list2);
+	    cons = list2;
+	    list2 = CDR(list2);
+	    if (!CONSP(list2)) {
+		RPLACD(cons, list1);
+		break;
+	    }
+	    right = CAR(list2);
+	    if (key != UNSPEC) {
+		right = APPLY1(key, right);
+		lisp__data.protect.objects[protect + 1] = right;
+	    }
+	}
+	else {
+	    /* left is "smaller" */
+	    if (result == NIL)
+		result = list1;
+	    else
+		RPLACD(cons, list1);
+	    cons = list1;
+	    list1 = CDR(list1);
+	    if (!CONSP(list1)) {
+		RPLACD(cons, list2);
+		break;
+	    }
+	    left = CAR(list1);
+	    if (key != UNSPEC) {
+		left = APPLY1(key, left);
+		lisp__data.protect.objects[protect] = left;
+	    }
+	}
+    }
+    if (key != UNSPEC)
+	lisp__data.protect.length = protect;
+
+    return (result);
+}
+
+/* XXX The first version made a copy of the list and then adjusted
+ *     the CARs of the list. To minimize GC time now it is now doing
+ *     the sort inplace. So, instead of writing just (sort variable)
+ *     now it is required to write (setq variable (sort variable))
+ *     if the variable should always keep all elements.
+ */
+LispObj *
+Lisp_Sort(LispBuiltin *builtin)
+/*
+ sort sequence predicate &key key
+ */
+{
+    GC_ENTER();
+    int istring, code;
+    long length;
+    char *string;
+
+    LispObj *list, *work, *cons = NULL;
+
+    LispObj *sequence, *predicate, *key;
+
+    key = ARGUMENT(2);
+    predicate = ARGUMENT(1);
+    sequence = ARGUMENT(0);
+
+    length = LispLength(sequence);
+    if (length < 2)
+	return (sequence);
+
+    list = sequence;
+    istring = XSTRINGP(sequence);
+    if (istring) {
+	CHECK_STRING_WRITABLE(sequence);
+	/* Convert string to list */
+	string = THESTR(sequence);
+	work = cons = CONS(SCHAR(string[0]), NIL);
+	GC_PROTECT(work);
+	for (++string; *string; ++string) {
+	    RPLACD(cons, CONS(SCHAR(*string), NIL));
+	    cons = CDR(cons);
+	}
+    }
+    else if (ARRAYP(list))
+	work = list->data.array.list;
+    else
+	work = list;
+
+    FUNCTION_CHECK(predicate);
+    code = FCODE(predicate);
+    work = LispMergeSort(work, predicate, key, code);
+
+    if (istring) {
+	/* Convert list to string */
+	string = THESTR(sequence);
+	for (; CONSP(work); ++string, work = CDR(work))
+	    *string = SCHAR_VALUE(CAR(work));
+    }
+    else if (ARRAYP(list))
+	list->data.array.list = work;
+    else
+	sequence = work;
+    GC_LEAVE();
+
+    return (sequence);
+}
+
+LispObj *
+Lisp_Subseq(LispBuiltin *builtin)
+/*
+ subseq sequence start &optional end
+ */
+{
+    long start, end, length, seqlength;
+
+    LispObj *sequence, *ostart, *oend, *result;
+
+    oend = ARGUMENT(2);
+    ostart = ARGUMENT(1);
+    sequence = ARGUMENT(0);
+
+    LispCheckSequenceStartEnd(builtin, sequence, ostart, oend,
+			      &start, &end, &length);
+
+    seqlength = end - start;
+
+    if (sequence == NIL)
+	result = NIL;
+    else if (XSTRINGP(sequence)) {
+	char *string = LispMalloc(seqlength + 1);
+
+	memcpy(string, THESTR(sequence) + start, seqlength);
+	string[seqlength] = '\0';
+	result = STRING2(string);
+    }
+    else {
+	GC_ENTER();
+	LispObj *object;
+
+	if (end > start) {
+	    /* list or array */
+	    int count;
+	    LispObj *cons;
+
+	    if (ARRAYP(sequence))
+		object = sequence->data.array.list;
+	    else
+		object = sequence;
+	    /* goto first element to copy */
+	    for (count = 0; count < start; count++, object = CDR(object))
+		;
+	    result = cons = CONS(CAR(object), NIL);
+	    GC_PROTECT(result);
+	    for (++count, object = CDR(object); count < end; count++,
+		 object = CDR(object)) {
+		RPLACD(cons, CONS(CAR(object), NIL));
+		cons = CDR(cons);
+	    }
+	}
+	else
+	    result = NIL;
+
+	if (ARRAYP(sequence)) {
+	    object = LispNew(NIL, NIL);
+	    GC_PROTECT(object);
+	    object->type = LispArray_t;
+	    object->data.array.list = result;
+	    object->data.array.dim = CONS(FIXNUM(seqlength), NIL);
+	    object->data.array.rank = 1;
+	    object->data.array.type = sequence->data.array.type;
+	    object->data.array.zero = length == 0;
+	    result = object;
+	}
+	GC_LEAVE();
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Subsetp(LispBuiltin *builtin)
+/*
+ subsetp list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, SUBSETP));
+}
+
+
+LispObj *
+Lisp_Substitute(LispBuiltin *builtin)
+/*
+ substitute newitem olditem sequence &key from-end test test-not start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, SUBSTITUTE, NONE));
+}
+
+LispObj *
+Lisp_SubstituteIf(LispBuiltin *builtin)
+/*
+ substitute-if newitem test sequence &key from-end start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, SUBSTITUTE, IF));
+}
+
+LispObj *
+Lisp_SubstituteIfNot(LispBuiltin *builtin)
+/*
+ substitute-if-not newitem test sequence &key from-end start end count key
+ */
+{
+    return (LispDeleteRemoveXSubstitute(builtin, SUBSTITUTE, IFNOT));
+}
+
+LispObj *
+Lisp_Symbolp(LispBuiltin *builtin)
+/*
+ symbolp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (SYMBOLP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_SymbolFunction(LispBuiltin *builtin)
+/*
+ symbol-function symbol
+ */
+{
+    LispObj *symbol;
+
+    symbol = ARGUMENT(0);
+    CHECK_SYMBOL(symbol);
+
+    return (LispSymbolFunction(symbol));
+}
+
+LispObj *
+Lisp_SymbolName(LispBuiltin *builtin)
+/*
+ symbol-name symbol
+ */
+{
+    LispObj *symbol;
+
+    symbol = ARGUMENT(0);
+    CHECK_SYMBOL(symbol);
+
+    return (LispSymbolName(symbol));
+}
+
+LispObj *
+Lisp_SymbolPackage(LispBuiltin *builtin)
+/*
+ symbol-package symbol
+ */
+{
+    LispObj *symbol;
+
+    symbol = ARGUMENT(0);
+    CHECK_SYMBOL(symbol);
+
+    symbol = symbol->data.atom->package;
+
+    return (symbol ? symbol : NIL);
+}
+
+LispObj *
+Lisp_SymbolPlist(LispBuiltin *builtin)
+/*
+ symbol-plist symbol
+ */
+{
+    LispObj *symbol;
+
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+
+    return (symbol->data.atom->a_property ?
+	    symbol->data.atom->property->properties : NIL);
+}
+
+LispObj *
+Lisp_SymbolValue(LispBuiltin *builtin)
+/*
+ symbol-value symbol
+ */
+{
+    LispAtom *atom;
+    LispObj *symbol;
+
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+    atom = symbol->data.atom;
+    if (!atom->a_object || atom->property->value == UNBOUND) {
+	if (atom->package == lisp__data.keyword)
+	    return (symbol);
+	LispDestroy("%s: the symbol %s has no value",
+		    STRFUN(builtin), STROBJ(symbol));
+    }
+
+    return (atom->dyn ? LispGetVar(symbol) : atom->property->value);
+}
+
+LispObj *
+Lisp_Tagbody(LispBuiltin *builtin)
+/*
+ tagbody &rest body
+ */
+{
+    GC_ENTER();
+    int stack, lex, length;
+    LispObj *list, *body, *ptr, *tag, *labels, *map,
+	    **p_list, **p_body, **p_labels;
+    LispBlock *block;
+
+    body = ARGUMENT(0);
+
+    /* Save environment information */
+    stack = lisp__data.stack.length;
+    lex = lisp__data.env.lex;
+    length = lisp__data.env.length;
+
+    /* Since the body may be large, and the code may iterate several
+     * thousand times, it is not a bad idea to avoid checking all
+     * elements of the body to verify if it is a tag. */
+    for (labels = map = NIL, ptr = body; CONSP(ptr); ptr = CDR(ptr)) {
+	tag = CAR(ptr);
+	switch (OBJECT_TYPE(tag)) {
+	    case LispNil_t:
+	    case LispAtom_t:
+	    case LispFixnum_t:
+		/* Don't allow duplicated labels */
+		for (list = labels; CONSP(list); list = CDDR(list)) {
+		    if (CAR(list) == tag)
+			LispDestroy("%s: tag %s specified more than once",
+				    STRFUN(builtin), STROBJ(tag));
+		}
+		if (labels == NIL) {
+		    labels = CONS(tag, CONS(NIL, NIL));
+		    map = CDR(labels);
+		    GC_PROTECT(labels);
+		}
+		else {
+		    RPLACD(map, CONS(tag, CONS(NIL, NIL)));
+		    map = CDDR(map);
+		}
+		break;
+	    case LispCons_t:
+		/* Restart point for tag */
+		if (map != NIL && CAR(map) == NIL)
+		    RPLACA(map, ptr);
+		break;
+	    default:
+		break;
+	}
+    }
+    /* Check for consecutive labels without code between them */
+    for (ptr = labels; CONSP(ptr); ptr = CDDR(ptr)) {
+	if (CADR(ptr) == NIL) {
+	    for (map = CDDR(ptr); CONSP(map); map = CDDR(map)) {
+		if (CADR(map) != NIL) {
+		    RPLACA(CDR(ptr), CADR(map));
+		    break;
+		}
+	    }
+	}
+    }
+
+    /* Initialize */
+    list = body;
+    p_list = &list;
+    p_body = &body;
+    p_labels = &labels;
+    block = LispBeginBlock(NIL, LispBlockBody);
+
+    /* Loop */
+    if (setjmp(block->jmp) != 0) {
+	/* Restore environment */
+	lisp__data.stack.length = stack;
+	lisp__data.env.lex = lex;
+	lisp__data.env.head = lisp__data.env.length = length;
+
+	tag = lisp__data.block.block_ret;
+	for (ptr = labels; CONSP(ptr); ptr = CDDR(ptr)) {
+	    map = CAR(ptr);
+	    if (map == tag)
+		break;
+	}
+
+	if (!CONSP(ptr))
+	    LispDestroy("%s: no such tag %s", STRFUN(builtin), STROBJ(tag));
+
+	*p_body = CADR(ptr);
+    }
+
+    /* Execute code */
+    for (; CONSP(body); body = CDR(body)) {
+	LispObj *form = CAR(body);
+
+	if (CONSP(form))
+	    EVAL(form);
+    }
+    /* If got here, (go) not called, else, labels will be candidate to gc
+     * when GC_LEAVE() be called by the code in the bottom of the stack. */
+    GC_LEAVE();
+
+    /* Finished */
+    LispEndBlock(block);
+
+    /* Always return NIL */
+    return (NIL);
+}
+
+LispObj *
+Lisp_The(LispBuiltin *builtin)
+/*
+ the value-type form
+ */
+{
+    LispObj *value_type, *form;
+
+    form = ARGUMENT(1);
+    value_type = ARGUMENT(0);
+
+    form = EVAL(form);
+
+    return (LispCoerce(builtin, form, value_type));
+}
+
+LispObj *
+Lisp_Throw(LispBuiltin *builtin)
+/*
+ throw tag result
+ */
+{
+    unsigned blevel = lisp__data.block.block_level;
+
+    LispObj *tag, *result;
+
+    result = ARGUMENT(1);
+    tag = ARGUMENT(0);
+
+    tag = EVAL(tag);
+
+    if (blevel == 0)
+	LispDestroy("%s: not within a block", STRFUN(builtin));
+
+    while (blevel) {
+	LispBlock *block = lisp__data.block.block[--blevel];
+
+	if (block->type == LispBlockCatch && tag == block->tag) {
+	    lisp__data.block.block_ret = EVAL(result);
+	    LispBlockUnwind(block);
+	    BLOCKJUMP(block);
+	}
+    }
+    LispDestroy("%s: %s is not a valid tag", STRFUN(builtin), STROBJ(tag));
+
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+static LispObj *
+LispTreeEqual(LispObj *left, LispObj *right, LispObj *test, int expect)
+{
+    LispObj *cmp_left, *cmp_right;
+
+    if ((OBJECT_TYPE(left)) ^ (OBJECT_TYPE(right)))
+	return (NIL);
+    if (CONSP(left)) {
+	for (; CONSP(left) && CONSP(right);
+	     left = CDR(left), right = CDR(right)) {
+	    cmp_left = CAR(left);
+	    cmp_right = CAR(right);
+	    if ((OBJECT_TYPE(cmp_left)) ^ (OBJECT_TYPE(cmp_right)))
+		return (NIL);
+	    if (CONSP(cmp_left)) {
+		if (LispTreeEqual(cmp_left, cmp_right, test, expect) == NIL)
+		    return (NIL);
+	    }
+	    else {
+		if (POINTERP(cmp_left) &&
+		    (XQUOTEP(cmp_left) || XBACKQUOTEP(cmp_left))) {
+		    cmp_left = cmp_left->data.quote;
+		    cmp_right = cmp_right->data.quote;
+		}
+		else if (COMMAP(cmp_left)) {
+		    cmp_left = cmp_left->data.comma.eval;
+		    cmp_right = cmp_right->data.comma.eval;
+		}
+		if ((APPLY2(test, cmp_left, cmp_right) != NIL) != expect)
+		    return (NIL);
+	    }
+	}
+	if ((OBJECT_TYPE(left)) ^ (OBJECT_TYPE(right)))
+	    return (NIL);
+    }
+
+    if (POINTERP(left) && (XQUOTEP(left) || XBACKQUOTEP(left))) {
+	left = left->data.quote;
+	right = right->data.quote;
+    }
+    else if (COMMAP(left)) {
+	left = left->data.comma.eval;
+	right = right->data.comma.eval;
+    }
+
+    return ((APPLY2(test, left, right) != NIL) == expect ? T : NIL);
+}
+
+LispObj *
+Lisp_TreeEqual(LispBuiltin *builtin)
+/*
+ tree-equal tree-1 tree-2 &key test test-not
+ */
+{
+    int expect;
+    LispObj *compare;
+
+    LispObj *tree_1, *tree_2, *test, *test_not;
+
+    test_not = ARGUMENT(3);
+    test = ARGUMENT(2);
+    tree_2 = ARGUMENT(1);
+    tree_1 = ARGUMENT(0);
+
+    CHECK_TEST_0();
+    if (test_not != UNSPEC) {
+	expect = 0;
+	compare = test_not;
+    }
+    else {
+	if (test == UNSPEC)
+	    test = Oeql;
+	expect = 1;
+	compare = test;
+    }
+
+    return (LispTreeEqual(tree_1, tree_2, compare, expect));
+}
+
+LispObj *
+Lisp_Typep(LispBuiltin *builtin)
+/*
+ typep object type
+ */
+{
+    LispObj *result = NULL;
+
+    LispObj *object, *type;
+
+    type = ARGUMENT(1);
+    object = ARGUMENT(0);
+
+    if (SYMBOLP(type)) {
+	Atom_id atom = ATOMID(type);
+
+	if (OBJECT_TYPE(object) == LispStruct_t)
+	    result = ATOMID(CAR(object->data.struc.def)) == atom ? T : NIL;
+	else if (type->data.atom->a_defstruct &&
+		 type->data.atom->property->structure.function == STRUCT_NAME)
+	    result = NIL;
+	else if (atom == Snil)
+	    result = object == NIL ? T : NIL;
+	else if (atom == St)
+	    result = object == T ? T : NIL;
+	else if (atom == Satom)
+	    result = !CONSP(object) ? T : NIL;
+	else if (atom == Ssymbol)
+	    result = SYMBOLP(object) || object == NIL || object == T ? T : NIL;
+	else if (atom == Sinteger)
+	    result = INTEGERP(object) ? T : NIL;
+	else if (atom == Srational)
+	    result = RATIONALP(object) ? T : NIL;
+	else if (atom == Scons || atom == Slist)
+	    result = CONSP(object) ? T : NIL;
+	else if (atom == Sstring)
+	    result = STRINGP(object) ? T : NIL;
+	else if (atom == Scharacter)
+	    result = SCHARP(object) ? T : NIL;
+	else if (atom == Scomplex)
+	    result = COMPLEXP(object) ? T : NIL;
+	else if (atom == Svector || atom == Sarray)
+	    result = ARRAYP(object) ? T : NIL;
+	else if (atom == Skeyword)
+	    result = KEYWORDP(object) ? T : NIL;
+	else if (atom == Sfunction)
+	    result = LAMBDAP(object) ? T : NIL;
+	else if (atom == Spathname)
+	    result = PATHNAMEP(object) ? T : NIL;
+	else if (atom == Sopaque)
+	    result = OPAQUEP(object) ? T : NIL;
+    }
+    else if (CONSP(type)) {
+	if (OBJECT_TYPE(object) == LispStruct_t &&
+	    SYMBOLP(CAR(type)) && ATOMID(CAR(type)) == Sstruct &&
+	    SYMBOLP(CAR(CDR(type))) && CDR(CDR(type)) == NIL) {
+	    result = ATOMID(CAR(object->data.struc.def)) ==
+		     ATOMID(CAR(CDR(type))) ? T : NIL;
+	}
+    }
+    else if (type == NIL)
+	result = object == NIL ? T : NIL;
+    else if (type == T)
+	result = object == T ? T : NIL;
+    if (result == NULL)
+	LispDestroy("%s: bad type specification %s",
+		    STRFUN(builtin), STROBJ(type));
+
+    return (result);
+}
+
+LispObj *
+Lisp_Union(LispBuiltin *builtin)
+/*
+ union list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, UNION));
+}
+
+LispObj *
+Lisp_Nunion(LispBuiltin *builtin)
+/*
+ nunion list1 list2 &key test test-not key
+ */
+{
+    return (LispListSet(builtin, NUNION));
+}
+
+LispObj *
+Lisp_Unless(LispBuiltin *builtin)
+/*
+ unless test &rest body
+ */
+{
+    LispObj *result, *test, *body;
+
+    body = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    result = NIL;
+    test = EVAL(test);
+    RETURN_COUNT = 0;
+    if (test == NIL) {
+	for (; CONSP(body); body = CDR(body))
+	    result = EVAL(CAR(body));
+    }
+
+    return (result);
+}
+
+/*
+ * ext::until
+ */
+LispObj *
+Lisp_Until(LispBuiltin *builtin)
+/*
+ until test &rest body
+ */
+{
+    LispObj *result, *test, *body, *prog;
+
+    body = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    result = NIL;
+    for (;;) {
+	if ((result = EVAL(test)) == NIL) {
+	    for (prog = body; CONSP(prog); prog = CDR(prog))
+		(void)EVAL(CAR(prog));
+	}
+	else
+	    break;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_UnwindProtect(LispBuiltin *builtin)
+/*
+ unwind-protect protect &rest cleanup
+ */
+{
+    LispObj *result, **presult = &result;
+    int did_jump, *pdid_jump = &did_jump, destroyed;
+    LispBlock *block;
+
+    LispObj *protect, *cleanup, **pcleanup = &cleanup;
+
+    cleanup = ARGUMENT(1);
+    protect = ARGUMENT(0);
+
+    /* run protected code */
+    *presult = NIL;
+    *pdid_jump = 1;
+    block = LispBeginBlock(NIL, LispBlockProtect);
+    if (setjmp(block->jmp) == 0) {
+	*presult = EVAL(protect);
+	*pdid_jump = 0;
+    }
+    LispEndBlock(block);
+    if (!lisp__data.destroyed && *pdid_jump)
+	*presult = lisp__data.block.block_ret;
+
+    destroyed = lisp__data.destroyed;
+    lisp__data.destroyed = 0;
+
+    /* run cleanup, unprotected code */
+    if (CONSP(*pcleanup))
+	for (; CONSP(cleanup); cleanup = CDR(cleanup))
+	    (void)EVAL(CAR(cleanup));
+
+    if (destroyed) {
+	/* in case there is another unwind-protect */
+	LispBlockUnwind(NULL);
+	/* if not, just return to the toplevel */
+	lisp__data.destroyed = 1;
+	LispDestroy(".");
+    }
+
+    return (result);
+}
+
+static LispObj *
+LispValuesList(LispBuiltin *builtin, int check_list)
+{
+    long i, count;
+    LispObj *result;
+
+    LispObj *list;
+
+    list = ARGUMENT(0);
+
+    count = LispLength(list) - 1;
+
+    if (count >= 0) {
+	result = CAR(list);
+	if ((RETURN_CHECK(count)) != count)
+	    LispDestroy("%s: too many values", STRFUN(builtin));
+	RETURN_COUNT = count;
+	for (i = 0, list = CDR(list); count && CONSP(list);
+	     count--, i++, list = CDR(list))
+	    RETURN(i) = CAR(list);
+	if (check_list) {
+	    CHECK_LIST(list);
+	}
+    }
+    else {
+	RETURN_COUNT = -1;
+	result = NIL;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Values(LispBuiltin *builtin)
+/*
+ values &rest objects
+ */
+{
+    return (LispValuesList(builtin, 0));
+}
+
+LispObj *
+Lisp_ValuesList(LispBuiltin *builtin)
+/*
+ values-list list
+ */
+{
+    return (LispValuesList(builtin, 1));
+}
+
+LispObj *
+Lisp_Vector(LispBuiltin *builtin)
+/*
+ vector &rest objects
+ */
+{
+    LispObj *objects;
+
+    objects = ARGUMENT(0);
+
+    return (VECTOR(objects));
+}
+
+LispObj *
+Lisp_When(LispBuiltin *builtin)
+/*
+ when test &rest body
+ */
+{
+    LispObj *result, *test, *body;
+
+    body = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    result = NIL;
+    test = EVAL(test);
+    RETURN_COUNT = 0;
+    if (test != NIL) {
+	for (; CONSP(body); body = CDR(body))
+	    result = EVAL(CAR(body));
+    }
+
+    return (result);
+}
+
+/*
+ * ext::while
+ */
+LispObj *
+Lisp_While(LispBuiltin *builtin)
+/*
+ while test &rest body
+ */
+{
+    LispObj *result, *test, *body, *prog;
+
+    body = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    result = NIL;
+    for (;;) {
+	if (EVAL(test) != NIL) {
+	    for (prog = body; CONSP(prog); prog = CDR(prog))
+		(void)EVAL(CAR(prog));
+	}
+	else
+	    break;
+    }
+
+    return (NIL);
+}
+
+/*
+ * ext::unsetenv
+ */
+LispObj *
+Lisp_Unsetenv(LispBuiltin *builtin)
+/*
+ unsetenv name
+ */
+{
+    char *name;
+
+    LispObj *oname;
+
+    oname = ARGUMENT(0);
+
+    CHECK_STRING(oname);
+    name = THESTR(oname);
+
+    unsetenv(name);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XeditEltStore(LispBuiltin *builtin)
+/*
+ lisp::elt-store sequence index value
+ */
+{
+    int length, offset;
+
+    LispObj *sequence, *oindex, *value;
+
+    value = ARGUMENT(2);
+    oindex = ARGUMENT(1);
+    sequence = ARGUMENT(0);
+
+    CHECK_INDEX(oindex);
+    offset = FIXNUM_VALUE(oindex);
+    length = LispLength(sequence);
+
+    if (offset >= length)
+	LispDestroy("%s: index %d too large for sequence length %d",
+		    STRFUN(builtin), offset, length);
+
+    if (STRINGP(sequence)) {
+	int ch;
+
+	CHECK_STRING_WRITABLE(sequence);
+	CHECK_SCHAR(value);
+	ch = SCHAR_VALUE(value);
+	if (ch < 0 || ch > 255)
+	    LispDestroy("%s: cannot represent character %d",
+			STRFUN(builtin), ch);
+	THESTR(sequence)[offset] = ch;
+    }
+    else {
+	if (ARRAYP(sequence))
+	    sequence = sequence->data.array.list;
+
+	for (; offset > 0; offset--, sequence = CDR(sequence))
+	    ;
+	RPLACA(sequence, value);
+    }
+
+    return (value);
+}
+
+LispObj *
+Lisp_XeditPut(LispBuiltin *builtin)
+/*
+ lisp::put symbol indicator value
+ */
+{
+    LispObj *symbol, *indicator, *value;
+
+    value = ARGUMENT(2);
+    indicator = ARGUMENT(1);
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+
+    return (CAR(LispPutAtomProperty(symbol->data.atom, indicator, value)));
+}
+
+LispObj *
+Lisp_XeditSetSymbolPlist(LispBuiltin *builtin)
+/*
+ lisp::set-symbol-plist symbol list
+ */
+{
+    LispObj *symbol, *list;
+
+    list = ARGUMENT(1);
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+
+    return (LispReplaceAtomPropertyList(symbol->data.atom, list));
+}
+
+LispObj *
+Lisp_XeditVectorStore(LispBuiltin *builtin)
+/*
+ lisp::vector-store array &rest values
+ */
+{
+    LispObj *value, *list, *object;
+    long rank, count, sequence, offset, accum;
+
+    LispObj *array, *values;
+
+    values = ARGUMENT(1);
+    array = ARGUMENT(0);
+
+    /* check for errors */
+    for (rank = 0, list = values;
+	 CONSP(list) && CONSP(CDR(list));
+	 list = CDR(list), rank++) {
+	CHECK_INDEX(CAR(values));
+    }
+
+    if (rank == 0)
+	LispDestroy("%s: too few subscripts", STRFUN(builtin));
+    value = CAR(list);
+
+    if (STRINGP(array) && rank == 1) {
+	long ch;
+	long length = STRLEN(array);
+	long offset = FIXNUM_VALUE(CAR(values));
+
+	CHECK_SCHAR(value);
+	CHECK_STRING_WRITABLE(array);
+	ch = SCHAR_VALUE(value);
+	if (offset >= length)
+	    LispDestroy("%s: index %ld too large for sequence length %ld",
+			STRFUN(builtin), offset, length);
+
+	if (ch < 0 || ch > 255)
+	    LispDestroy("%s: cannot represent character %ld",
+			STRFUN(builtin), ch);
+	THESTR(array)[offset] = ch;
+
+	return (value);
+    }
+
+    CHECK_ARRAY(array);
+    if (rank != array->data.array.rank)
+	LispDestroy("%s: too %s subscripts", STRFUN(builtin),
+		    rank < array->data.array.rank ? "few" : "many");
+
+    for (list = values, object = array->data.array.dim;
+	 CONSP(CDR(list));
+	 list = CDR(list), object = CDR(object)) {
+	if (FIXNUM_VALUE(CAR(list)) >= FIXNUM_VALUE(CAR(object)))
+	    LispDestroy("%s: %ld is out of range, index %ld",
+			STRFUN(builtin),
+			FIXNUM_VALUE(CAR(list)),
+			FIXNUM_VALUE(CAR(object)));
+    }
+
+    for (count = sequence = 0, list = values;
+	 CONSP(CDR(list));
+	 list = CDR(list), sequence++) {
+	for (offset = 0, object = array->data.array.dim;
+	     offset < sequence; object = CDR(object), offset++)
+	    ;
+	for (accum = 1, object = CDR(object); CONSP(object);
+	     object = CDR(object))
+	    accum *= FIXNUM_VALUE(CAR(object));
+	count += accum * FIXNUM_VALUE(CAR(list));
+    }
+
+    for (array = array->data.array.list; count > 0; array = CDR(array), count--)
+	;
+
+    RPLACA(array, value);
+
+    return (value);
+}
+
+LispObj *
+Lisp_XeditDocumentationStore(LispBuiltin *builtin)
+/*
+ lisp::documentation-store symbol type string
+ */
+{
+    LispDocType_t doc_type;
+
+    LispObj *symbol, *type, *string;
+
+    string = ARGUMENT(2);
+    type = ARGUMENT(1);
+    symbol = ARGUMENT(0);
+
+    CHECK_SYMBOL(symbol);
+
+    /* type is checked in LispDocumentationType() */
+    doc_type = LispDocumentationType(builtin, type);
+
+    if (string == NIL)
+	/* allow explicitly releasing memory used for documentation */
+	LispRemDocumentation(symbol, doc_type);
+    else {
+	CHECK_STRING(string);
+	LispAddDocumentation(symbol, string, doc_type);
+    }
+
+    return (string);
+}
diff --git a/lisp/core.h b/lisp/core.h
new file mode 100644
index 0000000..403a75a
--- /dev/null
+++ b/lisp/core.h
@@ -0,0 +1,221 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/core.h,v 1.35 2002/12/20 04:32:46 paulo Exp $ */
+
+#ifndef Lisp_core_h
+#define Lisp_core_h
+
+#include "internal.h"
+
+void LispCoreInit(void);
+
+LispObj *Lisp_Acons(LispBuiltin*);
+LispObj *Lisp_Adjoin(LispBuiltin*);
+LispObj *Lisp_Append(LispBuiltin*);
+LispObj *Lisp_And(LispBuiltin*);
+LispObj *Lisp_Aref(LispBuiltin*);
+LispObj *Lisp_Assoc(LispBuiltin*);
+LispObj *Lisp_AssocIf(LispBuiltin*);
+LispObj *Lisp_AssocIfNot(LispBuiltin*);
+LispObj *Lisp_Apply(LispBuiltin*);
+LispObj *Lisp_Atom(LispBuiltin*);
+LispObj *Lisp_Block(LispBuiltin*);
+LispObj *Lisp_Boundp(LispBuiltin*);
+LispObj *Lisp_Butlast(LispBuiltin*);
+LispObj *Lisp_Nbutlast(LispBuiltin*);
+LispObj *Lisp_Car(LispBuiltin*);
+LispObj *Lisp_Case(LispBuiltin*);
+LispObj *Lisp_Catch(LispBuiltin*);
+LispObj *Lisp_Cdr(LispBuiltin*);
+LispObj *Lisp_C_r(LispBuiltin*);
+LispObj *Lisp_Coerce(LispBuiltin*);
+LispObj *Lisp_Cond(LispBuiltin*);
+LispObj *Lisp_Cons(LispBuiltin*);
+LispObj *Lisp_Consp(LispBuiltin*);
+LispObj *Lisp_Constantp(LispBuiltin*);
+LispObj *Lisp_CopyAlist(LispBuiltin*);
+LispObj *Lisp_CopyList(LispBuiltin*);
+LispObj *Lisp_CopyTree(LispBuiltin*);
+LispObj *Lisp_Defconstant(LispBuiltin*);
+LispObj *Lisp_Defmacro(LispBuiltin*);
+LispObj *Lisp_Defun(LispBuiltin*);
+LispObj *Lisp_Defsetf(LispBuiltin*);
+LispObj *Lisp_Defparameter(LispBuiltin*);
+LispObj *Lisp_Defvar(LispBuiltin*);
+LispObj *Lisp_Delete(LispBuiltin*);
+LispObj *Lisp_DeleteDuplicates(LispBuiltin*);
+LispObj *Lisp_DeleteIf(LispBuiltin*);
+LispObj *Lisp_DeleteIfNot(LispBuiltin*);
+LispObj *Lisp_Do(LispBuiltin*);
+LispObj *Lisp_DoP(LispBuiltin*);
+LispObj *Lisp_Documentation(LispBuiltin*);
+LispObj *Lisp_DoList(LispBuiltin*);
+LispObj *Lisp_DoTimes(LispBuiltin*);
+LispObj *Lisp_Elt(LispBuiltin*);
+LispObj *Lisp_Endp(LispBuiltin*);
+LispObj *Lisp_Eq(LispBuiltin*);
+LispObj *Lisp_Eql(LispBuiltin*);
+LispObj *Lisp_Equal(LispBuiltin*);
+LispObj *Lisp_Equalp(LispBuiltin*);
+LispObj *Lisp_Error(LispBuiltin*);
+LispObj *Lisp_Eval(LispBuiltin*);
+LispObj *Lisp_Every(LispBuiltin*);
+LispObj *Lisp_Some(LispBuiltin*);
+LispObj *Lisp_Notevery(LispBuiltin*);
+LispObj *Lisp_Notany(LispBuiltin*);
+LispObj *Lisp_Fboundp(LispBuiltin*);
+LispObj *Lisp_Find(LispBuiltin*);
+LispObj *Lisp_FindIf(LispBuiltin*);
+LispObj *Lisp_FindIfNot(LispBuiltin*);
+LispObj *Lisp_Fill(LispBuiltin*);
+LispObj *Lisp_Fmakunbound(LispBuiltin*);
+LispObj *Lisp_Functionp(LispBuiltin*);
+LispObj *Lisp_Funcall(LispBuiltin*);
+LispObj *Lisp_Gc(LispBuiltin*);
+LispObj *Lisp_Gensym(LispBuiltin*);
+LispObj *Lisp_Get(LispBuiltin*);
+LispObj *Lisp_Getenv(LispBuiltin*);
+LispObj *Lisp_Go(LispBuiltin*);
+LispObj *Lisp_If(LispBuiltin*);
+LispObj *Lisp_IgnoreErrors(LispBuiltin*);
+LispObj *Lisp_Intersection(LispBuiltin*);
+LispObj *Lisp_Nintersection(LispBuiltin*);
+LispObj *Lisp_Keywordp(LispBuiltin*);
+LispObj *Lisp_Lambda(LispBuiltin*);
+LispObj *Lisp_Last(LispBuiltin*);
+LispObj *Lisp_Let(LispBuiltin*);
+LispObj *Lisp_Length(LispBuiltin*);
+LispObj *Lisp_LetP(LispBuiltin*);
+LispObj *Lisp_List(LispBuiltin*);
+LispObj *Lisp_ListLength(LispBuiltin*);
+LispObj *Lisp_ListP(LispBuiltin*);
+LispObj *Lisp_Listp(LispBuiltin*);
+LispObj *Lisp_Loop(LispBuiltin*);
+LispObj *Lisp_MakeArray(LispBuiltin*);
+LispObj *Lisp_MakeList(LispBuiltin*);
+LispObj *Lisp_MakeSymbol(LispBuiltin*);
+LispObj *Lisp_Makunbound(LispBuiltin*);
+LispObj *Lisp_Mapc(LispBuiltin*);
+LispObj *Lisp_Mapcar(LispBuiltin*);
+LispObj *Lisp_Mapcan(LispBuiltin*);
+LispObj *Lisp_Mapl(LispBuiltin*);
+LispObj *Lisp_Maplist(LispBuiltin*);
+LispObj *Lisp_Mapcon(LispBuiltin*);
+LispObj *Lisp_Member(LispBuiltin*);
+LispObj *Lisp_MemberIf(LispBuiltin*);
+LispObj *Lisp_MemberIfNot(LispBuiltin*);
+LispObj *Lisp_MultipleValueBind(LispBuiltin*);
+LispObj *Lisp_MultipleValueCall(LispBuiltin*);
+LispObj *Lisp_MultipleValueProg1(LispBuiltin*);
+LispObj *Lisp_MultipleValueList(LispBuiltin*);
+LispObj *Lisp_MultipleValueSetq(LispBuiltin*);
+LispObj *Lisp_Nconc(LispBuiltin*);
+LispObj *Lisp_Nreverse(LispBuiltin*);
+LispObj *Lisp_NsetDifference(LispBuiltin*);
+LispObj *Lisp_Nsubstitute(LispBuiltin*);
+LispObj *Lisp_NsubstituteIf(LispBuiltin*);
+LispObj *Lisp_NsubstituteIfNot(LispBuiltin*);
+LispObj *Lisp_Nth(LispBuiltin*);
+LispObj *Lisp_Nthcdr(LispBuiltin*);
+LispObj *Lisp_NthValue(LispBuiltin*);
+LispObj *Lisp_Null(LispBuiltin*);
+LispObj *Lisp_Or(LispBuiltin*);
+LispObj *Lisp_Pairlis(LispBuiltin*);
+LispObj *Lisp_Pop(LispBuiltin*);
+LispObj *Lisp_Position(LispBuiltin*);
+LispObj *Lisp_PositionIf(LispBuiltin*);
+LispObj *Lisp_PositionIfNot(LispBuiltin*);
+LispObj *Lisp_Proclaim(LispBuiltin*);
+LispObj *Lisp_Prog1(LispBuiltin*);
+LispObj *Lisp_Prog2(LispBuiltin*);
+LispObj *Lisp_Progn(LispBuiltin*);
+LispObj *Lisp_Progv(LispBuiltin*);
+LispObj *Lisp_Provide(LispBuiltin*);
+LispObj *Lisp_Push(LispBuiltin*);
+LispObj *Lisp_Pushnew(LispBuiltin*);
+LispObj *Lisp_Quit(LispBuiltin*);
+LispObj *Lisp_Quote(LispBuiltin*);
+LispObj *Lisp_Remove(LispBuiltin*);
+LispObj *Lisp_RemoveDuplicates(LispBuiltin*);
+LispObj *Lisp_RemoveIf(LispBuiltin*);
+LispObj *Lisp_RemoveIfNot(LispBuiltin*);
+LispObj *Lisp_Remprop(LispBuiltin*);
+LispObj *Lisp_Replace(LispBuiltin*);
+LispObj *Lisp_Return(LispBuiltin*);
+LispObj *Lisp_ReturnFrom(LispBuiltin*);
+LispObj *Lisp_Reverse(LispBuiltin*);
+LispObj *Lisp_Rplaca(LispBuiltin*);
+LispObj *Lisp_Rplacd(LispBuiltin*);
+LispObj *Lisp_Search(LispBuiltin*);
+LispObj *Lisp_Setenv(LispBuiltin*);
+LispObj *Lisp_Set(LispBuiltin*);
+LispObj *Lisp_SetDifference(LispBuiltin*);
+LispObj *Lisp_SetExclusiveOr(LispBuiltin*);
+LispObj *Lisp_NsetExclusiveOr(LispBuiltin*);
+LispObj *Lisp_Setf(LispBuiltin*);
+LispObj *Lisp_Psetf(LispBuiltin*);
+LispObj *Lisp_SetQ(LispBuiltin*);
+LispObj *Lisp_Psetq(LispBuiltin*);
+LispObj *Lisp_Sleep(LispBuiltin*);
+LispObj *Lisp_Sort(LispBuiltin*);
+LispObj *Lisp_Subseq(LispBuiltin*);
+LispObj *Lisp_Subsetp(LispBuiltin*);
+LispObj *Lisp_Substitute(LispBuiltin*);
+LispObj *Lisp_SubstituteIf(LispBuiltin*);
+LispObj *Lisp_SubstituteIfNot(LispBuiltin*);
+LispObj *Lisp_Symbolp(LispBuiltin*);
+LispObj *Lisp_SymbolFunction(LispBuiltin*);
+LispObj *Lisp_SymbolName(LispBuiltin*);
+LispObj *Lisp_SymbolPackage(LispBuiltin*);
+LispObj *Lisp_SymbolPlist(LispBuiltin*);
+LispObj *Lisp_SymbolValue(LispBuiltin*);
+LispObj *Lisp_Tagbody(LispBuiltin*);
+LispObj *Lisp_Throw(LispBuiltin*);
+LispObj *Lisp_The(LispBuiltin*);
+LispObj *Lisp_TreeEqual(LispBuiltin*);
+LispObj *Lisp_Typep(LispBuiltin*);
+LispObj *Lisp_Union(LispBuiltin*);
+LispObj *Lisp_Nunion(LispBuiltin*);
+LispObj *Lisp_Unless(LispBuiltin*);
+LispObj *Lisp_Until(LispBuiltin*);
+LispObj *Lisp_Unsetenv(LispBuiltin*);
+LispObj *Lisp_UnwindProtect(LispBuiltin*);
+LispObj *Lisp_Values(LispBuiltin*);
+LispObj *Lisp_ValuesList(LispBuiltin*);
+LispObj *Lisp_Vector(LispBuiltin*);
+LispObj *Lisp_When(LispBuiltin*);
+LispObj *Lisp_While(LispBuiltin*);
+LispObj *Lisp_XeditEltStore(LispBuiltin*);
+LispObj *Lisp_XeditPut(LispBuiltin*);
+LispObj *Lisp_XeditSetSymbolPlist(LispBuiltin*);
+LispObj *Lisp_XeditVectorStore(LispBuiltin*);
+LispObj *Lisp_XeditDocumentationStore(LispBuiltin*);
+
+#endif
diff --git a/lisp/debugger.c b/lisp/debugger.c
new file mode 100644
index 0000000..4716699
--- /dev/null
+++ b/lisp/debugger.c
@@ -0,0 +1,828 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/debugger.c,v 1.24 2002/11/12 06:05:07 paulo Exp $ */
+
+#include <ctype.h>
+#include "io.h"
+#include "debugger.h"
+#include "write.h"
+
+#ifdef DEBUGGER
+#define DebuggerHelp		0
+#define DebuggerAbort		1
+#define DebuggerBacktrace	2
+#define DebuggerContinue	3
+#define DebuggerFinish		4
+#define DebuggerFrame		5
+#define DebuggerNext		6
+#define DebuggerPrint		7
+#define DebuggerStep		8
+#define DebuggerBreak		9
+#define DebuggerDelete		10
+#define DebuggerDown		11
+#define DebuggerUp		12
+#define DebuggerInfo		13
+#define DebuggerWatch		14
+
+#define DebuggerInfoBreakpoints	0
+#define DebuggerInfoBacktrace	1
+
+/*
+ * Prototypes
+ */
+static char *format_integer(int);
+static void LispDebuggerCommand(LispObj *obj);
+
+/*
+ * Initialization
+ */
+static struct {
+    char *name;
+    int action;
+} commands[] = {
+    {"help",		DebuggerHelp},
+    {"abort",		DebuggerAbort},
+    {"backtrace",	DebuggerBacktrace},
+    {"b",		DebuggerBreak},
+    {"break",		DebuggerBreak},
+    {"bt",		DebuggerBacktrace},
+    {"continue",	DebuggerContinue},
+    {"d",		DebuggerDelete},
+    {"delete",		DebuggerDelete},
+    {"down",		DebuggerDown},
+    {"finish",		DebuggerFinish},
+    {"frame",		DebuggerFrame},
+    {"info",		DebuggerInfo},
+    {"n",		DebuggerNext},
+    {"next",		DebuggerNext},
+    {"print",		DebuggerPrint},
+    {"run",		DebuggerContinue},
+    {"s",		DebuggerStep},
+    {"step",		DebuggerStep},
+    {"up",		DebuggerUp},
+    {"watch",		DebuggerWatch},
+};
+
+static struct {
+    char *name;
+    int subaction;
+} info_commands[] = {
+    {"breakpoints",	DebuggerInfoBreakpoints},
+    {"stack",		DebuggerInfoBacktrace},
+    {"watchpoints",	DebuggerInfoBreakpoints},
+};
+
+static char debugger_help[] =
+"Available commands are:\n\
+\n\
+help		- This message.\n\
+abort		- Abort the current execution, and return to toplevel.\n\
+backtrace, bt	- Print backtrace.\n\
+b, break	- Set breakpoint at function name argument.\n\
+continue	- Continue execution.\n\
+d, delete	- Delete breakpoint(s), all breakpoint if no arguments given.\n\
+down		- Set environment to frame called by the current one.\n\
+finish		- Executes until current form is finished.\n\
+frame		- Set environment to selected frame.\n\
+info		- Prints information about the debugger state.\n\
+n, next		- Evaluate next form.\n\
+print		- Print value of variable name argument.\n\
+run		- Continue execution.\n\
+s, step		- Evaluate next form, stopping on any subforms.\n\
+up		- Set environment to frame that called the current one.\n\
+\n\
+Commands may be abbreviated.\n";
+
+static char debugger_info_help[] =
+"Available subcommands are:\n\
+\n\
+breakpoints	- List and prints status of breakpoints, and watchpoints.\n\
+stack		- Backtrace of stack.\n\
+watchpoints	- List and prints status of watchpoints, and breakpoints.\n\
+\n\
+Subcommands may be abbreviated.\n";
+
+/* Debugger variables layout (if you change it, update description):
+ *
+ * DBG
+ *	is a macro for lisp__data.dbglist
+ *	is a NIL terminated list
+ *	every element is a list in the format (NOT NIL terminated):
+ *	(list* NAM ARG ENV HED LEX)
+ *	where
+ *		NAM is an ATOM for the function/macro name
+ *		    or NIL for lambda expressions
+ *		ARG is NAM arguments (a LIST)
+ *		ENV is the value of lisp__data.stack.base (a FIXNUM)
+ *		LEN is the value of lisp__data.env.length (a FIXNUM)
+ *		LEX is the value of lisp__data.env.lex (a FIXNUM)
+ *	new elements are added to the beggining of the DBG list
+ *
+ * BRK
+ *	is macro for lisp__data.brklist
+ *	is a NIL terminated list
+ *	every element is a list in the format (NIL terminated):
+ *	(list NAM IDX TYP HIT VAR VAL FRM)
+ *	where
+ *		NAM is an ATOM for the name of the object at
+ *		    wich the breakpoint was added
+ *		IDX is a FIXNUM, the breakpoint number
+ *		    must be stored, as breakpoints may be deleted
+ *		TYP is a FIXNUM that must be an integer of enum LispBreakType
+ *		HIT is a FIXNUM, with the number of times this breakpoint was
+ *		    hitted.
+ *		VAR variable to watch a SYMBOL	(not needed for breakpoints)
+ *		VAL value of watched variable	(not needed for breakpoints)
+ *		FRM frame where variable started being watched
+ *						(not needed for breakpoints)
+ *	new elements are added to the end of the list
+ */
+
+/*
+ * Implementation
+ */
+void
+LispDebugger(LispDebugCall call, LispObj *name, LispObj *arg)
+{
+    int force = 0;
+    LispObj *obj, *prev;
+
+    switch (call) {
+	case LispDebugCallBegin:
+	    ++lisp__data.debug_level;
+	    GCDisable();
+	    DBG = CONS(CONS(name, CONS(arg, CONS(FIXNUM(lisp__data.stack.base),
+		       CONS(FIXNUM(lisp__data.env.length),
+			    FIXNUM(lisp__data.env.lex))))), DBG);
+	    GCEnable();
+	    for (obj = BRK; obj != NIL; obj = CDR(obj))
+		if (ATOMID(CAR(CAR(obj))) == ATOMID(name) &&
+		    FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj))))) ==
+		    LispDebugBreakFunction)
+		    break;
+	    if (obj != NIL) {
+		long counter;
+
+		/* if not at a fresh line */
+		if (LispGetColumn(NIL))
+		    LispFputc(Stdout, '\n');
+		LispFputs(Stdout, "BREAK #");
+		LispWriteObject(NIL, CAR(CDR(CAR(obj))));
+		LispFputs(Stdout, "> (");
+		LispWriteObject(NIL, CAR(CAR(DBG)));
+		LispFputc(Stdout, ' ');
+		LispWriteObject(NIL, CAR(CDR(CAR(DBG))));
+		LispFputs(Stdout, ")\n");
+		force = 1;
+		/* update hits counter */
+		counter = FIXNUM_VALUE(CAR(CDR(CDR(CDR(CAR(obj))))));
+		CAR(CDR(CDR(CDR(CAR(obj))))) FIXNUM(counter + 1);
+	    }
+	    break;
+	case LispDebugCallEnd:
+	    DBG = CDR(DBG);
+	    if (lisp__data.debug_level < lisp__data.debug_step)
+		lisp__data.debug_step = lisp__data.debug_level;
+	    --lisp__data.debug_level;
+	    break;
+	case LispDebugCallFatal:
+	    LispDebuggerCommand(NIL);
+	    return;
+	case LispDebugCallWatch:
+	    break;
+    }
+
+    /* didn't return, check watchpoints */
+    if (call == LispDebugCallEnd || call == LispDebugCallWatch) {
+watch_again:
+	for (prev = obj = BRK; obj != NIL; prev = obj, obj = CDR(obj)) {
+	    if (FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj))))) ==
+		LispDebugBreakVariable) {
+		/* the variable */
+		LispObj *wat = CAR(CDR(CDR(CDR(CDR(CAR(obj))))));
+		void *sym = LispGetVarAddr(CAAR(obj));
+		LispObj *frm = CAR(CDR(CDR(CDR(CDR(CDR(CDR(CAR(obj))))))));
+
+		if ((sym == NULL && lisp__data.debug_level <= 0) ||
+		    (sym != wat->data.opaque.data &&
+		     FIXNUM_VALUE(frm) > lisp__data.debug_level)) {
+		    LispFputs(Stdout, "WATCH #");
+		    LispFputs(Stdout, format_integer(FIXNUM_VALUE(CAR(CDR(CAR(obj))))));
+		    LispFputs(Stdout, "> ");
+		    LispFputs(Stdout, STRPTR(CAR(CAR(obj))));
+		    LispFputs(Stdout, " deleted. Variable does not exist anymore.\n");
+		    /* force debugger to stop */
+		    force = 1;
+		    if (obj == prev) {
+			BRK = CDR(BRK);
+			goto watch_again;
+		    }
+		    else
+			RPLACD(prev, CDR(obj));
+		    obj = prev;
+		}
+		else {
+		    /* current value */
+		    LispObj *cur = *(LispObj**)wat->data.opaque.data;
+		    /* last value */
+		    LispObj *val = CAR(CDR(CDR(CDR(CDR(CDR(CAR(obj)))))));
+		    if (XEQUAL(val, cur) == NIL) {
+			long counter;
+
+			LispFputs(Stdout, "WATCH #");
+			LispFputs(Stdout, format_integer(FIXNUM_VALUE(CAR(CDR(CAR(obj))))));
+			LispFputs(Stdout, "> ");
+			LispFputs(Stdout, STRPTR(CAR(CAR(obj))));
+			LispFputc(Stdout, '\n');
+
+			LispFputs(Stdout, "OLD: ");
+			LispWriteObject(NIL, val);
+
+			LispFputs(Stdout, "\nNEW: ");
+			LispWriteObject(NIL, cur);
+			LispFputc(Stdout, '\n');
+
+			/* update current value */
+			CAR(CDR(CDR(CDR(CDR(CDR(CAR(obj))))))) = cur;
+			/* update hits counter */
+			counter = FIXNUM_VALUE(CAR(CDR(CDR(CDR(CAR(obj))))));
+			CAR(CDR(CDR(CDR(CAR(obj))))) = FIXNUM(counter + 1);
+			/* force debugger to stop */
+			force = 1;
+		    }
+		}
+	    }
+	}
+
+	if (call == LispDebugCallWatch)
+	    /* special call, just don't keep gc protected variables that may be
+	     * using a lot of memory... */
+	    return;
+    }
+
+    switch (lisp__data.debug) {
+	case LispDebugUnspec:
+	    LispDebuggerCommand(NIL);
+	    goto debugger_done;
+	case LispDebugRun:
+	    if (force)
+		LispDebuggerCommand(NIL);
+	    goto debugger_done;
+	case LispDebugFinish:
+	    if (!force &&
+		(call != LispDebugCallEnd ||
+		 lisp__data.debug_level != lisp__data.debug_step))
+		goto debugger_done;
+	    break;
+	case LispDebugNext:
+	    if (call == LispDebugCallBegin) {
+		if (!force && lisp__data.debug_level != lisp__data.debug_step)
+		    goto debugger_done;
+	    }
+	    else if (call == LispDebugCallEnd) {
+		if (!force && lisp__data.debug_level >= lisp__data.debug_step)
+		    goto debugger_done;
+	    }
+	    break;
+	case LispDebugStep:
+	    break;
+    }
+
+    if (call == LispDebugCallBegin) {
+	LispFputc(Stdout, '#');
+	LispFputs(Stdout, format_integer(lisp__data.debug_level));
+	LispFputs(Stdout, "> (");
+	LispWriteObject(NIL, CAR(CAR(DBG)));
+	LispFputc(Stdout, ' ');
+	LispWriteObject(NIL, CAR(CDR(CAR(DBG))));
+	LispFputs(Stdout, ")\n");
+	LispDebuggerCommand(NIL);
+    }
+    else if (call == LispDebugCallEnd) {
+	LispFputc(Stdout, '#');
+	LispFputs(Stdout, format_integer(lisp__data.debug_level + 1));
+	LispFputs(Stdout, "= ");
+	LispWriteObject(NIL, arg);
+	LispFputc(Stdout, '\n');
+	LispDebuggerCommand(NIL);
+    }
+    else if (force)
+	LispDebuggerCommand(arg);
+
+debugger_done:
+    return;
+}
+
+static void
+LispDebuggerCommand(LispObj *args)
+{
+    LispObj *obj, *frm, *curframe;
+    int i = 0, frame, matches, action = -1, subaction = 0;
+    char *cmd, *arg, *ptr, line[256];
+
+    int envbase = lisp__data.stack.base,
+	envlen = lisp__data.env.length,
+	envlex = lisp__data.env.lex;
+
+    frame = lisp__data.debug_level;
+    curframe = CAR(DBG);
+
+    line[0] = '\0';
+    arg = line;
+    for (;;) {
+	LispFputs(Stdout, DBGPROMPT);
+	LispFflush(Stdout);
+	if (LispFgets(Stdin, line, sizeof(line)) == NULL) {
+	    LispFputc(Stdout, '\n');
+	    return;
+	}
+	/* get command */
+	ptr = line;
+	while (*ptr && isspace(*ptr))
+	    ++ptr;
+	cmd = ptr;
+	while (*ptr && !isspace(*ptr))
+	    ++ptr;
+	if (*ptr)
+	    *ptr++ = '\0';
+
+	if (*cmd) {	/* if *cmd is nul, then arg may be still set */
+	    /* get argument(s) */
+	    while (*ptr && isspace(*ptr))
+		++ptr;
+	    arg = ptr;
+	    /* goto end of line */
+	    if (*ptr) {
+		while (*ptr)
+		    ++ptr;
+		--ptr;
+		while (*ptr && isspace(*ptr))
+		    --ptr;
+		if (*ptr)
+		    *++ptr = '\0';
+	    }
+	}
+
+	if (*cmd == '\0') {
+	    if (action < 0) {
+		if (lisp__data.debug == LispDebugFinish)
+		    action = DebuggerFinish;
+		else if (lisp__data.debug == LispDebugNext)
+		    action = DebuggerNext;
+		else if (lisp__data.debug == LispDebugStep)
+		    action = DebuggerStep;
+		else if (lisp__data.debug == LispDebugRun)
+		    action = DebuggerContinue;
+		else
+		    continue;
+	    }
+	}
+	else {
+	    for (i = matches = 0; i < sizeof(commands) / sizeof(commands[0]);
+		 i++) {
+		char *str = commands[i].name;
+
+		ptr = cmd;
+		while (*ptr && *ptr == *str) {
+		    ++ptr;
+		    ++str;
+		}
+		if (*ptr == '\0') {
+		    action = commands[i].action;
+		    if (*str == '\0') {
+			matches = 1;
+			break;
+		    }
+		    ++matches;
+		}
+	    }
+	    if (matches == 0) {
+		LispFputs(Stdout, "* Command unknown: ");
+		LispFputs(Stdout, cmd);
+		LispFputs(Stdout, ". Type help for help.\n");
+		continue;
+	    }
+	    else if (matches > 1) {
+		LispFputs(Stdout, "* Command is ambiguous: ");
+		LispFputs(Stdout, cmd);
+		LispFputs(Stdout, ". Type help for help.\n");
+		continue;
+	    }
+	}
+
+	switch (action) {
+	    case DebuggerHelp:
+		LispFputs(Stdout, debugger_help);
+		break;
+	    case DebuggerInfo:
+		if (*arg == '\0') {
+		    LispFputs(Stdout, debugger_info_help);
+		    break;
+		}
+
+		for (i = matches = 0;
+		     i < sizeof(info_commands) / sizeof(info_commands[0]);
+		     i++) {
+		    char *str = info_commands[i].name;
+
+		    ptr = arg;
+		    while (*ptr && *ptr == *str) {
+			++ptr;
+			++str;
+		    }
+		    if (*ptr == '\0') {
+			subaction = info_commands[i].subaction;
+			if (*str == '\0') {
+			    matches = 1;
+			    break;
+			}
+			++matches;
+		    }
+		}
+		if (matches == 0) {
+		    LispFputs(Stdout, "* Command unknown: ");
+		    LispFputs(Stdout, arg);
+		    LispFputs(Stdout, ". Type info for help.\n");
+		    continue;
+		}
+		else if (matches > 1) {
+		    LispFputs(Stdout, "* Command is ambiguous: ");
+		    LispFputs(Stdout, arg);
+		    LispFputs(Stdout, ". Type info for help.\n");
+		    continue;
+		}
+
+		switch (subaction) {
+		    case DebuggerInfoBreakpoints:
+			LispFputs(Stdout, "Num\tHits\tType\t\tWhat\n");
+			for (obj = BRK; obj != NIL; obj = CDR(obj)) {
+			    /* breakpoint number */
+			    LispFputc(Stdout, '#');
+			    LispWriteObject(NIL, CAR(CDR(CAR(obj))));
+
+			    /* number of hits */
+			    LispFputc(Stdout, '\t');
+			    LispWriteObject(NIL, CAR(CDR(CDR(CDR(CAR(obj))))));
+
+			    /* breakpoint type */
+			    LispFputc(Stdout, '\t');
+			    switch ((int)FIXNUM_VALUE(CAR(CDR(CDR(CAR(obj)))))) {
+				case LispDebugBreakFunction:
+				    LispFputs(Stdout, "Function");
+				    break;
+				case LispDebugBreakVariable:
+				    LispFputs(Stdout, "Variable");
+				    break;
+			    }
+
+			    /* breakpoint object */
+			    LispFputc(Stdout, '\t');
+			    LispWriteObject(NIL, CAR(CAR(obj)));
+			    LispFputc(Stdout, '\n');
+			}
+			break;
+		    case DebuggerInfoBacktrace:
+			goto debugger_print_backtrace;
+		}
+		break;
+	    case DebuggerAbort:
+		while (lisp__data.mem.level) {
+		    --lisp__data.mem.level;
+		    if (lisp__data.mem.mem[lisp__data.mem.level])
+			free(lisp__data.mem.mem[lisp__data.mem.level]);
+		}
+		lisp__data.mem.index = 0;
+		LispTopLevel();
+		if (!lisp__data.running) {
+		    LispMessage("*** Fatal: nowhere to longjmp.");
+		    abort();
+		}
+		/* don't need to restore environment */
+		siglongjmp(lisp__data.jmp, 1);
+		/*NOTREACHED*/
+		break;
+	    case DebuggerBreak:
+		for (ptr = arg; *ptr; ptr++) {
+		    if (isspace(*ptr))
+			break;
+		    else
+			*ptr = toupper(*ptr);
+		}
+
+		if (!*arg || *ptr || strchr(arg, '(') || strchr(arg, '(') ||
+		    strchr(arg, ';')) {
+		    LispFputs(Stdout, "* Bad function name '");
+		    LispFputs(Stdout, arg);
+		    LispFputs(Stdout, "' specified.\n");
+		}
+		else {
+		    for (obj = frm = BRK; obj != NIL; frm = obj, obj = CDR(obj))
+			;
+		    i = lisp__data.debug_break;
+		    ++lisp__data.debug_break;
+		    GCDisable();
+		    obj = CONS(ATOM(arg),
+			       CONS(FIXNUM(i),
+				    CONS(FIXNUM(LispDebugBreakFunction),
+					 CONS(FIXNUM(0), NIL))));
+		    if (BRK == NIL)
+			BRK = CONS(obj, NIL);
+		    else
+			RPLACD(frm, CONS(obj, NIL));
+		    GCEnable();
+		}
+		break;
+	    case DebuggerWatch: {
+		void *sym;
+		int vframe;
+		LispObj *val, *atom;
+
+		/* make variable name uppercase, an ATOM */
+		ptr = arg;
+		while (*ptr) {
+		    *ptr = toupper(*ptr);
+		    ++ptr;
+		}
+		atom = ATOM(arg);
+		val = LispGetVar(atom);
+		if (val == NULL) {
+		    LispFputs(Stdout, "* No variable named '");
+		    LispFputs(Stdout, arg);
+		    LispFputs(Stdout, "' in the selected frame.\n");
+		    break;
+		}
+
+		/* variable is available at the current frame */
+		sym = LispGetVarAddr(atom);
+
+		/* find the lowest frame where the variable is visible */
+		vframe = 0;
+		if (frame > 0) {
+		    for (; vframe < frame; vframe++) {
+			for (frm = DBG, i = lisp__data.debug_level; i > vframe;
+			     frm = CDR(frm), i--)
+			    ;
+			obj = CAR(frm);
+			lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(obj))));
+			lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(obj)))));
+			lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(obj)))));
+
+			if (LispGetVarAddr(atom) == sym)
+			    /* got variable initial frame */
+			    break;
+		    }
+		    vframe = i;
+		    if (vframe != frame) {
+			/* restore environment */
+			for (frm = DBG, i = lisp__data.debug_level; i > frame;
+			     frm = CDR(frm), i--)
+			    ;
+			obj = CAR(frm);
+			lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(obj))));
+			lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(obj)))));
+			lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(obj)))));
+		    }
+		}
+
+		i = lisp__data.debug_break;
+		++lisp__data.debug_break;
+		for (obj = frm = BRK; obj != NIL; frm = obj, obj = CDR(obj))
+		    ;
+
+		GCDisable();
+		obj = CONS(atom,					/* NAM */
+			   CONS(FIXNUM(i),				/* IDX */
+				CONS(FIXNUM(LispDebugBreakVariable),	/* TYP */
+				     CONS(FIXNUM(0),			/* HIT */
+					  CONS(OPAQUE(sym, 0),		/* VAR */
+					       CONS(val,		/* VAL */
+						    CONS(FIXNUM(vframe),/* FRM */
+							      NIL)))))));
+
+		/* add watchpoint */
+		if (BRK == NIL)
+		    BRK = CONS(obj, NIL);
+		else
+		    RPLACD(frm, CONS(obj, NIL));
+		GCEnable();
+	    }	break;
+	    case DebuggerDelete:
+		if (*arg == 0) {
+		    int confirm = 0;
+
+		    for (;;) {
+			int ch;
+
+			LispFputs(Stdout, "* Delete all breakpoints? (y or n) ");
+			LispFflush(Stdout);
+			if ((ch = LispFgetc(Stdin)) == '\n')
+			    continue;
+			while ((i = LispFgetc(Stdin)) != '\n' && i != EOF)
+			    ;
+			if (tolower(ch) == 'n')
+			    break;
+			else if (tolower(ch) == 'y') {
+			    confirm = 1;
+			    break;
+			}
+		    }
+		    if (confirm)
+			BRK = NIL;
+		}
+		else {
+		    for (ptr = arg; *ptr;) {
+			while (*ptr && isdigit(*ptr))
+			    ++ptr;
+			if (*ptr && !isspace(*ptr)) {
+			    *ptr = '\0';
+			    LispFputs(Stdout, "* Bad breakpoint number '");
+			    LispFputs(Stdout, arg);
+			    LispFputs(Stdout, "' specified.\n");
+			    break;
+			}
+			i = atoi(arg);
+			for (obj = frm = BRK; frm != NIL;
+			     obj = frm, frm = CDR(frm))
+			    if (FIXNUM_VALUE(CAR(CDR(CAR(frm)))) == i)
+				break;
+			if (frm == NIL) {
+			    LispFputs(Stdout, "* No breakpoint number ");
+			    LispFputs(Stdout, arg);
+			    LispFputs(Stdout, " available.\n");
+			    break;
+			}
+			if (obj == frm)
+			    BRK = CDR(BRK);
+			else
+			    RPLACD(obj, CDR(frm));
+			while (*ptr && isspace(*ptr))
+			    ++ptr;
+			arg = ptr;
+		    }
+		}
+		break;
+	    case DebuggerFrame:
+		i = -1;
+		ptr = arg;
+		if (*ptr) {
+		    i = 0;
+		    while (*ptr && isdigit(*ptr)) {
+			i *= 10;
+			i += *ptr - '0';
+			++ptr;
+		    }
+		    if (*ptr) {
+			LispFputs(Stdout, "* Frame identifier must "
+				"be a positive number.\n");
+			break;
+		    }
+		}
+		else
+		    goto debugger_print_frame;
+		if (i >= 0 && i <= lisp__data.debug_level)
+		    goto debugger_new_frame;
+		LispFputs(Stdout, "* No such frame ");
+		LispFputs(Stdout, format_integer(i));
+		LispFputs(Stdout, ".\n");
+		break;
+	    case DebuggerDown:
+		if (frame + 1 > lisp__data.debug_level) {
+		    LispFputs(Stdout, "* Cannot go down.\n");
+		    break;
+		}
+		i = frame + 1;
+		goto debugger_new_frame;
+		break;
+	    case DebuggerUp:
+		if (frame == 0) {
+		    LispFputs(Stdout, "* Cannot go up.\n");
+		    break;
+		}
+		i = frame - 1;
+		goto debugger_new_frame;
+		break;
+	    case DebuggerPrint:
+		ptr = arg;
+		while (*ptr) {
+		    *ptr = toupper(*ptr);
+		    ++ptr;
+		}
+		obj = LispGetVar(ATOM(arg));
+		if (obj != NULL) {
+		    LispWriteObject(NIL, obj);
+		    LispFputc(Stdout, '\n');
+		}
+		else {
+		    LispFputs(Stdout, "* No variable named '");
+		    LispFputs(Stdout, arg);
+		    LispFputs(Stdout, "' in the selected frame.\n");
+		}
+		break;
+	    case DebuggerBacktrace:
+debugger_print_backtrace:
+		if (DBG == NIL) {
+		    LispFputs(Stdout, "* No stack.\n");
+		    break;
+		}
+		DBG = LispReverse(DBG);
+		for (obj = DBG, i = 0; obj != NIL; obj = CDR(obj), i++) {
+		    frm = CAR(obj);
+		    LispFputc(Stdout, '#');
+		    LispFputs(Stdout, format_integer(i));
+		    LispFputs(Stdout, "> (");
+		    LispWriteObject(NIL, CAR(frm));
+		    LispFputc(Stdout, ' ');
+		    LispWriteObject(NIL, CAR(CDR(frm)));
+		    LispFputs(Stdout, ")\n");
+		}
+		DBG = LispReverse(DBG);
+		break;
+	    case DebuggerContinue:
+		lisp__data.debug = LispDebugRun;
+		goto debugger_command_done;
+	    case DebuggerFinish:
+		if (lisp__data.debug != LispDebugFinish) {
+		    lisp__data.debug_step = lisp__data.debug_level - 2;
+		    lisp__data.debug = LispDebugFinish;
+		}
+		else
+		    lisp__data.debug_step = lisp__data.debug_level - 1;
+		goto debugger_command_done;
+	    case DebuggerNext:
+		if (lisp__data.debug != LispDebugNext) {
+		    lisp__data.debug = LispDebugNext;
+		    lisp__data.debug_step = lisp__data.debug_level + 1;
+		}
+		goto debugger_command_done;
+	    case DebuggerStep:
+		lisp__data.debug = LispDebugStep;
+		goto debugger_command_done;
+	}
+	continue;
+
+debugger_new_frame:
+	/* goto here with i as the new frame value, after error checking */
+	if (i != frame) {
+	    frame = i;
+	    for (frm = DBG, i = lisp__data.debug_level;
+		 i > frame; frm = CDR(frm), i--)
+		;
+	    curframe = CAR(frm);
+	    lisp__data.stack.base = FIXNUM_VALUE(CAR(CDR(CDR(curframe))));
+	    lisp__data.env.length = FIXNUM_VALUE(CAR(CDR(CDR(CDR(curframe)))));
+	    lisp__data.env.lex = FIXNUM_VALUE(CDR(CDR(CDR(CDR(curframe)))));
+	}
+debugger_print_frame:
+	LispFputc(Stdout, '#');
+	LispFputs(Stdout, format_integer(frame));
+	LispFputs(Stdout, "> (");
+	LispWriteObject(NIL, CAR(curframe));
+	LispFputc(Stdout, ' ');
+	LispWriteObject(NIL, CAR(CDR(curframe)));
+	LispFputs(Stdout, ")\n");
+    }
+
+debugger_command_done:
+    lisp__data.stack.base = envbase;
+    lisp__data.env.length = envlen;
+    lisp__data.env.lex = envlex;
+}
+
+static char *
+format_integer(int integer)
+{
+    static char buffer[16];
+
+    sprintf(buffer, "%d", integer);
+
+    return (buffer);
+}
+
+#endif /* DEBUGGER */
diff --git a/lisp/debugger.h b/lisp/debugger.h
new file mode 100644
index 0000000..98bd962
--- /dev/null
+++ b/lisp/debugger.h
@@ -0,0 +1,72 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/debugger.h,v 1.7 2002/11/08 08:00:56 paulo Exp $ */
+
+#ifndef Lisp_debugger_h
+#define Lisp_debugger_h
+
+/*
+ * Definitions
+ */
+#define	DBGPROMPT	"DEBUG> "
+#ifdef DEBUGGER
+
+/*
+ * Types
+ */
+typedef enum _LispDebugState {
+    LispDebugUnspec,	/* initial state */
+    LispDebugRun,	/* just run, until breakpoint or error */
+    LispDebugFinish,	/* evaluates until selected form is finished */
+    LispDebugNext,	/* evaluate form */
+    LispDebugStep	/* evaluate form, and step on subforms */
+} LispDebugState;
+
+typedef enum _LispDebugCall {
+    LispDebugCallBegin,
+    LispDebugCallEnd,
+    LispDebugCallFatal,
+    LispDebugCallWatch	/* just remove watched variables that lost context */
+} LispDebugCall;
+
+typedef enum _LispDebugBreak {
+    LispDebugBreakFunction,
+    LispDebugBreakVariable
+} LispDebugBreak;
+
+#include "private.h"
+
+/*
+ * Prototypes
+ */
+void LispDebugger(LispDebugCall, LispObj*, LispObj*);
+
+#endif /* DEBUGGER */
+#endif /* Lisp_debugger_h */
diff --git a/lisp/env.c b/lisp/env.c
new file mode 100644
index 0000000..a5da90c
--- /dev/null
+++ b/lisp/env.c
@@ -0,0 +1,151 @@
+/*
+ * Provide setenv() and unsetenv() on platforms that don't have them.
+ * From FreeBSD's libc.
+ */
+
+/*
+ * Copyright (c) 1987, 1993
+ *      The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *      This product includes software developed by the University of
+ *      California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/env.c,v 1.1 2002/03/05 03:52:34 dawes Exp $ */
+
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <string.h>
+
+extern char **environ;
+
+extern int setenv(const char *name, const char *value, int overwrite);
+extern void unsetenv(const char *name);
+
+static char *
+findenv(const char *name, int *offset)
+{
+    int len, i;
+    const char *np;
+    char **p, *cp;
+
+    if (name == NULL || environ == NULL)
+	return NULL;
+
+    for (np = name; *np && *np != '='; ++np)
+	continue;
+    len = np - name;
+    for (p = environ; (cp = *p) != NULL; ++p) {
+	for (np = name, i = len; i && *cp; i--)
+	    if (*cp++ != *np++)
+		break;
+	if (i == 0 && *cp++ == '=') {
+	    *offset = p - environ;
+	    return cp;
+	}
+    }
+    return NULL;
+}
+
+/*
+ * setenv --
+ *      Set the value of the environmental variable "name" to be
+ *      "value".  If overwrite is set, replace any current value.
+ */
+
+int
+setenv(const char *name, const char *value, int overwrite)
+{
+    static char **alloced;			/* if allocated space before */
+    char *c;
+    int l_value, offset;
+
+    if (*value == '=')				/* no '=' in value */
+	++value;
+    l_value = strlen(value);
+    if ((c = findenv(name, &offset))) {		/* find if already exists */
+	if (!overwrite)
+	    return 0;
+	if (strlen(c) >= l_value) {		/* old larger; copy over */
+	    while ((*c++ = *value++))
+		;
+	    return 0;
+	}
+    } else {					/* create new slot */
+	int cnt;
+	char **p;
+
+	for (p = environ, cnt = 0; *p; ++p, ++cnt)
+	    ;
+	if (alloced == environ) {		/* just increase size */
+	    p = (char **)realloc((char *)environ,
+				 sizeof(char *) * (cnt + 2));
+	    if (!p)
+		return -1;
+	    alloced = environ = p;
+	} else {				/* get new space */
+						/* copy old entries into it */
+	    p = malloc(sizeof(char *) * (cnt + 2));
+	    if (!p)
+		return -1;
+	    memcpy(p, environ, cnt * sizeof(char *));
+	    alloced = environ = p;
+	}
+	environ[cnt + 1] = NULL;
+	offset = cnt;
+    }
+    for (c = (char *)name; *c && *c != '='; ++c)	/* no '=' in name */
+	;
+    if (!(environ[offset] =				/* name + '=' + value */
+			malloc((int)(c - name) + l_value + 2)))
+	return -1;
+    for (c = environ[offset]; (*c = *name++) && *c != '='; ++c)
+	;
+    for (*c++ = '='; (*c++ = *value++); )
+	;
+    return 0;
+}
+
+/*
+ * unsetenv(name) --
+ *      Delete environmental variable "name".
+ */
+
+void
+unsetenv(const char *name)
+{
+    char **p;
+    int offset;
+
+    while (findenv(name, &offset))		/* if set multiple times */
+	for (p = &environ[offset];; ++p)
+	    if (!(*p = *(p + 1)))
+		break;
+}
+
diff --git a/lisp/format.c b/lisp/format.c
new file mode 100644
index 0000000..aa593d6
--- /dev/null
+++ b/lisp/format.c
@@ -0,0 +1,2121 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/format.c,v 1.28 2002/11/30 23:13:11 paulo Exp $ */
+
+#include "io.h"
+#include "write.h"
+#include "format.h"
+#include <ctype.h>
+
+#define MAXFMT			8
+#define NOERROR			0
+
+/* parse error codes */
+#define PARSE_2MANYPARM		1	/* too many directive parameters */
+#define PARSE_2MANYATS		2	/* more than one @ in directive */
+#define PARSE_2MANYCOLS		3	/* more than one : in directive */
+#define PARSE_NOARGSLEFT	4	/* no arguments left to format */
+#define PARSE_BADFMTARG		5	/* argument is not an integer or char */
+#define PARSE_BADDIRECTIVE	6	/* unknown format directive */
+#define PARSE_BADINTEGER	7	/* bad integer representation */
+
+/* merge error codes */
+#define MERGE_2MANY		1	/* too many parameters to directive */
+#define MERGE_NOCHAR		2	/* parameter must be a character */
+#define MERGE_NOINT		3	/* parameter must be an integer */
+
+/* generic error codes */
+#define GENERIC_RADIX		1	/* radix not in range 2-36 */
+#define GENERIC_NEGATIVE	2	/* parameter is negative */
+#define GENERIC_BADSTRING	3	/* argument is not a string */
+#define GENERIC_BADLIST		4	/* argument is not a list */
+
+#define IF_SPECIFIED(arg)	(arg).specified ? &((arg).value) : NULL
+
+#define UPANDOUT_NORMAL		1
+#define UPANDOUT_COLLON		2
+#define UPANDOUT_HASH		4	/* only useful inside a ~{ iteration
+					 * forces loop finalization. */
+
+#define ITERATION_NORMAL	1
+#define ITERATION_LAST		2
+
+/*
+ * Types
+ */
+/* parameter to format */
+typedef struct {
+    unsigned int achar : 1;	/* value was specified as a character */
+    unsigned int specified : 1;	/* set if value was specified */
+    unsigned int offset : 30;	/* offset in format string, for error printing */
+    int value;
+} FmtArg;
+
+/* information about format parameters */
+typedef struct {
+    unsigned int atsign : 1;	/* @ specified */
+    unsigned int collon : 1;	/* : specified */
+    unsigned int command : 8;	/* the format command */
+    unsigned int count : 4;	/* number of arguments processed */
+    unsigned int offset : 10;	/* offset in format string, for error printing */
+    char *base, *format;
+    FmtArg arguments[MAXFMT];
+} FmtArgs;
+
+/* used for combining default format parameter values */
+typedef struct {
+    int achar;
+    int value;
+} FmtDef;
+
+/* number of default format parameter values and defaults */
+typedef struct {
+    int count;
+    FmtDef defaults[MAXFMT];
+} FmtDefs;
+
+/* used on recursive calls to LispFormat */
+typedef struct {
+    FmtArgs args;
+    LispObj *base_arguments;	/* pointer to first format argument */
+    int total_arguments;	/* number of objects in base_arguments */
+    char **format;		/* if need to update format string pointer */
+    LispObj **object;		/* CAR(arguments), for plural check */
+    LispObj **arguments;	/* current element of base_arguments */
+    int *num_arguments;		/* number of arguments after arguments */
+    int upandout;		/* information for recursive calls */
+    int iteration;		/* only set if in ~:{... or ~:@{ and in the
+				 * last argument list, hint for upandout */
+} FmtInfo;
+
+/*
+ * Prototypes
+ */
+static void merge_arguments(FmtArgs*, FmtDefs*, int*);
+static char *parse_arguments(char*, FmtArgs*, int*, LispObj**, int*);
+static void merge_error(FmtArgs*, int);
+static void parse_error(FmtArgs*, int);
+static void generic_error(FmtArgs*, int);
+static void format_error(FmtArgs*, char*);
+
+static int format_object(LispObj*, LispObj*);
+
+static void format_ascii(LispObj*, LispObj*, FmtArgs*);
+static void format_in_radix(LispObj*, LispObj*, int, FmtArgs*);
+static void format_radix_special(LispObj*, LispObj*, FmtArgs*);
+static void format_roman(LispObj*, LispObj*, FmtArgs*);
+static void format_english(LispObj*, LispObj*, FmtArgs*);
+static void format_character(LispObj*, LispObj*, FmtArgs*);
+static void format_fixed_float(LispObj*, LispObj*, FmtArgs*);
+static void format_exponential_float(LispObj*, LispObj*, FmtArgs*);
+static void format_general_float(LispObj*, LispObj*, FmtArgs*);
+static void format_dollar_float(LispObj*, LispObj*, FmtArgs*);
+static void format_tabulate(LispObj*, FmtArgs*);
+
+static void format_goto(FmtInfo*);
+static void format_indirection(LispObj*, LispObj*, FmtInfo*);
+
+static void list_formats(FmtInfo*, int, char**, char***, int*, int*, int*, int*);
+static void free_formats(char**, int);
+
+static void format_case_conversion(LispObj*, FmtInfo*);
+static void format_conditional(LispObj*, FmtInfo*);
+static void format_iterate(LispObj*, FmtInfo*);
+static void format_justify(LispObj*, FmtInfo*);
+
+static void LispFormat(LispObj*, FmtInfo*);
+
+/*
+ * Initialization
+ */
+static FmtDefs AsciiDefs = {
+    4,
+    {
+	{0, 0},			/* mincol */
+	{0, 1},			/* colinc */
+	{0, 0},			/* minpad */
+	{1, ' '},		/* padchar */
+    },
+};
+
+static FmtDefs IntegerDefs = {
+    4,
+    {
+	{0, 0},			/* mincol */
+	{1, ' '},		/* padchar */
+	{1, ','},		/* commachar */
+	{0, 3},			/* commainterval */
+    },
+};
+
+static FmtDefs RadixDefs = {
+    5,
+    {
+	{0, 10},		/* radix */
+	{0, 0},			/* mincol */
+	{1, ' '},		/* padchar */
+	{1, ','},		/* commachar */
+	{0, 3},			/* commainterval */
+    },
+};
+
+static FmtDefs NoneDefs = {
+    0,
+};
+
+static FmtDefs FixedFloatDefs = {
+    5,
+    {
+	{0, 0},			/* w */
+	{0, 16},		/* d */
+	{0, 0},			/* k */
+	{1, '\0'},		/* overflowchar */
+	{1, ' '},		/* padchar */
+    },
+};
+
+static FmtDefs ExponentialFloatDefs = {
+    7,
+    {
+	{0, 0},			/* w */
+	{0, 16},		/* d */
+	{0, 0},			/* e */
+	{0, 1},			/* k */
+	{1, '\0'},		/* overflowchar */
+	{1, ' '},		/* padchar */
+	{1, 'E'},		/* exponentchar */
+	/* XXX if/when more than one float format,
+	 * should default to object type */
+    },
+};
+
+static FmtDefs DollarFloatDefs = {
+    4,
+    {
+	{0, 2},			/* d */
+	{0, 1},			/* n */
+	{0, 0},			/* w */
+	{1, ' '},		/* padchar */
+    },
+};
+
+static FmtDefs OneDefs = {
+    1,
+    {
+	{0, 1},
+    },
+};
+
+static FmtDefs TabulateDefs = {
+    2,
+    {
+	{0, 0},			/* colnum */
+	{0, 1},			/* colinc */
+    },
+};
+
+extern LispObj *Oprint_escape;
+
+/*
+ * Implementation
+ */
+static void
+merge_arguments(FmtArgs *arguments, FmtDefs *defaults, int *code)
+{
+    int count;
+    FmtDef *defaul;
+    FmtArg *argument;
+
+    defaul = &(defaults->defaults[0]);
+    argument = &(arguments->arguments[0]);
+    for (count = 0; count < defaults->count; count++, argument++, defaul++) {
+	if (count >= arguments->count)
+	    argument->specified = 0;
+	if (argument->specified) {
+	    if (argument->achar != defaul->achar) {
+		*code = defaul->achar ? MERGE_NOCHAR : MERGE_NOINT;
+		arguments->offset = argument->offset;
+		return;
+	    }
+	}
+	else {
+	    argument->specified = 0;
+	    argument->achar = defaul->achar;
+	    argument->value = defaul->value;
+	}
+    }
+
+    /* check if extra arguments were provided */
+    if (arguments->count > defaults->count)
+	*code = MERGE_2MANY;
+}
+
+/* the pointer arguments may be null, useful when just testing/parsing
+ * the directive parameters */
+static char *
+parse_arguments(char *format, FmtArgs *arguments,
+		int *num_objects, LispObj **objects, int *code)
+{
+    int test;
+    char *ptr;
+    FmtArg *argument;
+    unsigned int tmpcmd = 0;
+
+    /* initialize */
+    test = objects == NULL || code == NULL || num_objects == NULL;
+    ptr = format;
+    argument = &(arguments->arguments[0]);
+    arguments->atsign = arguments->collon = arguments->command = 0;
+
+    /* parse format parameters */
+    for (arguments->count = 0;; arguments->count++) {
+	arguments->offset = ptr - format + 1;
+	if (arguments->count >= MAXFMT) {
+	    if (!test)
+		*code = PARSE_2MANYPARM;
+	    return (ptr);
+	}
+	if (*ptr == '\'') {		/* character parameter value */
+	    ++ptr;			/* skip ' */
+	    argument->achar = argument->specified = 1;
+	    argument->value = *ptr++;
+	}
+	else if (*ptr == ',') {		/* use default parameter value */
+	    argument->achar = 0;
+	    argument->specified = 0;
+	    /* don't increment ptr, will be incremented below */
+	}
+	else if (*ptr == '#') {		/* number of arguments is value */
+	    ++ptr;			/* skip # */
+	    argument->achar = 0;
+	    argument->specified = 1;
+	    if (!test)
+		argument->value = *num_objects;
+	}
+	else if (*ptr == 'v' ||
+		 *ptr == 'V') {		/* format object argument is value */
+	    LispObj *object;
+
+	    ++ptr;			/* skip V */
+	    if (!test) {
+		if (!CONSP(*objects)) {
+		    *code = PARSE_NOARGSLEFT;
+		    return (ptr);
+		}
+		object = CAR((*objects));
+		if (FIXNUMP(object)) {
+		    argument->achar = 0;
+		    argument->specified = 1;
+		    argument->value = FIXNUM_VALUE(object);
+		}
+		else if (SCHARP(object)) {
+		    argument->achar = argument->specified = 1;
+		    argument->value = SCHAR_VALUE(object);
+		}
+		else {
+		    *code = PARSE_BADFMTARG;
+		    return (ptr);
+		}
+		*objects = CDR(*objects);
+		--*num_objects;
+	    }
+	}
+	else if (isdigit(*ptr) ||
+		*ptr == '-' || *ptr == '+') {	/* integer parameter value */
+	    int sign;
+
+	    argument->achar = 0;
+	    argument->specified = 1;
+	    if (!isdigit(*ptr)) {
+		sign = *ptr++ == '-';
+	    }
+	    else
+		sign = 0;
+	    if (!test && !isdigit(*ptr)) {
+		*code = PARSE_BADINTEGER;
+		return (ptr);
+	    }
+	    argument->value = *ptr++ - '0';
+	    while (isdigit(*ptr)) {
+		argument->value = (argument->value * 10) + (*ptr++ - '0');
+		if (argument->value > 65536) {
+		    if (!test) {
+			*code = PARSE_BADINTEGER;
+			return (ptr);
+		    }
+		}
+	    }
+	    if (sign)
+		argument->value = -argument->value;
+	}
+	else				/* no more arguments to format */
+	    break;
+
+	if (*ptr == ',')
+	    ++ptr;
+
+	/* remember offset of format parameter, for better error printing */
+	argument->offset = arguments->offset;
+	argument++;
+    }
+
+    /* check for extra flags */
+    for (;;) {
+	if (*ptr == '@') {		/* check for special parameter atsign */
+	    if (arguments->atsign) {
+		if (!test) {
+		    *code = PARSE_2MANYATS;
+		    return (ptr);
+		}
+	    }
+	    ++ptr;
+	    ++arguments->offset;
+	    arguments->atsign = 1;
+	}
+	else if (*ptr == ':') {		/* check for special parameter collon */
+	    if (arguments->collon) {
+		if (!test) {
+		    *code = PARSE_2MANYCOLS;
+		    return (ptr);
+		}
+	    }
+	    ++ptr;
+	    ++arguments->offset;
+	    arguments->collon = 1;
+	}
+	else				/* next value is format command */
+	    break;
+    }
+
+    if (!test)
+	*code = NOERROR;
+    arguments->command = *ptr++;
+    tmpcmd = arguments->command;
+    if (islower(tmpcmd))
+	arguments->command = toupper(tmpcmd);
+    ++arguments->offset;
+
+    return (ptr);
+}
+
+static void
+parse_error(FmtArgs *args, int code)
+{
+    static char *errors[] = {
+	NULL,
+	"too many parameters to directive",
+	"too many @ parameters",
+	"too many : parameters",
+	"no arguments left to format",
+	"argument is not a fixnum integer or a character",
+	"unknown format directive",
+	"parameter is not a fixnum integer",
+    };
+
+    format_error(args, errors[code]);
+}
+
+static void
+merge_error(FmtArgs *args, int code)
+{
+    static char *errors[] = {
+	NULL,
+	"too many parameters to directive",
+	"argument must be a character",
+	"argument must be a fixnum integer",
+    };
+
+    format_error(args, errors[code]);
+}
+
+static void
+generic_error(FmtArgs *args, int code)
+{
+    static char *errors[] = {
+	NULL,
+	"radix must be in the range 2 to 36, inclusive",
+	"parameter must be positive",
+	"argument must be a string",
+	"argument must be a list",
+    };
+
+    format_error(args, errors[code]);
+}
+
+static void
+format_error(FmtArgs *args, char *str)
+{
+    char *message;
+    int errorlen, formatlen;
+
+    /* number of bytes of format to be printed */
+    formatlen = (args->format - args->base) + args->offset;
+
+    /* length of specific error message */
+    errorlen = strlen(str) + 1;			/* plus '\n' */
+
+    /* XXX allocate string with LispMalloc,
+     * so that it will be freed in LispTopLevel */
+    message = LispMalloc(formatlen + errorlen + 1);
+
+    sprintf(message, "%s\n", str);
+    memcpy(message + errorlen, args->base, formatlen);
+    message[errorlen + formatlen] = '\0';
+
+    LispDestroy("FORMAT: %s", message);
+}
+
+static int
+format_object(LispObj *stream, LispObj *object)
+{
+    int length;
+
+    length = LispWriteObject(stream, object);
+
+    return (length);
+}
+
+static void
+format_ascii(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    GC_ENTER();
+    LispObj *string = NIL;
+    int length = 0,
+	atsign = args->atsign,
+	collon = args->collon,
+	mincol = args->arguments[0].value,
+	colinc = args->arguments[1].value,
+	minpad = args->arguments[2].value,
+	padchar = args->arguments[3].value;
+
+    /* check/correct arguments */
+    if (mincol < 0)
+	mincol = 0;
+    if (colinc < 0)
+	colinc = 1;
+    if (minpad < 0)
+	minpad = 0;
+    /* XXX pachar can be the null character? */
+
+    if (object == NIL)
+	length = collon ? 2 : 3;	    /* () or NIL */
+
+    /* left padding */
+    if (atsign) {
+	/* if length not yet known */
+	if (object == NIL) {
+	    string = LSTRINGSTREAM("", STREAM_READ | STREAM_WRITE, 0);
+	    GC_PROTECT(string);
+	    length = LispWriteObject(string, object);
+	}
+
+	/* output minpad characters at left */
+	if (minpad) {
+	    length += minpad;
+	    LispWriteChars(stream, padchar, minpad);
+	}
+
+	if (colinc) {
+	    /* puts colinc spaces at a time,
+	     * until at least mincol chars out */
+	    while (length < mincol) {
+		LispWriteChars(stream, padchar, colinc);
+		length += colinc;
+	    }
+	}
+    }
+
+    if (object == NIL) {
+	if (collon)
+	    LispWriteStr(stream, "()", 2);
+	else
+	    LispWriteStr(stream,  Snil, 3);
+    }
+    else {
+	/* if string is not NIL, atsign was specified
+	 * and object printed to string */
+	if (string == NIL)
+	    length = format_object(stream, object);
+	else {
+	    int size;
+	    char *str = LispGetSstring(SSTREAMP(string), &size);
+
+	    LispWriteStr(stream, str, size);
+	}
+    }
+
+    /* right padding */
+    if (!atsign) {
+	/* output minpad characters at left */
+	if (minpad) {
+	    length += minpad;
+	    LispWriteChars(stream, padchar, minpad);
+	}
+	if (colinc) {
+	    /* puts colinc spaces at a time,
+	     * until at least mincol chars out */
+	    while (length < mincol) {
+		LispWriteChars(stream, padchar, colinc);
+		length += colinc;
+	    }
+	}
+    }
+
+    GC_LEAVE();
+}
+
+/* assumes radix is 0 or in range 2 - 36 */
+static void
+format_in_radix(LispObj *stream, LispObj *object, int radix, FmtArgs *args)
+{
+    if (INTEGERP(object)) {
+	int i, check, atsign, collon, mincol, padchar, commachar, commainterval;
+
+	i = check = (radix == 0);
+	atsign = args->atsign;
+	collon = args->collon;
+	if (radix == 0) {
+	    radix = args->arguments[0].value;
+	    if (radix < 2 || radix > 36) {
+		args->offset = args->arguments[0].offset;
+		generic_error(args, GENERIC_RADIX);
+	    }
+	}
+	mincol = args->arguments[i++].value;
+	padchar = args->arguments[i++].value;
+	commachar = args->arguments[i++].value;
+	commainterval = args->arguments[i++].value;
+
+	LispFormatInteger(stream, object, radix, atsign, collon,
+			  mincol, padchar, commachar, commainterval);
+    }
+    else
+	format_object(stream, object);
+}
+
+static void
+format_radix_special(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    if (FIXNUMP(object)) {
+	if (args->atsign)
+	    format_roman(stream, object, args);
+	else
+	    format_english(stream, object, args);
+    }
+    else
+	format_object(stream, object);
+}
+
+static void
+format_roman(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    long value = 0;
+    int cando, new_roman = args->collon == 0;
+
+    if (FIXNUMP(object)) {
+	value = FIXNUM_VALUE(object);
+	if (new_roman)
+	    cando = value >= 1 && value <= 3999;
+	else
+	    cando = value >= 1 && value <= 4999;
+    }
+    else
+	cando = 0;
+
+    if (cando)
+	LispFormatRomanInteger(stream, value, new_roman);
+    else
+	format_object(stream, object);
+}
+
+static void
+format_english(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    int cando;
+    long number = 0;
+
+    if (FIXNUMP(object)) {
+	number = FIXNUM_VALUE(object);
+	cando = number >= -999999999 && number <= 999999999;
+    }
+    else
+	cando = 0;
+
+    if (cando)
+	LispFormatEnglishInteger(stream, number, args->collon);
+    else
+	format_object(stream, object);
+}
+
+static void
+format_character(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    if (SCHARP(object))
+	LispFormatCharacter(stream, object, args->atsign, args->collon);
+    else
+	format_object(stream, object);
+}
+
+static void
+format_fixed_float(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    if (FLOATP(object))
+	LispFormatFixedFloat(stream, object, args->atsign,
+			     args->arguments[0].value,
+			     IF_SPECIFIED(args->arguments[1]),
+			     args->arguments[2].value,
+			     args->arguments[3].value,
+			     args->arguments[4].value);
+    else
+	format_object(stream, object);
+}
+
+static void
+format_exponential_float(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    if (FLOATP(object))
+	LispFormatExponentialFloat(stream, object, args->atsign,
+				   args->arguments[0].value,
+				   IF_SPECIFIED(args->arguments[1]),
+				   args->arguments[2].value,
+				   args->arguments[3].value,
+				   args->arguments[4].value,
+				   args->arguments[5].value,
+				   args->arguments[6].value);
+    else
+	format_object(stream, object);
+}
+
+static void
+format_general_float(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    if (FLOATP(object))
+	LispFormatGeneralFloat(stream, object, args->atsign,
+				args->arguments[0].value,
+				IF_SPECIFIED(args->arguments[1]),
+				args->arguments[2].value,
+				args->arguments[3].value,
+				args->arguments[4].value,
+				args->arguments[5].value,
+				args->arguments[6].value);
+    else
+	format_object(stream, object);
+}
+
+static void
+format_dollar_float(LispObj *stream, LispObj *object, FmtArgs *args)
+{
+    if (FLOATP(object))
+	LispFormatDollarFloat(stream, object,
+			      args->atsign, args->collon,
+			      args->arguments[0].value,
+			      args->arguments[1].value,
+			      args->arguments[2].value,
+			      args->arguments[3].value);
+    else
+	format_object(stream, object);
+}
+
+static void
+format_tabulate(LispObj *stream, FmtArgs *args)
+{
+    int atsign = args->atsign,
+	colnum = args->arguments[0].value,
+	colinc = args->arguments[1].value,
+	column;
+
+    column = LispGetColumn(stream);
+
+    if (atsign) {
+	/* relative tabulation */
+	if (colnum > 0) {
+	    LispWriteChars(stream, ' ', colnum);
+	    column += colnum;
+	}
+	/* tabulate until at a multiple of colinc */
+	if (colinc > 0)
+	    LispWriteChars(stream, ' ', colinc - (column % colinc));
+    }
+    else {
+	/* if colinc not specified, just move to given column */
+	if (colinc <= 0)
+	    LispWriteChars(stream, ' ', column - colnum);
+	else {
+	    /* always output at least colinc spaces */
+	    do {
+		LispWriteChars(stream, ' ', colinc);
+		colnum -= colinc;
+	    } while (colnum > column);
+	}
+    }
+}
+
+static void
+format_goto(FmtInfo *info)
+{
+    int count, num_arguments;
+    LispObj *object, *arguments;
+
+    /* number of arguments to ignore or goto offset */
+    count = info->args.arguments[0].value;
+    if (count < 0)
+	generic_error(&(info->args), GENERIC_NEGATIVE);
+
+    if (info->args.atsign) {
+	/* absolute goto */
+
+	/* if not specified, defaults to zero */
+	if (!(info->args.arguments[0].specified))
+	    count = 0;
+
+	/* if offset too large */
+	if (count > info->total_arguments)
+	    parse_error(&(info->args), PARSE_NOARGSLEFT);
+	else if (count != info->total_arguments - *(info->num_arguments)) {
+	    /* calculate new parameters */
+	    object = NIL;
+	    arguments = info->base_arguments;
+	    num_arguments = info->total_arguments - count;
+
+	    for (; count > 0; count--, arguments = CDR(arguments))
+		object = CAR(arguments);
+
+	    /* update format information */
+	    *(info->object) = object;
+	    *(info->arguments) = arguments;
+	    *(info->num_arguments) = num_arguments;
+	}
+    }
+    else if (count) {
+	/* relative goto, ignore or go back count arguments */
+
+	/* prepare to update parameters */
+	arguments = *(info->arguments);
+	num_arguments = *(info->num_arguments);
+
+	/* go back count arguments? */
+	if (info->args.collon)
+	    count = -count;
+
+	num_arguments -= count;
+
+	if (count > 0) {
+	    if (count > *(info->num_arguments))
+		parse_error(&(info->args), PARSE_NOARGSLEFT);
+
+	    object = *(info->object);
+	    for (; count > 0; count--, arguments = CDR(arguments))
+		object = CAR(arguments);
+	}
+	else {		/* count < 0 */
+	    if (info->total_arguments + count - *(info->num_arguments) < 0)
+		parse_error(&(info->args), PARSE_NOARGSLEFT);
+
+	    object = NIL;
+	    arguments = info->base_arguments;
+	    for (count = 0; count < info->total_arguments - num_arguments;
+		count++, arguments = CDR(arguments))
+		object = CAR(arguments);
+	}
+
+	/* update format parameters */
+	*(info->object) = object;
+	*(info->arguments) = arguments;
+	*(info->num_arguments) = num_arguments;
+    }
+}
+
+static void
+format_indirection(LispObj *stream, LispObj *format, FmtInfo *info)
+{
+    char *string;
+    LispObj *object;
+    FmtInfo indirect_info;
+
+    if (!STRINGP(format))
+	generic_error(&(info->args), GENERIC_BADSTRING);
+    string = THESTR(format);
+
+    /* most information is the same */
+    memcpy(&indirect_info, info, sizeof(FmtInfo));
+
+    /* set new format string */
+    indirect_info.args.base = indirect_info.args.format = string;
+    indirect_info.format = &string;
+
+    if (info->args.atsign) {
+	/* use current arguments */
+
+	/* do the indirect format */
+	LispFormat(stream, &indirect_info);
+    }
+    else {
+	/* next argument is the recursive call arguments */
+
+	int num_arguments;
+
+	/* it is valid to not have a list following string, as string may
+	 * not have format directives */
+	if (CONSP(*(indirect_info.arguments)))
+	    object = CAR(*(indirect_info.arguments));
+	else
+	    object = NIL;
+
+	if (!LISTP(object) || !CONSP(*(info->arguments)))
+	    generic_error(&(info->args), GENERIC_BADLIST);
+
+	/* update information now */
+	*(info->object) = object;
+	*(info->arguments) = CDR(*(info->arguments));
+	*(info->num_arguments) -= 1;
+
+	/* set arguments for recursive call */
+	indirect_info.base_arguments = object;
+	indirect_info.arguments = &object;
+	for (num_arguments = 0; CONSP(object); object = CDR(object))
+	    ++num_arguments;
+
+	/* note that indirect_info.arguments is a pointer to "object",
+	 * keep it pointing to the correct object */
+	object = indirect_info.base_arguments;
+	indirect_info.total_arguments = num_arguments;
+	indirect_info.num_arguments = &num_arguments;
+
+	/* do the indirect format */
+	LispFormat(stream, &indirect_info);
+    }
+}
+
+/* update pointers to a list of format strings:
+ *	for '(' and '{' only one list is required
+ *	for '[' and '<' more than one may be returned
+ *	has_default is only meaningful for '[' and '<'
+ *	comma_width and line_width are only meaningful to '<', and
+ *	    only valid if has_default set
+ * if the string is finished prematurely, LispDestroy is called
+ * format_ptr is updated to the correct pointer in the "main" format string
+ */
+static void
+list_formats(FmtInfo *info, int command, char **format_ptr,
+	     char ***format_list, int *format_count, int *has_default,
+	     int *comma_width, int *line_width)
+{
+    /* instead of processing the directives recursively, just separate the
+     * input formats in separate strings, then see if one of then need to
+     * be used */
+    FmtArgs args;
+    int counters[] = {  0,   0,   0,   0};
+		    /* '[', '(', '{', '<' */
+    char *format, *next_format, *start, **formats;
+    int num_formats, format_index, separator, add_format;
+
+    /* initialize */
+    formats = NULL;
+    num_formats = format_index = 0;
+    if (has_default != NULL)
+	*has_default = 0;
+    if (comma_width != NULL)
+	*comma_width = 0;
+    if (line_width != NULL)
+	*line_width = 0;
+    format = start = next_format = *format_ptr;
+    switch (command) {
+	case '[': counters[0] = 1; format_index = 0; break;
+	case '(': counters[1] = 1; format_index = 1; break;
+	case '{': counters[2] = 1; format_index = 2; break;
+	case '<': counters[3] = 1; format_index = 3; break;
+    }
+
+#define	LIST_FORMATS_ADD	1
+#define	LIST_FORMATS_DONE	2
+
+    /* fill list of format options to conditional */
+    while (*format) {
+	if (*format == '~') {
+	    separator = add_format = 0;
+	    args.format = format + 1;
+	    next_format = parse_arguments(format + 1, &args, NULL, NULL, NULL);
+	    switch (args.command) {
+ 		case '[': ++counters[0];    break;
+		case ']': --counters[0];    break;
+		case '(': ++counters[1];    break;
+		case ')': --counters[1];    break;
+		case '{': ++counters[2];    break;
+		case '}': --counters[2];    break;
+		case '<': ++counters[3];    break;
+		case '>': --counters[3];    break;
+		case ';': separator = 1;    break;
+	    }
+
+	    /* check if a new format string must be added */
+	    if (separator && counters[format_index] == 1 &&
+		(command == '[' || command == '<'))
+		add_format = LIST_FORMATS_ADD;
+	    else if (counters[format_index] == 0)
+		add_format = LIST_FORMATS_DONE;
+
+	    if (add_format) {
+		int length = format - start;
+
+		formats = LispRealloc(formats,
+				      (num_formats + 1) * sizeof(char*));
+
+		formats[num_formats] = LispMalloc(length + 1);
+		strncpy(formats[num_formats], start, length);
+		formats[num_formats][length] = '\0';
+		++num_formats;
+		/* loop finished? */
+		if (add_format == LIST_FORMATS_DONE)
+		    break;
+		else if (command == '[' && has_default != NULL)
+		    /* will be set only for the last parameter, what is
+		     * expected, just don't warn about it in the incorrect
+		     * place */
+		    *has_default = args.collon != 0;
+		else if (command == '<' && num_formats == 1) {
+		    /* if the first parameter to '<', there may be overrides
+		     * to comma-width and line-width */
+		    if (args.collon && has_default != NULL) {
+			*has_default = 1;
+			if (comma_width != NULL &&
+			    args.arguments[0].specified &&
+			    !args.arguments[0].achar)
+			    *comma_width = args.arguments[0].value;
+			if (line_width != NULL &&
+			    args.arguments[1].specified &&
+			    !args.arguments[1].achar)
+			    *line_width = args.arguments[1].value;
+		    }
+		}
+		start = next_format;
+	    }
+	    format = next_format;
+	}
+	else
+	    ++format;
+    }
+
+    /* check if format string did not finish prematurely */
+    if (counters[format_index] != 0) {
+	char error_message[64];
+
+	sprintf(error_message, "expecting ~%c", command);
+	format_error(&(info->args), error_message);
+    }
+
+    /* update pointers */
+    *format_list = formats;
+    *format_count = num_formats;
+    *format_ptr = next_format;
+}
+
+static void
+free_formats(char **formats, int num_formats)
+{
+    if (num_formats) {
+	while (--num_formats >= 0)
+	    LispFree(formats[num_formats]);
+	LispFree(formats);
+    }
+}
+
+static void
+format_case_conversion(LispObj *stream, FmtInfo *info)
+{
+    GC_ENTER();
+    LispObj *string;
+    FmtInfo case_info;
+    char *str, *ptr;
+    char *format, *next_format, **formats;
+    int atsign, collon, num_formats, length;
+
+    atsign = info->args.atsign;
+    collon = info->args.collon;
+
+    /* output to a string, before case conversion */
+    string = LSTRINGSTREAM("", STREAM_READ | STREAM_WRITE, 0);
+    GC_PROTECT(string);
+
+    /* most information is the same */
+    memcpy(&case_info, info, sizeof(FmtInfo));
+
+    /* list formats */
+    next_format = *(info->format);
+    list_formats(info, '(', &next_format, &formats, &num_formats,
+		 NULL, NULL, NULL);
+
+    /* set new format string */
+    format = formats[0];
+    case_info.args.base = case_info.args.format = format;
+    case_info.format = &format;
+
+    /* format text to string */
+    LispFormat(string, &case_info);
+
+    str = ptr = LispGetSstring(SSTREAMP(string), &length);
+
+    /* do case conversion */
+    if (!atsign && !collon) {
+	/* convert all upercase to lowercase */
+	for (; *ptr; ptr++) {
+	    if (isupper(*ptr))
+		*ptr = tolower(*ptr);
+	}
+    }
+    else if (atsign && collon) {
+	/* convert all lowercase to upercase */
+	for (; *ptr; ptr++) {
+	    if (islower(*ptr))
+		*ptr = toupper(*ptr);
+	}
+    }
+    else {
+	int upper = 1;
+
+	/* skip non-alphanumeric characters */
+	for (; *ptr; ptr++)
+	    if (isalnum(*ptr))
+		break;
+
+	/* capitalize words */
+	for (; *ptr; ptr++) {
+	    if (isalnum(*ptr)) {
+		if (upper) {
+		    if (islower(*ptr))
+			*ptr = toupper(*ptr);
+		    upper = 0;
+		}
+		else if (isupper(*ptr))
+		    *ptr = tolower(*ptr);
+	    }
+	    else
+		upper = collon;
+		/* if collon, capitalize all words, else just first word */
+	}
+    }
+
+    /* output case converted string */
+    LispWriteStr(stream, str, length);
+
+    /* temporary string stream is not necessary anymore */
+    GC_LEAVE();
+
+    /* free temporary memory */
+    free_formats(formats, num_formats);
+
+    /* this information always updated */
+    *(info->format) = next_format;
+}
+
+static void
+format_conditional(LispObj *stream, FmtInfo *info)
+{
+    LispObj *object, *arguments;
+    char *format, *next_format, **formats;
+    int choice, num_formats, has_default, num_arguments;
+
+    /* save information that may change */
+    object = *(info->object);
+    arguments = *(info->arguments);
+    num_arguments = *(info->num_arguments);
+
+    /* initialize */
+    choice = -1;
+    next_format = *(info->format);
+
+    /* list formats */
+    list_formats(info, '[',
+		 &next_format, &formats, &num_formats, &has_default, NULL, NULL);
+
+    /* ~:[false;true] */
+    if (info->args.collon) {
+	/* one argument always consumed */
+	if (!CONSP(arguments))
+	    parse_error(&(info->args), PARSE_NOARGSLEFT);
+	object = CAR(arguments);
+	arguments = CDR(arguments);
+	--num_arguments;
+	choice = object == NIL ? 0 : 1;
+    }
+    /* ~@[true] */
+    else if (info->args.atsign) {
+	/* argument consumed only if nil, but one must be available */
+	if (!CONSP(arguments))
+	    parse_error(&(info->args), PARSE_NOARGSLEFT);
+	if (CAR(arguments) != NIL)
+	    choice = 0;
+	else {
+	    object = CAR(arguments);
+	    arguments = CDR(arguments);
+	    --num_arguments;
+	}
+    }
+    /* ~n[...~] */
+    else if (info->args.arguments[0].specified)
+	/* no arguments consumed */
+	choice = info->args.arguments[0].value;
+    /* ~[...~] */
+    else {
+	/* one argument consumed, it is the index in the available formats */
+	if (!CONSP(arguments))
+	    parse_error(&(info->args), PARSE_NOARGSLEFT);
+	object = CAR(arguments);
+	arguments = CDR(arguments);
+	--num_arguments;
+	/* no error if it isn't a number? */
+	if (FIXNUMP(object))
+	    choice = FIXNUM_VALUE(object);
+    }
+
+    /* update anything that may have changed */
+    *(info->object) = object;
+    *(info->arguments) = arguments;
+    *(info->num_arguments) = num_arguments;
+
+    /* if choice is out of range check if there is a default choice */
+    if (has_default && (choice < 0 || choice >= num_formats))
+	choice = num_formats - 1;
+
+    /* if one of the formats must be parsed */
+    if (choice >= 0 && choice < num_formats) {
+	FmtInfo conditional_info;
+
+	/* most information is the same */
+	memcpy(&conditional_info, info, sizeof(FmtInfo));
+
+	/* set new format string */
+	format = formats[choice];
+	conditional_info.args.base = conditional_info.args.format = format;
+	conditional_info.format = &format;
+
+	/* do the conditional format */
+	LispFormat(stream, &conditional_info);
+    }
+
+    /* free temporary memory */
+    free_formats(formats, num_formats);
+
+    /* this information always updated */
+    *(info->format) = next_format;
+}
+
+static void
+format_iterate(LispObj *stream, FmtInfo *info)
+{
+    FmtInfo iterate_info;
+    LispObj *object, *arguments, *iarguments, *iobject;
+    char *format, *next_format, *loop_format, **formats;
+    int num_arguments, iterate, iterate_max, has_max, has_min, inum_arguments,
+	num_formats;
+
+    /* save information that may change */
+    object = *(info->object);
+    arguments = *(info->arguments);
+    num_arguments = *(info->num_arguments);
+
+    /* initialize */
+    iterate = has_min = 0;
+    next_format = *(info->format);
+
+    /* if has_max set, iterate at most iterate_max times */
+    has_max = info->args.arguments[0].specified;
+    iterate_max = info->args.arguments[0].value;
+
+    /* list formats */
+    list_formats(info, '{', &next_format, &formats, &num_formats,
+		 NULL, NULL, NULL);
+    loop_format = formats[0];
+
+    /* most information is the same */
+    memcpy(&iterate_info, info, sizeof(FmtInfo));
+
+    /* ~{...~} */
+    if (!info->args.atsign && !info->args.collon) {
+	/* next argument is the argument list for the iteration */
+
+	/* fetch argument list, must exist */
+	if (!CONSP(arguments))
+	    parse_error(&(info->args), PARSE_NOARGSLEFT);
+	iarguments = object = CAR(arguments);
+	object = CAR(arguments);
+	arguments = CDR(arguments);
+	--num_arguments;
+
+	inum_arguments = 0;
+	if (CONSP(object)) {
+	    /* count arguments to format */
+	    for (iobject = object; CONSP(iobject); iobject = CDR(iobject))
+		++inum_arguments;
+	}
+	else if (object != NIL)
+	    generic_error(&(info->args), GENERIC_BADLIST);
+
+	iobject = NIL;
+
+	/* set new arguments to recursive calls */
+	iarguments = object;
+	iterate_info.base_arguments = iarguments;
+	iterate_info.total_arguments = inum_arguments;
+	iterate_info.object = &iobject;
+	iterate_info.arguments = &iarguments;
+	iterate_info.num_arguments = &inum_arguments;
+
+	/* iterate */
+	for (;; iterate++) {
+	    /* if maximum iterations done or all arguments consumed */
+	    if (has_max && iterate > iterate_max)
+		break;
+	    else if (inum_arguments == 0 && (!has_min || iterate > 0))
+		break;
+
+	    format = loop_format;
+
+	    /* set new format string */
+	    iterate_info.args.base = iterate_info.args.format = format;
+	    iterate_info.format = &format;
+
+	    /* information for possible ~^, in this case ~:^ is a noop */
+	    iterate_info.iteration = ITERATION_NORMAL;
+
+	    /* do the format */
+	    LispFormat(stream, &iterate_info);
+
+	    /* check for forced loop break */
+	    if (iterate_info.upandout & UPANDOUT_HASH)
+		break;
+	}
+    }
+    /* ~:@{...~} */
+    else if (info->args.atsign && info->args.collon) {
+	/* every following argument is the argument list for the iteration */
+
+	/* iterate */
+	for (;; iterate++) {
+	    /* if maximum iterations done or all arguments consumed */
+	    if (has_max && iterate > iterate_max)
+		break;
+	    else if (num_arguments == 0 && (!has_min || iterate > 0))
+		break;
+
+	    /* fetch argument list, must exist */
+	    if (!CONSP(arguments))
+		parse_error(&(info->args), PARSE_NOARGSLEFT);
+	    iarguments = object = CAR(arguments);
+	    object = CAR(arguments);
+	    arguments = CDR(arguments);
+	    --num_arguments;
+
+	    inum_arguments = 0;
+	    if (CONSP(object)) {
+		/* count arguments to format */
+		for (iobject = object; CONSP(iobject); iobject = CDR(iobject))
+		    ++inum_arguments;
+	    }
+	    else if (object != NIL)
+		generic_error(&(info->args), GENERIC_BADLIST);
+
+	    iobject = NIL;
+
+	    /* set new arguments to recursive calls */
+	    iarguments = object;
+	    iterate_info.base_arguments = iarguments;
+	    iterate_info.total_arguments = inum_arguments;
+	    iterate_info.object = &iobject;
+	    iterate_info.arguments = &iarguments;
+	    iterate_info.num_arguments = &inum_arguments;
+
+	    format = loop_format;
+
+	    /* set new format string */
+	    iterate_info.args.base = iterate_info.args.format = format;
+	    iterate_info.format = &format;
+
+	    /* information for possible ~^ */
+	    iterate_info.iteration =
+		num_arguments > 0 ? ITERATION_NORMAL : ITERATION_LAST;
+
+	    /* do the format */
+	    LispFormat(stream, &iterate_info);
+
+	    /* check for forced loop break */
+	    if (iterate_info.upandout & UPANDOUT_HASH)
+		break;
+	}
+    }
+    /* ~:{...~} */
+    else if (info->args.collon) {
+	/* next argument is a list of lists */
+
+	LispObj *sarguments, *sobject;
+	int snum_arguments;
+
+	/* fetch argument list, must exist */
+	if (!CONSP(arguments))
+	    parse_error(&(info->args), PARSE_NOARGSLEFT);
+	sarguments = object = CAR(arguments);
+	object = CAR(arguments);
+	arguments = CDR(arguments);
+	--num_arguments;
+
+	snum_arguments = 0;
+	if (CONSP(object)) {
+	    /* count arguments to format */
+	    for (sobject = object; CONSP(sobject); sobject = CDR(sobject))
+		++snum_arguments;
+	}
+	else
+	    generic_error(&(info->args), GENERIC_BADLIST);
+
+	/* iterate */
+	for (;; iterate++) {
+	    /* if maximum iterations done or all arguments consumed */
+	    if (has_max && iterate > iterate_max)
+		break;
+	    else if (snum_arguments == 0 && (!has_min || iterate > 0))
+		break;
+
+	    /* fetch argument list, must exist */
+	    if (!CONSP(sarguments))
+		parse_error(&(info->args), PARSE_NOARGSLEFT);
+	    iarguments = sobject = CAR(sarguments);
+	    sobject = CAR(sarguments);
+	    sarguments = CDR(sarguments);
+	    --snum_arguments;
+
+	    inum_arguments = 0;
+	    if (CONSP(object)) {
+		/* count arguments to format */
+		for (iobject = sobject; CONSP(iobject); iobject = CDR(iobject))
+		    ++inum_arguments;
+	    }
+	    else if (sobject != NIL)
+		generic_error(&(info->args), GENERIC_BADLIST);
+
+	    iobject = NIL;
+
+	    /* set new arguments to recursive calls */
+	    iarguments = sobject;
+	    iterate_info.base_arguments = iarguments;
+	    iterate_info.total_arguments = inum_arguments;
+	    iterate_info.object = &iobject;
+	    iterate_info.arguments = &iarguments;
+	    iterate_info.num_arguments = &inum_arguments;
+
+	    format = loop_format;
+
+	    /* set new format string */
+	    iterate_info.args.base = iterate_info.args.format = format;
+	    iterate_info.format = &format;
+
+	    /* information for possible ~^ */
+	    iterate_info.iteration =
+		snum_arguments > 0 ? ITERATION_NORMAL : ITERATION_LAST;
+
+	    /* do the format */
+	    LispFormat(stream, &iterate_info);
+
+	    /* check for forced loop break */
+	    if (iterate_info.upandout & UPANDOUT_HASH)
+		break;
+	}
+    }
+    /* ~@{...~} */
+    else if (info->args.atsign) {
+	/* current argument list is used */
+
+	/* set new arguments to recursive calls */
+	iterate_info.base_arguments = info->base_arguments;
+	iterate_info.total_arguments = info->total_arguments;
+	iterate_info.object = &object;
+	iterate_info.arguments = &arguments;
+	iterate_info.num_arguments = &num_arguments;
+
+	for (;; iterate++) {
+	    /* if maximum iterations done or all arguments consumed */
+	    if (has_max && iterate > iterate_max)
+		break;
+	    else if (num_arguments == 0 && (!has_min || iterate > 0))
+		break;
+
+	    format = loop_format;
+
+	    /* set new format string */
+	    iterate_info.args.base = iterate_info.args.format = format;
+	    iterate_info.format = &format;
+
+	    /* information for possible ~^, in this case ~:^ is a noop */
+	    iterate_info.iteration = ITERATION_NORMAL;
+
+	    /* do the format */
+	    LispFormat(stream, &iterate_info);
+
+	    /* check for forced loop break */
+	    if (iterate_info.upandout & UPANDOUT_HASH)
+		break;
+	}
+    }
+
+    /* free temporary memory */
+    free_formats(formats, num_formats);
+
+    /* update anything that may have changed */
+    *(info->object) = object;
+    *(info->arguments) = arguments;
+    *(info->num_arguments) = num_arguments;
+
+    /* this information always updated */
+    *(info->format) = next_format;
+}
+
+static void
+format_justify(LispObj *stream, FmtInfo *info)
+{
+    GC_ENTER();
+    FmtInfo justify_info;
+    char **formats, *format, *next_format, *str;
+    LispObj *string, *strings = NIL, *cons;
+    int atsign = info->args.atsign,
+	collon = info->args.collon,
+	mincol = info->args.arguments[0].value,
+	colinc = info->args.arguments[1].value,
+	minpad = info->args.arguments[2].value,
+	padchar = info->args.arguments[3].value;
+    int i, k, total_length, length, padding, num_formats, has_default,
+	comma_width, line_width, size, extra;
+
+    next_format = *(info->format);
+
+    /* list formats */
+    list_formats(info, '<', &next_format, &formats, &num_formats,
+		 &has_default, &comma_width, &line_width);
+
+    /* initialize list of strings streams */
+    if (num_formats) {
+	string = LSTRINGSTREAM("", STREAM_READ | STREAM_WRITE, 0);
+	strings = cons = CONS(string, NIL);
+	GC_PROTECT(strings);
+	for (i = 1; i < num_formats; i++) {
+	    string = LSTRINGSTREAM("", STREAM_READ | STREAM_WRITE, 0);
+	    RPLACD(cons, CONS(string, NIL));
+	    cons = CDR(cons);
+	}
+    }
+
+    /* most information is the same */
+    memcpy(&justify_info, info, sizeof(FmtInfo));
+
+    /* loop formating strings */
+    for (i = 0, cons = strings; i < num_formats; i++, cons = CDR(cons)) {
+	/* set new format string */
+	format = formats[i];
+	justify_info.args.base = justify_info.args.format = format;
+	justify_info.format = &format;
+
+	/* format string, maybe consuming arguments */
+	LispFormat(CAR(cons), &justify_info);
+
+	/* if format was aborted, it is discarded */
+	if (justify_info.upandout)
+	    RPLACA(cons, NIL);
+	/* check if the entire "main" iteration must be aborted */
+	if (justify_info.upandout & UPANDOUT_COLLON) {
+	    for (cons = CDR(cons); i < num_formats; i++, cons = CDR(cons))
+		RPLACA(cons, NIL);
+	    break;
+	}
+    }
+
+    /* free temporary format strings */
+    free_formats(formats, num_formats);
+
+    /* remove aborted formats */
+	/* first remove leading discarded formats */
+    if (CAR(strings) == NIL) {
+	while (CAR(strings) == NIL) {
+	    strings = CDR(strings);
+	    --num_formats;
+	}
+	/* keep strings gc protected, discarding first entries */
+	lisp__data.protect.objects[gc__protect] = strings;
+    }
+	/* now remove intermediary discarded formats */
+    cons = strings;
+    while (CONSP(cons)) {
+	if (CONSP(CDR(cons)) && CAR(CDR(cons)) == NIL) {
+	    RPLACD(cons, CDR(CDR(cons)));
+	    --num_formats;
+	}
+	else
+	    cons = CDR(cons);
+    }
+
+    /* calculate total length required for output */
+    if (has_default)
+	cons = CDR(strings);	/* if has_defaults, strings is surely a list */
+    else
+	cons = strings;
+    for (total_length = 0; CONSP(cons); cons = CDR(cons))
+	total_length += SSTREAMP(CAR(cons))->length;
+
+    /* initialize pointer to string streams */
+    if (has_default)
+	cons = CDR(strings);
+    else
+	cons = strings;
+
+    /* check if padding will need to be printed */
+    extra = 0;
+    padding = mincol - total_length;
+    if (padding < 0)
+	k = padding = 0;
+    else {
+	int num_fields = num_formats - (has_default != 0);
+
+	if (num_fields > 1) {
+	    /* check if padding is distributed in num_fields or
+	     * num_fields - 1 steps */
+	    if (!collon)
+		--num_fields;
+	}
+
+	if (num_fields)
+	    k = padding / num_fields;
+	else
+	    k = padding;
+
+	if (k <= 0)
+	    k = colinc;
+	else if (colinc)
+	    k = k + (k % colinc);
+	extra = mincol - (num_fields * k + total_length);
+	if (extra < 0)
+	    extra = 0;
+    }
+    if (padding && k < minpad) {
+	k = minpad;
+	if (colinc)
+	    k = k + (k % colinc);
+    }
+
+    /* first check for the special case of only one string being justified */
+    if (num_formats - has_default == 1) {
+	if (has_default && line_width > 0 && comma_width >= 0 &&
+	    total_length + comma_width > line_width) {
+	    str = LispGetSstring(SSTREAMP(CAR(strings)), &size);
+	    LispWriteStr(stream, str, size);
+	}
+	string = has_default ? CAR(CDR(strings)) : CAR(strings);
+	/* check if need left padding */
+	if (k && !atsign) {
+	    LispWriteChars(stream, padchar, k);
+	    k = 0;
+	}
+	/* check for centralizing text */
+	else if (k && atsign && collon) {
+	    LispWriteChars(stream, padchar, k / 2 + ((k / 2) & 1));
+	    k -= k / 2;
+	}
+	str = LispGetSstring(SSTREAMP(string), &size);
+	LispWriteStr(stream, str, size);
+	/* if any padding remaining */
+	if (k)
+	    LispWriteChars(stream, padchar, k);
+    }
+    else {
+	LispObj *result;
+	int last, spaces_before, padout;
+
+	/* if has default, need to check output length */
+	if (has_default && line_width > 0 && comma_width >= 0) {
+	    result = LSTRINGSTREAM("", STREAM_READ | STREAM_WRITE, 0);
+	    GC_PROTECT(result);
+	}
+	/* else write directly to stream */
+	else
+	    result = stream;
+
+	/* loop printing justified text */
+	    /* padout controls padding for cases where padding is
+	     * is separated in n-1 chunks, where n is the number of
+	     * formatted strings.
+	     */
+	for (i = padout = 0; CONSP(cons); i++, cons = CDR(cons), --extra) {
+	    string = CAR(cons);
+	    last = !CONSP(CDR(cons));
+
+	    spaces_before = (i != 0 || collon) && (!last || !atsign);
+
+	    if (!spaces_before) {
+		/* check for special case */
+		if (last && atsign && collon && padding > 0) {
+		    int spaces;
+
+		    spaces = minpad > colinc ? minpad : colinc;
+		    LispWriteChars(result, padchar, spaces + (extra > 0));
+		    k -= spaces;
+		}
+		str = LispGetSstring(SSTREAMP(string), &size);
+		LispWriteStr(result, str, size);
+		padout = 0;
+	    }
+	    if (!padout)
+		LispWriteChars(result, padchar, k + (extra > 0));
+	    padout = k;
+	    /* if not first string, or if left padding specified */
+	    if (spaces_before) {
+		str = LispGetSstring(SSTREAMP(string), &size);
+		LispWriteStr(result, str, size);
+		padout = 0;
+	    }
+	    padding -= k;
+	}
+
+	if (has_default && line_width > 0 && comma_width >= 0) {
+	    length = SSTREAMP(result)->length + LispGetColumn(stream);
+
+	    /* if current line is too large */
+	    if (has_default && length + comma_width > line_width) {
+		str = LispGetSstring(SSTREAMP(CAR(strings)), &size);
+		LispWriteStr(stream, str, size);
+	    }
+
+	    /* write result to stream */
+	    str = LispGetSstring(SSTREAMP(result), &size);
+	    LispWriteStr(stream, str, size);
+	}
+    }
+
+    /* unprotect string streams from GC */
+    GC_LEAVE();
+
+    /* this information always updated */
+    *(info->format) = next_format;
+}
+
+static void
+LispFormat(LispObj *stream, FmtInfo *info)
+{
+    FmtArgs *args;
+    FmtDefs *defs = NULL;
+    LispObj *object, *arguments;
+    char stk[256], *format, *next_format;
+    int length, num_arguments, code, need_update, need_argument, hash, head;
+
+    /* arguments that will be updated on function exit */
+    format = *(info->format);
+    object = *(info->object);
+    arguments = *(info->arguments);
+    num_arguments = *(info->num_arguments);
+
+    /* initialize */
+    length = 0;
+    args = &(info->args);
+    info->upandout = 0;
+
+    while (*format) {
+	if (*format == '~') {
+	    /* flush non formatted characters */
+	    if (length) {
+		LispWriteStr(stream, stk, length);
+		length = 0;
+	    }
+
+	    need_argument = need_update = hash = 0;
+
+	    /* parse parameters */
+	    args->format = format + 1;
+	    next_format = parse_arguments(format + 1, args, &num_arguments,
+					  &arguments, &code);
+	    if (code != NOERROR)
+		parse_error(args, code);
+
+	    /* check parameters */
+	    switch (args->command) {
+		case 'A': case 'S':
+		    defs = &AsciiDefs;
+		    break;
+		case 'B': case 'O': case 'D': case 'X':
+		    defs = &IntegerDefs;
+		    break;
+		case 'R':
+		    defs = &RadixDefs;
+		    break;
+		case 'P': case 'C':
+		    defs = &NoneDefs;
+		    break;
+		case 'F':
+		    defs = &FixedFloatDefs;
+		    break;
+		case 'E': case 'G':
+		    defs = &ExponentialFloatDefs;
+		    break;
+		case '$':
+		    defs = &DollarFloatDefs;
+		    break;
+		case '%': case '&': case '|': case '~': case '\n':
+		    defs = &OneDefs;
+		    break;
+		case 'T':
+		    defs = &TabulateDefs;
+		    break;
+		case '*':
+		    defs = &OneDefs;
+		    break;
+		case '?': case '(':
+		    defs = &NoneDefs;
+		    break;
+		case ')':
+		    /* this is never seen, processed in format_case_conversion */
+		    format_error(args, "no match for directive ~)");
+		case '[':
+		    defs = &OneDefs;
+		    break;
+		case ']':
+		    /* this is never seen, processed in format_conditional */
+		    format_error(args, "no match for directive ~]");
+		case '{':
+		    defs = &OneDefs;
+		    break;
+		case '}':
+		    /* this is never seen, processed in format_iterate */
+		    format_error(args, "no match for directive ~}");
+		case '<':
+		    defs = &AsciiDefs;
+		    break;
+		case '>':
+		    /* this is never seen, processed in format_justify */
+		    format_error(args, "no match for directive ~>");
+		case ';':
+		    /* this is never seen here */
+		    format_error(args, "misplaced directive ~;");
+		case '#':
+		    /* special handling for ~#^ */
+		    if (*next_format == '^') {
+			++next_format;
+			hash = 1;
+			defs = &NoneDefs;
+			args->command = '^';
+			break;
+		    }
+		    parse_error(args, PARSE_BADDIRECTIVE);
+		case '^':
+		    defs = &NoneDefs;
+		    break;
+		default:
+		    parse_error(args, PARSE_BADDIRECTIVE);
+		    break;
+	    }
+	    merge_arguments(args, defs, &code);
+	    if (code != NOERROR)
+		merge_error(args, code);
+
+	    /* check if an argument is required by directive */
+	    switch (args->command) {
+		case 'A': case 'S':
+		case 'B': case 'O': case 'D': case 'X': case 'R':
+		    need_argument = 1;
+		    break;
+		case 'P':
+		    /* if collon specified, plural is the last print argument */
+		    need_argument = !args->collon;
+		    break;
+		case 'C':
+		    need_argument = 1;
+		    break;
+		case 'F': case 'E': case 'G': case '$':
+		    need_argument = 1;
+		    break;
+		case '%': case '&': case '|': case '~': case '\n':
+		    break;
+		case 'T':
+		    break;
+		case '*':			/* check arguments below */
+		    need_update = 1;
+		    break;
+		case '?':
+		    need_argument = need_update = 1;
+		    break;
+		case '(': case '[': case '{': case '<':
+		    need_update = 1;
+		    break;
+		case '^':
+		    break;
+	    }
+	    if (need_argument) {
+		if (!CONSP(arguments))
+		    parse_error(args, PARSE_NOARGSLEFT);
+		object = CAR(arguments);
+		arguments = CDR(arguments);
+		--num_arguments;
+	    }
+
+	    /* will do recursive calls that change info */
+	    if (need_update) {
+		*(info->format) = next_format;
+		*(info->object) = object;
+		*(info->arguments) = arguments;
+		*(info->num_arguments) = num_arguments;
+	    }
+
+	    /* everything seens fine, print the format directive */
+	    switch (args->command) {
+		case 'A':
+		    head = lisp__data.env.length;
+		    LispAddVar(Oprint_escape, NIL);
+		    ++lisp__data.env.head;
+		    format_ascii(stream, object, args);
+		    lisp__data.env.head = lisp__data.env.length = head;
+		    break;
+		case 'S':
+		    head = lisp__data.env.length;
+		    LispAddVar(Oprint_escape, T);
+		    ++lisp__data.env.head;
+		    format_ascii(stream, object, args);
+		    lisp__data.env.head = lisp__data.env.length = head;
+		    break;
+		case 'B':
+		    format_in_radix(stream, object, 2, args);
+		    break;
+		case 'O':
+		    format_in_radix(stream, object, 8, args);
+		    break;
+		case 'D':
+		    format_in_radix(stream, object, 10, args);
+		    break;
+		case 'X':
+		    format_in_radix(stream, object, 16, args);
+		    break;
+		case 'R':
+		    /* if a single argument specified */
+		    if (args->count)
+			format_in_radix(stream, object, 0, args);
+		    else
+			format_radix_special(stream, object, args);
+		    break;
+		case 'P':
+		    if (args->atsign) {
+			if (FIXNUMP(object) && FIXNUM_VALUE(object) == 1)
+			    LispWriteChar(stream, 'y');
+			else
+			    LispWriteStr(stream, "ies", 3);
+		    }
+		    else if (!FIXNUMP(object) || FIXNUM_VALUE(object) != 1)
+			LispWriteChar(stream, 's');
+		    break;
+		case 'C':
+		    format_character(stream, object, args);
+		    break;
+		case 'F':
+		    format_fixed_float(stream, object, args);
+		    break;
+		case 'E':
+		    format_exponential_float(stream, object, args);
+		    break;
+		case 'G':
+		    format_general_float(stream, object, args);
+		    break;
+		case '$':
+		    format_dollar_float(stream, object, args);
+		    break;
+		case '&':
+		    if (LispGetColumn(stream) == 0)
+			--args->arguments[0].value;
+		case '%':
+		    LispWriteChars(stream, '\n', args->arguments[0].value);
+		    break;
+		case '|':
+		    LispWriteChars(stream, '\f', args->arguments[0].value);
+		    break;
+		case '~':
+		    LispWriteChars(stream, '~', args->arguments[0].value);
+		    break;
+		case '\n':
+		    if (!args->collon) {
+			if (args->atsign)
+			    LispWriteChar(stream, '\n');
+			/* ignore newline and following spaces */
+			while (*next_format && isspace(*next_format))
+			    ++next_format;
+		    }
+		    break;
+		case 'T':
+		    format_tabulate(stream, args);
+		    break;
+		case '*':
+		    format_goto(info);
+		    break;
+		case '?':
+		    format_indirection(stream, object, info);
+		    need_update = 1;
+		    break;
+		case '(':
+		    format_case_conversion(stream, info);
+		    /* next_format if far from what is set now */
+		    next_format = *(info->format);
+		    break;
+		case '[':
+		    format_conditional(stream, info);
+		    /* next_format if far from what is set now */
+		    next_format = *(info->format);
+		    break;
+		case '{':
+		    format_iterate(stream, info);
+		    /* next_format if far from what is set now */
+		    next_format = *(info->format);
+		    break;
+		case '<':
+		    format_justify(stream, info);
+		    /* next_format if far from what is set now */
+		    next_format = *(info->format);
+		    break;
+		case '^':
+		    if (args->collon) {
+			if (hash && num_arguments == 0) {
+			    info->upandout = UPANDOUT_HASH;
+			    goto format_up_and_out;
+			}
+			if (info->iteration &&
+			    info->iteration == ITERATION_NORMAL)
+			/* not exactly an error, but in this case,
+			 * command is ignored */
+			    break;
+			info->upandout = UPANDOUT_COLLON;
+			goto format_up_and_out;
+		    }
+		    else if (num_arguments == 0) {
+			info->upandout = UPANDOUT_NORMAL;
+			goto format_up_and_out;
+		    }
+		    break;
+	    }
+
+	    if (need_update) {
+		object = *(info->object);
+		arguments = *(info->arguments);
+		num_arguments = *(info->num_arguments);
+	    }
+
+	    format = next_format;
+	}
+	else {
+	    if (length >= sizeof(stk)) {
+		LispWriteStr(stream, stk, length);
+		length = 0;
+	    }
+	    stk[length++] = *format++;
+	}
+    }
+
+    /* flush any peding output */
+    if (length)
+	LispWriteStr(stream, stk, length);
+
+format_up_and_out:
+    /* update for recursive call */
+    *(info->format) = format;
+    *(info->object) = object;
+    *(info->arguments) = arguments;
+    *(info->num_arguments) = num_arguments;
+}
+
+LispObj *
+Lisp_Format(LispBuiltin *builtin)
+/*
+ format destination control-string &rest arguments
+ */
+{
+    GC_ENTER();
+    FmtInfo info;
+    LispObj *object;
+    char *control_string;
+    int num_arguments;
+
+    LispObj *stream, *format, *arguments;
+
+    arguments = ARGUMENT(2);
+    format = ARGUMENT(1);
+    stream = ARGUMENT(0);
+
+    /* check format and stream */
+    CHECK_STRING(format);
+    if (stream == NIL) {	/* return a string */
+	stream = LSTRINGSTREAM("", STREAM_READ | STREAM_WRITE, 0);
+	GC_PROTECT(stream);
+    }
+    else if (stream == T ||	/* print directly to *standard-output* */
+	     stream == STANDARD_OUTPUT)
+	stream = NIL;
+    else {
+	CHECK_STREAM(stream);
+	if (!stream->data.stream.writable)
+	    LispDestroy("%s: stream %s is not writable",
+			STRFUN(builtin), STROBJ(stream));
+    }
+
+    /* count number of arguments */
+    for (object = arguments, num_arguments = 0; CONSP(object);
+	 object = CDR(object), num_arguments++)
+	;
+
+    /* initialize plural/argument info */
+    object = NIL;
+
+    /* the format string */
+    control_string = THESTR(format);
+
+    /* arguments to recursive calls */
+    info.args.base = control_string;
+    info.base_arguments = arguments;
+    info.total_arguments = num_arguments;
+    info.format = &control_string;
+    info.object = &object;
+    info.arguments = &arguments;
+    info.num_arguments = &num_arguments;
+    info.iteration = 0;
+
+    /* format arguments */
+    LispFormat(stream, &info);
+
+    /* if printing to stdout */
+    if (stream == NIL)
+	LispFflush(Stdout);
+    /* else if printing to string-stream, return a string */
+    else if (stream->data.stream.type == LispStreamString) {
+	int length;
+	char *string;
+
+	string = LispGetSstring(SSTREAMP(stream), &length);
+	stream = LSTRING(string, length);
+    }
+
+    GC_LEAVE();
+
+    return (stream);
+}
diff --git a/lisp/format.h b/lisp/format.h
new file mode 100644
index 0000000..7ca14b9
--- /dev/null
+++ b/lisp/format.h
@@ -0,0 +1,42 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/format.h,v 1.3 2002/11/08 08:00:56 paulo Exp $ */
+
+#ifndef Lisp_format_h
+#define Lisp_format_h
+
+#include "private.h"
+
+/*
+ * Prototypes
+ */
+LispObj *Lisp_Format(LispBuiltin*);
+
+#endif /* Lisp_format_h */
diff --git a/lisp/hash.c b/lisp/hash.c
new file mode 100644
index 0000000..3d32f07
--- /dev/null
+++ b/lisp/hash.c
@@ -0,0 +1,657 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/hash.c,v 1.4 2002/11/23 08:26:48 paulo Exp $ */
+
+#include "hash.h"
+
+/* A simple hash-table implementation
+ * TODO: implement SXHASH and WITH-HASH-TABLE-ITERATOR
+ * May need a rewrite for better performance, and will
+ * need a rewrite if images/bytecode saved on disk.
+ */
+
+#define	GET_HASH	1
+#define PUT_HASH	2
+#define REM_HASH	3
+
+/*
+ * Prototypes
+ */
+static unsigned long LispHashKey(LispObj*, int);
+static LispObj *LispHash(LispBuiltin*, int);
+static void LispRehash(LispHashTable*);
+static void LispFreeHashEntries(LispHashEntry*, long);
+
+/*
+ * Initialization
+ */
+extern LispObj *Oeq, *Oeql, *Oequal, *Oequalp;
+
+/*  Hash tables will have one of these sizes, unless the user
+ * specified a very large size */
+static long some_primes[] = {
+       5,   11,   17,   23,
+      31,   47,   71,   97,
+     139,  199,  307,  401,
+     607,  809, 1213, 1619,
+    2437, 3251, 4889, 6521
+};
+
+/*
+ * Implementation
+ */
+static unsigned long
+LispHashKey(LispObj *object, int function)
+{
+    mpi *bigi;
+    char *string;
+    long i, length;
+    unsigned long key = ((unsigned long)object) >> 4;
+
+    /* Must be the same object for EQ */
+    if (function == FEQ)
+	goto hash_key_done;
+
+    if (function == FEQUALP) {
+	switch (OBJECT_TYPE(object)) {
+	    case LispSChar_t:
+		key = (unsigned long)toupper(SCHAR_VALUE(object));
+		goto hash_key_done;
+	    case LispString_t:
+		string = THESTR(object);
+		length = STRLEN(object);
+		if (length > 32)
+		    length = 32;
+		for (i = 0, key = 0; i < length; i++)
+		    key = (key << 1) ^ toupper(string[i]);
+		goto hash_key_done;
+	    default:
+		break;
+	}
+    }
+
+    /* Function is EQL, EQUAL or EQUALP */
+    switch (OBJECT_TYPE(object)) {
+	case LispFixnum_t:
+	case LispSChar_t:
+	    key = (unsigned long)FIXNUM_VALUE(object);
+	    goto hash_key_done;
+	case LispInteger_t:
+	    key = (unsigned long)INT_VALUE(object);
+	    goto hash_key_done;
+	case LispRatio_t:
+	    key = (object->data.ratio.numerator << 16) ^
+		   object->data.ratio.denominator;
+	    goto hash_key_done;
+	case LispDFloat_t:
+	    key = (unsigned long)DFLOAT_VALUE(object);
+	    break;
+	case LispComplex_t:
+	    key = (LispHashKey(object->data.complex.imag, function) << 16) ^
+		   LispHashKey(object->data.complex.real, function);
+	    goto hash_key_done;
+	case LispBignum_t:
+	    bigi = object->data.mp.integer;
+	    length = bigi->size;
+	    if (length > 8)
+		length = 8;
+	    key = bigi->sign;
+	    for (i = 0; i < length; i++)
+		key = (key << 8) ^ bigi->digs[i];
+	    goto hash_key_done;
+	case LispBigratio_t:
+	    bigi = mpr_num(object->data.mp.ratio);
+	    length = bigi->size;
+	    if (length > 4)
+		length = 4;
+	    key = bigi->sign;
+	    for (i = 0; i < length; i++)
+		key = (key << 4) ^ bigi->digs[i];
+	    bigi = mpr_den(object->data.mp.ratio);
+	    length = bigi->size;
+	    if (length > 4)
+		length = 4;
+	    for (i = 0; i < length; i++)
+		key = (key << 4) ^ bigi->digs[i];
+	    goto hash_key_done;
+	default:
+	    break;
+    }
+
+    /* Anything else must be the same object for EQL */
+    if (function == FEQL)
+	goto hash_key_done;
+
+    switch (OBJECT_TYPE(object)) {
+	case LispString_t:
+	    string = THESTR(object);
+	    length = STRLEN(object);
+	    if (length > 32)
+		length = 32;
+	    for (i = 0, key = 0; i < length; i++)
+		key = (key << 1) ^ string[i];
+	    break;
+	case LispCons_t:
+	    key = (LispHashKey(CAR(object), function) << 16) ^
+		   LispHashKey(CDR(object), function);
+	    break;
+	case LispQuote_t:
+	case LispBackquote_t:
+	case LispPathname_t:
+	    key = LispHashKey(object->data.pathname, function);
+	    break;
+	case LispRegex_t:
+	    key = LispHashKey(object->data.regex.pattern, function);
+	    break;
+	default:
+	    break;
+    }
+
+hash_key_done:
+    return (key);
+}
+
+static LispObj *
+LispHash(LispBuiltin *builtin, int code)
+{
+    LispHashEntry *entry;
+    LispHashTable *hash;
+    unsigned long key;
+    LispObj *result;
+    int found;
+    long i;
+
+    LispObj *okey, *hash_table, *value;
+
+    if (code == REM_HASH)
+	value = NIL;
+    else {
+	value = ARGUMENT(2);
+	if (value == UNSPEC)
+	    value = NIL;
+    }
+    hash_table = ARGUMENT(1);
+    okey = ARGUMENT(0);
+
+    CHECK_HASHTABLE(hash_table);
+
+    /* get hash entry */
+    hash = hash_table->data.hash.table;
+    key = LispHashKey(okey, hash->function) % hash->num_entries;
+    entry = hash->entries + key;
+
+    /* search entry in the hash table */
+    if (entry->count == 0)
+	i = 0;
+    else {
+	if (hash->function == FEQ) {
+	    for (i = entry->cache; i >= 0; i--) {
+		if (entry->keys[i] == okey)
+		    goto found_key;
+	    }
+	    for (i = entry->cache + 1; i < entry->count; i++) {
+		if (entry->keys[i] == okey)
+		    break;
+	    }
+	}
+	else {
+	    for (i = entry->cache; i >= 0; i--) {
+		if (LispObjectCompare(entry->keys[i], okey,
+				      hash->function) == T)
+		    goto found_key;
+	    }
+	    for (i = entry->cache + 1; i < entry->count; i++) {
+		if (LispObjectCompare(entry->keys[i], okey,
+				      hash->function) == T)
+		    break;
+	    }
+	}
+    }
+
+found_key:
+    result = value;
+    if ((found = i < entry->count) == 0)
+	i = entry->count;
+
+    switch (code) {
+	case GET_HASH:
+	    RETURN_COUNT = 1;
+	    if (found) {
+		RETURN(0) = T;
+		entry->cache = i;
+		result = entry->values[i];
+	    }
+	    else
+		RETURN(0) = NIL;
+	    break;
+	case PUT_HASH:
+	    entry->cache = i;
+	    if (found)
+		/* Just replace current entry */
+		entry->values[i] = value;
+	    else {
+		if ((i % 4) == 0) {
+		    LispObj **keys, **values;
+
+		    keys = realloc(entry->keys, sizeof(LispObj*) * (i + 4));
+		    if (keys == NULL)
+			LispDestroy("out of memory");
+		    values = realloc(entry->values, sizeof(LispObj*) * (i + 4));
+		    if (values == NULL) {
+			free(keys);
+			LispDestroy("out of memory");
+		    }
+		    entry->keys = keys;
+		    entry->values = values;
+		}
+		entry->keys[i] = okey;
+		entry->values[i] = value;
+		++entry->count;
+		++hash->count;
+		if (hash->count > hash->rehash_threshold * hash->num_entries)
+		    LispRehash(hash);
+	    }
+	    break;
+	case REM_HASH:
+	    if (found) {
+		result = T;
+		--entry->count;
+		--hash->count;
+		if (i < entry->count) {
+		    memmove(entry->keys + i, entry->keys + i + 1,
+			    (entry->count - i) * sizeof(LispObj*));
+		    memmove(entry->values + i, entry->values + i + 1,
+			    (entry->count - i) * sizeof(LispObj*));
+		}
+		if (entry->cache && entry->cache == entry->count)
+		    --entry->cache;
+	    }
+	    break;
+    }
+
+    return (result);
+}
+
+static void
+LispRehash(LispHashTable *hash)
+{
+    unsigned long key;
+    LispHashEntry *entries, *nentry, *entry, *last;
+    long i, size = hash->num_entries * hash->rehash_size;
+
+    for (i = 0; i < sizeof(some_primes) / sizeof(some_primes[0]); i++)
+	if (some_primes[i] >= size) {
+	    size = some_primes[i];
+	    break;
+	}
+
+    entries = calloc(1, sizeof(LispHashEntry) * size);
+    if (entries == NULL)
+	goto out_of_memory;
+
+    for (entry = hash->entries, last = entry + hash->num_entries;
+	 entry < last; entry++) {
+	for (i = 0; i < entry->count; i++) {
+	    key = LispHashKey(entry->keys[i], hash->function) % size;
+	    nentry = entries + key;
+	    if ((nentry->count % 4) == 0) {
+		LispObj **keys, **values;
+
+		keys = realloc(nentry->keys, sizeof(LispObj*) * (i + 4));
+		if (keys == NULL)
+		    goto out_of_memory;
+		values = realloc(nentry->values, sizeof(LispObj*) * (i + 4));
+		if (values == NULL) {
+		    free(keys);
+		    goto out_of_memory;
+		}
+		nentry->keys = keys;
+		nentry->values = values;
+	    }
+	    nentry->keys[nentry->count] = entry->keys[i];
+	    nentry->values[nentry->count] = entry->values[i];
+	    ++nentry->count;
+
+	}
+    }
+    LispFreeHashEntries(hash->entries, hash->num_entries);
+    hash->entries = entries;
+    hash->num_entries = size;
+    return;
+
+out_of_memory:
+    if (entries)
+	LispFreeHashEntries(entries, size);
+    LispDestroy("out of memory");
+}
+
+static void
+LispFreeHashEntries(LispHashEntry *entries, long num_entries)
+{
+    LispHashEntry *entry, *last;
+
+    for (entry = entries, last = entry + num_entries; entry < last; entry++) {
+	free(entry->keys);
+	free(entry->values);
+    }
+    free(entries);
+}
+
+void
+LispFreeHashTable(LispHashTable *hash)
+{
+    LispFreeHashEntries(hash->entries, hash->num_entries);
+    free(hash);
+}
+
+LispObj *
+Lisp_Clrhash(LispBuiltin *builtin)
+/*
+ clrhash hash-table
+ */
+{
+    LispHashTable *hash;
+    LispHashEntry *entry, *last;
+
+    LispObj *hash_table = ARGUMENT(0);
+
+    CHECK_HASHTABLE(hash_table);
+
+    hash = hash_table->data.hash.table;
+    for (entry = hash->entries, last = entry + hash->num_entries;
+	entry < last; entry++) {
+	free(entry->keys);
+	free(entry->values);
+	entry->keys = entry->values = NULL;
+	entry->count = entry->cache = 0;
+    }
+    hash->count = 0;
+
+    return (hash_table);
+}
+
+LispObj *
+Lisp_Gethash(LispBuiltin *builtin)
+/*
+ gethash key hash-table &optional default
+ */
+{
+    return (LispHash(builtin, GET_HASH));
+}
+
+LispObj *
+Lisp_HashTableP(LispBuiltin *builtin)
+/*
+ hash-table-p object
+ */
+{
+    LispObj *object = ARGUMENT(0);
+
+    return (HASHTABLEP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_HashTableCount(LispBuiltin *builtin)
+/*
+ hash-table-count hash-table
+ */
+{
+    LispObj *hash_table = ARGUMENT(0);
+
+    CHECK_HASHTABLE(hash_table);
+
+    return (FIXNUM(hash_table->data.hash.table->count));
+}
+
+LispObj *
+Lisp_HashTableRehashSize(LispBuiltin *builtin)
+/*
+ hash-table-rehash-size hash-table
+ */
+{
+    LispObj *hash_table = ARGUMENT(0);
+
+    CHECK_HASHTABLE(hash_table);
+
+    return (DFLOAT(hash_table->data.hash.table->rehash_size));
+}
+
+LispObj *
+Lisp_HashTableRehashThreshold(LispBuiltin *builtin)
+/*
+ hash-table-rehash-threshold hash-table
+ */
+{
+    LispObj *hash_table = ARGUMENT(0);
+
+    CHECK_HASHTABLE(hash_table);
+
+    return (DFLOAT(hash_table->data.hash.table->rehash_threshold));
+}
+
+LispObj *
+Lisp_HashTableSize(LispBuiltin *builtin)
+/*
+ hash-table-size hash-table
+ */
+{
+    LispObj *hash_table = ARGUMENT(0);
+
+    CHECK_HASHTABLE(hash_table);
+
+    return (FIXNUM(hash_table->data.hash.table->num_entries));
+}
+
+LispObj *
+Lisp_HashTableTest(LispBuiltin *builtin)
+/*
+ hash-table-test hash-table
+ */
+{
+    LispObj *hash_table = ARGUMENT(0);
+
+    CHECK_HASHTABLE(hash_table);
+
+    return (hash_table->data.hash.test);
+}
+
+LispObj *
+Lisp_Maphash(LispBuiltin *builtin)
+/*
+ maphash function hash-table
+ */
+{
+    long i;
+    LispHashEntry *entry, *last;
+
+    LispObj *function, *hash_table;
+
+    hash_table = ARGUMENT(1);
+    function = ARGUMENT(0);
+
+    CHECK_HASHTABLE(hash_table);
+
+    for (entry = hash_table->data.hash.table->entries,
+	 last = entry + hash_table->data.hash.table->num_entries;
+	 entry < last; entry++) {
+	for (i = 0; i < entry->count; i++)
+	    APPLY2(function, entry->keys[i], entry->values[i]);
+    }
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_MakeHashTable(LispBuiltin *builtin)
+/*
+ make-hash-table &key test size rehash-size rehash-threshold initial-contents
+ */
+{
+    int function = FEQL;
+    unsigned long i, isize, xsize;
+    double drsize, drthreshold;
+    LispHashTable *hash_table;
+    LispObj *cons, *result;
+
+    LispObj *test, *size, *rehash_size, *rehash_threshold, *initial_contents;
+
+    initial_contents = ARGUMENT(4);
+    rehash_threshold = ARGUMENT(3);
+    rehash_size = ARGUMENT(2);
+    size = ARGUMENT(1);
+    test = ARGUMENT(0);
+
+    if (test != UNSPEC) {
+	if (test == Oeq)
+	    function = FEQ;
+	else if (test == Oeql)
+	    function = FEQL;
+	else if (test == Oequal)
+	    function = FEQUAL;
+	else if (test == Oequalp)
+	    function = FEQUALP;
+	else
+	    LispDestroy("%s: :TEST must be EQ, EQL, EQUAL, "
+			"or EQUALP, not %s", STRFUN(builtin), STROBJ(test));
+    }
+    else
+	test = Oeql;
+
+    if (size != UNSPEC) {
+	CHECK_INDEX(size);
+	isize = FIXNUM_VALUE(size);
+    }
+    else
+	isize = 1;
+
+    if (rehash_size != UNSPEC) {
+	CHECK_DFLOAT(rehash_size);
+	if (DFLOAT_VALUE(rehash_size) <= 1.0)
+	    LispDestroy("%s: :REHASH-SIZE must a float > 1, not %s",
+			STRFUN(builtin), STROBJ(rehash_size));
+	drsize = DFLOAT_VALUE(rehash_size);
+    }
+    else
+	drsize = 1.5;
+
+    if (rehash_threshold != UNSPEC) {
+	CHECK_DFLOAT(rehash_threshold);
+	if (DFLOAT_VALUE(rehash_threshold) < 0.0 ||
+	    DFLOAT_VALUE(rehash_threshold) > 1.0)
+	    LispDestroy("%s: :REHASH-THRESHOLD must a float "
+			"in the range 0.0 - 1.0, not %s",
+			STRFUN(builtin), STROBJ(rehash_threshold));
+	drthreshold = DFLOAT_VALUE(rehash_threshold);
+    }
+    else
+	drthreshold = 0.75;
+
+    if (initial_contents == UNSPEC)
+	initial_contents = NIL;
+    CHECK_LIST(initial_contents);
+    for (xsize = 0, cons = initial_contents;
+	 CONSP(cons);
+	 xsize++, cons = CDR(cons))
+	CHECK_CONS(CAR(cons));
+
+    if (xsize > isize)
+	isize = xsize;
+
+    for (i = 0; i < sizeof(some_primes) / sizeof(some_primes[0]); i++)
+	if (some_primes[i] >= isize) {
+	    isize = some_primes[i];
+	    break;
+	}
+
+    hash_table = LispMalloc(sizeof(LispHashTable));
+    hash_table->entries = LispCalloc(1, sizeof(LispHashEntry) * isize);
+    hash_table->num_entries = isize;
+    hash_table->count = 0;
+    hash_table->function = function;
+    hash_table->rehash_size = drsize;
+    hash_table->rehash_threshold = drthreshold;
+
+    result = LispNew(NIL, NIL);
+    result->type = LispHashTable_t;
+    result->data.hash.table = hash_table;
+    result->data.hash.test = test;
+
+    LispMused(hash_table);
+    LispMused(hash_table->entries);
+
+    if (initial_contents != UNSPEC) {
+	unsigned long key;
+	LispHashEntry *entry;
+
+	for (cons = initial_contents; CONSP(cons); cons = CDR(cons)) {
+	    key = LispHashKey(CAAR(cons), function) % isize;
+	    entry = hash_table->entries + key;
+
+	    if ((entry->count % 4) == 0) {
+		LispObj **keys, **values;
+
+		keys = realloc(entry->keys, sizeof(LispObj*) * (i + 4));
+		if (keys == NULL)
+		    LispDestroy("out of memory");
+		values = realloc(entry->values, sizeof(LispObj*) * (i + 4));
+		if (values == NULL) {
+		    free(keys);
+		    LispDestroy("out of memory");
+		}
+		entry->keys = keys;
+		entry->values = values;
+	    }
+	    entry->keys[entry->count] = CAAR(cons);
+	    entry->values[entry->count] = CDAR(cons);
+	    ++entry->count;
+	}
+	hash_table->count = xsize;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Remhash(LispBuiltin *builtin)
+/*
+ remhash key hash-table
+ */
+{
+    return (LispHash(builtin, REM_HASH));
+}
+
+LispObj *
+Lisp_XeditPuthash(LispBuiltin *builtin)
+/*
+ lisp::puthash key hash-table value
+ */
+{
+    return (LispHash(builtin, PUT_HASH));
+}
diff --git a/lisp/hash.h b/lisp/hash.h
new file mode 100644
index 0000000..df74c96
--- /dev/null
+++ b/lisp/hash.h
@@ -0,0 +1,71 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/hash.h,v 1.2 2002/11/08 08:00:56 paulo Exp $ */
+
+#ifndef Lisp_hash_h
+#define Lisp_hash_h
+
+#include "private.h"
+
+typedef struct _LispHashEntry {
+    LispObj **keys;
+    LispObj **values;
+    long cache;
+    long count;
+} LispHashEntry;
+
+struct _LispHashTable {
+    LispHashEntry *entries;
+    long num_entries;
+    long count;
+    int function;		/* Function is EQ, EQL, EQUAL, or EQUALP */
+    double rehash_size;
+    double rehash_threshold;
+};
+
+/*
+ * Prototypes
+ */
+void LispFreeHashTable(LispHashTable*);
+
+LispObj *Lisp_Clrhash(LispBuiltin*);
+LispObj *Lisp_Gethash(LispBuiltin*);
+LispObj *Lisp_HashTableCount(LispBuiltin*);
+LispObj *Lisp_HashTableP(LispBuiltin*);
+LispObj *Lisp_HashTableRehashSize(LispBuiltin*);
+LispObj *Lisp_HashTableRehashThreshold(LispBuiltin*);
+LispObj *Lisp_HashTableSize(LispBuiltin*);
+LispObj *Lisp_HashTableTest(LispBuiltin*);
+LispObj *Lisp_Maphash(LispBuiltin*);
+LispObj *Lisp_MakeHashTable(LispBuiltin*);
+LispObj *Lisp_Remhash(LispBuiltin*);
+LispObj *Lisp_XeditPuthash(LispBuiltin*);
+
+#endif /* Lisp_hash_h */
diff --git a/lisp/helper.c b/lisp/helper.c
new file mode 100644
index 0000000..65749c5
--- /dev/null
+++ b/lisp/helper.c
@@ -0,0 +1,1124 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/helper.c,v 1.47 2002/11/26 04:06:28 paulo Exp $ */
+
+#include "helper.h"
+#include "pathname.h"
+#include "package.h"
+#include "read.h"
+#include "stream.h"
+#include "write.h"
+#include "hash.h"
+#include <ctype.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <math.h>
+#include <sys/stat.h>
+
+/*
+ * Prototypes
+ */
+static LispObj *LispReallyDo(LispBuiltin*, int);
+static LispObj *LispReallyDoListTimes(LispBuiltin*, int);
+
+/* in math.c */
+extern LispObj *LispFloatCoerce(LispBuiltin*, LispObj*);
+
+/*
+ * Implementation
+ */
+LispObj *
+LispObjectCompare(LispObj *left, LispObj *right, int function)
+{
+    LispType ltype, rtype;
+    LispObj *result = left == right ? T : NIL;
+
+    /* If left and right are the same object, or if function is EQ */
+    if (result == T || function == FEQ)
+	return (result);
+
+    ltype = OBJECT_TYPE(left);
+    rtype = OBJECT_TYPE(right);
+
+    /* Equalp requires that numeric objects be compared by value, and
+     * strings or characters comparison be case insenstive */
+    if (function == FEQUALP) {
+	switch (ltype) {
+	    case LispFixnum_t:
+	    case LispInteger_t:
+	    case LispBignum_t:
+	    case LispDFloat_t:
+	    case LispRatio_t:
+	    case LispBigratio_t:
+	    case LispComplex_t:
+		switch (rtype) {
+		    case LispFixnum_t:
+		    case LispInteger_t:
+		    case LispBignum_t:
+		    case LispDFloat_t:
+		    case LispRatio_t:
+		    case LispBigratio_t:
+		    case LispComplex_t:
+			result = APPLY2(Oequal_, left, right);
+			break;
+		    default:
+			break;
+		}
+		goto compare_done;
+	    case LispSChar_t:
+		if (rtype == LispSChar_t &&
+		    toupper(SCHAR_VALUE(left)) == toupper(SCHAR_VALUE(right)))
+		    result = T;
+		goto compare_done;
+	    case LispString_t:
+		if (rtype == LispString_t && STRLEN(left) == STRLEN(right)) {
+		    long i = STRLEN(left);
+		    char *sl = THESTR(left), *sr = THESTR(right);
+
+		    for (--i; i >= 0; i--)
+			if (toupper(sl[i]) != toupper(sr[i]))
+			    break;
+		    if (i < 0)
+			result = T;
+		}
+		goto compare_done;
+	    case LispArray_t:
+		if (rtype == LispArray_t &&
+		    left->data.array.type == right->data.array.type &&
+		    left->data.array.rank == right->data.array.rank &&
+		    LispObjectCompare(left->data.array.dim,
+				      right->data.array.dim,
+				      FEQUAL) != NIL) {
+		    LispObj *llist = left->data.array.list,
+		    	    *rlist = right->data.array.list;
+
+		    for (; CONSP(llist); llist = CDR(llist), rlist = CDR(rlist))
+			if (LispObjectCompare(CAR(llist), CAR(rlist),
+					      FEQUALP) == NIL)
+			    break;
+		    if (!CONSP(llist))
+			result = T;
+		}
+		goto compare_done;
+	    case LispStruct_t:
+		if (rtype == LispStruct_t &&
+		    left->data.struc.def == right->data.struc.def) {
+		    LispObj *lfield = left->data.struc.fields,
+		    	    *rfield = right->data.struc.fields;
+
+		    for (; CONSP(lfield);
+			 lfield = CDR(lfield), rfield = CDR(rfield)) {
+			if (LispObjectCompare(CAR(lfield), CAR(rfield),
+					      FEQUALP) != T)
+			    break;
+		    }
+		    if (!CONSP(lfield))
+			result = T;
+		}
+		goto compare_done;
+	    case LispHashTable_t:
+		if (rtype == LispHashTable_t &&
+		    left->data.hash.table->count ==
+		    right->data.hash.table->count &&
+		    left->data.hash.test == right->data.hash.test) {
+		    unsigned long i;
+		    LispObj *test = left->data.hash.test;
+		    LispHashEntry *lentry = left->data.hash.table->entries,
+				  *llast = lentry +
+					   left->data.hash.table->num_entries,
+				  *rentry = right->data.hash.table->entries;
+
+		    for (; lentry < llast; lentry++, rentry++) {
+			if (lentry->count != rentry->count)
+			    break;
+			for (i = 0; i < lentry->count; i++) {
+			    if (APPLY2(test,
+				       lentry->keys[i],
+				       rentry->keys[i]) == NIL ||
+				LispObjectCompare(lentry->values[i],
+						  rentry->values[i],
+						  FEQUALP) == NIL)
+				break;
+			}
+			if (i < lentry->count)
+			    break;
+		    }
+		    if (lentry == llast)
+			result = T;
+		}
+		goto compare_done;
+	    default:
+		break;
+	}
+    }
+
+    /* Function is EQL or EQUAL, or EQUALP on arguments with the same rules */
+    if (ltype == rtype) {
+	switch (ltype) {
+	    case LispFixnum_t:
+	    case LispSChar_t:
+		if (FIXNUM_VALUE(left) == FIXNUM_VALUE(right))
+		    result = T;
+		break;
+	    case LispInteger_t:
+		if (INT_VALUE(left) == INT_VALUE(right))
+		    result = T;
+		break;
+	    case LispDFloat_t:
+		if (DFLOAT_VALUE(left) == DFLOAT_VALUE(right))
+		    result = T;
+		break;
+	    case LispRatio_t:
+		if (left->data.ratio.numerator ==
+		    right->data.ratio.numerator &&
+		    left->data.ratio.denominator ==
+		    right->data.ratio.denominator)
+		    result = T;
+		break;
+	    case LispComplex_t:
+		if (LispObjectCompare(left->data.complex.real,
+				      right->data.complex.real,
+				      function) == T &&
+		    LispObjectCompare(left->data.complex.imag,
+				      right->data.complex.imag,
+				      function) == T)
+		    result = T;
+		break;
+	    case LispBignum_t:
+		if (mpi_cmp(left->data.mp.integer, right->data.mp.integer) == 0)
+		    result = T;
+		break;
+	    case LispBigratio_t:
+		if (mpr_cmp(left->data.mp.ratio, right->data.mp.ratio) == 0)
+		    result = T;
+		break;
+	    default:
+		break;
+	}
+
+	/* Next types must be the same object for EQL */
+	if (function == FEQL)
+	    goto compare_done;
+
+	switch (ltype) {
+	    case LispString_t:
+		if (STRLEN(left) == STRLEN(right) &&
+		    memcmp(THESTR(left), THESTR(right), STRLEN(left)) == 0)
+		    result = T;
+		break;
+	    case LispCons_t:
+		if (LispObjectCompare(CAR(left), CAR(right), function) == T &&
+		    LispObjectCompare(CDR(left), CDR(right), function) == T)
+		    result = T;
+		break;
+	    case LispQuote_t:
+	    case LispBackquote_t:
+	    case LispPathname_t:
+		result = LispObjectCompare(left->data.pathname,
+					   right->data.pathname, function);
+		break;
+	    case LispLambda_t:
+		result = LispObjectCompare(left->data.lambda.name,
+					   right->data.lambda.name,
+					   function);
+		break;
+	    case LispOpaque_t:
+		if (left->data.opaque.data == right->data.opaque.data)
+		    result = T;
+		break;
+	    case LispRegex_t:
+		/* If the regexs are guaranteed to generate the same matches */
+		if (left->data.regex.options == right->data.regex.options)
+		    result = LispObjectCompare(left->data.regex.pattern,
+					       right->data.regex.pattern,
+					       function);
+		break;
+	    default:
+		break;
+	}
+    }
+
+compare_done:
+    return (result);
+}
+
+void
+LispCheckSequenceStartEnd(LispBuiltin *builtin,
+			  LispObj *sequence, LispObj *start, LispObj *end,
+			  long *pstart, long *pend, long *plength)
+{
+    /* Calculate length of sequence and check it's type */
+    *plength = LispLength(sequence);
+
+    /* Check start argument */
+    if (start == UNSPEC || start == NIL)
+	*pstart = 0;
+    else {
+	CHECK_INDEX(start);
+	*pstart = FIXNUM_VALUE(start);
+    }
+
+    /* Check end argument */
+    if (end == UNSPEC || end == NIL)
+	*pend = *plength;
+    else {
+	CHECK_INDEX(end);
+	*pend = FIXNUM_VALUE(end);
+    }
+
+    /* Check start argument */
+    if (*pstart > *pend)
+	LispDestroy("%s: :START %ld is larger than :END %ld",
+		    STRFUN(builtin), *pstart, *pend);
+
+    /* Check end argument */
+    if (*pend > *plength)
+	LispDestroy("%s: :END %ld is larger then sequence length %ld",
+		    STRFUN(builtin), *pend, *plength);
+}
+
+long
+LispLength(LispObj *sequence)
+{
+    long length;
+
+    if (sequence == NIL)
+	return (0);
+    switch (OBJECT_TYPE(sequence)) {
+	case LispString_t:
+	    length = STRLEN(sequence);
+	    break;
+	case LispArray_t:
+	    if (sequence->data.array.rank != 1)
+		goto not_a_sequence;
+	    sequence = sequence->data.array.list;
+	    /*FALLTROUGH*/
+	case LispCons_t:
+	    for (length = 0;
+		 CONSP(sequence);
+		 length++, sequence = CDR(sequence))
+		;
+	    break;
+	default:
+not_a_sequence:
+	    LispDestroy("LENGTH: %s is not a sequence", STROBJ(sequence));
+	    /*NOTREACHED*/
+	    length = 0;
+    }
+
+    return (length);
+}
+
+LispObj *
+LispCharacterCoerce(LispBuiltin *builtin, LispObj *object)
+{
+    if (SCHARP(object))
+	return (object);
+    else if (STRINGP(object) && STRLEN(object) == 1)
+	return (SCHAR(THESTR(object)[0]));
+    else if (SYMBOLP(object) && ATOMID(object)[1] == '\0')
+	return (SCHAR(ATOMID(object)[0]));
+    else if (INDEXP(object)) {
+	int c = FIXNUM_VALUE(object);
+
+	if (c <= 0xff)
+	    return (SCHAR(c));
+    }
+    else if (object == T)
+	return (SCHAR('T'));
+
+    LispDestroy("%s: cannot convert %s to character",
+		STRFUN(builtin), STROBJ(object));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+LispStringCoerce(LispBuiltin *builtin, LispObj *object)
+{
+    if (STRINGP(object))
+	return (object);
+    else if (SYMBOLP(object))
+	return (LispSymbolName(object));
+    else if (SCHARP(object)) {
+	char string[1];
+
+	string[0] = SCHAR_VALUE(object);
+	return (LSTRING(string, 1));
+    }
+    else if (object == NIL)
+	return (LSTRING(Snil, 3));
+    else if (object == T)
+	return (LSTRING(St, 1));
+    else
+	LispDestroy("%s: cannot convert %s to string",
+		    STRFUN(builtin), STROBJ(object));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+LispCoerce(LispBuiltin *builtin,
+	   LispObj *object, LispObj *result_type)
+{
+    LispObj *result = NIL;
+    LispType type = LispNil_t;
+
+    if (result_type == NIL)
+	/* not even NIL can be converted to NIL? */
+	LispDestroy("%s: cannot convert %s to NIL",
+		    STRFUN(builtin), STROBJ(object));
+
+    else if (result_type == T)
+	/* no conversion */
+	return (object);
+
+    else if (!SYMBOLP(result_type))
+	/* only know about simple types */
+	LispDestroy("%s: bad argument %s",
+		    STRFUN(builtin), STROBJ(result_type));
+
+    else {
+	/* check all known types */
+
+	Atom_id atom = ATOMID(result_type);
+
+	if (atom == Satom) {
+	    if (CONSP(object))
+		goto coerce_fail;
+	    return (object);
+	}
+	/* only convert ATOM to SYMBOL */
+
+	if (atom == Sfloat)
+	    type = LispDFloat_t;
+	else if (atom == Sinteger)
+	    type = LispInteger_t;
+	else if (atom == Scons || atom == Slist) {
+	    if (object == NIL)
+		return (object);
+	    type = LispCons_t;
+	}
+	else if (atom == Sstring)
+	    type = LispString_t;
+	else if (atom == Scharacter)
+	    type = LispSChar_t;
+	else if (atom == Scomplex)
+	    type = LispComplex_t;
+	else if (atom == Svector || atom == Sarray)
+	    type = LispArray_t;
+	else if (atom == Sopaque)
+	    type = LispOpaque_t;
+	else if (atom == Srational)
+	    type = LispRatio_t;
+	else if (atom == Spathname)
+	    type = LispPathname_t;
+	else
+	    LispDestroy("%s: invalid type specification %s",
+			STRFUN(builtin), ATOMID(result_type));
+    }
+
+    if (OBJECT_TYPE(object) == LispOpaque_t) {
+	switch (type) {
+	    case LispAtom_t:
+		result = ATOM(object->data.opaque.data);
+		break;
+	    case LispString_t:
+		result = STRING(object->data.opaque.data);
+		break;
+	    case LispSChar_t:
+		result = SCHAR((unsigned long)object->data.opaque.data);
+		break;
+	    case LispDFloat_t:
+		result = DFLOAT((double)((long)object->data.opaque.data));
+		break;
+	    case LispInteger_t:
+		result = INTEGER(((long)object->data.opaque.data));
+		break;
+	    case LispOpaque_t:
+		result = OPAQUE(object->data.opaque.data, 0);
+		break;
+	    default:
+		goto coerce_fail;
+		break;
+	}
+    }
+
+    else if (OBJECT_TYPE(object) != type) {
+	switch (type) {
+	    case LispInteger_t:
+		if (INTEGERP(object))
+		    result = object;
+		else if (DFLOATP(object)) {
+		    if ((long)DFLOAT_VALUE(object) == DFLOAT_VALUE(object))
+			result = INTEGER((long)DFLOAT_VALUE(object));
+		    else {
+			mpi *integer = LispMalloc(sizeof(mpi));
+
+			mpi_init(integer);
+			mpi_setd(integer, DFLOAT_VALUE(object));
+			if (mpi_getd(integer) != DFLOAT_VALUE(object)) {
+			    mpi_clear(integer);
+			    LispFree(integer);
+			    goto coerce_fail;
+			}
+			result = BIGNUM(integer);
+		    }
+		}
+		else
+		    goto coerce_fail;
+		break;
+	    case LispRatio_t:
+		if (DFLOATP(object)) {
+		    mpr *ratio = LispMalloc(sizeof(mpr));
+
+		    mpr_init(ratio);
+		    mpr_setd(ratio, DFLOAT_VALUE(object));
+		    if (mpr_fiti(ratio)) {
+			result = RATIO(mpi_geti(mpr_num(ratio)),
+				       mpi_geti(mpr_den(ratio)));
+			mpr_clear(ratio);
+			LispFree(ratio);
+		    }
+		    else
+			result = BIGRATIO(ratio);
+		}
+		else if (RATIONALP(object))
+		    result = object;
+		else
+		    goto coerce_fail;
+		break;
+	    case LispDFloat_t:
+		result = LispFloatCoerce(builtin, object);
+	    	break;
+	    case LispComplex_t:
+		if (NUMBERP(object))
+		    result = object;
+		else
+		    goto coerce_fail;
+		break;
+	    case LispString_t:
+		if (object == NIL)
+		    result = STRING("");
+		else
+		    result = LispStringCoerce(builtin, object);
+		break;
+	    case LispSChar_t:
+		result = LispCharacterCoerce(builtin, object);
+		break;
+	    case LispArray_t:
+		if (LISTP(object))
+		    result = VECTOR(object);
+		else
+		    goto coerce_fail;
+		break;
+	    case LispCons_t:
+		if (ARRAYP(object) && object->data.array.rank == 1)
+		    result = object->data.array.list;
+		else
+		    goto coerce_fail;
+		break;
+	    case LispPathname_t:
+		result = APPLY1(Oparse_namestring, object);
+		break;
+	    default:
+		goto coerce_fail;
+	}
+    }
+    else
+	result = object;
+
+    return (result);
+
+coerce_fail:
+    LispDestroy("%s: cannot convert %s to %s",
+		STRFUN(builtin), STROBJ(object), ATOMID(result_type));
+    /* NOTREACHED */
+    return (NIL);
+}
+
+static LispObj *
+LispReallyDo(LispBuiltin *builtin, int refs)
+/*
+ do init test &rest body
+ do* init test &rest body
+ */
+{
+    GC_ENTER();
+    int stack, lex, head;
+    LispObj *list, *symbol, *value, *values, *cons;
+
+    LispObj *init, *test, *body;
+
+    body = ARGUMENT(2);
+    test = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    if (!CONSP(test))
+	LispDestroy("%s: end test condition must be a list, not %s",
+		    STRFUN(builtin), STROBJ(init));
+
+    CHECK_LIST(init);
+
+    /* Save state */
+    stack = lisp__data.stack.length;
+    lex = lisp__data.env.lex;
+    head = lisp__data.env.length;
+
+    values = cons = NIL;
+    for (list = init; CONSP(list); list = CDR(list)) {
+	symbol = CAR(list);
+	if (!SYMBOLP(symbol)) {
+	    CHECK_CONS(symbol);
+	    value = CDR(symbol);
+	    symbol = CAR(symbol);
+	    CHECK_SYMBOL(symbol);
+	    CHECK_CONS(value);
+	    value = EVAL(CAR(value));
+	}
+	else
+	    value = NIL;
+
+	CHECK_CONSTANT(symbol);
+
+	LispAddVar(symbol, value);
+
+	/* Bind variable now */
+	if (refs) {
+	    ++lisp__data.env.head;
+	}
+	else {
+	    if (values == NIL) {
+		values = cons = CONS(NIL, NIL);
+		GC_PROTECT(values);
+	    }
+	    else {
+		RPLACD(cons, CONS(NIL, NIL));
+		cons = CDR(cons);
+	    }
+	}
+    }
+    if (!refs)
+	lisp__data.env.head = lisp__data.env.length;
+
+    for (;;) {
+	if (EVAL(CAR(test)) != NIL)
+	    break;
+
+	/* TODO Run this code in an implicit tagbody */
+	for (list = body; CONSP(list); list = CDR(list))
+	    (void)EVAL(CAR(list));
+
+	/* Error checking already done in the initialization */
+	for (list = init, cons = values; CONSP(list); list = CDR(list)) {
+	    symbol = CAR(list);
+	    if (CONSP(symbol)) {
+		value = CDDR(symbol);
+		symbol = CAR(symbol);
+		if (CONSP(value))
+		    value = EVAL(CAR(value));
+		else
+		    value = NIL;
+	    }
+	    else
+		value = NIL;
+
+	    if (refs)
+		LispSetVar(symbol, value);
+	    else {
+		RPLACA(cons, value);
+		cons = CDR(cons);
+	    }
+	}
+	if (!refs) {
+	    for (list = init, cons = values;
+		 CONSP(list);
+		 list = CDR(list), cons = CDR(cons)) {
+		symbol = CAR(list);
+		if (CONSP(symbol)) {
+		    if (CONSP(CDR(symbol)))
+			LispSetVar(CAR(symbol), CAR(cons));
+		}
+	    }
+	}
+    }
+
+    if (CONSP(CDR(test)))
+	value = EVAL(CADR(test));
+    else
+	value = NIL;
+
+    /* Restore state */
+    lisp__data.stack.length = stack;
+    lisp__data.env.lex = lex;
+    lisp__data.env.head = lisp__data.env.length = head;
+    GC_LEAVE();
+
+    return (value);
+}
+
+LispObj *
+LispDo(LispBuiltin *builtin, int refs)
+/*
+ do init test &rest body
+ do* init test &rest body
+ */
+{
+    int jumped, *pjumped;
+    LispObj *result, **presult;
+    LispBlock *block;
+
+    jumped = 1;
+    result = NIL;
+    presult = &result;
+    pjumped = &jumped;
+    block = LispBeginBlock(NIL, LispBlockTag);
+    if (setjmp(block->jmp) == 0) {
+	result = LispReallyDo(builtin, refs);
+	jumped = 0;
+    }
+    LispEndBlock(block);
+    if (jumped)
+	result = lisp__data.block.block_ret;
+
+    return (result);
+}
+
+static LispObj *
+LispReallyDoListTimes(LispBuiltin *builtin, int times)
+/*
+ dolist init &rest body
+ dotimes init &rest body
+ */
+{
+    GC_ENTER();
+    int head = lisp__data.env.length;
+    long count = 0, end = 0;
+    LispObj *symbol, *value = NIL, *result = NIL, *init, *body, *object;
+
+    body = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    /* Parse arguments */
+    CHECK_CONS(init);
+    symbol = CAR(init);
+    CHECK_SYMBOL(symbol);
+    init = CDR(init);
+
+    if (init == NIL) {
+	if (times)
+	    LispDestroy("%s: NIL is not a number", STRFUN(builtin));
+    }
+    else {
+	CHECK_CONS(init);
+	value = CAR(init);
+	init = CDR(init);
+	if (init != NIL) {
+	    CHECK_CONS(init);
+	    result = CAR(init);
+	}
+
+	value = EVAL(value);
+
+	if (times) {
+	    CHECK_INDEX(value);
+	    end = FIXNUM_VALUE(value);
+	}
+	else {
+	    CHECK_LIST(value);
+	    /* Protect iteration control from gc */
+	    GC_PROTECT(value);
+	}
+    }
+
+    /* The variable is only bound inside the loop, so it is safe to optimize
+     * it out if there is no code to execute. But the result form may reference
+     * the bound variable. */
+    if (!CONSP(body)) {
+	if (times)
+	    count = end;
+	else
+	    value = NIL;
+    }
+
+    /* Initialize counter */
+    CHECK_CONSTANT(symbol);
+    if (times)
+	LispAddVar(symbol, FIXNUM(count));
+    else
+	LispAddVar(symbol, CONSP(value) ? CAR(value) : value);
+    ++lisp__data.env.head;
+
+    if (!CONSP(body) || (times && count >= end) || (!times && !CONSP(value)))
+	goto loop_done;
+
+    /* Execute iterations */
+    for (;;) {
+	for (object = body; CONSP(object); object = CDR(object))
+	    (void)EVAL(CAR(object));
+
+	/* Update symbols and check exit condition */
+	if (times) {
+	    ++count;
+	    LispSetVar(symbol, FIXNUM(count));
+	    if (count >= end)
+		break;
+	}
+	else {
+	    value = CDR(value);
+	    if (!CONSP(value)) {
+		LispSetVar(symbol, NIL);
+		break;
+	    }
+	    LispSetVar(symbol, CAR(value));
+	}
+    }
+
+loop_done:
+    result = EVAL(result);
+    lisp__data.env.head = lisp__data.env.length = head;
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+LispDoListTimes(LispBuiltin *builtin, int times)
+/*
+ dolist init &rest body
+ dotimes init &rest body
+ */
+{
+    int did_jump, *pdid_jump = &did_jump;
+    LispObj *result, **presult = &result;
+    LispBlock *block;
+
+    *presult = NIL;
+    *pdid_jump = 1;
+    block = LispBeginBlock(NIL, LispBlockTag);
+    if (setjmp(block->jmp) == 0) {
+	result = LispReallyDoListTimes(builtin, times);
+	did_jump = 0;
+    }
+    LispEndBlock(block);
+    if (did_jump)
+	result = lisp__data.block.block_ret;
+
+    return (result);
+}
+
+LispObj *
+LispLoadFile(LispObj *filename, int verbose, int print, int ifdoesnotexist)
+{
+    LispObj *stream, *cod, *obj, *result;
+    int ch;
+
+    LispObj *savepackage;
+    LispPackage *savepack;
+
+    if (verbose)
+	LispMessage("; Loading %s", THESTR(filename));
+
+    if (ifdoesnotexist) {
+	GC_ENTER();
+	result = CONS(filename, CONS(Kif_does_not_exist, CONS(Kerror, NIL)));
+	GC_PROTECT(result);
+	stream = APPLY(Oopen, result);
+	GC_LEAVE();
+    }
+    else
+	stream = APPLY1(Oopen, filename);
+
+    if (stream == NIL)
+	return (NIL);
+
+    result = NIL;
+    LispPushInput(stream);
+    ch = LispGet();
+    if (ch != '#')
+	LispUnget(ch);
+    else if ((ch = LispGet()) == '!') {
+	for (;;) {
+	    ch = LispGet();
+	    if (ch == '\n' || ch == EOF)
+		break;
+	}
+    }
+    else {
+	LispUnget(ch);
+	LispUnget('#');
+    }
+
+    /* Save package environment */
+    savepackage = PACKAGE;
+    savepack = lisp__data.pack;
+
+    cod = COD;
+
+    /*CONSTCOND*/
+    while (1) {
+	if ((obj = LispRead()) != NULL) {
+	    result = EVAL(obj);
+	    COD = cod;
+	    if (print) {
+		int i;
+
+		if (RETURN_COUNT >= 0)
+		    LispPrint(result, NIL, 1);
+		for (i = 0; i < RETURN_COUNT; i++)
+		    LispPrint(RETURN(i), NIL, 1);
+	    }
+	}
+	if (lisp__data.eof)
+	    break;
+    }
+    LispPopInput(stream);
+
+    /* Restore package environment */
+    PACKAGE = savepackage;
+    lisp__data.pack = savepack;
+
+    APPLY1(Oclose, stream);
+
+    return (T);
+}
+
+void
+LispGetStringArgs(LispBuiltin *builtin,
+		  char **string1, char **string2,
+		  long *start1, long *end1, long *start2, long *end2)
+{
+    long length1, length2;
+    LispObj *ostring1, *ostring2, *ostart1, *oend1, *ostart2, *oend2;
+
+    oend2 = ARGUMENT(5);
+    ostart2 = ARGUMENT(4);
+    oend1 = ARGUMENT(3);
+    ostart1 = ARGUMENT(2);
+    ostring2 = ARGUMENT(1);
+    ostring1 = ARGUMENT(0);
+
+    CHECK_STRING(ostring1);
+    *string1 = THESTR(ostring1);
+    length1 = STRLEN(ostring1);
+
+    CHECK_STRING(ostring2);
+    *string2 = THESTR(ostring2);
+    length2 = STRLEN(ostring2);
+
+    if (ostart1 == UNSPEC)
+	*start1 = 0;
+    else {
+	CHECK_INDEX(ostart1);
+	*start1 = FIXNUM_VALUE(ostart1);
+    }
+    if (oend1 == UNSPEC)
+	*end1 = length1;
+    else {
+	CHECK_INDEX(oend1);
+	*end1 = FIXNUM_VALUE(oend1);
+    }
+
+    if (ostart2 == UNSPEC)
+	*start2 = 0;
+    else {
+	CHECK_INDEX(ostart2);
+	*start2 = FIXNUM_VALUE(ostart2);
+    }
+
+    if (oend2 == UNSPEC)
+	*end2 = length2;
+    else {
+	CHECK_INDEX(oend2);
+	*end2 = FIXNUM_VALUE(oend2);
+    }
+
+    if (*start1 > *end1)
+	LispDestroy("%s: :START1 %ld larger than :END1 %ld",
+		    STRFUN(builtin), *start1, *end1);
+    if (*start2 > *end2)
+	LispDestroy("%s: :START2 %ld larger than :END2 %ld",
+		    STRFUN(builtin), *start2, *end2);
+    if (*end1 > length1)
+	LispDestroy("%s: :END1 %ld larger than string length %ld",
+		    STRFUN(builtin), *end1, length1);
+    if (*end2 > length2)
+	LispDestroy("%s: :END2 %ld larger than string length %ld",
+		    STRFUN(builtin), *end2, length2);
+}
+
+LispObj *
+LispPathnameField(int field, int string)
+{
+    int offset = field;
+    LispObj *pathname, *result, *object;
+
+    pathname = ARGUMENT(0);
+
+    if (PATHNAMEP(pathname))
+	pathname = APPLY1(Oparse_namestring, pathname);
+
+    result = pathname->data.pathname;
+    while (offset) {
+	result = CDR(result);
+	--offset;
+    }
+    object = result;
+    result = CAR(result);
+
+    if (string) {
+	if (!STRINGP(result)) {
+	    if (result == NIL)
+		result = STRING("");
+	    else if (field == PATH_DIRECTORY) {
+		char *name = THESTR(CAR(pathname->data.pathname)), *ptr;
+
+		ptr = strrchr(name, PATH_SEP);
+		if (ptr) {
+		    int length = ptr - name + 1;
+		    char data[PATH_MAX];
+
+		    if (length > PATH_MAX - 1)
+			length = PATH_MAX - 1;
+		    strncpy(data, name, length);
+		    data[length] = '\0';
+		    result = STRING(data);
+		}
+		else
+		    result = STRING("");
+	    }
+	    else
+		result = Kunspecific;
+	}
+	else if (field == PATH_NAME) {
+	    object = CAR(CDR(object));
+	    if (STRINGP(object)) {
+		int length;
+		char name[PATH_MAX + 1];
+
+		strcpy(name, THESTR(result));
+		length = STRLEN(result);
+		if (length + 1 < sizeof(name)) {
+		    name[length++] = PATH_TYPESEP;
+		    name[length] = '\0';
+		}
+		if (STRLEN(object) + length < sizeof(name))
+		    strcpy(name + length, THESTR(object));
+		/* else LispDestroy ... */
+		result = STRING(name);
+	    }
+	}
+    }
+
+    return (result);
+}
+
+LispObj *
+LispProbeFile(LispBuiltin *builtin, int probe)
+{
+    GC_ENTER();
+    LispObj *result;
+    char *name = NULL, resolved[PATH_MAX + 1];
+    struct stat st;
+
+    LispObj *pathname;
+
+    pathname = ARGUMENT(0);
+
+    if (!POINTERP(pathname))
+	goto bad_pathname;
+
+    if (XSTRINGP(pathname))
+	name = THESTR(pathname);
+    else if (XPATHNAMEP(pathname))
+	name = THESTR(CAR(pathname->data.pathname));
+    else if (STREAMP(pathname) && pathname->data.stream.type == LispStreamFile)
+	name = THESTR(CAR(pathname->data.stream.pathname->data.pathname));
+
+    if (realpath(name, &resolved[0]) == NULL ||
+	stat(resolved, &st)) {
+	if (probe)
+	    return (NIL);
+	LispDestroy("%s: realpath(\"%s\"): %s",
+		    STRFUN(builtin), name, strerror(errno));
+    }
+
+    if (S_ISDIR(st.st_mode)) {
+	int length = strlen(resolved);
+
+	if (!length || resolved[length - 1] != PATH_SEP) {
+	    resolved[length++] = PATH_SEP;
+	    resolved[length] = '\0';
+	}
+    }
+
+    result = STRING(resolved);
+    GC_PROTECT(result);
+    result = APPLY1(Oparse_namestring, result);
+    GC_LEAVE();
+
+    return (result);
+
+bad_pathname:
+    LispDestroy("%s: bad pathname %s", STRFUN(builtin), STROBJ(pathname));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+LispWriteString_(LispBuiltin *builtin, int newline)
+/*
+ write-line string &optional output-stream &key start end
+ write-string string &optional output-stream &key start end
+ */
+{
+    char *text;
+    long start, end, length;
+
+    LispObj *string, *output_stream, *ostart, *oend;
+
+    oend = ARGUMENT(3);
+    ostart = ARGUMENT(2);
+    output_stream = ARGUMENT(1);
+    string = ARGUMENT(0);
+
+    CHECK_STRING(string);
+    LispCheckSequenceStartEnd(builtin, string, ostart, oend,
+			      &start, &end, &length);
+    if (output_stream == UNSPEC)
+	output_stream = NIL;
+    text = THESTR(string);
+    if (end > start)
+	LispWriteStr(output_stream, text + start, end - start);
+    if (newline)
+	LispWriteChar(output_stream, '\n');
+
+    return (string);
+}
diff --git a/lisp/helper.h b/lisp/helper.h
new file mode 100644
index 0000000..865f397
--- /dev/null
+++ b/lisp/helper.h
@@ -0,0 +1,115 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/helper.h,v 1.15 2002/11/25 02:35:30 paulo Exp $ */
+
+#ifndef Lisp_helper_h
+#define Lisp_helper_h
+
+#include "private.h"
+
+/*
+ * Prototypes
+ */
+void LispCheckSequenceStartEnd(LispBuiltin*, LispObj*,
+			       LispObj*, LispObj*, long*, long*, long*);
+long LispLength(LispObj*);
+LispObj *LispCharacterCoerce(LispBuiltin*, LispObj*);
+LispObj *LispStringCoerce(LispBuiltin*, LispObj*);
+LispObj *LispCoerce(LispBuiltin*, LispObj*, LispObj*);
+
+/*
+ do init test &rest body
+ do* init test &rest body
+ */
+LispObj *LispDo(LispBuiltin*, int);
+
+/*
+ dolist init &rest body
+ dotimes init &rest body
+ */
+LispObj *LispDoListTimes(LispBuiltin*, int);
+
+#define FEQ	1
+#define FEQL	2
+#define FEQUAL	3
+#define FEQUALP	4
+LispObj *LispObjectCompare(LispObj*, LispObj*, int);
+#define XEQ(x, y)	LispObjectCompare(x, y, FEQ)
+#define XEQL(x, y)	LispObjectCompare(x, y, FEQL)
+#define XEQUAL(x, y)	LispObjectCompare(x, y, FEQUAL)
+#define XEQUALP(x, y)	LispObjectCompare(x, y, FEQUALP)
+
+LispObj *LispLoadFile(LispObj*, int, int, int);
+
+/*
+ string= string1 string2 &key start1 end1 start2 end2
+ string< string1 string2 &key start1 end1 start2 end2
+ string> string1 string2 &key start1 end1 start2 end2
+ string<= string1 string2 &key start1 end1 start2 end2
+ string>= string1 string2 &key start1 end1 start2 end2
+ string/= string1 string2 &key start1 end1 start2 end2
+ string-equal string1 string2 &key start1 end1 start2 end2
+ string-lessp string1 string2 &key start1 end1 start2 end2
+ string-greaterp string1 string2 &key start1 end1 start2 end2
+ string-not-lessp string1 string2 &key start1 end1 start2 end2
+ string-not-greaterp string1 string2 &key start1 end1 start2 end2
+ string-not-equal string1 string2 &key start1 end1 start2 end2
+*/
+void LispGetStringArgs(LispBuiltin*,
+			char**,	/* string1 */
+			char**,	/* string2 */
+			long*,	/* start1 */
+			long*,	/* end1 */
+			long*,	/* start2 */
+			long*);	/* end2 */
+
+/*
+ pathname-host pathname
+ pathname-device pathname
+ pathname-directory pathname
+ pathname-name pathname
+ pathname-type pathname
+ pathname-version pathname
+ */
+LispObj *LispPathnameField(int, int);
+
+/*
+ truename pathname
+ probe-file pathname
+ */
+LispObj *LispProbeFile(LispBuiltin*, int);
+
+/*
+ write-string string &optional output-stream &key start end
+ write-line string &optional output-stream &key start end
+ */
+LispObj *LispWriteString_(LispBuiltin*, int);
+
+#endif	/* Lisp_helper_h */
diff --git a/lisp/internal.h b/lisp/internal.h
new file mode 100644
index 0000000..1061618
--- /dev/null
+++ b/lisp/internal.h
@@ -0,0 +1,784 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/internal.h,v 1.49 2002/12/11 04:44:27 paulo Exp $ */
+
+#ifndef Lisp_internal_h
+#define Lisp_internal_h
+
+#include <stdio.h>
+#include "lisp.h"
+
+#include "mp.h"
+#include "re.h"
+
+/*
+ * Defines
+ */
+typedef struct _LispMac LispMac;
+
+#define STREAM_READ		0x01
+#define STREAM_WRITE		0x02
+#define STREAM_BINARY		0x20
+
+#define RPLACA(cons, object)	(CAR(cons) = object)
+#define RPLACD(cons, object)	(CDR(cons) = object)
+
+#define	CAR(list)		((list)->data.cons.car)
+#define	CAAR(list)		((list)->data.cons.car->data.cons.car)
+#define	CADR(list)		((list)->data.cons.cdr->data.cons.car)
+#define CDR(list)		((list)->data.cons.cdr)
+#define CDAR(list)		((list)->data.cons.car->data.cons.cdr)
+#define CDDR(list)		((list)->data.cons.cdr->data.cons.cdr)
+#define CONS(car, cdr)		LispNewCons(car, cdr)
+#define EVAL(list)		LispEval(list)
+#define APPLY(fun, args)	LispFuncall(fun, args, 0)
+#define APPLY1(fun, arg)	LispApply1(fun, arg)
+#define APPLY2(fun, arg1, arg2)	LispApply2(fun, arg1, arg2)
+#define APPLY3(f, a1, a2, a3)	LispApply3(f, a1, a2, a3)
+#define EXECUTE(string)		LispExecute(string)
+#define SYMBOL(atom)		LispNewSymbol(atom)
+#define ATOM(string)		LispNewAtom(string, 1)
+#define UNINTERNED_ATOM(string)	LispNewAtom(string, 0)
+#define FUNCTION(symbol)	LispNewFunction(symbol)
+#define FUNCTION_QUOTE(symbol)	LispNewFunctionQuote(symbol)
+
+	/* atom string is a static variable */
+#define ATOM2(string)		LispNewSymbol(LispGetPermAtom(string))
+
+	/* make a gc never released variable with a static string argument */
+#define STATIC_ATOM(string)	LispNewStaticAtom(string)
+
+#define STRING(str)		LispNewString(str, strlen(str), 0)
+#define LSTRING(str, size)	LispNewString(str, size, 0)
+
+	/* string must be from the LispXXX allocation functions,
+	 * and LispMused not yet called on it */
+#define STRING2(str)		LispNewString(str, strlen(str), 1)
+#define LSTRING2(str, size)	LispNewString(str, size, 1)
+
+#define VECTOR(objects)		LispNewVector(objects)
+
+	/* STRINGSTREAM2 and LSTRINGSTREAM2 require that the
+	 * string be allocated from the LispXXX allocation functions,
+	 * and LispMused not yet called on it */
+#define STRINGSTREAM(str, flag)			\
+	LispNewStringStream(str, flag, strlen(str), 0)
+#define STRINGSTREAM2(str, flag)		\
+	LispNewStringStream(str, flag, strlen(str), 1)
+#define LSTRINGSTREAM(str, flag, length)	\
+	LispNewStringStream(str, flag, length, 0)
+#define LSTRINGSTREAM2(str, flag, length)	\
+	LispNewStringStream(str, flag, length, 1)
+
+#define FILESTREAM(file, path, flag)	\
+	LispNewFileStream(file, path, flag)
+#define PIPESTREAM(file, path, flag)	\
+	LispNewPipeStream(file, path, flag)
+
+#define CHECKO(obj, typ)						\
+	((obj)->type == LispOpaque_t && 				\
+	 ((obj)->data.opaque.type == typ || (obj)->data.opaque.type == 0))
+#define PROTECT(key, list)	LispProtect(key, list)
+#define UPROTECT(key, list)	LispUProtect(key, list)
+
+/* create a new unique static atom string */
+#define GETATOMID(string)	LispGetAtomString(string, 1)
+
+#define	GCDisable()		++gcpro
+#define	GCEnable()		--gcpro
+
+
+/* pointer to something unique to all atoms with the same print representation */
+#define ATOMID(object)		(object)->data.atom->string
+
+
+
+#define NIL_BIT			0x01
+#define FIXNUM_BIT		0x02
+#define FIXNUM_MASK		0x03
+#define SCHAR_BIT		0x04
+#define SCHAR_MASK		0x05
+#define BIT_COUNT		4
+#define BIT_MASK		0x0f
+#define POINTERP(object)						\
+    (((unsigned long)(object) & NIL_BIT) == 0)
+
+#define MOST_POSITIVE_FIXNUM	((1L << (sizeof(long) * 8 - 5)) - 1)
+#define MOST_NEGATIVE_FIXNUM	(-1L << (sizeof(long) * 8 - 5))
+
+#define SCHAR(value)							\
+    ((LispObj*)(((long)(value) << BIT_COUNT) | SCHAR_MASK))
+#define SCHAR_VALUE(object)	FIXNUM_VALUE(object)
+#define SCHARP(object)							\
+    (((unsigned long)(object) & BIT_MASK) == SCHAR_MASK)
+#define CHECK_SCHAR(object)						\
+    if (!SCHARP(object))						\
+	LispDestroy("%s: %s is not a character",			\
+		    STRFUN(builtin), STROBJ(object))
+
+#define XOBJECT_TYPE(object)	((object)->type)
+#define OBJECT_TYPE(object)						\
+    (POINTERP(object) ? XOBJECT_TYPE(object) : (long)(object) & BIT_MASK)
+
+
+#define NIL			(LispObj*)0x00000001
+#define T			(LispObj*)0x00000011
+#define DOT			(LispObj*)0x00000021
+/* unmatched ')' */
+#define	EOLIST			(LispObj*)0x00000031
+#define READLABEL_MASK		0x00000041
+/* unspecified argument */
+#define UNSPEC			(LispObj*)0x00000051
+#define INVALIDP(object)						\
+    ((object) == NULL || (object) == EOLIST || (object) == DOT)
+
+
+/* cons */
+#define XCONSP(object)		((object)->type == LispCons_t)
+#define CONSP(object)		(POINTERP(object) && XCONSP(object))
+#define CHECK_CONS(object)						\
+    if (!CONSP(object))							\
+	LispDestroy("%s: %s is not of type cons",			\
+		    STRFUN(builtin), STROBJ(object))
+#define LISTP(object)		(object == NIL || CONSP(object))
+#define CHECK_LIST(object)						\
+    if (!LISTP(object))							\
+	LispDestroy("%s: %s is not a list",				\
+		    STRFUN(builtin), STROBJ(object))
+
+/* fixnum */
+#define FIXNUM(value)							\
+    ((LispObj*)(((long)(value) << BIT_COUNT) | FIXNUM_MASK))
+#define FIXNUM_VALUE(object)	((long)(object) >> BIT_COUNT)
+#define FIXNUMP(object)							\
+    (((unsigned long)(object) & BIT_MASK) == FIXNUM_MASK)
+#define CHECK_FIXNUM(object)						\
+    if (!FIXNUMP(object))						\
+	LispDestroy("%s: %s is not a fixnum",				\
+		    STRFUN(builtin), STROBJ(object))
+#define INDEXP(object)							\
+    (FIXNUMP(object) && FIXNUM_VALUE(object) >= 0)
+#define CHECK_INDEX(object)						\
+    if (!INDEXP(object))						\
+	LispDestroy("%s: %s is not a positive fixnum",			\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* long int integer */
+#define XINTP(object)		((object)->type == LispInteger_t)
+#define INTP(objet)		(POINTERP(object) && XINTP(object))
+#define INT_VALUE(object)	(object)->data.integer
+
+
+/* values that fit in a machine long int but not in a fixnum */
+#define LONGINTP(object)						\
+    (POINTERP(object) ? XINTP(object) : FIXNUMP(object))
+#define LONGINT_VALUE(object)						\
+    (POINTERP(object) ? INT_VALUE(object) : FIXNUM_VALUE(object))
+#define CHECK_LONGINT(object)						\
+    if (!LONGINTP(object))						\
+	LispDestroy("%s: %s is not an integer",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* bignum */
+#define XBIGNUMP(object)	((object)->type == LispBignum_t)
+#define BIGNUMP(object)		(POINTERP(object) && XBIGNUMP(object))
+#define BIGNUM(object)		LispNewBignum(object)
+
+
+/* generic integer */
+#define INTEGER(integer)	LispNewInteger(integer)
+#define INTEGERP(object)						\
+    (POINTERP(object) ? XINTP(object) || XBIGNUMP(object) : FIXNUMP(object))
+#define CHECK_INTEGER(object)						\
+    if (!INTEGERP(object))						\
+	LispDestroy("%s: %s is not an integer",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* ratio */
+#define XRATIOP(object)		((object)->type == LispRatio_t)
+#define RATIOP(object)		(POINTERP(object) && XRATIOP(object))
+#define RATIO(num, den)		LispNewRatio(num, den)
+
+
+/* bigratio */
+#define XBIGRATIOP(object)	((object)->type == LispBigratio_t)
+#define BIGRATIOP(object)	(POINTERP(object) && XBIGRATIOP(object))
+#define BIGRATIO(ratio)		LispNewBigratio(ratio)
+
+
+/* generic rational */
+#define RATIONALP(object)						\
+    (POINTERP(object) ? XINTP(object) || XRATIOP(object) ||		\
+			XBIGNUMP(object) || XBIGRATIOP(object) :	\
+			FIXNUMP(object))
+
+
+/* double float */
+#define XDFLOATP(object)	((object)->type == LispDFloat_t)
+#define DFLOATP(object)		(POINTERP(object) && XDFLOATP(object))
+#define DFLOAT_VALUE(object)	(object)->data.dfloat
+#define CHECK_DFLOAT(object)						\
+    if (!DFLOATP(object))						\
+	LispDestroy("%s: %s is not a float number",			\
+		    STRFUN(builtin), STROBJ(object))
+#define DFLOAT(value)		LispNewDFloat(value)
+
+
+/* generic float - currently only double float supported */
+#define FLOATP(object)		DFLOATP(object)
+
+
+/* real number */
+#define REALP(object)							\
+    (POINTERP(object) ? XINTP(object) || XDFLOATP(object) ||		\
+			XRATIOP(object) || XBIGNUMP(object) ||		\
+			XBIGRATIOP(object) :				\
+			FIXNUMP(object))
+#define CHECK_REAL(object)						\
+    if (!REALP(object))							\
+	LispDestroy("%s: %s is not a real number",			\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* complex */
+#define XCOMPLEXP(object)	((object)->type == LispComplex_t)
+#define COMPLEXP(object)	(POINTERP(object) && XCOMPLEXP(object))
+#define COMPLEX(real, imag)	LispNewComplex(real, imag)
+
+
+/* generic number */
+#define NUMBERP(object)							\
+    (POINTERP(object) ? XINTP(object) || XDFLOATP(object) ||		\
+			XRATIOP(object) || XBIGNUMP(object) ||		\
+			XBIGRATIOP(object) || XCOMPLEXP(object) :	\
+			FIXNUMP(object))
+#define CHECK_NUMBER(object)						\
+    if (!NUMBERP(object))						\
+	LispDestroy("%s: %s is not a number",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* symbol */
+#define XSYMBOLP(object)	((object)->type == LispAtom_t)
+#define SYMBOLP(object)		(POINTERP(object) && XSYMBOLP(object))
+#define CHECK_SYMBOL(object)						\
+    if (!SYMBOLP(object))						\
+	LispDestroy("%s: %s is not a symbol",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* keyword */
+#define XKEYWORDP(object)						\
+    ((object)->data.atom->package == lisp__data.keyword)
+#define KEYWORDP(object)						\
+    (POINTERP(object) && XSYMBOLP(object) && XKEYWORDP(object))
+#define KEYWORD(string)		LispNewKeyword(string)
+#define CHECK_KEYWORD(object)						\
+    if (!KEYWORDP(object))						\
+	LispDestroy("%s: %s is not a keyword",				\
+		    STRFUN(builtin), STROBJ(object))
+#define CHECK_CONSTANT(object)						\
+    if ((object)->data.atom->constant)					\
+	LispDestroy("%s: %s is a constant",				\
+		    STRFUN(builtin), STROBJ(object))
+
+#define SETVALUE(atom, object)	((atom)->property->value = object)
+
+
+/* function */
+#define XFUNCTIONP(object)	((object)->type == LispFunction_t)
+#define FUNCTIONP(object)	(POINTERP(object) && XFUNCTIONP(object))
+
+
+/* lambda */
+#define XLAMBDAP(object)	((object)->type == LispLambda_t)
+#define LAMBDAP(object)		(POINTERP(object) && XLAMBDAP(object))
+
+
+/* string - currently only simple 8 bit characters */
+#define XSTRINGP(object)	((object)->type == LispString_t)
+#define STRINGP(object)		(POINTERP(object) && XSTRINGP(object))
+#define THESTR(object)		(object)->data.string.string
+#define STRLEN(object)		(object)->data.string.length
+#define CHECK_STRING(object)						\
+    if (!STRINGP(object))						\
+	LispDestroy("%s: %s is not a string",				\
+		    STRFUN(builtin), STROBJ(object))
+#define CHECK_STRING_WRITABLE(object)					\
+    if (!object->data.string.writable)					\
+	LispDestroy("%s: %s is readonly",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* array/vector */
+#define XARRAYP(object)		((object)->type == LispArray_t)
+#define ARRAYP(object)		(POINTERP(object) && XARRAYP(object))
+#define CHECK_ARRAY(object)						\
+    if (!ARRAYP(object))						\
+	LispDestroy("%s: %s is not an array",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* quote */
+#define XQUOTEP(object)		((object)->type == LispQuote_t)
+#define QUOTEP(object)		(POINTERP(object) && XQUOTEP(object))
+#define QUOTE(object)		LispNewQuote(object)
+
+#define XBACKQUOTEP(object)	((object)->type == LispBackquote_t)
+#define BACKQUOTEP(object)	(POINTERP(object) && XBACKQUOTEP(object))
+#define BACKQUOTE(object)	LispNewBackquote(object)
+
+#define XCOMMAP(object)		((object)->type == LispComma_t)
+#define COMMAP(object)		(POINTERP(object) && XCOMMAP(object))
+#define COMMA(object, at)	LispNewComma(object, at)
+
+
+/* package */
+#define XPACKAGEP(object)	((object)->type == LispPackage_t)
+#define PACKAGEP(object)	(POINTERP(object) && XPACKAGEP(object))
+
+
+/* pathname */
+#define XPATHNAMEP(object)	((object)->type == LispPathname_t)
+#define PATHNAMEP(object)	(POINTERP(object) && XPATHNAMEP(object))
+#define PATHNAME(object)	LispNewPathname(object)
+#define CHECK_PATHNAME(object)						\
+    if (!PATHNAMEP(object))						\
+	LispDestroy("%s: %s is not a pathname",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* stream */
+#define XSTREAMP(object)	((object)->type == LispStream_t)
+#define STREAMP(object)		(POINTERP(object) && XSTREAMP(object))
+#define CHECK_STREAM(object)						\
+    if (!STREAMP(object))						\
+	LispDestroy("%s: %s is not a stream",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* hastable */
+#define XHASHTABLEP(object)	((object)->type == LispHashTable_t)
+#define HASHTABLEP(object)	(POINTERP(object) && XHASHTABLEP(object))
+#define CHECK_HASHTABLE(object)						\
+    if (!HASHTABLEP(object))						\
+	LispDestroy("%s: %s is not a hash-table",			\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* regex */
+#define XREGEXP(object)		((object)->type == LispRegex_t)
+#define REGEXP(object)		(POINTERP(object) && XREGEXP(object))
+#define CHECK_REGEX(object)						\
+    if (!REGEXP(object))						\
+	LispDestroy("%s: %s is not a regexp",				\
+		    STRFUN(builtin), STROBJ(object))
+
+
+/* bytecode */
+#define XBYTECODEP(object)	((object)->type == LispBytecode_t)
+#define BYTECODEP(object)	(POINTERP(object) && XBYTECODEP(object))
+
+
+/* opaque */
+#define XOPAQUEP(object)	((object)->type == LispOpaque_t)
+#define OPAQUEP(object)		(POINTERP(object) && XOPAQUEP(object))
+#define OPAQUE(data, type)	LispNewOpaque((void*)((long)data), type)
+
+
+
+#define SSTREAMP(str)		((str)->data.stream.source.string)
+
+#define FSTREAMP(str)		((str)->data.stream.source.file)
+
+#define PSTREAMP(str)		((str)->data.stream.source.program)
+#define PIDPSTREAMP(str)	((str)->data.stream.source.program->pid)
+#define IPSTREAMP(str)		((str)->data.stream.source.program->input)
+#define OPSTREAMP(str)		((str)->data.stream.source.program->output)
+#define EPSTREAMP(str)		\
+	FSTREAMP((str)->data.stream.source.program->errorp)
+
+#define LispFileno(file)	((file)->descriptor)
+
+#define STRFUN(builtin)		ATOMID(builtin->symbol)
+#define STROBJ(obj)		LispStrObj(obj)
+
+/* fetch builtin function/macro argument value
+ */
+#define ARGUMENT(index)							\
+	lisp__data.stack.values[lisp__data.stack.base + (index)]
+
+#define RETURN(index)	lisp__data.returns.values[(index)]
+#define RETURN_COUNT	lisp__data.returns.count
+#define RETURN_CHECK(value)						\
+    value < MULTIPLE_VALUES_LIMIT ?					\
+	value : MULTIPLE_VALUES_LIMIT
+
+#define GC_ENTER()		int gc__protect = lisp__data.protect.length
+
+#define GC_PROTECT(object)						\
+    if (lisp__data.protect.length >= lisp__data.protect.space)		\
+	LispMoreProtects();						\
+    lisp__data.protect.objects[lisp__data.protect.length++] = object
+
+#define GC_LEAVE()		lisp__data.protect.length = gc__protect
+
+
+#define ERROR_CHECK_SPECIAL_FORM(atom)					\
+    if (atom->property->fun.builtin->compile)				\
+	LispDestroy("%s: the special form %s cannot be redefined",	\
+		    STRFUN(builtin), atom->string)
+
+
+
+#define CONSTANTP(object)						\
+    (!POINTERP(object) ||						\
+     XOBJECT_TYPE(object) < LispAtom_t ||				\
+     (XSYMBOLP(object) && XKEYWORDP(object)))
+
+/* slightly faster test, since keywords are very uncommon as eval arguments */
+#define NCONSTANTP(object)						\
+    (OBJECT_TYPE(object) >= LispAtom_t)
+
+
+/*
+ * Types
+ */
+typedef struct _LispObj LispObj;
+typedef struct _LispAtom LispAtom;
+typedef struct _LispBuiltin LispBuiltin;
+typedef struct _LispModuleData LispModuleData;
+typedef struct _LispFile LispFile;
+typedef struct _LispString LispString;
+typedef struct _LispPackage LispPackage;
+typedef struct _LispBytecode LispBytecode;
+typedef struct _LispHashTable LispHashTable;
+
+/* Bytecode compiler data */
+typedef struct _LispCom LispCom;
+
+typedef char *Atom_id;
+
+typedef enum _LispType {
+    /* objects encoded in the LispObj pointer */
+    LispNil_t = 1,
+    LispFixnum_t = 3,
+    LispSChar_t = 5,
+
+    /* objects that have a structure */
+    LispInteger_t = 16,
+    LispDFloat_t,
+    LispString_t,
+    LispRatio_t,
+    LispOpaque_t,
+
+    /* simple access for marking */
+    LispBignum_t,
+    LispBigratio_t,
+
+    LispAtom_t,
+    LispFunction_t,
+    LispFunctionQuote_t,
+
+    LispLambda_t,
+
+    LispComplex_t,
+    LispCons_t,
+    LispQuote_t,
+    LispArray_t,
+    LispStruct_t,
+    LispStream_t,
+    LispBackquote_t,
+    LispComma_t,
+    LispPathname_t,
+    LispPackage_t,
+    LispRegex_t,
+    LispBytecode_t,
+    LispHashTable_t
+} LispType;
+
+typedef enum _LispFunType {
+    LispLambda,
+    LispFunction,
+    LispMacro,
+    LispSetf
+} LispFunType;
+
+typedef enum _LispStreamType {
+    LispStreamString,
+    LispStreamFile,
+    LispStreamStandard,
+    LispStreamPipe
+} LispStreamType;
+
+typedef struct {
+    int pid;			/* process id of program */
+    LispFile *input;		/* if READABLE: stdout of program */
+    LispFile *output;		/* if WRITABLE: stdin of program */
+    LispObj *errorp;		/* ALWAYS (ONLY) READABLE: stderr of program */
+} LispPipe;
+
+struct _LispObj {
+    LispType type : 6;
+    unsigned int mark : 1;	/* gc protected */
+    unsigned int prot: 1;	/* protection for constant/unamed variables */
+    LispFunType funtype : 4;	/* this is subject to change in the future */
+    union {
+	LispAtom *atom;
+	struct {
+	    char *string;
+	    long length;
+	    int writable : 1;
+	} string;
+	long integer;
+	double dfloat;
+	LispObj *quote;
+	LispObj *pathname;	/* don't use quote generic name,
+				 * to avoid confusing code */
+	struct {
+	    long numerator;
+	    long denominator;
+	} ratio;
+	union {
+	    mpi *integer;
+	    mpr *ratio;
+	} mp;
+	struct {
+	    LispObj *real;
+	    LispObj *imag;
+	} complex;
+	struct {
+	    LispObj *car;
+	    LispObj *cdr;
+	} cons;
+	struct {
+	    LispObj *name;
+	    LispObj *code;
+	    LispObj *data;		/* extra data to protect */
+	} lambda;
+	struct {
+	    LispObj *list;		/* stored as a linear list */
+	    LispObj *dim;		/* dimensions of array */
+	    unsigned int rank : 8;	/* i.e. array-rank-limit => 256 */
+	    unsigned int type : 7;	/* converted to LispType, if not
+					 * Lisp_Nil_t only accepts given
+					 * type in array fields */
+	    unsigned int zero : 1;	/* at least one of the dimensions
+					 * is zero */
+	} array;
+	struct {
+	    LispObj *fields;	/* structure fields */
+	    LispObj *def;	/* structure definition */
+	} struc;
+	struct {
+	    union {
+		LispFile *file;
+		LispPipe *program;
+		LispString *string;
+	    } source;
+	    LispObj *pathname;
+	    LispStreamType type : 6;
+	    int readable : 1;
+	    int writable : 1;
+	} stream;
+	struct {
+	    void *data;
+	    int type;
+	} opaque;
+	struct {
+	    LispObj *eval;
+	    int atlist;
+	} comma;
+	struct {
+	    LispObj *name;
+	    LispObj *nicknames;
+	    LispPackage *package;
+	} package;
+	struct {
+	    re_cod *regex;
+	    LispObj *pattern;		/* regex string */
+	    int options;		/* regex compile flags */
+	} regex;
+	struct {
+	    LispBytecode *bytecode;
+	    LispObj *code;		/* object used to generate bytecode */
+	    LispObj *name;		/* name of function, or NIL */
+	} bytecode;
+	struct {
+	    LispHashTable *table;
+	    LispObj *test;
+	} hash;
+    } data;
+};
+
+typedef	LispObj *(*LispFunPtr)(LispBuiltin*);
+typedef void (*LispComPtr)(LispCom*, LispBuiltin*);
+
+struct _LispBuiltin {
+    /* these fields must be set */
+    LispFunType type;
+    LispFunPtr function;
+    char *declaration;
+
+    /* this field is optional, set if the function returns multiple values */
+    int multiple_values;
+
+    /* this field is also optional, set if the function should not be exported */
+    int internal;
+
+    /* this optional field points to a function of the bytecode compiler */
+    LispComPtr compile;
+
+    /* this field is set at runtime */
+    LispObj *symbol;
+};
+
+typedef int (*LispLoadModule)(void);
+typedef int (*LispUnloadModule)(void);
+
+#define LISP_MODULE_VERSION		1
+struct _LispModuleData {
+    int version;
+    LispLoadModule load;
+    LispUnloadModule unload;
+};
+
+/*
+ * Prototypes
+ */
+LispObj *LispEval(LispObj*);
+LispObj *LispFuncall(LispObj*, LispObj*, int);
+LispObj *LispApply1(LispObj*, LispObj*);
+LispObj *LispApply2(LispObj*, LispObj*, LispObj*);
+LispObj *LispApply3(LispObj*, LispObj*, LispObj*, LispObj*);
+
+LispObj *LispNew(LispObj*, LispObj*);
+LispObj *LispNewSymbol(LispAtom*);
+LispObj *LispNewAtom(char*, int);
+LispObj *LispNewFunction(LispObj*);
+LispObj *LispNewFunctionQuote(LispObj*);
+LispObj *LispNewStaticAtom(char*);
+LispObj *LispNewDFloat(double);
+LispObj *LispNewString(char*, long, int);
+LispObj *LispNewInteger(long);
+LispObj *LispNewRatio(long, long);
+LispObj *LispNewVector(LispObj*);
+LispObj *LispNewQuote(LispObj*);
+LispObj *LispNewBackquote(LispObj*);
+LispObj *LispNewComma(LispObj*, int);
+LispObj *LispNewCons(LispObj*, LispObj*);
+LispObj *LispNewLambda(LispObj*, LispObj*, LispObj*, LispFunType);
+LispObj *LispNewStruct(LispObj*, LispObj*);
+LispObj *LispNewComplex(LispObj*, LispObj*);
+LispObj *LispNewOpaque(void*, int);
+LispObj *LispNewKeyword(char*);
+LispObj *LispNewPathname(LispObj*);
+LispObj *LispNewStringStream(char*, int, long, int);
+LispObj *LispNewFileStream(LispFile*, LispObj*, int);
+LispObj *LispNewPipeStream(LispPipe*, LispObj*, int);
+LispObj *LispNewBignum(mpi*);
+LispObj *LispNewBigratio(mpr*);
+
+LispAtom *LispGetAtom(char*);
+
+/* This function does not allocate a copy of it's argument, but the argument
+ * itself. The argument string should never change. */
+LispAtom *LispGetPermAtom(char*);
+
+void *LispMalloc(size_t);
+void *LispCalloc(size_t, size_t);
+void *LispRealloc(void*, size_t);
+char *LispStrdup(char*);
+void LispFree(void*);
+/* LispMused means memory is now safe from LispDestroy, and should not be
+ * freed in case of an error */
+void LispMused(void*);
+
+void LispGC(LispObj*, LispObj*);
+
+char *LispStrObj(LispObj*);
+
+#ifdef __GNUC__
+#define PRINTF_FORMAT	__attribute__ ((format (printf, 1, 2)))
+#else
+#define PRINTF_FORMAT	/**/
+#endif
+void LispDestroy(char *fmt, ...) PRINTF_FORMAT;
+	/* continuable error */
+void LispContinuable(char *fmt, ...) PRINTF_FORMAT;
+void LispMessage(char *fmt, ...) PRINTF_FORMAT;
+void LispWarning(char *fmt, ...) PRINTF_FORMAT;
+#undef PRINTF_FORMAT
+
+LispObj *LispSetVariable(LispObj*, LispObj*, char*, int);
+
+int LispRegisterOpaqueType(char*);
+
+int LispPrintString(LispObj*, char*);
+
+void LispProtect(LispObj*, LispObj*);
+void LispUProtect(LispObj*, LispObj*);
+
+/* this function should be called when a module is loaded, and is called
+ * when loading the interpreter */
+void LispAddBuiltinFunction(LispBuiltin*);
+
+/*
+ * Initialization
+ */
+extern LispObj *UNBOUND;
+extern int gcpro;
+
+extern LispObj *Okey, *Orest, *Ooptional, *Oaux, *Olambda;
+extern Atom_id Snil, St, Skey, Srest, Soptional, Saux;
+extern Atom_id Sand, Sor, Snot;
+extern Atom_id Satom, Ssymbol, Sinteger, Scharacter, Sstring, Slist,
+	       Scons, Svector, Sarray, Sstruct, Skeyword, Sfunction, Spathname,
+	       Srational, Sfloat, Scomplex, Sopaque, Sdefault;
+
+extern LispObj *Ocomplex, *Oformat, *Kunspecific;
+
+extern LispObj *Omake_array, *Kinitial_contents, *Osetf;
+extern Atom_id Svariable, Sstructure, Stype, Ssetf;
+
+extern Atom_id Smake_struct, Sstruct_access, Sstruct_store, Sstruct_type;
+extern LispObj *Omake_struct, *Ostruct_access, *Ostruct_store, *Ostruct_type;
+
+extern LispObj *Oparse_namestring, *Kerror, *Kabsolute, *Krelative, *Oopen,
+	       *Oclose, *Kif_does_not_exist;
+
+extern LispObj *Oequal_;
+
+extern LispFile *Stdout, *Stdin, *Stderr;
+
+#endif /* Lisp_internal_h */
diff --git a/lisp/io.c b/lisp/io.c
new file mode 100644
index 0000000..ea59575
--- /dev/null
+++ b/lisp/io.c
@@ -0,0 +1,709 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/io.c,v 1.16 2002/12/16 03:59:27 paulo Exp $ */
+
+#include "io.h"
+#include <errno.h>
+#include <fcntl.h>
+#include <stdarg.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+
+/* Match the FILE_XXX flags */
+#define READ_BIT	0x01
+#define WRITE_BIT	0x02
+#define APPEND_BIT	0x04
+#define BUFFERED_BIT	0x08
+#define UNBUFFERED_BIT	0x10
+#define BINARY_BIT	0x20
+
+/*
+ * Prototypes
+ */
+static int calculate_line(void*, int);
+static int calculate_column(void*, int, int);
+
+/*
+ * Initialization
+ */
+extern int pagesize;
+
+/*
+ * Implementation
+ */
+int
+LispGet(void)
+{
+    int ch = EOF;
+    LispUngetInfo *unget = lisp__data.unget[lisp__data.iunget];
+
+    if (unget->offset)
+	ch = ((unsigned char*)unget->buffer)[--unget->offset];
+    else if (SINPUT->data.stream.readable) {
+	LispFile *file = NULL;
+
+	switch (SINPUT->data.stream.type) {
+	    case LispStreamStandard:
+	    case LispStreamFile:
+		file = FSTREAMP(SINPUT);
+		break;
+	    case LispStreamPipe:
+		file = IPSTREAMP(SINPUT);
+		break;
+	    case LispStreamString:
+		ch = LispSgetc(SSTREAMP(SINPUT));
+		break;
+	    default:
+		ch = EOF;
+		break;
+	}
+	if (file != NULL) {
+	    if (file->nonblock) {
+		if (fcntl(file->descriptor, F_SETFL, 0) < 0)
+		    LispDestroy("fcntl: %s", strerror(errno));
+		file->nonblock = 0;
+	    }
+	    ch = LispFgetc(file);
+	}
+    }
+    else
+	LispDestroy("cannot read from *STANDARD-INPUT*");
+
+    if (ch == EOF)
+	lisp__data.eof = 1;
+
+    return (ch);
+}
+
+int
+LispUnget(int ch)
+{
+    LispUngetInfo *unget = lisp__data.unget[lisp__data.iunget];
+
+    if (unget->offset == sizeof(unget->buffer)) {
+	LispWarning("character %c lost at LispUnget()", unget->buffer[0]);
+	memmove(unget->buffer, unget->buffer + 1, unget->offset - 1);
+	unget->buffer[unget->offset - 1] = ch;
+    }
+    else
+	unget->buffer[unget->offset++] = ch;
+
+    return (ch);
+}
+
+void
+LispPushInput(LispObj *stream)
+{
+    if (!STREAMP(stream) || !stream->data.stream.readable)
+	LispDestroy("bad stream at PUSH-INPUT");
+    lisp__data.input_list = CONS(stream, lisp__data.input_list);
+    SINPUT = stream;
+    if (lisp__data.iunget + 1 == lisp__data.nunget) {
+	LispUngetInfo **info =
+	    realloc(lisp__data.unget,
+		    sizeof(LispUngetInfo) * (lisp__data.nunget + 1));
+
+	if (!info ||
+	    (info[lisp__data.nunget] =
+	     calloc(1, sizeof(LispUngetInfo))) == NULL)
+	    LispDestroy("out of memory");
+	lisp__data.unget = info;
+	++lisp__data.nunget;
+    }
+    ++lisp__data.iunget;
+    memset(lisp__data.unget[lisp__data.iunget], '\0', sizeof(LispUngetInfo));
+    lisp__data.eof = 0;
+}
+
+void
+LispPopInput(LispObj *stream)
+{
+    if (!CONSP(lisp__data.input_list) || stream != CAR(lisp__data.input_list))
+	LispDestroy("bad stream at POP-INPUT");
+    lisp__data.input_list = CDR(lisp__data.input_list);
+    SINPUT = CONSP(lisp__data.input_list) ?
+    CAR(lisp__data.input_list) : lisp__data.input_list;
+    --lisp__data.iunget;
+    lisp__data.eof = 0;
+}
+
+/*
+ * Low level functions
+ */
+static int
+calculate_line(void *data, int size)
+{
+    int line = 0;
+    char *str, *ptr;
+
+    for (str = (char*)data, ptr = (char*)data + size; str < ptr; str++)
+	if (*ptr == '\n')
+	    ++line;
+
+    return (line);
+}
+
+static int
+calculate_column(void *data, int size, int column)
+{
+    char *str, *ptr;
+
+    /* search for newline in data */
+    for (str = (char*)data, ptr = (char*)data + size - 1; ptr >= str; ptr--)
+	if (*ptr == '\n')
+	    break;
+
+    /* newline found */
+    if (ptr >= str)
+	return (size - (ptr - str) - 1);
+
+    /* newline not found */
+    return (column + size);
+}
+
+LispFile *
+LispFdopen(int descriptor, int mode)
+{
+    LispFile *file = calloc(1, sizeof(LispFile));
+
+    if (file) {
+	struct stat st;
+
+	file->descriptor = descriptor;
+	file->readable = (mode & READ_BIT) != 0;
+	file->writable = (mode & WRITE_BIT) != 0;
+
+	if (fstat(descriptor, &st) == 0)
+	    file->regular = S_ISREG(st.st_mode);
+	else
+	    file->regular = 0;
+
+	file->buffered = (mode & BUFFERED_BIT) != 0;
+	if ((mode & UNBUFFERED_BIT) == 0)
+	    file->buffered = file->regular;
+
+	if (file->buffered) {
+	    file->buffer = malloc(pagesize);
+	    if (file->buffer == NULL)
+		file->buffered = 0;
+	}
+	file->line = 1;
+	file->binary = (mode & BINARY_BIT) != 0;
+	file->io_write = write;
+    }
+
+    return (file);
+}
+
+LispFile *
+LispFopen(char *path, int mode)
+{
+    LispFile *file;
+    int descriptor;
+    int flags = O_NOCTTY;
+
+    /* check read/write attributes */
+    if ((mode & (READ_BIT | WRITE_BIT)) == (READ_BIT | WRITE_BIT))
+	flags |= O_RDWR;
+    else if (mode & READ_BIT)
+	flags |= O_RDONLY;
+    else if (mode & WRITE_BIT)
+	flags |= O_WRONLY;
+
+    /* create if does not exist */
+    if (mode & WRITE_BIT) {
+	flags |= O_CREAT;
+
+	/* append if exists? */
+	if (mode & APPEND_BIT)
+	    flags |= O_APPEND;
+	else
+	    flags |= O_TRUNC;
+    }
+
+    /* open file */
+    descriptor = open(path, flags, 0666);
+    if (descriptor < 0)
+	return (NULL);
+
+    /* initialize LispFile structure */
+    file = LispFdopen(descriptor, mode);
+    if (file == NULL)
+	close(descriptor);
+
+    return (file);
+}
+
+void
+LispFclose(LispFile *file)
+{
+    /* flush any pending output */
+    LispFflush(file);
+    /* cleanup */
+    close(file->descriptor);
+    if (file->buffer)
+	free(file->buffer);
+    free(file);
+}
+
+io_write_fn
+LispSetFileWrite(LispFile *file, io_write_fn new_write)
+{
+    io_write_fn old_write = file->io_write;
+
+    file->io_write = new_write;
+
+    return (old_write);
+}
+
+int
+LispFflush(LispFile *file)
+{
+    if (file->writable && file->length) {
+	int length = (*file->io_write)(file->descriptor,
+				       file->buffer, file->length);
+
+	if (length > 0) {
+	    if (file->length > length)
+		memmove(file->buffer, file->buffer + length,
+			file->length - length);
+	    file->length -= length;
+	}
+	return (length);
+    }
+
+    return (0);
+}
+
+int
+LispFungetc(LispFile *file, int ch)
+{
+    if (file->readable) {
+	file->available = 1;
+	file->unget = ch;
+	/* this should never happen */
+	if (ch == '\n' && !file->binary)
+	    --file->line;
+    }
+
+    return (ch);
+}
+
+int
+LispFgetc(LispFile *file)
+{
+    int ch;
+
+    if (file->readable) {
+	unsigned char c;
+
+	if (file->available) {
+	    ch = file->unget;
+	    file->available = 0;
+	}
+	else if (file->buffered) {
+	    if (file->writable) {
+		LispFflush(file);
+		if (read(file->descriptor, &c, 1) == 1)
+		    ch = c;
+		else
+		    ch = EOF;
+	    }
+	    else {
+		if (file->offset < file->length)
+		    ch = ((unsigned char*)file->buffer)[file->offset++];
+		else {
+		    int length = read(file->descriptor,
+				      file->buffer, pagesize);
+
+		    if (length >= 0)
+			file->length = length;
+		    else
+			file->length = 0;
+		    file->offset = 0;
+		    if (file->length)
+			ch = ((unsigned char*)file->buffer)[file->offset++];
+		    else
+			ch = EOF;
+		}
+	    }
+	}
+	else if (read(file->descriptor, &c, 1) == 1)
+	    ch = c;
+	else
+	    ch = EOF;
+    }
+    else
+	ch = EOF;
+
+    if (ch == '\n' && !file->binary)
+	++file->line;
+
+    return (ch);
+}
+
+int
+LispFputc(LispFile *file, int ch)
+{
+    if (file->writable) {
+	unsigned char c = ch;
+
+	if (file->buffered) {
+	    if (file->length + 1 >= pagesize)
+		LispFflush(file);
+	    file->buffer[file->length++] = c;
+	}
+	else if ((*file->io_write)(file->descriptor, &c, 1) != 1)
+	    ch = EOF;
+
+	if (!file->binary) {
+	    /* update column number */
+	    if (ch == '\n')
+		file->column = 0;
+	    else
+		++file->column;
+	}
+    }
+
+    return (ch);
+}
+
+int
+LispSgetc(LispString *string)
+{
+    int ch;
+
+    if (string->input >= string->length)
+	return (EOF);			/* EOF reading from string */
+
+    ch = ((unsigned char*)string->string)[string->input++];
+    if (ch == '\n' && !string->binary)
+	++string->line;
+
+    return (ch);
+}
+
+int
+LispSputc(LispString *string, int ch)
+{
+    if (string->output + 1 >= string->space) {
+	if (string->fixed)
+	    return (EOF);
+	else {
+	    char *tmp = realloc(string->string, string->space + pagesize);
+
+	    if (tmp == NULL)
+		return (EOF);
+	    string->string = tmp;
+	    string->space += pagesize;
+	}
+    }
+
+    string->string[string->output++] = ch;
+    if (string->length < string->output)
+	string->length = string->output;
+
+    /* update column number */
+    if (!string->binary) {
+	if (ch == '\n')
+	    string->column = 0;
+	else
+	    ++string->column;
+    }
+
+    return (ch);
+}
+
+char *
+LispFgets(LispFile *file, char *string, int size)
+{
+    int ch, offset = 0;
+
+    if (size < 1)
+	return (string);
+
+    for (;;) {
+	if (offset + 1 >= size)
+	    break;
+	if ((ch = LispFgetc(file)) == EOF)
+	    break;
+	string[offset++] = ch;
+	/* line number is calculated in LispFgetc */
+	if (ch == '\n')
+	    break;
+    }
+    string[offset] = '\0';
+
+    return (offset ? string : NULL);
+}
+
+int
+LispFputs(LispFile *file, char *buffer)
+{
+    return (LispFwrite(file, buffer, strlen(buffer)));
+}
+
+int
+LispSputs(LispString *string, char *buffer)
+{
+    return (LispSwrite(string, buffer, strlen(buffer)));
+}
+
+int
+LispFread(LispFile *file, void *data, int size)
+{
+    int bytes, length;
+    char *buffer;
+
+    if (!file->readable)
+	return (EOF);
+
+    if (size <= 0)
+	return (size);
+
+    length = 0;
+    buffer = (char*)data;
+
+    /* check if there is an unget character */
+    if (file->available) {
+	*buffer++ = file->unget;
+	file->available = 0;
+	if (--size == 0) {
+	    if (file->unget == '\n' && !file->binary)
+		++file->line;
+
+	    return (1);
+	}
+
+	length = 1;
+    }
+
+    if (file->buffered) {
+	void *base_data = (char*)data - length;
+
+	if (file->writable) {
+	    LispFflush(file);
+	    bytes = read(file->descriptor, buffer, size);
+	    if (bytes < 0)
+		bytes = 0;
+	    if (!file->binary)
+		file->line += calculate_line(base_data, length + bytes);
+
+	    return (length + bytes);
+	}
+
+	/* read anything that is in the buffer */
+	if (file->offset < file->length) {
+	    bytes = file->length - file->offset;
+	    if (bytes > size)
+		bytes = size;
+	    memcpy(buffer, file->buffer + file->offset, bytes);
+	    buffer += bytes;
+	    file->offset += bytes;
+	    size -= bytes;
+	}
+
+	/* if there is still something to read */
+	if (size) {
+	    bytes = read(file->descriptor, buffer, size);
+	    if (bytes < 0)
+		bytes = 0;
+
+	    length += bytes;
+	}
+
+	if (!file->binary)
+	    file->line += calculate_line(base_data, length);
+
+	return (length);
+    }
+
+    bytes = read(file->descriptor, buffer, size);
+    if (bytes < 0)
+	bytes = 0;
+    if (!file->binary)
+	file->line += calculate_line(buffer - length, length + bytes);
+
+    return (length + bytes);
+}
+
+int
+LispFwrite(LispFile *file, void *data, int size)
+{
+    if (!file->writable || size < 0)
+	return (EOF);
+
+    if (!file->binary)
+	file->column = calculate_column(data, size, file->column);
+
+    if (file->buffered) {
+	int length, bytes;
+	char *buffer = (char*)data;
+
+	length = 0;
+	if (size + file->length > pagesize) {
+	    /* fill remaining space in buffer and flush */
+	    bytes = pagesize - file->length;
+	    memcpy(file->buffer + file->length, buffer, bytes);
+	    file->length += bytes;
+	    LispFflush(file);
+
+	    /* check if all data was written */
+	    if (file->length)
+		return (pagesize - file->length);
+
+	    length = bytes;
+	    buffer += bytes;
+	    size -= bytes;
+	}
+
+	while (size > pagesize) {
+	    /* write multiple of pagesize */
+	    bytes = (*file->io_write)(file->descriptor, buffer,
+				      size - (size % pagesize));
+	    if (bytes <= 0)
+		return (length);
+
+	    length += bytes;
+	    buffer += bytes;
+	    size -= bytes;
+	}
+
+	if (size) {
+	    /* keep remaining data in buffer */
+	    switch (size) {
+		case 8:
+		    file->buffer[file->length++] = *buffer++;
+		case 7:
+		    file->buffer[file->length++] = *buffer++;
+		case 6:
+		    file->buffer[file->length++] = *buffer++;
+		case 5:
+		    file->buffer[file->length++] = *buffer++;
+		case 4:
+		    file->buffer[file->length++] = *buffer++;
+		case 3:
+		    file->buffer[file->length++] = *buffer++;
+		case 2:
+		    file->buffer[file->length++] = *buffer++;
+		case 1:
+		    file->buffer[file->length++] = *buffer++;
+		    break;
+		default:
+		    memcpy(file->buffer + file->length, buffer, size);
+		    file->length += size;
+		    break;
+	    }
+	    length += size;
+	}
+
+	return (length);
+    }
+
+    return ((*file->io_write)(file->descriptor, data, size));
+}
+
+int
+LispSwrite(LispString *string, void *data, int size)
+{
+    if (size < 0)
+	return (EOF);
+
+    if (string->output + size >= string->space) {
+	if (string->fixed) {
+	    /* leave space for a ending nul character */
+	    size = string->space - string->output - 1;
+
+	    if (size <= 0)
+		return (-1);
+	}
+	else {
+	    char *tmp = realloc(string->string, string->space +
+				(size / pagesize) * pagesize + pagesize);
+
+	    if (tmp == NULL)
+		return (-1);
+
+	    string->string = tmp;
+	    string->space += pagesize;
+	}
+    }
+    memcpy(string->string + string->output, data, size);
+    string->output += size;
+    if (string->length < string->output)
+	string->length = string->output;
+
+    if (!string->binary)
+	string->column = calculate_column(data, size, string->column);
+
+    return (size);
+}
+
+char *
+LispGetSstring(LispString *string, int *length)
+{
+    if (string->string == NULL || string->length <= 0) {
+	*length = 0;
+
+	return ("");
+    }
+    *length = string->length;
+    if (string->string[string->length -1] != '\0') {
+	if (string->length < string->space)
+	    string->string[string->length] = '\0';
+	else if (string->fixed && string->space)
+	    string->string[string->space - 1] = '\0';
+	else {
+	    char *tmp = realloc(string->string, string->space + pagesize);
+
+	    if (tmp == NULL)
+		string->string[string->space - 1] = '\0';
+	    else {
+		string->string = tmp;
+		string->space += pagesize;
+		string->string[string->length] = '\0';
+	    }
+	}
+    }
+
+    return (string->string);
+}
+
+int
+LispRename(char *from, char *to)
+{
+    return (rename(from, to));
+}
+
+int
+LispUnlink(char *name)
+{
+    return (unlink(name));
+}
diff --git a/lisp/io.h b/lisp/io.h
new file mode 100644
index 0000000..eb5edc6
--- /dev/null
+++ b/lisp/io.h
@@ -0,0 +1,115 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/io.h,v 1.8 2002/12/06 03:25:27 paulo Exp $ */
+
+#ifndef Lisp_io_h
+#define Lisp_io_h
+
+#include "private.h"
+
+#define	FILE_READ	0x01
+#define FILE_WRITE	0x02
+#define FILE_IO		0x03
+#define FILE_APPEND	0x06	/* append mode, write bit also set */
+#define FILE_BUFFERED	0x08	/* force buffered mode */
+#define FILE_UNBUFFERED	0x10	/* force unbuffered mode */
+#define FILE_BINARY	0x20
+
+/*
+ * Types
+ */
+typedef ssize_t (*io_write_fn)(int, const void*, size_t);
+
+struct _LispFile {
+    char *buffer;
+    int line;			/* input line number */
+    int column;			/* output column number */
+    int descriptor;
+    int length;			/* number of bytes used */
+    int offset;			/* read/write offset */
+    int unget : 8;		/* unread char */
+    int readable : 1;
+    int writable : 1;
+    int regular : 1;		/* regular file */
+    int buffered : 1;
+    int available : 1;		/* unget field holds a char */
+    int nonblock : 1;		/* in nonblock mode */
+    int binary : 1;		/* if set, don't calculate column/line-number */
+    io_write_fn io_write;
+};
+
+struct _LispString {
+    char *string;
+    int line;			/* input line number */
+    int column;			/* output column number */
+    int space;			/* number of bytes alocated */
+    int length;			/* number of bytes used */
+    int input;			/* input offset, for read operations */
+    int output;			/* output offset, for write operations */
+    int fixed : 1;		/* if set, don't try to reallocate string */
+    int binary : 1;		/* if set, don't calculate column/line-number */
+};
+
+/*
+ * Prototypes
+ */
+	/* higher level functions */
+int LispGet(void);
+int LispUnget(int);
+void LispPushInput(LispObj*);
+void LispPopInput(LispObj*);
+
+	/* functions that read/write using the LispFile structure */
+LispFile *LispFdopen(int, int);
+LispFile *LispFopen(char*, int);
+void LispFclose(LispFile*);
+int LispFflush(LispFile*);
+int LispFungetc(LispFile*, int);
+int LispFgetc(LispFile*);
+int LispFputc(LispFile*, int);
+char *LispFgets(LispFile*, char*, int);
+int LispFputs(LispFile*, char*);
+int LispFread(LispFile*, void*, int);
+int LispFwrite(LispFile*, void*, int);
+int LispRename(char*, char*);
+int LispUnlink(char*);
+
+	/* io wrappers */
+io_write_fn LispSetFileWrite(LispFile*, io_write_fn);
+
+	/* functions that read/write using the LispString structure */
+int LispSgetc(LispString*);
+int LispSputc(LispString*, int);
+int LispSputs(LispString*, char*);
+int LispSwrite(LispString*, void*, int);
+
+char *LispGetSstring(LispString*, int*);
+
+#endif /* Lisp_io_h */
diff --git a/lisp/lisp.c b/lisp/lisp.c
new file mode 100644
index 0000000..cda8c14
--- /dev/null
+++ b/lisp/lisp.c
@@ -0,0 +1,5507 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/lisp.c,v 1.85 2003/01/29 03:05:53 paulo Exp $ */
+
+#include <stdlib.h>
+#include <string.h>
+#ifdef sun
+#include <strings.h>
+#endif
+#include <ctype.h>
+#include <errno.h>
+#include <fcntl.h>
+#include <stdarg.h>
+#include <signal.h>
+#include <sys/wait.h>
+
+#ifndef X_NOT_POSIX
+#include <unistd.h>	/* for sysconf(), and getpagesize() */
+#endif
+
+#if defined(linux)
+#include <asm/page.h>	/* for PAGE_SIZE */
+#define HAS_GETPAGESIZE
+#define HAS_SC_PAGESIZE	/* _SC_PAGESIZE may be an enum for Linux */
+#endif
+
+#if defined(CSRG_BASED)
+#define HAS_GETPAGESIZE
+#endif
+
+#if defined(sun)
+#define HAS_GETPAGESIZE
+#endif
+
+#if defined(QNX4)
+#define HAS_GETPAGESIZE
+#endif
+
+#if defined(__QNXNTO__)
+#define HAS_SC_PAGESIZE
+#endif
+
+#include "bytecode.h"
+
+#include "read.h"
+#include "format.h"
+#include "math.h"
+#include "hash.h"
+#include "package.h"
+#include "pathname.h"
+#include "regex.h"
+#include "require.h"
+#include "stream.h"
+#include "struct.h"
+#include "time.h"
+#include "write.h"
+#include <math.h>
+
+typedef struct {
+    LispObj **objects;
+    LispObj *freeobj;
+    int nsegs;
+    int nobjs;
+    int nfree;
+} LispObjSeg;
+
+/*
+ * Prototypes
+ */
+static void Lisp__GC(LispObj*, LispObj*);
+static LispObj *Lisp__New(LispObj*, LispObj*);
+
+/* run a user function, to be called only by LispEval */
+static LispObj *LispRunFunMac(LispObj*, LispObj*, int, int);
+
+/* expands and executes a setf method, to be called only by Lisp_Setf */
+LispObj *LispRunSetf(LispArgList*, LispObj*, LispObj*, LispObj*);
+LispObj *LispRunSetfMacro(LispAtom*, LispObj*, LispObj*);
+
+/* increases storage size for environment */
+void LispMoreEnvironment(void);
+
+/* increases storage size for stack of builtin arguments */
+void LispMoreStack(void);
+
+/* increases storage size for global variables */
+void LispMoreGlobals(LispPackage*);
+
+#ifdef __GNUC__
+static INLINE LispObj *LispDoGetVar(LispObj*);
+#endif
+static INLINE void LispDoAddVar(LispObj*, LispObj*);
+
+/* Helper for importing symbol(s) functions,
+ * Search for the specified object in the current package */
+static INLINE LispObj *LispGetVarPack(LispObj*);
+
+/* create environment for function call */
+static int LispMakeEnvironment(LispArgList*, LispObj*, LispObj*, int, int);
+
+	/* if not already in keyword package, move atom to keyword package */
+static LispObj *LispCheckKeyword(LispObj*);
+
+	/* builtin backquote parsing */
+static LispObj *LispEvalBackquoteObject(LispObj*, int, int);
+	/* used also by the bytecode compiler */
+LispObj *LispEvalBackquote(LispObj*, int);
+
+	/* create or change object property */
+void LispSetAtomObjectProperty(LispAtom*, LispObj*);
+	/* remove object property */
+static void LispRemAtomObjectProperty(LispAtom*);
+
+	/* allocates a new LispProperty for the given atom */
+static void LispAllocAtomProperty(LispAtom*);
+	/* Increment reference count of atom property */
+static void LispIncrementAtomReference(LispAtom*);
+	/* Decrement reference count of atom property */
+static void LispDecrementAtomReference(LispAtom*);
+	/* Removes all atom properties */
+static void LispRemAtomAllProperties(LispAtom*);
+
+static LispObj *LispAtomPropertyFunction(LispAtom*, LispObj*, int);
+
+static INLINE void LispCheckMemLevel(void);
+
+void LispAllocSeg(LispObjSeg*, int);
+static INLINE void LispMark(LispObj*);
+
+/* functions, macros, setf methods, and structure definitions */
+static INLINE void LispProt(LispObj*);
+
+static LispObj *LispCheckNeedProtect(LispObj*);
+
+static
+#ifdef SIGNALRETURNSINT
+int
+#else
+void
+#endif
+LispSignalHandler(int);
+
+/*
+ * Initialization
+ */
+LispMac lisp__data;
+
+static LispObj lispunbound = {LispNil_t};
+LispObj *UNBOUND = &lispunbound;
+
+static volatile int lisp__disable_int;
+static volatile int lisp__interrupted;
+
+LispObj *Okey, *Orest, *Ooptional, *Oaux, *Olambda;
+
+Atom_id Snil, St;
+Atom_id Saux, Skey, Soptional, Srest;
+Atom_id Satom, Ssymbol, Sinteger, Scharacter, Sstring, Slist,
+	Scons, Svector, Sarray, Sstruct, Skeyword, Sfunction, Spathname,
+	Srational, Sfloat, Scomplex, Sopaque, Sdefault;
+
+LispObj *Oformat, *Kunspecific;
+LispObj *Oexpand_setf_method;
+
+static LispProperty noproperty;
+LispProperty *NOPROPERTY = &noproperty;
+static int segsize, minfree;
+int pagesize, gcpro;
+
+static LispObjSeg objseg = {NULL, NIL};
+static LispObjSeg atomseg = {NULL, NIL};
+
+int LispArgList_t;
+
+LispFile *Stdout, *Stdin, *Stderr;
+
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_Mul, "* &rest numbers"},
+    {LispFunction, Lisp_Plus, "+ &rest numbers"},
+    {LispFunction, Lisp_Minus, "- number &rest more-numbers"},
+    {LispFunction, Lisp_Div, "/ number &rest more-numbers"},
+    {LispFunction, Lisp_OnePlus, "1+ number"},
+    {LispFunction, Lisp_OneMinus, "1- number"},
+    {LispFunction, Lisp_Less, "< number &rest more-numbers"},
+    {LispFunction, Lisp_LessEqual, "<= number &rest more-numbers"},
+    {LispFunction, Lisp_Equal_, "= number &rest more-numbers"},
+    {LispFunction, Lisp_Greater, "> number &rest more-numbers"},
+    {LispFunction, Lisp_GreaterEqual, ">= number &rest more-numbers"},
+    {LispFunction, Lisp_NotEqual, "/= number &rest more-numbers"},
+    {LispFunction, Lisp_Max, "max number &rest more-numbers"},
+    {LispFunction, Lisp_Min, "min number &rest more-numbers"},
+    {LispFunction, Lisp_Abs, "abs number"},
+    {LispFunction, Lisp_Acons, "acons key datum alist"},
+    {LispFunction, Lisp_Adjoin, "adjoin item list &key key test test-not"},
+    {LispFunction, Lisp_AlphaCharP, "alpha-char-p char"},
+    {LispMacro, Lisp_And, "and &rest args", 1, 0, Com_And},
+    {LispFunction, Lisp_Append, "append &rest lists"},
+    {LispFunction, Lisp_Apply, "apply function arg &rest more-args", 1},
+    {LispFunction, Lisp_Aref, "aref array &rest subscripts"},
+    {LispFunction, Lisp_Assoc, "assoc item list &key test test-not key"},
+    {LispFunction, Lisp_AssocIf, "assoc-if predicate list &key key"},
+    {LispFunction, Lisp_AssocIfNot, "assoc-if-not predicate list &key key"},
+    {LispFunction, Lisp_Atom, "atom object"},
+    {LispMacro, Lisp_Block, "block name &rest body", 1, 0, Com_Block},
+    {LispFunction, Lisp_BothCaseP, "both-case-p character"},
+    {LispFunction, Lisp_Boundp, "boundp symbol"},
+    {LispFunction, Lisp_Butlast, "butlast list &optional count"},
+    {LispFunction, Lisp_Nbutlast, "nbutlast list &optional count"},
+    {LispFunction, Lisp_Car, "car list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_Car, "first list", 0, 0, Com_C_r},
+    {LispMacro, Lisp_Case, "case keyform &rest body"},
+    {LispMacro, Lisp_Catch, "catch tag &rest body", 1},
+    {LispFunction, Lisp_Cdr, "cdr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_Cdr, "rest list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_Ceiling, "ceiling number &optional divisor", 1},
+    {LispFunction, Lisp_Fceiling, "fceiling number &optional divisor", 1},
+    {LispFunction, Lisp_Char, "char string index"},
+    {LispFunction, Lisp_Char, "schar simple-string index"},
+    {LispFunction, Lisp_CharLess, "char< character &rest more-characters"},
+    {LispFunction, Lisp_CharLessEqual, "char<= character &rest more-characters"},
+    {LispFunction, Lisp_CharEqual_, "char= character &rest more-characters"},
+    {LispFunction, Lisp_CharGreater, "char> character &rest more-characters"},
+    {LispFunction, Lisp_CharGreaterEqual, "char>= character &rest more-characters"},
+    {LispFunction, Lisp_CharNotEqual_, "char/= character &rest more-characters"},
+    {LispFunction, Lisp_CharLessp, "char-lessp character &rest more-characters"},
+    {LispFunction, Lisp_CharNotGreaterp, "char-not-greaterp character &rest more-characters"},
+    {LispFunction, Lisp_CharEqual, "char-equal character &rest more-characters"},
+    {LispFunction, Lisp_CharGreaterp, "char-greaterp character &rest more-characters"},
+    {LispFunction, Lisp_CharNotLessp, "char-not-lessp character &rest more-characters"},
+    {LispFunction, Lisp_CharNotEqual, "char-not-equal character &rest more-characters"},
+    {LispFunction, Lisp_CharDowncase, "char-downcase character"},
+    {LispFunction, Lisp_CharInt, "char-code character"},
+    {LispFunction, Lisp_CharInt, "char-int character"},
+    {LispFunction, Lisp_CharUpcase, "char-upcase character"},
+    {LispFunction, Lisp_Character, "character object"},
+    {LispFunction, Lisp_Characterp, "characterp object"},
+    {LispFunction, Lisp_Clrhash, "clrhash hash-table"},
+    {LispFunction, Lisp_IntChar, "code-char integer"},
+    {LispFunction, Lisp_Coerce, "coerce object result-type"},
+    {LispFunction, Lisp_Compile, "compile name &optional definition", 1},
+    {LispFunction, Lisp_Complex, "complex realpart &optional imagpart"},
+    {LispMacro, Lisp_Cond, "cond &rest body", 0, 0, Com_Cond},
+    {LispFunction, Lisp_Cons, "cons car cdr", 0, 0, Com_Cons},
+    {LispFunction, Lisp_Consp, "consp object", 0, 0, Com_Consp},
+    {LispFunction, Lisp_Constantp, "constantp form &optional environment"},
+    {LispFunction, Lisp_Conjugate, "conjugate number"},
+    {LispFunction, Lisp_Complexp, "complexp object"},
+    {LispFunction, Lisp_CopyAlist, "copy-alist list"},
+    {LispFunction, Lisp_CopyList, "copy-list list"},
+    {LispFunction, Lisp_CopyTree, "copy-tree list"},
+    {LispFunction, Lisp_Close, "close stream &key abort"},
+    {LispFunction, Lisp_C_r, "caar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cadr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cddr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "caaar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "caadr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cadar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "caddr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdaar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdadr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cddar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdddr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "caaaar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "caaadr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "caadar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "caaddr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cadaar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cadadr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "caddar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cadddr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdaaar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdaadr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdadar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdaddr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cddaar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cddadr list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cdddar list", 0, 0, Com_C_r},
+    {LispFunction, Lisp_C_r, "cddddr list", 0, 0, Com_C_r},
+    {LispMacro, Lisp_Decf, "decf place &optional delta"},
+    {LispMacro, Lisp_Defconstant, "defconstant name initial-value &optional documentation"},
+    {LispMacro, Lisp_Defmacro, "defmacro name lambda-list &rest body"},
+    {LispMacro, Lisp_Defstruct, "defstruct name &rest description"},
+    {LispMacro, Lisp_Defun, "defun name lambda-list &rest body"},
+    {LispMacro, Lisp_Defsetf, "defsetf function lambda-list &rest body"},
+    {LispMacro, Lisp_Defparameter, "defparameter name initial-value &optional documentation"},
+    {LispMacro, Lisp_Defvar, "defvar name &optional initial-value documentation"},
+    {LispFunction, Lisp_Delete, "delete item sequence &key from-end test test-not start end count key"},
+    {LispFunction, Lisp_DeleteDuplicates, "delete-duplicates sequence &key from-end test test-not start end key"},
+    {LispFunction, Lisp_DeleteIf, "delete-if predicate sequence &key from-end start end count key"},
+    {LispFunction, Lisp_DeleteIfNot, "delete-if-not predicate sequence &key from-end start end count key"},
+    {LispFunction, Lisp_DeleteFile, "delete-file filename"},
+    {LispFunction, Lisp_Denominator, "denominator rational"},
+    {LispFunction, Lisp_DigitChar, "digit-char weight &optional radix"},
+    {LispFunction, Lisp_DigitCharP, "digit-char-p character &optional radix"},
+    {LispFunction, Lisp_Directory, "directory pathname &key all if-cannot-read"},
+    {LispFunction, Lisp_DirectoryNamestring, "directory-namestring pathname"},
+    {LispFunction, Lisp_Disassemble, "disassemble function"},
+    {LispMacro, Lisp_Do, "do init test &rest body"},
+    {LispMacro, Lisp_DoP, "do* init test &rest body"},
+    {LispFunction, Lisp_Documentation, "documentation symbol type"},
+    {LispMacro, Lisp_DoList, "dolist init &rest body", 0, 0, Com_Dolist},
+    {LispMacro, Lisp_DoTimes, "dotimes init &rest body"},
+    {LispMacro, Lisp_DoAllSymbols, "do-all-symbols init &rest body"},
+    {LispMacro, Lisp_DoExternalSymbols, "do-external-symbols init &rest body"},
+    {LispMacro, Lisp_DoSymbols, "do-symbols init &rest body"},
+    {LispFunction, Lisp_Elt, "elt sequence index"},
+    {LispFunction, Lisp_Endp, "endp object"},
+    {LispFunction, Lisp_EnoughNamestring, "enough-namestring pathname &optional defaults"},
+    {LispFunction, Lisp_Eq, "eq left right", 0, 0, Com_Eq},
+    {LispFunction, Lisp_Eql, "eql left right", 0, 0, Com_Eq},
+    {LispFunction, Lisp_Equal, "equal left right", 0, 0, Com_Eq},
+    {LispFunction, Lisp_Equalp, "equalp left right", 0, 0, Com_Eq},
+    {LispFunction, Lisp_Error, "error control-string &rest arguments"},
+    {LispFunction, Lisp_Evenp, "evenp integer"},
+    {LispFunction, Lisp_Export, "export symbols &optional package"},
+    {LispFunction, Lisp_Eval, "eval form"},
+    {LispFunction, Lisp_Every, "every predicate sequence &rest more-sequences"},
+    {LispFunction, Lisp_Some, "some predicate sequence &rest more-sequences"},
+    {LispFunction, Lisp_Notevery, "notevery predicate sequence &rest more-sequences"},
+    {LispFunction, Lisp_Notany, "notany predicate sequence &rest more-sequences"},
+    {LispFunction, Lisp_Fboundp, "fboundp symbol"},
+    {LispFunction, Lisp_Find, "find item sequence &key from-end test test-not start end key"},
+    {LispFunction, Lisp_FindIf, "find-if predicate sequence &key from-end start end key"},
+    {LispFunction, Lisp_FindIfNot, "find-if-not predicate sequence &key from-end start end key"},
+    {LispFunction, Lisp_FileNamestring, "file-namestring pathname"},
+    {LispFunction, Lisp_Fill, "fill sequence item &key start end"},
+    {LispFunction, Lisp_FindAllSymbols, "find-all-symbols string-or-symbol"},
+    {LispFunction, Lisp_FindSymbol, "find-symbol string &optional package", 1},
+    {LispFunction, Lisp_FindPackage, "find-package name"},
+    {LispFunction, Lisp_Float, "float number &optional other"},
+    {LispFunction, Lisp_Floatp, "floatp object"},
+    {LispFunction, Lisp_Floor, "floor number &optional divisor", 1},
+    {LispFunction, Lisp_Ffloor, "ffloor number &optional divisor", 1},
+    {LispFunction, Lisp_Fmakunbound, "fmakunbound symbol"},
+    {LispFunction, Lisp_Format, "format destination control-string &rest arguments"},
+    {LispFunction, Lisp_FreshLine, "fresh-line &optional output-stream"},
+    {LispFunction, Lisp_Funcall, "funcall function &rest arguments", 1},
+    {LispFunction, Lisp_Functionp, "functionp object"},
+    {LispFunction, Lisp_Gc, "gc &optional car cdr"},
+    {LispFunction, Lisp_Gcd, "gcd &rest integers"},
+    {LispFunction, Lisp_Gensym, "gensym &optional arg"},
+    {LispFunction, Lisp_Get, "get symbol indicator &optional default"},
+    {LispFunction, Lisp_Gethash, "gethash key hash-table &optional default", 1},
+    {LispMacro, Lisp_Go, "go tag", 0, 0, Com_Go},
+    {LispFunction, Lisp_GraphicCharP, "graphic-char-p char"},
+    {LispFunction, Lisp_HashTableP, "hash-table-p object"},
+    {LispFunction, Lisp_HashTableCount, "hash-table-count hash-table"},
+    {LispFunction, Lisp_HashTableRehashSize, "hash-table-rehash-size hash-table"},
+    {LispFunction, Lisp_HashTableRehashThreshold, "hash-table-rehash-threshold hash-table"},
+    {LispFunction, Lisp_HashTableSize, "hash-table-size hash-table"},
+    {LispFunction, Lisp_HashTableTest, "hash-table-test hash-table"},
+    {LispFunction, Lisp_HostNamestring, "host-namestring pathname"},
+    {LispMacro, Lisp_If, "if test then &optional else", 0, 0, Com_If},
+    {LispMacro, Lisp_IgnoreErrors, "ignore-errors &rest body", 1},
+    {LispFunction, Lisp_Imagpart, "imagpart number"},
+    {LispMacro, Lisp_InPackage, "in-package name"},
+    {LispMacro, Lisp_Incf, "incf place &optional delta"},
+    {LispFunction, Lisp_Import, "import symbols &optional package"},
+    {LispFunction, Lisp_InputStreamP, "input-stream-p stream"},
+    {LispFunction, Lisp_IntChar, "int-char integer"},
+    {LispFunction, Lisp_Integerp, "integerp object"},
+    {LispFunction, Lisp_Intern, "intern string &optional package", 1},
+    {LispFunction, Lisp_Intersection, "intersection list1 list2 &key test test-not key"},
+    {LispFunction, Lisp_Nintersection, "nintersection list1 list2 &key test test-not key"},
+    {LispFunction, Lisp_Isqrt, "isqrt natural"},
+    {LispFunction, Lisp_Keywordp, "keywordp object"},
+    {LispFunction, Lisp_Last, "last list &optional count", 0, 0, Com_Last},
+    {LispMacro, Lisp_Lambda, "lambda lambda-list &rest body"},
+    {LispFunction, Lisp_Lcm, "lcm &rest integers"},
+    {LispFunction, Lisp_Length, "length sequence", 0, 0, Com_Length},
+    {LispMacro, Lisp_Let, "let init &rest body", 1, 0, Com_Let},
+    {LispMacro, Lisp_LetP, "let* init &rest body", 1, 0, Com_Letx},
+    {LispFunction, Lisp_ListP, "list* object &rest more-objects"},
+    {LispFunction, Lisp_ListAllPackages, "list-all-packages"},
+    {LispFunction, Lisp_List, "list &rest args"},
+    {LispFunction, Lisp_ListLength, "list-length list"},
+    {LispFunction, Lisp_Listp, "listp object", 0, 0, Com_Listp},
+    {LispFunction, Lisp_Listen, "listen &optional input-stream"},
+    {LispFunction, Lisp_Load, "load filename &key verbose print if-does-not-exist"},
+    {LispFunction, Lisp_Logand, "logand &rest integers"},
+    {LispFunction, Lisp_Logeqv, "logeqv &rest integers"},
+    {LispFunction, Lisp_Logior, "logior &rest integers"},
+    {LispFunction, Lisp_Lognot, "lognot integer"},
+    {LispFunction, Lisp_Logxor, "logxor &rest integers"},
+    {LispMacro, Lisp_Loop, "loop &rest body", 0, 0, Com_Loop},
+    {LispFunction, Lisp_LowerCaseP, "lower-case-p character"},
+    {LispFunction, Lisp_MakeArray, "make-array dimensions &key element-type initial-element initial-contents adjustable fill-pointer displaced-to displaced-index-offset"},
+    {LispFunction, Lisp_MakeHashTable, "make-hash-table &key test size rehash-size rehash-threshold initial-contents"},
+    {LispFunction, Lisp_MakeList, "make-list size &key initial-element"},
+    {LispFunction, Lisp_MakePackage, "make-package package-name &key nicknames use"},
+    {LispFunction, Lisp_MakePathname, "make-pathname &key host device directory name type version defaults"},
+    {LispFunction, Lisp_MakeString, "make-string size &key initial-element element-type"},
+    {LispFunction, Lisp_MakeSymbol, "make-symbol name"},
+    {LispFunction, Lisp_MakeStringInputStream, "make-string-input-stream string &optional start end"},
+    {LispFunction, Lisp_MakeStringOutputStream, "make-string-output-stream &key element-type"},
+    {LispFunction, Lisp_GetOutputStreamString, "get-output-stream-string string-output-stream"},
+    {LispFunction, Lisp_Makunbound, "makunbound symbol"},
+    {LispFunction, Lisp_Mapc, "mapc function list &rest more-lists"},
+    {LispFunction, Lisp_Mapcar, "mapcar function list &rest more-lists"},
+    {LispFunction, Lisp_Mapcan, "mapcan function list &rest more-lists"},
+    {LispFunction, Lisp_Maphash, "maphash function hash-table"},
+    {LispFunction, Lisp_Mapl, "mapl function list &rest more-lists"},
+    {LispFunction, Lisp_Maplist, "maplist function list &rest more-lists"},
+    {LispFunction, Lisp_Mapcon, "mapcon function list &rest more-lists"},
+    {LispFunction, Lisp_Member, "member item list &key test test-not key"},
+    {LispFunction, Lisp_MemberIf, "member-if predicate list &key key"},
+    {LispFunction, Lisp_MemberIfNot, "member-if-not predicate list &key key"},
+    {LispFunction, Lisp_Minusp, "minusp number"},
+    {LispFunction, Lisp_Mod, "mod number divisor"},
+    {LispMacro, Lisp_MultipleValueBind, "multiple-value-bind symbols values &rest body"},
+    {LispMacro, Lisp_MultipleValueCall, "multiple-value-call function &rest form", 1},
+    {LispMacro, Lisp_MultipleValueProg1, "multiple-value-prog1 first-form &rest form", 1},
+    {LispMacro, Lisp_MultipleValueList, "multiple-value-list form"},
+    {LispMacro, Lisp_MultipleValueSetq, "multiple-value-setq symbols form"},
+    {LispFunction, Lisp_Nconc, "nconc &rest lists"},
+    {LispFunction, Lisp_Nreverse, "nreverse sequence"},
+    {LispFunction, Lisp_NsetDifference, "nset-difference list1 list2 &key test test-not key"},
+    {LispFunction, Lisp_Nsubstitute, "nsubstitute newitem olditem sequence &key from-end test test-not start end count key"},
+    {LispFunction, Lisp_NsubstituteIf, "nsubstitute-if newitem test sequence &key from-end start end count key"},
+    {LispFunction, Lisp_NsubstituteIfNot, "nsubstitute-if-not newitem test sequence &key from-end start end count key"},
+    {LispFunction, Lisp_Nth, "nth index list"},
+    {LispFunction, Lisp_Nthcdr, "nthcdr index list", 0, 0, Com_Nthcdr},
+    {LispMacro, Lisp_NthValue, "nth-value index form"},
+    {LispFunction, Lisp_Numerator, "numerator rational"},
+    {LispFunction, Lisp_Namestring, "namestring pathname"},
+    {LispFunction, Lisp_Null, "not arg", 0, 0, Com_Null},
+    {LispFunction, Lisp_Null, "null list", 0, 0, Com_Null},
+    {LispFunction, Lisp_Numberp, "numberp object", 0, 0, Com_Numberp},
+    {LispFunction, Lisp_Oddp, "oddp integer"},
+    {LispFunction, Lisp_Open, "open filename &key direction element-type if-exists if-does-not-exist external-format"},
+    {LispFunction, Lisp_OpenStreamP, "open-stream-p stream"},
+    {LispMacro, Lisp_Or, "or &rest args", 1, 0, Com_Or},
+    {LispFunction, Lisp_OutputStreamP, "output-stream-p stream"},
+    {LispFunction, Lisp_Packagep, "packagep object"},
+    {LispFunction, Lisp_PackageName, "package-name package"},
+    {LispFunction, Lisp_PackageNicknames, "package-nicknames package"},
+    {LispFunction, Lisp_PackageUseList, "package-use-list package"},
+    {LispFunction, Lisp_PackageUsedByList, "package-used-by-list package"},
+    {LispFunction, Lisp_Pairlis, "pairlis key data &optional alist"},
+    {LispFunction, Lisp_ParseInteger, "parse-integer string &key start end radix junk-allowed", 1},
+    {LispFunction, Lisp_ParseNamestring, "parse-namestring object &optional host defaults &key start end junk-allowed", 1},
+    {LispFunction, Lisp_PathnameHost, "pathname-host pathname"},
+    {LispFunction, Lisp_PathnameDevice, "pathname-device pathname"},
+    {LispFunction, Lisp_PathnameDirectory, "pathname-directory pathname"},
+    {LispFunction, Lisp_PathnameName, "pathname-name pathname"},
+    {LispFunction, Lisp_PathnameType, "pathname-type pathname"},
+    {LispFunction, Lisp_PathnameVersion, "pathname-version pathname"},
+    {LispFunction, Lisp_Pathnamep, "pathnamep object"},
+    {LispFunction, Lisp_Plusp, "plusp number"},
+    {LispMacro, Lisp_Pop, "pop place"},
+    {LispFunction, Lisp_Position, "position item sequence &key from-end test test-not start end key"},
+    {LispFunction, Lisp_PositionIf, "position-if predicate sequence &key from-end start end key"},
+    {LispFunction, Lisp_PositionIfNot, "position-if-not predicate sequence &key from-end start end key"},
+    {LispFunction, Lisp_Prin1, "prin1 object &optional output-stream"},
+    {LispFunction, Lisp_Princ, "princ object &optional output-stream"},
+    {LispFunction, Lisp_Print, "print object &optional output-stream"},
+    {LispFunction, Lisp_ProbeFile, "probe-file pathname"},
+    {LispFunction, Lisp_Proclaim, "proclaim declaration"},
+    {LispMacro, Lisp_Prog1, "prog1 first &rest body"},
+    {LispMacro, Lisp_Prog2, "prog2 first second &rest body"},
+    {LispMacro, Lisp_Progn, "progn &rest body", 1, 0, Com_Progn},
+    {LispMacro, Lisp_Progv, "progv symbols values &rest body", 1},
+    {LispFunction, Lisp_Provide, "provide module"},
+    {LispMacro, Lisp_Push, "push item place"},
+    {LispMacro, Lisp_Pushnew, "pushnew item place &key key test test-not"},
+    {LispFunction, Lisp_Quit, "quit &optional status"},
+    {LispMacro, Lisp_Quote, "quote object"},
+    {LispFunction, Lisp_Rational, "rational number"},
+    {LispFunction, Lisp_Rationalp, "rationalp object"},
+    {LispFunction, Lisp_Read, "read &optional input-stream eof-error-p eof-value recursive-p"},
+    {LispFunction, Lisp_ReadChar, "read-char &optional input-stream eof-error-p eof-value recursive-p"},
+    {LispFunction, Lisp_ReadCharNoHang, "read-char-no-hang &optional input-stream eof-error-p eof-value recursive-p"},
+    {LispFunction, Lisp_ReadLine, "read-line &optional input-stream eof-error-p eof-value recursive-p", 1},
+    {LispFunction, Lisp_Realpart, "realpart number"},
+    {LispFunction, Lisp_Replace, "replace sequence1 sequence2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_ReadFromString, "read-from-string string &optional eof-error-p eof-value &key start end preserve-whitespace", 1},
+    {LispFunction, Lisp_Require, "require module &optional pathname"},
+    {LispFunction, Lisp_Rem, "rem number divisor"},
+    {LispFunction, Lisp_Remhash, "remhash key hash-table"},
+    {LispFunction, Lisp_Remove, "remove item sequence &key from-end test test-not start end count key"},
+    {LispFunction, Lisp_RemoveDuplicates, "remove-duplicates sequence &key from-end test test-not start end key"},
+    {LispFunction, Lisp_RemoveIf, "remove-if predicate sequence &key from-end start end count key"},
+    {LispFunction, Lisp_RemoveIfNot, "remove-if-not predicate sequence &key from-end start end count key"},
+    {LispFunction, Lisp_Remprop, "remprop symbol indicator"},
+    {LispFunction, Lisp_RenameFile, "rename-file filename new-name", 1},
+    {LispMacro, Lisp_Return, "return &optional result", 1, 0, Com_Return},
+    {LispMacro, Lisp_ReturnFrom, "return-from name &optional result", 1, 0, Com_ReturnFrom},
+    {LispFunction, Lisp_Reverse, "reverse sequence"},
+    {LispFunction, Lisp_Round, "round number &optional divisor", 1},
+    {LispFunction, Lisp_Fround, "fround number &optional divisor", 1},
+    {LispFunction, Lisp_Rplaca, "rplaca place value", 0, 0, Com_Rplac_},
+    {LispFunction, Lisp_Rplacd, "rplacd place value", 0, 0, Com_Rplac_},
+    {LispFunction, Lisp_Search, "search sequence1 sequence2 &key from-end test test-not key start1 start2 end1 end2"},
+    {LispFunction, Lisp_Set, "set symbol value"},
+    {LispFunction, Lisp_SetDifference, "set-difference list1 list2 &key test test-not key"},
+    {LispFunction, Lisp_SetExclusiveOr, "set-exclusive-or list1 list2 &key test test-not key"},
+    {LispFunction, Lisp_NsetExclusiveOr, "nset-exclusive-or list1 list2 &key test test-not key"},
+    {LispMacro, Lisp_Setf, "setf &rest form"},
+    {LispMacro, Lisp_Psetf, "psetf &rest form"},
+    {LispMacro, Lisp_SetQ, "setq &rest form", 0, 0, Com_Setq},
+    {LispMacro, Lisp_Psetq, "psetq &rest form"},
+    {LispFunction, Lisp_Sleep, "sleep seconds"},
+    {LispFunction, Lisp_Sort, "sort sequence predicate &key key"},
+    {LispFunction, Lisp_Sqrt, "sqrt number"},
+    {LispFunction, Lisp_Elt, "svref sequence index"},
+    {LispFunction, Lisp_Sort, "stable-sort sequence predicate &key key"},
+    {LispFunction, Lisp_Streamp, "streamp object"},
+    {LispFunction, Lisp_String, "string object"},
+    {LispFunction, Lisp_Stringp, "stringp object"},
+    {LispFunction, Lisp_StringEqual_, "string= string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringLess, "string< string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringGreater, "string> string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringLessEqual, "string<= string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringGreaterEqual, "string>= string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringNotEqual_, "string/= string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringConcat, "string-concat &rest strings"},
+    {LispFunction, Lisp_StringEqual, "string-equal string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringGreaterp, "string-greaterp string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringNotEqual, "string-not-equal string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringNotGreaterp, "string-not-greaterp string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringNotLessp, "string-not-lessp string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringLessp, "string-lessp string1 string2 &key start1 end1 start2 end2"},
+    {LispFunction, Lisp_StringTrim, "string-trim character-bag string"},
+    {LispFunction, Lisp_StringLeftTrim, "string-left-trim character-bag string"},
+    {LispFunction, Lisp_StringRightTrim, "string-right-trim character-bag string"},
+    {LispFunction, Lisp_StringUpcase, "string-upcase string &key start end"},
+    {LispFunction, Lisp_NstringUpcase, "nstring-upcase string &key start end"},
+    {LispFunction, Lisp_StringDowncase, "string-downcase string &key start end"},
+    {LispFunction, Lisp_NstringDowncase, "nstring-downcase string &key start end"},
+    {LispFunction, Lisp_StringCapitalize, "string-capitalize string &key start end"},
+    {LispFunction, Lisp_NstringCapitalize, "nstring-capitalize string &key start end"},
+    {LispFunction, Lisp_Subseq, "subseq sequence start &optional end"},
+    {LispFunction, Lisp_Subsetp, "subsetp list1 list2 &key test test-not key"},
+    {LispFunction, Lisp_Substitute, "substitute newitem olditem sequence &key from-end test test-not start end count key"},
+    {LispFunction, Lisp_SubstituteIf, "substitute-if newitem test sequence &key from-end start end count key"},
+    {LispFunction, Lisp_SubstituteIfNot, "substitute-if-not newitem test sequence &key from-end start end count key"},
+    {LispFunction, Lisp_SymbolFunction, "symbol-function symbol"},
+    {LispFunction, Lisp_SymbolName, "symbol-name symbol"},
+    {LispFunction, Lisp_Symbolp, "symbolp object"},
+    {LispFunction, Lisp_SymbolPlist, "symbol-plist symbol"},
+    {LispFunction, Lisp_SymbolPackage, "symbol-package symbol"},
+    {LispFunction, Lisp_SymbolValue, "symbol-value symbol"},
+    {LispMacro, Lisp_Tagbody, "tagbody &rest body", 0, 0, Com_Tagbody},
+    {LispFunction, Lisp_Terpri, "terpri &optional output-stream"},
+    {LispFunction, Lisp_Typep, "typep object type"},
+    {LispMacro, Lisp_The, "the value-type form"},
+    {LispMacro, Lisp_Throw, "throw tag result", 1},
+    {LispMacro, Lisp_Time, "time form"},
+    {LispFunction, Lisp_Truename, "truename pathname"},
+    {LispFunction, Lisp_TreeEqual, "tree-equal tree-1 tree-2 &key test test-not"},
+    {LispFunction, Lisp_Truncate, "truncate number &optional divisor", 1},
+    {LispFunction, Lisp_Ftruncate, "ftruncate number &optional divisor", 1},
+    {LispFunction, Lisp_Unexport, "unexport symbols &optional package"},
+    {LispFunction, Lisp_Union, "union list1 list2 &key test test-not key"},
+    {LispFunction, Lisp_Nunion, "nunion list1 list2 &key test test-not key"},
+    {LispMacro, Lisp_Unless, "unless test &rest body", 1, 0, Com_Unless},
+    {LispFunction, Lisp_UserHomedirPathname, "user-homedir-pathname &optional host"},
+    {LispMacro, Lisp_UnwindProtect, "unwind-protect protect &rest cleanup"},
+    {LispFunction, Lisp_UpperCaseP, "upper-case-p character"},
+    {LispFunction, Lisp_Values, "values &rest objects", 1},
+    {LispFunction, Lisp_ValuesList, "values-list list", 1},
+    {LispFunction, Lisp_Vector, "vector &rest objects"},
+    {LispMacro, Lisp_When, "when test &rest body", 1, 0, Com_When},
+    {LispFunction, Lisp_Write, " write object &key case circle escape length level lines pretty readably right-margin stream"},
+    {LispFunction, Lisp_WriteChar, "write-char string &optional output-stream"},
+    {LispFunction, Lisp_WriteLine, "write-line string &optional output-stream &key start end"},
+    {LispFunction, Lisp_WriteString, "write-string string &optional output-stream &key start end"},
+    {LispFunction, Lisp_XeditCharStore, "lisp::char-store string index value", 0, 1},
+    {LispFunction, Lisp_XeditEltStore, "lisp::elt-store sequence index value", 0, 1},
+    {LispFunction, Lisp_XeditMakeStruct, "lisp::make-struct atom &rest init", 0, 1},
+    {LispFunction, Lisp_XeditPut, " lisp::put symbol indicator value", 0, 1},
+    {LispFunction, Lisp_XeditPuthash, "lisp::puthash key hash-table value", 0, 1},
+    {LispFunction, Lisp_XeditSetSymbolPlist, "lisp::set-symbol-plist symbol list", 0, 1},
+    {LispFunction, Lisp_XeditStructAccess, "lisp::struct-access atom struct", 0, 1},
+    {LispFunction, Lisp_XeditStructType, "lisp::struct-type atom struct", 0, 1},
+    {LispFunction, Lisp_XeditStructStore, "lisp::struct-store atom struct value", 0, 1},
+    {LispFunction, Lisp_XeditVectorStore, "lisp::vector-store array &rest values", 0, 1},
+    {LispFunction, Lisp_XeditDocumentationStore, "lisp::documentation-store symbol type string", 0, 1},
+    {LispFunction, Lisp_Zerop, "zerop number"},
+};
+
+static LispBuiltin extbuiltins[] = {
+    {LispFunction, Lisp_Getenv, "getenv name"},
+    {LispFunction, Lisp_MakePipe, "make-pipe command-line &key direction element-type external-format"},
+    {LispFunction, Lisp_PipeBroken, "pipe-broken pipe-stream"},
+    {LispFunction, Lisp_PipeErrorStream, "pipe-error-stream pipe-stream"},
+    {LispFunction, Lisp_PipeInputDescriptor, "pipe-input-descriptor pipe-stream"},
+    {LispFunction, Lisp_PipeErrorDescriptor, "pipe-error-descriptor pipe-stream"},
+    {LispFunction, Lisp_Recomp, "re-comp pattern &key nospec icase nosub newline"},
+    {LispFunction, Lisp_Reexec, "re-exec regex string &key count start end notbol noteol"},
+    {LispFunction, Lisp_Rep, "re-p object"},
+    {LispFunction, Lisp_Setenv, "setenv name value &optional overwrite"},
+    {LispFunction, Lisp_Unsetenv, "unsetenv name"},
+    {LispFunction, Lisp_NstringTrim, "nstring-trim character-bag string"},
+    {LispFunction, Lisp_NstringLeftTrim, "nstring-left-trim character-bag string"},
+    {LispFunction, Lisp_NstringRightTrim, "nstring-right-trim character-bag string"},
+    {LispMacro, Lisp_Until, "until test &rest body", 0, 0, Com_Until},
+    {LispMacro, Lisp_While, "while test &rest body", 0, 0, Com_While},
+};
+
+/* byte code function argument list for functions that don't change it's
+ * &REST argument list. */
+extern LispObj x_cons[8];
+
+/*
+ * Implementation
+ */
+static int
+LispGetPageSize(void)
+{
+    static int pagesize = -1;
+
+    if (pagesize != -1)
+	return pagesize;
+
+    /* Try each supported method in the preferred order */
+
+#if defined(_SC_PAGESIZE) || defined(HAS_SC_PAGESIZE)
+    pagesize = sysconf(_SC_PAGESIZE);
+#endif
+
+#ifdef _SC_PAGE_SIZE
+    if (pagesize == -1)
+	pagesize = sysconf(_SC_PAGE_SIZE);
+#endif
+
+#ifdef HAS_GETPAGESIZE
+    if (pagesize == -1)
+	pagesize = getpagesize();
+#endif
+
+#ifdef PAGE_SIZE
+    if (pagesize == -1)
+	pagesize = PAGE_SIZE;
+#endif
+
+    if (pagesize < sizeof(LispObj) * 16)
+	pagesize = sizeof(LispObj) * 16;	/* need a reasonable sane size */
+
+    return pagesize;
+}
+
+void
+LispDestroy(char *fmt, ...)
+{
+    static char Error[] = "*** ";
+
+    if (!lisp__data.destroyed) {
+	char string[128];
+	va_list ap;
+
+	va_start(ap, fmt);
+	vsnprintf(string, sizeof(string), fmt, ap);
+	va_end(ap);
+
+	if (!lisp__data.ignore_errors) {
+	    if (Stderr->column)
+		LispFputc(Stderr, '\n');
+	    LispFputs(Stderr, Error);
+	    LispFputs(Stderr, string);
+	    LispFputc(Stderr, '\n');
+	    LispFflush(Stderr);
+	}
+	else
+	    lisp__data.error_condition = STRING(string);
+
+#ifdef DEBUGGER
+	if (lisp__data.debugging) {
+	    LispDebugger(LispDebugCallWatch, NIL, NIL);
+	    LispDebugger(LispDebugCallFatal, NIL, NIL);
+	}
+#endif
+
+	lisp__data.destroyed = 1;
+	LispBlockUnwind(NULL);
+	if (lisp__data.errexit)
+	    exit(1);
+    }
+
+#ifdef DEBUGGER
+    if (lisp__data.debugging) {
+	/* when stack variables could be changed, this must be also changed! */
+	lisp__data.debug_level = -1;
+	lisp__data.debug = LispDebugUnspec;
+    }
+#endif
+
+    while (lisp__data.mem.level) {
+	--lisp__data.mem.level;
+	if (lisp__data.mem.mem[lisp__data.mem.level])
+	    free(lisp__data.mem.mem[lisp__data.mem.level]);
+    }
+    lisp__data.mem.index = 0;
+
+    /* If the package was changed and an error happened */
+    PACKAGE = lisp__data.savepackage;
+    lisp__data.pack = lisp__data.savepack;
+
+    LispTopLevel();
+
+    if (!lisp__data.running) {
+	static char Fatal[] = "*** Fatal: nowhere to longjmp.\n";
+
+	LispFputs(Stderr, Fatal);
+	LispFflush(Stderr);
+	abort();
+    }
+
+    siglongjmp(lisp__data.jmp, 1);
+}
+
+void
+LispContinuable(char *fmt, ...)
+{
+    va_list ap;
+    char string[128];
+    static char Error[] = "*** Error: ";
+
+    if (Stderr->column)
+	LispFputc(Stderr, '\n');
+    LispFputs(Stderr, Error);
+    va_start(ap, fmt);
+    vsnprintf(string, sizeof(string), fmt, ap);
+    va_end(ap);
+    LispFputs(Stderr, string);
+    LispFputc(Stderr, '\n');
+    LispFputs(Stderr, "Type 'continue' if you want to proceed: ");
+    LispFflush(Stderr);
+
+    /* NOTE: does not check if stdin is a tty */
+    if (LispFgets(Stdin, string, sizeof(string)) &&
+	strcmp(string, "continue\n") == 0)
+	return;
+
+    LispDestroy("aborted on continuable error");
+}
+
+void
+LispMessage(char *fmt, ...)
+{
+    va_list ap;
+    char string[128];
+
+    if (Stderr->column)
+	LispFputc(Stderr, '\n');
+    va_start(ap, fmt);
+    vsnprintf(string, sizeof(string), fmt, ap);
+    va_end(ap);
+    LispFputs(Stderr, string);
+    LispFputc(Stderr, '\n');
+    LispFflush(Stderr);
+}
+
+void
+LispWarning(char *fmt, ...)
+{
+    va_list ap;
+    char string[128];
+    static char Warning[] = "*** Warning: ";
+
+    if (Stderr->column)
+	LispFputc(Stderr, '\n');
+    LispFputs(Stderr, Warning);
+    va_start(ap, fmt);
+    vsnprintf(string, sizeof(string), fmt, ap);
+    va_end(ap);
+    LispFputs(Stderr, string);
+    LispFputc(Stderr, '\n');
+    LispFflush(Stderr);
+}
+
+void
+LispTopLevel(void)
+{
+    int count;
+
+    COD = NIL;
+#ifdef DEBUGGER
+    if (lisp__data.debugging) {
+	DBG = NIL;
+	if (lisp__data.debug == LispDebugFinish)
+	    lisp__data.debug = LispDebugUnspec;
+	lisp__data.debug_level = -1;
+	lisp__data.debug_step = 0;
+    }
+#endif
+    gcpro = 0;
+    lisp__data.block.block_level = 0;
+    if (lisp__data.block.block_size) {
+	while (lisp__data.block.block_size)
+	    free(lisp__data.block.block[--lisp__data.block.block_size]);
+	free(lisp__data.block.block);
+	lisp__data.block.block = NULL;
+    }
+
+    lisp__data.destroyed = lisp__data.ignore_errors = 0;
+
+    if (CONSP(lisp__data.input_list)) {
+	LispUngetInfo **info, *unget = lisp__data.unget[0];
+
+	while (CONSP(lisp__data.input_list))
+	    lisp__data.input_list = CDR(lisp__data.input_list);
+	SINPUT = lisp__data.input_list;
+	while (lisp__data.nunget > 1)
+	    free(lisp__data.unget[--lisp__data.nunget]);
+	if ((info = realloc(lisp__data.unget, sizeof(LispUngetInfo*))) != NULL)
+	    lisp__data.unget = info;
+	lisp__data.unget[0] = unget;
+	lisp__data.iunget = 0;
+	lisp__data.eof = 0;
+    }
+
+    for (count = 0; lisp__data.mem.level;) {
+	--lisp__data.mem.level;
+	if (lisp__data.mem.mem[lisp__data.mem.level]) {
+	    ++count;
+#if 0
+	    printf("LEAK: %p\n", lisp__data.mem.mem[lisp__data.mem.level]);
+#endif
+	}
+    }
+    lisp__data.mem.index = 0;
+    if (count)
+	LispWarning("%d raw memory pointer(s) left. Probably a leak.", count);
+
+    lisp__data.stack.base = lisp__data.stack.length =
+	lisp__data.env.lex = lisp__data.env.length = lisp__data.env.head = 0;
+    RETURN_COUNT = 0;
+    lisp__data.protect.length = 0;
+
+    lisp__data.savepackage = PACKAGE;
+    lisp__data.savepack = lisp__data.pack;
+
+    lisp__disable_int = lisp__interrupted = 0;
+}
+
+void
+LispGC(LispObj *car, LispObj *cdr)
+{
+    Lisp__GC(car, cdr);
+}
+
+static void
+Lisp__GC(LispObj *car, LispObj *cdr)
+{
+    register LispObj *entry, *last, *freeobj, **pentry, **eentry;
+    register int nfree;
+    unsigned i, j;
+    LispAtom *atom;
+    struct timeval start, end;
+#ifdef DEBUG
+    long sec, msec;
+    int count = objseg.nfree;
+#else
+    long msec;
+#endif
+
+    if (gcpro)
+	return;
+
+    DISABLE_INTERRUPTS();
+
+    nfree = 0;
+    freeobj = NIL;
+
+    ++lisp__data.gc.count;
+
+#ifdef DEBUG
+    gettimeofday(&start, NULL);
+#else
+    if (lisp__data.gc.timebits)
+	gettimeofday(&start, NULL);
+#endif
+
+    /*  Need to measure timings again to check if it is not better/faster
+     * to just mark these fields as any other data, as the interface was
+     * changed to properly handle circular lists in the function body itself.
+     */
+    if (lisp__data.gc.immutablebits) {
+	for (j = 0; j < objseg.nsegs; j++) {
+	    for (entry = objseg.objects[j], last = entry + segsize;
+		 entry < last; entry++)
+		entry->prot = 0;
+	}
+    }
+
+    /* Protect all packages */
+    for (entry = PACK; CONSP(entry); entry = CDR(entry)) {
+	LispObj *package = CAR(entry);
+	LispPackage *pack = package->data.package.package;
+
+	/* Protect cons cell */
+	entry->mark = 1;
+
+	/* Protect the package cell */
+	package->mark = 1;
+
+	/* Protect package name */
+	package->data.package.name->mark = 1;
+
+	/* Protect package nicknames */
+	LispMark(package->data.package.nicknames);
+
+	/* Protect global symbols */
+	for (pentry = pack->glb.pairs, eentry = pentry + pack->glb.length;
+	    pentry < eentry; pentry++)
+	    LispMark((*pentry)->data.atom->property->value);
+
+	/* Traverse atom list, protecting properties, and function/structure
+	 * definitions if lisp__data.gc.immutablebits set */
+	for (i = 0; i < STRTBLSZ; i++) {
+	    atom = pack->atoms[i];
+	    while (atom) {
+		if (atom->property != NOPROPERTY) {
+		    if (atom->a_property)
+			LispMark(atom->property->properties);
+		    if (lisp__data.gc.immutablebits) {
+			if (atom->a_function || atom->a_compiled)
+			    LispProt(atom->property->fun.function);
+			if (atom->a_defsetf)
+			    LispProt(atom->property->setf);
+			if (atom->a_defstruct)
+			    LispProt(atom->property->structure.definition);
+		    }
+		}
+		atom = atom->next;
+	    }
+	}
+    }
+
+    /* protect environment */
+    for (pentry = lisp__data.env.values,
+	 eentry = pentry + lisp__data.env.length;
+	 pentry < eentry; pentry++)
+	LispMark(*pentry);
+
+    /* protect multiple return values */
+    for (pentry = lisp__data.returns.values,
+	 eentry = pentry + lisp__data.returns.count;
+	 pentry < eentry; pentry++)
+	LispMark(*pentry);
+
+    /* protect stack of arguments to builtin functions */
+    for (pentry = lisp__data.stack.values,
+	 eentry = pentry + lisp__data.stack.length;
+	 pentry < eentry; pentry++)
+	LispMark(*pentry);
+
+    /* protect temporary data used by builtin functions */
+    for (pentry = lisp__data.protect.objects,
+	 eentry = pentry + lisp__data.protect.length;
+	 pentry < eentry; pentry++)
+	LispMark(*pentry);
+
+    for (i = 0; i < sizeof(x_cons) / sizeof(x_cons[0]); i++)
+	x_cons[i].mark = 0;
+
+    LispMark(COD);
+#ifdef DEBUGGER
+    LispMark(DBG);
+    LispMark(BRK);
+#endif
+    LispMark(PRO);
+    LispMark(lisp__data.input_list);
+    LispMark(lisp__data.output_list);
+    LispMark(car);
+    LispMark(cdr);
+
+    for (j = 0; j < objseg.nsegs; j++) {
+	for (entry = objseg.objects[j], last = entry + segsize;
+	     entry < last; entry++) {
+	    if (entry->prot)
+		continue;
+	    else if (entry->mark)
+		entry->mark = 0;
+	    else {
+		switch (XOBJECT_TYPE(entry)) {
+		    case LispString_t:
+			free(THESTR(entry));
+			entry->type = LispCons_t;
+			break;
+		    case LispStream_t:
+			switch (entry->data.stream.type) {
+			    case LispStreamString:
+				free(SSTREAMP(entry)->string);
+				free(SSTREAMP(entry));
+				break;
+			    case LispStreamFile:
+				if (FSTREAMP(entry))
+				    LispFclose(FSTREAMP(entry));
+				break;
+			    case LispStreamPipe:
+				/* XXX may need special handling if child hangs */
+				if (PSTREAMP(entry)) {
+				    if (IPSTREAMP(entry))
+					LispFclose(IPSTREAMP(entry));
+				    if (OPSTREAMP(entry))
+					LispFclose(OPSTREAMP(entry));
+				    /* don't bother with error stream, will also
+				     * freed in this GC call, maybe just out
+				     * of order */
+				    if (PIDPSTREAMP(entry) > 0) {
+					kill(PIDPSTREAMP(entry), SIGTERM);
+					waitpid(PIDPSTREAMP(entry), NULL, 0);
+				    }
+				    free(PSTREAMP(entry));
+				}
+				break;
+			    default:
+				break;
+			}
+			entry->type = LispCons_t;
+			break;
+		    case LispBignum_t:
+			mpi_clear(entry->data.mp.integer);
+			free(entry->data.mp.integer);
+			entry->type = LispCons_t;
+			break;
+		    case LispBigratio_t:
+			mpr_clear(entry->data.mp.ratio);
+			free(entry->data.mp.ratio);
+			entry->type = LispCons_t;
+			break;
+		    case LispLambda_t:
+			if (!SYMBOLP(entry->data.lambda.name))
+			    LispFreeArgList((LispArgList*)
+				entry->data.lambda.name->data.opaque.data);
+			entry->type = LispCons_t;
+			break;
+		    case LispRegex_t:
+			refree(entry->data.regex.regex);
+			free(entry->data.regex.regex);
+			entry->type = LispCons_t;
+			break;
+		    case LispBytecode_t:
+			free(entry->data.bytecode.bytecode->code);
+			free(entry->data.bytecode.bytecode);
+			entry->type = LispCons_t;
+			break;
+		    case LispHashTable_t:
+			LispFreeHashTable(entry->data.hash.table);
+			entry->type = LispCons_t;
+			break;
+		    case LispCons_t:
+			break;
+		    default:
+			entry->type = LispCons_t;
+			break;
+		}
+		CDR(entry) = freeobj;
+		freeobj = entry;
+		++nfree;
+	    }
+	}
+    }
+
+    objseg.nfree = nfree;
+    objseg.freeobj = freeobj;
+
+    lisp__data.gc.immutablebits = 0;
+
+#ifdef DEBUG
+    gettimeofday(&end, NULL);
+    sec = end.tv_sec - start.tv_sec;
+    msec = end.tv_usec - start.tv_usec;
+    if (msec < 0) {
+	--sec;
+	msec += 1000000;
+    }
+    LispMessage("gc: "
+		"%ld sec, %ld msec, "
+		"%d recovered, %d free, %d protected, %d total",
+		sec, msec,
+		objseg.nfree - count, objseg.nfree,
+		objseg.nobjs - objseg.nfree, objseg.nobjs);
+#else
+    if (lisp__data.gc.timebits) {
+	gettimeofday(&end, NULL);
+	if ((msec = end.tv_usec - start.tv_usec) < 0)
+	    msec += 1000000;
+	lisp__data.gc.gctime += msec;
+    }
+#endif
+
+    ENABLE_INTERRUPTS();
+}
+
+static INLINE void
+LispCheckMemLevel(void)
+{
+    int i;
+
+    /* Check for a free slot before the end. */
+    for (i = lisp__data.mem.index; i < lisp__data.mem.level; i++)
+	if (lisp__data.mem.mem[i] == NULL) {
+	    lisp__data.mem.index = i;
+	    return;
+	}
+
+    /* Check for a free slot in the beginning */
+    for (i = 0; i < lisp__data.mem.index; i++)
+	if (lisp__data.mem.mem[i] == NULL) {
+	    lisp__data.mem.index = i;
+	    return;
+	}
+
+    lisp__data.mem.index = lisp__data.mem.level;
+    ++lisp__data.mem.level;
+    if (lisp__data.mem.index < lisp__data.mem.space)
+	/* There is free space to store pointer. */
+	return;
+    else {
+	void **ptr = (void**)realloc(lisp__data.mem.mem,
+				     (lisp__data.mem.space + 16) *
+				     sizeof(void*));
+
+	if (ptr == NULL)
+	    LispDestroy("out of memory");
+	lisp__data.mem.mem = ptr;
+	lisp__data.mem.space += 16;
+    }
+}
+
+void
+LispMused(void *pointer)
+{
+    int i;
+
+    DISABLE_INTERRUPTS();
+    for (i = lisp__data.mem.index; i >= 0; i--)
+	if (lisp__data.mem.mem[i] == pointer) {
+	    lisp__data.mem.mem[i] = NULL;
+	    lisp__data.mem.index = i;
+	    goto mused_done;
+	}
+
+    for (i = lisp__data.mem.level - 1; i > lisp__data.mem.index; i--)
+	if (lisp__data.mem.mem[i] == pointer) {
+	    lisp__data.mem.mem[i] = NULL;
+	    lisp__data.mem.index = i;
+	    break;
+	}
+
+mused_done:
+    ENABLE_INTERRUPTS();
+}
+
+void *
+LispMalloc(size_t size)
+{
+    void *pointer;
+
+    DISABLE_INTERRUPTS();
+    LispCheckMemLevel();
+    if ((pointer = malloc(size)) == NULL)
+	LispDestroy("out of memory, couldn't allocate %lu bytes",
+		    (unsigned long)size);
+
+    lisp__data.mem.mem[lisp__data.mem.index] = pointer;
+    ENABLE_INTERRUPTS();
+
+    return (pointer);
+}
+
+void *
+LispCalloc(size_t nmemb, size_t size)
+{
+    void *pointer;
+
+    DISABLE_INTERRUPTS();
+    LispCheckMemLevel();
+    if ((pointer = calloc(nmemb, size)) == NULL)
+	LispDestroy("out of memory, couldn't allocate %lu bytes",
+		    (unsigned long)size);
+
+    lisp__data.mem.mem[lisp__data.mem.index] = pointer;
+    ENABLE_INTERRUPTS();
+
+    return (pointer);
+}
+
+void *
+LispRealloc(void *pointer, size_t size)
+{
+    void *ptr;
+    int i;
+
+    DISABLE_INTERRUPTS();
+    if (pointer != NULL) {
+	for (i = lisp__data.mem.index; i >= 0; i--)
+	    if (lisp__data.mem.mem[i] == pointer)
+		goto index_found;
+
+	for (i = lisp__data.mem.index + 1; i < lisp__data.mem.level; i++)
+	    if (lisp__data.mem.mem[i] == pointer)
+		goto index_found;
+
+    }
+    LispCheckMemLevel();
+    i = lisp__data.mem.index;
+
+index_found:
+    if ((ptr = realloc(pointer, size)) == NULL)
+	LispDestroy("out of memory, couldn't realloc");
+
+    lisp__data.mem.mem[i] = ptr;
+    ENABLE_INTERRUPTS();
+
+    return (ptr);
+}
+
+char *
+LispStrdup(char *str)
+{
+    char *ptr = LispMalloc(strlen(str) + 1);
+
+    strcpy(ptr, str);
+
+    return (ptr);
+}
+
+void
+LispFree(void *pointer)
+{
+    int i;
+
+    DISABLE_INTERRUPTS();
+    for (i = lisp__data.mem.index; i >= 0; i--)
+	if (lisp__data.mem.mem[i] == pointer) {
+	    lisp__data.mem.mem[i] = NULL;
+	    lisp__data.mem.index = i;
+	    goto free_done;
+	}
+
+    for (i = lisp__data.mem.level - 1; i > lisp__data.mem.index; i--)
+	if (lisp__data.mem.mem[i] == pointer) {
+	    lisp__data.mem.mem[i] = NULL;
+	    lisp__data.mem.index = i;
+	    break;
+	}
+
+free_done:
+    free(pointer);
+    ENABLE_INTERRUPTS();
+}
+
+LispObj *
+LispSetVariable(LispObj *var, LispObj *val, char *fname, int eval)
+{
+    if (!SYMBOLP(var))
+	LispDestroy("%s: %s is not a symbol", fname, STROBJ(var));
+    if (eval)
+	val = EVAL(val);
+
+    return (LispSetVar(var, val));
+}
+
+int
+LispRegisterOpaqueType(char *desc)
+{
+    LispOpaque *opaque;
+    int ii = STRHASH(desc);
+
+    for (opaque = lisp__data.opqs[ii]; opaque; opaque = opaque->next)
+	if (strcmp(opaque->desc, desc) == 0)
+	    return (opaque->type);
+    opaque = (LispOpaque*)LispMalloc(sizeof(LispOpaque));
+    opaque->desc = LispStrdup(desc);
+    opaque->next = lisp__data.opqs[ii];
+    lisp__data.opqs[ii] = opaque;
+    LispMused(opaque->desc);
+    LispMused(opaque);
+
+    return (opaque->type = ++lisp__data.opaque);
+}
+
+char *
+LispIntToOpaqueType(int type)
+{
+    int i;
+    LispOpaque *opaque;
+
+    if (type) {
+	for (i = 0; i < STRTBLSZ; i++) {
+	    opaque = lisp__data.opqs[i];
+	    while (opaque) {
+		if (opaque->type == type)
+		    return (opaque->desc);
+		opaque = opaque->next;
+	    }
+	}
+	LispDestroy("Opaque type %d not registered", type);
+    }
+
+    return (Snil);
+}
+
+int
+LispDoHashString(char *string)
+{
+    char *pp;
+    int ii, count;
+
+    for (pp = string, ii = count = 0; *pp && count < 32; pp++, count++)
+	ii = (ii << 1) ^ *pp;
+    if (ii < 0)
+	ii = -ii;
+
+    return (ii % STRTBLSZ);
+}
+
+char *
+LispGetAtomString(char *string, int perm)
+{
+    LispStringHash *entry;
+    int ii = STRHASH(string);
+
+    for (entry = lisp__data.strings[ii]; entry != NULL; entry = entry->next)
+	if (strcmp(entry->string, string) == 0)
+	    return (entry->string);
+
+    entry = (LispStringHash*)LispCalloc(1, sizeof(LispStringHash));
+    if (perm)
+	entry->string = string;
+    else
+	entry->string = LispStrdup(string);
+    LispMused(entry);
+    if (!perm)
+	LispMused(entry->string);
+    entry->next = lisp__data.strings[ii];
+    lisp__data.strings[ii] = entry;
+
+    return (entry->string);
+}
+
+LispAtom *
+LispDoGetAtom(char *str, int perm)
+{
+    LispAtom *atom;
+    int ii = STRHASH(str);
+
+    for (atom = lisp__data.pack->atoms[ii]; atom; atom = atom->next)
+	if (strcmp(atom->string, str) == 0)
+	    return (atom);
+
+    atom = (LispAtom*)LispCalloc(1, sizeof(LispAtom));
+    atom->string = LispGetAtomString(str, perm);
+    LispMused(atom);
+    atom->next = lisp__data.pack->atoms[ii];
+    lisp__data.pack->atoms[ii] = atom;
+    atom->property = NOPROPERTY;
+
+    return (atom);
+}
+
+static void
+LispAllocAtomProperty(LispAtom *atom)
+{
+    LispProperty *property;
+
+    if (atom->property != NOPROPERTY)
+	LispDestroy("internal error at ALLOC-ATOM-PROPERTY");
+
+    property = LispCalloc(1, sizeof(LispProperty));
+    LispMused(property);
+    atom->property = property;
+    property->package = lisp__data.pack;
+    if (atom->package == NULL)
+	atom->package = PACKAGE;
+
+    LispIncrementAtomReference(atom);
+}
+
+static void
+LispIncrementAtomReference(LispAtom *atom)
+{
+    if (atom->property != NOPROPERTY)
+	/* if atom->property is NOPROPERTY, this is an unbound symbol */
+	++atom->property->refcount;
+}
+
+/* Assumes atom property is not NOPROPERTY */
+static void
+LispDecrementAtomReference(LispAtom *atom)
+{
+    if (atom->property == NOPROPERTY)
+	/* if atom->property is NOPROPERTY, this is an unbound symbol */
+	return;
+
+    --atom->property->refcount;
+
+    if (atom->property->refcount < 0)
+	LispDestroy("internal error at DECREMENT-ATOM-REFERENCE");
+
+    if (atom->property->refcount == 0) {
+	LispRemAtomAllProperties(atom);
+	free(atom->property);
+	atom->property = NOPROPERTY;
+    }
+}
+
+static void
+LispRemAtomAllProperties(LispAtom *atom)
+{
+    if (atom->property != NOPROPERTY) {
+	if (atom->a_object)
+	    LispRemAtomObjectProperty(atom);
+	if (atom->a_function) {
+	    lisp__data.gc.immutablebits = 1;
+	    LispRemAtomFunctionProperty(atom);
+	}
+	else if (atom->a_compiled) {
+	    lisp__data.gc.immutablebits = 1;
+	    LispRemAtomCompiledProperty(atom);
+	}
+	else if (atom->a_builtin) {
+	    lisp__data.gc.immutablebits = 1;
+	    LispRemAtomBuiltinProperty(atom);
+	}
+	if (atom->a_defsetf) {
+	    lisp__data.gc.immutablebits = 1;
+	    LispRemAtomSetfProperty(atom);
+	}
+	if (atom->a_defstruct) {
+	    lisp__data.gc.immutablebits = 1;
+	    LispRemAtomStructProperty(atom);
+	}
+    }
+}
+
+void
+LispSetAtomObjectProperty(LispAtom *atom, LispObj *object)
+{
+    if (atom->property == NOPROPERTY)
+	LispAllocAtomProperty(atom);
+    else if (atom->watch) {
+	if (atom->object == lisp__data.package) {
+	    if (!PACKAGEP(object))
+		LispDestroy("Symbol %s must be a package, not %s",
+			    ATOMID(lisp__data.package), STROBJ(object));
+	    lisp__data.pack = object->data.package.package;
+	}
+    }
+
+    atom->a_object = 1;
+    SETVALUE(atom, object);
+}
+
+static void
+LispRemAtomObjectProperty(LispAtom *atom)
+{
+    if (atom->a_object) {
+	atom->a_object = 0;
+	atom->property->value = NULL;
+    }
+}
+
+void
+LispSetAtomCompiledProperty(LispAtom *atom, LispObj *bytecode)
+{
+    if (atom->property == NOPROPERTY)
+	LispAllocAtomProperty(atom);
+
+    lisp__data.gc.immutablebits = 1;
+    if (atom->a_builtin) {
+	atom->a_builtin = 0;
+	LispFreeArgList(atom->property->alist);
+    }
+    else
+	atom->a_function = 0;
+    atom->a_compiled = 1;
+    atom->property->fun.function = bytecode;
+}
+
+void
+LispRemAtomCompiledProperty(LispAtom *atom)
+{
+    if (atom->a_compiled) {
+	lisp__data.gc.immutablebits = 1;
+	atom->property->fun.function = NULL;
+	atom->a_compiled = 0;
+	LispFreeArgList(atom->property->alist);
+	atom->property->alist = NULL;
+    }
+}
+
+void
+LispSetAtomFunctionProperty(LispAtom *atom, LispObj *function,
+			    LispArgList *alist)
+{
+    if (atom->property == NOPROPERTY)
+	LispAllocAtomProperty(atom);
+
+    lisp__data.gc.immutablebits = 1;
+    if (atom->a_function == 0 && atom->a_builtin == 0 && atom->a_compiled == 0)
+	atom->a_function = 1;
+    else {
+	if (atom->a_builtin) {
+	    atom->a_builtin = 0;
+	    LispFreeArgList(atom->property->alist);
+	}
+	else
+	    atom->a_compiled = 0;
+	atom->a_function = 1;
+    }
+
+    atom->property->fun.function = function;
+    atom->property->alist = alist;
+}
+
+void
+LispRemAtomFunctionProperty(LispAtom *atom)
+{
+    if (atom->a_function) {
+	lisp__data.gc.immutablebits = 1;
+	atom->property->fun.function = NULL;
+	atom->a_function = 0;
+	LispFreeArgList(atom->property->alist);
+	atom->property->alist = NULL;
+    }
+}
+
+void
+LispSetAtomBuiltinProperty(LispAtom *atom, LispBuiltin *builtin,
+			   LispArgList *alist)
+{
+    if (atom->property == NOPROPERTY)
+	LispAllocAtomProperty(atom);
+
+    lisp__data.gc.immutablebits = 1;
+    if (atom->a_builtin == 0 && atom->a_function == 0)
+	atom->a_builtin = 1;
+    else {
+	if (atom->a_function) {
+	    atom->a_function = 0;
+	    LispFreeArgList(atom->property->alist);
+	}
+    }
+
+    atom->property->fun.builtin = builtin;
+    atom->property->alist = alist;
+}
+
+void
+LispRemAtomBuiltinProperty(LispAtom *atom)
+{
+    if (atom->a_builtin) {
+	lisp__data.gc.immutablebits = 1;
+	atom->property->fun.function = NULL;
+	atom->a_builtin = 0;
+	LispFreeArgList(atom->property->alist);
+	atom->property->alist = NULL;
+    }
+}
+
+void
+LispSetAtomSetfProperty(LispAtom *atom, LispObj *setf, LispArgList *alist)
+{
+    if (atom->property == NOPROPERTY)
+	LispAllocAtomProperty(atom);
+
+    lisp__data.gc.immutablebits = 1;
+    if (atom->a_defsetf)
+	LispFreeArgList(atom->property->salist);
+
+    atom->a_defsetf = 1;
+    atom->property->setf = setf;
+    atom->property->salist = alist;
+}
+
+void
+LispRemAtomSetfProperty(LispAtom *atom)
+{
+    if (atom->a_defsetf) {
+	lisp__data.gc.immutablebits = 1;
+	atom->property->setf = NULL;
+	atom->a_defsetf = 0;
+	LispFreeArgList(atom->property->salist);
+	atom->property->salist = NULL;
+    }
+}
+
+void
+LispSetAtomStructProperty(LispAtom *atom, LispObj *def, int fun)
+{
+    if (fun > 0xff)
+	/* Not suported by the bytecode compiler... */
+	LispDestroy("SET-ATOM-STRUCT-PROPERTY: "
+		    "more than 256 fields not supported");
+
+    if (atom->property == NOPROPERTY)
+	LispAllocAtomProperty(atom);
+
+    lisp__data.gc.immutablebits = 1;
+    atom->a_defstruct = 1;
+    atom->property->structure.definition = def;
+    atom->property->structure.function = fun;
+}
+
+void
+LispRemAtomStructProperty(LispAtom *atom)
+{
+    if (atom->a_defstruct) {
+	lisp__data.gc.immutablebits = 1;
+	atom->property->structure.definition = NULL;
+	atom->a_defstruct = 0;
+    }
+}
+
+LispAtom *
+LispGetAtom(char *str)
+{
+    return (LispDoGetAtom(str, 0));
+}
+
+LispAtom *
+LispGetPermAtom(char *str)
+{
+    return (LispDoGetAtom(str, 1));
+}
+
+#define GET_PROPERTY	0
+#define ADD_PROPERTY	1
+#define REM_PROPERTY	2
+static LispObj *
+LispAtomPropertyFunction(LispAtom *atom, LispObj *key, int function)
+{
+    LispObj *list = NIL, *result = NIL;
+
+    if (function == ADD_PROPERTY) {
+	if (atom->property == NOPROPERTY)
+	    LispAllocAtomProperty(atom);
+	if (atom->property->properties == NULL) {
+	    atom->a_property = 1;
+	    atom->property->properties = NIL;
+	}
+    }
+
+    if (atom->a_property) {
+	LispObj *base;
+
+	for (base = list = atom->property->properties;
+	     CONSP(list);
+	     list = CDR(list)) {
+	    if (key == CAR(list)) {
+		result = CDR(list);
+		break;
+	    }
+	    base = list;
+	    list = CDR(list);
+	    if (!CONSP(list))
+		LispDestroy("%s: %s has an odd property list length",
+			    STROBJ(atom->object),
+			    function == REM_PROPERTY ? "REMPROP" : "GET");
+	}
+	if (CONSP(list) && function == REM_PROPERTY) {
+	    if (!CONSP(CDR(list)))
+		LispDestroy("REMPROP: %s has an odd property list length",
+			    STROBJ(atom->object));
+	    if (base == list)
+		atom->property->properties = CDDR(list);
+	    else
+		RPLACD(CDR(base), CDDR(list));
+	}
+    }
+
+    if (!CONSP(list)) {
+	if (function == ADD_PROPERTY) {
+	    atom->property->properties =
+		CONS(key, CONS(NIL, atom->property->properties));
+	    result = CDR(atom->property->properties);
+	}
+    }
+    else if (function == REM_PROPERTY)
+	result = T;
+
+    return (result);
+}
+
+LispObj *
+LispGetAtomProperty(LispAtom *atom, LispObj *key)
+{
+    return (LispAtomPropertyFunction(atom, key, GET_PROPERTY));
+}
+
+LispObj *
+LispPutAtomProperty(LispAtom *atom, LispObj *key, LispObj *value)
+{
+    LispObj *result = LispAtomPropertyFunction(atom, key, ADD_PROPERTY);
+
+    RPLACA(result, value);
+
+    return (result);
+}
+
+LispObj *
+LispRemAtomProperty(LispAtom *atom, LispObj *key)
+{
+    return (LispAtomPropertyFunction(atom, key, REM_PROPERTY));
+}
+
+LispObj *
+LispReplaceAtomPropertyList(LispAtom *atom, LispObj *list)
+{
+    if (atom->property == NOPROPERTY)
+	LispAllocAtomProperty(atom);
+    if (atom->property->properties == NULL)
+	atom->a_property = 1;
+    atom->property->properties = list;
+
+    return (list);
+}
+#undef GET_PROPERTY
+#undef ADD_PROPERTY
+#undef REM_PROPERTY
+
+
+/* Used to make sure that when defining a function like:
+ *	(defun my-function (... &key key1 key2 key3 ...)
+ * key1, key2, and key3 will be in the keyword package
+ */
+static LispObj *
+LispCheckKeyword(LispObj *keyword)
+{
+    if (KEYWORDP(keyword))
+	return (keyword);
+
+    return (KEYWORD(ATOMID(keyword)));
+}
+
+void
+LispUseArgList(LispArgList *alist)
+{
+    if (alist->normals.num_symbols)
+	LispMused(alist->normals.symbols);
+    if (alist->optionals.num_symbols) {
+	LispMused(alist->optionals.symbols);
+	LispMused(alist->optionals.defaults);
+	LispMused(alist->optionals.sforms);
+    }
+    if (alist->keys.num_symbols) {
+	LispMused(alist->keys.symbols);
+	LispMused(alist->keys.defaults);
+	LispMused(alist->keys.sforms);
+	LispMused(alist->keys.keys);
+    }
+    if (alist->auxs.num_symbols) {
+	LispMused(alist->auxs.symbols);
+	LispMused(alist->auxs.initials);
+    }
+    LispMused(alist);
+}
+
+void
+LispFreeArgList(LispArgList *alist)
+{
+    if (alist->normals.num_symbols)
+	LispFree(alist->normals.symbols);
+    if (alist->optionals.num_symbols) {
+	LispFree(alist->optionals.symbols);
+	LispFree(alist->optionals.defaults);
+	LispFree(alist->optionals.sforms);
+    }
+    if (alist->keys.num_symbols) {
+	LispFree(alist->keys.symbols);
+	LispFree(alist->keys.defaults);
+	LispFree(alist->keys.sforms);
+	LispFree(alist->keys.keys);
+    }
+    if (alist->auxs.num_symbols) {
+	LispFree(alist->auxs.symbols);
+	LispFree(alist->auxs.initials);
+    }
+    LispFree(alist);
+}
+
+static LispObj *
+LispCheckNeedProtect(LispObj *object)
+{
+    if (object) {
+	switch (OBJECT_TYPE(object)) {
+	    case LispNil_t:
+	    case LispAtom_t:
+	    case LispFunction_t:
+	    case LispFixnum_t:
+	    case LispSChar_t:
+		return (NULL);
+	    default:
+		return (object);
+	}
+    }
+    return (NULL);
+}
+
+LispObj *
+LispListProtectedArguments(LispArgList *alist)
+{
+    int i;
+    GC_ENTER();
+    LispObj *arguments, *cons, *obj, *prev;
+
+    arguments = cons = prev = NIL;
+    for (i = 0; i < alist->optionals.num_symbols; i++) {
+	if ((obj = LispCheckNeedProtect(alist->optionals.defaults[i])) != NULL) {
+	    if (arguments == NIL) {
+		arguments = cons = prev = CONS(obj, NIL);
+		GC_PROTECT(arguments);
+	    }
+	    else {
+		RPLACD(cons, CONS(obj, NIL));
+		prev = cons;
+		cons = CDR(cons);
+	    }
+	}
+    }
+    for (i = 0; i < alist->keys.num_symbols; i++) {
+	if ((obj = LispCheckNeedProtect(alist->keys.defaults[i])) != NULL) {
+	    if (arguments == NIL) {
+		arguments = cons = prev = CONS(obj, NIL);
+		GC_PROTECT(arguments);
+	    }
+	    else {
+		RPLACD(cons, CONS(obj, NIL));
+		prev = cons;
+		cons = CDR(cons);
+	    }
+	}
+    }
+    for (i = 0; i < alist->auxs.num_symbols; i++) {
+	if ((obj = LispCheckNeedProtect(alist->auxs.initials[i])) != NULL) {
+	    if (arguments == NIL) {
+		arguments = cons = prev = CONS(obj, NIL);
+		GC_PROTECT(arguments);
+	    }
+	    else {
+		RPLACD(cons, CONS(obj, NIL));
+		prev = cons;
+		cons = CDR(cons);
+	    }
+	}
+    }
+    GC_LEAVE();
+
+    /* Don't add a NIL cell at the end, to save some space */
+    if (arguments != NIL) {
+	if (arguments == cons)
+	    arguments = CAR(cons);
+	else
+	    CDR(prev) = CAR(cons);
+    }
+
+    return (arguments);
+}
+
+LispArgList *
+LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin)
+{
+    static char *types[4] = {"LAMBDA-LIST", "FUNCTION", "MACRO", "SETF-METHOD"};
+    static char *fnames[4] = {"LAMBDA", "DEFUN", "DEFMACRO", "DEFSETF"};
+#define IKEY		0
+#define IOPTIONAL	1
+#define IREST		2
+#define IAUX		3
+    static char *keys[4] = {"&KEY", "&OPTIONAL", "&REST", "&AUX"};
+    int rest, optional, key, aux, count;
+    LispArgList *alist;
+    LispObj *spec, *sform, *defval, *default_value;
+    char description[8], *desc;
+
+/* If LispRealloc fails, the previous memory will be released
+ * in LispTopLevel, unless LispMused was called on the pointer */
+#define REALLOC_OBJECTS(pointer, count)		\
+    pointer = LispRealloc(pointer, (count) * sizeof(LispObj*))
+
+    alist = LispCalloc(1, sizeof(LispArgList));
+    if (!CONSP(list)) {
+	if (list != NIL)
+	    LispDestroy("%s %s: %s cannot be a %s argument list",
+			fnames[type], name, STROBJ(list), types[type]);
+	alist->description = GETATOMID("");
+
+	return (alist);
+    }
+
+    default_value = builtin ? UNSPEC : NIL;
+
+    description[0] = '\0';
+    desc = description;
+    rest = optional = key = aux = 0;
+    for (; CONSP(list); list = CDR(list)) {
+	spec = CAR(list);
+
+	if (CONSP(spec)) {
+	    if (builtin)
+		LispDestroy("builtin function argument cannot have default value");
+	    if (aux) {
+		if (!SYMBOLP(CAR(spec)) ||
+		    (CDR(spec) != NIL && CDDR(spec) != NIL))
+		    LispDestroy("%s %s: bad &AUX argument %s",
+				fnames[type], name, STROBJ(spec));
+		defval = CDR(spec) != NIL ? CADR(spec) : NIL;
+		count = alist->auxs.num_symbols;
+		REALLOC_OBJECTS(alist->auxs.symbols, count + 1);
+		REALLOC_OBJECTS(alist->auxs.initials, count + 1);
+		alist->auxs.symbols[count] = CAR(spec);
+		alist->auxs.initials[count] = defval;
+		++alist->auxs.num_symbols;
+		if (count == 0)
+		    *desc++ = 'a';
+		++alist->num_arguments;
+	    }
+	    else if (rest)
+		LispDestroy("%s %s: syntax error parsing %s",
+			    fnames[type], name, keys[IREST]);
+	    else if (key) {
+		LispObj *akey = CAR(spec);
+
+		defval = default_value;
+		sform = NULL;
+		if (CONSP(akey)) {
+		    /* check for special case, as in:
+		     *	(defun a (&key ((key name) 'default-value)) name)
+		     *	(a 'key 'test)	=> TEST
+		     *	(a)		=> DEFAULT-VALUE
+		     */
+		    if (!SYMBOLP(CAR(akey)) || !CONSP(CDR(akey)) ||
+			!SYMBOLP(CADR(akey)) || CDDR(akey) != NIL ||
+			(CDR(spec) != NIL && CDDR(spec) != NIL))
+			LispDestroy("%s %s: bad special &KEY %s",
+				    fnames[type], name, STROBJ(spec));
+		    if (CDR(spec) != NIL)
+			defval = CADR(spec);
+		    spec = CADR(akey);
+		    akey = CAR(akey);
+		}
+		else {
+		    akey = NULL;
+
+		    if (!SYMBOLP(CAR(spec)))
+			LispDestroy("%s %s: %s cannot be a %s argument name",
+				    fnames[type], name,
+				    STROBJ(CAR(spec)), types[type]);
+		    /* check if default value provided, and optionally a `svar' */
+		    else if (CDR(spec) != NIL && (!CONSP(CDR(spec)) ||
+			      (CDDR(spec) != NIL &&
+			       (!SYMBOLP(CAR(CDDR(spec))) ||
+				CDR(CDDR(spec)) != NIL))))
+			LispDestroy("%s %s: bad argument specification %s",
+				    fnames[type], name, STROBJ(spec));
+		    if (CONSP(CDR(spec))) {
+			defval = CADR(spec);
+			if (CONSP(CDDR(spec)))
+			    sform = CAR(CDDR(spec));
+		    }
+		    /* Add to keyword package, and set the keyword in the
+		     * argument list, so that a function argument keyword
+		     * will reference the same object, and make comparison
+		     * simpler. */
+		    spec = LispCheckKeyword(CAR(spec));
+		}
+
+		count = alist->keys.num_symbols;
+		REALLOC_OBJECTS(alist->keys.keys, count + 1);
+		REALLOC_OBJECTS(alist->keys.defaults, count + 1);
+		REALLOC_OBJECTS(alist->keys.sforms, count + 1);
+		REALLOC_OBJECTS(alist->keys.symbols, count + 1);
+		alist->keys.symbols[count] = spec;
+		alist->keys.defaults[count] = defval;
+		alist->keys.sforms[count] = sform;
+		alist->keys.keys[count] = akey;
+		++alist->keys.num_symbols;
+		if (count == 0)
+		    *desc++ = 'k';
+		alist->num_arguments += 1 + (sform != NULL);
+	    }
+	    else if (optional) {
+		defval = default_value;
+		sform = NULL;
+
+		if (!SYMBOLP(CAR(spec)))
+		    LispDestroy("%s %s: %s cannot be a %s argument name",
+				fnames[type], name,
+				STROBJ(CAR(spec)), types[type]);
+		/* check if default value provided, and optionally a `svar' */
+		else if (CDR(spec) != NIL && (!CONSP(CDR(spec)) ||
+			  (CDDR(spec) != NIL &&
+			   (!SYMBOLP(CAR(CDDR(spec))) ||
+			    CDR(CDDR(spec)) != NIL))))
+		    LispDestroy("%s %s: bad argument specification %s",
+				fnames[type], name, STROBJ(spec));
+		if (CONSP(CDR(spec))) {
+		    defval = CADR(spec);
+		    if (CONSP(CDDR(spec)))
+			sform = CAR(CDDR(spec));
+		}
+		spec = CAR(spec);
+
+		count = alist->optionals.num_symbols;
+		REALLOC_OBJECTS(alist->optionals.symbols, count + 1);
+		REALLOC_OBJECTS(alist->optionals.defaults, count + 1);
+		REALLOC_OBJECTS(alist->optionals.sforms, count + 1);
+		alist->optionals.symbols[count] = spec;
+		alist->optionals.defaults[count] = defval;
+		alist->optionals.sforms[count] = sform;
+		++alist->optionals.num_symbols;
+		if (count == 0)
+		    *desc++ = 'o';
+		alist->num_arguments += 1 + (sform != NULL);
+	    }
+
+	    /* Normal arguments cannot have default value */
+	    else
+		LispDestroy("%s %s: syntax error parsing %s",
+			    fnames[type], name, STROBJ(spec));
+	}
+
+	/* spec must be an atom, excluding keywords */
+	else if (!SYMBOLP(spec) || KEYWORDP(spec))
+	    LispDestroy("%s %s: %s cannot be a %s argument",
+			fnames[type], name, STROBJ(spec), types[type]);
+	else {
+	    Atom_id atom = ATOMID(spec);
+
+	    if (atom[0] == '&') {
+		if (atom == Srest) {
+		    if (rest || aux || CDR(list) == NIL || !SYMBOLP(CADR(list))
+			/* only &aux allowed after &rest */
+			|| (CDDR(list) != NIL && !SYMBOLP(CAR(CDDR(list))) &&
+			    ATOMID(CAR(CDDR(list))) != Saux))
+			LispDestroy("%s %s: syntax error parsing %s",
+				    fnames[type], name, ATOMID(spec));
+		    if (key)
+			LispDestroy("%s %s: %s not allowed after %s",
+				    fnames[type], name, keys[IREST], keys[IKEY]);
+		    rest = 1;
+		    continue;
+		}
+
+		else if (atom == Skey) {
+		    if (rest || aux)
+			LispDestroy("%s %s: %s not allowed after %s",
+				    fnames[type], name, ATOMID(spec),
+				    rest ? keys[IREST] : keys[IAUX]);
+		    key = 1;
+		    continue;
+		}
+
+		else if (atom == Soptional) {
+		    if (rest || optional || aux || key)
+			LispDestroy("%s %s: %s not allowed after %s",
+				    fnames[type], name, ATOMID(spec),
+				    rest ? keys[IREST] :
+					optional ?
+					keys[IOPTIONAL] :
+					    aux ? keys[IAUX] : keys[IKEY]);
+		    optional = 1;
+		    continue;
+		}
+
+		else if (atom == Saux) {
+		    /* &AUX must be the last keyword parameter */
+		    if (aux)
+			LispDestroy("%s %s: syntax error parsing %s",
+				    fnames[type], name, ATOMID(spec));
+		    else if (builtin)
+			LispDestroy("builtin function cannot have &AUX arguments");
+		    aux = 1;
+		    continue;
+		}
+
+		/* Untill more lambda-list keywords supported, don't allow
+		 * argument names starting with the '&' character */
+		else
+		    LispDestroy("%s %s: %s not allowed/implemented",
+				fnames[type], name, ATOMID(spec));
+	    }
+
+	    /* Add argument to alist */
+	    if (aux) {
+		count = alist->auxs.num_symbols;
+		REALLOC_OBJECTS(alist->auxs.symbols, count + 1);
+		REALLOC_OBJECTS(alist->auxs.initials, count + 1);
+		alist->auxs.symbols[count] = spec;
+		alist->auxs.initials[count] = default_value;
+		++alist->auxs.num_symbols;
+		if (count == 0)
+		    *desc++ = 'a';
+		++alist->num_arguments;
+	    }
+	    else if (rest) {
+		alist->rest = spec;
+		*desc++ = 'r';
+		++alist->num_arguments;
+	    }
+	    else if (key) {
+		/* Add to keyword package, and set the keyword in the
+		 * argument list, so that a function argument keyword
+		 * will reference the same object, and make comparison
+		 * simpler. */
+		spec = LispCheckKeyword(spec);
+		count = alist->keys.num_symbols;
+		REALLOC_OBJECTS(alist->keys.keys, count + 1);
+		REALLOC_OBJECTS(alist->keys.defaults, count + 1);
+		REALLOC_OBJECTS(alist->keys.sforms, count + 1);
+		REALLOC_OBJECTS(alist->keys.symbols, count + 1);
+		alist->keys.symbols[count] = spec;
+		alist->keys.defaults[count] = default_value;
+		alist->keys.sforms[count] = NULL;
+		alist->keys.keys[count] = NULL;
+		++alist->keys.num_symbols;
+		if (count == 0)
+		    *desc++ = 'k';
+		++alist->num_arguments;
+	    }
+	    else if (optional) {
+		count = alist->optionals.num_symbols;
+		REALLOC_OBJECTS(alist->optionals.symbols, count + 1);
+		REALLOC_OBJECTS(alist->optionals.defaults, count + 1);
+		REALLOC_OBJECTS(alist->optionals.sforms, count + 1);
+		alist->optionals.symbols[count] = spec;
+		alist->optionals.defaults[count] = default_value;
+		alist->optionals.sforms[count] = NULL;
+		++alist->optionals.num_symbols;
+		if (count == 0)
+		    *desc++ = 'o';
+		++alist->num_arguments;
+	    }
+	    else {
+		count = alist->normals.num_symbols;
+		REALLOC_OBJECTS(alist->normals.symbols, count + 1);
+		alist->normals.symbols[count] = spec;
+		++alist->normals.num_symbols;
+		if (count == 0)
+		    *desc++ = '.';
+		++alist->num_arguments;
+	    }
+	}
+    }
+
+    /* Check for dotted argument list */
+    if (list != NIL)
+	LispDestroy("%s %s: %s cannot end %s arguments",
+		    fnames[type], name, STROBJ(list), types[type]);
+
+    *desc = '\0';
+    alist->description = LispGetAtomString(description, 0);
+
+    return (alist);
+}
+
+void
+LispAddBuiltinFunction(LispBuiltin *builtin)
+{
+    static LispObj stream;
+    static LispString string;
+    static int first = 1;
+    LispObj *name, *obj, *list, *cons, *code;
+    LispAtom *atom;
+    LispArgList *alist;
+    int length = lisp__data.protect.length;
+
+    if (first) {
+	stream.type = LispStream_t;
+	stream.data.stream.source.string = &string;
+	stream.data.stream.pathname = NIL;
+	stream.data.stream.type = LispStreamString;
+	stream.data.stream.readable = 1;
+	stream.data.stream.writable = 0;
+	string.output = 0;
+	first = 0;
+    }
+    string.string = builtin->declaration;
+    string.length = strlen(builtin->declaration);
+    string.input = 0;
+
+    code = COD;
+    LispPushInput(&stream);
+    name = LispRead();
+    list = cons = CONS(name, NIL);
+    if (length + 1 >= lisp__data.protect.space)
+	LispMoreProtects();
+    lisp__data.protect.objects[lisp__data.protect.length++] = list;
+    while ((obj = LispRead()) != NULL) {
+	RPLACD(cons, CONS(obj, NIL));
+	cons = CDR(cons);
+    }
+    LispPopInput(&stream);
+
+    atom = name->data.atom;
+    alist = LispCheckArguments(builtin->type, CDR(list), atom->string, 1);
+    builtin->symbol = CAR(list);
+    LispSetAtomBuiltinProperty(atom, builtin, alist);
+    LispUseArgList(alist);
+
+    /* Make function a extern symbol, unless told to not do so */
+    if (!builtin->internal)
+	LispExportSymbol(name);
+
+    lisp__data.protect.length = length;
+    COD = code;			/* LispRead protect data in COD */
+}
+
+void
+LispAllocSeg(LispObjSeg *seg, int cellcount)
+{
+    unsigned int i;
+    LispObj **list, *obj;
+
+    DISABLE_INTERRUPTS();
+    while (seg->nfree < cellcount) {
+	if ((obj = (LispObj*)calloc(1, sizeof(LispObj) * segsize)) == NULL) {
+	    ENABLE_INTERRUPTS();
+	    LispDestroy("out of memory");
+	}
+	if ((list = (LispObj**)realloc(seg->objects,
+	    sizeof(LispObj*) * (seg->nsegs + 1))) == NULL) {
+	    free(obj);
+	    ENABLE_INTERRUPTS();
+	    LispDestroy("out of memory");
+	}
+	seg->objects = list;
+	seg->objects[seg->nsegs] = obj;
+
+	seg->nfree += segsize;
+	seg->nobjs += segsize;
+	for (i = 1; i < segsize; i++, obj++) {
+	    /* Objects of type cons are the most used, save some time
+	     * by not setting it's type in LispNewCons. */
+	    obj->type = LispCons_t;
+	    CDR(obj) = obj + 1;
+	}
+	obj->type = LispCons_t;
+	CDR(obj) = seg->freeobj;
+	seg->freeobj = seg->objects[seg->nsegs];
+	++seg->nsegs;
+    }
+#ifdef DEBUG
+    LispMessage("gc: %d cell(s) allocated at %d segment(s)",
+		seg->nobjs, seg->nsegs);
+#endif
+    ENABLE_INTERRUPTS();
+}
+
+static INLINE void
+LispMark(register LispObj *object)
+{
+mark_again:
+    switch (OBJECT_TYPE(object)) {
+	case LispNil_t:
+	case LispAtom_t:
+	case LispFixnum_t:
+	case LispSChar_t:
+	case LispFunction_t:
+	    return;
+	case LispLambda_t:
+	    if (OPAQUEP(object->data.lambda.name))
+		object->data.lambda.name->mark = 1;
+	    object->mark = 1;
+	    LispMark(object->data.lambda.data);
+	    object = object->data.lambda.code;
+	    goto mark_cons;
+	case LispQuote_t:
+	case LispBackquote_t:
+	case LispFunctionQuote_t:
+	    object->mark = 1;
+	    object = object->data.quote;
+	    goto mark_again;
+	case LispPathname_t:
+	    object->mark = 1;
+	    object = object->data.pathname;
+	    goto mark_again;
+	case LispComma_t:
+	    object->mark = 1;
+	    object = object->data.comma.eval;
+	    goto mark_again;
+	case LispComplex_t:
+	    if (POINTERP(object->data.complex.real))
+		object->data.complex.real->mark = 1;
+	    if (POINTERP(object->data.complex.imag))
+		object->data.complex.imag->mark = 1;
+	    break;
+	case LispCons_t:
+mark_cons:
+	    for (; CONSP(object) && !object->mark; object = CDR(object)) {
+		object->mark = 1;
+		switch (OBJECT_TYPE(CAR(object))) {
+		    case LispNil_t:
+		    case LispAtom_t:
+		    case LispFixnum_t:
+		    case LispSChar_t:
+		    case LispPackage_t:		/* protected in gc */
+			break;
+		    case LispInteger_t:
+		    case LispDFloat_t:
+		    case LispString_t:
+		    case LispRatio_t:
+		    case LispOpaque_t:
+		    case LispBignum_t:
+		    case LispBigratio_t:
+			CAR(object)->mark = 1;
+			break;
+		    default:
+			LispMark(CAR(object));
+			break;
+		}
+	    }
+	    if (POINTERP(object) && !object->mark)
+		goto mark_again;
+	    return;
+	case LispArray_t:
+	    LispMark(object->data.array.list);
+	    object->mark = 1;
+	    object = object->data.array.dim;
+	    goto mark_cons;
+	case LispStruct_t:
+	    object->mark = 1;
+	    object = object->data.struc.fields;
+	    goto mark_cons;
+	case LispStream_t:
+mark_stream:
+	    LispMark(object->data.stream.pathname);
+	    if (object->data.stream.type == LispStreamPipe) {
+		object->mark = 1;
+		object = object->data.stream.source.program->errorp;
+		goto mark_stream;
+	    }
+	    break;
+	case LispRegex_t:
+	    object->data.regex.pattern->mark = 1;
+	    break;
+	case LispBytecode_t:
+	    object->mark = 1;
+	    object = object->data.bytecode.code;
+	    goto mark_again;
+	case LispHashTable_t: {
+	    unsigned long i;
+	    LispHashEntry *entry = object->data.hash.table->entries,
+			  *last = entry + object->data.hash.table->num_entries;
+
+	    if (object->mark)
+		return;
+	    object->mark = 1;
+	    for (; entry < last; entry++) {
+		for (i = 0; i < entry->count; i++) {
+		    switch (OBJECT_TYPE(entry->keys[i])) {
+			case LispNil_t:
+			case LispAtom_t:
+			case LispFixnum_t:
+			case LispSChar_t:
+			case LispFunction_t:
+			case LispPackage_t:
+			    break;
+			case LispInteger_t:
+			case LispDFloat_t:
+			case LispString_t:
+			case LispRatio_t:
+			case LispOpaque_t:
+			case LispBignum_t:
+			case LispBigratio_t:
+			    entry->keys[i]->mark = 1;
+			    break;
+			default:
+			    LispMark(entry->keys[i]);
+			    break;
+		    }
+		    switch (OBJECT_TYPE(entry->values[i])) {
+			case LispNil_t:
+			case LispAtom_t:
+			case LispFixnum_t:
+			case LispSChar_t:
+			case LispFunction_t:
+			case LispPackage_t:
+			    break;
+			case LispInteger_t:
+			case LispDFloat_t:
+			case LispString_t:
+			case LispRatio_t:
+			case LispOpaque_t:
+			case LispBignum_t:
+			case LispBigratio_t:
+			    entry->values[i]->mark = 1;
+			    break;
+			default:
+			    LispMark(entry->values[i]);
+			    break;
+		    }
+		}
+	    }
+	}   return;
+	default:
+	    break;
+    }
+    object->mark = 1;
+}
+
+static INLINE void
+LispProt(register LispObj *object)
+{
+prot_again:
+    switch (OBJECT_TYPE(object)) {
+	case LispNil_t:
+	case LispAtom_t:
+	case LispFixnum_t:
+	case LispSChar_t:
+	case LispFunction_t:
+	    return;
+	case LispLambda_t:
+	    if (OPAQUEP(object->data.lambda.name))
+		object->data.lambda.name->prot = 1;
+	    object->prot = 1;
+	    LispProt(object->data.lambda.data);
+	    object = object->data.lambda.code;
+	    goto prot_cons;
+	case LispQuote_t:
+	case LispBackquote_t:
+	case LispFunctionQuote_t:
+	    object->prot = 1;
+	    object = object->data.quote;
+	    goto prot_again;
+	case LispPathname_t:
+	    object->prot = 1;
+	    object = object->data.pathname;
+	    goto prot_again;
+	case LispComma_t:
+	    object->prot = 1;
+	    object = object->data.comma.eval;
+	    goto prot_again;
+	case LispComplex_t:
+	    if (POINTERP(object->data.complex.real))
+		object->data.complex.real->prot = 1;
+	    if (POINTERP(object->data.complex.imag))
+		object->data.complex.imag->prot = 1;
+	    break;
+	case LispCons_t:
+prot_cons:
+	    for (; CONSP(object) && !object->prot; object = CDR(object)) {
+		object->prot = 1;
+		switch (OBJECT_TYPE(CAR(object))) {
+		    case LispNil_t:
+		    case LispAtom_t:
+		    case LispFixnum_t:
+		    case LispSChar_t:
+		    case LispFunction_t:
+		    case LispPackage_t:		/* protected in gc */
+			break;
+		    case LispInteger_t:
+		    case LispDFloat_t:
+		    case LispString_t:
+		    case LispRatio_t:
+		    case LispOpaque_t:
+		    case LispBignum_t:
+		    case LispBigratio_t:
+			CAR(object)->prot = 1;
+			break;
+		    default:
+			LispProt(CAR(object));
+			break;
+		}
+	    }
+	    if (POINTERP(object) && !object->prot)
+		goto prot_again;
+	    return;
+	case LispArray_t:
+	    LispProt(object->data.array.list);
+	    object->prot = 1;
+	    object = object->data.array.dim;
+	    goto prot_cons;
+	case LispStruct_t:
+	    object->prot = 1;
+	    object = object->data.struc.fields;
+	    goto prot_cons;
+	case LispStream_t:
+prot_stream:
+	    LispProt(object->data.stream.pathname);
+	    if (object->data.stream.type == LispStreamPipe) {
+		object->prot = 1;
+		object = object->data.stream.source.program->errorp;
+		goto prot_stream;
+	    }
+	    break;
+	case LispRegex_t:
+	    object->data.regex.pattern->prot = 1;
+	    break;
+	case LispBytecode_t:
+	    object->prot = 1;
+	    object = object->data.bytecode.code;
+	    goto prot_again;
+	case LispHashTable_t: {
+	    unsigned long i;
+	    LispHashEntry *entry = object->data.hash.table->entries,
+			  *last = entry + object->data.hash.table->num_entries;
+
+	    if (object->prot)
+		return;
+	    object->prot = 1;
+	    for (; entry < last; entry++) {
+		for (i = 0; i < entry->count; i++) {
+		    switch (OBJECT_TYPE(entry->keys[i])) {
+			case LispNil_t:
+			case LispAtom_t:
+			case LispFixnum_t:
+			case LispSChar_t:
+			case LispFunction_t:
+			case LispPackage_t:
+			    break;
+			case LispInteger_t:
+			case LispDFloat_t:
+			case LispString_t:
+			case LispRatio_t:
+			case LispOpaque_t:
+			case LispBignum_t:
+			case LispBigratio_t:
+			    entry->keys[i]->prot = 1;
+			    break;
+			default:
+			    LispProt(entry->keys[i]);
+			    break;
+		    }
+		    switch (OBJECT_TYPE(entry->values[i])) {
+			case LispNil_t:
+			case LispAtom_t:
+			case LispFixnum_t:
+			case LispSChar_t:
+			case LispFunction_t:
+			case LispPackage_t:
+			    break;
+			case LispInteger_t:
+			case LispDFloat_t:
+			case LispString_t:
+			case LispRatio_t:
+			case LispOpaque_t:
+			case LispBignum_t:
+			case LispBigratio_t:
+			    entry->values[i]->prot = 1;
+			    break;
+			default:
+			    LispProt(entry->values[i]);
+			    break;
+		    }
+		}
+	    }
+	}   return;
+	default:
+	    break;
+    }
+    object->prot = 1;
+}
+
+void
+LispProtect(LispObj *key, LispObj *list)
+{
+    PRO = CONS(CONS(key, list), PRO);
+}
+
+void
+LispUProtect(LispObj *key, LispObj *list)
+{
+    LispObj *prev, *obj;
+
+    for (prev = obj = PRO; obj != NIL; prev = obj, obj = CDR(obj))
+	if (CAR(CAR(obj)) == key && CDR(CAR(obj)) == list) {
+	    if (obj == PRO)
+		PRO = CDR(PRO);
+	    else
+		CDR(prev) = CDR(obj);
+	    return;
+	}
+
+    LispDestroy("no match for %s, at UPROTECT", STROBJ(key));
+}
+
+static LispObj *
+Lisp__New(LispObj *car, LispObj *cdr)
+{
+    int cellcount;
+    LispObj *obj;
+
+    Lisp__GC(car, cdr);
+#if 0
+    lisp__data.gc.average = (objseg.nfree + lisp__data.gc.average) >> 1;
+    if (lisp__data.gc.average < minfree) {
+	if (lisp__data.gc.expandbits < 6)
+	    ++lisp__data.gc.expandbits;
+    }
+    else if (lisp__data.gc.expandbits)
+	--lisp__data.gc.expandbits;
+    /* For 32 bit computers, where sizeof(LispObj) == 16,
+     * minfree is set to 1024, and expandbits limited to 6,
+     * the maximum extra memory requested here should be 1Mb
+     */
+    cellcount = minfree << lisp__data.gc.expandbits;
+#else
+    /* Try to keep at least 3 times more free cells than the de number
+     * of used cells in the freelist, to amenize the cost of the gc time,
+     * in the, currently, very simple gc strategy code. */
+    cellcount = (objseg.nobjs - objseg.nfree) * 3;
+    cellcount = cellcount + (minfree - (cellcount % minfree));
+#endif
+
+    if (objseg.freeobj == NIL || objseg.nfree < cellcount)
+	LispAllocSeg(&objseg, cellcount);
+
+    obj = objseg.freeobj;
+    objseg.freeobj = CDR(obj);
+
+    return (obj);
+}
+
+LispObj *
+LispNew(LispObj *car, LispObj *cdr)
+{
+    LispObj *obj = objseg.freeobj;
+
+    if (obj == NIL)
+	obj = Lisp__New(car, cdr);
+    else
+	objseg.freeobj = CDR(obj);
+
+    return (obj);
+}
+
+LispObj *
+LispNewAtom(char *str, int intern)
+{
+    LispObj *object;
+    LispAtom *atom = LispDoGetAtom(str, 0);
+
+    if (atom->object) {
+	if (intern && atom->package == NULL)
+	    atom->package = PACKAGE;
+
+	return (atom->object);
+    }
+
+    if (atomseg.freeobj == NIL)
+	LispAllocSeg(&atomseg, pagesize);
+    object = atomseg.freeobj;
+    atomseg.freeobj = CDR(object);
+    --atomseg.nfree;
+
+    object->type = LispAtom_t;
+    object->data.atom = atom;
+    atom->object = object;
+    if (intern)
+	atom->package = PACKAGE;
+
+    return (object);
+}
+
+LispObj *
+LispNewStaticAtom(char *str)
+{
+    LispObj *object;
+    LispAtom *atom = LispDoGetAtom(str, 1);
+
+    object = LispNewSymbol(atom);
+
+    return (object);
+}
+
+LispObj *
+LispNewSymbol(LispAtom *atom)
+{
+    if (atom->object) {
+	if (atom->package == NULL)
+	    atom->package = PACKAGE;
+
+	return (atom->object);
+    }
+    else {
+	LispObj *symbol;
+
+	if (atomseg.freeobj == NIL)
+	    LispAllocSeg(&atomseg, pagesize);
+	symbol = atomseg.freeobj;
+	atomseg.freeobj = CDR(symbol);
+	--atomseg.nfree;
+
+	symbol->type = LispAtom_t;
+	symbol->data.atom = atom;
+	atom->object = symbol;
+	atom->package = PACKAGE;
+
+	return (symbol);
+    }
+}
+
+/* function representation is created on demand and never released,
+ * even if the function is undefined and never defined again */
+LispObj *
+LispNewFunction(LispObj *symbol)
+{
+    LispObj *function;
+
+    if (symbol->data.atom->function)
+	return (symbol->data.atom->function);
+
+    if (symbol->data.atom->package == NULL)
+	symbol->data.atom->package = PACKAGE;
+
+    if (atomseg.freeobj == NIL)
+	LispAllocSeg(&atomseg, pagesize);
+    function = atomseg.freeobj;
+    atomseg.freeobj = CDR(function);
+    --atomseg.nfree;
+
+    function->type = LispFunction_t;
+    function->data.atom = symbol->data.atom;
+    symbol->data.atom->function = function;
+
+    return (function);
+}
+
+/* symbol name representation is created on demand and never released */
+LispObj *
+LispSymbolName(LispObj *symbol)
+{
+    LispObj *name;
+    LispAtom *atom = symbol->data.atom;
+
+    if (atom->name)
+	return (atom->name);
+
+    if (atomseg.freeobj == NIL)
+	LispAllocSeg(&atomseg, pagesize);
+    name = atomseg.freeobj;
+    atomseg.freeobj = CDR(name);
+    --atomseg.nfree;
+
+    name->type = LispString_t;
+    THESTR(name) = atom->string;
+    STRLEN(name) = strlen(atom->string);
+    name->data.string.writable = 0;
+    atom->name = name;
+
+    return (name);
+}
+
+LispObj *
+LispNewFunctionQuote(LispObj *object)
+{
+    LispObj *quote = LispNew(object, NIL);
+
+    quote->type = LispFunctionQuote_t;
+    quote->data.quote = object;
+
+    return (quote);
+}
+
+LispObj *
+LispNewDFloat(double value)
+{
+    LispObj *dfloat = objseg.freeobj;
+
+    if (dfloat == NIL)
+	dfloat = Lisp__New(NIL, NIL);
+    else
+	objseg.freeobj = CDR(dfloat);
+
+    dfloat->type = LispDFloat_t;
+    dfloat->data.dfloat = value;
+
+    return (dfloat);
+}
+
+LispObj *
+LispNewString(char *str, long length, int alloced)
+{
+    char *cstring;
+    LispObj *string = objseg.freeobj;
+
+    if (string == NIL)
+	string = Lisp__New(NIL, NIL);
+    else
+	objseg.freeobj = CDR(string);
+
+    if (alloced)
+	cstring = str;
+    else {
+	cstring = LispMalloc(length + 1);
+	memcpy(cstring, str, length);
+	cstring[length] = '\0';
+    }
+    LispMused(cstring);
+    string->type = LispString_t;
+    THESTR(string) = cstring;
+    STRLEN(string) = length;
+    string->data.string.writable = 1;
+
+    return (string);
+}
+
+LispObj *
+LispNewComplex(LispObj *realpart, LispObj *imagpart)
+{
+    LispObj *complexp = objseg.freeobj;
+
+    if (complexp == NIL)
+	complexp = Lisp__New(realpart, imagpart);
+    else
+	objseg.freeobj = CDR(complexp);
+
+    complexp->type = LispComplex_t;
+    complexp->data.complex.real = realpart;
+    complexp->data.complex.imag = imagpart;
+
+    return (complexp);
+}
+
+LispObj *
+LispNewInteger(long integer)
+{
+    if (integer > MOST_POSITIVE_FIXNUM || integer < MOST_NEGATIVE_FIXNUM) {
+	LispObj *object = objseg.freeobj;
+
+	if (object == NIL)
+	    object = Lisp__New(NIL, NIL);
+	else
+	    objseg.freeobj = CDR(object);
+
+	object->type = LispInteger_t;
+	object->data.integer = integer;
+
+	return (object);
+    }
+    return (FIXNUM(integer));
+}
+
+LispObj *
+LispNewRatio(long num, long den)
+{
+    LispObj *ratio = objseg.freeobj;
+
+    if (ratio == NIL)
+	ratio = Lisp__New(NIL, NIL);
+    else
+	objseg.freeobj = CDR(ratio);
+
+    ratio->type = LispRatio_t;
+    ratio->data.ratio.numerator = num;
+    ratio->data.ratio.denominator = den;
+
+    return (ratio);
+}
+
+LispObj *
+LispNewVector(LispObj *objects)
+{
+    GC_ENTER();
+    long count;
+    LispObj *array, *dimension;
+
+    for (count = 0, array = objects; CONSP(array); count++, array = CDR(array))
+	;
+
+    GC_PROTECT(objects);
+    dimension = CONS(FIXNUM(count), NIL);
+    array = LispNew(objects, dimension);
+    array->type = LispArray_t;
+    array->data.array.list = objects;
+    array->data.array.dim = dimension;
+    array->data.array.rank = 1;
+    array->data.array.type = LispNil_t;
+    array->data.array.zero = count == 0;
+    GC_LEAVE();
+
+    return (array);
+}
+
+LispObj *
+LispNewQuote(LispObj *object)
+{
+    LispObj *quote = LispNew(object, NIL);
+
+    quote->type = LispQuote_t;
+    quote->data.quote = object;
+
+    return (quote);
+}
+
+LispObj *
+LispNewBackquote(LispObj *object)
+{
+    LispObj *backquote = LispNew(object, NIL);
+
+    backquote->type = LispBackquote_t;
+    backquote->data.quote = object;
+
+    return (backquote);
+}
+
+LispObj *
+LispNewComma(LispObj *object, int atlist)
+{
+    LispObj *comma = LispNew(object, NIL);
+
+    comma->type = LispComma_t;
+    comma->data.comma.eval = object;
+    comma->data.comma.atlist = atlist;
+
+    return (comma);
+}
+
+LispObj *
+LispNewCons(LispObj *car, LispObj *cdr)
+{
+    LispObj *cons = objseg.freeobj;
+
+    if (cons == NIL)
+	cons = Lisp__New(car, cdr);
+    else
+	objseg.freeobj = CDR(cons);
+
+    CAR(cons) = car;
+    CDR(cons) = cdr;
+
+    return (cons);
+}
+
+LispObj *
+LispNewLambda(LispObj *name, LispObj *code, LispObj *data, LispFunType type)
+{
+    LispObj *fun = LispNew(data, code);
+
+    fun->type = LispLambda_t;
+    fun->funtype = type;
+    fun->data.lambda.name = name;
+    fun->data.lambda.code = code;
+    fun->data.lambda.data = data;
+
+    return (fun);
+}
+
+LispObj *
+LispNewStruct(LispObj *fields, LispObj *def)
+{
+    LispObj *struc = LispNew(fields, def);
+
+    struc->type = LispStruct_t;
+    struc->data.struc.fields = fields;
+    struc->data.struc.def = def;
+
+    return (struc);
+}
+
+LispObj *
+LispNewOpaque(void *data, int type)
+{
+    LispObj *opaque = LispNew(NIL, NIL);
+
+    opaque->type = LispOpaque_t;
+    opaque->data.opaque.data = data;
+    opaque->data.opaque.type = type;
+
+    return (opaque);
+}
+
+/* string argument must be static, or allocated */
+LispObj *
+LispNewKeyword(char *string)
+{
+    LispObj *keyword;
+
+    if (PACKAGE != lisp__data.keyword) {
+	LispObj *savepackage;
+	LispPackage *savepack;
+
+	/* Save package environment */
+	savepackage = PACKAGE;
+	savepack = lisp__data.pack;
+
+	/* Change package environment */
+	PACKAGE = lisp__data.keyword;
+	lisp__data.pack = lisp__data.key;
+
+	/* Create symbol in keyword package */
+	keyword = LispNewStaticAtom(string);
+
+	/* Restore package environment */
+	PACKAGE = savepackage;
+	lisp__data.pack = savepack;
+    }
+    else
+	/* Just create symbol in keyword package */
+	keyword = LispNewStaticAtom(string);
+
+    /* Export keyword symbol */
+    LispExportSymbol(keyword);
+
+    /* All keywords are constants */
+    keyword->data.atom->constant = 1;
+
+    /* XXX maybe should bound the keyword to itself, but that would
+     * require allocating a LispProperty structure for every keyword */
+
+    return (keyword);
+}
+
+LispObj *
+LispNewPathname(LispObj *obj)
+{
+    LispObj *path = LispNew(obj, NIL);
+
+    path->type = LispPathname_t;
+    path->data.pathname = obj;
+
+    return (path);
+}
+
+LispObj *
+LispNewStringStream(char *string, int flags, long length, int alloced)
+{
+    LispObj *stream = LispNew(NIL, NIL);
+
+    SSTREAMP(stream) = LispCalloc(1, sizeof(LispString));
+    if (alloced)
+	SSTREAMP(stream)->string = string;
+    else {
+	SSTREAMP(stream)->string = LispMalloc(length + 1);
+	memcpy(SSTREAMP(stream)->string, string, length);
+	SSTREAMP(stream)->string[length] = '\0';
+    }
+
+    stream->type = LispStream_t;
+
+    SSTREAMP(stream)->length = length;
+    LispMused(SSTREAMP(stream));
+    LispMused(SSTREAMP(stream)->string);
+    stream->data.stream.type = LispStreamString;
+    stream->data.stream.readable = (flags & STREAM_READ) != 0;
+    stream->data.stream.writable = (flags & STREAM_WRITE) != 0;
+    SSTREAMP(stream)->space = length + 1;
+
+    stream->data.stream.pathname = NIL;
+
+    return (stream);
+}
+
+LispObj *
+LispNewFileStream(LispFile *file, LispObj *path, int flags)
+{
+    LispObj *stream = LispNew(NIL, NIL);
+
+    stream->type = LispStream_t;
+    FSTREAMP(stream) = file;
+    stream->data.stream.pathname = path;
+    stream->data.stream.type = LispStreamFile;
+    stream->data.stream.readable = (flags & STREAM_READ) != 0;
+    stream->data.stream.writable = (flags & STREAM_WRITE) != 0;
+
+    return (stream);
+}
+
+LispObj *
+LispNewPipeStream(LispPipe *program, LispObj *path, int flags)
+{
+    LispObj *stream = LispNew(NIL, NIL);
+
+    stream->type = LispStream_t;
+    PSTREAMP(stream) = program;
+    stream->data.stream.pathname = path;
+    stream->data.stream.type = LispStreamPipe;
+    stream->data.stream.readable = (flags & STREAM_READ) != 0;
+    stream->data.stream.writable = (flags & STREAM_WRITE) != 0;
+
+    return (stream);
+}
+
+LispObj *
+LispNewStandardStream(LispFile *file, LispObj *description, int flags)
+{
+    LispObj *stream = LispNew(NIL, NIL);
+
+    stream->type = LispStream_t;
+    FSTREAMP(stream) = file;
+    stream->data.stream.pathname = description;
+    stream->data.stream.type = LispStreamStandard;
+    stream->data.stream.readable = (flags & STREAM_READ) != 0;
+    stream->data.stream.writable = (flags & STREAM_WRITE) != 0;
+
+    return (stream);
+}
+
+LispObj *
+LispNewBignum(mpi *bignum)
+{
+    LispObj *integer = LispNew(NIL, NIL);
+
+    integer->type = LispBignum_t;
+    integer->data.mp.integer = bignum;
+    LispMused(bignum->digs);
+    LispMused(bignum);
+
+    return (integer);
+}
+
+LispObj *
+LispNewBigratio(mpr *bigratio)
+{
+    LispObj *ratio = LispNew(NIL, NIL);
+
+    ratio->type = LispBigratio_t;
+    ratio->data.mp.ratio = bigratio;
+    LispMused(mpr_num(bigratio)->digs);
+    LispMused(mpr_den(bigratio)->digs);
+    LispMused(bigratio);
+
+    return (ratio);
+}
+
+/* name must be of type LispString_t */
+LispObj *
+LispNewPackage(LispObj *name, LispObj *nicknames)
+{
+    LispObj *package = LispNew(name, nicknames);
+    LispPackage *pack = LispCalloc(1, sizeof(LispPackage));
+
+    package->type = LispPackage_t;
+    package->data.package.name = name;
+    package->data.package.nicknames = nicknames;
+    package->data.package.package = pack;
+
+    LispMused(pack);
+
+    return (package);
+}
+
+LispObj *
+LispSymbolFunction(LispObj *symbol)
+{
+    LispAtom *atom = symbol->data.atom;
+
+    if ((atom->a_builtin &&
+	 atom->property->fun.builtin->type == LispFunction) ||
+	(atom->a_function &&
+	 atom->property->fun.function->funtype == LispFunction) ||
+	(atom->a_defstruct &&
+	 atom->property->structure.function != STRUCT_NAME) ||
+	/* XXX currently bytecode is only generated for functions */
+	atom->a_compiled)
+	symbol = FUNCTION(symbol);
+    else
+	LispDestroy("SYMBOL-FUNCTION: %s is not a function", STROBJ(symbol));
+
+    return (symbol);
+}
+
+
+static INLINE LispObj *
+LispGetVarPack(LispObj *symbol)
+{
+    int ii;
+    char *string;
+    LispAtom *atom;
+    LispProperty *property;
+
+    string = ATOMID(symbol);
+    property = symbol->data.atom->property;
+    ii = STRHASH(string);
+
+    atom = lisp__data.pack->atoms[ii];
+    while (atom) {
+	if (strcmp(atom->string, string) == 0)
+	    return (atom->object);
+
+	atom = atom->next;
+    }
+
+    /* Symbol not found, just import it */
+    return (NULL);
+}
+
+/* package must be of type LispPackage_t */
+void
+LispUsePackage(LispObj *package)
+{
+    unsigned i;
+    LispAtom *atom;
+    LispPackage *pack;
+    LispObj **pentry, **eentry;
+
+    /* Already using its own symbols... */
+    if (package == PACKAGE)
+	return;
+
+    /* Check if package not already in use-package list */
+    for (pentry = lisp__data.pack->use.pairs,
+	 eentry = pentry + lisp__data.pack->use.length;
+	 pentry < eentry; pentry++)
+	if (*pentry == package)
+	return;
+
+    /* Remember this package is in the use-package list */
+    if (lisp__data.pack->use.length + 1 >= lisp__data.pack->use.space) {
+	LispObj **pairs = realloc(lisp__data.pack->use.pairs,
+				  (lisp__data.pack->use.space + 1) *
+				  sizeof(LispObj*));
+
+	if (pairs == NULL)
+	    LispDestroy("out of memory");
+
+	lisp__data.pack->use.pairs = pairs;
+	++lisp__data.pack->use.space;
+    }
+    lisp__data.pack->use.pairs[lisp__data.pack->use.length++] = package;
+
+    /* Import all extern symbols from package */
+    pack = package->data.package.package;
+
+    /* Traverse atom list, searching for extern symbols */
+    for (i = 0; i < STRTBLSZ; i++) {
+	atom = pack->atoms[i];
+	while (atom) {
+	    if (atom->ext)
+		LispImportSymbol(atom->object);
+	    atom = atom->next;
+	}
+    }
+}
+
+/* symbol must be of type LispAtom_t */
+void
+LispImportSymbol(LispObj *symbol)
+{
+    int increment;
+    LispAtom *atom;
+    LispObj *current;
+
+    current = LispGetVarPack(symbol);
+    if (current == NULL || current->data.atom->property == NOPROPERTY) {
+	/* No conflicts */
+
+	if (symbol->data.atom->a_object) {
+	    /* If it is a bounded variable */
+	    if (lisp__data.pack->glb.length + 1 >= lisp__data.pack->glb.space)
+		LispMoreGlobals(lisp__data.pack);
+	    lisp__data.pack->glb.pairs[lisp__data.pack->glb.length++] = symbol;
+	}
+
+	/* Create copy of atom in current package */
+	atom = LispDoGetAtom(ATOMID(symbol), 0);
+	/*   Need to create a copy because if anything new is atached to the
+	 * property, the current package is the owner, not the previous one. */
+
+	/* And reference the same properties */
+	atom->property = symbol->data.atom->property;
+
+	increment = 1;
+    }
+    else if (current->data.atom->property != symbol->data.atom->property) {
+	/* Symbol already exists in the current package,
+	 * but does not reference the same variable */
+	LispContinuable("Symbol %s already defined in package %s. Redefine?",
+			ATOMID(symbol), THESTR(PACKAGE->data.package.name));
+
+	atom = current->data.atom;
+
+	/* Continued from error, redefine variable */
+	LispDecrementAtomReference(atom);
+	atom->property = symbol->data.atom->property;
+	
+	atom->a_object = atom->a_function = atom->a_builtin =
+	    atom->a_property = atom->a_defsetf = atom->a_defstruct = 0;
+
+	increment = 1;
+    }
+    else {
+	/* Symbol is already available in the current package, just update */
+	atom = current->data.atom;
+
+	increment = 0;
+    }
+
+    /* If importing an important system variable */
+    atom->watch = symbol->data.atom->watch;
+
+    /* Update constant flag */
+    atom->constant = symbol->data.atom->constant;
+
+    /* Set home-package and unique-atom associated with symbol */
+    atom->package = symbol->data.atom->package;
+    atom->object = symbol->data.atom->object;
+
+    if (symbol->data.atom->a_object)
+	atom->a_object = 1;
+    if (symbol->data.atom->a_function)
+	atom->a_function = 1;
+    else if (symbol->data.atom->a_builtin)
+	atom->a_builtin = 1;
+    else if (symbol->data.atom->a_compiled)
+	atom->a_compiled = 1;
+    if (symbol->data.atom->a_property)
+	atom->a_property = 1;
+    if (symbol->data.atom->a_defsetf)
+	atom->a_defsetf = 1;
+    if (symbol->data.atom->a_defstruct)
+	atom->a_defstruct = 1;
+
+    if (increment)
+	/* Increase reference count, more than one package using the symbol */
+	LispIncrementAtomReference(symbol->data.atom);
+}
+
+/* symbol must be of type LispAtom_t */
+void
+LispExportSymbol(LispObj *symbol)
+{
+    /* This does not automatically export symbols to another package using
+     * the symbols of the current package */
+    symbol->data.atom->ext = 1;
+}
+
+#ifdef __GNUC__
+LispObj *
+LispGetVar(LispObj *atom)
+{
+    return (LispDoGetVar(atom));
+}
+
+static INLINE LispObj *
+LispDoGetVar(LispObj *atom)
+#else
+#define LispDoGetVar LispGetVar
+LispObj *
+LispGetVar(LispObj *atom)
+#endif
+{
+    LispAtom *name;
+    int i, base, offset;
+    Atom_id id;
+
+    name = atom->data.atom;
+    if (name->constant && name->package == lisp__data.keyword)
+	return (atom);
+
+    /* XXX offset should be stored elsewhere, it is unique, like the string
+     * pointer. Unless a multi-thread interface is implemented (where
+     * multiple stacks would be required, the offset value should be
+     * stored with the string, so that a few cpu cicles could be saved
+     * by initializing the value to -1, and only searching for the symbol
+     * binding if it is not -1, and if no binding is found, because the
+     * lexical scope was left, reset offset to -1. */
+    offset = name->offset;
+    id = name->string;
+    base = lisp__data.env.lex;
+    i = lisp__data.env.head - 1;
+
+    if (offset <= i && (offset >= base || name->dyn) &&
+	lisp__data.env.names[offset] == id)
+	return (lisp__data.env.values[offset]);
+
+    for (; i >= base; i--)
+	if (lisp__data.env.names[i] == id) {
+	    name->offset = i;
+
+	    return (lisp__data.env.values[i]);
+	}
+
+    if (name->dyn) {
+	/* Keep searching as maybe a rebound dynamic variable */
+	for (; i >= 0; i--)
+	    if (lisp__data.env.names[i] == id) {
+		name->offset = i;
+
+	    return (lisp__data.env.values[i]);
+	}
+
+	if (name->a_object) {
+	    /* Check for a symbol defined as special, but not yet bound. */
+	    if (name->property->value == UNBOUND)
+		return (NULL);
+
+	    return (name->property->value);
+	}
+    }
+
+    return (name->a_object ? name->property->value : NULL);
+}
+
+#ifdef DEBUGGER
+/* Same code as LispDoGetVar, but returns the address of the pointer to
+ * the object value. Used only by the debugger */
+void *
+LispGetVarAddr(LispObj *atom)
+{
+    LispAtom *name;
+    int i, base;
+    Atom_id id;
+
+    name = atom->data.atom;
+    if (name->constant && name->package == lisp__data.keyword)
+	return (&atom);
+
+    id = name->string;
+
+    i = lisp__data.env.head - 1;
+    for (base = lisp__data.env.lex; i >= base; i--)
+	if (lisp__data.env.names[i] == id)
+	    return (&(lisp__data.env.values[i]));
+
+    if (name->dyn) {
+	for (; i >= 0; i--)
+	    if (lisp__data.env.names[i] == id)
+		return (&(lisp__data.env.values[i]));
+
+	if (name->a_object) {
+	    /* Check for a symbol defined as special, but not yet bound */
+	    if (name->property->value == UNBOUND)
+		return (NULL);
+
+	    return (&(name->property->value));
+	}
+    }
+
+    return (name->a_object ? &(name->property->value) : NULL);
+}
+#endif
+
+/* Only removes global variables. To be called by makunbound
+ * Local variables are unbounded once their block is closed anyway.
+ */
+void
+LispUnsetVar(LispObj *atom)
+{
+    LispAtom *name = atom->data.atom;
+
+    if (name->package) {
+	int i;
+	LispPackage *pack = name->package->data.package.package;
+
+	for (i = pack->glb.length - 1; i > 0; i--)
+	    if (pack->glb.pairs[i] == atom) {
+		LispRemAtomObjectProperty(name);
+		--pack->glb.length;
+		if (i < pack->glb.length)
+		    memmove(pack->glb.pairs + i, pack->glb.pairs + i + 1,
+			    sizeof(LispObj*) * (pack->glb.length - i));
+
+		/* unset hint about dynamically binded variable */
+		if (name->dyn)
+		    name->dyn = 0;
+		break;
+	    }
+    }
+}
+
+LispObj *
+LispAddVar(LispObj *atom, LispObj *obj)
+{
+    if (lisp__data.env.length >= lisp__data.env.space)
+	LispMoreEnvironment();
+
+    LispDoAddVar(atom, obj);
+
+    return (obj);
+}
+
+static INLINE void
+LispDoAddVar(LispObj *symbol, LispObj *value)
+{
+    LispAtom *atom = symbol->data.atom;
+
+    atom->offset = lisp__data.env.length;
+    lisp__data.env.values[lisp__data.env.length] = value;
+    lisp__data.env.names[lisp__data.env.length++] = atom->string;
+}
+
+LispObj *
+LispSetVar(LispObj *atom, LispObj *obj)
+{
+    LispPackage *pack;
+    LispAtom *name;
+    int i, base, offset;
+    Atom_id id;
+
+    name = atom->data.atom;
+    offset = name->offset;
+    id = name->string;
+    base = lisp__data.env.lex;
+    i = lisp__data.env.head - 1;
+
+    if (offset <= i && (offset >= base || name->dyn) &&
+	lisp__data.env.names[offset] == id)
+	return (lisp__data.env.values[offset] = obj);
+
+    for (; i >= base; i--)
+	if (lisp__data.env.names[i] == id) {
+	    name->offset = i;
+
+	    return (lisp__data.env.values[i] = obj);
+	}
+
+    if (name->dyn) {
+	for (; i >= 0; i--)
+	    if (lisp__data.env.names[i] == id)
+		return (lisp__data.env.values[i] = obj);
+
+	if (name->watch) {
+	    LispSetAtomObjectProperty(name, obj);
+
+	    return (obj);
+	}
+
+	return (SETVALUE(name, obj));
+    }
+
+    if (name->a_object) {
+	if (name->watch) {
+	    LispSetAtomObjectProperty(name, obj);
+
+	    return (obj);
+	}
+
+	return (SETVALUE(name, obj));
+    }
+
+    LispSetAtomObjectProperty(name, obj);
+
+    pack = name->package->data.package.package;
+    if (pack->glb.length >= pack->glb.space)
+	LispMoreGlobals(pack);
+
+    pack->glb.pairs[pack->glb.length++] = atom;
+
+    return (obj);
+}
+
+void
+LispProclaimSpecial(LispObj *atom, LispObj *value, LispObj *doc)
+{
+    int i = 0, dyn, glb;
+    LispAtom *name;
+    LispPackage *pack;
+
+    glb = 0;
+    name = atom->data.atom;
+    pack = name->package->data.package.package;
+    dyn = name->dyn;
+
+    if (!dyn) {
+	/* Note: don't check if a local variable already is using the symbol */
+	for (i = pack->glb.length - 1; i >= 0; i--)
+	    if (pack->glb.pairs[i] == atom) {
+		glb = 1;
+		break;
+	    }
+    }
+
+    if (dyn) {
+	if (name->property->value == UNBOUND && value)
+	    /* if variable was just made special, but not bounded */
+	    LispSetAtomObjectProperty(name, value);
+    }
+    else if (glb)
+	/* Already a global variable, but not marked as special.
+	 * Set hint about dynamically binded variable. */
+	name->dyn = 1;
+    else {
+	/* create new special variable */
+	LispSetAtomObjectProperty(name, value ? value : UNBOUND);
+
+	if (pack->glb.length >= pack->glb.space)
+	    LispMoreGlobals(pack);
+
+	pack->glb.pairs[pack->glb.length] = atom;
+	++pack->glb.length;
+	/* set hint about possibly dynamically binded variable */
+	name->dyn = 1;
+    }
+
+    if (doc != NIL)
+	LispAddDocumentation(atom, doc, LispDocVariable);
+}
+
+void
+LispDefconstant(LispObj *atom, LispObj *value, LispObj *doc)
+{
+    int i;
+    LispAtom *name = atom->data.atom;
+    LispPackage *pack = name->package->data.package.package;
+
+    /* Unset hint about dynamically binded variable, if set. */
+    name->dyn = 0;
+
+    /* Check if variable is bounded as a global variable */
+    for (i = pack->glb.length - 1; i >= 0; i--)
+	if (pack->glb.pairs[i] == atom)
+	    break;
+
+    if (i < 0) {
+	/* Not a global variable */
+	if (pack->glb.length >= pack->glb.space)
+	    LispMoreGlobals(pack);
+
+	pack->glb.pairs[pack->glb.length] = atom;
+	++pack->glb.length;
+    }
+
+    /* If already a constant variable */
+    if (name->constant && name->a_object && name->property->value != value)
+	LispWarning("constant %s is being redefined", STROBJ(atom));
+    else
+	name->constant = 1;
+
+    /* Set constant value */
+    LispSetAtomObjectProperty(name, value);
+
+    if (doc != NIL)
+	LispAddDocumentation(atom, doc, LispDocVariable);
+}
+
+void
+LispAddDocumentation(LispObj *symbol, LispObj *documentation, LispDocType_t type)
+{
+    int length;
+    char *string;
+    LispAtom *atom;
+    LispObj *object;
+
+    if (!SYMBOLP(symbol) || !STRINGP(documentation))
+	LispDestroy("DOCUMENTATION: invalid argument");
+
+    atom = symbol->data.atom;
+    if (atom->documentation[type])
+	LispRemDocumentation(symbol, type);
+
+    /* allocate documentation in atomseg */
+    if (atomseg.freeobj == NIL)
+	LispAllocSeg(&atomseg, pagesize);
+    length = STRLEN(documentation);
+    string = LispMalloc(length);
+    memcpy(string, THESTR(documentation), length);
+    string[length] = '\0';
+    object = atomseg.freeobj;
+    atomseg.freeobj = CDR(object);
+    --atomseg.nfree;
+
+    object->type = LispString_t;
+    THESTR(object) = string;
+    STRLEN(object) = length;
+    object->data.string.writable = 0;
+    atom->documentation[type] = object;
+    LispMused(string);
+}
+
+void
+LispRemDocumentation(LispObj *symbol, LispDocType_t type)
+{
+    LispAtom *atom;
+
+    if (!SYMBOLP(symbol))
+	LispDestroy("DOCUMENTATION: invalid argument");
+
+    atom = symbol->data.atom;
+    if (atom->documentation[type]) {
+	/* reclaim object to atomseg */
+	free(THESTR(atom->documentation[type]));
+	CDR(atom->documentation[type]) = atomseg.freeobj;
+	atomseg.freeobj = atom->documentation[type];
+	atom->documentation[type] = NULL;
+	++atomseg.nfree;
+    }
+}
+
+LispObj *
+LispGetDocumentation(LispObj *symbol, LispDocType_t type)
+{
+    LispAtom *atom;
+
+    if (!SYMBOLP(symbol))
+	LispDestroy("DOCUMENTATION: invalid argument");
+
+    atom = symbol->data.atom;
+
+    return (atom->documentation[type] ? atom->documentation[type] : NIL);
+}
+
+LispObj *
+LispReverse(LispObj *list)
+{
+    LispObj *tmp, *res = NIL;
+
+    while (list != NIL) {
+	tmp = CDR(list);
+	CDR(list) = res;
+	res = list;
+	list = tmp;
+    }
+
+    return (res);
+}
+
+LispBlock *
+LispBeginBlock(LispObj *tag, LispBlockType type)
+{
+    LispBlock *block;
+    unsigned blevel = lisp__data.block.block_level + 1;
+
+    if (blevel > lisp__data.block.block_size) {
+	LispBlock **blk;
+
+	if (blevel > MAX_STACK_DEPTH)
+	    LispDestroy("stack overflow");
+
+	DISABLE_INTERRUPTS();
+	blk = realloc(lisp__data.block.block, sizeof(LispBlock*) * (blevel + 1));
+
+	block = NULL;
+	if (blk == NULL || (block = malloc(sizeof(LispBlock))) == NULL) {
+	    ENABLE_INTERRUPTS();
+	    LispDestroy("out of memory");
+	}
+	lisp__data.block.block = blk;
+	lisp__data.block.block[lisp__data.block.block_size] = block;
+	lisp__data.block.block_size = blevel;
+	ENABLE_INTERRUPTS();
+    }
+    block = lisp__data.block.block[lisp__data.block.block_level];
+    if (type == LispBlockCatch && !CONSTANTP(tag)) {
+	tag = EVAL(tag);
+	lisp__data.protect.objects[lisp__data.protect.length++] = tag;
+    }
+    block->type = type;
+    block->tag = tag;
+    block->stack = lisp__data.stack.length;
+    block->protect = lisp__data.protect.length;
+    block->block_level = lisp__data.block.block_level;
+
+    lisp__data.block.block_level = blevel;
+
+#ifdef DEBUGGER
+    if (lisp__data.debugging) {
+	block->debug_level = lisp__data.debug_level;
+	block->debug_step = lisp__data.debug_step;
+    }
+#endif
+
+    return (block);
+}
+
+void
+LispEndBlock(LispBlock *block)
+{
+    lisp__data.protect.length = block->protect;
+    lisp__data.block.block_level = block->block_level;
+
+#ifdef DEBUGGER
+    if (lisp__data.debugging) {
+	if (lisp__data.debug_level >= block->debug_level) {
+	    while (lisp__data.debug_level > block->debug_level) {
+		DBG = CDR(DBG);
+		--lisp__data.debug_level;
+	    }
+	}
+	lisp__data.debug_step = block->debug_step;
+    }
+#endif
+}
+
+void
+LispBlockUnwind(LispBlock *block)
+{
+    LispBlock *unwind;
+    int blevel = lisp__data.block.block_level;
+
+    while (blevel > 0) {
+	unwind = lisp__data.block.block[--blevel];
+	if (unwind->type == LispBlockProtect) {
+	    BLOCKJUMP(unwind);
+	}
+	if (unwind == block)
+	    /* jump above unwind block */
+	    break;
+    }
+}
+
+static LispObj *
+LispEvalBackquoteObject(LispObj *argument, int list, int quote)
+{
+    LispObj *result = argument, *object;
+
+    if (!POINTERP(argument))
+	return (argument);
+
+    else if (XCOMMAP(argument)) {
+	/* argument may need to be evaluated */
+
+	int atlist;
+
+	if (!list && argument->data.comma.atlist)
+	    /* cannot append, not in a list */
+	    LispDestroy("EVAL: ,@ only allowed on lists");
+
+	--quote;
+	if (quote < 0)
+	    LispDestroy("EVAL: comma outside of backquote");
+
+	result = object = argument->data.comma.eval;
+	atlist = COMMAP(object) && object->data.comma.atlist;
+
+	if (POINTERP(result) && (XCOMMAP(result) || XBACKQUOTEP(result)))
+	    /* nested commas, reduce 1 level, or backquote,
+	     * don't call LispEval or quote argument will be reset */
+	    result = LispEvalBackquoteObject(object, 0, quote);
+
+	else if (quote == 0)
+	   /* just evaluate it */
+	    result = EVAL(result);
+
+	if (quote != 0)
+	    result = result == object ? argument : COMMA(result, atlist);
+    }
+
+    else if (XBACKQUOTEP(argument)) {
+	object = argument->data.quote;
+
+	result = LispEvalBackquote(object, quote + 1);
+	if (quote)
+	    result = result == object ? argument : BACKQUOTE(result);
+    }
+
+    else if (XQUOTEP(argument) && POINTERP(argument->data.quote) &&
+	     (XCOMMAP(argument->data.quote) ||
+	      XBACKQUOTEP(argument->data.quote) ||
+	      XCONSP(argument->data.quote))) {
+	/* ensures `',sym to be the same as `(quote ,sym) */
+	object = argument->data.quote;
+
+	result = LispEvalBackquote(argument->data.quote, quote);
+	result = result == object ? argument : QUOTE(result);
+    }
+
+    return (result);
+}
+
+LispObj *
+LispEvalBackquote(LispObj *argument, int quote)
+{
+    int protect;
+    LispObj *result, *object, *cons, *cdr;
+
+    if (!CONSP(argument))
+	return (LispEvalBackquoteObject(argument, 0, quote));
+
+    result = cdr = NIL;
+    protect = lisp__data.protect.length;
+
+    /* always generate a new list for the result, even if nothing
+     * is evaluated. It is not expected to use backqoutes when
+     * not required. */
+
+    /* reserve a GC protected slot for the result */
+    if (protect + 1 >= lisp__data.protect.space)
+	LispMoreProtects();
+    lisp__data.protect.objects[lisp__data.protect.length++] = NIL;
+
+    for (cons = argument; ; cons = CDR(cons)) {
+	/* if false, last argument, and if cons is not NIL, a dotted list */
+	int list = CONSP(cons), insert;
+
+	if (list)
+	    object = CAR(cons);
+	else
+	    object = cons;
+
+	if (COMMAP(object))
+	    /* need to insert list elements in result, not just cons it? */
+	    insert = object->data.comma.atlist;
+	else
+	    insert = 0;
+
+	/* evaluate object, if required */
+	if (CONSP(object))
+	    object = LispEvalBackquote(object, quote);
+	else
+	    object = LispEvalBackquoteObject(object, insert, quote);
+
+	if (result == NIL) {
+	    /* if starting result list */
+	    if (!insert) {
+		if (list)
+		    result = cdr = CONS(object, NIL);
+		else
+		    result = cdr = object;
+		/* gc protect result */
+		lisp__data.protect.objects[protect] = result;
+	    }
+	    else {
+		if (!CONSP(object)) {
+		    result = cdr = object;
+		    /* gc protect result */
+		    lisp__data.protect.objects[protect] = result;
+		}
+		else {
+		    result = cdr = CONS(CAR(object), NIL);
+		    /* gc protect result */
+		    lisp__data.protect.objects[protect] = result;
+
+		    /* add remaining elements to result */
+		    for (object = CDR(object);
+			 CONSP(object);
+			 object = CDR(object)) {
+			RPLACD(cdr, CONS(CAR(object), NIL));
+			cdr = CDR(cdr);
+		    }
+		    if (object != NIL) {
+			/* object was a dotted list */
+			RPLACD(cdr, object);
+			cdr = CDR(cdr);
+		    }
+		}
+	    }
+	}
+	else {
+	    if (!CONSP(cdr))
+		LispDestroy("EVAL: cannot append to %s", STROBJ(cdr));
+
+	    if (!insert) {
+		if (list) {
+		    RPLACD(cdr, CONS(object, NIL));
+		    cdr = CDR(cdr);
+		}
+		else {
+		    RPLACD(cdr, object);
+		    cdr = object;
+		}
+	    }
+	    else {
+		if (!CONSP(object)) {
+		    RPLACD(cdr, object);
+		    /* if object is NIL, it is a empty list appended, not
+		     * creating a dotted list. */
+		    if (object != NIL)
+			cdr = object;
+		}
+		else {
+		    for (; CONSP(object); object = CDR(object)) {
+			RPLACD(cdr, CONS(CAR(object), NIL));
+			cdr = CDR(cdr);
+		    }
+		    if (object != NIL) {
+			/* object was a dotted list */
+			RPLACD(cdr, object);
+			cdr = CDR(cdr);
+		    }
+		}
+	    }
+	}
+
+	/* if last argument list element processed */
+	if (!list)
+	    break;
+    }
+
+    lisp__data.protect.length = protect;
+
+    return (result);
+}
+
+void
+LispMoreEnvironment(void)
+{
+    Atom_id *names;
+    LispObj **values;
+
+    DISABLE_INTERRUPTS();
+    names = realloc(lisp__data.env.names,
+		    (lisp__data.env.space + 256) * sizeof(Atom_id));
+    if (names != NULL) {
+	values = realloc(lisp__data.env.values,
+			 (lisp__data.env.space + 256) * sizeof(LispObj*));
+	if (values != NULL) {
+	    lisp__data.env.names = names;
+	    lisp__data.env.values = values;
+	    lisp__data.env.space += 256;
+	    ENABLE_INTERRUPTS();
+	    return;
+	}
+	else
+	    free(names);
+    }
+    ENABLE_INTERRUPTS();
+    LispDestroy("out of memory");
+}
+
+void
+LispMoreStack(void)
+{
+    LispObj **values;
+
+    DISABLE_INTERRUPTS();
+    values = realloc(lisp__data.stack.values,
+		     (lisp__data.stack.space + 256) * sizeof(LispObj*));
+    if (values == NULL) {
+	ENABLE_INTERRUPTS();
+	LispDestroy("out of memory");
+    }
+    lisp__data.stack.values = values;
+    lisp__data.stack.space += 256;
+    ENABLE_INTERRUPTS();
+}
+
+void
+LispMoreGlobals(LispPackage *pack)
+{
+    LispObj **pairs;
+
+    DISABLE_INTERRUPTS();
+    pairs = realloc(pack->glb.pairs,
+		    (pack->glb.space + 256) * sizeof(LispObj*));
+    if (pairs == NULL) {
+	ENABLE_INTERRUPTS();
+	LispDestroy("out of memory");
+    }
+    pack->glb.pairs = pairs;
+    pack->glb.space += 256;
+    ENABLE_INTERRUPTS();
+}
+
+void
+LispMoreProtects(void)
+{
+    LispObj **objects;
+
+    DISABLE_INTERRUPTS();
+    objects = realloc(lisp__data.protect.objects,
+		      (lisp__data.protect.space + 256) * sizeof(LispObj*));
+    if (objects == NULL) {
+	ENABLE_INTERRUPTS();
+	LispDestroy("out of memory");
+    }
+    lisp__data.protect.objects = objects;
+    lisp__data.protect.space += 256;
+    ENABLE_INTERRUPTS();
+}
+
+static int
+LispMakeEnvironment(LispArgList *alist, LispObj *values,
+		    LispObj *name, int eval, int builtin)
+{
+    char *desc;
+    int i, count, base;
+    LispObj **symbols, **defaults, **sforms;
+
+#define BUILTIN_ARGUMENT(value)				\
+    lisp__data.stack.values[lisp__data.stack.length++] = value
+
+/* If the index value is from register variables, this
+ * can save some cpu time. Useful for normal arguments
+ * that are the most common, and thus the ones that
+ * consume more time in LispMakeEnvironment. */
+#define BUILTIN_NO_EVAL_ARGUMENT(index, value)		\
+    lisp__data.stack.values[index] = value
+
+#define NORMAL_ARGUMENT(symbol, value)			\
+    LispDoAddVar(symbol, value)
+
+    if (builtin) {
+	base = lisp__data.stack.length;
+	if (base + alist->num_arguments > lisp__data.stack.space) {
+	    do
+		LispMoreStack();
+	    while (base + alist->num_arguments > lisp__data.stack.space);
+	}
+    }
+    else {
+	base = lisp__data.env.length;
+	if (base + alist->num_arguments > lisp__data.env.space) {
+	    do
+		LispMoreEnvironment();
+	    while (base + alist->num_arguments > lisp__data.env.space);
+	}
+    }
+
+    desc = alist->description;
+    switch (*desc++) {
+	case '.':
+	    goto normal_label;
+	case 'o':
+	    goto optional_label;
+	case 'k':
+	    goto key_label;
+	case 'r':
+	    goto rest_label;
+	case 'a':
+	    goto aux_label;
+	default:
+	    goto done_label;
+    }
+
+
+    /* Code below is done in several almost identical loops, to avoid
+     * checking the value of the arguments eval and builtin too much times */
+
+
+    /* Normal arguments */
+normal_label:
+    i = 0;
+    count = alist->normals.num_symbols;
+    if (builtin) {
+	if (eval) {
+	    for (; i < count && CONSP(values); i++, values = CDR(values)) {
+		BUILTIN_ARGUMENT(EVAL(CAR(values)));
+	    }
+	}
+	else {
+	    for (; i < count && CONSP(values); i++, values = CDR(values)) {
+		BUILTIN_NO_EVAL_ARGUMENT(base + i, CAR(values));
+	    }
+	    /* macro BUILTIN_NO_EVAL_ARGUMENT does not update
+	     * lisp__data.stack.length, as there is no risk of GC while
+	     * adding the arguments. */
+	    lisp__data.stack.length += i;
+	}
+    }
+    else {
+	symbols = alist->normals.symbols;
+	if (eval) {
+	    for (; i < count && CONSP(values); i++, values = CDR(values)) {
+		NORMAL_ARGUMENT(symbols[i], EVAL(CAR(values)));
+	    }
+	}
+	else {
+	    for (; i < count && CONSP(values); i++, values = CDR(values)) {
+		NORMAL_ARGUMENT(symbols[i], CAR(values));
+	    }
+	}
+    }
+    if (i < count)
+	LispDestroy("%s: too few arguments", STROBJ(name));
+
+    switch (*desc++) {
+	case 'o':
+	    goto optional_label;
+	case 'k':
+	    goto key_label;
+	case 'r':
+	    goto rest_label;
+	case 'a':
+	    goto aux_label;
+	default:
+	    goto done_label;
+    }
+
+    /* &OPTIONAL */
+optional_label:
+    i = 0;
+    count = alist->optionals.num_symbols;
+    defaults = alist->optionals.defaults;
+    sforms = alist->optionals.sforms;
+    if (builtin) {
+	if (eval) {
+	    for (; i < count && CONSP(values); i++, values = CDR(values))
+		BUILTIN_ARGUMENT(EVAL(CAR(values)));
+	    for (; i < count; i++)
+		BUILTIN_ARGUMENT(UNSPEC);
+	}
+	else {
+	    for (; i < count && CONSP(values); i++, values = CDR(values))
+		BUILTIN_ARGUMENT(CAR(values));
+	    for (; i < count; i++)
+		BUILTIN_ARGUMENT(UNSPEC);
+	}
+    }
+    else {
+	symbols = alist->optionals.symbols;
+	if (eval) {
+	    for (; i < count && CONSP(values); i++, values = CDR(values)) {
+		NORMAL_ARGUMENT(symbols[i], EVAL(CAR(values)));
+		if (sforms[i]) {
+		    NORMAL_ARGUMENT(sforms[i], T);
+		}
+	    }
+	}
+	else {
+	    for (; i < count && CONSP(values); i++, values = CDR(values)) {
+		NORMAL_ARGUMENT(symbols[i], CAR(values));
+		if (sforms[i]) {
+		    NORMAL_ARGUMENT(sforms[i], T);
+		}
+	    }
+	}
+
+	/* default arguments are evaluated for macros */
+	for (; i < count; i++) {
+	    if (!CONSTANTP(defaults[i])) {
+		int head = lisp__data.env.head;
+		int lex = lisp__data.env.lex;
+
+		lisp__data.env.lex = base;
+		lisp__data.env.head = lisp__data.env.length;
+		NORMAL_ARGUMENT(symbols[i], EVAL(defaults[i]));
+		lisp__data.env.head = head;
+		lisp__data.env.lex = lex;
+	    }
+	    else {
+		NORMAL_ARGUMENT(symbols[i], defaults[i]);
+	    }
+	    if (sforms[i]) {
+		NORMAL_ARGUMENT(sforms[i], NIL);
+	    }
+	}
+    }
+    switch (*desc++) {
+	case 'k':
+	    goto key_label;
+	case 'r':
+	    goto rest_label;
+	case 'a':
+	    goto aux_label;
+	default:
+	    goto done_label;
+    }
+
+    /* &KEY */
+key_label:
+    {
+	int argc, nused;
+	LispObj *val, *karg, **keys;
+
+	/* Count number of remaining arguments */
+	for (karg = values, argc = 0; CONSP(karg); karg = CDR(karg), argc++) {
+	    karg = CDR(karg);
+	    if (!CONSP(karg))
+		LispDestroy("%s: &KEY needs arguments as pairs",
+			    STROBJ(name));
+	}
+
+
+	/* OPTIMIZATION:
+	 * Builtin functions require that the keyword be in the keyword package.
+	 * User functions don't need the arguments being pushed in the stack
+	 * in the declared order (bytecode expects it...).
+	 * XXX Error checking should be done elsewhere, code may be looping
+	 * and doing error check here may consume too much cpu time.
+	 * XXX Would also be good to already have the arguments specified in
+	 * the correct order.
+	 */
+
+
+	nused = 0;
+	val = NIL;
+	count = alist->keys.num_symbols;
+	symbols = alist->keys.symbols;
+	defaults = alist->keys.defaults;
+	sforms = alist->keys.sforms;
+	if (builtin) {
+
+	    /* Arguments must be created in the declared order */
+	    i = 0;
+	    if (eval) {
+		for (; i < count; i++) {
+		    for (karg = values; CONSP(karg); karg = CDDR(karg)) {
+			/* This is only true if both point to the
+			 * same symbol in the keyword package. */
+			if (symbols[i] == CAR(karg)) {
+			    if (karg == values)
+				values = CDDR(values);
+			    ++nused;
+			    BUILTIN_ARGUMENT(EVAL(CADR(karg)));
+			    goto keyword_builtin_eval_used_label;
+			}
+		    }
+		    BUILTIN_ARGUMENT(UNSPEC);
+keyword_builtin_eval_used_label:;
+		}
+	    }
+	    else {
+		for (; i < count; i++) {
+		    for (karg = values; CONSP(karg); karg = CDDR(karg)) {
+			if (symbols[i] == CAR(karg)) {
+			    if (karg == values)
+				values = CDDR(values);
+			    ++nused;
+			    BUILTIN_ARGUMENT(CADR(karg));
+			    goto keyword_builtin_used_label;
+			}
+		    }
+		    BUILTIN_ARGUMENT(UNSPEC);
+keyword_builtin_used_label:;
+		}
+	    }
+
+	    if (argc != nused) {
+		/* Argument(s) may be incorrectly specified, or specified
+		 * twice (what is not an error). */
+		for (karg = values; CONSP(karg); karg = CDDR(karg)) {
+		    val = CAR(karg);
+		    if (KEYWORDP(val)) {
+			for (i = 0; i < count; i++)
+			    if (symbols[i] == val)
+				break;
+		    }
+		    else
+			/* Just make the error test true */
+			i = count;
+
+		    if (i == count)
+			goto invalid_keyword_label;
+		}
+	    }
+	}
+
+#if 0
+	else {
+	    /* The base offset of the atom in the stack, to check for
+	     * keywords specified twice. */
+	    LispObj *symbol;
+	    int offset = lisp__data.env.length;
+
+	    keys = alist->keys.keys;
+	    for (karg = values; CONSP(karg); karg = CDDR(karg)) {
+		symbol = CAR(karg);
+		if (SYMBOLP(symbol)) {
+		    /* Must be a keyword, but even if it is a keyword, may
+		     * be a typo, so assume it is correct. If it is not
+		     * in the argument list, it is an error. */
+		    for (i = 0; i < count; i++) {
+			if (!keys[i] && symbols[i] == symbol) {
+			    LispAtom *atom = symbol->data.atom;
+
+			    /* Symbol found in the argument list. */
+			    if (atom->offset >= offset &&
+				atom->offset < offset + nused &&
+				lisp__data.env.names[atom->offset] ==
+				atom->string)
+				/* Specified more than once... */
+				goto keyword_duplicated_label;
+			    break;
+			}
+		    }
+		}
+		else {
+		    Atom_id id;
+
+		    if (!QUOTEP(symbol) || !SYMBOLP(val = symbol->data.quote)) {
+			/* Bad argument. */
+			val = symbol;
+			goto invalid_keyword_label;
+		    }
+
+		    id = ATOMID(val);
+		    for (i = 0; i < count; i++) {
+			if (keys[i] && ATOMID(keys[i]) == id) {
+			    LispAtom *atom = val->data.atom;
+
+			    /* Symbol found in the argument list. */
+			    if (atom->offset >= offset &&
+				atom->offset < offset + nused &&
+				lisp__data.env.names[atom->offset] ==
+				atom->string)
+				/* Specified more than once... */
+				goto keyword_duplicated_label;
+			    break;
+			}
+		    }
+		}
+		if (i == count) {
+		    /* Argument specification not found. */
+		    val = symbol;
+		    goto invalid_keyword_label;
+		}
+		++nused;
+		if (eval) {
+		    NORMAL_ARGUMENT(symbols[i], EVAL(CADR(karg)));
+		}
+		else {
+		    NORMAL_ARGUMENT(symbols[i], CADR(karg));
+		}
+		if (sforms[i]) {
+		    NORMAL_ARGUMENT(sforms[i], T);
+		}
+keyword_duplicated_label:;
+	    }
+
+	    /* Add variables that were not specified in the function call. */
+	    if (nused < count) {
+		int j;
+
+		for (i = 0; i < count; i++) {
+		    Atom_id id = ATOMID(symbols[i]);
+
+		    for (j = offset + nused - 1; j >= offset; j--) {
+			if (lisp__data.env.names[j] == id)
+			    break;
+		    }
+
+		    if (j < offset) {
+			/* Argument not specified. Use default value */
+
+			/* default arguments are evaluated for macros */
+			if (!CONSTANTP(defaults[i])) {
+			    int head = lisp__data.env.head;
+			    int lex = lisp__data.env.lex;
+
+			    lisp__data.env.lex = base;
+			    lisp__data.env.head = lisp__data.env.length;
+			    NORMAL_ARGUMENT(symbols[i], EVAL(defaults[i]));
+			    lisp__data.env.head = head;
+			    lisp__data.env.lex = lex;
+			}
+			else {
+			    NORMAL_ARGUMENT(symbols[i], defaults[i]);
+			}
+			if (sforms[i]) {
+			    NORMAL_ARGUMENT(sforms[i], NIL);
+			}
+		    }
+		}
+	    }
+	}
+#else
+	else {
+	    int varset;
+
+	    sforms = alist->keys.sforms;
+	    keys = alist->keys.keys;
+
+	    /* Add variables */
+	    for (i = 0; i < alist->keys.num_symbols; i++) {
+		val = defaults[i];
+		varset = 0;
+		if (keys[i]) {
+		    Atom_id atom = ATOMID(keys[i]);
+
+		    /* Special keyword specification, need to compare ATOMID
+		     * and keyword specification must be a quoted object */
+		    for (karg = values; CONSP(karg); karg = CDR(karg)) {
+			val = CAR(karg);
+		 	if (QUOTEP(val) && atom == ATOMID(val->data.quote)) {
+			    val = CADR(karg);
+			    varset = 1;
+			    ++nused;
+			    break;
+			}
+			karg = CDR(karg);
+		    }
+		}
+
+		else {
+		    /* Normal keyword specification, can compare object pointers,
+		     * as they point to the same object in the keyword package */
+		    for (karg = values; CONSP(karg); karg = CDR(karg)) {
+			/* Don't check if argument is a valid keyword or
+			 * special quoted keyword */
+			if (symbols[i] == CAR(karg)) {
+			    val = CADR(karg);
+			    varset = 1;
+			    ++nused;
+			    break;
+			}
+			karg = CDR(karg);
+		    }
+		}
+
+		/* Add the variable to environment */
+		if (varset) {
+		    NORMAL_ARGUMENT(symbols[i], eval ? EVAL(val) : val);
+		    if (sforms[i]) {
+			NORMAL_ARGUMENT(sforms[i], T);
+		    }
+		}
+		else {
+		    /* default arguments are evaluated for macros */
+		    if (!CONSTANTP(val)) {
+			int head = lisp__data.env.head;
+			int lex = lisp__data.env.lex;
+
+			lisp__data.env.lex = base;
+			lisp__data.env.head = lisp__data.env.length;
+			NORMAL_ARGUMENT(symbols[i], EVAL(val));
+			lisp__data.env.head = head;
+			lisp__data.env.lex = lex;
+		    }
+		    else {
+			NORMAL_ARGUMENT(symbols[i], val);
+		    }
+		    if (sforms[i]) {
+			NORMAL_ARGUMENT(sforms[i], NIL);
+		    }
+		}
+	    }
+
+	    if (argc != nused) {
+		/* Argument(s) may be incorrectly specified, or specified
+		 * twice (what is not an error). */
+		for (karg = values; CONSP(karg); karg = CDDR(karg)) {
+		    val = CAR(karg);
+		    if (KEYWORDP(val)) {
+			for (i = 0; i < count; i++)
+			    if (symbols[i] == val)
+				break;
+		    }
+		    else if (QUOTEP(val) && SYMBOLP(val->data.quote)) {
+			Atom_id atom = ATOMID(val->data.quote);
+
+			for (i = 0; i < count; i++)
+			    if (ATOMID(keys[i]) == atom)
+				break;
+		    }
+		    else
+			/* Just make the error test true */
+			i = count;
+
+		    if (i == count)
+			goto invalid_keyword_label;
+		}
+	    }
+	}
+#endif
+	goto check_aux_label;
+
+invalid_keyword_label:
+	{
+	    /* If not in argument specification list... */
+	    char function_name[36];
+
+	    strcpy(function_name, STROBJ(name));
+	    LispDestroy("%s: %s is an invalid keyword",
+			function_name, STROBJ(val));
+	}
+    }
+
+check_aux_label:
+    if (*desc == 'a') {
+	/* &KEY uses all remaining arguments */
+	values = NIL;
+	goto aux_label;
+    }
+    goto finished_label;
+
+    /* &REST */
+rest_label:
+    if (!CONSP(values)) {
+	if (builtin) {
+	    BUILTIN_ARGUMENT(values);
+	}
+	else {
+	    NORMAL_ARGUMENT(alist->rest, values);
+	}
+	values = NIL;
+    }
+    /* always allocate a new list, don't know if it will be retained */
+    else if (eval) {
+	LispObj *cons;
+
+	cons = CONS(EVAL(CAR(values)), NIL);
+	if (builtin) {
+	    BUILTIN_ARGUMENT(cons);
+	}
+	else {
+	    NORMAL_ARGUMENT(alist->rest, cons);
+	}
+	values = CDR(values);
+	for (; CONSP(values); values = CDR(values)) {
+	    RPLACD(cons, CONS(EVAL(CAR(values)), NIL));
+	    cons = CDR(cons);
+	}
+    }
+    else {
+	LispObj *cons;
+
+	cons = CONS(CAR(values), NIL);
+	if (builtin) {
+	    BUILTIN_ARGUMENT(cons);
+	}
+	else {
+	    NORMAL_ARGUMENT(alist->rest, cons);
+	}
+	values = CDR(values);
+	for (; CONSP(values); values = CDR(values)) {
+	    RPLACD(cons, CONS(CAR(values), NIL));
+	    cons = CDR(cons);
+	}
+    }
+    if (*desc != 'a')
+	goto finished_label;
+
+    /* &AUX */
+aux_label:
+    i = 0;
+    count = alist->auxs.num_symbols;
+    defaults = alist->auxs.initials;
+    symbols = alist->auxs.symbols;
+    {
+	int lex = lisp__data.env.lex;
+
+	lisp__data.env.lex = base;
+	lisp__data.env.head = lisp__data.env.length;
+	for (; i < count; i++) {
+	    NORMAL_ARGUMENT(symbols[i], EVAL(defaults[i]));
+	    ++lisp__data.env.head;
+	}
+	lisp__data.env.lex = lex;
+    }
+
+done_label:
+    if (CONSP(values))
+	LispDestroy("%s: too many arguments", STROBJ(name));
+
+finished_label:
+    if (builtin)
+	lisp__data.stack.base = base;
+    else {
+	lisp__data.env.head = lisp__data.env.length;
+    }
+#undef BULTIN_ARGUMENT
+#undef NORMAL_ARGUMENT
+#undef BUILTIN_NO_EVAL_ARGUMENT
+
+    return (base);
+}
+
+LispObj *
+LispFuncall(LispObj *function, LispObj *arguments, int eval)
+{
+    LispAtom *atom;
+    LispArgList *alist;
+    LispBuiltin *builtin;
+    LispObj *lambda, *result;
+    int macro, base;
+
+#ifdef DEBUGGER
+    if (lisp__data.debugging)
+	LispDebugger(LispDebugCallBegin, function, arguments);
+#endif
+
+    switch (OBJECT_TYPE(function)) {
+	case LispFunction_t:
+	    function = function->data.atom->object;
+	case LispAtom_t:
+	    atom = function->data.atom;
+	    if (atom->a_builtin) {
+		builtin = atom->property->fun.builtin;
+
+		if (eval)
+		    eval = builtin->type != LispMacro;
+		base = LispMakeEnvironment(atom->property->alist,
+					   arguments, function, eval, 1);
+		if (builtin->multiple_values) {
+		    RETURN_COUNT = 0;
+		    result = builtin->function(builtin);
+		}
+		else {
+		    result = builtin->function(builtin);
+		    RETURN_COUNT = 0;
+		}
+		lisp__data.stack.base = lisp__data.stack.length = base;
+	    }
+	    else if (atom->a_compiled) {
+		int lex = lisp__data.env.lex;
+		lambda = atom->property->fun.function;
+		alist = atom->property->alist;
+
+		base = LispMakeEnvironment(alist, arguments, function, eval, 0);
+		lisp__data.env.lex = base;
+		result = LispExecuteBytecode(lambda);
+		lisp__data.env.lex = lex;
+		lisp__data.env.head = lisp__data.env.length = base;
+	    }
+	    else if (atom->a_function) {
+		lambda = atom->property->fun.function;
+		macro = lambda->funtype == LispMacro;
+		alist = atom->property->alist;
+
+		lambda = lambda->data.lambda.code;
+		if (eval)
+		    eval = !macro;
+		base = LispMakeEnvironment(alist, arguments, function, eval, 0);
+		result = LispRunFunMac(function, lambda, macro, base);
+	    }
+	    else if (atom->a_defstruct &&
+		     atom->property->structure.function != STRUCT_NAME) {
+		LispObj cons;
+
+		if (atom->property->structure.function == STRUCT_CONSTRUCTOR)
+		    atom = Omake_struct->data.atom;
+		else if (atom->property->structure.function == STRUCT_CHECK)
+		    atom = Ostruct_type->data.atom;
+		else
+		    atom = Ostruct_access->data.atom;
+		builtin = atom->property->fun.builtin;
+
+		cons.type = LispCons_t;
+		cons.data.cons.cdr = arguments;
+		if (eval) {
+		    LispObj quote;
+
+		    quote.type = LispQuote_t;
+		    quote.data.quote = function;
+		    cons.data.cons.car = &quote;
+		    base = LispMakeEnvironment(atom->property->alist,
+					       &cons, function, 1, 1);
+		}
+		else {
+		    cons.data.cons.car = function;
+		    base = LispMakeEnvironment(atom->property->alist,
+					       &cons, function, 0, 1);
+		}
+		result = builtin->function(builtin);
+		RETURN_COUNT = 0;
+		lisp__data.stack.length = base;
+	    }
+	    else {
+		LispDestroy("EVAL: the function %s is not defined",
+			    STROBJ(function));
+		/*NOTREACHED*/
+		result = NIL;
+	    }
+	    break;
+	case LispLambda_t:
+	    lambda = function->data.lambda.code;
+	    alist = (LispArgList*)function->data.lambda.name->data.opaque.data;
+	    base = LispMakeEnvironment(alist, arguments, function, eval, 0);
+	    result = LispRunFunMac(function, lambda, 0, base);
+	    break;
+	case LispCons_t:
+	    if (CAR(function) == Olambda) {
+		function = EVAL(function);
+		if (LAMBDAP(function)) {
+		    GC_ENTER();
+
+		    GC_PROTECT(function);
+		    lambda = function->data.lambda.code;
+		    alist = (LispArgList*)function->data.lambda.name->data.opaque.data;
+		    base = LispMakeEnvironment(alist, arguments, NIL, eval, 0);
+		    result = LispRunFunMac(NIL, lambda, 0, base);
+		    GC_LEAVE();
+		    break;
+		}
+	    }
+	default:
+	    LispDestroy("EVAL: %s is invalid as a function",
+			STROBJ(function));
+	    /*NOTREACHED*/
+	    result = NIL;
+	    break;
+    }
+
+#ifdef DEBUGGER
+    if (lisp__data.debugging)
+	LispDebugger(LispDebugCallEnd, function, result);
+#endif
+
+    return (result);
+}
+
+LispObj *
+LispEval(LispObj *object)
+{
+    LispObj *result;
+
+    switch (OBJECT_TYPE(object)) {
+	case LispAtom_t:
+	    if ((result = LispDoGetVar(object)) == NULL)
+		LispDestroy("EVAL: the variable %s is unbound", STROBJ(object));
+	    break;
+	case LispCons_t:
+	    result = LispFuncall(CAR(object), CDR(object), 1);
+	    break;
+	case LispQuote_t:
+	    result = object->data.quote;
+	    break;
+	case LispFunctionQuote_t:
+	    result = object->data.quote;
+	    if (SYMBOLP(result))
+		result = LispSymbolFunction(result);
+	    else if (CONSP(result) && CAR(result) == Olambda)
+		result = EVAL(result);
+	    else
+		LispDestroy("FUNCTION: %s is not a function", STROBJ(result));
+	    break;
+	case LispBackquote_t:
+	    result = LispEvalBackquote(object->data.quote, 1);
+	    break;
+	case LispComma_t:
+	    LispDestroy("EVAL: comma outside of backquote");
+	default:
+	    result = object;
+	    break;
+    }
+
+    return (result);
+}
+
+LispObj *
+LispApply1(LispObj *function, LispObj *argument)
+{
+    LispObj arguments;
+
+    arguments.type = LispCons_t;
+    arguments.data.cons.car = argument;
+    arguments.data.cons.cdr = NIL;
+
+    return (LispFuncall(function, &arguments, 0));
+}
+
+LispObj *
+LispApply2(LispObj *function, LispObj *argument1, LispObj *argument2)
+{
+    LispObj arguments, cdr;
+
+    arguments.type = cdr.type = LispCons_t;
+    arguments.data.cons.car = argument1;
+    arguments.data.cons.cdr = &cdr;
+    cdr.data.cons.car = argument2;
+    cdr.data.cons.cdr = NIL;
+
+    return (LispFuncall(function, &arguments, 0));
+}
+
+LispObj *
+LispApply3(LispObj *function, LispObj *arg1, LispObj *arg2, LispObj *arg3)
+{
+    LispObj arguments, car, cdr;
+
+    arguments.type = car.type = cdr.type = LispCons_t;
+    arguments.data.cons.car = arg1;
+    arguments.data.cons.cdr = &car;
+    car.data.cons.car = arg2;
+    car.data.cons.cdr = &cdr;
+    cdr.data.cons.car = arg3;
+    cdr.data.cons.cdr = NIL;
+
+    return (LispFuncall(function, &arguments, 0));
+}
+
+static LispObj *
+LispRunFunMac(LispObj *name, LispObj *code, int macro, int base)
+{
+    LispObj *result = NIL;
+
+    if (!macro) {
+	int lex = lisp__data.env.lex;
+	int did_jump = 1, *pdid_jump;
+	LispObj **pcode, **presult;
+	LispBlock *block;
+
+	block = LispBeginBlock(name, LispBlockClosure);
+	lisp__data.env.lex = base;
+	if (setjmp(block->jmp) == 0) {
+	    for (pcode = &code, presult = &result, pdid_jump = &did_jump;
+		 CONSP(code); code = CDR(code))
+		result = EVAL(CAR(code));
+	    did_jump = 0;
+	}
+	LispEndBlock(block);
+	if (did_jump)
+	    result = lisp__data.block.block_ret;
+	lisp__data.env.lex = lex;
+	lisp__data.env.head = lisp__data.env.length = base;
+    }
+    else {
+	GC_ENTER();
+
+	for (; CONSP(code); code = CDR(code))
+	    result = EVAL(CAR(code));
+	/* FIXME this does not work if macro has &aux variables,
+	 * but there are several other missing features, like
+	 * destructuring and more lambda list keywords still missing.
+	 * TODO later.
+	 */
+	lisp__data.env.head = lisp__data.env.length = base;
+
+	GC_PROTECT(result);
+	result = EVAL(result);
+	GC_LEAVE();
+    }
+
+    return (result);
+}
+
+LispObj *
+LispRunSetf(LispArgList *alist, LispObj *setf, LispObj *place, LispObj *value)
+{
+    GC_ENTER();
+    LispObj *store, *code, *expression, *result, quote;
+    int base;
+
+    code = setf->data.lambda.code;
+    store = setf->data.lambda.data;
+
+    quote.type = LispQuote_t;
+    quote.data.quote = value;
+    LispDoAddVar(CAR(store), &quote);
+    ++lisp__data.env.head;
+    base = LispMakeEnvironment(alist, place, Oexpand_setf_method, 0, 0);
+
+    /* build expansion macro */
+    expression = NIL;
+    for (; CONSP(code); code = CDR(code))
+	expression = EVAL(CAR(code));
+
+    /* Minus 1 to pop the added variable */
+    lisp__data.env.head = lisp__data.env.length = base - 1;
+
+    /* protect expansion, and executes it */
+    GC_PROTECT(expression);
+    result = EVAL(expression);
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+LispRunSetfMacro(LispAtom *atom, LispObj *arguments, LispObj *value)
+{
+    int base;
+    GC_ENTER();
+    LispObj *place, *body, *result, quote;
+
+    place = NIL;
+    base = LispMakeEnvironment(atom->property->alist,
+			       arguments, atom->object, 0, 0);
+    body = atom->property->fun.function->data.lambda.code;
+
+    /* expand macro body */
+    for (; CONSP(body); body = CDR(body))
+	place = EVAL(CAR(body));
+
+    /* protect expansion */
+    GC_PROTECT(place);
+
+    /* restore environment */
+    lisp__data.env.head = lisp__data.env.length = base;
+
+    /* value is already evaluated */
+    quote.type = LispQuote_t;
+    quote.data.quote = value;
+
+    /* call setf again */
+    result = APPLY2(Osetf, place, &quote);
+
+    GC_LEAVE();
+
+    return (result);
+}
+
+char *
+LispStrObj(LispObj *object)
+{
+    static int first = 1;
+    static char buffer[34];
+    static LispObj stream;
+    static LispString string;
+
+    if (first) {
+	stream.type = LispStream_t;
+	stream.data.stream.source.string = &string;
+	stream.data.stream.pathname = NIL;
+	stream.data.stream.type = LispStreamString;
+	stream.data.stream.readable = 0;
+	stream.data.stream.writable = 1;
+
+	string.string = buffer;
+	string.fixed = 1;
+	string.space = sizeof(buffer) - 1;
+	first = 0;
+    }
+
+    string.length = string.output = 0;
+
+    LispWriteObject(&stream, object);
+
+    /* make sure string is nul terminated */
+    string.string[string.length] = '\0';
+    if (string.length >= 32) {
+	if (buffer[0] == '(')
+	    strcpy(buffer + 27, "...)");
+	else
+	    strcpy(buffer + 28, "...");
+    }
+
+    return (buffer);
+}
+
+void
+LispPrint(LispObj *object, LispObj *stream, int newline)
+{
+    if (stream != NIL && !STREAMP(stream)) {
+	LispDestroy("PRINT: %s is not a stream", STROBJ(stream));
+    }
+    if (newline && LispGetColumn(stream))
+	LispWriteChar(stream, '\n');
+    LispWriteObject(stream, object);
+    if (stream == NIL || (stream->data.stream.type == LispStreamStandard &&
+	stream->data.stream.source.file == Stdout))
+	LispFflush(Stdout);
+}
+
+void
+LispUpdateResults(LispObj *cod, LispObj *res)
+{
+    LispSetVar(RUN[2], LispGetVar(RUN[1]));
+    LispSetVar(RUN[1], LispGetVar(RUN[0]));
+    LispSetVar(RUN[0], cod);
+
+    LispSetVar(RES[2], LispGetVar(RES[1]));
+    LispSetVar(RES[1], LispGetVar(RES[0]));
+    LispSetVar(RES[0], res);
+}
+
+#ifdef SIGNALRETURNSINT
+int
+#else
+void
+#endif
+LispSignalHandler(int signum)
+{
+    LispSignal(signum);
+#ifdef SIGNALRETURNSINT
+    return (0);
+#endif
+}
+
+void
+LispSignal(int signum)
+{
+    char *errstr;
+    char buffer[32];
+
+    if (lisp__disable_int) {
+	lisp__interrupted = signum;
+	return;
+    }
+    switch (signum) {
+	case SIGINT:
+	    errstr = "interrupted";
+	    break;
+	case SIGFPE:
+	    errstr = "floating point exception";
+	    break;
+	default:
+	    sprintf(buffer, "signal %d received", signum);
+	    errstr = buffer;
+	    break;
+    }
+    LispDestroy(errstr);
+}
+
+void
+LispDisableInterrupts(void)
+{
+    ++lisp__disable_int;
+}
+
+void
+LispEnableInterrupts(void)
+{
+    --lisp__disable_int;
+    if (lisp__disable_int <= 0 && lisp__interrupted)
+	LispSignal(lisp__interrupted);
+}
+
+void
+LispMachine(void)
+{
+    LispObj *cod, *obj;
+
+    lisp__data.sigint = signal(SIGINT, LispSignalHandler);
+    lisp__data.sigfpe = signal(SIGFPE, LispSignalHandler);
+
+    /*CONSTCOND*/
+    while (1) {
+	if (sigsetjmp(lisp__data.jmp, 1) == 0) {
+	    lisp__data.running = 1;
+	    if (lisp__data.interactive && lisp__data.prompt) {
+		LispFputs(Stdout, lisp__data.prompt);
+		LispFflush(Stdout);
+	    }
+	    if ((cod = LispRead()) != NULL) {
+		obj = EVAL(cod);
+		if (lisp__data.interactive) {
+		    if (RETURN_COUNT >= 0)
+			LispPrint(obj, NIL, 1);
+		    if (RETURN_COUNT > 0) {
+			int i;
+
+			for (i = 0; i < RETURN_COUNT; i++)
+			    LispPrint(RETURN(i), NIL, 1);
+		    }
+		    LispUpdateResults(cod, obj);
+		    if (LispGetColumn(NIL))
+			LispWriteChar(NIL, '\n');
+		}
+	    }
+	    LispTopLevel();
+	}
+	if (lisp__data.eof)
+	    break;
+    }
+
+    signal(SIGINT, lisp__data.sigint);
+    signal(SIGFPE, lisp__data.sigfpe);
+
+    lisp__data.running = 0;
+}
+
+void *
+LispExecute(char *str)
+{
+    static LispObj stream;
+    static LispString string;
+    static int first = 1;
+
+    int running = lisp__data.running;
+    LispObj *result, *cod, *obj, **presult = &result;
+
+    if (str == NULL || *str == '\0')
+	return (NIL);
+
+    *presult = NIL;
+
+    if (first) {
+	stream.type = LispStream_t;
+	stream.data.stream.source.string = &string;
+	stream.data.stream.pathname = NIL;
+	stream.data.stream.type = LispStreamString;
+	stream.data.stream.readable = 1;
+	stream.data.stream.writable = 0;
+	string.output = 0;
+	first = 0;
+    }
+    string.string = str;
+    string.length = strlen(str);
+    string.input = 0;
+
+    LispPushInput(&stream);
+    if (!running) {
+	lisp__data.running = 1;
+	if (sigsetjmp(lisp__data.jmp, 1) != 0)
+	    return (NULL);
+    }
+
+    cod = COD;
+    /*CONSTCOND*/
+    while (1) {
+	if ((obj = LispRead()) != NULL) {
+	    result = EVAL(obj);
+	    COD = cod;
+	}
+	if (lisp__data.eof)
+	    break;
+    }
+    LispPopInput(&stream);
+
+    lisp__data.running = running;
+
+    return (result);
+}
+
+void
+LispBegin(void)
+{
+    int i;
+    LispAtom *atom;
+    char results[4];
+    LispObj *object, *path, *ext;
+
+    pagesize = LispGetPageSize();
+    segsize = pagesize / sizeof(LispObj);
+
+    /* Initialize memory management */
+    lisp__data.mem.mem = (void**)calloc(lisp__data.mem.space = 16,
+					sizeof(void*));
+    lisp__data.mem.index = lisp__data.mem.level = 0;
+
+    /* Allow LispGetVar to check ATOMID() of unbound symbols */
+    UNBOUND->data.atom = (LispAtom*)LispCalloc(1, sizeof(LispAtom));
+    LispMused(UNBOUND->data.atom);
+    noproperty.value = UNBOUND;
+
+    if (Stdin == NULL)
+	Stdin = LispFdopen(0, FILE_READ);
+    if (Stdout == NULL)
+	Stdout = LispFdopen(1, FILE_WRITE | FILE_BUFFERED);
+    if (Stderr == NULL)
+	Stderr = LispFdopen(2, FILE_WRITE);
+
+    /* minimum number of free cells after GC
+     * if sizeof(LispObj) == 16, than a minfree of 1024 would try to keep
+     * at least 16Kb of free cells.
+     */
+    minfree = 1024;
+
+    MOD = COD = PRO = NIL;
+#ifdef DEBUGGER
+    DBG = BRK = NIL;
+#endif
+
+    /* allocate initial object cells */
+    LispAllocSeg(&objseg, minfree);
+    LispAllocSeg(&atomseg, pagesize);
+    lisp__data.gc.average = segsize;
+
+    /* Don't allow gc in initialization */
+    GCDisable();
+
+    /* Initialize package system, the current package is LISP. Order of
+     * initialization is very important here */
+    lisp__data.lisp = LispNewPackage(STRING("LISP"),
+				     CONS(STRING("COMMON-LISP"), NIL));
+
+    /* Make LISP package the current one */
+    lisp__data.pack = lisp__data.savepack =
+	lisp__data.lisp->data.package.package;
+
+    /* Allocate space in LISP package */
+    LispMoreGlobals(lisp__data.pack);
+
+    /* Allocate  space for multiple value return values */
+    lisp__data.returns.values = malloc(MULTIPLE_VALUES_LIMIT *
+				       (sizeof(LispObj*)));
+
+    /*  Create the first atom, do it "by hand" because macro "PACKAGE"
+     * cannot yet be used. */
+    atom = LispGetPermAtom("*PACKAGE*");
+    lisp__data.package = atomseg.freeobj;
+    atomseg.freeobj = CDR(atomseg.freeobj);
+    --atomseg.nfree;
+    lisp__data.package->type = LispAtom_t;
+    lisp__data.package->data.atom = atom;
+    atom->object = lisp__data.package;
+    atom->package = lisp__data.lisp;
+
+    /* Set package list, to be used by (gc) and (list-all-packages) */
+    PACK = CONS(lisp__data.lisp, NIL);
+
+    /* Make *PACKAGE* a special variable */
+    LispProclaimSpecial(lisp__data.package, lisp__data.lisp, NIL);
+
+	/* Value of macro "PACKAGE" is now properly available */
+
+    /* Changing *PACKAGE* is like calling (in-package) */
+    lisp__data.package->data.atom->watch = 1;
+
+    /* And available to other packages */
+    LispExportSymbol(lisp__data.package);
+
+    /* Initialize stacks */
+    LispMoreEnvironment();
+    LispMoreStack();
+
+    /* Create the KEYWORD package */
+    Skeyword = GETATOMID("KEYWORD");
+    object = LispNewPackage(STRING(Skeyword),
+			    CONS(STRING(""), NIL));
+
+    /* Update list of packages */
+    PACK = CONS(object, PACK);
+
+    /* Allow easy access to the keyword package */
+    lisp__data.keyword = object;
+    lisp__data.key = object->data.package.package;
+
+    /* Initialize some static important symbols */
+    Olambda		= STATIC_ATOM("LAMBDA");
+    LispExportSymbol(Olambda);
+    Okey		= STATIC_ATOM("&KEY");
+    LispExportSymbol(Okey);
+    Orest		= STATIC_ATOM("&REST");
+    LispExportSymbol(Orest);
+    Ooptional		= STATIC_ATOM("&OPTIONAL");
+    LispExportSymbol(Ooptional);
+    Oaux		= STATIC_ATOM("&AUX");
+    LispExportSymbol(Oaux);
+    Kunspecific		= KEYWORD("UNSPECIFIC");
+    Oformat		= STATIC_ATOM("FORMAT");
+    Oexpand_setf_method	= STATIC_ATOM("EXPAND-SETF-METHOD");
+
+    Omake_struct	= STATIC_ATOM("MAKE-STRUCT");
+    Ostruct_access	= STATIC_ATOM("STRUCT-ACCESS");
+    Ostruct_store	= STATIC_ATOM("STRUCT-STORE");
+    Ostruct_type	= STATIC_ATOM("STRUCT-TYPE");
+    Smake_struct	= ATOMID(Omake_struct);
+    Sstruct_access	= ATOMID(Ostruct_access);
+    Sstruct_store	= ATOMID(Ostruct_store);
+    Sstruct_type	= ATOMID(Ostruct_type);
+
+    /* Initialize some static atom ids */
+    Snil		= GETATOMID("NIL");
+    St			= GETATOMID("T");
+    Saux		= ATOMID(Oaux);
+    Skey		= ATOMID(Okey);
+    Soptional		= ATOMID(Ooptional);
+    Srest		= ATOMID(Orest);
+    Sand		= GETATOMID("AND");
+    Sor			= GETATOMID("OR");
+    Snot		= GETATOMID("NOT");
+    Satom		= GETATOMID("ATOM");
+    Ssymbol		= GETATOMID("SYMBOL");
+    Sinteger		= GETATOMID("INTEGER");
+    Scharacter		= GETATOMID("CHARACTER");
+    Sstring		= GETATOMID("STRING");
+    Slist		= GETATOMID("LIST");
+    Scons		= GETATOMID("CONS");
+    Svector		= GETATOMID("VECTOR");
+    Sarray		= GETATOMID("ARRAY");
+    Sstruct		= GETATOMID("STRUCT");
+    Sfunction		= GETATOMID("FUNCTION");
+    Spathname		= GETATOMID("PATHNAME");
+    Srational		= GETATOMID("RATIONAL");
+    Sfloat		= GETATOMID("FLOAT");
+    Scomplex		= GETATOMID("COMPLEX");
+    Sopaque		= GETATOMID("OPAQUE");
+    Sdefault		= GETATOMID("DEFAULT");
+
+    LispArgList_t	= LispRegisterOpaqueType("LispArgList*");
+
+    lisp__data.unget = malloc(sizeof(LispUngetInfo*));
+    lisp__data.unget[0] = calloc(1, sizeof(LispUngetInfo));
+    lisp__data.nunget = 1;
+
+    lisp__data.standard_input = ATOM2("*STANDARD-INPUT*");
+    SINPUT = STANDARDSTREAM(Stdin, lisp__data.standard_input, STREAM_READ);
+    lisp__data.interactive = 1;
+    LispProclaimSpecial(lisp__data.standard_input,
+			lisp__data.input_list = SINPUT, NIL);
+    LispExportSymbol(lisp__data.standard_input);
+
+    lisp__data.standard_output = ATOM2("*STANDARD-OUTPUT*");
+    SOUTPUT = STANDARDSTREAM(Stdout, lisp__data.standard_output, STREAM_WRITE);
+    LispProclaimSpecial(lisp__data.standard_output,
+			lisp__data.output_list = SOUTPUT, NIL);
+    LispExportSymbol(lisp__data.standard_output);
+
+    object = ATOM2("*STANDARD-ERROR*");
+    lisp__data.error_stream = STANDARDSTREAM(Stderr, object, STREAM_WRITE);
+    LispProclaimSpecial(object, lisp__data.error_stream, NIL);
+    LispExportSymbol(object);
+
+    lisp__data.modules = ATOM2("*MODULES*");
+    LispProclaimSpecial(lisp__data.modules, MOD, NIL);
+    LispExportSymbol(lisp__data.modules);
+
+    object = CONS(KEYWORD("UNIX"), CONS(KEYWORD("XEDIT"), NIL));
+    lisp__data.features = ATOM2("*FEATURES*");
+    LispProclaimSpecial(lisp__data.features, object, NIL);
+    LispExportSymbol(lisp__data.features);
+
+    object = ATOM2("MULTIPLE-VALUES-LIMIT");
+    LispDefconstant(object, FIXNUM(MULTIPLE_VALUES_LIMIT + 1), NIL);
+    LispExportSymbol(object);
+
+    /* Reenable gc */
+    GCEnable();
+
+    LispBytecodeInit();
+    LispPackageInit();
+    LispCoreInit();
+    LispMathInit();
+    LispPathnameInit();
+    LispStreamInit();
+    LispRegexInit();
+    LispWriteInit();
+
+    lisp__data.prompt = isatty(0) ? "> " : NULL;
+
+    lisp__data.errexit = !lisp__data.interactive;
+
+    if (lisp__data.interactive) {
+	/* add +, ++, +++, *, **, and *** */
+	for (i = 0; i < 3; i++) {
+	    results[i] = '+';
+	    results[i + 1] = '\0';
+	    RUN[i] = ATOM(results);
+	    LispSetVar(RUN[i], NIL);
+	    LispExportSymbol(RUN[i]);
+	}
+	for (i = 0; i < 3; i++) {
+	    results[i] = '*';
+	    results[i + 1] = '\0';
+	    RES[i] = ATOM(results);
+	    LispSetVar(RES[i], NIL);
+	    LispExportSymbol(RES[i]);
+	}
+    }
+    else
+	RUN[0] = RUN[1] = RUN[2] = RES[0] = RES[1] = RES[2] = NIL;
+
+    /* Add LISP builtin functions */
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    EXECUTE("(require \"lisp\")");
+
+    object = ATOM2("*DEFAULT-PATHNAME-DEFAULTS*");
+#ifdef LISPDIR
+    {
+	int length;
+	char *pathname = LISPDIR;
+
+	length = strlen(pathname);
+	if (length && pathname[length - 1] != '/') {
+	    pathname = LispMalloc(length + 2);
+
+	    strcpy(pathname, LISPDIR);
+	    strcpy(pathname + length, "/");
+	    path = LSTRING2(pathname, length + 1);
+	}
+	else
+	    path = LSTRING(pathname, length);
+    }
+#else
+    path = STRING("");
+#endif
+    GCDisable();
+    LispProclaimSpecial(object, APPLY1(Oparse_namestring, path), NIL);
+    LispExportSymbol(object);
+    GCEnable();
+
+    /* Create and make EXT the current package */
+    PACKAGE = ext = LispNewPackage(STRING("EXT"), NIL);
+    lisp__data.pack = lisp__data.savepack = PACKAGE->data.package.package;
+
+    /* Update list of packages */
+    PACK = CONS(ext, PACK);
+
+    /* Import LISP external symbols in EXT package */
+    LispUsePackage(lisp__data.lisp);
+
+    /* Add EXT non standard builtin functions */
+    for (i = 0; i < sizeof(extbuiltins) / sizeof(extbuiltins[0]); i++)
+	LispAddBuiltinFunction(&extbuiltins[i]);
+
+    /* Create and make USER the current package */
+    GCDisable();
+    PACKAGE = LispNewPackage(STRING("USER"),
+			     CONS(STRING("COMMON-LISP-USER"), NIL));
+    GCEnable();
+    lisp__data.pack = lisp__data.savepack = PACKAGE->data.package.package;
+
+    /* Update list of packages */
+    PACK = CONS(PACKAGE, PACK);
+
+    /* USER package inherits all LISP external symbols */
+    LispUsePackage(lisp__data.lisp);
+    /* And all EXT external symbols */
+    LispUsePackage(ext);
+
+    LispTopLevel();
+}
+
+void
+LispEnd()
+{
+    /* XXX needs to free all used memory, not just close file descriptors */
+}
+
+void
+LispSetPrompt(char *prompt)
+{
+    lisp__data.prompt = prompt;
+}
+
+void
+LispSetInteractive(int interactive)
+{
+    lisp__data.interactive = !!interactive;
+}
+
+void
+LispSetExitOnError(int errexit)
+{
+    lisp__data.errexit = !!errexit;
+}
+
+void
+LispDebug(int enable)
+{
+    lisp__data.debugging = !!enable;
+
+#ifdef DEBUGGER
+    /* assumes we are at the toplevel */
+    DBG = BRK = NIL;
+    lisp__data.debug_level = -1;
+    lisp__data.debug_step = 0;
+#endif
+}
diff --git a/lisp/lisp.h b/lisp/lisp.h
new file mode 100644
index 0000000..f783c37
--- /dev/null
+++ b/lisp/lisp.h
@@ -0,0 +1,44 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/lisp.h,v 1.5 2002/11/08 08:00:57 paulo Exp $ */
+
+#ifndef Lisp_lisp_h
+#define Lisp_lisp_h
+
+void LispBegin(void);
+void LispEnd(void);
+void *LispExecute(char*);
+void LispMachine(void);
+void LispSetPrompt(char*);
+void LispSetInteractive(int);
+void LispSetExitOnError(int);
+void LispDebug(int);		/* argument is boolean to enable/disable */
+
+#endif /* Lisp_lisp_h */
diff --git a/lisp/lsp.c b/lisp/lsp.c
new file mode 100644
index 0000000..920dba0
--- /dev/null
+++ b/lisp/lsp.c
@@ -0,0 +1,79 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/lsp.c,v 1.7 2002/11/23 08:26:49 paulo Exp $ */
+
+#include <stdio.h>
+#include <string.h>
+#include "lisp.h"
+
+#ifdef NEED_STRCASECMP
+int strcasecmp(const char *s1, const char *s2);
+int strncasecmp(const char *s1, const char *s2, size_t n);
+#endif
+#ifdef NEED_REALPATH
+#include <sys/param.h>
+#if defined(ISC)
+#ifndef MAXPATHLEN
+#define MAXPATHLEN      1024
+#endif
+#endif
+char *realpath(const char *pathname, char resolvedname[MAXPATHLEN]);
+#endif
+
+int
+main(int argc, char *argv[])
+{
+    int i;
+
+    LispBegin();
+
+    i = 1;
+    if (argc > 1 && strcmp(argv[1], "-d") == 0) {
+	LispDebug(1);
+	++i;
+    }
+
+    if (i < argc) {
+	char buffer[2048];
+
+	for (; i < argc; i++) {
+	    snprintf(buffer, sizeof(buffer),
+		     "(load \"%s\" :if-does-not-exist :error)",
+		     argv[i]);
+	    LispExecute(buffer);
+	}
+    }
+    else
+	LispMachine();
+
+    LispEnd();
+
+    return (0);
+}
diff --git a/lisp/math.c b/lisp/math.c
new file mode 100644
index 0000000..fcadefa
--- /dev/null
+++ b/lisp/math.c
@@ -0,0 +1,1473 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/math.c,v 1.22 2002/11/23 21:41:52 paulo Exp $ */
+
+#include "math.h"
+#include "private.h"
+
+/*
+ * Prototypes
+ */
+static LispObj *LispDivide(LispBuiltin*, int, int);
+
+/*
+ * Initialization
+ */
+static LispObj *obj_zero, *obj_one;
+LispObj *Ocomplex, *Oequal_;
+
+LispObj *Oshort_float, *Osingle_float, *Odouble_float, *Olong_float;
+
+Atom_id Sdefault_float_format;
+
+/*
+ * Implementation
+ */
+#include "mathimp.c"
+
+void
+LispMathInit(void)
+{
+    LispObj *object, *result;
+
+    mp_set_malloc(LispMalloc);
+    mp_set_calloc(LispCalloc);
+    mp_set_realloc(LispRealloc);
+    mp_set_free(LispFree);
+
+    number_init();
+    obj_zero = FIXNUM(0);
+    obj_one = FIXNUM(1);
+
+    Oequal_		= STATIC_ATOM("=");
+    Ocomplex		= STATIC_ATOM(Scomplex);
+    Oshort_float	= STATIC_ATOM("SHORT-FLOAT");
+    LispExportSymbol(Oshort_float);
+    Osingle_float	= STATIC_ATOM("SINGLE-FLOAT");
+    LispExportSymbol(Osingle_float);
+    Odouble_float	= STATIC_ATOM("DOUBLE-FLOAT");
+    LispExportSymbol(Odouble_float);
+    Olong_float		= STATIC_ATOM("LONG-FLOAT");
+    LispExportSymbol(Olong_float);
+
+    object		= STATIC_ATOM("*DEFAULT-FLOAT-FORMAT*");
+    LispProclaimSpecial(object, Odouble_float, NIL);
+    LispExportSymbol(object);
+    Sdefault_float_format = ATOMID(object);
+
+    object		= STATIC_ATOM("PI");
+    result = number_pi();
+    LispProclaimSpecial(object, result, NIL);
+    LispExportSymbol(object);
+
+    object		= STATIC_ATOM("MOST-POSITIVE-FIXNUM");
+    LispDefconstant(object, FIXNUM(MOST_POSITIVE_FIXNUM), NIL);
+    LispExportSymbol(object);
+
+    object		= STATIC_ATOM("MOST-NEGATIVE-FIXNUM");
+    LispDefconstant(object, FIXNUM(MOST_NEGATIVE_FIXNUM), NIL);
+    LispExportSymbol(object);
+}
+
+LispObj *
+Lisp_Mul(LispBuiltin *builtin)
+/*
+ * &rest numbers
+ */
+{
+    n_number num;
+    LispObj *number, *numbers;
+
+    numbers = ARGUMENT(0);
+
+    if (CONSP(numbers)) {
+	number = CAR(numbers);
+
+	numbers = CDR(numbers);
+	if (!CONSP(numbers)) {
+	    CHECK_NUMBER(number);
+	    return (number);
+	}
+    }
+    else
+	return (FIXNUM(1));
+
+    set_number_object(&num, number);
+    do {
+	mul_number_object(&num, CAR(numbers));
+	numbers = CDR(numbers);
+    } while (CONSP(numbers));
+
+    return (make_number_object(&num));
+}
+
+LispObj *
+Lisp_Plus(LispBuiltin *builtin)
+/*
+ + &rest numbers
+ */
+{
+    n_number num;
+    LispObj *number, *numbers;
+
+    numbers = ARGUMENT(0);
+
+    if (CONSP(numbers)) {
+	number = CAR(numbers);
+
+	numbers = CDR(numbers);
+	if (!CONSP(numbers)) {
+	    CHECK_NUMBER(number);
+	    return (number);
+	}
+    }
+    else
+	return (FIXNUM(0));
+
+    set_number_object(&num, number);
+    do {
+	add_number_object(&num, CAR(numbers));
+	numbers = CDR(numbers);
+    } while (CONSP(numbers));
+
+    return (make_number_object(&num));
+}
+
+LispObj *
+Lisp_Minus(LispBuiltin *builtin)
+/*
+ - number &rest more_numbers
+ */
+{
+    n_number num;
+    LispObj *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    number = ARGUMENT(0);
+
+    set_number_object(&num, number);
+    if (!CONSP(more_numbers)) {
+	neg_number(&num);
+
+	return (make_number_object(&num));
+    }
+    do {
+	sub_number_object(&num, CAR(more_numbers));
+	more_numbers = CDR(more_numbers);
+    } while (CONSP(more_numbers));
+
+    return (make_number_object(&num));
+}
+
+LispObj *
+Lisp_Div(LispBuiltin *builtin)
+/*
+ / number &rest more_numbers
+ */
+{
+    n_number num;
+    LispObj *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    number = ARGUMENT(0);
+
+    if (CONSP(more_numbers))
+	set_number_object(&num, number);
+    else {
+	num.complex = 0;
+	num.real.type = N_FIXNUM;
+	num.real.data.fixnum = 1;
+	goto div_one_argument;
+    }
+
+    for (;;) {
+	number = CAR(more_numbers);
+	more_numbers = CDR(more_numbers);
+
+div_one_argument:
+	div_number_object(&num, number);
+	if (!CONSP(more_numbers))
+	    break;
+    }
+
+    return (make_number_object(&num));
+}
+
+LispObj *
+Lisp_OnePlus(LispBuiltin *builtin)
+/*
+ 1+ number
+ */
+{
+    n_number num;
+    LispObj *number;
+
+    number = ARGUMENT(0);
+    num.complex = 0;
+    num.real.type = N_FIXNUM;
+    num.real.data.fixnum = 1;
+    add_number_object(&num, number);
+
+    return (make_number_object(&num));
+}
+
+LispObj *
+Lisp_OneMinus(LispBuiltin *builtin)
+/*
+ 1- number
+ */
+{
+    n_number num;
+    LispObj *number;
+
+    number = ARGUMENT(0);
+    num.complex = 0;
+    num.real.type = N_FIXNUM;
+    num.real.data.fixnum = -1;
+    add_number_object(&num, number);
+
+    return (make_number_object(&num));
+}
+
+LispObj *
+Lisp_Less(LispBuiltin *builtin)
+/*
+ < number &rest more-numbers
+ */
+{
+    LispObj *compare, *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    compare = ARGUMENT(0);
+
+    if (CONSP(more_numbers)) {
+	do {
+	    number = CAR(more_numbers);
+	    if (cmp_object_object(compare, number, 1) >= 0)
+		return (NIL);
+	    compare = number;
+	    more_numbers = CDR(more_numbers);
+	} while (CONSP(more_numbers));
+    }
+    else {
+	CHECK_REAL(compare);
+    }
+
+    return (T);
+}
+
+LispObj *
+Lisp_LessEqual(LispBuiltin *builtin)
+/*
+ <= number &rest more-numbers
+ */
+{
+    LispObj *compare, *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    compare = ARGUMENT(0);
+
+    if (CONSP(more_numbers)) {
+	do {
+	    number = CAR(more_numbers);
+	    if (cmp_object_object(compare, number, 1) > 0)
+		return (NIL);
+	    compare = number;
+	    more_numbers = CDR(more_numbers);
+	} while (CONSP(more_numbers));
+    }
+    else {
+	CHECK_REAL(compare);
+    }
+
+    return (T);
+}
+
+LispObj *
+Lisp_Equal_(LispBuiltin *builtin)
+/*
+ = number &rest more-numbers
+ */
+{
+    LispObj *compare, *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    compare = ARGUMENT(0);
+
+    if (CONSP(more_numbers)) {
+	do {
+	    number = CAR(more_numbers);
+	    if (cmp_object_object(compare, number, 0) != 0)
+		return (NIL);
+	    compare = number;
+	    more_numbers = CDR(more_numbers);
+	} while (CONSP(more_numbers));
+    }
+    else {
+	CHECK_REAL(compare);
+    }
+
+    return (T);
+}
+
+LispObj *
+Lisp_Greater(LispBuiltin *builtin)
+/*
+ > number &rest more-numbers
+ */
+{
+    LispObj *compare, *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    compare = ARGUMENT(0);
+
+    if (CONSP(more_numbers)) {
+	do {
+	    number = CAR(more_numbers);
+	    if (cmp_object_object(compare, number, 1) <= 0)
+		return (NIL);
+	    compare = number;
+	    more_numbers = CDR(more_numbers);
+	} while (CONSP(more_numbers));
+    }
+    else {
+	CHECK_REAL(compare);
+    }
+
+    return (T);
+}
+
+LispObj *
+Lisp_GreaterEqual(LispBuiltin *builtin)
+/*
+ >= number &rest more-numbers
+ */
+{
+    LispObj *compare, *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    compare = ARGUMENT(0);
+
+    if (CONSP(more_numbers)) {
+	do {
+	    number = CAR(more_numbers);
+	    if (cmp_object_object(compare, number, 1) < 0)
+		return (NIL);
+	    compare = number;
+	    more_numbers = CDR(more_numbers);
+	} while (CONSP(more_numbers));
+    }
+    else {
+	CHECK_REAL(compare);
+    }
+
+    return (T);
+}
+
+LispObj *
+Lisp_NotEqual(LispBuiltin *builtin)
+/*
+ /= number &rest more-numbers
+ */
+{
+    LispObj *object, *compare, *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    number = ARGUMENT(0);
+
+    if (!CONSP(more_numbers)) {
+	CHECK_REAL(number);
+
+	return (T);
+    }
+
+    /* compare all numbers */
+    while (1) {
+	compare = number;
+	for (object = more_numbers; CONSP(object); object = CDR(object)) {
+	    number = CAR(object);
+
+	    if (cmp_object_object(compare, number, 0) == 0)
+		return (NIL);
+	}
+	if (CONSP(more_numbers)) {
+	    number = CAR(more_numbers);
+	    more_numbers = CDR(more_numbers);
+	}
+	else
+	    break;
+    }
+
+    return (T);
+}
+
+LispObj *
+Lisp_Min(LispBuiltin *builtin)
+/*
+ min number &rest more-numbers
+ */
+{
+    LispObj *result, *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (CONSP(more_numbers)) {
+	do {
+	    number = CAR(more_numbers);
+	    if (cmp_object_object(result, number, 1) > 0)
+		result = number;
+	    more_numbers = CDR(more_numbers);
+	} while (CONSP(more_numbers));
+    }
+    else {
+	CHECK_REAL(result);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Max(LispBuiltin *builtin)
+/*
+ max number &rest more-numbers
+ */
+{
+    LispObj *result, *number, *more_numbers;
+
+    more_numbers = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (CONSP(more_numbers)) {
+	do {
+	    number = CAR(more_numbers);
+	    if (cmp_object_object(result, number, 1) < 0)
+		result = number;
+	    more_numbers = CDR(more_numbers);
+	} while (CONSP(more_numbers));
+    }
+    else {
+	CHECK_REAL(result);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Abs(LispBuiltin *builtin)
+/*
+ abs number
+ */
+{
+    LispObj *result, *number;
+
+    result = number = ARGUMENT(0);
+
+    switch (OBJECT_TYPE(number)) {
+	case LispFixnum_t:
+	case LispInteger_t:
+	case LispBignum_t:
+	case LispDFloat_t:
+	case LispRatio_t:
+	case LispBigratio_t:
+	    if (cmp_real_object(&zero, number) > 0) {
+		n_real real;
+
+		set_real_object(&real, number);
+		neg_real(&real);
+		result = make_real_object(&real);
+	    }
+	    break;
+	case LispComplex_t: {
+	    n_number num;
+
+	    set_number_object(&num, number);
+	    abs_number(&num);
+	    result = make_number_object(&num);
+	}   break;
+	default:
+	    fatal_builtin_object_error(builtin, number, NOT_A_NUMBER);
+	    break;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Complex(LispBuiltin *builtin)
+/*
+ complex realpart &optional imagpart
+ */
+{
+    LispObj *realpart, *imagpart;
+
+    imagpart = ARGUMENT(1);
+    realpart = ARGUMENT(0);
+
+    CHECK_REAL(realpart);
+
+    if (imagpart == UNSPEC)
+	return (realpart);
+    else {
+	CHECK_REAL(imagpart);
+    }
+    if (!FLOATP(imagpart) && cmp_real_object(&zero, imagpart) == 0)
+	return (realpart);
+
+    return (COMPLEX(realpart, imagpart));
+}
+
+LispObj *
+Lisp_Complexp(LispBuiltin *builtin)
+/*
+ complexp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (COMPLEXP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_Conjugate(LispBuiltin *builtin)
+/*
+ conjugate number
+ */
+{
+    n_number num;
+    LispObj *number, *realpart, *imagpart;
+
+    number = ARGUMENT(0);
+
+    CHECK_NUMBER(number);
+
+    if (REALP(number))
+	return (number);
+
+    realpart = OCXR(number);
+    num.complex = 0;
+    num.real.type = N_FIXNUM;
+    num.real.data.fixnum = -1;
+    mul_number_object(&num, OCXI(number));
+    imagpart = make_number_object(&num);
+
+    return (COMPLEX(realpart, imagpart));
+}
+
+LispObj *
+Lisp_Decf(LispBuiltin *builtin)
+/*
+ decf place &optional delta
+ */
+{
+    n_number num;
+    LispObj *place, *delta, *number;
+
+    delta = ARGUMENT(1);
+    place = ARGUMENT(0);
+
+    if (SYMBOLP(place)) {
+	number = LispGetVar(place);
+	if (number == NULL)
+	    LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
+    }
+    else
+	number = EVAL(place);
+
+    if (delta != UNSPEC) {
+	LispObj *operand;
+
+	operand = EVAL(delta);
+	set_number_object(&num, number);
+	sub_number_object(&num, operand);
+	number = make_number_object(&num);
+    }
+    else {
+	num.complex = 0;
+	num.real.type = N_FIXNUM;
+	num.real.data.fixnum = -1;
+	add_number_object(&num, number);
+	number = make_number_object(&num);
+    }
+
+    if (SYMBOLP(place)) {
+	CHECK_CONSTANT(place);
+	LispSetVar(place, number);
+    }
+    else {
+	GC_ENTER();
+
+	GC_PROTECT(number);
+	(void)APPLY2(Osetf, place, number);
+	GC_LEAVE();
+    }
+
+    return (number);
+}
+
+LispObj *
+Lisp_Denominator(LispBuiltin *builtin)
+/*
+ denominator rational
+ */
+{
+    LispObj *result, *rational;
+
+    rational = ARGUMENT(0);
+
+    switch (OBJECT_TYPE(rational)) {
+	case LispFixnum_t:
+	case LispInteger_t:
+	case LispBignum_t:
+	    result = FIXNUM(1);
+	    break;
+	case LispRatio_t:
+	    result = INTEGER(OFRD(rational));
+	    break;
+	case LispBigratio_t:
+	    if (mpi_fiti(OBRD(rational)))
+		result = INTEGER(mpi_geti(OBRD(rational)));
+	    else {
+		mpi *den = XALLOC(mpi);
+
+		mpi_init(den);
+		mpi_set(den, OBRD(rational));
+		result = BIGNUM(den);
+	    }
+	    break;
+	default:
+	    LispDestroy("%s: %s is not a rational number",
+			STRFUN(builtin), STROBJ(rational));
+	    /*NOTREACHED*/
+	    result = NIL;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Evenp(LispBuiltin *builtin)
+/*
+ evenp integer
+ */
+{
+    LispObj *result, *integer;
+
+    integer = ARGUMENT(0);
+
+    switch (OBJECT_TYPE(integer)) {
+	case LispFixnum_t:
+	    result = FIXNUM_VALUE(integer) % 2 ? NIL : T;
+	    break;
+	case LispInteger_t:
+	    result = INT_VALUE(integer) % 2 ? NIL : T;
+	    break;
+	case LispBignum_t:
+	    result = mpi_remi(OBI(integer), 2) ? NIL : T;
+	    break;
+	default:
+	    fatal_builtin_object_error(builtin, integer, NOT_AN_INTEGER);
+	    /*NOTREACHED*/
+	    result = NIL;
+    }
+
+    return (result);
+}
+
+/* only one float format */
+LispObj *
+Lisp_Float(LispBuiltin *builtin)
+/*
+ float number &optional other
+ */
+{
+    LispObj *number, *other;
+
+    other = ARGUMENT(1);
+    number = ARGUMENT(0);
+
+    if (other != UNSPEC) {
+	CHECK_DFLOAT(other);
+    }
+
+    return (LispFloatCoerce(builtin, number));
+}
+
+LispObj *
+LispFloatCoerce(LispBuiltin *builtin, LispObj *number)
+{
+    double value;
+
+    switch (OBJECT_TYPE(number)) {
+	case LispFixnum_t:
+	    value = FIXNUM_VALUE(number);
+	    break;
+	case LispInteger_t:
+	    value = INT_VALUE(number);
+	    break;
+	case LispBignum_t:
+	    value = mpi_getd(OBI(number));
+	    break;
+	case LispDFloat_t:
+	    return (number);
+	case LispRatio_t:
+	    value = (double)OFRN(number) / (double)OFRD(number);
+	    break;
+	case LispBigratio_t:
+	    value = mpr_getd(OBR(number));
+	    break;
+	default:
+	    value = 0.0;
+	    fatal_builtin_object_error(builtin, number, NOT_A_REAL_NUMBER);
+	    break;
+    }
+
+    if (!finite(value))
+	fatal_error(FLOATING_POINT_OVERFLOW);
+
+    return (DFLOAT(value));
+}
+
+LispObj *
+Lisp_Floatp(LispBuiltin *builtin)
+/*
+ floatp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (FLOATP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_Gcd(LispBuiltin *builtin)
+/*
+ gcd &rest integers
+ */
+{
+    n_real real;
+    LispObj *integers, *integer, *operand;
+
+    integers = ARGUMENT(0);
+
+    if (!CONSP(integers))
+	return (FIXNUM(0));
+
+    integer = CAR(integers);
+
+    CHECK_INTEGER(integer);
+    set_real_object(&real, integer);
+    integers = CDR(integers);
+
+    for (; CONSP(integers); integers = CDR(integers)) {
+	operand = CAR(integers);
+	gcd_real_object(&real, operand);
+    }
+    abs_real(&real);
+
+    return (make_real_object(&real));
+}
+
+LispObj *
+Lisp_Imagpart(LispBuiltin *builtin)
+/*
+ imagpart number
+ */
+{
+    LispObj *number;
+
+    number = ARGUMENT(0);
+
+    if (COMPLEXP(number))
+	return (OCXI(number));
+    else {
+	CHECK_REAL(number);
+    }
+
+    return (FIXNUM(0));
+}
+
+LispObj *
+Lisp_Incf(LispBuiltin *builtin)
+/*
+ incf place &optional delta
+ */
+{
+    n_number num;
+    LispObj *place, *delta, *number;
+
+    delta = ARGUMENT(1);
+    place = ARGUMENT(0);
+
+    if (SYMBOLP(place)) {
+	number = LispGetVar(place);
+	if (number == NULL)
+	    LispDestroy("EVAL: the variable %s is unbound", STROBJ(place));
+    }
+    else
+	number = EVAL(place);
+
+    if (delta != UNSPEC) {
+	LispObj *operand;
+
+	operand = EVAL(delta);
+	set_number_object(&num, number);
+	add_number_object(&num, operand);
+	number = make_number_object(&num);
+    }
+    else {
+	num.complex = 0;
+	num.real.type = N_FIXNUM;
+	num.real.data.fixnum = 1;
+	add_number_object(&num, number);
+	number = make_number_object(&num);
+    }
+
+    if (SYMBOLP(place)) {
+	CHECK_CONSTANT(place);
+	LispSetVar(place, number);
+    }
+    else {
+	GC_ENTER();
+
+	GC_PROTECT(number);
+	(void)APPLY2(Osetf, place, number);
+	GC_LEAVE();
+    }
+
+    return (number);
+}
+
+LispObj *
+Lisp_Integerp(LispBuiltin *builtin)
+/*
+ integerp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (INTEGERP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_Isqrt(LispBuiltin *builtin)
+/*
+ isqrt natural
+ */
+{
+    LispObj *natural, *result;
+
+    natural = ARGUMENT(0);
+
+    if (cmp_object_object(natural, obj_zero, 1) < 0)
+	goto not_a_natural_number;
+
+    switch (OBJECT_TYPE(natural)) {
+	case LispFixnum_t:
+	    result = FIXNUM((long)floor(sqrt(FIXNUM_VALUE(natural))));
+	    break;
+	case LispInteger_t:
+	    result = INTEGER((long)floor(sqrt(INT_VALUE(natural))));
+	    break;
+	case LispBignum_t: {
+	    mpi *bigi;
+
+	    bigi = XALLOC(mpi);
+	    mpi_init(bigi);
+	    mpi_sqrt(bigi, OBI(natural));
+	    if (mpi_fiti(bigi)) {
+		result = INTEGER(mpi_geti(bigi));
+		mpi_clear(bigi);
+		XFREE(bigi);
+	    }
+	    else
+		result = BIGNUM(bigi);
+	}   break;
+	default:
+	    goto not_a_natural_number;
+    }
+
+    return (result);
+
+not_a_natural_number:
+    LispDestroy("%s: %s is not a natural number",
+		STRFUN(builtin), STROBJ(natural));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+Lisp_Lcm(LispBuiltin *builtin)
+/*
+ lcm &rest integers
+ */
+{
+    n_real real, gcd;
+    LispObj *integers, *operand;
+
+    integers = ARGUMENT(0);
+
+    if (!CONSP(integers))
+	return (FIXNUM(1));
+
+    operand = CAR(integers);
+
+    CHECK_INTEGER(operand);
+    set_real_object(&real, operand);
+    integers = CDR(integers);
+
+    gcd.type = N_FIXNUM;
+    gcd.data.fixnum = 0;
+
+    for (; CONSP(integers); integers = CDR(integers)) {
+	operand = CAR(integers);
+
+	if (real.type == N_FIXNUM && real.data.fixnum == 0)
+	    break;
+
+	/* calculate gcd before changing integer */
+	clear_real(&gcd);
+	set_real_real(&gcd, &real);
+	gcd_real_object(&gcd, operand);
+
+	/* calculate lcm */
+	mul_real_object(&real, operand);
+	div_real_real(&real, &gcd);
+    }
+    clear_real(&gcd);
+    abs_real(&real);
+
+    return (make_real_object(&real));
+}
+
+LispObj *
+Lisp_Logand(LispBuiltin *builtin)
+/*
+ logand &rest integers
+ */
+{
+    n_real real;
+
+    LispObj *integers;
+
+    integers = ARGUMENT(0);
+
+    real.type = N_FIXNUM;
+    real.data.fixnum = -1;
+
+    for (; CONSP(integers); integers = CDR(integers))
+	and_real_object(&real, CAR(integers));
+
+    return (make_real_object(&real));
+}
+
+LispObj *
+Lisp_Logeqv(LispBuiltin *builtin)
+/*
+ logeqv &rest integers
+ */
+{
+    n_real real;
+
+    LispObj *integers;
+
+    integers = ARGUMENT(0);
+
+    real.type = N_FIXNUM;
+    real.data.fixnum = -1;
+
+    for (; CONSP(integers); integers = CDR(integers))
+	eqv_real_object(&real, CAR(integers));
+
+    return (make_real_object(&real));
+}
+
+LispObj *
+Lisp_Logior(LispBuiltin *builtin)
+/*
+ logior &rest integers
+ */
+{
+    n_real real;
+
+    LispObj *integers;
+
+    integers = ARGUMENT(0);
+
+    real.type = N_FIXNUM;
+    real.data.fixnum = 0;
+
+    for (; CONSP(integers); integers = CDR(integers))
+	ior_real_object(&real, CAR(integers));
+
+    return (make_real_object(&real));
+}
+
+LispObj *
+Lisp_Lognot(LispBuiltin *builtin)
+/*
+ lognot integer
+ */
+{
+    n_real real;
+
+    LispObj *integer;
+
+    integer = ARGUMENT(0);
+
+    CHECK_INTEGER(integer);
+
+    set_real_object(&real, integer);
+    not_real(&real);
+
+    return (make_real_object(&real));
+}
+
+LispObj *
+Lisp_Logxor(LispBuiltin *builtin)
+/*
+ logxor &rest integers
+ */
+{
+    n_real real;
+
+    LispObj *integers;
+
+    integers = ARGUMENT(0);
+
+    real.type = N_FIXNUM;
+    real.data.fixnum = 0;
+
+    for (; CONSP(integers); integers = CDR(integers))
+	xor_real_object(&real, CAR(integers));
+
+    return (make_real_object(&real));
+}
+
+LispObj *
+Lisp_Minusp(LispBuiltin *builtin)
+/*
+ minusp number
+ */
+{
+    LispObj *number;
+
+    number = ARGUMENT(0);
+
+    CHECK_REAL(number);
+
+    return (cmp_real_object(&zero, number) > 0 ? T : NIL);
+}
+
+LispObj *
+Lisp_Mod(LispBuiltin *builtin)
+/*
+ mod number divisor
+ */
+{
+    LispObj *result;
+
+    LispObj *number, *divisor;
+
+    divisor = ARGUMENT(1);
+    number = ARGUMENT(0);
+
+    if (INTEGERP(number) && INTEGERP(divisor)) {
+	n_real real;
+
+	set_real_object(&real, number);
+	mod_real_object(&real, divisor);
+	result = make_real_object(&real);
+    }
+    else {
+	n_number num;
+
+	set_number_object(&num, number);
+	divide_number_object(&num, divisor, NDIVIDE_FLOOR, 0);
+	result = make_real_object(&(num.imag));
+	clear_real(&(num.real));
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Numberp(LispBuiltin *builtin)
+/*
+ numberp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (NUMBERP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_Numerator(LispBuiltin *builtin)
+/*
+ numerator rational
+ */
+{
+    LispObj *result, *rational;
+
+    rational = ARGUMENT(0);
+
+    switch (OBJECT_TYPE(rational)) {
+	case LispFixnum_t:
+	case LispInteger_t:
+	case LispBignum_t:
+	    result = rational;
+	    break;
+	case LispRatio_t:
+	    result = INTEGER(OFRN(rational));
+	    break;
+	case LispBigratio_t:
+	    if (mpi_fiti(OBRN(rational)))
+		result = INTEGER(mpi_geti(OBRN(rational)));
+	    else {
+		mpi *num = XALLOC(mpi);
+
+		mpi_init(num);
+		mpi_set(num, OBRN(rational));
+		result = BIGNUM(num);
+	    }
+	    break;
+	default:
+	    LispDestroy("%s: %s is not a rational number",
+			STRFUN(builtin), STROBJ(rational));
+	    /*NOTREACHED*/
+	    result = NIL;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Oddp(LispBuiltin *builtin)
+/*
+ oddp integer
+ */
+{
+    LispObj *result, *integer;
+
+    integer = ARGUMENT(0);
+
+    switch (OBJECT_TYPE(integer)) {
+	case LispFixnum_t:
+	    result = FIXNUM_VALUE(integer) % 2 ? T : NIL;
+	    break;
+	case LispInteger_t:
+	    result = INT_VALUE(integer) % 2 ? T : NIL;
+	    break;
+	case LispBignum_t:
+	    result = mpi_remi(OBI(integer), 2) ? T : NIL;
+	    break;
+	default:
+	    fatal_builtin_object_error(builtin, integer, NOT_AN_INTEGER);
+	    /*NOTREACHED*/
+	    result = NIL;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Plusp(LispBuiltin *builtin)
+/*
+ plusp number
+ */
+{
+    LispObj *number;
+
+    number = ARGUMENT(0);
+
+    CHECK_REAL(number);
+
+    return (cmp_real_object(&zero, number) < 0 ? T : NIL);
+}
+
+LispObj *
+Lisp_Rational(LispBuiltin *builtin)
+/*
+ rational number
+ */
+{
+    LispObj *number;
+
+    number = ARGUMENT(0);
+
+    if (DFLOATP(number)) {
+	double numerator = ODF(number);
+
+	if ((long)numerator == numerator)
+	    number = INTEGER(numerator);
+	else {
+	    n_real real;
+	    mpr *bigr = XALLOC(mpr);
+
+	    mpr_init(bigr);
+	    mpr_setd(bigr, numerator);
+	    real.type = N_BIGRATIO;
+	    real.data.bigratio = bigr;
+	    rbr_canonicalize(&real);
+	    number = make_real_object(&real);
+	}
+    }
+    else {
+	CHECK_REAL(number);
+    }
+
+    return (number);
+}
+
+LispObj *
+Lisp_Rationalp(LispBuiltin *builtin)
+/*
+ rationalp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (RATIONALP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_Realpart(LispBuiltin *builtin)
+/*
+ realpart number
+ */
+{
+    LispObj *number;
+
+    number = ARGUMENT(0);
+
+    if (COMPLEXP(number))
+	return (OCXR(number));
+    else {
+	CHECK_REAL(number);
+    }
+
+    return (number);
+}
+
+LispObj *
+Lisp_Rem(LispBuiltin *builtin)
+/*
+ rem number divisor
+ */
+{
+    LispObj *result;
+
+    LispObj *number, *divisor;
+
+    divisor = ARGUMENT(1);
+    number = ARGUMENT(0);
+
+    if (INTEGERP(number) && INTEGERP(divisor)) {
+	n_real real;
+
+	set_real_object(&real, number);
+	rem_real_object(&real, divisor);
+	result = make_real_object(&real);
+    }
+    else {
+	n_number num;
+
+	set_number_object(&num, number);
+	divide_number_object(&num, divisor, NDIVIDE_TRUNC, 0);
+	result = make_real_object(&(num.imag));
+	clear_real(&(num.real));
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Sqrt(LispBuiltin *builtin)
+/*
+ sqrt number
+ */
+{
+    n_number num;
+    LispObj *number;
+
+    number = ARGUMENT(0);
+
+    set_number_object(&num, number);
+    sqrt_number(&num);
+
+    return (make_number_object(&num));
+}
+
+LispObj *
+Lisp_Zerop(LispBuiltin *builtin)
+/*
+ zerop number
+ */
+{
+    LispObj *result, *number;
+
+    number = ARGUMENT(0);
+
+    switch (OBJECT_TYPE(number)) {
+	case LispFixnum_t:
+	case LispInteger_t:
+	case LispBignum_t:
+	case LispDFloat_t:
+	case LispRatio_t:
+	case LispBigratio_t:
+	    result = cmp_real_object(&zero, number) == 0 ? T : NIL;
+	    break;
+	case LispComplex_t:
+	    result = cmp_real_object(&zero, OCXR(number)) == 0 &&
+		     cmp_real_object(&zero, OCXI(number)) == 0 ? T : NIL;
+	    break;
+	default:
+	    fatal_builtin_object_error(builtin, number, NOT_A_NUMBER);
+	    /*NOTREACHED*/
+	    result = NIL;
+    }
+
+    return (result);
+}
+
+static LispObj *
+LispDivide(LispBuiltin *builtin, int fun, int flo)
+{
+    n_number num;
+    LispObj *number, *divisor;
+
+    divisor = ARGUMENT(1);
+    number = ARGUMENT(0);
+
+    RETURN_COUNT = 1;
+
+    if (cmp_real_object(&zero, number) == 0) {
+	if (divisor != NIL) {
+	    CHECK_REAL(divisor);
+	}
+
+	return (RETURN(0) = obj_zero);
+    }
+
+    if (divisor == UNSPEC)
+	divisor = obj_one;
+
+    set_number_object(&num, number);
+    if (num.complex)
+	fatal_builtin_object_error(builtin, divisor, NOT_A_REAL_NUMBER);
+
+    divide_number_object(&num, divisor, fun, flo);
+    RETURN(0) = make_real_object(&(num.imag));
+
+    return (make_real_object(&(num.real)));
+}
+
+LispObj *
+Lisp_Ceiling(LispBuiltin *builtin)
+/*
+ ceiling number &optional divisor
+ */
+{
+    return (LispDivide(builtin, NDIVIDE_CEIL, 0));
+}
+
+LispObj *
+Lisp_Fceiling(LispBuiltin *builtin)
+/*
+ fceiling number &optional divisor
+ */
+{
+    return (LispDivide(builtin, NDIVIDE_CEIL, 1));
+}
+
+LispObj *
+Lisp_Floor(LispBuiltin *builtin)
+/*
+ floor number &optional divisor
+ */
+{
+    return (LispDivide(builtin, NDIVIDE_FLOOR, 0));
+}
+
+LispObj *
+Lisp_Ffloor(LispBuiltin *builtin)
+/*
+ ffloor number &optional divisor
+ */
+{
+    return (LispDivide(builtin, NDIVIDE_FLOOR, 1));
+}
+
+LispObj *
+Lisp_Round(LispBuiltin *builtin)
+/*
+ round number &optional divisor
+ */
+{
+    return (LispDivide(builtin, NDIVIDE_ROUND, 0));
+}
+
+LispObj *
+Lisp_Fround(LispBuiltin *builtin)
+/*
+ fround number &optional divisor
+ */
+{
+    return (LispDivide(builtin, NDIVIDE_ROUND, 1));
+}
+
+LispObj *
+Lisp_Truncate(LispBuiltin *builtin)
+/*
+ truncate number &optional divisor
+ */
+{
+    return (LispDivide(builtin, NDIVIDE_TRUNC, 0));
+}
+
+LispObj *
+Lisp_Ftruncate(LispBuiltin *builtin)
+/*
+ ftruncate number &optional divisor
+ */
+{
+    return (LispDivide(builtin, NDIVIDE_TRUNC, 1));
+}
diff --git a/lisp/math.h b/lisp/math.h
new file mode 100644
index 0000000..8297d43
--- /dev/null
+++ b/lisp/math.h
@@ -0,0 +1,100 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/math.h,v 1.6 2002/11/08 08:00:57 paulo Exp $ */
+
+#ifndef Lisp_math_h
+#define Lisp_math_h
+
+#include "internal.h"
+#include "mp.h"
+
+void LispMathInit(void);
+LispObj *LispFloatCoerce(LispBuiltin*, LispObj*);
+
+LispObj *Lisp_Mul(LispBuiltin*);
+LispObj *Lisp_Plus(LispBuiltin*);
+LispObj *Lisp_Minus(LispBuiltin*);
+LispObj *Lisp_Div(LispBuiltin*);
+LispObj *Lisp_OnePlus(LispBuiltin*);
+LispObj *Lisp_OneMinus(LispBuiltin*);
+LispObj *Lisp_Less(LispBuiltin*);
+LispObj *Lisp_LessEqual(LispBuiltin*);
+LispObj *Lisp_Equal_(LispBuiltin*);
+LispObj *Lisp_Greater(LispBuiltin*);
+LispObj *Lisp_GreaterEqual(LispBuiltin*);
+LispObj *Lisp_NotEqual(LispBuiltin*);
+LispObj *Lisp_Max(LispBuiltin*);
+LispObj *Lisp_Min(LispBuiltin*);
+LispObj *Lisp_Mod(LispBuiltin*);
+LispObj *Lisp_Abs(LispBuiltin*);
+LispObj *Lisp_Complex(LispBuiltin*);
+LispObj *Lisp_Complexp(LispBuiltin*);
+LispObj *Lisp_Conjugate(LispBuiltin*);
+LispObj *Lisp_Decf(LispBuiltin*);
+LispObj *Lisp_Denominator(LispBuiltin*);
+LispObj *Lisp_Evenp(LispBuiltin*);
+LispObj *Lisp_Float(LispBuiltin*);
+LispObj *Lisp_Floatp(LispBuiltin*);
+LispObj *Lisp_Gcd(LispBuiltin*);
+LispObj *Lisp_Imagpart(LispBuiltin*);
+LispObj *Lisp_Incf(LispBuiltin*);
+LispObj *Lisp_Integerp(LispBuiltin*);
+LispObj *Lisp_Isqrt(LispBuiltin*);
+LispObj *Lisp_Lcm(LispBuiltin*);
+LispObj *Lisp_Logand(LispBuiltin*);
+LispObj *Lisp_Logeqv(LispBuiltin*);
+LispObj *Lisp_Logior(LispBuiltin*);
+LispObj *Lisp_Lognot(LispBuiltin*);
+LispObj *Lisp_Logxor(LispBuiltin*);
+LispObj *Lisp_Minusp(LispBuiltin*);
+LispObj *Lisp_Numberp(LispBuiltin*);
+LispObj *Lisp_Numerator(LispBuiltin*);
+LispObj *Lisp_Oddp(LispBuiltin*);
+LispObj *Lisp_Plusp(LispBuiltin*);
+LispObj *Lisp_Rational(LispBuiltin*);
+#if 0
+LispObj *Lisp_Rationalize(LispBuiltin*);
+#endif
+LispObj *Lisp_Rationalp(LispBuiltin*);
+LispObj *Lisp_Realpart(LispBuiltin*);
+LispObj *Lisp_Rem(LispBuiltin*);
+LispObj *Lisp_Sqrt(LispBuiltin*);
+LispObj *Lisp_Zerop(LispBuiltin*);
+LispObj *Lisp_Ceiling(LispBuiltin*);
+LispObj *Lisp_Fceiling(LispBuiltin*);
+LispObj *Lisp_Floor(LispBuiltin*);
+LispObj *Lisp_Ffloor(LispBuiltin*);
+LispObj *Lisp_Round(LispBuiltin*);
+LispObj *Lisp_Fround(LispBuiltin*);
+LispObj *Lisp_Truncate(LispBuiltin*);
+LispObj *Lisp_Ftruncate(LispBuiltin*);
+
+
+#endif /* Lisp_math_h */
diff --git a/lisp/mathimp.c b/lisp/mathimp.c
new file mode 100644
index 0000000..ccda576
--- /dev/null
+++ b/lisp/mathimp.c
@@ -0,0 +1,5225 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/mathimp.c,v 1.14 2003/01/30 02:46:25 paulo Exp $ */
+
+
+/*
+ * Defines
+ */
+#ifdef __GNUC__
+#define CONST			__attribute__ ((__const__))
+#else
+#define CONST			/**/
+#endif
+
+/* mask for checking overflow on long operations */
+#ifdef LONG64
+#define FI_MASK			0x4000000000000000L
+#define LONGSBITS		63
+#else
+#define FI_MASK			0x40000000L
+#define LONGSBITS		31
+#endif
+
+#define N_FIXNUM		1
+#define N_BIGNUM		2
+#define N_FLONUM		3
+#define N_FIXRATIO		4
+#define N_BIGRATIO		5
+
+#define NOP_ADD			1
+#define NOP_SUB			2
+#define NOP_MUL			3
+#define NOP_DIV			4
+
+#define NDIVIDE_CEIL		1
+#define NDIVIDE_FLOOR		2
+#define NDIVIDE_ROUND		3
+#define NDIVIDE_TRUNC		4
+
+/* real part from number */
+#define NREAL(num)		&((num)->real)
+#define NRTYPE(num)		(num)->real.type
+#define NRFI(num)		(num)->real.data.fixnum
+#define NRBI(num)		(num)->real.data.bignum
+#define NRFF(num)		(num)->real.data.flonum
+#define NRFRN(Num)		(Num)->real.data.fixratio.num
+#define NRFRD(num)		(num)->real.data.fixratio.den
+#define NRBR(num)		(num)->real.data.bigratio
+#define NRBRN(num)		mpr_num(NRBR(num))
+#define NRBRD(num)		mpr_den(NRBR(num))
+
+#define NRCLEAR_BI(num)		mpi_clear(NRBI(num)); XFREE(NRBI(num))
+#define NRCLEAR_BR(num)		mpr_clear(NRBR(num)); XFREE(NRBR(num))
+
+/* imag part from number */
+#define NIMAG(num)		&((num)->imag)
+#define NITYPE(num)		(num)->imag.type
+#define NIFI(num)		(num)->imag.data.fixnum
+#define NIBI(num)		(num)->imag.data.bignum
+#define NIFF(num)		(num)->imag.data.flonum
+#define NIFRN(Num)		(Num)->imag.data.fixratio.num
+#define NIFRD(num)		(num)->imag.data.fixratio.den
+#define NIBR(num)		(num)->imag.data.bigratio
+#define NIBRN(obj)		mpr_num(NIBR(obj))
+#define NIBRD(obj)		mpr_den(NIBR(obj))
+
+/* real number fields */
+#define RTYPE(real)		(real)->type
+#define RFI(real)		(real)->data.fixnum
+#define RBI(real)		(real)->data.bignum
+#define RFF(real)		(real)->data.flonum
+#define RFRN(real)		(real)->data.fixratio.num
+#define RFRD(real)		(real)->data.fixratio.den
+#define RBR(real)		(real)->data.bigratio
+#define RBRN(real)		mpr_num(RBR(real))
+#define RBRD(real)		mpr_den(RBR(real))
+
+#define RINTEGERP(real)				\
+    (RTYPE(real) == N_FIXNUM || RTYPE(real) == N_BIGNUM)
+
+#define RCLEAR_BI(real)		mpi_clear(RBI(real)); XFREE(RBI(real))
+#define RCLEAR_BR(real)		mpr_clear(RBR(real)); XFREE(RBR(real))
+
+/* numeric value from lisp object */
+#define OFI(object)		FIXNUM_VALUE(object)
+#define OII(object)		INT_VALUE(object)
+#define OBI(object)		(object)->data.mp.integer
+#define ODF(object)		DFLOAT_VALUE(object)
+#define OFRN(object)		(object)->data.ratio.numerator
+#define OFRD(object)		(object)->data.ratio.denominator
+#define OBR(object)		(object)->data.mp.ratio
+#define OBRN(object)		mpr_num(OBR(object))
+#define OBRD(object)		mpr_den(OBR(object))
+#define OCXR(object)		(object)->data.complex.real
+#define OCXI(object)		(object)->data.complex.imag
+
+#define XALLOC(type)		LispMalloc(sizeof(type))
+#define XFREE(ptr)		LispFree(ptr)
+
+
+/*
+ * Types
+ */
+typedef struct _n_real {
+    char type;
+    union {
+	long fixnum;
+	mpi *bignum;
+	double flonum;
+	struct {
+	    long num;
+	    long den;
+	} fixratio;
+	mpr *bigratio;
+    } data;
+} n_real;
+
+typedef struct _n_number {
+    char complex;
+    n_real real;
+    n_real imag;
+} n_number;
+
+
+/*
+ * Prototypes
+ */
+static void number_init(void);
+static LispObj *number_pi(void);
+
+static void set_real_real(n_real*, n_real*);
+static void set_real_object(n_real*, LispObj*);
+static void set_number_object(n_number*, LispObj*);
+static void clear_real(n_real*);
+static void clear_number(n_number*);
+
+static LispObj *make_real_object(n_real*);
+static LispObj *make_number_object(n_number*);
+
+static void fatal_error(int);
+static void fatal_object_error(LispObj*, int);
+static void fatal_builtin_object_error(LispBuiltin*, LispObj*, int);
+
+static double bi_getd(mpi*);
+static double br_getd(mpr*);
+
+/* add */
+static void add_real_object(n_real*, LispObj*);
+static void add_number_object(n_number*, LispObj*);
+
+/* sub */
+static void sub_real_object(n_real*, LispObj*);
+static void sub_number_object(n_number*, LispObj*);
+
+/* mul */
+static void mul_real_object(n_real*, LispObj*);
+static void mul_number_object(n_number*, LispObj*);
+
+/* div */
+static void div_real_object(n_real*, LispObj*);
+static void div_number_object(n_number*, LispObj*);
+
+/* compare */
+static int cmp_real_real(n_real*, n_real*);
+static int cmp_real_object(n_real*, LispObj*);
+#if 0	/* not used */
+static int cmp_number_object(n_number*, LispObj*);
+#endif
+static int cmp_object_object(LispObj*, LispObj*, int);
+
+/* fixnum */
+static INLINE int fi_fi_add_overflow(long, long) CONST;
+static INLINE int fi_fi_sub_overflow(long, long) CONST;
+static INLINE int fi_fi_mul_overflow(long, long) CONST;
+
+/* bignum */
+static void rbi_canonicalize(n_real*);
+
+/* ratio */
+static void rfr_canonicalize(n_real*);
+static void rbr_canonicalize(n_real*);
+
+/* complex */
+static void ncx_canonicalize(n_number*);
+
+/* abs */
+static void abs_real(n_real*);
+static void abs_number(n_number*);
+static void nabs_cx(n_number*);
+static INLINE void rabs_fi(n_real*);
+static INLINE void rabs_bi(n_real*);
+static INLINE void rabs_ff(n_real*);
+static INLINE void rabs_fr(n_real*);
+static INLINE void rabs_br(n_real*);
+
+/* neg */
+static void neg_real(n_real*);
+static void neg_number(n_number*);
+static void rneg_fi(n_real*);
+static INLINE void rneg_bi(n_real*);
+static INLINE void rneg_ff(n_real*);
+static INLINE void rneg_fr(n_real*);
+static INLINE void rneg_br(n_real*);
+
+/* sqrt */
+static void sqrt_real(n_real*);
+static void sqrt_number(n_number*);
+static void rsqrt_xi(n_real*);
+static void rsqrt_xr(n_real*);
+static void rsqrt_ff(n_real*);
+static void nsqrt_cx(n_number*);
+static void nsqrt_xi(n_number*);
+static void nsqrt_ff(n_number*);
+static void nsqrt_xr(n_number*);
+
+/* mod */
+static void mod_real_real(n_real*, n_real*);
+static void mod_real_object(n_real*, LispObj*);
+static void rmod_fi_fi(n_real*, long);
+static void rmod_fi_bi(n_real*, mpi*);
+static void rmod_bi_fi(n_real*, long);
+static void rmod_bi_bi(n_real*, mpi*);
+
+/* rem */
+static void rem_real_object(n_real*, LispObj*);
+static void rrem_fi_fi(n_real*, long);
+static void rrem_fi_bi(n_real*, mpi*);
+static void rrem_bi_fi(n_real*, long);
+static void rrem_bi_bi(n_real*, mpi*);
+
+/* gcd */
+static void gcd_real_object(n_real*, LispObj*);
+
+/* and */
+static void and_real_object(n_real*, LispObj*);
+
+/* eqv */
+static void eqv_real_object(n_real*, LispObj*);
+
+/* ior */
+static void ior_real_object(n_real*, LispObj*);
+
+/* not */
+static void not_real(n_real*);
+
+/* xor */
+static void xor_real_object(n_real*, LispObj*);
+
+/* divide */
+static void divide_number_object(n_number*, LispObj*, int, int);
+static void ndivide_xi_xi(n_number*, LispObj*, int, int);
+static void ndivide_flonum(n_number*, double, double, int, int);
+static void ndivide_xi_xr(n_number*, LispObj*, int, int);
+static void ndivide_xr_xi(n_number*, LispObj*, int, int);
+static void ndivide_xr_xr(n_number*, LispObj*, int, int);
+
+/* real complex */
+static void nadd_re_cx(n_number*, LispObj*);
+static void nsub_re_cx(n_number*, LispObj*);
+static void nmul_re_cx(n_number*, LispObj*);
+static void ndiv_re_cx(n_number*, LispObj*);
+
+/* complex real */
+static void nadd_cx_re(n_number*, LispObj*);
+static void nsub_cx_re(n_number*, LispObj*);
+static void nmul_cx_re(n_number*, LispObj*);
+static void ndiv_cx_re(n_number*, LispObj*);
+
+/* complex complex */
+static void nadd_cx_cx(n_number*, LispObj*);
+static void nsub_cx_cx(n_number*, LispObj*);
+static void nmul_cx_cx(n_number*, LispObj*);
+static void ndiv_cx_cx(n_number*, LispObj*);
+static int cmp_cx_cx(LispObj*, LispObj*);
+
+/* flonum flonum */
+static void radd_flonum(n_real*, double, double);
+static void rsub_flonum(n_real*, double, double);
+static void rmul_flonum(n_real*, double, double);
+static void rdiv_flonum(n_real*, double, double);
+static int cmp_flonum(double, double);
+
+/* fixnum fixnum */
+static void rop_fi_fi_bi(n_real*, long, int);
+static INLINE void radd_fi_fi(n_real*, long);
+static INLINE void rsub_fi_fi(n_real*, long);
+static INLINE void rmul_fi_fi(n_real*, long);
+static INLINE void rdiv_fi_fi(n_real*, long);
+static INLINE int cmp_fi_fi(long, long);
+static void ndivide_fi_fi(n_number*, long, int, int);
+
+/* fixnum bignum */
+static void rop_fi_bi_xi(n_real*, mpi*, int);
+static INLINE void radd_fi_bi(n_real*, mpi*);
+static INLINE void rsub_fi_bi(n_real*, mpi*);
+static INLINE void rmul_fi_bi(n_real*, mpi*);
+static void rdiv_fi_bi(n_real*, mpi*);
+static INLINE int cmp_fi_bi(long, mpi*);
+
+/* fixnum fixratio */
+static void rop_fi_fr_as_xr(n_real*, long, long, int);
+static void rop_fi_fr_md_xr(n_real*, long, long, int);
+static INLINE void radd_fi_fr(n_real*, long, long);
+static INLINE void rsub_fi_fr(n_real*, long, long);
+static INLINE void rmul_fi_fr(n_real*, long, long);
+static INLINE void rdiv_fi_fr(n_real*, long, long);
+static INLINE int cmp_fi_fr(long, long, long);
+
+/* fixnum bigratio */
+static void rop_fi_br_as_xr(n_real*, mpr*, int);
+static void rop_fi_br_md_xr(n_real*, mpr*, int);
+static INLINE void radd_fi_br(n_real*, mpr*);
+static INLINE void rsub_fi_br(n_real*, mpr*);
+static INLINE void rmul_fi_br(n_real*, mpr*);
+static INLINE void rdiv_fi_br(n_real*, mpr*);
+static INLINE int cmp_fi_br(long, mpr*);
+
+/* bignum fixnum */
+static INLINE void radd_bi_fi(n_real*, long);
+static INLINE void rsub_bi_fi(n_real*, long);
+static INLINE void rmul_bi_fi(n_real*, long);
+static void rdiv_bi_fi(n_real*, long);
+static INLINE int cmp_bi_fi(mpi*, long);
+
+/* bignum bignum */
+static INLINE void radd_bi_bi(n_real*, mpi*);
+static INLINE void rsub_bi_bi(n_real*, mpi*);
+static INLINE void rmul_bi_bi(n_real*, mpi*);
+static void rdiv_bi_bi(n_real*, mpi*);
+static INLINE int cmp_bi_bi(mpi*, mpi*);
+
+/* bignum fixratio */
+static void rop_bi_fr_as_xr(n_real*, long, long, int);
+static void rop_bi_fr_md_xr(n_real*, long, long, int);
+static INLINE void radd_bi_fr(n_real*, long, long);
+static INLINE void rsub_bi_fr(n_real*, long, long);
+static INLINE void rmul_bi_fr(n_real*, long, long);
+static INLINE void rdiv_bi_fr(n_real*, long, long);
+static int cmp_bi_fr(mpi*, long, long);
+
+/* bignum bigratio */
+static void rop_bi_br_as_xr(n_real*, mpr*, int);
+static void rop_bi_br_md_xr(n_real*, mpr*, int);
+static INLINE void radd_bi_br(n_real*, mpr*);
+static INLINE void rsub_bi_br(n_real*, mpr*);
+static INLINE void rmul_bi_br(n_real*, mpr*);
+static INLINE void rdiv_bi_br(n_real*, mpr*);
+static int cmp_bi_br(mpi*, mpr*);
+
+/* fixratio fixnum */
+static void rop_fr_fi_as_xr(n_real*, long, int);
+static void rop_fr_fi_md_xr(n_real*, long, int);
+static INLINE void radd_fr_fi(n_real*, long);
+static INLINE void rsub_fr_fi(n_real*, long);
+static INLINE void rmul_fr_fi(n_real*, long);
+static INLINE void rdiv_fr_fi(n_real*, long);
+static INLINE int cmp_fr_fi(long, long, long);
+
+/* fixratio bignum */
+static void rop_fr_bi_as_xr(n_real*, mpi*, int);
+static void rop_fr_bi_md_xr(n_real*, mpi*, int);
+static INLINE void radd_fr_bi(n_real*, mpi*);
+static INLINE void rsub_fr_bi(n_real*, mpi*);
+static INLINE void rmul_fr_bi(n_real*, mpi*);
+static INLINE void rdiv_fr_bi(n_real*, mpi*);
+static int cmp_fr_bi(long, long, mpi*);
+
+/* fixratio fixratio */
+static void rop_fr_fr_as_xr(n_real*, long, long, int);
+static void rop_fr_fr_md_xr(n_real*, long, long, int);
+static INLINE void radd_fr_fr(n_real*, long, long);
+static INLINE void rsub_fr_fr(n_real*, long, long);
+static INLINE void rmul_fr_fr(n_real*, long, long);
+static INLINE void rdiv_fr_fr(n_real*, long, long);
+static INLINE int cmp_fr_fr(long, long, long, long);
+
+/* fixratio bigratio */
+static void rop_fr_br_asmd_xr(n_real*, mpr*, int);
+static INLINE void radd_fr_br(n_real*, mpr*);
+static INLINE void rsub_fr_br(n_real*, mpr*);
+static INLINE void rmul_fr_br(n_real*, mpr*);
+static INLINE void rdiv_fr_br(n_real*, mpr*);
+static int cmp_fr_br(long, long, mpr*);
+
+/* bigratio fixnum */
+static void rop_br_fi_asmd_xr(n_real*, long, int);
+static INLINE void radd_br_fi(n_real*, long);
+static INLINE void rsub_br_fi(n_real*, long);
+static INLINE void rmul_br_fi(n_real*, long);
+static INLINE void rdiv_br_fi(n_real*, long);
+static int cmp_br_fi(mpr*, long);
+
+/* bigratio bignum */
+static void rop_br_bi_as_xr(n_real*, mpi*, int);
+static INLINE void radd_br_bi(n_real*, mpi*);
+static INLINE void rsub_br_bi(n_real*, mpi*);
+static INLINE void rmul_br_bi(n_real*, mpi*);
+static INLINE void rdiv_br_bi(n_real*, mpi*);
+static int cmp_br_bi(mpr*, mpi*);
+
+/* bigratio fixratio */
+static void rop_br_fr_asmd_xr(n_real*, long, long, int);
+static INLINE void radd_br_fr(n_real*, long, long);
+static INLINE void rsub_br_fr(n_real*, long, long);
+static INLINE void rmul_br_fr(n_real*, long, long);
+static INLINE void rdiv_br_fr(n_real*, long, long);
+static int cmp_br_fr(mpr*, long, long);
+
+/* bigratio bigratio */
+static INLINE void radd_br_br(n_real*, mpr*);
+static INLINE void rsub_br_br(n_real*, mpr*);
+static INLINE void rmul_br_br(n_real*, mpr*);
+static INLINE void rdiv_br_br(n_real*, mpr*);
+static INLINE int cmp_br_br(mpr*, mpr*);
+
+/*
+ * Initialization
+ */
+static n_real zero, one, two;
+
+static char *fatal_error_strings[] = {
+#define DIVIDE_BY_ZERO			0
+    "divide by zero",
+#define FLOATING_POINT_OVERFLOW		1
+    "floating point overflow",
+#define FLOATING_POINT_EXCEPTION	2
+    "floating point exception"
+};
+
+static char *fatal_object_error_strings[] = {
+#define NOT_A_NUMBER			0
+    "is not a number",
+#define NOT_A_REAL_NUMBER		1
+    "is not a real number",
+#define NOT_AN_INTEGER			2
+    "is not an integer"
+};
+
+/*
+ * Implementation
+ */
+static void
+fatal_error(int num)
+{
+    LispDestroy(fatal_error_strings[num]);
+}
+
+static void
+fatal_object_error(LispObj *obj, int num)
+{
+    LispDestroy("%s %s", STROBJ(obj), fatal_object_error_strings[num]);
+}
+
+static void
+fatal_builtin_object_error(LispBuiltin *builtin, LispObj *obj, int num)
+{
+    LispDestroy("%s: %s %s", STRFUN(builtin), STROBJ(obj),
+		fatal_object_error_strings[num]);
+}
+
+static void
+number_init(void)
+{
+    zero.type = one.type = two.type = N_FIXNUM;
+    zero.data.fixnum = 0;
+    one.data.fixnum = 1;
+    two.data.fixnum = 2;
+}
+
+static double
+bi_getd(mpi *bignum)
+{
+    double value = mpi_getd(bignum);
+
+    if (!finite(value))
+	fatal_error(FLOATING_POINT_EXCEPTION);
+
+    return (value);
+}
+
+static double
+br_getd(mpr *bigratio)
+{
+    double value = mpr_getd(bigratio);
+
+    if (!finite(value))
+	fatal_error(FLOATING_POINT_EXCEPTION);
+
+    return (value);
+}
+
+static LispObj *
+number_pi(void)
+{
+    LispObj *result;
+#ifndef M_PI
+#define M_PI 3.14159265358979323846
+#endif
+    result = DFLOAT(M_PI);
+
+    return (result);
+}
+
+static void
+set_real_real(n_real *real, n_real *val)
+{
+    switch (RTYPE(real) = RTYPE(val)) {
+	case N_FIXNUM:
+	    RFI(real) = RFI(val);
+	    break;
+	case N_BIGNUM:
+	    RBI(real) = XALLOC(mpi);
+	    mpi_init(RBI(real));
+	    mpi_set(RBI(real), RBI(val));
+	    break;
+	case N_FLONUM:
+	    RFF(real) = RFF(val);
+	    break;
+	case N_FIXRATIO:
+	    RFRN(real) = RFRN(val);
+	    RFRD(real) = RFRD(val);
+	    break;
+	case N_BIGRATIO:
+	    RBR(real) = XALLOC(mpr);
+	    mpr_init(RBR(real));
+	    mpr_set(RBR(real), RBR(val));
+	    break;
+    }
+}
+
+static void
+set_real_object(n_real *real, LispObj *obj)
+{
+    switch (OBJECT_TYPE(obj)) {
+	case LispFixnum_t:
+	    RTYPE(real) = N_FIXNUM;
+	    RFI(real) = OFI(obj);
+	    break;
+	case LispInteger_t:
+	    RTYPE(real) = N_FIXNUM;
+	    RFI(real) = OII(obj);
+	    break;
+	case LispBignum_t:
+	    RTYPE(real) = N_BIGNUM;
+	    RBI(real) = XALLOC(mpi);
+	    mpi_init(RBI(real));
+	    mpi_set(RBI(real), OBI(obj));
+	    break;
+	case LispDFloat_t:
+	    RTYPE(real) = N_FLONUM;
+	    RFF(real) = ODF(obj);
+	    break;
+	case LispRatio_t:
+	    RTYPE(real) = N_FIXRATIO;
+	    RFRN(real) = OFRN(obj);
+	    RFRD(real) = OFRD(obj);
+	    break;
+	case LispBigratio_t:
+	    RTYPE(real) = N_BIGRATIO;
+	    RBR(real) = XALLOC(mpr);
+	    mpr_init(RBR(real));
+	    mpr_set(RBR(real), OBR(obj));
+	    break;
+	default:
+	    fatal_object_error(obj, NOT_A_REAL_NUMBER);
+	    break;
+    }
+}
+
+static void
+set_number_object(n_number *num, LispObj *obj)
+{
+    switch (OBJECT_TYPE(obj)) {
+	case LispFixnum_t:
+	    num->complex = 0;
+	    NRTYPE(num) = N_FIXNUM;
+	    NRFI(num) = OFI(obj);
+	    break;
+	case LispInteger_t:
+	    num->complex = 0;
+	    NRTYPE(num) = N_FIXNUM;
+	    NRFI(num) = OII(obj);
+	    break;
+	case LispBignum_t:
+	    num->complex = 0;
+	    NRTYPE(num) = N_BIGNUM;
+	    NRBI(num) = XALLOC(mpi);
+	    mpi_init(NRBI(num));
+	    mpi_set(NRBI(num), OBI(obj));
+	    break;
+	case LispDFloat_t:
+	    num->complex = 0;
+	    NRTYPE(num) = N_FLONUM;
+	    NRFF(num) = ODF(obj);
+	    break;
+	case LispRatio_t:
+	    num->complex = 0;
+	    NRTYPE(num) = N_FIXRATIO;
+	    NRFRN(num) = OFRN(obj);
+	    NRFRD(num) = OFRD(obj);
+	    break;
+	case LispBigratio_t:
+	    num->complex = 0;
+	    NRTYPE(num) = N_BIGRATIO;
+	    NRBR(num) = XALLOC(mpr);
+	    mpr_init(NRBR(num));
+	    mpr_set(NRBR(num), OBR(obj));
+	    break;
+	case LispComplex_t:
+	    num->complex = 1;
+	    set_real_object(NREAL(num), OCXR(obj));
+	    set_real_object(NIMAG(num), OCXI(obj));
+	    break;
+	default:
+	    fatal_object_error(obj, NOT_A_NUMBER);
+	    break;
+    }
+}
+
+static void
+clear_real(n_real *real)
+{
+    if (RTYPE(real) == N_BIGNUM) {
+	mpi_clear(RBI(real));
+	XFREE(RBI(real));
+    }
+    else if (RTYPE(real) == N_BIGRATIO) {
+	mpr_clear(RBR(real));
+	XFREE(RBR(real));
+    }
+}
+
+static void
+clear_number(n_number *num)
+{
+    clear_real(NREAL(num));
+    if (num->complex)
+	clear_real(NIMAG(num));
+}
+
+static LispObj *
+make_real_object(n_real *real)
+{
+    LispObj *obj;
+
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	    if (RFI(real) > MOST_POSITIVE_FIXNUM ||
+		RFI(real) < MOST_NEGATIVE_FIXNUM) {
+		obj = LispNew(NIL, NIL);
+		obj->type = LispInteger_t;
+		OII(obj) = RFI(real);
+	    }
+	    else
+		obj = FIXNUM(RFI(real));
+	    break;
+	case N_BIGNUM:
+	    obj = BIGNUM(RBI(real));
+	    break;
+	case N_FLONUM:
+	    obj = DFLOAT(RFF(real));
+	    break;
+	case N_FIXRATIO:
+	    obj = LispNew(NIL, NIL);
+	    obj->type = LispRatio_t;
+	    OFRN(obj) = RFRN(real);
+	    OFRD(obj) = RFRD(real);
+	    break;
+	case N_BIGRATIO:
+	    obj = BIGRATIO(RBR(real));
+	    break;
+	default:
+	    obj = NIL;
+	    break;
+    }
+
+    return (obj);
+}
+
+static LispObj *
+make_number_object(n_number *num)
+{
+    LispObj *obj;
+
+    if (num->complex) {
+	GC_ENTER();
+
+	obj = LispNew(NIL, NIL);
+	GC_PROTECT(obj);
+	OCXI(obj) = NIL;
+	obj->type = LispComplex_t;
+	OCXR(obj) = make_real_object(NREAL(num));
+	OCXI(obj) = make_real_object(NIMAG(num));
+	GC_LEAVE();
+    }
+    else {
+	switch (NRTYPE(num)) {
+	    case N_FIXNUM:
+		if (NRFI(num) > MOST_POSITIVE_FIXNUM ||
+		    NRFI(num) < MOST_NEGATIVE_FIXNUM) {
+		    obj = LispNew(NIL, NIL);
+		    obj->type = LispInteger_t;
+		    OII(obj) = NRFI(num);
+		}
+		else
+		    obj = FIXNUM(NRFI(num));
+		break;
+	    case N_BIGNUM:
+		obj = BIGNUM(NRBI(num));
+		break;
+	    case N_FLONUM:
+		obj = DFLOAT(NRFF(num));
+		break;
+	    case N_FIXRATIO:
+		obj = LispNew(NIL, NIL);
+		obj->type = LispRatio_t;
+		OFRN(obj) = NRFRN(num);
+		OFRD(obj) = NRFRD(num);
+		break;
+	    case N_BIGRATIO:
+		obj = BIGRATIO(NRBR(num));
+		break;
+	    default:
+		obj = NIL;
+		break;
+	}
+    }
+
+    return (obj);
+}
+
+#define DEFOP_REAL_REAL(OP)						\
+OP##_real_real(n_real *real, n_real *val)				\
+{									\
+    switch (RTYPE(real)) {						\
+	case N_FIXNUM:							\
+	    switch (RTYPE(val)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_fi_fi(real, RFI(val));			\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_fi_bi(real, RBI(val));			\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, (double)RFI(real), RFF(val));	\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_fi_fr(real, RFRN(val), RFRD(val));		\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_fi_br(real, RBR(val));			\
+		    break;						\
+	    }								\
+	    break;							\
+	case N_BIGNUM:							\
+	    switch (RTYPE(val)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_bi_fi(real, RFI(val));			\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_bi_bi(real, RBI(val));			\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, bi_getd(RBI(real)), RFF(val));	\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_bi_fr(real, RFRN(val), RFRD(val));		\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_bi_br(real, RBR(val));			\
+		    break;						\
+	    }								\
+	    break;							\
+	case N_FLONUM:							\
+	    switch (RTYPE(val)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_flonum(real, RFF(real), (double)RFI(val));	\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_flonum(real, RFF(real), bi_getd(RBI(val)));	\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, RFF(real), RFF(val));		\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_flonum(real, RFF(real),			\
+				 (double)RFRN(val) / (double)RFRD(val));\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_flonum(real, RFF(real), br_getd(RBR(val)));	\
+		    break;						\
+	    }								\
+	    break;							\
+	case N_FIXRATIO:						\
+	    switch (RTYPE(val)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_fr_fi(real, RFI(val));			\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_fr_bi(real, RBI(val));			\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real,				\
+				(double)RFRN(real) / (double)RFRD(real),\
+				RFF(val));				\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_fr_fr(real, RFRN(val), RFRD(val));		\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_fr_br(real, RBR(val));			\
+		    break;						\
+	    }								\
+	    break;							\
+	case N_BIGRATIO:						\
+	    switch (RTYPE(val)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_br_fi(real, RFI(val));			\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_br_bi(real, RBI(val));			\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, br_getd(RBR(real)), RFF(val));	\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_br_fr(real, RFRN(val), RFRD(val));		\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_br_br(real, RBR(val));			\
+		    break;						\
+	    }								\
+	    break;							\
+    }									\
+}
+
+static void
+DEFOP_REAL_REAL(add)
+
+static void
+DEFOP_REAL_REAL(sub)
+
+static void
+DEFOP_REAL_REAL(div)
+
+static void
+DEFOP_REAL_REAL(mul)
+
+
+#define DEFOP_REAL_OBJECT(OP)						\
+OP##_real_object(n_real *real, LispObj *obj)				\
+{									\
+    switch (OBJECT_TYPE(obj)) {						\
+	case LispFixnum_t:						\
+	    switch (RTYPE(real)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_fi_fi(real, OFI(obj));			\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_bi_fi(real, OFI(obj));			\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, RFF(real), (double)OFI(obj));	\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_fr_fi(real, OFI(obj));			\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_br_fi(real, OFI(obj));			\
+		    break;						\
+	    }								\
+	    break;							\
+	case LispInteger_t:						\
+	    switch (RTYPE(real)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_fi_fi(real, OII(obj));			\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_bi_fi(real, OII(obj));			\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, RFF(real), (double)OII(obj));	\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_fr_fi(real, OII(obj));			\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_br_fi(real, OII(obj));			\
+		    break;						\
+	    }								\
+	    break;							\
+	case LispBignum_t:						\
+	    switch (RTYPE(real)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_fi_bi(real, OBI(obj));			\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_bi_bi(real, OBI(obj));			\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, RFF(real), bi_getd(OBI(obj)));	\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_fr_bi(real, OBI(obj));			\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_br_bi(real, OBI(obj));			\
+		    break;						\
+	    }								\
+	    break;							\
+	case LispDFloat_t:						\
+	    switch (RTYPE(real)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_flonum(real, (double)RFI(real), ODF(obj));	\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_flonum(real, bi_getd(RBI(real)), ODF(obj));	\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, RFF(real), ODF(obj));		\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_flonum(real,				\
+				(double)RFRN(real) / (double)RFRD(real),\
+				ODF(obj));				\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_flonum(real, br_getd(RBR(real)), ODF(obj));	\
+		    break;						\
+	    }								\
+	    break;							\
+	case LispRatio_t:						\
+	    switch (RTYPE(real)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_fi_fr(real, OFRN(obj), OFRD(obj));		\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_bi_fr(real, OFRN(obj), OFRD(obj));		\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, RFF(real),			\
+				(double)OFRN(obj) / (double)OFRD(obj));	\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_fr_fr(real, OFRN(obj), OFRD(obj));		\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_br_fr(real, OFRN(obj), OFRD(obj));		\
+		    break;						\
+	    }								\
+	    break;							\
+	case LispBigratio_t:						\
+	    switch (RTYPE(real)) {					\
+		case N_FIXNUM:						\
+		    r##OP##_fi_br(real, OBR(obj));			\
+		    break;						\
+		case N_BIGNUM:						\
+		    r##OP##_bi_br(real, OBR(obj));			\
+		    break;						\
+		case N_FLONUM:						\
+		    r##OP##_flonum(real, RFF(real), br_getd(OBR(obj)));	\
+		    break;						\
+		case N_FIXRATIO:					\
+		    r##OP##_fr_br(real, OBR(obj));			\
+		    break;						\
+		case N_BIGRATIO:					\
+		    r##OP##_br_br(real, OBR(obj));			\
+		    break;						\
+	    }								\
+	    break;							\
+	default:							\
+	    fatal_object_error(obj, NOT_A_REAL_NUMBER);			\
+	    break;							\
+    }									\
+}
+
+static void
+DEFOP_REAL_OBJECT(add)
+
+static void
+DEFOP_REAL_OBJECT(sub)
+
+static void
+DEFOP_REAL_OBJECT(div)
+
+static void
+DEFOP_REAL_OBJECT(mul)
+
+
+#define DEFOP_NUMBER_OBJECT(OP)						\
+OP##_number_object(n_number *num, LispObj *obj)				\
+{									\
+    if (num->complex) {							\
+	switch (OBJECT_TYPE(obj)) {					\
+	    case LispFixnum_t:						\
+	    case LispInteger_t:						\
+	    case LispBignum_t:						\
+	    case LispDFloat_t:						\
+	    case LispRatio_t:						\
+	    case LispBigratio_t:					\
+		n##OP##_cx_re(num, obj);				\
+		break;							\
+	    case LispComplex_t:						\
+		n##OP##_cx_cx(num, obj);				\
+		break;							\
+	    default:							\
+		fatal_object_error(obj, NOT_A_NUMBER);			\
+		break;							\
+	}								\
+    }									\
+    else {								\
+	switch (OBJECT_TYPE(obj)) {					\
+	    case LispFixnum_t:						\
+		switch (NRTYPE(num)) {					\
+		    case N_FIXNUM:					\
+			r##OP##_fi_fi(NREAL(num), OFI(obj));		\
+			break;						\
+		    case N_BIGNUM:					\
+			r##OP##_bi_fi(NREAL(num), OFI(obj));		\
+			break;						\
+		    case N_FLONUM:					\
+			r##OP##_flonum(NREAL(num), NRFF(num),		\
+				    (double)OFI(obj));			\
+			break;						\
+		    case N_FIXRATIO:					\
+			r##OP##_fr_fi(NREAL(num), OFI(obj));		\
+			break;						\
+		    case N_BIGRATIO:					\
+			r##OP##_br_fi(NREAL(num), OFI(obj));		\
+			break;						\
+		}							\
+		break;							\
+	    case LispInteger_t:						\
+		switch (NRTYPE(num)) {					\
+		    case N_FIXNUM:					\
+			r##OP##_fi_fi(NREAL(num), OII(obj));		\
+			break;						\
+		    case N_BIGNUM:					\
+			r##OP##_bi_fi(NREAL(num), OII(obj));		\
+			break;						\
+		    case N_FLONUM:					\
+			r##OP##_flonum(NREAL(num), NRFF(num),		\
+				    (double)OII(obj));			\
+			break;						\
+		    case N_FIXRATIO:					\
+			r##OP##_fr_fi(NREAL(num), OII(obj));		\
+			break;						\
+		    case N_BIGRATIO:					\
+			r##OP##_br_fi(NREAL(num), OII(obj));		\
+			break;						\
+		}							\
+		break;							\
+	    case LispBignum_t:						\
+		switch (NRTYPE(num)) {					\
+		    case N_FIXNUM:					\
+			r##OP##_fi_bi(NREAL(num), OBI(obj));		\
+			break;						\
+		    case N_BIGNUM:					\
+			r##OP##_bi_bi(NREAL(num), OBI(obj));		\
+			break;						\
+		    case N_FLONUM:					\
+			r##OP##_flonum(NREAL(num), NRFF(num),		\
+				       bi_getd(OBI(obj)));		\
+			break;						\
+		    case N_FIXRATIO:					\
+			r##OP##_fr_bi(NREAL(num), OBI(obj));		\
+			break;						\
+		    case N_BIGRATIO:					\
+			r##OP##_br_bi(NREAL(num), OBI(obj));		\
+			break;						\
+		}							\
+		break;							\
+	    case LispDFloat_t:						\
+		switch (NRTYPE(num)) {					\
+		    case N_FIXNUM:					\
+			r##OP##_flonum(NREAL(num), (double)NRFI(num),	\
+				    ODF(obj));				\
+			break;						\
+		    case N_BIGNUM:					\
+			r##OP##_flonum(NREAL(num), bi_getd(NRBI(num)),	\
+				    ODF(obj));				\
+			break;						\
+		    case N_FLONUM:					\
+			r##OP##_flonum(NREAL(num), NRFF(num), ODF(obj));\
+			break;						\
+		    case N_FIXRATIO:					\
+			r##OP##_flonum(NREAL(num),			\
+				    (double)NRFRN(num) /		\
+				    (double)NRFRD(num),			\
+				    ODF(obj));				\
+			break;						\
+		    case N_BIGRATIO:					\
+			r##OP##_flonum(NREAL(num), br_getd(NRBR(num)),	\
+				    ODF(obj));				\
+			break;						\
+		}							\
+		break;							\
+	    case LispRatio_t:						\
+		switch (NRTYPE(num)) {					\
+		    case N_FIXNUM:					\
+			r##OP##_fi_fr(NREAL(num), OFRN(obj), OFRD(obj));\
+			break;						\
+		    case N_BIGNUM:					\
+			r##OP##_bi_fr(NREAL(num), OFRN(obj), OFRD(obj));\
+			break;						\
+		    case N_FLONUM:					\
+			r##OP##_flonum(NREAL(num), NRFF(num),		\
+				    (double)OFRN(obj) /			\
+				    (double)OFRD(obj));			\
+			break;						\
+		    case N_FIXRATIO:					\
+			r##OP##_fr_fr(NREAL(num), OFRN(obj), OFRD(obj));\
+			break;						\
+		    case N_BIGRATIO:					\
+			r##OP##_br_fr(NREAL(num), OFRN(obj), OFRD(obj));\
+			break;						\
+		}							\
+		break;							\
+	    case LispBigratio_t:					\
+		switch (NRTYPE(num)) {					\
+		    case N_FIXNUM:					\
+			r##OP##_fi_br(NREAL(num), OBR(obj));		\
+			break;						\
+		    case N_BIGNUM:					\
+			r##OP##_bi_br(NREAL(num), OBR(obj));		\
+			break;						\
+		    case N_FLONUM:					\
+			r##OP##_flonum(NREAL(num), NRFF(num),		\
+				    br_getd(OBR(obj)));		\
+			break;						\
+		    case N_FIXRATIO:					\
+			r##OP##_fr_br(NREAL(num), OBR(obj));		\
+			break;						\
+		    case N_BIGRATIO:					\
+			r##OP##_br_br(NREAL(num), OBR(obj));		\
+			break;						\
+		}							\
+		break;							\
+	    case LispComplex_t:						\
+		n##OP##_re_cx(num, obj);				\
+		break;							\
+	    default:							\
+		fatal_object_error(obj, NOT_A_NUMBER);			\
+		break;							\
+	}								\
+    }									\
+}
+
+static void
+DEFOP_NUMBER_OBJECT(add)
+
+static void
+DEFOP_NUMBER_OBJECT(sub)
+
+static void
+DEFOP_NUMBER_OBJECT(div)
+
+static void
+DEFOP_NUMBER_OBJECT(mul)
+
+
+/************************************************************************
+ * ABS
+ ************************************************************************/
+static void
+abs_real(n_real *real)
+{
+    switch (RTYPE(real)) {
+	case N_FIXNUM:		rabs_fi(real);	break;
+	case N_BIGNUM:		rabs_bi(real);	break;
+	case N_FLONUM:		rabs_ff(real);	break;
+	case N_FIXRATIO:	rabs_fr(real);	break;
+	case N_BIGRATIO:	rabs_br(real);	break;
+    }
+}
+
+static void
+abs_number(n_number *num)
+{
+    if (num->complex)
+	nabs_cx(num);
+    else {
+	switch (NRTYPE(num)) {
+	    case N_FIXNUM:	rabs_fi(NREAL(num));	break;
+	    case N_BIGNUM:	rabs_bi(NREAL(num));	break;
+	    case N_FLONUM:	rabs_ff(NREAL(num));	break;
+	    case N_FIXRATIO:	rabs_fr(NREAL(num));	break;
+	    case N_BIGRATIO:	rabs_br(NREAL(num));	break;
+	}
+    }
+}
+
+static void
+nabs_cx(n_number *num)
+{
+    n_real temp;
+
+    abs_real(NREAL(num));
+    abs_real(NIMAG(num));
+
+    if (cmp_real_real(NREAL(num), NIMAG(num)) < 0) {
+	memcpy(&temp, NIMAG(num), sizeof(n_real));
+	memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
+	memcpy(NREAL(num), &temp, sizeof(n_real));
+    }
+
+    if (cmp_real_real(NIMAG(num), &zero) == 0) {
+	num->complex = 0;
+	if (NITYPE(num) == N_FLONUM) {
+	    /* change number type */
+	    temp.type = N_FLONUM;
+	    temp.data.flonum = 1.0;
+	    mul_real_real(NREAL(num), &temp);
+	}
+	else
+	    clear_real(NIMAG(num));
+    }
+    else {
+	div_real_real(NIMAG(num), NREAL(num));
+	set_real_real(&temp, NIMAG(num));
+	mul_real_real(NIMAG(num), &temp);
+	clear_real(&temp);
+
+	add_real_real(NIMAG(num), &one);
+	sqrt_real(NIMAG(num));
+
+	mul_real_real(NIMAG(num), NREAL(num));
+	clear_real(NREAL(num));
+	memcpy(NREAL(num), NIMAG(num), sizeof(n_real));
+	num->complex = 0;
+    }
+}
+
+static INLINE void
+rabs_fi(n_real *real)
+{
+    if (RFI(real) < 0)
+	rneg_fi(real);
+}
+
+static INLINE void
+rabs_bi(n_real *real)
+{
+    if (mpi_cmpi(RBI(real), 0) < 0)
+	mpi_neg(RBI(real), RBI(real));
+}
+
+static INLINE void
+rabs_ff(n_real *real)
+{
+    if (RFF(real) < 0.0)
+	RFF(real) = -RFF(real);
+}
+
+static INLINE void
+rabs_fr(n_real *real)
+{
+    if (RFRN(real) < 0)
+	rneg_fr(real);
+}
+
+static INLINE void
+rabs_br(n_real *real)
+{
+    if (mpi_cmpi(RBRN(real), 0) < 0)
+	mpi_neg(RBRN(real), RBRN(real));
+}
+
+
+/************************************************************************
+ * NEG
+ ************************************************************************/
+static void
+neg_real(n_real *real)
+{
+    switch (RTYPE(real)) {
+	case N_FIXNUM:		rneg_fi(real);	break;
+	case N_BIGNUM:		rneg_bi(real);	break;
+	case N_FLONUM:		rneg_ff(real);	break;
+	case N_FIXRATIO:	rneg_fr(real);	break;
+	case N_BIGRATIO:	rneg_br(real);	break;
+    }
+}
+
+static void
+neg_number(n_number *num)
+{
+    if (num->complex) {
+	neg_real(NREAL(num));
+	neg_real(NIMAG(num));
+    }
+    else {
+	switch (NRTYPE(num)) {
+	    case N_FIXNUM:	rneg_fi(NREAL(num));	break;
+	    case N_BIGNUM:	rneg_bi(NREAL(num));	break;
+	    case N_FLONUM:	rneg_ff(NREAL(num));	break;
+	    case N_FIXRATIO:	rneg_fr(NREAL(num));	break;
+	    case N_BIGRATIO:	rneg_br(NREAL(num));	break;
+	}
+    }
+}
+
+static void
+rneg_fi(n_real *real)
+{
+    if (RFI(real) == MINSLONG) {
+	mpi *bigi = XALLOC(mpi);
+
+	mpi_init(bigi);
+	mpi_seti(bigi, RFI(real));
+	mpi_neg(bigi, bigi);
+	RTYPE(real) = N_BIGNUM;
+	RBI(real) = bigi;
+    }
+    else
+	RFI(real) = -RFI(real);
+}
+
+static INLINE void
+rneg_bi(n_real *real)
+{
+    mpi_neg(RBI(real), RBI(real));
+}
+
+static INLINE void
+rneg_ff(n_real *real)
+{
+    RFF(real) = -RFF(real);
+}
+
+static void
+rneg_fr(n_real *real)
+{
+    if (RFRN(real) == MINSLONG) {
+	mpr *bigr = XALLOC(mpr);
+
+	mpr_init(bigr);
+	mpr_seti(bigr, RFRN(real), RFRD(real));
+	mpi_neg(mpr_num(bigr), mpr_num(bigr));
+	RTYPE(real) = N_BIGRATIO;
+	RBR(real) = bigr;
+    }
+    else
+	RFRN(real) = -RFRN(real);
+}
+
+static INLINE void
+rneg_br(n_real *real)
+{
+    mpi_neg(RBRN(real), RBRN(real));
+}
+
+
+/************************************************************************
+ * SQRT
+ ************************************************************************/
+static void
+sqrt_real(n_real *real)
+{
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	case N_BIGNUM:
+	    rsqrt_xi(real);
+	    break;
+	case N_FLONUM:
+	    rsqrt_ff(real);
+	    break;
+	case N_FIXRATIO:
+	case N_BIGRATIO:
+	    rsqrt_xr(real);
+	    break;
+    }
+}
+
+static void
+sqrt_number(n_number *num)
+{
+    if (num->complex)
+	nsqrt_cx(num);
+    else {
+	switch (NRTYPE(num)) {
+	    case N_FIXNUM:
+	    case N_BIGNUM:
+		nsqrt_xi(num);
+		break;
+	    case N_FLONUM:
+		nsqrt_ff(num);
+		break;
+	    case N_FIXRATIO:
+	    case N_BIGRATIO:
+		nsqrt_xr(num);
+		break;
+	}
+    }
+}
+
+static void
+rsqrt_xi(n_real *real)
+{
+    int exact;
+    mpi bignum;
+
+    if (cmp_real_real(real, &zero) < 0)
+	fatal_error(FLOATING_POINT_EXCEPTION);
+
+    mpi_init(&bignum);
+    if (RTYPE(real) == N_BIGNUM)
+	exact = mpi_sqrt(&bignum, RBI(real));
+    else {
+	mpi tmp;
+
+	mpi_init(&tmp);
+	mpi_seti(&tmp, RFI(real));
+	exact = mpi_sqrt(&bignum, &tmp);
+	mpi_clear(&tmp);
+    }
+    if (exact) {
+	if (RTYPE(real) == N_BIGNUM) {
+	    mpi_set(RBI(real), &bignum);
+	    rbi_canonicalize(real);
+	}
+	else
+	    RFI(real) = mpi_geti(&bignum);
+    }
+    else {
+	double value;
+
+	if (RTYPE(real) == N_BIGNUM) {
+	    value = bi_getd(RBI(real));
+	    RCLEAR_BI(real);
+	}
+	else
+	    value = (double)RFI(real);
+
+	value = sqrt(value);
+	RTYPE(real) = N_FLONUM;
+	RFF(real) = value;
+    }
+    mpi_clear(&bignum);
+}
+
+static void
+rsqrt_xr(n_real *real)
+{
+    n_real num, den;
+
+    if (cmp_real_real(real, &zero) < 0)
+	fatal_error(FLOATING_POINT_EXCEPTION);
+
+    if (RTYPE(real) == N_FIXRATIO) {
+	num.type = den.type = N_FIXNUM;
+	num.data.fixnum = RFRN(real);
+	den.data.fixnum = RFRD(real);
+    }
+    else {
+	mpi *bignum;
+
+	if (mpi_fiti(RBRN(real))) {
+	    num.type = N_FIXNUM;
+	    num.data.fixnum = mpi_geti(RBRN(real));
+	}
+	else {
+	    bignum = XALLOC(mpi);
+	    mpi_init(bignum);
+	    mpi_set(bignum, RBRN(real));
+	    num.type = N_BIGNUM;
+	    num.data.bignum = bignum;
+	}
+
+	if (mpi_fiti(RBRD(real))) {
+	    den.type = N_FIXNUM;
+	    den.data.fixnum = mpi_geti(RBRD(real));
+	}
+	else {
+	    bignum = XALLOC(mpi);
+	    mpi_init(bignum);
+	    mpi_set(bignum, RBRD(real));
+	    den.type = N_BIGNUM;
+	    den.data.bignum = bignum;
+	}
+    }
+
+    rsqrt_xi(&num);
+    rsqrt_xi(&den);
+
+    clear_real(real);
+    memcpy(real, &num, sizeof(n_real));
+    div_real_real(real, &den);
+    clear_real(&den);
+}
+
+static void
+rsqrt_ff(n_real *real)
+{
+    if (RFF(real) < 0.0)
+	fatal_error(FLOATING_POINT_EXCEPTION);
+    RFF(real) = sqrt(RFF(real));
+}
+
+
+static void
+nsqrt_cx(n_number *num)
+{
+    n_number mag;
+    n_real *real, *imag;
+
+    real = &(mag.real);
+    imag = &(mag.imag);
+    set_real_real(real, NREAL(num));
+    set_real_real(imag, NIMAG(num));
+    mag.complex = 1;
+
+    nabs_cx(&mag);	/* this will free the imag part data */
+    if (cmp_real_real(real, &zero) == 0) {
+	clear_number(num);
+	memcpy(NREAL(num), real, sizeof(n_real));
+	clear_real(real);
+	num->complex = 0;
+	return;
+    }
+    else if (cmp_real_real(NREAL(num), &zero) > 0) {
+	/* R = sqrt((mag + Ra) / 2) */
+	add_real_real(NREAL(num), real);
+	clear_real(real);
+	div_real_real(NREAL(num), &two);
+	sqrt_real(NREAL(num));
+
+	/* I = Ia / R / 2 */
+	div_real_real(NIMAG(num), NREAL(num));
+	div_real_real(NIMAG(num), &two);
+    }
+    else {
+	/* remember old imag part */
+	memcpy(imag, NIMAG(num), sizeof(n_real));
+
+	/* I = sqrt((mag - Ra) / 2) */
+	memcpy(NIMAG(num), real, sizeof(n_real));
+	sub_real_real(NIMAG(num), NREAL(num));
+	div_real_real(NIMAG(num), &two);
+	sqrt_real(NIMAG(num));
+	if (cmp_real_real(imag, &zero) < 0)
+	    neg_real(NIMAG(num));
+
+	/* R = Ia / I / 2 */
+	clear_real(NREAL(num));
+	/* start with old imag part */
+	memcpy(NREAL(num), imag, sizeof(n_real));
+	div_real_real(NREAL(num), NIMAG(num));
+	div_real_real(NREAL(num), &two);
+    }
+
+    ncx_canonicalize(num);
+}
+
+static void
+nsqrt_xi(n_number *num)
+{
+    if (cmp_real_real(NREAL(num), &zero) < 0) {
+	memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
+	neg_real(NIMAG(num));
+	rsqrt_xi(NIMAG(num));
+	NRTYPE(num) = N_FIXNUM;
+	NRFI(num) = 0;
+	num->complex = 1;
+    }
+    else
+	rsqrt_xi(NREAL(num));
+}
+
+static void
+nsqrt_ff(n_number *num)
+{
+    double value;
+
+    if (NRFF(num) < 0.0) {
+	value = sqrt(-NRFF(num));
+
+	NITYPE(num) = N_FLONUM;
+	NIFF(num) = value;
+	NRTYPE(num) = N_FIXNUM;
+	NRFI(num) = 0;
+	num->complex = 1;
+    }
+    else {
+	value = sqrt(NRFF(num));
+	NRFF(num) = value;
+    }
+}
+
+static void
+nsqrt_xr(n_number *num)
+{
+    if (cmp_real_real(NREAL(num), &zero) < 0) {
+	memcpy(NIMAG(num), NREAL(num), sizeof(n_real));
+	neg_real(NIMAG(num));
+	rsqrt_xr(NIMAG(num));
+	NRTYPE(num) = N_FIXNUM;
+	NRFI(num) = 0;
+	num->complex = 1;
+    }
+    else
+	rsqrt_xr(NREAL(num));
+}
+
+
+/************************************************************************
+ * MOD
+ ************************************************************************/
+static void
+mod_real_real(n_real *real, n_real *val)
+{
+    /* Assume both operands are integers */
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	    switch (RTYPE(val)) {
+		case N_FIXNUM:
+		    rmod_fi_fi(real, RFI(val));
+		    break;
+		case N_BIGNUM:
+		    rmod_fi_bi(real, RBI(val));
+		    break;
+	    }
+	    break;
+	case N_BIGNUM:
+	    switch (RTYPE(val)) {
+		case N_FIXNUM:
+		    rmod_bi_fi(real, RFI(val));
+		    break;
+		case N_BIGNUM:
+		    rmod_bi_bi(real, RBI(val));
+		    break;
+	    }
+	    break;
+    }
+}
+
+static void
+mod_real_object(n_real *real, LispObj *obj)
+{
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	    switch (OBJECT_TYPE(obj)) {
+		case LispFixnum_t:
+		    rmod_fi_fi(real, OFI(obj));
+		    return;
+		case LispInteger_t:
+		    rmod_fi_fi(real, OII(obj));
+		    return;
+		case LispBignum_t:
+		    rmod_fi_bi(real, OBI(obj));
+		    return;
+		default:
+		    break;
+	    }
+	    break;
+	case N_BIGNUM:
+	    switch (OBJECT_TYPE(obj)) {
+		case LispFixnum_t:
+		    rmod_bi_fi(real, OFI(obj));
+		    return;
+		case LispInteger_t:
+		    rmod_bi_fi(real, OII(obj));
+		    return;
+		case LispBignum_t:
+		    rmod_bi_bi(real, OBI(obj));
+		    return;
+		default:
+		    break;
+	    }
+	    break;
+	/* Assume the n_real object is an integer */
+    }
+    fatal_object_error(obj, NOT_AN_INTEGER);
+}
+
+static void
+rmod_fi_fi(n_real *real, long fi)
+{
+    if (fi == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    if ((RFI(real) < 0) ^ (fi < 0))
+	RFI(real) = (RFI(real) % fi) + fi;
+    else if (RFI(real) == MINSLONG || fi == MINSLONG) {
+	mpi bignum;
+
+	mpi_init(&bignum);
+	mpi_seti(&bignum, RFI(real));
+	RFI(real) = mpi_modi(&bignum, fi);
+	mpi_clear(&bignum);
+    }
+    else
+	RFI(real) = RFI(real) % fi;
+}
+
+static void
+rmod_fi_bi(n_real *real, mpi *bignum)
+{
+    mpi *bigi;
+
+    if (mpi_cmpi(bignum, 0) == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    bigi = XALLOC(mpi);
+    mpi_init(bigi);
+    mpi_seti(bigi, RFI(real));
+    mpi_mod(bigi, bigi, bignum);
+    RTYPE(real) = N_BIGNUM;
+    RBI(real) = bigi;
+    rbi_canonicalize(real);
+}
+
+static void
+rmod_bi_fi(n_real *real, long fi)
+{
+    mpi iop;
+
+    if (fi == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    mpi_init(&iop);
+    mpi_seti(&iop, fi);
+    mpi_mod(RBI(real), RBI(real), &iop);
+    mpi_clear(&iop);
+    rbi_canonicalize(real);
+}
+
+static void
+rmod_bi_bi(n_real *real, mpi *bignum)
+{
+    if (mpi_cmpi(bignum, 0) == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    mpi_mod(RBI(real), RBI(real), bignum);
+    rbi_canonicalize(real);
+}
+
+/************************************************************************
+ * REM
+ ************************************************************************/
+static void
+rem_real_object(n_real *real, LispObj *obj)
+{
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	    switch (OBJECT_TYPE(obj)) {
+		case LispFixnum_t:
+		    rrem_fi_fi(real, OFI(obj));
+		    return;
+		case LispInteger_t:
+		    rrem_fi_fi(real, OII(obj));
+		    return;
+		case LispBignum_t:
+		    rrem_fi_bi(real, OBI(obj));
+		    return;
+		default:
+		    break;
+	    }
+	    break;
+	case N_BIGNUM:
+	    switch (OBJECT_TYPE(obj)) {
+		case LispFixnum_t:
+		    rrem_bi_fi(real, OFI(obj));
+		    return;
+		case LispInteger_t:
+		    rrem_bi_fi(real, OII(obj));
+		    return;
+		case LispBignum_t:
+		    rrem_bi_bi(real, OBI(obj));
+		    return;
+		default:
+		    break;
+	    }
+	    break;
+	/* Assume the n_real object is an integer */
+    }
+    fatal_object_error(obj, NOT_AN_INTEGER);
+}
+
+static void
+rrem_fi_fi(n_real *real, long fi)
+{
+    if (fi == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    if (RFI(real) == MINSLONG || fi == MINSLONG) {
+	mpi bignum;
+
+	mpi_init(&bignum);
+	mpi_seti(&bignum, RFI(real));
+	RFI(real) = mpi_remi(&bignum, fi);
+	mpi_clear(&bignum);
+    }
+    else
+	RFI(real) = RFI(real) % fi;
+}
+
+static void
+rrem_fi_bi(n_real *real, mpi *bignum)
+{
+    mpi *bigi;
+
+    if (mpi_cmpi(bignum, 0) == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    bigi = XALLOC(mpi);
+    mpi_init(bigi);
+    mpi_seti(bigi, RFI(real));
+    mpi_rem(bigi, bigi, bignum);
+    RTYPE(real) = N_BIGNUM;
+    RBI(real) = bigi;
+    rbi_canonicalize(real);
+}
+
+static void
+rrem_bi_fi(n_real *real, long fi)
+{
+    mpi iop;
+
+    if (fi == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    mpi_init(&iop);
+    mpi_seti(&iop, fi);
+    mpi_rem(RBI(real), RBI(real), &iop);
+    mpi_clear(&iop);
+    rbi_canonicalize(real);
+}
+
+static void
+rrem_bi_bi(n_real *real, mpi *bignum)
+{
+    if (mpi_cmpi(bignum, 0) == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    mpi_rem(RBI(real), RBI(real), bignum);
+    rbi_canonicalize(real);
+}
+
+
+/************************************************************************
+ * GCD
+ ************************************************************************/
+static void
+gcd_real_object(n_real *real, LispObj *obj)
+{
+    if (!INTEGERP(obj))
+	fatal_object_error(obj, NOT_AN_INTEGER);
+
+    /* check for zero operand */
+    if (cmp_real_real(real, &zero) == 0)
+	set_real_object(real, obj);
+    else if (cmp_real_object(&zero, obj) != 0) {
+	n_real rest, temp;
+
+	set_real_object(&rest, obj);
+	for (;;) {
+	    mod_real_real(&rest, real);
+	    if (cmp_real_real(&rest, &zero) == 0)
+		break;
+	    memcpy(&temp, real, sizeof(n_real));
+	    memcpy(real, &rest, sizeof(n_real));
+	    memcpy(&rest, &temp, sizeof(n_real));
+	}
+	clear_real(&rest);
+    }
+}
+
+/************************************************************************
+ * AND
+ ************************************************************************/
+static void
+and_real_object(n_real *real, LispObj *obj)
+{
+    mpi *bigi, iop;
+
+    switch (OBJECT_TYPE(obj)) {
+	case LispFixnum_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    RFI(real) &= OFI(obj);
+		    break;
+		case N_BIGNUM:
+		    mpi_init(&iop);
+		    mpi_seti(&iop, OFI(obj));
+		    mpi_and(RBI(real), RBI(real), &iop);
+		    mpi_clear(&iop);
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	case LispInteger_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    RFI(real) &= OII(obj);
+		    break;
+		case N_BIGNUM:
+		    mpi_init(&iop);
+		    mpi_seti(&iop, OII(obj));
+		    mpi_and(RBI(real), RBI(real), &iop);
+		    mpi_clear(&iop);
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	case LispBignum_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    bigi = XALLOC(mpi);
+		    mpi_init(bigi);
+		    mpi_seti(bigi, RFI(real));
+		    mpi_and(bigi, bigi, OBI(obj));
+		    RTYPE(real) = N_BIGNUM;
+		    RBI(real) = bigi;
+		    rbi_canonicalize(real);
+		    break;
+		case N_BIGNUM:
+		    mpi_and(RBI(real), RBI(real), OBI(obj));
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	default:
+	    fatal_object_error(obj, NOT_AN_INTEGER);
+	    break;
+    }
+}
+
+
+/************************************************************************
+ * EQV
+ ************************************************************************/
+static void
+eqv_real_object(n_real *real, LispObj *obj)
+{
+    mpi *bigi, iop;
+
+    switch (OBJECT_TYPE(obj)) {
+	case LispFixnum_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    RFI(real) ^= ~OFI(obj);
+		    break;
+		case N_BIGNUM:
+		    mpi_init(&iop);
+		    mpi_seti(&iop, OFI(obj));
+		    mpi_com(&iop, &iop);
+		    mpi_xor(RBI(real), RBI(real), &iop);
+		    mpi_clear(&iop);
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	case LispInteger_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    RFI(real) ^= ~OII(obj);
+		    break;
+		case N_BIGNUM:
+		    mpi_init(&iop);
+		    mpi_seti(&iop, OII(obj));
+		    mpi_com(&iop, &iop);
+		    mpi_xor(RBI(real), RBI(real), &iop);
+		    mpi_clear(&iop);
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	case LispBignum_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    bigi = XALLOC(mpi);
+		    mpi_init(bigi);
+		    mpi_seti(bigi, RFI(real));
+		    mpi_com(bigi, bigi);
+		    mpi_xor(bigi, bigi, OBI(obj));
+		    RTYPE(real) = N_BIGNUM;
+		    RBI(real) = bigi;
+		    rbi_canonicalize(real);
+		    break;
+		case N_BIGNUM:
+		    mpi_com(RBI(real), RBI(real));
+		    mpi_xor(RBI(real), RBI(real), OBI(obj));
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	default:
+	    fatal_object_error(obj, NOT_AN_INTEGER);
+	    break;
+    }
+}
+
+
+/************************************************************************
+ * IOR
+ ************************************************************************/
+static void
+ior_real_object(n_real *real, LispObj *obj)
+{
+    mpi *bigi, iop;
+
+    switch (OBJECT_TYPE(obj)) {
+	case LispFixnum_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    RFI(real) |= OFI(obj);
+		    break;
+		case N_BIGNUM:
+		    mpi_init(&iop);
+		    mpi_seti(&iop, OFI(obj));
+		    mpi_ior(RBI(real), RBI(real), &iop);
+		    mpi_clear(&iop);
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	case LispInteger_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    RFI(real) |= OII(obj);
+		    break;
+		case N_BIGNUM:
+		    mpi_init(&iop);
+		    mpi_seti(&iop, OII(obj));
+		    mpi_ior(RBI(real), RBI(real), &iop);
+		    mpi_clear(&iop);
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	case LispBignum_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    bigi = XALLOC(mpi);
+		    mpi_init(bigi);
+		    mpi_seti(bigi, RFI(real));
+		    mpi_ior(bigi, bigi, OBI(obj));
+		    RTYPE(real) = N_BIGNUM;
+		    RBI(real) = bigi;
+		    rbi_canonicalize(real);
+		    break;
+		case N_BIGNUM:
+		    mpi_ior(RBI(real), RBI(real), OBI(obj));
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	default:
+	    fatal_object_error(obj, NOT_AN_INTEGER);
+	    break;
+    }
+}
+
+
+/************************************************************************
+ * NOT
+ ************************************************************************/
+static void
+not_real(n_real *real)
+{
+    if (RTYPE(real) == N_FIXNUM)
+	RFI(real) = ~RFI(real);
+    else {
+	mpi_com(RBI(real), RBI(real));
+	rbi_canonicalize(real);
+    }
+}
+
+/************************************************************************
+ * XOR
+ ************************************************************************/
+static void
+xor_real_object(n_real *real, LispObj *obj)
+{
+    mpi *bigi, iop;
+
+    switch (OBJECT_TYPE(obj)) {
+	case LispFixnum_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    RFI(real) ^= OFI(obj);
+		    break;
+		case N_BIGNUM:
+		    mpi_init(&iop);
+		    mpi_seti(&iop, OFI(obj));
+		    mpi_xor(RBI(real), RBI(real), &iop);
+		    mpi_clear(&iop);
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	case LispInteger_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    RFI(real) ^= OII(obj);
+		    break;
+		case N_BIGNUM:
+		    mpi_init(&iop);
+		    mpi_seti(&iop, OII(obj));
+		    mpi_xor(RBI(real), RBI(real), &iop);
+		    mpi_clear(&iop);
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	case LispBignum_t:
+	    switch (RTYPE(real)) {
+		case N_FIXNUM:
+		    bigi = XALLOC(mpi);
+		    mpi_init(bigi);
+		    mpi_seti(bigi, RFI(real));
+		    mpi_xor(bigi, bigi, OBI(obj));
+		    RTYPE(real) = N_BIGNUM;
+		    RBI(real) = bigi;
+		    rbi_canonicalize(real);
+		    break;
+		case N_BIGNUM:
+		    mpi_xor(RBI(real), RBI(real), OBI(obj));
+		    rbi_canonicalize(real);
+		    break;
+	    }
+	    break;
+	default:
+	    fatal_object_error(obj, NOT_AN_INTEGER);
+	    break;
+    }
+}
+
+
+/************************************************************************
+ * DIVIDE
+ ************************************************************************/
+static void
+divide_number_object(n_number *num, LispObj *obj, int fun, int flo)
+{
+    switch (OBJECT_TYPE(obj)) {
+	case LispFixnum_t:
+	    switch (NRTYPE(num)) {
+		case N_FIXNUM:
+		    ndivide_fi_fi(num, OFI(obj), fun, flo);
+		    break;
+		case N_BIGNUM:
+		    ndivide_xi_xi(num, obj, fun, flo);
+		    break;
+		case N_FLONUM:
+		    ndivide_flonum(num, NRFF(num), (double)OFI(obj), fun, flo);
+		    break;
+		case N_FIXRATIO:
+		case N_BIGRATIO:
+		    ndivide_xr_xi(num, obj, fun, flo);
+		    break;
+	    }
+	    break;
+	case LispInteger_t:
+	    switch (NRTYPE(num)) {
+		case N_FIXNUM:
+		    ndivide_fi_fi(num, OII(obj), fun, flo);
+		    break;
+		case N_BIGNUM:
+		    ndivide_xi_xi(num, obj, fun, flo);
+		    break;
+		case N_FLONUM:
+		    ndivide_flonum(num, NRFF(num), (double)OII(obj), fun, flo);
+		    break;
+		case N_FIXRATIO:
+		case N_BIGRATIO:
+		    ndivide_xr_xi(num, obj, fun, flo);
+		    break;
+	    }
+	    break;
+	case LispBignum_t:
+	    switch (NRTYPE(num)) {
+		case N_FIXNUM:
+		case N_BIGNUM:
+		    ndivide_xi_xi(num, obj, fun, flo);
+		    break;
+		case N_FLONUM:
+		    ndivide_flonum(num, NRFF(num), bi_getd(OBI(obj)),
+				   fun, flo);
+		    break;
+		case N_FIXRATIO:
+		case N_BIGRATIO:
+		    ndivide_xr_xi(num, obj, fun, flo);
+		    break;
+	    }
+	    break;
+	case LispDFloat_t:
+	    switch (NRTYPE(num)) {
+		case N_FIXNUM:
+		    ndivide_flonum(num, (double)NRFI(num), ODF(obj),
+				   fun, flo);
+		    break;
+		case N_BIGNUM:
+		    ndivide_flonum(num, bi_getd(NRBI(num)), ODF(obj),
+				   fun, flo);
+		    break;
+		case N_FLONUM:
+		    ndivide_flonum(num, NRFF(num), ODF(obj), fun, flo);
+		    break;
+		case N_FIXRATIO:
+		    ndivide_flonum(num,
+				   (double)NRFRN(num) / (double)NRFRD(num),
+				   ODF(obj), fun, flo);
+		    break;
+		case N_BIGRATIO:
+		    ndivide_flonum(num, br_getd(NRBR(num)), ODF(obj),
+				   fun, flo);
+		    break;
+	    }
+	    break;
+	case LispRatio_t:
+	    switch (NRTYPE(num)) {
+		case N_FIXNUM:
+		case N_BIGNUM:
+		    ndivide_xi_xr(num, obj, fun, flo);
+		    break;
+		case N_FLONUM:
+		    ndivide_flonum(num, NRFF(num),
+				   (double)OFRN(obj) / (double)OFRD(obj),
+				   fun, flo);
+		    break;
+		case N_FIXRATIO:
+		case N_BIGRATIO:
+		    ndivide_xr_xr(num, obj, fun, flo);
+		    break;
+	    }
+	    break;
+	case LispBigratio_t:
+	    switch (NRTYPE(num)) {
+		case N_FIXNUM:
+		case N_BIGNUM:
+		    ndivide_xi_xr(num, obj, fun, flo);
+		    break;
+		case N_FLONUM:
+		    ndivide_flonum(num, NRFF(num), br_getd(OBR(obj)),
+				   fun, flo);
+		    break;
+		case N_FIXRATIO:
+		case N_BIGRATIO:
+		    ndivide_xr_xr(num, obj, fun, flo);
+		    break;
+	    }
+	    break;
+	default:
+	    fatal_object_error(obj, NOT_A_REAL_NUMBER);
+	    break;
+    }
+}
+
+
+/************************************************************************
+ * COMPARE
+ ************************************************************************/
+static int
+cmp_real_real(n_real *op1, n_real *op2)
+{
+    switch (RTYPE(op1)) {
+	case N_FIXNUM:
+	    switch (RTYPE(op2)) {
+		case N_FIXNUM:
+		    return (cmp_fi_fi(RFI(op1), RFI(op2)));
+		case N_BIGNUM:
+		    return (cmp_fi_bi(RFI(op1), RBI(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum((double)RFI(op1), RFF(op2)));
+		case N_FIXRATIO:
+		    return (cmp_fi_fr(RFI(op1), RFRN(op2), RFRD(op2)));
+		case N_BIGRATIO:
+		    return (cmp_fi_br(RFI(op1), RBR(op2)));
+	    }
+	    break;
+	case N_BIGNUM:
+	    switch (RTYPE(op2)) {
+		case N_FIXNUM:
+		    return (cmp_bi_fi(RBI(op1), RFI(op2)));
+		case N_BIGNUM:
+		    return (cmp_bi_bi(RBI(op1), RBI(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum(bi_getd(RBI(op1)), RFF(op2)));
+		case N_FIXRATIO:
+		    return (cmp_bi_fr(RBI(op1), RFRN(op2), RFRD(op2)));
+		case N_BIGRATIO:
+		    return (cmp_bi_br(RBI(op1), RBR(op2)));
+	    }
+	    break;
+	case N_FLONUM:
+	    switch (RTYPE(op2)) {
+		case N_FIXNUM:
+		    return (cmp_flonum(RFF(op1), (double)RFI(op2)));
+		case N_BIGNUM:
+		    return (cmp_flonum(RFF(op1), bi_getd(RBI(op2))));
+		case N_FLONUM:
+		    return (cmp_flonum(RFF(op1), RFF(op2)));
+		case N_FIXRATIO:
+		    return (cmp_flonum(RFF(op1),
+				       (double)RFRN(op2) / (double)RFRD(op2)));
+		case N_BIGRATIO:
+		    return (cmp_flonum(RFF(op1), br_getd(RBR(op2))));
+	    }
+	    break;
+	case N_FIXRATIO:
+	    switch (RTYPE(op2)) {
+		case N_FIXNUM:
+		    return (cmp_fr_fi(RFRN(op1), RFRD(op1), RFI(op2)));
+		case N_BIGNUM:
+		    return (cmp_fr_bi(RFRN(op1), RFRD(op1), RBI(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum((double)RFRN(op1) / (double)RFRD(op1),
+				       RFF(op2)));
+		case N_FIXRATIO:
+		    return (cmp_fr_fr(RFRN(op1), RFRD(op1),
+				      RFRN(op2), RFRD(op2)));
+		case N_BIGRATIO:
+		    return (cmp_fr_br(RFRN(op1), RFRD(op1), RBR(op2)));
+	    }
+	    break;
+	case N_BIGRATIO:
+	    switch (RTYPE(op2)) {
+		case N_FIXNUM:
+		    return (cmp_br_fi(RBR(op1), RFI(op2)));
+		case N_BIGNUM:
+		    return (cmp_br_bi(RBR(op1), RBI(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum(br_getd(RBR(op1)), RFF(op2)));
+		case N_FIXRATIO:
+		    return (cmp_br_fr(RBR(op1), RFRN(op2), RFRD(op2)));
+		case N_BIGRATIO:
+		    return (cmp_br_br(RBR(op1), RBR(op2)));
+	    }
+    }
+
+    return (0);
+}
+
+static int
+cmp_real_object(n_real *op1, LispObj *op2)
+{
+    switch (OBJECT_TYPE(op2)) {
+	case LispFixnum_t:
+	    switch (RTYPE(op1)) {
+		case N_FIXNUM:
+		    return (cmp_fi_fi(RFI(op1), OFI(op2)));
+		case N_BIGNUM:
+		    return (cmp_bi_fi(RBI(op1), OFI(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum(RFF(op1), (double)OFI(op2)));
+		case N_FIXRATIO:
+		    return (cmp_fr_fi(RFRD(op1), RFRN(op1), OFI(op2)));
+		case N_BIGRATIO:
+		    return (cmp_br_fi(RBR(op1), OFI(op2)));
+	    }
+	    break;
+	case LispInteger_t:
+	    switch (RTYPE(op1)) {
+		case N_FIXNUM:
+		    return (cmp_fi_fi(RFI(op1), OII(op2)));
+		case N_BIGNUM:
+		    return (cmp_bi_fi(RBI(op1), OII(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum(RFF(op1), (double)OII(op2)));
+		case N_FIXRATIO:
+		    return (cmp_fr_fi(RFRD(op1), RFRN(op1), OII(op2)));
+		case N_BIGRATIO:
+		    return (cmp_br_fi(RBR(op1), OII(op2)));
+	    }
+	    break;
+	case LispBignum_t:
+	    switch (RTYPE(op1)) {
+		case N_FIXNUM:
+		    return (cmp_fi_bi(RFI(op1), OBI(op2)));
+		case N_BIGNUM:
+		    return (cmp_bi_bi(RBI(op1), OBI(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum(RFF(op1), bi_getd(OBI(op2))));
+		case N_FIXRATIO:
+		    return (cmp_fr_bi(RFRD(op1), RFRN(op1), OBI(op2)));
+		case N_BIGRATIO:
+		    return (cmp_br_bi(RBR(op1), OBI(op2)));
+	    }
+	    break;
+	case LispDFloat_t:
+	    switch (RTYPE(op1)) {
+		case N_FIXNUM:
+		    return (cmp_flonum((double)RFI(op1), ODF(op2)));
+		case N_BIGNUM:
+		    return (cmp_flonum(bi_getd(RBI(op1)), ODF(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum(RFF(op1), ODF(op2)));
+		case N_FIXRATIO:
+		    return (cmp_flonum((double)RFRN(op1) / (double)RFRD(op1),
+				       ODF(op2)));
+		case N_BIGRATIO:
+		    return (cmp_flonum(br_getd(RBR(op1)), ODF(op2)));
+	    }
+	    break;
+	case LispRatio_t:
+	    switch (RTYPE(op1)) {
+		case N_FIXNUM:
+		    return (cmp_fi_fr(RFI(op1), OFRN(op2), OFRD(op2)));
+		case N_BIGNUM:
+		    return (cmp_bi_fr(RBI(op1), OFRN(op2), OFRD(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum(RFF(op1),
+				       (double)OFRN(op2) / (double)OFRD(op2)));
+		case N_FIXRATIO:
+		    return (cmp_fr_fr(RFRN(op1), RFRD(op1),
+				      OFRN(op2), OFRD(op2)));
+		case N_BIGRATIO:
+		    return (cmp_br_fr(RBR(op1), OFRN(op2), OFRD(op2)));
+	    }
+	    break;
+	case LispBigratio_t:
+	    switch (RTYPE(op1)) {
+		case N_FIXNUM:
+		    return (cmp_fi_br(RFI(op1), OBR(op2)));
+		case N_BIGNUM:
+		    return (cmp_bi_br(RBI(op1), OBR(op2)));
+		case N_FLONUM:
+		    return (cmp_flonum(RFF(op1), br_getd(OBR(op2))));
+		case N_FIXRATIO:
+		    return (cmp_fr_br(RFRN(op1), RFRD(op1), OBR(op2)));
+		case N_BIGRATIO:
+		    return (cmp_br_br(RBR(op1), OBR(op2)));
+	    }
+	    break;
+	default:
+	    fatal_object_error(op2, NOT_A_REAL_NUMBER);
+	    break;
+    }
+
+    return (0);
+}
+
+#if 0		/* not used */
+static int
+cmp_number_object(n_number *op1, LispObj *op2)
+{
+    if (op1->complex) {
+	if (OBJECT_TYPE(op2) == LispComplex_t) {
+	    if (cmp_real_object(NREAL(op1), OCXR(op2)) == 0)
+		return (cmp_real_object(NIMAG(op1), OCXI(op2)));
+	    return (1);
+	}
+	else if (cmp_real_real(NIMAG(op1), &zero) == 0)
+	    return (cmp_real_object(NREAL(op1), op2));
+	else
+	    return (1);
+    }
+    else {
+	switch (OBJECT_TYPE(op2)) {
+	    case LispFixnum_t:
+		switch (NRTYPE(op1)) {
+		    case N_FIXNUM:
+			return (cmp_fi_fi(NRFI(op1), OFI(op2)));
+		    case N_BIGNUM:
+			return (cmp_bi_fi(NRBI(op1), OFI(op2)));
+		    case N_FLONUM:
+			return (cmp_flonum(NRFF(op1), (double)OFI(op2)));
+		    case N_FIXRATIO:
+			return (cmp_fr_fi(NRFRD(op1), NRFRN(op1), OFI(op2)));
+		    case N_BIGRATIO:
+			return (cmp_br_fi(NRBR(op1), OFI(op2)));
+		}
+		break;
+	    case LispInteger_t:
+		switch (NRTYPE(op1)) {
+		    case N_FIXNUM:
+			return (cmp_fi_fi(NRFI(op1), OII(op2)));
+		    case N_BIGNUM:
+			return (cmp_bi_fi(NRBI(op1), OII(op2)));
+		    case N_FLONUM:
+			return (cmp_flonum(NRFF(op1), (double)OII(op2)));
+		    case N_FIXRATIO:
+			return (cmp_fr_fi(NRFRD(op1), NRFRN(op1), OII(op2)));
+		    case N_BIGRATIO:
+			return (cmp_br_fi(NRBR(op1), OII(op2)));
+		}
+		break;
+	    case LispBignum_t:
+		switch (NRTYPE(op1)) {
+		    case N_FIXNUM:
+			return (cmp_fi_bi(NRFI(op1), OBI(op2)));
+		    case N_BIGNUM:
+			return (cmp_bi_bi(NRBI(op1), OBI(op2)));
+		    case N_FLONUM:
+			return (cmp_flonum(NRFF(op1), bi_getd(OBI(op2))));
+		    case N_FIXRATIO:
+			return (cmp_fr_bi(NRFRD(op1), NRFRN(op1), OBI(op2)));
+		    case N_BIGRATIO:
+			return (cmp_br_bi(NRBR(op1), OBI(op2)));
+		}
+		break;
+	    case LispDFloat_t:
+		switch (NRTYPE(op1)) {
+		    case N_FIXNUM:
+			return (cmp_flonum((double)NRFI(op1), ODF(op2)));
+		    case N_BIGNUM:
+			return (cmp_flonum(bi_getd(NRBI(op1)), ODF(op2)));
+		    case N_FLONUM:
+			return (cmp_flonum(NRFF(op1), ODF(op2)));
+		    case N_FIXRATIO:
+			return (cmp_flonum((double)NRFRN(op1) /
+					   (double)NRFRD(op1),
+					   ODF(op2)));
+		    case N_BIGRATIO:
+			return (cmp_flonum(br_getd(NRBR(op1)), ODF(op2)));
+		}
+		break;
+	    case LispRatio_t:
+		switch (NRTYPE(op1)) {
+		    case N_FIXNUM:
+			return (cmp_fi_fr(NRFI(op1), OFRN(op2), OFRD(op2)));
+		    case N_BIGNUM:
+			return (cmp_bi_fr(NRBI(op1), OFRN(op2), OFRD(op2)));
+		    case N_FLONUM:
+			return (cmp_flonum(NRFF(op1),
+					   (double)OFRN(op2) / (double)OFRD(op2)));
+		    case N_FIXRATIO:
+			return (cmp_fr_fr(NRFRN(op1), NRFRD(op1),
+					  OFRN(op2), OFRD(op2)));
+		    case N_BIGRATIO:
+			return (cmp_br_fr(NRBR(op1), OFRN(op2), OFRD(op2)));
+		}
+		break;
+	    case LispBigratio_t:
+		switch (NRTYPE(op1)) {
+		    case N_FIXNUM:
+			return (cmp_fi_br(NRFI(op1), OBR(op2)));
+		    case N_BIGNUM:
+			return (cmp_bi_br(NRBI(op1), OBR(op2)));
+		    case N_FLONUM:
+			return (cmp_flonum(NRFF(op1), br_getd(OBR(op2))));
+		    case N_FIXRATIO:
+			return (cmp_fr_br(NRFRN(op1), NRFRD(op1), OBR(op2)));
+		    case N_BIGRATIO:
+			return (cmp_br_br(NRBR(op1), OBR(op2)));
+		}
+		break;
+	    case LispComplex_t:
+		if (cmp_real_object(&zero, OCXI(op2)) == 0)
+		    return (cmp_real_object(NREAL(op1), OCXR(op2)));
+		return (1);
+	    default:
+		fatal_object_error(op2, NOT_A_NUMBER);
+		break;
+	}
+    }
+
+    return (0);
+}
+#endif
+
+static int
+cmp_object_object(LispObj *op1, LispObj *op2, int real)
+{
+    if (OBJECT_TYPE(op1) == LispComplex_t) {
+	if (real)
+	    fatal_object_error(op1, NOT_A_REAL_NUMBER);
+	if (OBJECT_TYPE(op2) == LispComplex_t)
+	    return (cmp_cx_cx(op1, op2));
+	else if (cmp_real_object(&zero, OCXI(op1)) == 0)
+	    return (cmp_object_object(OCXR(op1), op2, real));
+	return (1);
+    }
+    else if (OBJECT_TYPE(op2) == LispComplex_t) {
+	if (real)
+	    fatal_object_error(op1, NOT_A_REAL_NUMBER);
+	if (cmp_real_object(&zero, OCXI(op2)) == 0)
+	    return (cmp_object_object(op1, OCXR(op2), real));
+	return (1);
+    }
+    else {
+	switch (OBJECT_TYPE(op1)) {
+	    case LispFixnum_t:
+		switch (OBJECT_TYPE(op2)) {
+		    case LispFixnum_t:
+			return (cmp_fi_fi(OFI(op1), OFI(op2)));
+		    case LispInteger_t:
+			return (cmp_fi_fi(OFI(op1), OII(op2)));
+		    case LispBignum_t:
+			return (cmp_fi_bi(OFI(op1), OBI(op2)));
+		    case LispDFloat_t:
+			return (cmp_flonum((double)OFI(op1), ODF(op2)));
+		    case LispRatio_t:
+			return (cmp_fi_fr(OFI(op1),
+					  OFRN(op2), OFRD(op2)));
+		    case LispBigratio_t:
+			return (cmp_fi_br(OFI(op1), OBR(op2)));
+		    default:
+			break;
+		}
+		break;
+	    case LispInteger_t:
+		switch (OBJECT_TYPE(op2)) {
+		    case LispFixnum_t:
+			return (cmp_fi_fi(OII(op1), OFI(op2)));
+		    case LispInteger_t:
+			return (cmp_fi_fi(OII(op1), OII(op2)));
+		    case LispBignum_t:
+			return (cmp_fi_bi(OII(op1), OBI(op2)));
+		    case LispDFloat_t:
+			return (cmp_flonum((double)OII(op1), ODF(op2)));
+		    case LispRatio_t:
+			return (cmp_fi_fr(OII(op1),
+					  OFRN(op2), OFRD(op2)));
+		    case LispBigratio_t:
+			return (cmp_fi_br(OII(op1), OBR(op2)));
+		    default:
+			break;
+		}
+		break;
+	    case LispBignum_t:
+		switch (OBJECT_TYPE(op2)) {
+		    case LispFixnum_t:
+			return (cmp_bi_fi(OBI(op1), OFI(op2)));
+		    case LispInteger_t:
+			return (cmp_bi_fi(OBI(op1), OII(op2)));
+		    case LispBignum_t:
+			return (cmp_bi_bi(OBI(op1), OBI(op2)));
+		    case LispDFloat_t:
+			return (cmp_flonum(bi_getd(OBI(op1)), ODF(op2)));
+		    case LispRatio_t:
+			return (cmp_bi_fr(OBI(op1),
+					  OFRN(op2), OFRD(op2)));
+		    case LispBigratio_t:
+			return (cmp_bi_br(OBI(op1), OBR(op2)));
+		    default:
+			break;
+		}
+		break;
+	    case LispDFloat_t:
+		switch (OBJECT_TYPE(op2)) {
+		    case LispFixnum_t:
+			return (cmp_flonum(ODF(op1), (double)OFI(op2)));
+		    case LispInteger_t:
+			return (cmp_flonum(ODF(op1), (double)OII(op2)));
+		    case LispBignum_t:
+			return (cmp_flonum(ODF(op1), bi_getd(OBI(op2))));
+		    case LispDFloat_t:
+			return (cmp_flonum(ODF(op1), ODF(op2)));
+			break;
+		    case LispRatio_t:
+			return (cmp_flonum(ODF(op1),
+					   (double)OFRN(op2) /
+					   (double)OFRD(op2)));
+		    case LispBigratio_t:
+			return (cmp_flonum(ODF(op1), br_getd(OBR(op2))));
+		    default:
+			break;
+		}
+		break;
+	    case LispRatio_t:
+		switch (OBJECT_TYPE(op2)) {
+		    case LispFixnum_t:
+			return (cmp_fr_fi(OFRN(op1), OFRD(op1), OFI(op2)));
+		    case LispInteger_t:
+			return (cmp_fr_fi(OFRN(op1), OFRD(op1), OII(op2)));
+		    case LispBignum_t:
+			return (cmp_fr_bi(OFRN(op1), OFRD(op1), OBI(op2)));
+		    case LispDFloat_t:
+			return (cmp_flonum((double)OFRN(op1) /
+					   (double)OFRD(op1),
+					   ODF(op2)));
+		    case LispRatio_t:
+			return (cmp_fr_fr(OFRN(op1), OFRD(op1),
+					  OFRN(op2), OFRD(op2)));
+		    case LispBigratio_t:
+			return (cmp_fr_br(OFRN(op1), OFRD(op1), OBR(op2)));
+		    default:
+			break;
+		}
+		break;
+	    case LispBigratio_t:
+		switch (OBJECT_TYPE(op2)) {
+		    case LispFixnum_t:
+			return (cmp_br_fi(OBR(op1), OFI(op2)));
+		    case LispInteger_t:
+			return (cmp_br_fi(OBR(op1), OII(op2)));
+		    case LispBignum_t:
+			return (cmp_br_bi(OBR(op1), OBI(op2)));
+		    case LispDFloat_t:
+			return (cmp_flonum(br_getd(OBR(op1)), ODF(op2)));
+		    case LispRatio_t:
+			return (cmp_br_fr(OBR(op1), OFRN(op2), OFRD(op2)));
+		    case LispBigratio_t:
+			return (cmp_br_br(OBR(op1), OBR(op2)));
+		    default:
+			break;
+		}
+		break;
+	    default:
+		fatal_object_error(op1, NOT_A_NUMBER);
+		break;
+	}
+    }
+
+    fatal_object_error(op2, NOT_A_NUMBER);
+    return (0);
+}
+
+
+/************************************************************************
+ * FIXNUM
+ ************************************************************************/
+/*
+ * check if op1 + op2 will overflow
+ */
+static INLINE int
+fi_fi_add_overflow(long op1, long op2)
+{
+    long op = op1 + op2;
+
+    return (op1 > 0 ? op2 > op : op2 < op);
+}
+
+/*
+ * check if op1 - op2 will overflow
+ */
+static INLINE int
+fi_fi_sub_overflow(long op1, long op2)
+{
+    long op = op1 - op2;
+
+    return (((op1 < 0) ^ (op2 < 0)) && ((op < 0) ^ (op1 < 0)));
+}
+
+/*
+ * check if op1 * op2 will overflow
+ */
+static INLINE int
+fi_fi_mul_overflow(long op1, long op2)
+{
+#ifndef LONG64
+    double op = (double)op1 * (double)op2;
+
+    return (op > 2147483647.0 || op < -2147483648.0);
+#else
+    int shift, sign;
+    long mask;
+
+    if (op1 == 0 || op1 == 1 || op2 == 0 || op2 == 1)
+	return (0);
+
+    if (op1 == MINSLONG || op2 == MINSLONG)
+	return (1);
+
+    sign = (op1 < 0) ^ (op2 < 0);
+
+    if (op1 < 0)
+	op1 = -op1;
+    if (op2 < 0)
+	op2 = -op2;
+
+    for (shift = 0, mask = FI_MASK; shift < LONGSBITS; shift++, mask >>= 1)
+	if (op1 & mask)
+	    break;
+    ++shift;
+    for (mask = FI_MASK; shift < LONGSBITS; shift++, mask >>= 1)
+	if (op2 & mask)
+	    break;
+
+    return (shift < LONGSBITS);
+#endif
+}
+
+
+/************************************************************************
+ * BIGNUM
+ ************************************************************************/
+static void
+rbi_canonicalize(n_real *real)
+{
+    if (mpi_fiti(RBI(real))) {
+	long fi = mpi_geti(RBI(real));
+
+	RTYPE(real) = N_FIXNUM;
+	mpi_clear(RBI(real));
+	XFREE(RBI(real));
+	RFI(real) = fi;
+    }
+}
+
+
+/************************************************************************
+ * RATIO
+ ************************************************************************/
+static void
+rfr_canonicalize(n_real *real)
+{
+    long num, numerator, den, denominator, rest;
+
+    num = numerator = RFRN(real);
+    den = denominator = RFRD(real);
+    if (denominator == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    if (num == MINSLONG || den == MINSLONG) {
+	mpr *bigratio = XALLOC(mpr);
+
+	mpr_init(bigratio);
+	mpr_seti(bigratio, num, den);
+	RTYPE(real) = N_BIGRATIO;
+	RBR(real) = bigratio;
+	rbr_canonicalize(real);
+	return;
+    }
+
+    if (num < 0)
+	num = -num;
+    else if (num == 0) {
+	RFI(real) = 0;
+	RTYPE(real) = N_FIXNUM;
+	return;
+    }
+    for (;;) {
+	if ((rest = den % num) == 0)
+	    break;
+	den = num;
+	num = rest;
+    }
+    if (den != 1) {
+	denominator /= num;
+	numerator /= num;
+    }
+    if (denominator < 0) {
+	numerator = -numerator;
+	denominator = -denominator;
+    }
+    if (denominator == 1) {
+	RTYPE(real) = N_FIXNUM;
+	RFI(real) = numerator;
+    }
+    else {
+	RFRN(real) = numerator;
+	RFRD(real) = denominator;
+    }
+}
+
+static void
+rbr_canonicalize(n_real *real)
+{
+    int fitnum, fitden;
+    long numerator, denominator;
+
+    mpr_canonicalize(RBR(real));
+    fitnum = mpi_fiti(RBRN(real));
+    fitden = mpi_fiti(RBRD(real));
+    if (fitnum && fitden) {
+	numerator = mpi_geti(RBRN(real));
+	denominator = mpi_geti(RBRD(real));
+	mpr_clear(RBR(real));
+	XFREE(RBR(real));
+	if (numerator == 0) {
+	    RFI(real) = 0;
+	    RTYPE(real) = N_FIXNUM;
+	}
+	else if (denominator == 1) {
+	    RTYPE(real) = N_FIXNUM;
+	    RFI(real) = numerator;
+	}
+	else {
+	    RTYPE(real) = N_FIXRATIO;
+	    RFRN(real) = numerator;
+	    RFRD(real) = denominator;
+	}
+    }
+    else if (fitden) {
+	denominator = mpi_geti(RBRD(real));
+	if (denominator == 1) {
+	    mpi *bigi = XALLOC(mpi);
+
+	    mpi_init(bigi);
+	    mpi_set(bigi, RBRN(real));
+	    mpr_clear(RBR(real));
+	    XFREE(RBR(real));
+	    RTYPE(real) = N_BIGNUM;
+	    RBI(real) = bigi;
+	}
+	else if (denominator == 0)
+	    fatal_error(DIVIDE_BY_ZERO);
+    }
+}
+
+
+/************************************************************************
+ * COMPLEX
+ ************************************************************************/
+static void
+ncx_canonicalize(n_number *num)
+{
+    if (NITYPE(num) == N_FIXNUM && NIFI(num) == 0)
+	num->complex = 0;
+}
+
+
+/************************************************************************
+ * DIVIDE
+ ************************************************************************/
+#define NDIVIDE_NOP	0
+#define NDIVIDE_ADD	1
+#define NDIVIDE_SUB	2
+static void
+ndivide_fi_fi(n_number *num, long div, int fun, int flo)
+{
+    long quo, rem;
+
+    if (NRFI(num) == MINSLONG || div == MINSLONG) {
+	LispObj integer;
+	mpi *bignum = XALLOC(mpi);
+
+	mpi_init(bignum);
+	mpi_seti(bignum, NRFI(num));
+	NRBI(num) = bignum;
+	NRTYPE(num) = N_BIGNUM;
+	integer.type = LispInteger_t;
+	integer.data.integer = div;
+	ndivide_xi_xi(num, &integer, fun, flo);
+	return;
+    }
+    else {
+	quo = NRFI(num) / div;
+	rem = NRFI(num) % div;
+    }
+
+    switch (fun) {
+	case NDIVIDE_CEIL:
+	    if ((rem < 0 && div < 0) || (rem > 0 && div > 0)) {
+		++quo;
+		rem -= div;
+	    }
+	    break;
+	case NDIVIDE_FLOOR:
+	    if ((rem < 0 && div > 0) || (rem > 0 && div < 0)) {
+		--quo;
+		rem += div;
+	    }
+	    break;
+	case NDIVIDE_ROUND:
+	    if (div > 0) {
+		if (rem > 0) {
+		    if (rem >= (div + 1) / 2) {
+			++quo;
+			rem -= div;
+		    }
+		}
+		else {
+		    if (rem <= (-div - 1) / 2) {
+			--quo;
+			rem += div;
+		    }
+		}
+	    }
+	    else {
+		if (rem > 0) {
+		    if (rem >= (-div + 1) / 2) {
+			--quo;
+			rem += div;
+		    }
+		}
+		else {
+		    if (rem <= (div - 1) / 2) {
+			++quo;
+			rem -= div;
+		    }
+		}
+	    }
+	    break;
+    }
+
+    NITYPE(num) = N_FIXNUM;
+    NIFI(num) = rem;
+    if (flo) {
+	NRTYPE(num) = N_FLONUM;
+	NRFF(num) = (double)quo;
+    }
+    else
+	NRFI(num) = quo;
+}
+
+static void
+ndivide_xi_xi(n_number *num, LispObj *div, int fun, int flo)
+{
+    LispType type = OBJECT_TYPE(div);
+    int state = NDIVIDE_NOP, dsign, rsign;
+    mpi *quo, *rem;
+
+    quo = XALLOC(mpi);
+    mpi_init(quo);
+    if (NRTYPE(num) == N_FIXNUM)
+	mpi_seti(quo, NRFI(num));
+    else
+	mpi_set(quo, NRBI(num));
+
+    rem = XALLOC(mpi);
+    mpi_init(rem);
+
+    switch (type) {
+	case LispFixnum_t:
+	    mpi_seti(rem, OFI(div));
+	    break;
+	case LispInteger_t:
+	    mpi_seti(rem, OII(div));
+	    break;
+	default:
+	    mpi_set(rem, OBI(div));
+    }
+
+    dsign = mpi_sgn(rem);
+
+    mpi_divqr(quo, rem, quo, rem);
+    rsign = mpi_sgn(rem);
+
+    switch (fun) {
+	case NDIVIDE_CEIL:
+	    if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
+		state = NDIVIDE_ADD;
+	    break;
+	case NDIVIDE_FLOOR:
+	    if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
+		state = NDIVIDE_SUB;
+	    break;
+	case NDIVIDE_ROUND: {
+	    mpi test;
+
+	    mpi_init(&test);
+	    switch (type) {
+		case LispFixnum_t:
+		    mpi_seti(&test, OFI(div));
+		    break;
+		case LispInteger_t:
+		    mpi_seti(&test, OII(div));
+		    break;
+		default:
+		    mpi_set(&test, OBI(div));
+	    }
+	    if (dsign > 0) {
+		if (rsign > 0) {
+		    mpi_addi(&test, &test, 1);
+		    mpi_divi(&test, &test, 2);
+		    if (mpi_cmp(rem, &test) >= 0)
+			state = NDIVIDE_ADD;
+		}
+		else {
+		    mpi_neg(&test, &test);
+		    mpi_subi(&test, &test, 1);
+		    mpi_divi(&test, &test, 2);
+		    if (mpi_cmp(rem, &test) <= 0)
+			state = NDIVIDE_SUB;
+		}
+	    }
+	    else {
+		if (rsign > 0) {
+		    mpi_neg(&test, &test);
+		    mpi_addi(&test, &test, 1);
+		    mpi_divi(&test, &test, 2);
+		    if (mpi_cmp(rem, &test) >= 0)
+			state = NDIVIDE_SUB;
+		}
+		else {
+		    mpi_subi(&test, &test, 1);
+		    mpi_divi(&test, &test, 2);
+		    if (mpi_cmp(rem, &test) <= 0)
+			state = NDIVIDE_ADD;
+		}
+	    }
+	    mpi_clear(&test);
+	}   break;
+    }
+
+    if (state == NDIVIDE_ADD) {
+	mpi_addi(quo, quo, 1);
+	switch (type) {
+	    case LispFixnum_t:
+		mpi_subi(rem, rem, OFI(div));
+		break;
+	    case LispInteger_t:
+		mpi_subi(rem, rem, OII(div));
+		break;
+	    default:
+		mpi_sub(rem, rem, OBI(div));
+	}
+    }
+    else if (state == NDIVIDE_SUB) {
+	mpi_subi(quo, quo, 1);
+	switch (type) {
+	    case LispFixnum_t:
+		mpi_addi(rem, rem, OFI(div));
+		break;
+	    case LispInteger_t:
+		mpi_addi(rem, rem, OII(div));
+		break;
+	    default:
+		mpi_add(rem, rem, OBI(div));
+	}
+    }
+
+    if (mpi_fiti(rem)) {
+	NITYPE(num) = N_FIXNUM;
+	NIFI(num) = mpi_geti(rem);
+	mpi_clear(rem);
+	XFREE(rem);
+    }
+    else {
+	NITYPE(num) = N_BIGNUM;
+	NIBI(num) = rem;
+    }
+
+    clear_real(NREAL(num));
+
+    if (flo) {
+	double dval = bi_getd(quo);
+
+	mpi_clear(quo);
+	XFREE(quo);
+	NRTYPE(num) = N_FLONUM;
+	NRFF(num) = dval;
+    }
+    else {
+	NRTYPE(num) = N_BIGNUM;
+	NRBI(num) = quo;
+	rbi_canonicalize(NREAL(num));
+    }
+}
+
+static void
+ndivide_flonum(n_number *number, double num, double div, int fun, int flo)
+{
+    double quo, rem, modp, tmp;
+
+    modp = modf(num / div, &quo);
+    rem = num - quo * div;
+
+    switch (fun) {
+	case NDIVIDE_CEIL:
+	    if ((rem < 0.0 && div < 0.0) || (rem > 0.0 && div > 0.0)) {
+		quo += 1.0;
+		rem -= div;
+	    }
+	    break;
+	case NDIVIDE_FLOOR:
+	    if ((rem < 0.0 && div > 0.0) || (rem > 0.0 && div < 0.0)) {
+		quo -= 1.0;
+		rem += div;
+	    }
+	    break;
+	case NDIVIDE_ROUND:
+	    if (fabs(modp) != 0.5 || modf(quo * 0.5, &tmp) != 0.0) {
+		if (div > 0.0) {
+		    if (rem > 0.0) {
+			if (rem >= div * 0.5) {
+			    quo += 1.0;
+			    rem -= div;
+			}
+		    }
+		    else {
+			if (rem <= div * -0.5) {
+			    quo -= 1.0;
+			    rem += div;
+			}
+		    }
+		}
+		else {
+		    if (rem > 0.0) {
+			if (rem >= div * -0.5) {
+			    quo -= 1.0;
+			    rem += div;
+			}
+		    }
+		    else {
+			if (rem <= div * 0.5) {
+			    quo += 1.0;
+			    rem -= div;
+			}
+		    }
+		}
+	    }
+	    break;
+    }
+    if (!finite(quo) || !finite(rem))
+	fatal_error(FLOATING_POINT_OVERFLOW);
+
+    NITYPE(number) = N_FLONUM;
+    NIFF(number) = rem;
+
+    clear_real(NREAL(number));
+
+    if (flo) {
+	NRTYPE(number) = N_FLONUM;
+	NRFF(number) = quo;
+    }
+    else {
+	if ((long)quo == quo) {
+	    NRTYPE(number) = N_FIXNUM;
+	    NRFI(number) = (long)quo;
+	}
+	else {
+	    mpi *bigi = XALLOC(mpi);
+
+	    mpi_init(bigi);
+	    mpi_setd(bigi, quo);
+	    NRBI(number) = bigi;
+	    NRTYPE(number) = N_BIGNUM;
+	}
+    }
+}
+
+static void
+ndivide_xi_xr(n_number *num, LispObj *div, int fun, int flo)
+{
+    int state = NDIVIDE_NOP, dsign, rsign;
+    mpi *quo;
+    mpr *rem;
+
+    quo = XALLOC(mpi);
+    mpi_init(quo);
+    if (NRTYPE(num) == N_FIXNUM)
+	mpi_seti(quo, NRFI(num));
+    else    
+	mpi_set(quo, NRBI(num));
+
+    rem = XALLOC(mpr);
+    mpr_init(rem);
+
+    if (XOBJECT_TYPE(div) == LispRatio_t)
+	mpr_seti(rem, OFRN(div), OFRD(div));
+    else
+	mpr_set(rem, OBR(div));
+    dsign = mpi_sgn(mpr_num(rem));
+    mpi_mul(quo, quo, mpr_den(rem));
+
+    mpi_divqr(quo, mpr_num(rem), quo, mpr_num(rem));
+    mpr_canonicalize(rem);
+
+    rsign = mpi_sgn(mpr_num(rem));
+    if (mpr_fiti(rem)) {
+	if (mpi_geti(mpr_den(rem)) == 1) {
+	    NITYPE(num) = N_FIXNUM;
+	    NIFI(num) = mpi_geti(mpr_num(rem));
+	}
+	else {
+	    NITYPE(num) = N_FIXRATIO;
+	    NIFRN(num) = mpi_geti(mpr_num(rem));
+	    NIFRD(num) = mpi_geti(mpr_den(rem));
+	}
+	mpr_clear(rem);
+	XFREE(rem);	
+    }
+    else {
+	if (mpi_fiti(mpr_den(rem)) && mpi_geti(mpr_den(rem)) == 1) {
+	    NITYPE(num) = N_BIGNUM;
+	    NIBI(num) = mpr_num(rem);
+	    mpi_clear(mpr_den(rem));
+	    XFREE(rem);
+	}
+	else {
+	    NITYPE(num) = N_BIGRATIO;
+	    NIBR(num) = rem;
+	}
+    }
+
+    switch (fun) {
+	case NDIVIDE_CEIL:
+	    if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
+		state = NDIVIDE_ADD;
+	    break;
+	case NDIVIDE_FLOOR:
+	    if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
+		state = NDIVIDE_SUB;
+	    break;
+	case NDIVIDE_ROUND: {
+	    n_real cmp;
+
+	    set_real_object(&cmp, div);
+	    div_real_real(&cmp, &two);
+	    if (dsign > 0) {
+		if (rsign > 0) {
+		    if (cmp_real_real(NIMAG(num), &cmp) >= 0)
+			state = NDIVIDE_ADD;
+		}
+		else {
+		    neg_real(&cmp);
+		    if (cmp_real_real(NIMAG(num), &cmp) <= 0)
+			state = NDIVIDE_SUB;
+		}
+	    }
+	    else {
+		if (rsign > 0) {
+		    neg_real(&cmp);
+		    if (cmp_real_real(NIMAG(num), &cmp) >= 0)
+			state = NDIVIDE_SUB;
+		}
+		else {
+		    if (cmp_real_real(NIMAG(num), &cmp) <= 0)
+			state = NDIVIDE_ADD;
+		}
+	    }
+	    clear_real(&cmp);
+	}   break;
+    }
+
+    if (state == NDIVIDE_ADD) {
+	mpi_addi(quo, quo, 1);
+	sub_real_object(NIMAG(num), div);
+    }
+    else if (state == NDIVIDE_SUB) {
+	mpi_subi(quo, quo, 1);
+	add_real_object(NIMAG(num), div);
+    }
+
+    clear_real(NREAL(num));
+
+    if (flo) {
+	double dval = bi_getd(quo);
+
+	mpi_clear(quo);
+	XFREE(quo);
+	NRTYPE(num) = N_FLONUM;
+	NRFF(num) = dval;
+    }
+    else {
+	NRBI(num)  = quo;
+	NRTYPE(num) = N_BIGNUM;
+	rbi_canonicalize(NREAL(num));
+    }
+}
+
+static void
+ndivide_xr_xi(n_number *num, LispObj *div, int fun, int flo)
+{
+    LispType type = OBJECT_TYPE(div);
+    int state = NDIVIDE_NOP, dsign, rsign;
+    mpi *quo;
+    mpr *rem;
+
+    quo = XALLOC(mpi);
+    mpi_init(quo);
+    switch (type) {
+	case LispFixnum_t:
+	    dsign = OFI(div) < 0 ? -1 : OFI(div) > 0 ? 1 : 0;
+	    mpi_seti(quo, OFI(div));
+	    break;
+	case LispInteger_t:
+	    dsign = OII(div) < 0 ? -1 : OII(div) > 0 ? 1 : 0;
+	    mpi_seti(quo, OII(div));
+	    break;
+	default:
+	    dsign = mpi_sgn(OBI(div));
+	    mpi_set(quo, OBI(div));
+	    break;
+    }
+
+    rem = XALLOC(mpr);
+    mpr_init(rem);
+    if (NRTYPE(num) == N_FIXRATIO) {
+	mpr_seti(rem, NRFRN(num), NRFRD(num));
+	mpi_muli(quo, quo, NRFRD(num));
+    }
+    else {
+	mpr_set(rem, NRBR(num));
+	mpi_mul(quo, quo, NRBRD(num));
+    }
+    mpi_divqr(quo, mpr_num(rem), mpr_num(rem), quo);
+    mpr_canonicalize(rem);
+
+    rsign = mpi_sgn(mpr_num(rem));
+    if (mpr_fiti(rem)) {
+	NITYPE(num) = N_FIXRATIO;
+	NIFRN(num) = mpi_geti(mpr_num(rem));
+	NIFRD(num) = mpi_geti(mpr_den(rem));
+	mpr_clear(rem);
+	XFREE(rem);
+    }
+    else {
+	NITYPE(num) = N_BIGRATIO;
+	NIBR(num) = rem;
+    }
+
+    switch (fun) {
+	case NDIVIDE_CEIL:
+	    if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
+		state = NDIVIDE_ADD;
+	    break;
+	case NDIVIDE_FLOOR:
+	    if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
+		state = NDIVIDE_SUB;
+	    break;
+	case NDIVIDE_ROUND: {
+	    n_real cmp;
+
+	    set_real_object(&cmp, div);
+	    div_real_real(&cmp, &two);
+	    if (dsign > 0) {
+		if (rsign > 0) {
+		    if (cmp_real_real(NIMAG(num), &cmp) >= 0)
+			state = NDIVIDE_ADD;
+		}
+		else {
+		    neg_real(&cmp);
+		    if (cmp_real_real(NIMAG(num), &cmp) <= 0)
+			state = NDIVIDE_SUB;
+		}
+	    }
+	    else {
+		if (rsign > 0) {
+		    neg_real(&cmp);
+		    if (cmp_real_real(NIMAG(num), &cmp) >= 0)
+			state = NDIVIDE_SUB;
+		}
+		else {
+		    if (cmp_real_real(NIMAG(num), &cmp) <= 0)
+			state = NDIVIDE_ADD;
+		}
+	    }
+	    clear_real(&cmp);
+	}   break;
+    }
+
+    if (state == NDIVIDE_ADD) {
+	mpi_addi(quo, quo, 1);
+	sub_real_object(NIMAG(num), div);
+    }
+    else if (state == NDIVIDE_SUB) {
+	mpi_subi(quo, quo, 1);
+	add_real_object(NIMAG(num), div);
+    }
+
+    clear_real(NREAL(num));
+
+    if (flo) {
+	double dval = bi_getd(quo);
+
+	mpi_clear(quo);
+	XFREE(quo);
+	NRTYPE(num) = N_FLONUM;
+	NRFF(num) = dval;
+    }
+    else {
+	NRBI(num) = quo;
+	NRTYPE(num) = N_BIGNUM;
+	rbi_canonicalize(NREAL(num));
+    }
+}
+
+static void
+ndivide_xr_xr(n_number *num, LispObj *div, int fun, int flo)
+{
+    int state = NDIVIDE_NOP, dsign, rsign, modp;
+    mpr *bigr;
+    mpi *bigi;
+
+    bigr = XALLOC(mpr);
+    mpr_init(bigr);
+    if (NRTYPE(num) == N_FIXRATIO)
+	mpr_seti(bigr, NRFRN(num), NRFRD(num));
+    else
+	mpr_set(bigr, NRBR(num));
+
+    NITYPE(num) = N_BIGRATIO;
+    NIBR(num) = bigr;
+
+    if (OBJECT_TYPE(div) == LispRatio_t) {
+	dsign = OFRN(div) < 0 ? -1 : OFRN(div) > 0 ? 1 : 0;
+	mpi_muli(mpr_num(bigr), mpr_num(bigr), OFRD(div));
+	mpi_muli(mpr_den(bigr), mpr_den(bigr), OFRN(div));
+    }
+    else {
+	dsign = mpi_sgn(OBRN(div));
+	mpr_div(bigr, bigr, OBR(div));
+    }
+    modp = mpi_fiti(mpr_den(bigr)) && mpi_geti(mpr_den(bigr)) == 2;
+
+    bigi = XALLOC(mpi);
+    mpi_init(bigi);
+    mpi_divqr(bigi, mpr_num(bigr), mpr_num(bigr), mpr_den(bigr));
+
+    if (OBJECT_TYPE(div) == LispRatio_t)
+	mpi_seti(mpr_den(bigr), OFRD(div));
+    else
+	mpi_set(mpr_den(bigr), OBRD(div));
+    if (NRTYPE(num) == N_FIXRATIO)
+	mpi_muli(mpr_den(bigr), mpr_den(bigr), NRFRD(num));
+    else
+	mpi_mul(mpr_den(bigr), mpr_den(bigr), NRBRD(num));
+
+    clear_real(NREAL(num));
+    NRTYPE(num) = N_BIGNUM;
+    NRBI(num) = bigi;
+
+    rbr_canonicalize(NIMAG(num));
+    rsign = cmp_real_real(NIMAG(num), &zero);
+
+    switch (fun) {
+	case NDIVIDE_CEIL:
+	    if ((rsign < 0 && dsign < 0) || (rsign > 0 && dsign > 0))
+		state = NDIVIDE_ADD;
+	    break;
+	case NDIVIDE_FLOOR:
+	    if ((rsign < 0 && dsign > 0) || (rsign > 0 && dsign < 0))
+		state = NDIVIDE_SUB;
+	    break;
+	case NDIVIDE_ROUND:
+	    if (!modp || (bigi->digs[0] & 1) == 1) {
+		n_real cmp;
+
+		set_real_object(&cmp, div);
+		div_real_real(&cmp, &two);
+		if (dsign > 0) {
+		    if (rsign > 0) {
+			if (cmp_real_real(NIMAG(num), &cmp) >= 0)
+			    state = NDIVIDE_ADD;
+		    }
+		    else {
+			neg_real(&cmp);
+			if (cmp_real_real(NIMAG(num), &cmp) <= 0)
+			    state = NDIVIDE_SUB;
+		    }
+		}
+		else {
+		    if (rsign > 0) {
+			neg_real(&cmp);
+			if (cmp_real_real(NIMAG(num), &cmp) >= 0)
+			    state = NDIVIDE_SUB;
+		    }
+		    else {
+			if (cmp_real_real(NIMAG(num), &cmp) <= 0)
+			    state = NDIVIDE_ADD;
+		    }
+		}
+		clear_real(&cmp);
+	    }
+	    break;
+    }
+
+    if (state == NDIVIDE_ADD) {
+	add_real_real(NREAL(num), &one);
+	sub_real_object(NIMAG(num), div);
+    }
+    else if (state == NDIVIDE_SUB) {
+	sub_real_real(NREAL(num), &one);
+	add_real_object(NIMAG(num), div);
+    }
+
+    if (NRTYPE(num) == N_BIGNUM) {
+	if (flo) {
+	    double dval = bi_getd(bigi);
+
+	    mpi_clear(bigi);
+	    XFREE(bigi);
+	    NRTYPE(num) = N_FLONUM;
+	    NRFF(num) = dval;
+	}
+	else
+	    rbi_canonicalize(NREAL(num));
+    }
+    else if (flo) {
+	NRTYPE(num) = N_FLONUM;
+	NRFF(num) = (double)NRFI(num);
+    }
+}
+
+
+/************************************************************************
+ * REAL COMPLEX
+ ************************************************************************/
+static void
+nadd_re_cx(n_number *num, LispObj *comp)
+{
+/*
+	Ra+Rb Ib
+ */
+    /* Ra+Rb */
+    add_real_object(NREAL(num), OCXR(comp));
+
+    /* Ib */
+    set_real_object(NIMAG(num), OCXI(comp));
+
+    num->complex = 1;
+
+    ncx_canonicalize(num);
+}
+
+static void
+nsub_re_cx(n_number *num, LispObj *comp)
+{
+/*
+	Ra-Rb -Ib
+ */
+    /* Ra-Rb */
+    sub_real_object(NREAL(num), OCXR(comp));
+
+    /* -Ib */
+    NITYPE(num) = N_FIXNUM;
+    NIFI(num) = -1;
+    mul_real_object(NIMAG(num), OCXI(comp));
+
+    num->complex = 1;
+
+    ncx_canonicalize(num);
+}
+
+static void
+nmul_re_cx(n_number *num, LispObj *comp)
+{
+/*
+	Ra*Rb Ra*Ib
+ */
+    /* copy before change */
+    set_real_real(NIMAG(num), NREAL(num));
+
+    /* Ra*Rb */
+    mul_real_object(NREAL(num), OCXR(comp));
+
+    /* Ra*Ib */
+    mul_real_object(NIMAG(num), OCXI(comp));
+
+    num->complex = 1;
+
+    ncx_canonicalize(num);
+}
+
+static void
+ndiv_re_cx(n_number *num, LispObj *comp)
+{
+/*
+	Ra*Rb        -Ib*Ra
+	-----------  -----------
+	Rb*Rb+Ib*Ib  Rb*Rb+Ib*Ib
+ */
+    n_real div, temp;
+
+    /* Rb*Rb */
+    set_real_object(&div, OCXR(comp));
+    mul_real_object(&div, OCXR(comp));
+
+    /* Ib*Ib */
+    set_real_object(&temp, OCXI(comp));
+    mul_real_object(&temp, OCXI(comp));
+
+    /* Rb*Rb+Ib*Ib */
+    add_real_real(&div, &temp);
+    clear_real(&temp);
+
+    /* -Ib*Ra */
+    NITYPE(num) = N_FIXNUM;
+    NIFI(num) = -1;
+    mul_real_object(NIMAG(num), OCXI(comp));
+    mul_real_real(NIMAG(num), NREAL(num));
+
+    /* Ra*Rb */
+    mul_real_object(NREAL(num), OCXR(comp));
+
+    div_real_real(NREAL(num), &div);
+    div_real_real(NIMAG(num), &div);
+    clear_real(&div);
+
+    num->complex = 1;
+
+    ncx_canonicalize(num);
+}
+
+
+/************************************************************************
+ * COMPLEX REAL
+ ************************************************************************/
+static void
+nadd_cx_re(n_number *num, LispObj *re)
+{
+/*
+	Ra+Rb Ia
+ */
+    add_real_object(NREAL(num), re);
+
+    ncx_canonicalize(num);
+}
+
+static void
+nsub_cx_re(n_number *num, LispObj *re)
+{
+/*
+	Ra-Rb Ia
+ */
+    sub_real_object(NREAL(num), re);
+
+    ncx_canonicalize(num);
+}
+
+static void
+nmul_cx_re(n_number *num, LispObj *re)
+{
+/*
+	Ra*Rb Ia*Rb
+ */
+    mul_real_object(NREAL(num), re);
+    mul_real_object(NIMAG(num), re);
+
+    ncx_canonicalize(num);
+}
+
+static void
+ndiv_cx_re(n_number *num, LispObj *re)
+{
+/*
+	Ra/Rb Ia/Rb
+ */
+    div_real_object(NREAL(num), re);
+    div_real_object(NIMAG(num), re);
+
+    ncx_canonicalize(num);
+}
+
+
+/************************************************************************
+ * COMPLEX COMPLEX
+ ************************************************************************/
+static void
+nadd_cx_cx(n_number *num, LispObj *comp)
+{
+/*
+	Ra+Rb Ia+Ib
+ */
+    add_real_object(NREAL(num), OCXR(comp));
+    add_real_object(NIMAG(num), OCXI(comp));
+
+    ncx_canonicalize(num);
+}
+
+static void
+nsub_cx_cx(n_number *num, LispObj *comp)
+{
+/*
+	Ra-Rb Ia-Ib
+ */
+    sub_real_object(NREAL(num), OCXR(comp));
+    sub_real_object(NIMAG(num), OCXI(comp));
+
+    ncx_canonicalize(num);
+}
+
+static void
+nmul_cx_cx(n_number *num, LispObj *comp)
+{
+/*
+	Ra*Rb-Ia*Ib Ra*Ib+Ia*Rb
+ */
+    n_real IaIb, RaIb;
+
+    set_real_real(&IaIb, NIMAG(num));
+    mul_real_object(&IaIb, OCXI(comp));
+
+    set_real_real(&RaIb, NREAL(num));
+    mul_real_object(&RaIb, OCXI(comp));
+
+    /* Ra*Rb-Ia*Ib */
+    mul_real_object(NREAL(num), OCXR(comp));
+    sub_real_real(NREAL(num), &IaIb);
+    clear_real(&IaIb);
+
+    /* Ra*Ib+Ia*Rb */
+    mul_real_object(NIMAG(num), OCXR(comp));
+    add_real_real(NIMAG(num), &RaIb);
+    clear_real(&RaIb);
+
+    ncx_canonicalize(num);
+}
+
+static void
+ndiv_cx_cx(n_number *num, LispObj *comp)
+{
+/*
+	Ra*Rb+Ia*Ib  Ia*Rb-Ib*Ra
+	-----------  -----------
+	Rb*Rb+Ib*Ib  Rb*Rb+Ib*Ib
+ */
+    n_real temp1, temp2;
+
+    /* IaIb */
+    set_real_real(&temp1, NIMAG(num));
+    mul_real_object(&temp1, OCXI(comp));
+
+    /* IbRa */
+    set_real_real(&temp2, NREAL(num));
+    mul_real_object(&temp2, OCXI(comp));
+
+    /* Ra*Rb+Ia*Ib */
+    mul_real_object(NREAL(num), OCXR(comp));
+    add_real_real(NREAL(num), &temp1);
+    clear_real(&temp1);
+
+    /* Ia*Rb-Ib*Ra */
+    mul_real_object(NIMAG(num), OCXR(comp));
+    sub_real_real(NIMAG(num), &temp2);
+    clear_real(&temp2);
+
+
+    /* Rb*Rb */
+    set_real_object(&temp1, OCXR(comp));
+    mul_real_object(&temp1, OCXR(comp));
+
+    /* Ib*Ib */
+    set_real_object(&temp2, OCXI(comp));
+    mul_real_object(&temp2, OCXI(comp));
+
+    /* Rb*Rb+Ib*Ib */
+    add_real_real(&temp1, &temp2);
+    clear_real(&temp2);
+
+    div_real_real(NREAL(num), &temp1);
+    div_real_real(NIMAG(num), &temp1);
+    clear_real(&temp1);
+
+    ncx_canonicalize(num);
+}
+
+static int
+cmp_cx_cx(LispObj *op1, LispObj *op2)
+{
+    int cmp;
+
+    cmp = cmp_object_object(OCXR(op1), OCXR(op2), 1);
+    if (cmp == 0)
+	cmp = cmp_object_object(OCXI(op1), OCXI(op2), 1);
+
+    return (cmp);
+}
+
+
+/************************************************************************
+ * FLONUM FLONUM
+ ************************************************************************/
+static void
+radd_flonum(n_real *real, double op1, double op2)
+{
+    double value = op1 + op2;
+
+    if (!finite(value))
+	fatal_error(FLOATING_POINT_OVERFLOW);
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	case N_FIXRATIO:
+	    RTYPE(real) = N_FLONUM;
+	    break;
+	case N_BIGNUM:
+	    RCLEAR_BI(real);
+	    RTYPE(real) = N_FLONUM;
+	    break;
+	case N_BIGRATIO:
+	    RCLEAR_BR(real);
+	    RTYPE(real) = N_FLONUM;
+	    break;
+    }
+    RFF(real) = value;
+}
+
+static void
+rsub_flonum(n_real *real, double op1, double op2)
+{
+    double value = op1 - op2;
+
+    if (!finite(value))
+	fatal_error(FLOATING_POINT_OVERFLOW);
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	case N_FIXRATIO:
+	    RTYPE(real) = N_FLONUM;
+	    break;
+	case N_BIGNUM:
+	    RCLEAR_BI(real);
+	    RTYPE(real) = N_FLONUM;
+	    break;
+	case N_BIGRATIO:
+	    RCLEAR_BR(real);
+	    RTYPE(real) = N_FLONUM;
+	    break;
+    }
+    RFF(real) = value;
+}
+
+static void
+rmul_flonum(n_real *real, double op1, double op2)
+{
+    double value = op1 * op2;
+
+    if (!finite(value))
+	fatal_error(FLOATING_POINT_OVERFLOW);
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	case N_FIXRATIO:
+	    RTYPE(real) = N_FLONUM;
+	    break;
+	case N_BIGNUM:
+	    RCLEAR_BI(real);
+	    RTYPE(real) = N_FLONUM;
+	    break;
+	case N_BIGRATIO:
+	    RCLEAR_BR(real);
+	    RTYPE(real) = N_FLONUM;
+	    break;
+    }
+    RFF(real) = value;
+}
+
+static void
+rdiv_flonum(n_real *real, double op1, double op2)
+{
+    double value;
+
+    if (op2 == 0.0)
+	fatal_error(DIVIDE_BY_ZERO);
+    value = op1 / op2;
+    if (!finite(value))
+	fatal_error(FLOATING_POINT_OVERFLOW);
+    switch (RTYPE(real)) {
+	case N_FIXNUM:
+	case N_FIXRATIO:
+	    RTYPE(real) = N_FLONUM;
+	    break;
+	case N_BIGNUM:
+	    RCLEAR_BI(real);
+	    RTYPE(real) = N_FLONUM;
+	    break;
+	case N_BIGRATIO:
+	    RCLEAR_BR(real);
+	    RTYPE(real) = N_FLONUM;
+	    break;
+    }
+    RFF(real) = value;
+}
+
+static int
+cmp_flonum(double op1, double op2)
+{
+    double value = op1 - op2;
+
+    if (!finite(value))
+	fatal_error(FLOATING_POINT_OVERFLOW);
+
+    return (value > 0.0 ? 1 : value < 0.0 ? -1 : 0);
+}
+
+
+/************************************************************************
+ * FIXNUM FIXNUM
+ ************************************************************************/
+static void
+rop_fi_fi_bi(n_real *real, long fi, int op)
+{
+    mpi *bigi = XALLOC(mpi);
+
+    mpi_init(bigi);
+    mpi_seti(bigi, RFI(real));
+    if (op == NOP_ADD)
+	mpi_addi(bigi, bigi, fi);
+    else if (op == NOP_SUB)
+	mpi_subi(bigi, bigi, fi);
+    else
+	mpi_muli(bigi, bigi, fi);
+    RBI(real) = bigi;
+    RTYPE(real) = N_BIGNUM;
+}
+
+static INLINE void
+radd_fi_fi(n_real *real, long fi)
+{
+    if (!fi_fi_add_overflow(RFI(real), fi))
+	RFI(real) += fi;
+    else
+	rop_fi_fi_bi(real, fi, NOP_ADD);
+}
+
+static INLINE void
+rsub_fi_fi(n_real *real, long fi)
+{
+    if (!fi_fi_sub_overflow(RFI(real), fi))
+	RFI(real) -= fi;
+    else
+	rop_fi_fi_bi(real, fi, NOP_SUB);
+}
+
+static INLINE void
+rmul_fi_fi(n_real *real, long fi)
+{
+    if (!fi_fi_mul_overflow(RFI(real), fi))
+	RFI(real) *= fi;
+    else
+	rop_fi_fi_bi(real, fi, NOP_MUL);
+}
+
+static INLINE void
+rdiv_fi_fi(n_real *real, long fi)
+{
+    RTYPE(real) = N_FIXRATIO;
+    RFRN(real) = RFI(real);
+    RFRD(real) = fi;
+    rfr_canonicalize(real);
+}
+
+static INLINE int
+cmp_fi_fi(long op1, long op2)
+{
+    if (op1 > op2)
+	return (1);
+    else if (op1 < op2)
+	return (-1);
+
+    return (0);
+}
+
+
+/************************************************************************
+ * FIXNUM BIGNUM
+ ************************************************************************/
+static void
+rop_fi_bi_xi(n_real *real, mpi *bi, int nop)
+{
+    mpi *bigi = XALLOC(mpi);
+
+    mpi_init(bigi);
+    mpi_seti(bigi, RFI(real));
+    if (nop == NOP_ADD)
+	mpi_add(bigi, bigi, bi);
+    else if (nop == NOP_SUB)
+	mpi_sub(bigi, bigi, bi);
+    else
+	mpi_mul(bigi, bigi, bi);
+
+    if (mpi_fiti(bigi)) {
+	RFI(real) = mpi_geti(bigi);
+	mpi_clear(bigi);
+	XFREE(bigi);
+    }
+    else {
+	RBI(real) = bigi;
+	RTYPE(real) = N_BIGNUM;
+    }
+}
+
+static INLINE void
+radd_fi_bi(n_real *real, mpi *bi)
+{
+    rop_fi_bi_xi(real, bi, NOP_ADD);
+}
+
+static INLINE void
+rsub_fi_bi(n_real *real, mpi *bi)
+{
+    rop_fi_bi_xi(real, bi, NOP_SUB);
+}
+
+static INLINE void
+rmul_fi_bi(n_real *real, mpi *bi)
+{
+    rop_fi_bi_xi(real, bi, NOP_MUL);
+}
+
+static void
+rdiv_fi_bi(n_real *real, mpi *bi)
+{
+    mpr *bigr;
+
+    if (mpi_cmpi(bi, 0) == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    bigr = XALLOC(mpr);
+    mpr_init(bigr);
+    mpi_seti(mpr_num(bigr), RFI(real));
+    mpi_set(mpr_den(bigr), bi);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real);
+}
+
+static INLINE int
+cmp_fi_bi(long fixnum, mpi *bignum)
+{
+    return (-mpi_cmpi(bignum, fixnum));
+}
+
+
+/************************************************************************
+ * FIXNUM FIXRATIO
+ ************************************************************************/
+static void
+rop_fi_fr_as_xr(n_real *real, long num, long den, int nop)
+{
+    int fit;
+    long value = 0, op = RFI(real);
+
+    fit = !fi_fi_mul_overflow(op, den);
+    if (fit) {
+	value = op * den;
+	if (nop == NOP_ADD)
+	    fit = !fi_fi_add_overflow(value, num);
+	else
+	    fit = !fi_fi_sub_overflow(value, num);
+    }
+    if (fit) {
+	if (nop == NOP_ADD)
+	    RFRN(real) = value + num;
+	else
+	    RFRN(real) = value - num;
+	RFRD(real) = den;
+	RTYPE(real) = N_FIXRATIO;
+	rfr_canonicalize(real);
+    }
+    else {
+	mpi iop;
+	mpr *bigr = XALLOC(mpr);
+
+	mpi_init(&iop);
+	mpi_seti(&iop, op);
+	mpi_muli(&iop, &iop, den);
+
+	mpr_init(bigr);
+	mpr_seti(bigr, num, den);
+	if (nop == NOP_ADD)
+	    mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
+	else
+	    mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
+	mpi_clear(&iop);
+	RBR(real) = bigr;
+	RTYPE(real) = N_BIGRATIO;
+	rbr_canonicalize(real);
+    }
+}
+
+static void
+rop_fi_fr_md_xr(n_real *real, long num, long den, int nop)
+{
+    int fit;
+    long op = RFI(real);
+
+    if (nop == NOP_MUL)
+	fit = !fi_fi_mul_overflow(op, num);
+    else
+	fit = !fi_fi_mul_overflow(op, den);
+    if (fit) {
+	if (nop == NOP_MUL) {
+	    RFRN(real) = op * num;
+	    RFRD(real) = den;
+	}
+	else {
+	    RFRN(real) = op * den;
+	    RFRD(real) = num;
+	}
+	RTYPE(real) = N_FIXRATIO;
+	rfr_canonicalize(real);
+    }
+    else {
+	mpi iop;
+	mpr *bigr = XALLOC(mpr);
+
+	mpi_init(&iop);
+	mpi_seti(&iop, op);
+
+	mpr_init(bigr);
+	if (nop == NOP_MUL)
+	    mpr_seti(bigr, num, den);
+	else
+	    mpr_seti(bigr, den, num);
+	mpi_mul(mpr_num(bigr), mpr_num(bigr), &iop);
+	mpi_clear(&iop);
+	RBR(real) = bigr;
+	RTYPE(real) = N_BIGRATIO;
+	rbr_canonicalize(real);
+    }
+}
+
+static INLINE void
+radd_fi_fr(n_real *real, long num, long den)
+{
+    rop_fi_fr_as_xr(real, num, den, NOP_ADD);
+}
+
+static INLINE void
+rsub_fi_fr(n_real *real, long num, long den)
+{
+    rop_fi_fr_as_xr(real, num, den, NOP_SUB);
+}
+
+static INLINE void
+rmul_fi_fr(n_real *real, long num, long den)
+{
+    rop_fi_fr_md_xr(real, num, den, NOP_MUL);
+}
+
+static INLINE void
+rdiv_fi_fr(n_real *real, long num, long den)
+{
+    rop_fi_fr_md_xr(real, num, den, NOP_DIV);
+}
+
+static INLINE int
+cmp_fi_fr(long fi, long num, long den)
+{
+    return (cmp_flonum((double)fi, (double)num / (double)den));
+}
+
+
+/************************************************************************
+ * FIXNUM BIGRATIO
+ ************************************************************************/
+static void
+rop_fi_br_as_xr(n_real *real, mpr *ratio, int nop)
+{
+    mpi iop;
+    mpr *bigr = XALLOC(mpr);
+
+    mpi_init(&iop);
+    mpi_seti(&iop, RFI(real));
+
+    mpr_init(bigr);
+    mpr_set(bigr, ratio);
+
+    mpi_mul(&iop, &iop, mpr_den(ratio));
+    if (nop == NOP_ADD)
+	mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
+    else
+	mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
+
+    mpi_clear(&iop);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real); 
+}
+
+static void
+rop_fi_br_md_xr(n_real *real, mpr *ratio, int nop)
+{
+    mpi iop;
+    mpr *bigr = XALLOC(mpr);
+
+    mpi_init(&iop);
+    mpi_seti(&iop, RFI(real));
+
+    mpr_init(bigr);
+    if (nop == NOP_MUL)
+	mpr_set(bigr, ratio);
+    else
+	mpr_inv(bigr, ratio);
+
+    mpi_mul(mpr_num(bigr), &iop, mpr_num(bigr));
+
+    mpi_clear(&iop);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real);
+}
+
+static INLINE void
+radd_fi_br(n_real *real, mpr *ratio)
+{
+    rop_fi_br_as_xr(real, ratio, NOP_ADD);
+}
+
+static INLINE void
+rsub_fi_br(n_real *real, mpr *ratio)
+{
+    rop_fi_br_as_xr(real, ratio, NOP_SUB);
+}
+
+static INLINE void
+rmul_fi_br(n_real *real, mpr *ratio)
+{
+    rop_fi_br_md_xr(real, ratio, NOP_MUL);
+}
+
+static INLINE void
+rdiv_fi_br(n_real *real, mpr *ratio)
+{
+    rop_fi_br_md_xr(real, ratio, NOP_DIV);
+}
+
+static INLINE int
+cmp_fi_br(long op1, mpr *op2)
+{
+    return (-mpr_cmpi(op2, op1));
+}
+
+
+/************************************************************************
+ * BIGNUM FIXNUM
+ ************************************************************************/
+static INLINE void
+radd_bi_fi(n_real *real, long fi)
+{
+    mpi_addi(RBI(real), RBI(real), fi);
+    rbi_canonicalize(real);
+}
+
+static INLINE void
+rsub_bi_fi(n_real *real, long fi)
+{
+    mpi_subi(RBI(real), RBI(real), fi);
+    rbi_canonicalize(real);
+}
+
+static INLINE void
+rmul_bi_fi(n_real *real, long fi)
+{
+    mpi_muli(RBI(real), RBI(real), fi);
+    rbi_canonicalize(real);
+}
+
+static void
+rdiv_bi_fi(n_real *real, long fi)
+{
+    mpr *bigr;
+
+    if (RFI(real) == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    bigr = XALLOC(mpr);
+    mpr_init(bigr);
+    mpi_set(mpr_num(bigr), RBI(real));
+    mpi_seti(mpr_den(bigr), fi);
+    RCLEAR_BI(real);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real);
+}
+
+static INLINE int
+cmp_bi_fi(mpi *bignum, long fi)
+{
+    return (mpi_cmpi(bignum, fi));
+}
+
+
+/************************************************************************
+ * BIGNUM BIGNUM
+ ************************************************************************/
+static INLINE void
+radd_bi_bi(n_real *real, mpi *bignum)
+{
+    mpi_add(RBI(real), RBI(real), bignum);
+    rbi_canonicalize(real);
+}
+
+static INLINE void
+rsub_bi_bi(n_real *real, mpi *bignum)
+{
+    mpi_sub(RBI(real), RBI(real), bignum);
+    rbi_canonicalize(real);
+}
+
+static INLINE void
+rmul_bi_bi(n_real *real, mpi *bignum)
+{
+    mpi_mul(RBI(real), RBI(real), bignum);
+    rbi_canonicalize(real);
+}
+
+static void
+rdiv_bi_bi(n_real *real, mpi *bignum)
+{
+    mpr *bigr;
+
+    if (mpi_cmpi(bignum, 0) == 0)
+	fatal_error(DIVIDE_BY_ZERO);
+
+    bigr = XALLOC(mpr);
+    mpr_init(bigr);
+    mpi_set(mpr_num(bigr), RBI(real));
+    mpi_set(mpr_den(bigr), bignum);
+    RCLEAR_BI(real);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real); 
+}
+
+static INLINE int
+cmp_bi_bi(mpi *op1, mpi *op2)
+{
+    return (mpi_cmp(op1, op2));
+}
+
+
+/************************************************************************
+ * BIGNUM FIXRATIO
+ ************************************************************************/
+static void
+rop_bi_fr_as_xr(n_real *real, long num, long den, int nop)
+{
+    mpi iop;
+    mpr *bigr = XALLOC(mpr);
+
+    mpi_init(&iop);
+    mpi_set(&iop, RBI(real));
+    mpi_muli(&iop, &iop, den);
+
+    mpr_init(bigr);
+    mpr_seti(bigr, num, den);
+
+    if (nop == NOP_ADD)
+	mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
+    else
+	mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
+    mpi_clear(&iop);
+
+    RCLEAR_BI(real);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real);
+}
+
+static INLINE void
+rop_bi_fr_md_xr(n_real *real, long num, long den, int nop)
+{
+    mpr *bigr = XALLOC(mpr);
+
+    mpr_init(bigr);
+
+    mpr_seti(bigr, num, den);
+
+    if (nop == NOP_MUL)
+	mpi_mul(mpr_num(bigr), RBI(real), mpr_num(bigr));
+    else {
+	mpi_mul(mpr_den(bigr), RBI(real), mpr_den(bigr));
+	mpr_inv(bigr, bigr);
+    }
+
+    RCLEAR_BI(real);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real);
+}
+
+static INLINE void
+radd_bi_fr(n_real *real, long num, long den)
+{
+    rop_bi_fr_as_xr(real, num, den, NOP_ADD);
+}
+
+static INLINE void
+rsub_bi_fr(n_real *real, long num, long den)
+{
+    rop_bi_fr_as_xr(real, num, den, NOP_SUB);
+}
+
+static INLINE void
+rmul_bi_fr(n_real *real, long num, long den)
+{
+    rop_bi_fr_md_xr(real, num, den, NOP_MUL);
+}
+
+static INLINE void
+rdiv_bi_fr(n_real *real, long num, long den)
+{
+    rop_bi_fr_md_xr(real, num, den, NOP_DIV);
+}
+
+static int
+cmp_bi_fr(mpi *bignum, long num, long den)
+{
+    int cmp;
+    mpr cmp1, cmp2;
+
+    mpr_init(&cmp1);
+    mpi_set(mpr_num(&cmp1), bignum);
+    mpi_seti(mpr_den(&cmp1), 1);
+
+    mpr_init(&cmp2);
+    mpr_seti(&cmp2, num, den);
+
+    cmp = mpr_cmp(&cmp1, &cmp2);
+    mpr_clear(&cmp1);
+    mpr_clear(&cmp2);
+
+    return (cmp);
+}
+
+
+/************************************************************************
+ * BIGNUM BIGRATIO
+ ************************************************************************/
+static void
+rop_bi_br_as_xr(n_real *real, mpr *bigratio, int nop)
+{
+    mpi iop;
+    mpr *bigr = XALLOC(mpr);
+
+    mpi_init(&iop);
+    mpi_set(&iop, RBI(real));
+    mpr_init(bigr);
+    mpr_set(bigr, bigratio);
+
+    mpi_mul(&iop, &iop, mpr_den(bigratio));
+
+    if (nop == NOP_ADD)
+	mpi_add(mpr_num(bigr), &iop, mpr_num(bigr));
+    else
+	mpi_sub(mpr_num(bigr), &iop, mpr_num(bigr));
+    mpi_clear(&iop);
+
+    RCLEAR_BI(real);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real);
+}
+
+static void
+rop_bi_br_md_xr(n_real *real, mpr *bigratio, int nop)
+{
+    mpr *bigr = XALLOC(mpr);
+
+    mpr_init(bigr);
+    if (nop == NOP_MUL)
+	mpr_set(bigr, bigratio);
+    else
+	mpr_inv(bigr, bigratio);
+
+    mpi_mul(mpr_num(bigr), RBI(real), mpr_num(bigr));
+
+    RCLEAR_BI(real);
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+radd_bi_br(n_real *real, mpr *bigratio)
+{
+    rop_bi_br_as_xr(real, bigratio, NOP_ADD);
+}
+
+static INLINE void
+rsub_bi_br(n_real *real, mpr *bigratio)
+{
+    rop_bi_br_as_xr(real, bigratio, NOP_SUB);
+}
+
+static INLINE void
+rmul_bi_br(n_real *real, mpr *bigratio)
+{
+    rop_bi_br_md_xr(real, bigratio, NOP_MUL);
+}
+
+static INLINE void
+rdiv_bi_br(n_real *real, mpr *bigratio)
+{
+    rop_bi_br_md_xr(real, bigratio, NOP_DIV);
+}
+
+static int
+cmp_bi_br(mpi *bignum, mpr *bigratio)
+{
+    int cmp;
+    mpr cmp1;
+
+    mpr_init(&cmp1);
+    mpi_set(mpr_num(&cmp1), bignum);
+    mpi_seti(mpr_den(&cmp1), 1);
+
+    cmp = mpr_cmp(&cmp1, bigratio);
+    mpr_clear(&cmp1);
+
+    return (cmp);
+}
+
+
+/************************************************************************
+ * FIXRATIO FIXNUM
+ ************************************************************************/
+static void
+rop_fr_fi_as_xr(n_real *real, long op, int nop)
+{
+    int fit;
+    long value = 0, num = RFRN(real), den = RFRD(real);
+
+    fit = !fi_fi_mul_overflow(op, den);
+
+    if (fit) {
+	value = op * den;
+	if (nop == NOP_ADD)
+	    fit = !fi_fi_add_overflow(value, num);
+	else
+	    fit = !fi_fi_sub_overflow(value, num);
+    }
+    if (fit) {
+	if (nop == NOP_ADD)
+	    RFRN(real) = num + value;
+	else
+	    RFRN(real) = num - value;
+	rfr_canonicalize(real);
+    }
+    else {
+	mpi iop;
+	mpr *bigr = XALLOC(mpr);
+
+	mpr_init(bigr);
+	mpr_seti(bigr, num, den);
+	mpi_init(&iop);
+	mpi_seti(&iop, op);
+	mpi_muli(&iop, &iop, den);
+	if (nop == NOP_ADD)
+	    mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
+	else
+	    mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
+	mpi_clear(&iop);
+	RBR(real) = bigr;
+	RTYPE(real) = N_BIGRATIO;
+	rbr_canonicalize(real);
+    }
+}
+
+static void
+rop_fr_fi_md_xr(n_real *real, long op, int nop)
+{
+    long num = RFRN(real), den = RFRD(real);
+
+    if (nop == NOP_MUL) {
+	if (!fi_fi_mul_overflow(op, num)) {
+	    RFRN(real) = op * num;
+	    rfr_canonicalize(real);
+	    return;
+	}
+    }
+    else if (!fi_fi_mul_overflow(op, den)) {
+	RFRD(real) = op * den;
+	rfr_canonicalize(real);
+	return;
+    }
+
+    {
+	mpr *bigr = XALLOC(mpr);
+
+	mpr_init(bigr);
+	mpr_seti(bigr, num, den);
+	if (nop == NOP_MUL)
+	    mpr_muli(bigr, bigr, op);
+	else
+	    mpr_divi(bigr, bigr, op);
+	RBR(real) = bigr;
+	RTYPE(real) = N_BIGRATIO;
+	rbr_canonicalize(real);
+    }
+}
+
+static INLINE void
+radd_fr_fi(n_real *real, long op)
+{
+    rop_fr_fi_as_xr(real, op, NOP_ADD);
+}
+
+static INLINE void
+rsub_fr_fi(n_real *real, long op)
+{
+    rop_fr_fi_as_xr(real, op, NOP_SUB);
+}
+
+static INLINE void
+rmul_fr_fi(n_real *real, long op)
+{
+    rop_fr_fi_md_xr(real, op, NOP_MUL);
+}
+
+static INLINE void
+rdiv_fr_fi(n_real *real, long op)
+{
+    rop_fr_fi_md_xr(real, op, NOP_DIV);
+}
+
+static INLINE int
+cmp_fr_fi(long num, long den, long fixnum)
+{
+    return (cmp_flonum((double)num / (double)den, (double)fixnum));
+}
+
+
+/************************************************************************
+ * FIXRATIO BIGNUM
+ ************************************************************************/
+static void
+rop_fr_bi_as_xr(n_real *real, mpi *bignum, int nop)
+{
+    mpi iop;
+    mpr *bigr = XALLOC(mpr);
+
+    mpr_init(bigr);
+    mpr_seti(bigr, RFRN(real), RFRD(real));
+
+    mpi_init(&iop);
+    mpi_set(&iop, bignum);
+    mpi_muli(&iop, &iop, RFRD(real));
+
+    if (nop == NOP_ADD)
+	mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
+    else
+	mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
+    mpi_clear(&iop);
+
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real); 
+}
+
+static void
+rop_fr_bi_md_xr(n_real *real, mpi *bignum, int nop)
+{
+    mpr *bigr = XALLOC(mpr);
+
+    mpr_init(bigr);
+    mpr_seti(bigr, RFRN(real), RFRD(real));
+
+    if (nop == NOP_MUL)
+	mpi_mul(mpr_num(bigr), mpr_num(bigr), bignum);
+    else
+	mpi_mul(mpr_den(bigr), mpr_den(bigr), bignum);
+
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+radd_fr_bi(n_real *real, mpi *bignum)
+{
+    rop_fr_bi_as_xr(real, bignum, NOP_ADD);
+}
+
+static INLINE void
+rsub_fr_bi(n_real *real, mpi *bignum)
+{
+    rop_fr_bi_as_xr(real, bignum, NOP_SUB);
+}
+
+static INLINE void
+rmul_fr_bi(n_real *real, mpi *bignum)
+{
+    rop_fr_bi_md_xr(real, bignum, NOP_MUL);
+}
+
+static INLINE void
+rdiv_fr_bi(n_real *real, mpi *bignum)
+{
+    rop_fr_bi_md_xr(real, bignum, NOP_DIV);
+}
+
+static int
+cmp_fr_bi(long num, long den, mpi *bignum)
+{
+    int cmp;
+    mpr cmp1, cmp2;
+
+    mpr_init(&cmp1);
+    mpr_seti(&cmp1, num, den);
+
+    mpr_init(&cmp2);
+    mpi_set(mpr_num(&cmp2), bignum);
+    mpi_seti(mpr_den(&cmp2), 1);
+
+    cmp = mpr_cmp(&cmp1, &cmp2);
+    mpr_clear(&cmp1);
+    mpr_clear(&cmp2);
+
+    return (cmp);
+}
+
+
+/************************************************************************
+ * FIXRATIO FIXRATIO
+ ************************************************************************/
+static void
+rop_fr_fr_as_xr(n_real *real, long num2, long den2, int nop)
+{
+    int fit;
+    long num1 = RFRN(real), den1 = RFRD(real), num = 0, den = 0;
+
+    fit = !fi_fi_mul_overflow(num1, den2);
+    if (fit) {
+	num = num1 * den2;
+	fit = !fi_fi_mul_overflow(num2, den1);
+	if (fit) {
+	    den = num2 * den1;
+	    if (nop == NOP_ADD) {
+		if ((fit = !fi_fi_add_overflow(num, den)) != 0)
+		    num += den;
+	    }
+	    else if ((fit = !fi_fi_sub_overflow(num, den)) != 0)
+		num -= den;
+	    if (fit) {
+		fit = !fi_fi_mul_overflow(den1, den2);
+		if (fit)
+		    den = den1 * den2;
+	    }
+	}
+    }
+    if (fit) {
+	RFRN(real) = num;
+	RFRD(real) = den;
+	rfr_canonicalize(real);
+    }
+    else {
+	mpi iop;
+	mpr *bigr = XALLOC(mpr);
+
+	mpr_init(bigr);
+	mpr_seti(bigr, num1, den1);
+	mpi_muli(mpr_den(bigr), mpr_den(bigr), den2);
+	mpi_init(&iop);
+	mpi_seti(&iop, num2);
+	mpi_muli(&iop, &iop, den1);
+	mpi_muli(mpr_num(bigr), mpr_num(bigr), den2);
+	if (nop == NOP_ADD)
+	    mpi_add(mpr_num(bigr), mpr_num(bigr), &iop);
+	else
+	    mpi_sub(mpr_num(bigr), mpr_num(bigr), &iop);
+	mpi_clear(&iop);
+	RBR(real) = bigr;
+	RTYPE(real) = N_BIGRATIO;
+	rbr_canonicalize(real);
+    }
+}
+
+static void
+rop_fr_fr_md_xr(n_real *real, long num2, long den2, int nop)
+{
+    int fit;
+    long num1 = RFRN(real), den1 = RFRD(real), num = 0, den = 0;
+
+    if (nop == NOP_MUL) {
+	fit = !fi_fi_mul_overflow(num1, num2) && !fi_fi_mul_overflow(den1, den2);
+	if (fit) {
+	    num = num1 * num2;
+	    den = den1 * den2;
+	}
+    }
+    else {
+	fit = !fi_fi_mul_overflow(num1, den2) && !fi_fi_mul_overflow(den1, num2);
+	if (fit) {
+	    num = num1 * den2;
+	    den = den1 * num2;
+	}
+    }
+
+    if (fit) {
+	RFRN(real) = num;
+	RFRD(real) = den;
+	rfr_canonicalize(real);
+    }
+    else {
+	mpr *bigr = XALLOC(mpr);
+
+	mpr_init(bigr);
+
+	if (nop == NOP_MUL) {
+	    mpr_seti(bigr, num1, den1);
+	    mpi_muli(mpr_num(bigr), mpr_num(bigr), num2);
+	    mpi_muli(mpr_den(bigr), mpr_den(bigr), den2);
+	}
+	else {
+	    mpr_seti(bigr, num1, num2);
+	    mpi_muli(mpr_num(bigr), mpr_num(bigr), den2);
+	    mpi_muli(mpr_den(bigr), mpr_den(bigr), den1);
+	}
+
+	RBR(real) = bigr;
+	RTYPE(real) = N_BIGRATIO;
+	rbr_canonicalize(real);
+    }
+}
+
+static INLINE void
+radd_fr_fr(n_real *real, long num, long den)
+{
+    rop_fr_fr_as_xr(real, num, den, NOP_ADD);
+}
+
+static INLINE void
+rsub_fr_fr(n_real *real, long num, long den)
+{
+    rop_fr_fr_as_xr(real, num, den, NOP_SUB);
+}
+
+static INLINE void
+rmul_fr_fr(n_real *real, long num, long den)
+{
+    rop_fr_fr_md_xr(real, num, den, NOP_MUL);
+}
+
+static INLINE void
+rdiv_fr_fr(n_real *real, long num, long den)
+{
+    rop_fr_fr_md_xr(real, num, den, NOP_DIV);
+}
+
+static INLINE int
+cmp_fr_fr(long num1, long den1, long num2, long den2)
+{
+    return (cmp_flonum((double)num1 / (double)den1,
+		       (double)num2 / (double)den2));
+}
+
+
+/************************************************************************
+ * FIXRATIO BIGRATIO
+ ************************************************************************/
+static void
+rop_fr_br_asmd_xr(n_real *real, mpr *bigratio, int nop)
+{
+    mpr *bigr = XALLOC(mpr);
+
+    mpr_init(bigr);
+    mpr_seti(bigr, RFRN(real), RFRD(real));
+
+    switch (nop) {
+	case NOP_ADD:
+	    mpr_add(bigr, bigr, bigratio);
+	    break;
+	case NOP_SUB:
+	    mpr_sub(bigr, bigr, bigratio);
+	    break;
+	case NOP_MUL:
+	    mpr_mul(bigr, bigr, bigratio);
+	    break;
+	default:
+	    mpr_div(bigr, bigr, bigratio);
+	    break;
+    }
+
+    RBR(real) = bigr;
+    RTYPE(real) = N_BIGRATIO;
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+radd_fr_br(n_real *real, mpr *bigratio)
+{
+    rop_fr_br_asmd_xr(real, bigratio, NOP_ADD);
+}
+
+static INLINE void
+rsub_fr_br(n_real *real, mpr *bigratio)
+{
+    rop_fr_br_asmd_xr(real, bigratio, NOP_SUB);
+}
+
+static INLINE void
+rmul_fr_br(n_real *real, mpr *bigratio)
+{
+    rop_fr_br_asmd_xr(real, bigratio, NOP_MUL);
+}
+
+static INLINE void
+rdiv_fr_br(n_real *real, mpr *bigratio)
+{
+    rop_fr_br_asmd_xr(real, bigratio, NOP_DIV);
+}
+
+static int
+cmp_fr_br(long num, long den, mpr *bigratio)
+{
+    int cmp;
+    mpr cmp1;
+
+    mpr_init(&cmp1);
+    mpr_seti(&cmp1, num, den);
+
+    cmp = mpr_cmp(&cmp1, bigratio);
+    mpr_clear(&cmp1);
+
+    return (cmp);
+}
+
+
+/************************************************************************
+ * BIGRATIO FIXNUM
+ ************************************************************************/
+static void
+rop_br_fi_asmd_xr(n_real *real, long fixnum, int nop)
+{
+    mpr *bigratio = RBR(real);
+
+    switch (nop) {
+	case NOP_ADD:
+	    mpr_addi(bigratio, bigratio, fixnum);
+	    break;
+	case NOP_SUB:
+	    mpr_subi(bigratio, bigratio, fixnum);
+	    break;
+	case NOP_MUL:
+	    mpr_muli(bigratio, bigratio, fixnum);
+	    break;
+	default:
+	    if (fixnum == 0)
+		fatal_error(DIVIDE_BY_ZERO);
+	    mpr_divi(bigratio, bigratio, fixnum);
+	    break;
+    }
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+radd_br_fi(n_real *real, long fixnum)
+{
+    rop_br_fi_asmd_xr(real, fixnum, NOP_ADD);
+}
+
+static INLINE void
+rsub_br_fi(n_real *real, long fixnum)
+{
+    rop_br_fi_asmd_xr(real, fixnum, NOP_SUB);
+}
+
+static INLINE void
+rmul_br_fi(n_real *real, long fixnum)
+{
+    rop_br_fi_asmd_xr(real, fixnum, NOP_MUL);
+}
+
+static INLINE void
+rdiv_br_fi(n_real *real, long fixnum)
+{
+    rop_br_fi_asmd_xr(real, fixnum, NOP_DIV);
+}
+
+static int
+cmp_br_fi(mpr *bigratio, long fixnum)
+{
+    int cmp;
+    mpr cmp2;
+
+    mpr_init(&cmp2);
+    mpr_seti(&cmp2, fixnum, 1);
+    cmp = mpr_cmp(bigratio, &cmp2);
+    mpr_clear(&cmp2);
+
+    return (cmp);
+}
+
+
+/************************************************************************
+ * BIGRATIO BIGNUM
+ ************************************************************************/
+static void
+rop_br_bi_as_xr(n_real *real, mpi *bignum, int nop)
+{
+    mpi iop;
+
+    mpi_init(&iop);
+    mpi_set(&iop, bignum);
+
+    mpi_mul(&iop, &iop, RBRD(real));
+    if (nop == NOP_ADD)
+	mpi_add(RBRN(real), RBRN(real), &iop);
+    else
+	mpi_sub(RBRN(real), RBRN(real), &iop);
+    mpi_clear(&iop);
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+radd_br_bi(n_real *real, mpi *bignum)
+{
+    rop_br_bi_as_xr(real, bignum, NOP_ADD);
+}
+
+static INLINE void
+rsub_br_bi(n_real *real, mpi *bignum)
+{
+    rop_br_bi_as_xr(real, bignum, NOP_SUB);
+}
+
+static INLINE void
+rmul_br_bi(n_real *real, mpi *bignum)
+{
+    mpi_mul(RBRN(real), RBRN(real), bignum);
+    rbr_canonicalize(real);
+}
+
+static INLINE void
+rdiv_br_bi(n_real *real, mpi *bignum)
+{
+    mpi_mul(RBRD(real), RBRD(real), bignum);
+    rbr_canonicalize(real);
+}
+
+static int
+cmp_br_bi(mpr *bigratio, mpi *bignum)
+{
+    int cmp;
+    mpr cmp1;
+
+    mpr_init(&cmp1);
+    mpi_set(mpr_num(&cmp1), bignum);
+    mpi_seti(mpr_den(&cmp1), 1);
+
+    cmp = mpr_cmp(bigratio, &cmp1);
+    mpr_clear(&cmp1);
+
+    return (cmp);
+}
+
+
+/************************************************************************
+ * BIGRATIO FIXRATIO
+ ************************************************************************/
+static void
+rop_br_fr_asmd_xr(n_real *real, long num, long den, int nop)
+{
+    mpr *bigratio = RBR(real), rop;
+
+    mpr_init(&rop);
+    mpr_seti(&rop, num, den);
+    switch (nop) {
+	case NOP_ADD:
+	    mpr_add(bigratio, bigratio, &rop);
+	    break;
+	case NOP_SUB:
+	    mpr_sub(bigratio, bigratio, &rop);
+	    break;
+	case NOP_MUL:
+	    mpr_mul(bigratio, bigratio, &rop);
+	    break;
+	default:
+	    mpr_div(bigratio, bigratio, &rop);
+	    break;
+    }
+    mpr_clear(&rop);
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+radd_br_fr(n_real *real, long num, long den)
+{
+    rop_br_fr_asmd_xr(real, num, den, NOP_ADD);
+}
+
+static INLINE void
+rsub_br_fr(n_real *real, long num, long den)
+{
+    rop_br_fr_asmd_xr(real, num, den, NOP_SUB);
+}
+
+static INLINE void
+rmul_br_fr(n_real *real, long num, long den)
+{
+    rop_br_fr_asmd_xr(real, num, den, NOP_MUL);
+}
+
+static INLINE void
+rdiv_br_fr(n_real *real, long num, long den)
+{
+    rop_br_fr_asmd_xr(real, num, den, NOP_DIV);
+}
+
+static int
+cmp_br_fr(mpr *bigratio, long num, long den)
+{
+    int cmp;
+    mpr cmp2;
+
+    mpr_init(&cmp2);
+    mpr_seti(&cmp2, num, den);
+    cmp = mpr_cmp(bigratio, &cmp2);
+    mpr_clear(&cmp2);
+
+    return (cmp);
+}
+
+
+/************************************************************************
+ * BIGRATIO BIGRATIO
+ ************************************************************************/
+static INLINE void
+radd_br_br(n_real *real, mpr *bigratio)
+{
+    mpr_add(RBR(real), RBR(real), bigratio);
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+rsub_br_br(n_real *real, mpr *bigratio)
+{
+    mpr_sub(RBR(real), RBR(real), bigratio);
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+rmul_br_br(n_real *real, mpr *bigratio)
+{
+    mpr_mul(RBR(real), RBR(real), bigratio);
+    rbr_canonicalize(real); 
+}
+
+static INLINE void
+rdiv_br_br(n_real *real, mpr *bigratio)
+{
+    mpr_div(RBR(real), RBR(real), bigratio);
+    rbr_canonicalize(real); 
+}
+
+static INLINE int
+cmp_br_br(mpr *op1, mpr *op2)
+{
+    return (mpr_cmp(op1, op2));
+}
diff --git a/lisp/modules/indent.lsp b/lisp/modules/indent.lsp
new file mode 100644
index 0000000..4a7f7aa
--- /dev/null
+++ b/lisp/modules/indent.lsp
@@ -0,0 +1,1420 @@
+;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/indent.lsp,v 1.7 2003/01/29 03:05:53 paulo Exp $
+;;
+
+(provide "indent")
+(require "xedit")
+(in-package "XEDIT")
+
+(defconstant indent-spaces '(#\Tab #\Space))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The final indentation function.
+;; Parameters:
+;;	indent
+;;		Number of spaces to insert
+;;	offset
+;;		Offset to where indentation should be added
+;;	no-tabs
+;;		If set, tabs aren't inserted
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indent-text (indent offset &optional no-tabs
+		    &aux start line length index current tabs spaces string
+			 barrier base result (point (point))
+		   )
+
+    ;; Initialize
+    (setq
+	start	(scan offset :eol :left)
+	line	(read-text start (- offset start))
+	length	(length line)
+	index	(1- length)
+	current	0
+	base	0
+    )
+
+    (and (minusp indent) (setq indent 0))
+
+    ;; Skip any spaces after offset, "paranoia check"
+    (while (member (char-after offset) indent-spaces)
+	(incf offset)
+    )
+
+    ;; Check if there are only spaces before `offset' and the line `start'
+    (while (and (>= index 0) (member (char line index) indent-spaces))
+	(decf index)
+    )
+
+    ;; `index' will be zero if there are only spaces in the `line'
+    (setq barrier (+ start (incf index)))
+
+    ;; Calculate `base' unmodifiable indentation, if any
+    (dotimes (i index)
+	(if (char= (char line i) #\Tab)
+	    (incf base (- 8 (rem base 8)))
+	    (incf base)
+	)
+    )
+
+    ;; If any non blank character would need to be deleted
+    (and (> base indent) (return-from indent-text nil))
+
+    ;; Calculate `current' indentation
+    (setq current base)
+    (while (< index length)
+	(if (char= (char line index) #\Tab)
+	    (incf current (- 8 (rem current 8)))
+	    (incf current)
+	)
+	(incf index)
+    )
+
+    ;; Maybe could also "optimize" the indentation even if it is already
+    ;; correct, removing spaces "inside" tabs.
+    (when (/= indent current)
+	(if no-tabs
+	    (setq
+		length	(- indent base)
+		result	(+ barrier length)
+		string	(make-string length :initial-element #\Space)
+	    )
+	    (progn
+		(multiple-value-setq (tabs spaces) (floor (- indent base) 8))
+		(setq
+		    length	(+ tabs spaces)
+		    result	(+ barrier length)
+		    string	(make-string length :initial-element #\Tab)
+		)
+		(fill string #\Space :start tabs)
+	    )
+	)
+
+	(replace-text barrier offset string)
+	(and (>= offset point) (>= point barrier) (goto-char result))
+    )
+)
+(compile 'indent-text)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helper function, returns indentation of a given offset
+;; If `align' is set, stop once a non blank character is seen, that
+;; is, use `offset' only as a line identifier
+;; If `resolve' is set, it means that the offset is just a hint, it
+;; maybe anywhere in the line
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun offset-indentation (offset &key resolve align
+			   &aux
+			   char
+			   line
+			   (start (scan offset :eol :left))
+			   (indent 0))
+    (if resolve
+	(loop
+	    (if (characterp (setq char (char-after start)))
+		(if (char= char #\Tab)
+		    (incf indent (- 8 (rem indent 8)))
+		    ;; Not a tab, check if is a space
+		    (if (char= char #\Space)
+			(incf indent)
+			;; Not a tab neither a space
+			(return indent)
+		    )
+		)
+		;; EOF found
+		(return indent)
+	    )
+	    ;; Increment offset to check next character
+	    (incf start)
+	)
+	(progn
+	    (setq line (read-text start (- offset start)))
+	    (dotimes (i (length line) indent)
+		(if (char= (setq char (char line i)) #\Tab)
+		    (incf indent (- 8 (rem indent 8)))
+		    (progn
+			(or align (member char indent-spaces)
+			    (return indent)
+			)
+			(incf indent)
+		    )
+		)
+	    )
+	)
+    )
+)
+(compile 'offset-indentation)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  A default/fallback indentation function, just copy indentation
+;; of previous line.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun default-indent (syntax syntable)
+    (let
+	(
+	(offset (scan (point) :eol :left))
+	start
+	left
+	right
+	)
+
+	syntable	;; XXX hack to not generate warning about unused
+			;; variable, should be temporary (until unused
+			;; variables can be declared as such)
+
+	(if
+	    (or
+		;; if indentation is disabled
+		(and
+		    (hash-table-p (syntax-options syntax))
+		    (gethash :disable-indent (syntax-options syntax))
+		)
+		;; or if not at the start of a new line
+		(> (scan offset :eol :right) offset)
+	    )
+	    (return-from default-indent)
+	)
+
+	(setq left offset)
+	(loop
+	    (setq
+		start left
+		left (scan start :eol :left :count 2)
+		right (scan left :eol :right)
+	    )
+	    ;; if start of file reached
+	    (and (>= left start) (return))
+	    (when
+		(setq
+		    start
+		    (position-if-not
+			#'(lambda (char) (member char indent-spaces))
+			(read-text left (- right left))
+		    )
+		)
+
+		;; indent the current line
+		(indent-text (offset-indentation (+ left start) :align t) offset)
+		(return)
+	    )
+	)
+    )
+)
+(compile 'default-indent)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helper function
+;;   Clear line before cursor if it is empty
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indent-clear-empty-line (&aux left offset right line index)
+    (setq
+	offset	(scan (point) :eol :left)
+	left	(scan offset :eol :left :count 2)
+	right	(scan left :eol :right)
+    )
+
+    ;; If not at the first line in the file and line is not already empty
+    (when (and (/= offset left) (/= left right))
+	(setq
+	    line	(read-text left (- right left))
+	    index	(1- (length line))
+	)
+	(while (and (>= index 0) (member (char line index) indent-spaces))
+	    (decf index)
+	)
+	;; If line was only spaces
+	(and (minusp index) (replace-text left right ""))
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Macro to be called whenever an indentation rule decides that
+;; the parser is done.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indent-macro-terminate (&optional result)
+    `(return-from ind-terminate-block ,result)
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Like indent-terminate, but "rejects" the input for the current line
+;; and terminates the loop.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indent-macro-reject (&optional result)
+   `(progn
+	(setq ind-state ind-prev-state)
+	(return-from ind-terminate-block ,result)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Like indent-reject, but "rejects" anything before the current token
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indent-macro-reject-left (&optional result)
+   `(progn
+	(setq ind-state ind-matches)
+	(return-from ind-terminate-block ,result)
+    )
+)
+
+
+(defstruct indtoken
+    regex			;; a string, character or regex
+    token			;; the resulting token, nil or a keyword
+    begin			;; begin a new table
+    switch			;; switch to another table
+    ;; begin and switch fields are used like the ones for the syntax highlight
+    ;; syntoken structure.
+    label			;; filed at compile time
+    code			;; code to execute when it matches
+)
+
+(defstruct indtable
+    label			;; a keyword, name of the table
+    tokens			;; list of indtoken structures
+    tables			;; list of indtable structures
+    augments			;; augment list
+)
+
+(defstruct indaugment
+    labels			;; list of keywords labeling tables
+)
+
+(defstruct indinit
+    variables			;; list of variables and optional initialization
+    ;; Format of variables must be suitable to LET*, example of call:
+    ;;	(indinit
+    ;;	    var1		;; initialized to NIL
+    ;;	    (var2 (afun))	;; initialized to the value returned by AFUN
+    ;;	)
+)
+
+(defstruct indreduce
+    token			;; reduced token
+    rules			;; list of rules
+    label			;; unique label associated with rule, this
+				;; field is automatically filled in the
+				;; compilation process. this field exists
+				;; to allow several indreduce definitions
+				;; that result in the same token
+    check			;; FORM evaluated, if T apply reduce rule
+    code			;; PROGN to be called when a rule matches
+)
+
+;; NOTE, unlike "reduce" rules, "resolve" rules cannot be duplicated
+(defstruct indresolve
+    match			;; the matched token (or a list of tokens)
+    code			;; PROGN to apply for this token
+)
+
+(defstruct indent
+    reduces			;; list of indreduce structures
+    tables			;; list of indtable structures
+    inits			;; initialization list
+    resolves			;; list of indresolve structures
+    token-code			;; code to execute when a token matches
+    check-code			;; code to execute before applying a reduce rule
+    reduce-code			;; code to execute after reduce rule
+    resolve-code		;; code to execute when matching a token
+)
+
+(defmacro defindent (variable label &rest lists)
+   `(if (boundp ',variable)
+	,variable
+	(progn
+	    (proclaim '(special ,variable))
+	    (setq ,variable (compile-indent-table ,label ,@lists))
+	)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create an indent token.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indtoken (pattern token
+		    &key icase nospec begin switch code (nosub t))
+    (setq pattern (re-comp (eval pattern) :icase icase :nospec nospec :nosub nosub))
+    (when (consp (re-exec pattern "" :notbol t :noteol t))
+	(error "INDTOKEN: regex ~A matches empty string" pattern)
+    )
+
+    ;; result of macro, return token structure
+    (make-indtoken
+	:regex	pattern
+	:token	token
+	:begin	begin
+	:switch	switch
+	:code	code
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create an indentation table. Basically a list of indentation tokens.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indtable (label &rest definitions)
+    ;; check for simple errors
+    (unless (keywordp label)
+	(error "INDTABLE: ~A is not a keyword" label)
+    )
+    (dolist (item definitions)
+	(unless
+	    (or
+		(atom item)
+		(indtoken-p item)
+		(indtable-p item)
+		(indaugment-p item)
+	    )
+	    (error "INDTABLE: invalid indent table argument ~A" item)
+	)
+    )
+
+    ;; return indent table structure
+    (make-indtable
+	:label		label
+	:tokens		(remove-if-not #'indtoken-p definitions)
+	:tables		(remove-if-not #'indtable-p definitions)
+	:augments	(remove-if-not #'indaugment-p definitions)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Add identifier to list of augment tables.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indaugment (&rest keywords)
+    (dolist (keyword keywords)
+	(unless (keywordp keyword)
+	    (error "INDAUGMENT: bad indent table label ~A" keyword)
+	)
+    )
+
+    ;; return augment list structure
+    (make-indaugment :labels keywords)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Add variables to initialization list
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indinit (&rest variables)
+    (make-indinit :variables variables)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create a "reduction rule"
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indreduce (token check rules &rest code &aux nullp consp)
+    ;; check for simple errors
+    (unless (or (keywordp token) (null token))
+	(error "INDREDUCE: ~A is not a keyword" token)
+    )
+    (dolist (rule rules)
+	(or (listp rule) (error "INDREDUCE: invalid indent rule ~A" rule))
+	;; XXX This test is not enough, maybe should add some sort of
+	;; runtime check to avoid circularity.
+	(and (eq token (car rule)) (null (cdr rule))
+	    (error "INDREDUCE: ~A reduces to ~A" token)
+	)
+	(dolist (item rule)
+	    (and (or nullp consp) (not (keywordp item))
+		(error "INDREDUCE: a keyword must special pattern")
+	    )
+	    (if (consp item)
+		(progn
+		    (unless
+			(or
+			    (and
+				(eq (car item) 'not)
+				(keywordp (cadr item))
+				(null (cddr item))
+			    )
+			    (and
+				(eq (car item) 'or)
+				(null (member-if-not #'keywordp (cdr item)))
+			    )
+			)
+			(error "INDREDUCE: syntax error parsing ~A" item)
+		    )
+		    (setq consp t)
+		)
+		(progn
+		    (setq nullp (null item) consp nil)
+		    (unless (or (keywordp item) nullp (eq item t))
+			(error "INDREDUCE: ~A is not a keyword" item)
+		    )
+		)
+	    )
+	)
+;	(and consp
+;	    (error "INDREDUCE: pattern must be followed by keyword")
+;	)
+    )
+
+    ;; result of macro, return indent reduce structure
+    (make-indreduce
+	:token	token
+	:check	check
+	:rules	(remove-if #'null rules)
+	:code	code
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create a "resolve rule"
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indresolve (match &rest code)
+    ;; check for simple errors
+    (if (consp match)
+	(dolist (token match)
+	    (or (keywordp token) (error "INDRESOLVE: ~A is not a keyword" token))
+	)
+	(or (keywordp match) (error "INDRESOLVE: ~A is not a keyword" match))
+    )
+
+    ;; result of macro, return indent resolve structure
+    (make-indresolve
+	:match	match
+	:code	code
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helper function for compile-indent-table. Returns a list of all
+;; tables and tokens for a given table, including tokens and tables
+;; of children.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun list-indtable-elements (table &aux result sub-result)
+    (setq result (cons (indtable-tokens table) (indtable-tables table)))
+    (dolist (child (indtable-tables table))
+	(setq sub-result (list-indtable-elements child))
+	(rplaca result (append (car result) (car sub-result)))
+	(rplacd result (append (cdr result) (cdr sub-result)))
+    )
+    ;; Return pair of all nested tokens and tables
+    result
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; First pass adding augumented tokens to a table, done in two passes
+;; to respect inheritance order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-indent-augment-list (table table-list &aux labels augment tokens)
+
+    ;; Create a list of all augment tables.
+    (dolist (augment (indtable-augments table))
+	(setq labels (append labels (indaugment-labels augment)))
+    )
+
+    ;;  Remove duplicates and references to "itself", without warnings?
+    (setq
+	labels
+	(remove (indtable-label table) (remove-duplicates labels :from-end t))
+    )
+
+    ;; Check if the specified indent tables exists!
+    (dolist (label labels)
+	(unless
+	    (setq augment (car (member label table-list :key #'indtable-label)))
+	    (error "COMPILE-INDENT-AUGMENT-LIST: Cannot augment ~A in ~A"
+		label
+		(indtable-label table)
+	    )
+	)
+
+	;; Increase list of tokens.
+	(setq tokens (append tokens (indtable-tokens augment)))
+    )
+
+    ;;  Store the tokens in the augment list. They will be added
+    ;; to the indent table in the second pass.
+    (setf (indtable-augments table) tokens)
+
+    ;;  Recurse on every child table.
+    (dolist (child (indtable-tables table))
+	(compile-indent-augment-list child table-list)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Last pass adding augmented tokens to a table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun link-indent-augment-list (table)
+    (setf
+	(indtable-tokens table)
+	(remove-duplicates
+	    (nconc (indtable-tokens table) (indtable-augments table))
+	    :key	#'indtoken-regex
+	    :test	#'equal
+	    :from-end	t
+	)
+
+	;;  Don't need to keep this list anymore.
+	(indtable-augments table)
+	()
+    )
+
+    (dolist (child (indtable-tables table))
+	(link-indent-augment-list child)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Compile the indent reduction rules
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-indent-reduces (reduces
+			       &aux need label check rules reduce
+				    check-code reduce-code)
+    (dolist (item reduces)
+	(setq
+	    label	(indreduce-label item)
+	    check	(indreduce-check item)
+	    rules	(indreduce-rules item)
+	    reduce	(indreduce-code  item)
+	    need	(and
+			    rules
+			    (not label)
+			    (or
+				reduce
+				(null check)
+				(not (constantp check))
+			    )
+			)
+	)
+	(when need
+	    (and (null label) (setq label (intern (string (gensym)) 'keyword)))
+
+	    (setf (indreduce-label item) label)
+
+	    (and
+		(or (null check)
+		    (not (constantp check))
+		)
+		(setq
+		    check	(list (list 'eq '*ind-label* label) check)
+		    check-code	(nconc check-code (list check))
+		)
+	    )
+
+	    (and reduce
+		(setq
+		    reduce	(cons (list 'eq '*ind-label* label) reduce)
+		    reduce-code	(nconc reduce-code (list reduce))
+		)
+	    )
+	)
+    )
+
+    ;; XXX Instead of using COND, could/should use CASE
+    ;; TODO Implement a smart CASE in the bytecode compiler, if
+    ;;	    possible, should generate a hashtable, or a table
+    ;;	    of indexes (for example when all elements in the cases
+    ;;	    are characters) and then jump directly to the code.
+    (if check-code
+	(setq check-code (cons 'cond (nconc check-code '((t t)))))
+	(setq check-code t)
+    )
+    (and reduce-code (setq reduce-code (cons 'cond reduce-code)))
+
+    (values check-code reduce-code)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Compile the indent resolve code
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-indent-resolves (resolves &aux match resolve resolve-code)
+    (and
+	(/=
+	    (length resolves)
+	    (length (remove-duplicates resolves :key #'indresolve-match))
+	)
+	;; XXX Could do a more complete job and tell what is wrong...
+	(error "COMPILE-INDENT-RESOLVES: duplicated labels")
+    )
+
+    (dolist (item resolves)
+	(when (setq resolve (indresolve-code item))
+	    (setq
+		match
+		(indresolve-match item)
+
+		resolve
+		(cons
+		    (if (listp match)
+			(list 'member '*ind-token* `',match :test `#'eq)
+			(list 'eq '*ind-token* match)
+		    )
+		    resolve
+		)
+
+		resolve-code
+		(nconc resolve-code (list resolve))
+	    )
+	)
+    )
+
+    (and resolve-code (cons 'cond resolve-code))
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create an indentation table
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-indent-table (name &rest lists
+			     &aux main elements switches begins tables symbols
+				  label code token-code check-code reduce-code
+				  (inits (remove-if-not #'indinit-p lists))
+				  (reduces (remove-if-not #'indreduce-p lists))
+				  (resolves (remove-if-not #'indresolve-p lists))
+			    )
+    (setq
+	lists	 (delete-if
+		    #'(lambda (object)
+			(or
+			    (indinit-p object)
+			    (indreduce-p object)
+			    (indresolve-p object)
+			)
+		    )
+		    lists)
+	main	 (apply #'indtable name lists)
+	elements (list-indtable-elements main)
+	switches (remove-if #'null (car elements) :key #'indtoken-switch)
+	begins   (remove-if #'null (car elements) :key #'indtoken-begin)
+	tables	 (cons main (cdr elements))
+    )
+
+    ;; Check for typos in the keywords, or for not defined indent tables.
+    (dolist (item (mapcar #'indtoken-switch switches))
+	(unless
+	    (or	(and (integerp item) (minusp item))
+		(member item tables :key #'indtable-label)
+	    )
+	    (error "COMPILE-INDENT-TABLE: SWITCH ~A cannot be matched" item)
+	)
+    )
+    (dolist (item (mapcar #'indtoken-begin begins))
+	(unless (member item tables :key #'indtable-label)
+	    (error "COMPILE-INDENT-TABLE: BEGIN ~A cannot be matched" item)
+	)
+    )
+
+    ;; Build augment list.
+    (compile-indent-augment-list main tables)
+    (link-indent-augment-list main)
+
+    ;; Change switch and begin fields to point to the indent table
+    (dolist (item switches)
+	(if (keywordp (indtoken-switch item))
+	    (setf
+		(indtoken-switch item)
+		(car (member (indtoken-switch item) tables :key #'indtable-label))
+	    )
+	)
+    )
+    (dolist (item begins)
+	(setf
+	    (indtoken-begin item)
+	    (car (member (indtoken-begin item) tables :key #'indtable-label))
+	)
+    )
+
+    ;; Build initialization list
+    (dolist (init inits)
+	(setq symbols (nconc symbols (indinit-variables init)))
+    )
+
+    ;; Build token code
+    (dolist (item (car elements))
+	(when (setq code (indtoken-code item))
+	    (setf
+		label
+		(intern (string (gensym)) 'keyword)
+
+		(indtoken-label item)
+		label
+
+		code
+		(list (list 'eq '*ind-label* label) code)
+
+		token-code
+		(nconc token-code (list code))
+	    )
+	)
+    )
+
+    (multiple-value-setq
+	(check-code reduce-code)
+	(compile-indent-reduces reduces)
+    )
+
+    (make-indent
+	:tables		tables
+	:inits		symbols
+	:reduces	reduces
+	:resolves	resolves
+	:token-code	(and token-code (cons 'cond token-code))
+	:check-code	check-code
+	:reduce-code	reduce-code
+	:resolve-code	(compile-indent-resolves resolves)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Search rule-pattern in match-pattern
+;; Returns offset of match, and it's length, if any
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun indent-search-rule (rule-pattern match-pattern
+			   &aux start rule rulep matchp test offset length)
+    (if (member-if-not #'keywordp rule-pattern)
+	;; rule has wildcards
+	(progn
+	    (setq
+		rulep	rule-pattern
+		matchp	match-pattern
+		start	match-pattern
+	    )
+	    (loop
+		(setq rule (car rulep))
+		(cond
+		    ;; Special pattern
+		    ((consp rule)
+			(if (eq (car rule) 'not)
+			    (progn
+				(setq
+				    test	(cadr rule)
+				    rulep	(cdr rulep)
+				    rule	(car rulep)
+				)
+				(while
+				    (and
+					;; something to match
+					matchp
+					;; NOT match is true
+					(not (eq (car matchp) test))
+					;; next match is not true
+					(not (eq (car matchp) rule))
+				    )
+				    (setq matchp (cdr matchp))
+				)
+				(if (eq (car matchp) rule)
+				    ;; rule matched
+				    (setq
+					matchp	(cdr matchp)
+					rulep	(cdr rulep)
+				    )
+				    ;; failed
+				    (setq
+					rulep	rule-pattern
+					matchp	(cdr start)
+					start	matchp
+				    )
+				)
+			    )
+			    ;; (eq (car rule) 'or)
+			    (progn
+				(if (member (car matchp) (cdr rule) :test #'eq)
+				    (setq rulep (cdr rulep) matchp (cdr matchp))
+				    ;; failed
+				    (progn
+					;; end of match found!
+					(and (null matchp) (return))
+					;; reset search
+					(setq
+					    rulep	rule-pattern
+					    matchp	(cdr start)
+					    start	matchp
+					)
+				    )
+				)
+			    )
+			)
+		    )
+
+		    ;; Skip until end of match-pattern or rule is found
+		    ((null rule)
+			(setq rulep (cdr rulep))
+			;; If matches everything
+			(if (null rulep)
+			    (progn (setq matchp nil) (return))
+			    ;; If next token cannot be matched
+			    (unless
+				(setq
+				    matchp
+				    (member (car rulep) matchp :test #'eq)
+				)
+				(setq rulep rule-pattern)
+				(return)
+			    )
+			)
+			(setq rulep (cdr rulep) matchp (cdr matchp))
+		    )
+
+		    ;; Matched
+		    ((eq rule t)
+			;; If there isn't a rule to skip
+			(and (null matchp) (return))
+			(setq rulep (cdr rulep) matchp (cdr matchp))
+		    )
+
+		    ;; Matched
+		    ((eq rule (car matchp))
+			(setq rulep (cdr rulep) matchp (cdr matchp))
+		    )
+
+		    ;; No match
+		    (t
+			;; end of match found!
+			(and (null matchp) (return))
+			;; reset search
+			(setq
+			    rulep	rule-pattern
+			    matchp	(cdr start)
+			    start	matchp
+			)
+		    )
+		)
+
+		;; if everything matched
+		(or rulep (return))
+	    )
+
+	    ;; All rules matched
+	    (unless rulep
+		;; Calculate offset and length of match
+		(setq offset 0 length 0)
+		(until (eq match-pattern start)
+		    (setq
+			offset		(1+ offset)
+			match-pattern	(cdr match-pattern)
+		    )
+		)
+		(until (eq match-pattern matchp)
+		    (setq
+			length		(1+ length)
+			match-pattern	(cdr match-pattern)
+		    )
+		)
+	    )
+	)
+	;; no wildcards
+	(and (setq offset (search rule-pattern match-pattern :test #'eq))
+	     (setq length (length rule-pattern))
+	)
+    )
+
+    (values offset length)
+)
+(compile 'indent-search-rule)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Indentation parser
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro indent-macro (ind-definition ind-offset &optional ind-no-tabs)
+   `(prog*
+	(
+	;; Current indentation table
+	(ind-table (car (indent-tables ,ind-definition)))
+
+	;; The parser rules
+	(ind-reduces (indent-reduces ,ind-definition))
+
+	;; Token list for the table
+	(ind-tokens (indtable-tokens ind-table))
+
+	;; Stack of nested tables/states
+	ind-stack
+
+	;; indentation to be used
+	(*indent* 0)
+
+	;; offset to apply indentation
+	*offset*
+
+	;; Number of lines read
+	(*ind-lines* 1)
+
+	;; Matched token
+	*ind-token*
+
+	;; list of tokens after current match, should not be changed
+	*ind-token-list*
+
+	;; label associated with rule
+	*ind-label*
+
+	;; offset of match
+	*ind-offset*
+
+	;; length of match
+	*ind-length*
+
+	;; insert position
+	(*ind-point* (point))
+
+	(ind-from (scan ,ind-offset :eol :left))
+	(ind-to ,ind-offset)
+	(ind-line (read-text ind-from (- ind-to ind-from)))
+
+	;; start of current line
+	(*ind-start* ind-from)
+
+	;; State information
+	ind-state
+
+	;; For use with (indent-macro-reject)
+	ind-prev-state
+
+	;; Matches for the current line
+	ind-matches
+
+	;; Matched tokens not yet used
+	ind-cache
+
+	;; Pattern being tested
+	ind-token
+
+	;; Used when searching for a regex
+	ind-match
+
+	;; Table to change
+	ind-change
+
+	;; Length of ind-line
+	(ind-length (length ind-line))
+
+	;; Don't parse after this offset
+	(ind-end ind-length)
+
+	;; Temporary variables used during loops
+	ind-left
+	ind-right
+	ind-tleft
+	ind-tright
+
+	;; Set  when start of file is found
+	ind-startp
+
+	;; Flag for regex search
+	(ind-noteol (< ind-to (scan ind-from :eol :right)))
+
+	;; Initialization variables expanded here
+	,@(indent-inits (eval ind-definition))
+	)
+
+	;; Initial input already read
+	(go :ind-loop)
+
+;------------------------------------------------------------------------
+; Read a text line
+:ind-read
+	(setq
+	    ind-to	ind-from
+	    ind-from	(scan ind-from :eol :left :count 2)
+	)
+	;; If start of file reached
+	(and (= ind-to ind-from) (setq ind-startp t) (go :ind-process))
+
+	(setq
+	    *ind-lines*		(1+ *ind-lines*)
+	    ind-to		(scan ind-from :eol :right)
+	    ind-line		(read-text ind-from (- ind-to ind-from))
+	    ind-length		(length ind-line)
+	    ind-end		ind-length
+	    ind-noteol		nil
+	    ind-cache		nil
+	    ind-prev-state	ind-state
+	)
+
+;------------------------------------------------------------------------
+; Loop parsing backwards
+:ind-loop
+	(setq ind-matches nil)
+	(dolist (token ind-tokens)
+	    ;; Prepare to loop
+	    (setq
+		ind-token	(indtoken-regex token)
+		ind-left	0
+	    )
+	    ;; While the pattern matches
+	    (loop
+		(setq ind-right ind-left)
+		(if
+		    (consp
+			(setq
+			    ind-match
+			    (re-exec
+				ind-token
+				ind-line
+				:start	ind-left
+				:end	ind-end
+				:notbol (> ind-left 0)
+				:noteol ind-noteol
+			    )
+			)
+		    )
+
+		    ;; Remember about match
+		    (setq
+			ind-match   (car ind-match)
+			ind-left    (cdr ind-match)
+			ind-matches (cons (cons token ind-match) ind-matches)
+		    )
+
+		    ;; No match
+		    (return)
+		)
+		;; matched an empty string
+		(and (= ind-left ind-right) (incf ind-left))
+
+		;; matched a single eol or bol
+		(and (>= ind-left ind-end) (return))
+	    )
+	)
+
+	;; Add new matches to cache
+	(when ind-matches
+	    (setq
+		ind-cache
+		(stable-sort
+		    (nconc (nreverse ind-matches) ind-cache) #'< :key #'cadr
+		)
+	    )
+	)
+
+	;; If nothing in the cache
+	(or ind-cache (go :ind-process))
+
+	(setq
+	    ind-left	(cadar ind-cache)
+	    ind-right	(cddar ind-cache)
+	    ind-matches	(cdr ind-cache)
+	)
+
+	;; If only one element in the cache
+	(or ind-matches	(go :ind-parse))
+
+	(setq
+	    ind-tleft	(cadar ind-matches)
+	    ind-tright	(cddar ind-matches)
+	)
+
+	;; Remove overlaps
+	(loop
+	    (if (or (>= ind-tleft ind-right) (<= ind-tright ind-left))
+		;; No overlap
+		(progn
+		    (setq
+			ind-left    ind-tleft
+			ind-right   ind-tright
+			ind-matches (cdr ind-matches)
+		    )
+		    ;; If everything checked
+		    (or ind-matches (return))
+		)
+		;; Overlap found
+		(progn
+		    (if (consp (cdr ind-matches))
+			;; There are yet items to be checked
+			(progn
+			    (rplaca ind-matches (cadr ind-matches))
+			    (rplacd ind-matches (cddr ind-matches))
+			)
+			;; Last item
+			(progn
+			    (rplacd (last ind-cache 2) nil)
+			    (return)
+			)
+		    )
+		)
+	    )
+
+	    ;; Prepare for next check
+	    (setq
+		ind-tleft   (cadar ind-matches)
+		ind-tright  (cddar ind-matches)
+	    )
+	)
+
+;------------------------------------------------------------------------
+; Process the matched tokens
+:ind-parse
+	(setq ind-cache (nreverse ind-cache))
+
+:ind-parse-loop
+	(or (setq ind-match (car ind-cache)) (go :ind-process))
+
+	(setq
+	    ind-cache (cdr ind-cache)
+	    ind-token (car ind-match)
+	)
+
+	(or (member ind-token ind-tokens :test #'eq)
+	    (go :ind-parse-loop)
+	)
+
+	;; If a state should be added
+	(when (setq ind-change (indtoken-token ind-token))
+	    (setq
+		ind-left    (cadr ind-match)
+		ind-right   (cddr ind-match)
+
+		*ind-offset*
+		(+ ind-from ind-left)
+
+		*ind-length*
+		(- ind-right ind-left)
+
+		ind-state
+		(cons
+		    (cons ind-change (cons *ind-offset* *ind-length*))
+		    ind-state
+		)
+
+		*ind-label*
+		(indtoken-label ind-token)
+	    )
+
+	    ;; Expand token code
+	    ,(indent-token-code (eval ind-definition))
+	)
+
+	;; Check if needs to switch to another table
+	(when (setq ind-change (indtoken-switch ind-token))
+	    ;; Need to switch to a previous table
+	    (if (integerp ind-change)
+		;; Relative switch
+		(while (and ind-stack (minusp ind-change))
+		    (setq
+			ind-table	(pop ind-stack)
+			ind-change	(1+ ind-change)
+		    )
+		)
+		;; Search table in the stack
+		(until
+		    (or
+			(null ind-stack)
+			(eq
+			    (setq ind-table (pop ind-stack))
+			    ind-change
+			)
+		    )
+		)
+	    )
+
+	    ;; If no match or stack became empty
+	    (and (null ind-table)
+		(setq
+		    ind-table
+		    (car (indent-tables ,ind-definition))
+		)
+	    )
+	)
+
+	;; Check if needs to start a new table
+	;; XXX use ind-tleft to reduce number of local variables
+	(when (setq ind-tleft (indtoken-begin ind-token))
+	    (setq
+		ind-change  ind-tleft
+		ind-stack   (cons ind-table ind-stack)
+		ind-table   ind-change
+	    )
+	)
+
+	;; If current "indent pattern table" changed
+	(when ind-change
+	    (setq
+		ind-tokens  (indtable-tokens ind-table)
+		ind-cache   (nreverse ind-cache)
+		ind-end     (cadr ind-match)
+		ind-noteol  (> ind-length ind-end)
+	    )
+	    (go :ind-loop)
+	)
+
+	(and ind-cache (go :ind-parse-loop))
+
+;------------------------------------------------------------------------
+; Everything checked, process result
+:ind-process
+
+	;; If stack is not empty, don't apply rules
+	(and ind-stack (not ind-startp) (go :ind-read))
+
+	(block ind-terminate-block
+	    (setq ind-cache nil ind-tleft 0 ind-change (mapcar #'car ind-state))
+	    (dolist (entry ind-reduces)
+		(setq
+		    *ind-token* (indreduce-token entry)
+		    *ind-label* (indreduce-label entry)
+		)
+		(dolist (rule (indreduce-rules entry))
+		    (loop
+			;; Check if reduction can be applied
+			(or
+			    (multiple-value-setq
+				(ind-match ind-length)
+				(indent-search-rule rule ind-change)
+			    )
+			    (return)
+			)
+
+			(setq
+			    ;; First element matched
+			    ind-matches		(nthcdr ind-match ind-state)
+
+			    ;; Offset of match
+			    *ind-offset*	(cadar ind-matches)
+
+			    *ind-token-list*	(nthcdr ind-match ind-change)
+
+			    ;; Length of match, note that *ind-length*
+			    ;; Will be transformed to zero bellow if
+			    ;; the rule is deleting entries.
+			    *ind-length*
+			    (if (> ind-length 1)
+				(progn
+				    (setq
+					;; XXX using ind-tright, to reduce
+					;; number of local variables...
+					ind-tright
+					(nth (1- ind-length) ind-matches)
+
+					ind-right
+					(+  (cadr ind-tright)
+					    (cddr ind-tright)
+					)
+				    )
+				    (- ind-right *ind-offset*)
+				)
+				(cddar ind-matches)
+			    )
+			)
+
+			;; XXX using ind-tleft as a counter, to reduce
+			;; number of used variables...
+			(and (>= (incf ind-tleft) 1000)
+			    ;; Should never apply so many reduce rules on
+			    ;; every iteration, if needs to, something is
+			    ;; wrong in the indentation definition...
+			    (error "~D INDREDUCE iterations, ~
+				   now checking (~A ~A)"
+				ind-tleft *ind-token* rule
+			    )
+			)
+
+			;; Check if should apply the reduction
+			(or
+			    ;; Expand check code
+			    ,(indent-check-code (eval ind-definition))
+			    (return)
+			)
+
+			(if (null *ind-token*)
+			    ;; Remove match
+			    (progn
+				(setq *ind-length* 0)
+				(if (= ind-match 0)
+				    ;; Matched the first entry
+				    (setq
+					ind-state
+					(nthcdr ind-length ind-matches)
+				    )
+				    (progn
+					(setq
+					    ind-matches
+					    (nthcdr (1- ind-match) ind-state)
+					)
+					(rplacd
+					    ind-matches
+					    (nthcdr (1+ ind-length) ind-matches)
+					)
+				    )
+				)
+			    )
+
+			    ;; Substitute/simplify
+			    (progn
+				(rplaca (car ind-matches) *ind-token*)
+				(when (> ind-length 1)
+				    (rplacd (cdar ind-matches) *ind-length*)
+				    (rplacd
+					ind-matches
+					(nthcdr ind-length ind-matches)
+				    )
+				)
+			    )
+			)
+			(setq
+			    ind-cache	    t
+			    ind-change	    (mapcar #'car ind-state)
+			)
+
+			;; Expand reduce code
+			,(indent-reduce-code (eval ind-definition))
+		    )
+		)
+	    )
+
+	    ;; ind-cache will be T if at least one change was done
+	    (and ind-cache (go :ind-process))
+
+	    ;; Start of file reached
+	    (or ind-startp (go :ind-read))
+
+	)    ;; end of ind-terminate-block
+
+
+	(block ind-terminate-block
+	    (setq *ind-token-list* (mapcar #'car ind-state))
+	    (dolist (item ind-state)
+		(setq
+		    *ind-token*		(car item)
+		    *ind-offset*	(cadr item)
+		    *ind-length*	(cddr item)
+		)
+		;; Expand resolve code
+		,(indent-resolve-code (eval ind-definition))
+		(setq *ind-token-list* (cdr *ind-token-list*))
+	    )
+	)
+
+	(and (integerp *indent*)
+	     (integerp *offset*)
+	    (indent-text *indent* *offset* ,ind-no-tabs)
+	)
+    )
+)
diff --git a/lisp/modules/lisp.lsp b/lisp/modules/lisp.lsp
new file mode 100644
index 0000000..55d5e6c
--- /dev/null
+++ b/lisp/modules/lisp.lsp
@@ -0,0 +1,174 @@
+;;
+;; Copyright (c) 2001 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;  
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/lisp.lsp,v 1.10 2002/12/20 04:32:47 paulo Exp $
+;;
+(provide "lisp")
+
+(in-package "LISP")
+
+(export '(
+    second third fourth fifth sixth seventh eighth ninth tenth
+    pathname merge-pathnames
+    logtest signum
+    alphanumericp copy-seq push pop prog prog*
+    with-open-file with-output-to-string
+))
+
+(defun second (a)	(nth 1 a))
+(defun third (a)	(nth 2 a))
+(defun fourth (a)	(nth 3 a))
+(defun fifth (a)	(nth 4 a))
+(defun sixth (a)	(nth 5 a))
+(defun seventh (a)	(nth 6 a))
+(defun eighth (a)	(nth 7 a))
+(defun ninth (a)	(nth 8 a))
+(defun tenth (a)	(nth 9 a))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; pathnames
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun pathname (filename)
+    (values (parse-namestring filename)))
+
+(defun merge-pathnames (pathname &optional defaults default-version)
+    (if (null default-version)
+	(parse-namestring pathname nil defaults)
+	(parse-namestring pathname nil
+	    (make-pathname :defaults defaults :version default-version))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; math
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun logtest (integer1 integer2)
+    (not (zerop (logand integer1 integer2))))
+
+(defun signum (number)
+    (if (zerop number) number (/ number (abs number))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; misc functions/macros
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun alphanumericp (char)
+    (or (alpha-char-p char) (not (null (digit-char-p char)))))
+
+(defun copy-seq (sequence)
+    (subseq sequence 0))
+
+(defmacro prog (init &rest body)
+    `(block nil (let ,init (tagbody ,@body))))
+
+(defmacro prog* (init &rest body)
+    `(block nil (let* ,init (tagbody ,@body))))
+
+(defmacro with-open-file (file &rest body)
+    `(let ((,(car file) (open ,@(cdr file))))
+	(unwind-protect
+	    (progn ,@body)
+	    (if ,(car file) (close ,(car file))))))
+
+(defmacro with-output-to-string (stream &rest body)
+    `(let ((,(car stream) (make-string-output-stream)))
+	(unwind-protect
+	    (progn ,@body (get-output-stream-string ,(car stream)))
+	    (and ,(car stream) (close ,(car stream))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; setf
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defsetf car (list) (value)	`(progn (rplaca ,list ,value) ,value))
+(defsetf cdr (list) (value)	`(progn (rplacd ,list ,value) ,value))
+
+(defsetf caar (list) (value)	`(progn (rplaca (car ,list) ,value) ,value))
+(defsetf cadr (list) (value)	`(progn (rplaca (cdr ,list) ,value) ,value))
+(defsetf cdar (list) (value)	`(progn (rplacd (car ,list) ,value) ,value))
+(defsetf cddr (list) (value)	`(progn (rplacd (cdr ,list) ,value) ,value))
+(defsetf caaar (list) (value)	`(progn (rplaca (caar ,list) ,value) ,value))
+(defsetf caadr (list) (value)	`(progn (rplaca (cadr ,list) ,value) ,value))
+(defsetf cadar (list) (value)	`(progn (rplaca (cdar ,list) ,value) ,value))
+(defsetf caddr (list) (value)	`(progn (rplaca (cddr ,list) ,value) ,value))
+(defsetf cdaar (list) (value)	`(progn (rplacd (caar ,list) ,value) ,value))
+(defsetf cdadr (list) (value)	`(progn (rplacd (cadr ,list) ,value) ,value))
+(defsetf cddar (list) (value)	`(progn (rplacd (cdar ,list) ,value) ,value))
+(defsetf cdddr (list) (value)	`(progn (rplacd (cddr ,list) ,value) ,value))
+(defsetf caaaar (list) (value)	`(progn (rplaca (caaar ,list) ,value) ,value))
+(defsetf caaadr (list) (value)	`(progn (rplaca (caadr ,list) ,value) ,value))
+(defsetf caadar (list) (value)	`(progn (rplaca (cadar ,list) ,value) ,value))
+(defsetf caaddr (list) (value)	`(progn (rplaca (caddr ,list) ,value) ,value))
+(defsetf cadaar (list) (value)	`(progn (rplaca (cdaar ,list) ,value) ,value))
+(defsetf cadadr (list) (value)	`(progn (rplaca (cdadr ,list) ,value) ,value))
+(defsetf caddar (list) (value)	`(progn (rplaca (cddar ,list) ,value) ,value))
+(defsetf cadddr (list) (value)	`(progn (rplaca (cdddr ,list) ,value) ,value))
+(defsetf cdaaar (list) (value)	`(progn (rplacd (caaar ,list) ,value) ,value))
+(defsetf cdaadr (list) (value)	`(progn (rplacd (caadr ,list) ,value) ,value))
+(defsetf cdadar (list) (value)	`(progn (rplacd (cadar ,list) ,value) ,value))
+(defsetf cdaddr (list) (value)	`(progn (rplacd (caddr ,list) ,value) ,value))
+(defsetf cddaar (list) (value)	`(progn (rplacd (cdaar ,list) ,value) ,value))
+(defsetf cddadr (list) (value)	`(progn (rplacd (cdadr ,list) ,value) ,value))
+(defsetf cdddar (list) (value)	`(progn (rplacd (cddar ,list) ,value) ,value))
+(defsetf cddddr (list) (value)	`(progn (rplacd (cdddr ,list) ,value) ,value))
+
+(defsetf first (list) (value)	`(progn (rplaca ,list ,value) ,value))
+(defsetf second (list) (value)	`(progn (rplaca (nthcdr 1 ,list) ,value) ,value))
+(defsetf third (list) (value)	`(progn (rplaca (nthcdr 2 ,list) ,value) ,value))
+(defsetf fourth (list) (value)	`(progn (rplaca (nthcdr 3 ,list) ,value) ,value))
+(defsetf fifth (list) (value)	`(progn (rplaca (nthcdr 4 ,list) ,value) ,value))
+(defsetf sixth (list) (value)	`(progn (rplaca (nthcdr 5 ,list) ,value) ,value))
+(defsetf seventh (list) (value)	`(progn (rplaca (nthcdr 6 ,list) ,value) ,value))
+(defsetf eighth (list) (value)	`(progn (rplaca (nthcdr 7 ,list) ,value) ,value))
+(defsetf ninth (list) (value)	`(progn (rplaca (nthcdr 8 ,list) ,value) ,value))
+(defsetf tenth (list) (value)	`(progn (rplaca (nthcdr 9 ,list) ,value) ,value))
+
+(defsetf rest (list) (value)	`(progn (rplacd ,list ,value) ,value))
+
+(defun lisp::nth-store (index list value)
+    (rplaca (nthcdr index list) value) value)
+(defsetf nth lisp::nth-store)
+
+(defsetf aref (array &rest indices) (value)
+    `(lisp::vector-store ,array ,@indices ,value))
+
+(defsetf get (symbol key &optional default) (value)
+    `(lisp::put ,symbol ,key ,value))
+
+(defsetf symbol-plist lisp::set-symbol-plist)
+
+(defsetf gethash (key hash-table &optional default) (value)
+    `(lisp::puthash ,key ,hash-table ,value))
+
+(defsetf char lisp::char-store)
+(defsetf schar lisp::char-store)
+(defsetf elt lisp::elt-store)
+(defsetf svref lisp::elt-store)
+(defsetf documentation lisp::documentation-store)
+
+(defsetf symbol-value set)
+
+(defsetf subseq (sequence start &optional end) (value)
+    `(progn (replace ,sequence ,value :start1 ,start :end1 ,end) ,value))
diff --git a/lisp/modules/progmodes/c.lsp b/lisp/modules/progmodes/c.lsp
new file mode 100644
index 0000000..bc4474b
--- /dev/null
+++ b/lisp/modules/progmodes/c.lsp
@@ -0,0 +1,1118 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/c.lsp,v 1.26 2003/01/29 03:05:54 paulo Exp $
+;;
+
+(require "syntax")
+(require "indent")
+(in-package "XEDIT")
+
+(defsynprop *prop-format*
+    "format"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"RoyalBlue2"
+    :underline	t
+)
+
+(defsynoptions *c-DEFAULT-style*
+    ;; Positive number. Basic indentation.
+    (:indentation		.	4)
+
+    ;; Boolean. Support for GNU style indentation.
+    (:brace-indent		.	nil)
+
+    ;; Boolean. Add one indentation level to case and default?
+    (:case-indent		.	t)
+
+    ;; Boolean. Remove one indentation level for labels?
+    (:label-dedent		.	t)
+
+    ;; Boolean. Add one indentation level to continuations?
+    (:cont-indent		.	t)
+
+    ;; Boolean. Move cursor to the indent column after pressing <Enter>?
+    (:newline-indent		.	t)
+
+    ;; Boolean. Set to T if tabs shouldn't be used to fill indentation.
+    (:emulate-tabs		.	nil)
+
+    ;; Boolean. Force a newline before braces?
+    (:newline-before-brace	.	nil)
+
+    ;; Boolean. Force a newline after braces?
+    (:newline-after-brace	.	nil)
+
+    ;; Boolean. Force a newline after semicolons?
+    (:newline-after-semi	.	nil)
+
+    ;; Boolean. Only calculate indentation after pressing <Enter>?
+    ;;		This may be useful if the parser does not always
+    ;;		do what the user expects...
+    (:only-newline-indent	.	nil)
+
+    ;; Boolean. Remove extra spaces from previous line.
+    ;;		This should default to T when newline-indent is not NIL.
+    (:trim-blank-lines		.	t)
+
+    ;; Boolean. If this hash-table entry is set, no indentation is done.
+    ;;		Useful to temporarily disable indentation.
+    (:disable-indent		.	nil)
+)
+
+;; BSD like style
+(defsynoptions *c-BSD-style*
+    (:indentation		.	8)
+    (:brace-indent		.	nil)
+    (:case-indent		.	nil)
+    (:label-dedent		.	t)
+    (:cont-indent		.	t)
+    (:newline-indent		.	t)
+    (:emulate-tabs		.	nil)
+    (:newline-before-brace	.	nil)
+    (:newline-after-brace	.	t)
+    (:newline-after-semi	.	t)
+    (:trim-blank-lines		.	t)
+)
+
+;; GNU like style
+(defsynoptions *c-GNU-style*
+    (:indentation		.	2)
+    (:brace-indent		.	t)
+    (:case-indent		.	nil)
+    (:label-dedent		.	t)
+    (:cont-indent		.	t)
+    (:newline-indent		.	nil)
+    (:emulate-tabs		.	nil)
+    (:newline-before-brace	.	t)
+    (:newline-after-brace	.	t)
+    (:newline-after-semi	.	t)
+    (:trim-blank-lines		.	nil)
+)
+
+;; K&R like style
+(defsynoptions *c-K&R-style*
+    (:indentation		.	5)
+    (:brace-indent		.	nil)
+    (:case-indent		.	nil)
+    (:label-dedent		.	t)
+    (:cont-indent		.	t)
+    (:newline-indent		.	t)
+    (:emulate-tabs		.	t)
+    (:newline-before-brace	.	t)
+    (:newline-after-brace	.	t)
+    (:newline-after-semi	.	t)
+    (:trim-blank-lines		.	t)
+)
+
+(defvar *c-styles* '(
+    ("xedit"	.	*c-DEFAULT-style*)
+    ("BSD"	.	*c-BSD-style*)
+    ("GNU"	.	*c-GNU-style*)
+    ("K&R"	.	*c-K&R-style*)
+))
+
+(defvar *c-mode-options* *c-DEFAULT-style*)
+; (setq *c-mode-options* *c-gnu-style*)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; This is a very lazy "pattern matcher" for the C language.
+;; If the syntax in the code is not correct, it may get confused, and
+;; because it is "lazy" some wrong constructs will be recognized as
+;; correct when reducing patterns.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defindent *c-mode-indent* :main
+    ;; this must be the first token
+    (indtoken "^\\s*"		:start-of-line)
+    (indtoken "\\<case\\>"	:c-case)
+    (indtoken "\\<default\\>"	:c-default)
+    (indtoken "\\<do\\>"	:do)
+    (indtoken "\\<if\\>"	:c-if)
+    (indtoken "\\<else\\>"	:c-else)
+    (indtoken "\\<for\\>"	:c-for)
+    (indtoken "\\<switch\\>"	:c-switch)
+    (indtoken "\\<while\\>"	:c-while)
+    ;; Match identifiers and numbers as an expression
+    (indtoken "\\w+"		:expression)
+    (indtoken ";"		:semi		:nospec t)
+    (indtoken ","		:comma		:nospec t)
+    (indtoken ":"		:collon		:nospec t)
+    ;;  Ignore spaces before collon, this avoids dedenting ternary
+    ;; and bitfield definitions as the parser does not distinguish
+    ;; labels from those, another option would be to use the pattern
+    ;; "\\w+:", but this way should properly handle labels generated
+    ;; by macros, example: `MACRO_LABEL(value):'
+    (indtoken "\\s+:"		nil)
+
+    (indinit			(c-braces 0))
+    (indtoken "{"
+	:obrace
+	:nospec t
+	:code	(decf c-braces)
+    )
+    (indtoken "}"
+	:cbrace
+	:nospec t
+	:begin	:braces
+	:code	(incf c-braces)
+    )
+    (indtable :braces
+	(indtoken "{"
+	    :obrace
+	    :nospec t
+	    :switch -1
+	    :code   (decf c-braces)
+	)
+	(indtoken "}"
+	    :cbrace
+	    :nospec t
+	    :begin  :braces
+	    :code   (incf c-braces)
+	)
+    )
+
+    (indinit			(c-bra 0))
+    (indtoken ")"		:cparen		:nospec t :code (incf c-bra))
+    (indtoken "("		:oparen		:nospec t :code (decf c-bra))
+    (indtoken "]"		:cbrack		:nospec t :code (incf c-bra))
+    (indtoken "["		:obrack		:nospec t :code (decf c-bra))
+    (indtoken "\\\\$"		:continuation)
+
+    ;; C++ style comment, disallow other tokens to match inside comment
+    (indtoken "//.*$"		nil)
+
+    (indtoken "#"		:hash		:nospec t)
+
+    ;; if in the same line, reduce now, this must be done because the
+    ;; delimiters are identical
+    (indtoken "'([^\\']|\\\\.)*'"	:expression)
+    (indtoken "\"([^\\\"]|\\\\.)*\""	:expression)
+
+    (indtoken "\""		:cstring	:nospec t	:begin :string)
+
+    (indtoken "'"		:cconstant	:nospec t	:begin :constant)
+
+    (indtoken "*/"		:ccomment	:nospec t	:begin :comment)
+    ;; this must be the last token
+    (indtoken "$"		:end-of-line)
+
+    (indtable :string
+	;; Ignore escaped characters
+	(indtoken "\\." 	nil)
+	;; Return to the toplevel when the start of the string is found
+	(indtoken "\""		:ostring	:nospec t	:switch -1)
+    )
+    (indtable :constant
+	;; Ignore escaped characters
+	(indtoken "\\." 	nil)
+	;; Return to the toplevel when the start of the character is found
+	(indtoken "'"		:oconstant	:nospec t	:switch -1)
+    )
+    (indtable :comment
+	(indtoken "/*"		:ocomment	:nospec t	:switch -1)
+    )
+
+    ;; "Complex" statements
+    (indinit		(c-complex 0) (c-cases 0))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Order of reduce rules here is important, process comment,
+    ;; continuations, preprocessor and set states when an eol is found.
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (indinit	(c-offset (point-max))
+		(c-prev-offset c-offset)
+    )
+    (indreduce :indent
+	t
+	((:start-of-line))
+	(and (= *ind-start* *ind-offset*)
+	    (setq
+		*offset* (+ *ind-offset* *ind-length*)
+	    )
+	)
+	(setq
+	    c-prev-offset   c-offset
+	    c-offset	    *ind-offset*
+	)
+    )
+
+    ;; Delete comments
+    (indreduce nil
+	t
+	((:ocomment nil :ccomment))
+    )
+
+    ;; Join in a single token to simplify removal of possible multiline
+    ;; preprocessor directives
+    (indinit			c-continuation)
+    (indreduce :continuation
+	t
+	((:continuation :end-of-line))
+	(setq c-continuation t)
+    )
+
+    (indreduce :eol
+	t
+	((:end-of-line))
+	;; Anything after the eol offset is safe to parse now
+	(setq c-continuation nil)
+    )
+
+    ;; Delete blank lines
+    (indreduce nil
+	t
+	((:indent :eol))
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Preprocessor
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce nil
+	(>= *ind-offset* *ind-start*)
+	((:indent :hash))
+	(setq *indent* 0)
+	(indent-macro-reject-left)
+    )
+    (indreduce nil
+	t
+	((:indent :hash nil :eol))
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Expressions
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce :expression
+	t
+	;; Reduce to a single expression
+	((:expression :parens)
+	 (:expression :bracks)
+	 (:expression :expression)
+	;; These may be multiline
+	 (:ostring (not :ostring) :cstring)
+	 (:oconstant (not :oconstant) :cconstant)
+	)
+    )
+
+    (indreduce :expression
+	t
+	((:expression :eol :indent :expression)
+	 (:expression :eol :expression)
+	)
+    )
+
+    (indreduce :exp-comma
+	t
+	((:expression :comma)
+	)
+    )
+
+    ;; A semicollon, start a statement
+    (indreduce :stat
+	t
+	((:semi))
+    )
+
+    ;; Expression following (possibly empty) statement
+    (indreduce :stat
+	t
+	(((or :expression :exp-comma) :stat))
+    )
+
+    ;; Multiline statements
+    (indreduce :stat
+	t
+	(((or :expression :exp-comma) :eol :indent :stat)
+	 ;; rule below may have removed the :indent
+	 ((or :expression :exp-comma) :eol :stat)
+	)
+    )
+
+    (indinit	c-exp-indent)
+    ;; XXX This rule avoids parsing large amounts of code
+    (indreduce :stat
+	t
+	;; Eat eol if following expression
+	((:indent :stat :eol)
+	 (:indent :stat)
+	)
+	(if
+	    (or
+		(null c-exp-indent)
+		(/= (cdar c-exp-indent) (+ *ind-offset* *ind-length*))
+	    )
+	    ;; A new statement, i.e. not just joining a multiline one
+	    (push
+		(cons
+		    (offset-indentation *ind-offset* :resolve t)
+		    (+ *ind-offset* *ind-length*)
+		)
+		c-exp-indent
+	    )
+	    ;; Update start of statement
+	    (rplaca
+		(car c-exp-indent)
+		(offset-indentation *ind-offset* :resolve t)
+	    )
+	)
+	(when (consp (cdr c-exp-indent))
+	    (if (and
+		    (zerop c-complex)
+		    (zerop c-cases)
+		    (zerop c-bra)
+		    (= (caar c-exp-indent) (caadr c-exp-indent))
+		)
+		;; Two statements with the same indentation
+		(progn
+		    (setq *indent* (caar c-exp-indent))
+		    (indent-macro-reject-left)
+		)
+		;; Different indentation or complex state
+		(progn
+		    (rplacd c-exp-indent nil)
+		    (setq c-complex 0)
+		)
+	    )
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle braces
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce :stat
+	;; If block finishes before current line, group as a statement
+	(< (+ *ind-offset* *ind-length*) *ind-start*)
+	((:obrace (not :obrace) :cbrace))
+    )
+    (indreduce :obrace
+	;; If not in the first line
+	(< *ind-offset* *ind-start*)
+	;; If the opening { is the first non blank char in the line
+	((:indent :obrace))
+	(setq *indent* (offset-indentation (+ *ind-offset* *ind-length*)))
+
+	;; XXX This may be the starting brace of a switch
+	(setq c-case-flag nil)
+	(indent-macro-reject-left)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Labels
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; XXX this frequently doesn't do what is expected, should redefine
+    ;; some rules, as it frequently will dedent while typing something
+    ;; like  test ? exp1 : exp2
+    ;;                   ^ dedents here because it reduces everything
+    ;;			   before ':' to a single :expression token.
+    (indreduce :label
+	t
+	((:indent :expression :collon :eol))
+	(when (and *label-dedent* (>= *ind-offset* *ind-start*))
+	    (setq
+		*indent*
+		(- (offset-indentation *ind-offset* :resolve t) *base-indent*)
+	    )
+	    (indent-macro-reject-left)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle if
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce :if
+	t
+	((:c-if :parens)
+	)
+	(incf c-complex)
+    )
+
+    (indreduce :else
+	t
+	((:c-else))
+	(incf c-complex)
+    )
+
+    ;; Join
+    (indreduce :else-if
+	t
+	((:else :if)
+	 (:else :eol :indent :if)
+	)
+	(incf c-complex)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle for
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Join with the parentheses
+    (indreduce :for
+	t
+	((:c-for :parens)
+	)
+	(incf c-complex)
+    )
+    ;; Before current line, simplify
+    (indreduce :stat
+	(< (+ *ind-offset* *ind-length*) *ind-point*)
+	((:for :stat)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle while and do
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce :while
+	t
+	((:c-while :parens)
+	 ;; Assume that it is yet being edited, or adjusting indentation
+	(:c-while)
+	)
+	(incf c-complex)
+    )
+    (indreduce :stat
+	t
+	((:do :stat :while)
+	 (:while :stat)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle switch
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indinit			c-case-flag)
+
+    (indreduce :switch
+	t
+	((:c-switch :parens)
+	)
+    )
+    ;; Transform in a statement
+    (indreduce :stat
+	(< (+ *ind-offset* *ind-length*) *ind-start*)
+	((:switch :stat)
+	 ;; Do it now or some rule may stop parsing, and calculate
+	 ;; a wrong indentation for nested switches
+	 (:switch :eol :indent :stat)
+	)
+    )
+    ;; An open switch
+    (indreduce :obrace
+	(and
+	    (<= c-braces 0)
+	    (> *ind-start* *ind-offset*)
+	)
+	((:indent :switch :obrace)
+	)
+	(setq
+	    *indent* (offset-indentation *ind-offset* :resolve t)
+	    c-case-flag nil
+	)
+	(indent-macro-reject-left)
+    )
+    (indreduce :obrace
+	(and
+	    (<= c-braces 0)
+	    (> *ind-start* *ind-offset*)
+	)
+	((:indent :switch :eol :indent :obrace)
+	)
+	(setq
+	    *indent* (- (offset-indentation *ind-offset* :resolve t) *base-indent*)
+	    c-case-flag nil
+	)
+	(and *brace-indent* (incf *indent* *base-indent*))
+	(indent-macro-reject-left)
+    )
+    ;; Before current line
+    (indreduce :case
+	(and
+	    (or
+		(not *case-indent*)
+		(prog1 c-case-flag (setq c-case-flag t))
+	    )
+	    (<= c-braces 0)
+	    (< *ind-offset* *ind-start*)
+	)
+	((:indent :case)
+	)
+	(setq
+	    *indent* (offset-indentation *ind-offset* :resolve t)
+	    c-case-flag nil
+	)
+	(indent-macro-reject-left)
+    )
+    (indreduce :case
+	t
+	((:c-case :expression :collon)
+	 (:c-default :collon)
+	 ;; Assume that it is yet being edited, or adjusting indentation
+	 (:c-case)
+	 (:c-default)
+	)
+	(and (>= *ind-offset* *ind-start*)
+	    (incf c-cases)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Handle parentheses and brackets
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Reduce matches
+    (indreduce :parens
+	t
+	((:oparen (not :oparen) :cparen))
+	(when
+	    (and
+		(< *ind-offset* *ind-start*)
+		(> (+ *ind-offset* *ind-length*) *ind-start*)
+	    )
+	    (setq *indent* (1+ (offset-indentation *ind-offset* :align t)))
+	    (indent-macro-reject-left)
+	)
+    )
+    (indreduce :bracks
+	t
+	((:obrack (not :obrack) :cbrack))
+	(when
+	    (and
+		(< *ind-offset* *ind-start*)
+		(> (+ *ind-offset* *ind-length*) *ind-start*)
+	    )
+	    (setq *indent* (1+ (offset-indentation *ind-offset* :align t)))
+	    (indent-macro-reject-left)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Assuming previous lines have correct indentation, this allows
+    ;; resolving the indentation fastly
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Line ended with an open brace
+    (indreduce :obrace
+	(< *ind-offset* *ind-start*)
+	((:indent (or :for :while :if :else-if :else :do) :obrace)
+	)
+	(setq *indent* (offset-indentation *ind-offset* :resolve t))
+	(indent-macro-reject-left)
+    )
+    ;; Adjust indentation level if current line starts with an open brace
+    (indreduce nil
+	(< *ind-offset* *ind-start* (+ *ind-offset* *ind-length*))
+	 ;; Just set initial indentation
+	((:indent (or :for :while :if :else-if :else :do) :eol :indent :obrace)
+	)
+	(setq
+	    *indent*
+	    (- (offset-indentation *ind-offset* :resolve t) *base-indent*)
+	)
+	(and *brace-indent* (incf *indent* *base-indent*))
+	(indent-macro-reject-left)
+    )
+    ;; Previous rule failed, current line does not start with an open brace
+    (indreduce :flow
+	;; first statement is in current line
+	(and
+	    (<= c-braces 0)
+	    (> (+ *ind-offset* *ind-length*) *ind-start* *ind-offset*)
+	)
+	((:indent (or :for :while :if :else-if :else :do) :eol :indent)
+	)
+	(setq *indent* (offset-indentation *ind-offset* :resolve t))
+	(indent-macro-reject-left)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Simplify, remove old (:eol :indent)
+    ;; This must be the last rule, to avoid not matching the
+    ;; rules for fast calculation of indentation above
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indreduce nil
+	(> *ind-offset* c-prev-offset)
+	((:eol :indent))
+    )
+
+
+    (indinit			(c-flow 0))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; If
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indinit			c-if-flow)
+    (indresolve :if
+	(and (< *ind-offset* *ind-start*)
+	    (push c-flow c-if-flow)
+	    (incf *indent* *base-indent*)
+	    (incf c-flow)
+	)
+    )
+    (indresolve (:else-if :else)
+	(when c-if-flow
+	    (while (< c-flow (car c-if-flow))
+		(incf *indent* *base-indent*)
+		(incf c-flow)
+	    )
+	    (or (eq *ind-token* :else-if) (pop c-if-flow))
+	)
+	(and (< *ind-offset* *ind-start*)
+	    (incf *indent* *base-indent*)
+	    (incf c-flow)
+	)
+    )
+
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; For/while/do
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indinit			c-do-flow)
+    (indresolve (:for :while :do)
+	(if (eq *ind-token* :do)
+	    (and (< *ind-offset* *ind-start*) (push c-flow c-do-flow))
+	    (when (and c-do-flow (eq *ind-token* :while))
+		(while (< c-flow (car c-do-flow))
+		    (incf *indent* *base-indent*)
+		    (incf c-flow)
+		)
+		(pop c-do-flow)
+	    )
+	)
+	(and (< *ind-offset* *ind-start*)
+	    (incf *indent* *base-indent*)
+	    (incf c-flow)
+	)
+    )
+
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Switch
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indresolve :switch
+	(setq c-case-flag nil)
+    )
+    (indresolve (:case :c-case)
+	(if (< *ind-offset* *ind-start*)
+	    (or c-case-flag
+		(setq
+		    *indent*
+		    (+ (offset-indentation *ind-offset* :resolve t)
+			*base-indent*
+		    )
+		)
+	    )
+	    (if c-case-flag
+		(and (= (decf c-cases) 0)
+		    (decf *indent* *base-indent*)
+		)
+		(or *case-indent*
+		    (decf *indent* *base-indent*)
+		)
+	    )
+	)
+	(setq c-case-flag t)
+    )
+
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Braces/flow control
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indresolve :flow
+	(incf *indent* *base-indent*)
+    )
+    (indresolve :obrace
+	(and (< *ind-offset* *ind-start*)
+	    (incf *indent* *base-indent*)
+	)
+    )
+    (indresolve :cbrace
+	(decf *indent* *base-indent*)
+	(and *case-indent* c-case-flag
+	    (decf *indent* *base-indent*)
+	    (setq c-case-flag nil)
+	)
+	(and (not *offset*) (>= *ind-offset* *ind-start*)
+	    (setq *offset* *ind-offset*)
+	)
+    )
+
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Statements
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indresolve :stat
+	(when (< *ind-offset* *ind-start*)
+	    (while (> c-flow 0)
+		(setq
+		    *indent*	(- *indent* *base-indent*)
+		    c-flow	(1- c-flow)
+		)
+	    )
+	)
+	(and
+	    *cont-indent*
+	    (< *ind-offset* *ind-start*)
+	    (> (+ *ind-offset* *ind-length*) *ind-start*)
+	    (incf *indent* *base-indent*)
+	)
+    )
+
+    (indresolve :expression
+	(and
+	    *cont-indent*
+	    (zerop c-bra)
+	    (> *indent* 0)
+	    (< *ind-offset* *ind-start*)
+	    (> (+ *ind-offset* *ind-length*) *ind-start*)
+	    (incf *indent* *base-indent*)
+	)
+    )
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Open
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (indresolve (:oparen :obrack)
+	(and (< *ind-offset* *ind-start*)
+	    (setq *indent* (1+ (offset-indentation *ind-offset* :align t)))
+	)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Find a "good" offset to start parsing backwards, so that it should
+;; always generate the same results.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun c-offset-indent (&aux char (point (point)))
+    ;; Skip spaces forward
+    (while (member (setq char (char-after point)) indent-spaces)
+	(incf point)
+    )
+    (or (characterp char) (return-from c-offset-indent point))
+
+    ;;	Skip word chars
+    (when (alphanumericp char)
+	(while (and (setq char (char-after point)) (alphanumericp char))
+	    (incf point)
+	)
+	(or (characterp char) (return-from c-offset-indent point))
+
+	;; Skip spaces forward
+	(while (member (setq char (char-after point)) indent-spaces)
+	    (incf point)
+	)
+	(or (characterp char) (return-from c-offset-indent point))
+    )
+
+    ;; don't include " or ' to avoid parsing strings "inverted"
+    (if (member char '(#\Newline #\" #\')) point (1+ point))
+)
+(compile 'c-offset-indent)
+
+(defun c-should-indent (options)
+    (when (hash-table-p options)
+	;; check if previous line has extra spaces
+	(and (gethash :trim-blank-lines options)
+	    (indent-clear-empty-line)
+	)
+
+	;; indentation disabled?
+	(and (gethash :disable-indent options)
+	    (return-from c-should-indent)
+	)
+
+	(let*
+	    (
+	    (point (point))
+	    (start (scan point :eol :left))
+	    (char (char-before point))
+	    offset
+	    match
+	    text
+	    )
+
+	    ;; at the start of an empty file
+	    (or (characterp char)
+		(return-from c-should-indent)
+	    )
+
+	    ;; if at bol and should indent only when starting a line
+	    (and (gethash :only-newline-indent options)
+		(return-from c-should-indent (= point start))
+	    )
+
+	    (and
+		(char= char #\;)
+		(gethash :newline-after-semi options)
+		(return-from c-should-indent t)
+	    )
+
+	    ;; if one of these was typed, must check indentation
+	    (and (member char '(#\{ #\} #\: #\] #\) #\#))
+		(return-from c-should-indent t)
+	    )
+
+	    ;; at the start of a line
+	    (and (= point start)
+		(return-from c-should-indent (gethash :newline-indent options))
+	    )
+
+	    ;; if first character
+	    (and (= point (1+ start))
+		(return-from c-should-indent t)
+	    )
+
+	    ;; check if is the first non-blank character in a new line
+	    (when
+		(and
+		    (gethash :cont-indent options)
+		    (= point (scan point :eol :right))
+		    (alphanumericp char)
+		)
+		(setq offset (1- point))
+		(while
+		    (and
+			(> offset start)
+			(member (char-before offset) indent-spaces)
+		    )
+		    (decf offset)
+		)
+		;; line has only one character with possible spaces before it
+		(and (<= offset start)
+		    (return-from c-should-indent t)
+		)
+	    )
+
+	    ;; check for keywords that change indentation
+	    (when (alphanumericp char)
+		(setq offset (1- point))
+		(while
+		    (and
+			(alphanumericp (char-before offset))
+			(> offset start)
+		    )
+		    (decf offset)
+		)
+		(setq
+		    text	(read-text offset (- point offset))
+		    match	(re-exec #.(re-comp "(case|else|while)\\w?\\>")
+				    text)
+		)
+		(and
+		    (consp match)
+		    (return-from c-should-indent (<= (- (caar match) offset) 2))
+		)
+	    )
+	)
+    )
+    ;; Should not indent
+    nil
+)
+(compile 'c-should-indent)
+
+
+(defun c-indent-check (syntax syntable options
+		       &aux start point char left brace change)
+    (setq
+	point	(point)
+	char	(char-before point)
+	left	point
+	brace	(member char '(#\{ #\}))
+    )
+
+    (when
+	(and brace (gethash :newline-before-brace options))
+	(setq start (scan point :eol :left))
+	(while
+	    (and
+		(> (decf left) start)
+		(member (char-before left) indent-spaces)
+	    )
+	    ;; skip blanks
+	)
+	(when (> left start)
+	    (replace-text left left (string #\Newline))
+	    (c-indent syntax syntable)
+	    (setq change t)
+	)
+    )
+
+    (when
+	(or
+	    (and brace (not change) (gethash :newline-after-brace options))
+	    (and (char= char #\;) (gethash :newline-after-semi options))
+	)
+	(setq left (point))
+	(replace-text left left (string #\Newline))
+	(goto-char (1+ left))
+	(c-indent syntax syntable)
+    )
+)
+
+(defun c-indent (syntax syntable)
+    (let*
+	(
+	(options (syntax-options syntax))
+	*base-indent*
+	*brace-indent*
+	*case-indent*
+	*label-dedent*
+	*cont-indent*
+	)
+
+	(or (c-should-indent options) (return-from c-indent))
+
+	(setq
+	    *base-indent*	(gethash :indentation options 4)
+	    *brace-indent*	(gethash :brace-indent options nil)
+	    *case-indent*	(gethash :case-indent options t)
+	    *label-dedent*	(gethash :label-dedent options t)
+	    *cont-indent*	(gethash :cont-indent options t)
+	)
+
+	(indent-macro
+	    *c-mode-indent*
+	    (c-offset-indent)
+	    (gethash :emulate-tabs options)
+	)
+
+	(c-indent-check syntax syntable options)
+    )
+)
+(compile 'c-indent)
+
+(defsyntax *c-mode* :main nil #'c-indent *c-mode-options*
+    ;;  All recognized C keywords.
+    (syntoken
+	(string-concat
+	    "\\<("
+	    "asm|auto|break|case|catch|char|class|const|continue|default|"
+	    "delete|do|double|else|enum|extern|float|for|friend|goto|if|"
+	    "inline|int|long|new|operator|private|protected|public|register|"
+	    "return|short|signed|sizeof|static|struct|switch|template|this|"
+	    "throw|try|typedef|union|unsigned|virtual|void|volatile|while"
+	    ")\\>")
+	:property *prop-keyword*)
+
+    ;; Numbers, this is optional, comment this rule if xedit is
+    ;; too slow to load c files.
+    (syntoken
+	(string-concat
+	    "\\<("
+	    ;; Integers
+	    "(\\d+|0x\\x+)(u|ul|ull|l|ll|lu|llu)?|"
+	    ;; Floats
+	    "\\d+\\.?\\d*(e[+-]?\\d+)?[lf]?"
+	    ")\\>")
+	:icase t
+	:property *prop-number*
+    )
+
+    ;; String start rule.
+    (syntoken "\"" :nospec t :begin :string :contained t)
+
+    ;; Character start rule.
+    (syntoken "'" :nospec t :begin :character :contained t)
+
+    ;; Preprocessor start rule.
+    (syntoken "^\\s*#\\s*\\w+" :begin :preprocessor :contained t)
+
+    ;; Comment start rule.
+    (syntoken "/*" :nospec t :begin :comment :contained t)
+
+    ;; C++ style comments.
+    (syntoken "//.*" :property *prop-comment*)
+
+    ;; Punctuation, this is also optional, comment this rule if xedit is
+    ;; too slow to load c files.
+    (syntoken "[][(){}/*+:;=<>,&.!%|^~?-][][(){}*+:;=<>,&.!%|^~?-]?"
+	:property *prop-punctuation*)
+
+
+    ;; Rules for comments.
+    (syntable :comment *prop-comment* #'default-indent
+	;; Match nested comments as an error.
+	(syntoken "/*" :nospec t :property *prop-error*)
+
+	(syntoken "XXX|TODO|FIXME" :property *prop-annotation*)
+
+	;;  Rule to finish a comment.
+	(syntoken "*/" :nospec t :switch -1)
+    )
+
+    ;; Rules for strings.
+    (syntable :string *prop-string* #'default-indent
+	;; Ignore escaped characters, this includes \".
+	(syntoken "\\\\.")
+
+	;; Match, most, printf arguments.
+	(syntoken "%%|%([+-]?\\d+)?(l?[deEfgiouxX]|[cdeEfgiopsuxX])"
+	    :property *prop-format*)
+
+	;; Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;; Rule to finish a string.
+	(syntoken "\"" :nospec t :switch -1)
+
+	;; Don't allow strings continuing in the next line.
+	(syntoken ".?$" :begin :error)
+    )
+
+    ;; Rules for characters.
+    (syntable :character *prop-constant* nil
+	;; Ignore escaped characters, this includes \'.
+	(syntoken "\\\\.")
+
+	;; Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;; Rule to finish a character constant.
+	(syntoken "'" :nospec t :switch -1)
+
+	;; Don't allow constants continuing in the next line.
+	(syntoken ".?$" :begin :error)
+    )
+
+    ;;  Rules for preprocessor.
+    (syntable :preprocessor *prop-preprocessor* #'default-indent
+	;;  Preprocessor includes comments.
+	(syntoken "/*" :nospec t :begin :comment :contained t)
+
+	;;  Ignore lines finishing with a backslash.
+	(syntoken "\\\\$")
+
+	;; Return to previous state if end of line found.
+	(syntoken ".?$" :switch -1)
+    )
+
+    (syntable :error *prop-error* nil
+	(syntoken "^.*$" :switch -2)
+    )
+
+    ;;  You may also want to comment this rule if the parsing is
+    ;; noticeably slow.
+    (syntoken "\\c" :property *prop-control*)
+)
diff --git a/lisp/modules/progmodes/html.lsp b/lisp/modules/progmodes/html.lsp
new file mode 100644
index 0000000..86f8eea
--- /dev/null
+++ b/lisp/modules/progmodes/html.lsp
@@ -0,0 +1,327 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/html.lsp,v 1.3 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+#|
+  This is not a validation tool for html.
+
+  It is possible to, using macros generate all combinations of text attributes,
+  to properly handle <b>...<i>...</i>...</b> etc, as well as generating macros
+  to automatically closing tags, but for now this file was built to work as an
+  experience with the syntax highlight code.
+|#
+
+(defsynprop *prop-html-default*
+    "default"
+    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Gray10")
+
+(defsynprop *prop-html-bold*
+    "bold"
+    :font	"-*-lucida-bold-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-italic*
+    "italic"
+    :font	"-*-lucida-medium-i-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Gray10")
+
+(defsynprop *prop-html-pre*
+    "pre"
+    :font	"-*-courier-medium-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Gray10")
+
+(defsynprop *prop-html-link*
+    "link"
+    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Blue"
+    :underline "t")
+
+(defsynprop *prop-html-small*
+    "small"
+    :font	"-*-lucida-medium-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"Gray10")
+
+(defsynprop *prop-html-big*
+    "big"
+    :font	"-*-lucida-medium-r-*-*-20-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-name*
+    "name"
+    :font	"-*-lucida-bold-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Black"
+    :background "rgb:e/f/e")
+
+(defsynprop *prop-html-h1*
+    "h1"
+    :font	"-*-lucida-bold-r-*-*-20-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-h2*
+    "h2"
+    :font	"-*-lucida-bold-r-*-*-17-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-h4*
+    "h4"
+    :font	"-*-lucida-bold-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-h5*
+    "h5"
+    :font	"-*-lucida-bold-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"Gray15")
+
+(defsynprop *prop-html-li*
+    "li"
+    :font	"-*-lucida-bold-r-*-*-8-*-*-*-*-*-*-1"
+    :foreground	"rgb:0/5/0"
+    :underline	t)
+
+(defsynprop *prop-html-hr*
+    "hr"
+    :font	"-*-courier-bold-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"rgb:0/5/0"
+    :overstrike	t)
+
+(defsynprop *prop-html-title*
+    "title"
+    :font	"-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"Red3"
+    :underline "t")
+
+(defsynprop *prop-html-tag*
+    "tag"
+    :font	"-*-courier-medium-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"green4")
+
+(defsynprop *prop-html-string*
+    "string"
+    :font	"-*-lucida-medium-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"RoyalBlue2")
+
+(defsynprop *prop-html-comment*
+    "comment"
+    :font	"-*-courier-medium-o-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"SlateBlue3")
+
+(defsynprop *prop-html-entity*
+    "entity"
+    :font	"-*-lucida-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Red4")
+
+(defsynprop *prop-html-unknown*
+    "unknown"
+    :font	"-*-courier-bold-r-*-*-10-*-*-*-*-*-*-1"
+    :foreground	"yellow"
+    :background "red")
+
+(defmacro html-syntoken (name)
+    `(syntoken (string-concat "<" ,name "\\>")
+	:icase t :contained t
+	:begin (intern (string-concat ,name "$") 'keyword)))
+(defmacro html-syntable (name property)
+    `(let
+	((label (intern (string-concat ,name "$") 'keyword))
+	 (nested-label (intern (string (gensym)) 'keyword)))
+	(syntable label *prop-html-tag* nil
+	    (synaugment :generic-tag)
+	    (syntoken ">" :nospec t :property *prop-html-tag* :begin nested-label)
+	    (syntable nested-label ,property nil
+		(syntoken (string-concat "</" ,name ">")
+		    :icase t :nospec t :property *prop-html-tag* :switch -2)
+		(syntoken (string-concat "</" ,name "\\s*$")
+		    :icase t :contained t :begin :continued-end-tag)
+		(synaugment :main)))))
+
+
+(defsyntax *html-mode* :main *prop-html-default* nil nil
+    (syntoken "<!--" :nospec t :contained t :begin :comment)
+    (syntable :comment *prop-html-comment* nil
+	(syntoken "-->" :nospec t :switch -1))
+    (syntoken "&([a-zA-Z0-9_.-]+|#\\x\\x?);?" :property *prop-html-entity*)
+    (syntoken "<li>" :nospec t :icase t :property *prop-html-li*)
+    (syntoken "<hr>" :nospec t :icase t :property *prop-html-hr*)
+
+    (syntoken "<img\\>" :icase t :contained t :begin :tag)
+    (syntoken "<(p|br)>" :icase t :property *prop-html-tag*)
+
+    ;; If in the toplevel, unbalanced!
+    ;; XXX When adding new nested tables, don't forget to update this pattern.
+    (syntoken
+	(string-concat
+	    "</("
+	    "b|strong|i|em|address|pre|code|tt|small|big|a|span|div|"
+	    "h1|h2|h3|h4|h5|title|font|ol|ul|dl|dt|dd|menu"
+	    ")\\>")
+	:icase t :property *prop-html-unknown* :begin :unbalanced)
+    (syntable :unbalanced *prop-html-unknown* nil
+	(syntoken ">" :nospec t :switch :main)
+	(synaugment :generic-tag)
+    )
+
+    #||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+    ;; XXX ONLY add a rule for "html", "head" and "body" if you want to do a
+    ;; more complete check for common errors. If you add those rules, it will
+    ;; reparse the entire file at every character typed (unless there are
+    ;; errors in which case the parser resets the state).
+    ;; For visualization only that would be OK...
+    ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||#
+
+    (html-syntoken "b")
+    (html-syntable "b" *prop-html-bold*)
+    (html-syntoken "strong")
+    (html-syntable "strong" *prop-html-bold*)
+
+    (html-syntoken "i")
+    (html-syntable "i" *prop-html-italic*)
+    (html-syntoken "em")
+    (html-syntable "em" *prop-html-italic*)
+    (html-syntoken "address")
+    (html-syntable "address" *prop-html-italic*)
+
+    (html-syntoken "pre")
+    (html-syntable "pre" *prop-html-pre*)
+    (html-syntoken "code")
+    (html-syntable "code" *prop-html-pre*)
+    (html-syntoken "tt")
+    (html-syntable "tt" *prop-html-pre*)
+
+    (html-syntoken "small")
+    (html-syntable "small" *prop-html-small*)
+
+    (html-syntoken "big")
+    (html-syntable "big" *prop-html-big*)
+
+    ;; Cannot hack html-syntoken and html-syntable to handle this,
+    ;; as the option to <a may be in the next line.
+    (syntoken "<a\\>" :icase t :contained t :begin :a)
+    (syntable :a *prop-html-tag* nil
+	;; Tag is open
+	(syntoken "\\<href\\>" :icase t :begin :a-href)
+	(syntoken "\\<name\\>" :icase t :begin :a-name)
+	(syntoken "<" :nospec t :property *prop-html-unknown* :switch -2)
+	(synaugment :generic-tag)
+	(syntoken ">" :nospec t :begin :a-generic-text)
+	(syntable :a-href *prop-html-tag* nil
+	    (syntoken ">" :nospec t :begin :a-href-text)
+	    (synaugment :generic-tag)
+	    (syntable :a-href-text *prop-html-link* nil
+		(syntoken "</a>"
+		    :icase t :nospec t :property *prop-html-tag* :switch -3)
+		(syntoken "</a\\s*$" :icase t :begin :continued-nested-end-tag)
+		(synaugment :main)
+	    )
+	)
+	(syntable :a-name *prop-html-tag* nil
+	    (syntoken ">" :nospec t :begin :a-name-text)
+	    (synaugment :generic-tag)
+	    (syntable :a-name-text *prop-html-name* nil
+		(syntoken "</a>"
+		    :icase t :nospec t :property *prop-html-tag* :switch -3)
+		(syntoken "</a\\s*$" :icase t :begin :continued-nested-end-tag)
+		(synaugment :main)
+	    )
+	)
+	(syntable :a-generic-text nil nil
+	    (syntoken "</a>"
+		:icase t :nospec t :property *prop-html-tag* :switch -2)
+	    (syntoken "<a/\\s$" :icase t :begin :continued-end-tag)
+	    (synaugment :main)
+	)
+    )
+
+    ;; Do nothing, just check start/end tags
+    (html-syntoken "ol")
+    (html-syntable "ol" nil)
+    (html-syntoken "ul")
+    (html-syntable "ul" nil)
+    (html-syntoken "dl")
+    (html-syntable "dl" nil)
+    ;; Maybe <dt> and <dd> should be in a special table, to not require
+    ;; and ending tag.
+    ;; XXX Maybe should also add a table for <p>.
+    (html-syntoken "dt")
+    (html-syntable "dt" nil)
+    (html-syntoken "dd")
+    (html-syntable "dd" nil)
+
+    (html-syntoken "span")
+    (html-syntable "span" nil)
+    (html-syntoken "div")
+    (html-syntable "div" nil)
+    (html-syntoken "menu")
+    (html-syntable "menu" nil)
+
+    (html-syntoken "h1")
+    (html-syntable "h1" *prop-html-h1*)
+    (html-syntoken "h2")
+    (html-syntable "h2" *prop-html-h2*)
+    (html-syntoken "h3")
+    (html-syntable "h3" *prop-html-bold*)
+    (html-syntoken "h4")
+    (html-syntable "h4" *prop-html-h4*)
+    (html-syntoken "h5")
+    (html-syntable "h5" *prop-html-h5*)
+    (html-syntoken "title")
+    (html-syntable "title" *prop-html-title*)
+
+    (html-syntoken "font")
+    (html-syntable "font" *prop-control*)
+
+    (syntoken "<" :nospec t :contained t :begin :tag)
+    (syntable :generic-tag *prop-html-tag* nil
+	(syntoken "\"" :nospec t :contained t :begin :string)
+	(syntoken "<" :nospec t :property *prop-html-unknown*)
+    )
+    (syntable :tag *prop-html-tag* nil
+	(syntoken ">" :nospec t :switch -1)
+	(synaugment :generic-tag)
+    )
+	;; Tag ended in a newline, common practice...
+    (syntable :continued-end-tag *prop-html-tag* nil
+	(syntoken ">" :nospec t :switch -3)
+	(synaugment :generic-tag)
+    )
+    (syntable :continued-nested-end-tag *prop-html-tag* nil
+	(syntoken ">" :nospec t :switch -4)
+	(synaugment :generic-tag)
+    )
+
+    (syntable :string *prop-html-string* nil
+	(syntoken "\\\\.")
+	(syntoken "\"" :nospec t :switch -1)
+    )
+)
diff --git a/lisp/modules/progmodes/imake.lsp b/lisp/modules/progmodes/imake.lsp
new file mode 100644
index 0000000..ea34ed6
--- /dev/null
+++ b/lisp/modules/progmodes/imake.lsp
@@ -0,0 +1,188 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/imake.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-shell*
+    "shell"
+    :font	"*courier-bold-r*12*"
+    :foreground	"Red4"
+)
+
+(defsynprop *prop-variable*
+    "variable"
+    :font	"*courier-medium-r*12*"
+    :foreground	"Red3"
+)
+
+;;  The syntax-highlight definition does not try to flag errors, just show
+;; tabs in the start of lines for better visualization.
+(defsynprop *prop-tabulation*
+    "tabulation"
+    :font	"*courier-medium-r*12*"
+    :background	"Gray90"
+)
+
+(defsynprop *prop-xcomm*
+    "xcomm"
+    :font	"*courier-medium-o*12*"
+    :foreground	"SkyBlue4"
+)
+
+
+(defsyntax *imake-mode* :main nil nil nil
+    (syntoken "^\\s*XCOMM\\W?.*$"
+	:property *prop-xcomm*)
+
+    (syntoken "^\\t+"
+	:property *prop-tabulation*)
+
+    (syntoken "$("
+	:nospec t
+	:begin :shell
+	:property *prop-shell*)
+
+    (syntoken "[][(){};$<=>&@/\\,.:~!|*?'`+-]"
+	:property *prop-shell*)
+
+    ;;  Preprocessor start rule.
+    (syntoken "^\\s*#\\s*\\w+"
+	:begin :preprocessor
+	:contained t)
+
+    ;;  Comment start rule.
+    (syntoken "/*"
+	:nospec t
+	:begin :comment
+	:contained t)
+
+    ;;  String start rule.
+    (syntoken "\""
+	:begin :string
+	:nospec t
+	:contained t)
+
+    ;;  Quoted string start rule.
+    (syntoken "\\\""
+	:begin :quoted-string
+	:nospec t
+	:contained t)
+
+    (syntable :shell *prop-variable* nil
+	(syntoken ")"
+	    :nospec t
+	    :property *prop-shell*
+	    :switch -1)
+    )
+
+    ;;  Rules for comments.
+    (syntable :comment *prop-comment* nil
+
+	;;  Match nested comments as an error.
+	(syntoken "/*"
+	    :nospec t
+	    :property *prop-error*)
+
+	(syntoken "XXX|TODO|FIXME"
+	    :property *prop-annotation*)
+
+	;;  Rule to finish a comment.
+	(syntoken "*/"
+	    :nospec t
+	    :switch -1)
+    )
+
+    ;;  Rules for preprocessor.
+    (syntable :preprocessor *prop-preprocessor* nil
+
+	;;  Preprocessor includes comments.
+	(syntoken "/*"
+	    :nospec t
+	    :begin :comment
+	    :contained t)
+
+	;;  Visualization help, show tabs in the start of lines.
+	(syntoken "^\\t+"
+	    :property *prop-tabulation*)
+
+	;;  Ignore lines finishing with a backslash.
+	(syntoken "\\\\$")
+
+	;;  Return to previous state if end of line found.
+	(syntoken ".?$"
+	    :switch -1)
+    )
+
+    ;;  Rules for strings.
+    (syntable :string *prop-string* nil
+
+	;;  Ignore escaped characters, this includes \".
+	(syntoken "\\\\.")
+
+	;;  Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;;  Rule to finish a string.
+	(syntoken "\""
+	    :nospec t
+	    :switch -1)
+
+	;;  Don't allow strings continuing in the next line.
+	(syntoken ".?$"
+	    :begin :error)
+    )
+
+    ;;  Rules for quoted strings.
+    (syntable :quoted-string *prop-constant* nil
+
+	;;  Rule to finish the quoted string.
+	(syntoken "\\\""
+	    :nospec t
+	    :switch -1)
+
+	;;  Ignore escaped characters
+	(syntoken "\\\\.")
+
+	;;  Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;;  Don't allow strings continuing in the next line.
+	(syntoken ".?$"
+	    :begin :error)
+    )
+
+    (syntable :error *prop-error* nil
+	(syntoken "^.*$"
+	    :switch -2)
+    )
+)
diff --git a/lisp/modules/progmodes/lisp.lsp b/lisp/modules/progmodes/lisp.lsp
new file mode 100644
index 0000000..ebf2c10
--- /dev/null
+++ b/lisp/modules/progmodes/lisp.lsp
@@ -0,0 +1,384 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/lisp.lsp,v 1.9 2003/01/30 02:46:26 paulo Exp $
+;;
+
+(require "syntax")
+(require "indent")
+(in-package "XEDIT")
+
+(defsynprop *prop-special*
+  "special"
+  :font		"*courier-bold-r*12*"
+  :foreground	"NavyBlue"
+)
+
+(defsynprop *prop-quote*
+  "quote"
+  :font		"*courier-bold-r*12*"
+  :foreground	"Red3"
+)
+
+(defsynprop *prop-package*
+  "package"
+  :font		"*lucidatypewriter-medium-r*12*"
+  :foreground	"Gold4"
+)
+
+(defsynprop *prop-unreadable*
+  "unreadable"
+  :font		"*courier-medium-r*12*"
+  :foreground	"Gray25"
+  :underline	t
+)
+
+(defsynoptions *lisp-DEFAULT-style*
+  ;; Positive number. Basic indentation.
+  (:indentation			.	2)
+
+  ;; Boolean. Move cursor to the indent column after pressing <Enter>?
+  (:newline-indent		.	t)
+
+  ;; Boolean. Use spaces instead of tabs to fill indentation?
+  (:emulate-tabs		.	nil)
+
+  ;; Boolean. Remove extra spaces from previous line.
+  ;;		This should default to T when newline-indent is not NIL.
+  (:trim-blank-lines		.	t)
+
+  ;; Boolean. If this hash-table entry is set, no indentation is done.
+  ;;		Useful to temporarily disable indentation.
+  (:disable-indent		.	nil)
+)
+
+(defvar *lisp-mode-options* *lisp-DEFAULT-style*)
+
+(defindent *lisp-mode-indent* :main
+  ;; this must be the first token
+  (indtoken "^\\s*"		:indent
+    :code (or *offset* (setq *offset* (+ *ind-offset* *ind-length*))))
+  ;; ignore single line comments
+  (indtoken ";.*$"		nil)
+  ;; multiline comments
+  (indtoken "|#"		:comment	:nospec t	:begin :comment)
+  ;; characters
+  (indtoken "#\\\\(\\W|\\w+(-\\w+)?)"		:character)
+  ;; numbers
+  (indtoken
+    (string-concat
+      "(\\<|[+-])\\d+("
+      ;; integers
+      "(\\>|\\.(\\s|$))|"
+      ;; ratios
+      "/\\d+\\>|"
+      ;;floats
+      "\\.?\\d*([SsFfDdLlEe][+-]?\\d+)?\\>"
+      ")")
+    :number)
+  ;; symbols, with optional package
+  (indtoken
+    (string-concat
+      ;; optional package name and ending ':'
+      "([A-Za-z_0-9%-]+:)?"
+      ;; internal symbol if after package name, or keyword
+      ":?"
+      ;; symbol name
+      "[][{}A-Za-z_0-9!$%&/<=>^~*+-]+")
+    :symbol)
+  ;; strings in the same line
+  (indtoken "\"([^\\\"]|\\\\.)*\""		:string)
+  ;; multiline strings
+  (indtoken "\""		:cstring	:nospec t	:begin :string)
+  ;; "quoted" symbols in the same line
+  (indtoken "\\|([^\\|]|\\\\.)*\\|"		:symbol)
+  ;; multiline
+  (indtoken "|"			:csymbol	:nospec t	:begin :symbol)
+  (indtoken "#"			:hash		:nospec t)
+
+  (indinit	(parens 0))
+  (indtoken "("			:oparen		:nospec t :code (incf parens))
+  (indtoken ")"			:cparen		:nospec t :code (decf parens))
+
+  (indtable :comment
+    ;; multiline comments can nest
+    (indtoken "|#"		nil		:nospec t	:begin :comment)
+    (indtoken "#|"		nil		:nospec t	:switch -1))
+
+  (indtable :string
+    ;; Ignore escaped characters
+    (indtoken "\\." 		nil)
+    ;; Return to the toplevel when the start of the string is found
+    (indtoken "\""		:ostring	:nospec t	:switch -1))
+
+  (indtable :symbol
+    ;; Ignore escaped characters
+    (indtoken "\\." 		nil)
+    ;; Return to the toplevel when the start of the symbol is found
+    (indtoken "|"		:osymbol	:nospec t	:switch -1))
+
+  ;; ignore comments
+  (indreduce nil
+    t
+    ((:comment)))
+
+  ;; reduce multiline strings
+  (indreduce :string
+    t
+    ((:ostring (not :ostring) :cstring)))
+
+  ;; reduce multiline symbols
+  (indreduce :symbol
+    t
+    ((:osymbol (not :osymbol) :csymbol)))
+
+  ;; reduce basic types, don't care if inside list or not
+  (indreduce :element
+    t
+    ((:number)
+      (:string)
+      (:character)
+      (:element :element)
+      (:indent :element)))
+
+  (indreduce :symbol
+    t
+    ((:symbol :symbol)
+      (:symbol :element)
+      (:indent :symbol)))
+
+  ;; the "real" indentation value, to make easier parsing code like:
+  ;;  (foo (bar (baz (blah
+  ;;        ^         ^
+  ;;        |         |
+  ;;        indent    |
+  ;;                  effective indentation to be used
+  (indinit	(indent 0))
+
+  ;; indentation values of opening parenthesis.
+  (indinit	stack)
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; if before current line and open parenthesis >= 0, use indentation
+  ;; of current line to calculate relative indentation.
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  (indreduce :oparen	;; simple list?
+    (and (>= parens 0) (< *ind-offset* *ind-start*))
+    ((:indent :oparen))
+    (setq
+      *indent*	(offset-indentation (+ *ind-offset* *ind-length*) :resolve t)
+      indent	*indent*)
+    (indent-macro-reject-left))
+
+  ;; reduce list if there isn't indentation change
+  (indreduce :element
+    t
+    ((:oparen (not :oparen) :cparen)))
+
+  (indresolve :oparen
+    (setq
+      *indent*
+      (offset-indentation
+	(+ *ind-offset* *ind-length* -1 *base-indent*) :align t))
+    (push *indent* stack)
+    (incf indent *base-indent*)
+    (if (< *indent* indent) (setq *indent* indent)))
+
+  (indresolve :cparen
+    (decf indent *base-indent*)
+    (setq *indent* (pop stack))
+    (if (null stack)
+      (setq *indent* indent)
+      (setq *indent* (car stack))))
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Find a "good" offset to start parsing backwards, so that it should
+;; always generate the same results.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun lisp-offset-indent (&aux char (point (scan (point) :eol :left)))
+  ;; skip spaces
+  (while (member (setq char (char-after point)) indent-spaces)
+    (incf point))
+  (if (member char '(#\))) (1+ point) point))
+
+(defun lisp-should-indent (options &aux char point start)
+  (when (hash-table-p options)
+    ;; check if previous line has extra spaces
+    (and (gethash :trim-blank-lines options)
+      (indent-clear-empty-line))
+
+    ;; indentation disabled?
+    (and (gethash :disable-indent options)
+      (return-from lisp-should-indent))
+
+    (setq
+      point	(point)
+      char	(char-before (point))
+      start	(scan point :eol :left))
+
+    ;; at the start of a line
+    (and (= point start)
+      (return-from lisp-should-indent (gethash :newline-indent options)))
+
+    ;; if first character
+    (and (= point (1+ start)) (return-from lisp-should-indent t))
+
+    ;; if closing parenthesis and first nonblank char
+    (when (and (characterp char) (char= char #\)))
+      (decf point)
+      (while
+	(and (> point start) (member (char-before point) indent-spaces))
+	(decf point))
+      (return-from lisp-should-indent (<= point start)))
+  )
+  ;; should not indent
+  nil)
+
+(defun lisp-indent (syntax syntable)
+  (let*
+    ((options (syntax-options syntax))
+      *base-indent*)
+
+    (or (lisp-should-indent options) (return-from lisp-indent))
+
+    (setq *base-indent* (gethash :indentation options 2))
+
+    (indent-macro
+      *lisp-mode-indent*
+      (lisp-offset-indent)
+      (gethash :emulate-tabs options))))
+
+(compile 'lisp-indent)
+
+(defsyntax *lisp-mode* :main nil #'lisp-indent *lisp-mode-options*
+  ;; highlight car and parenthesis
+  (syntoken "\\(+\\s*[][{}A-Za-z_0-9!$%&/<=>?^~*:+-]*\\)*"
+    :property *prop-keyword*)
+  (syntoken "\\)+" :property *prop-keyword*)
+
+  ;; nil and t
+  (syntoken "\\<(nil|t)\\>" :icase t :property *prop-special*)
+
+  (syntoken "|" :nospec t :begin :unreadable :contained t)
+
+  ;; keywords
+  (syntoken ":[][{}A-Za-z_0-9!$%&/<=>^~+-]+" :property *prop-constant*)
+
+  ;; special symbol.
+  (syntoken "\\*[][{}A-Za-z_0-9!$%&7=?^~+-]+\\*"
+    :property *prop-special*)
+
+  ;; special identifiers
+  (syntoken "&(aux|key|optional|rest)\\>" :icase t :property *prop-constant*)
+
+  ;; numbers
+  (syntoken
+    ;; since lisp is very liberal in what can be a symbol, this pattern
+    ;; will not always work as expected, since \< and \> will not properly
+    ;; work for all characters that may be in a symbol name
+    (string-concat
+      "(\\<|[+-])\\d+("
+      ;; integers
+      "(\\>|\\.(\\s|$))|"
+      ;; ratios
+      "/\\d+\\>|"
+      ;;floats
+      "\\.?\\d*([SsFfDdLlEe][+-]?\\d+)?\\>"
+      ")")
+    :property *prop-number*)
+
+  ;; characters
+  (syntoken "#\\\\(\\W|\\w+(-\\w+)?)" :property *prop-constant*)
+
+  ;; quotes
+  (syntoken "[`'.]|,@?" :property *prop-quote*)
+
+  ;; package names
+  (syntoken "[A-Za-z_0-9%-]+::?" :property *prop-package*)
+
+  ;; read time evaluation
+  (syntoken "#\\d+#" :property *prop-preprocessor*)
+  (syntoken "#([+'cCsS-]|\\d+[aA=])?" :begin :preprocessor :contained t)
+
+  (syntoken "\\c" :property *prop-control*)
+
+  ;; symbols, do nothing, just resolve conflicting matches
+  (syntoken "[][{}A-Za-z_0-9!$%&/<=>^~*+-]+")
+
+  (syntable :simple-comment *prop-comment* nil
+    (syntoken "$" :switch -1)
+    (syntoken "XXX|FIXME|TODO" :property *prop-annotation*))
+
+  (syntable :comment *prop-comment* nil
+    ;; comments can nest
+    (syntoken "#|" :nospec t :begin :comment)
+    ;;  return to previous state
+    (syntoken "|#" :nospec t :switch -1)
+    (syntoken "XXX|FIXME|TODO" :property *prop-annotation*))
+
+  (syntable :unreadable *prop-unreadable* nil
+    ;; ignore escaped characters
+    (syntoken "\\\\.")
+    (syntoken "|" :nospec t :switch -1))
+
+  (syntable :string *prop-string* nil
+    ;; ignore escaped characters
+    (syntoken "\\\\.")
+    (syntoken "\"" :nospec t :switch -1))
+
+  (syntable :preprocessor *prop-preprocessor* nil
+    ;; a symbol
+    (syntoken "[][{}A-Za-z_0-9!$%&/<=>^~:*+-]+" :switch -1)
+
+    ;; conditional expression
+    (syntoken "(" :nospec t :begin :preprocessor-expression :contained t)
+
+    (syntable :preprocessor-expression *prop-preprocessor* nil
+      ;; recursive
+      (syntoken "(" :nospec t :begin :preprocessor-recursive :contained t)
+      (syntoken ")" :nospec t :switch -2)
+
+      (syntable :preprocessor-recursive *prop-preprocessor* nil
+	(syntoken "(" :nospec t
+	  :begin :preprocessor-recursive
+	  :contained t)
+	(syntoken ")" :nospec t :switch -1)
+	(synaugment :comments-and-strings))
+      (synaugment :comments-and-strings))
+    (synaugment :comments-and-strings))
+
+  (syntable :comments-and-strings nil nil
+    (syntoken "\"" :nospec t :begin :string :contained t)
+    (syntoken "#|" :nospec t :begin :comment :contained t)
+    (syntoken ";" :begin :simple-comment :contained t))
+
+  (synaugment :comments-and-strings)
+)
diff --git a/lisp/modules/progmodes/make.lsp b/lisp/modules/progmodes/make.lsp
new file mode 100644
index 0000000..d5cbc00
--- /dev/null
+++ b/lisp/modules/progmodes/make.lsp
@@ -0,0 +1,135 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/make.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-shell*
+    "shell"
+    :font	"*courier-bold-r*12*"
+    :foreground	"Red4"
+)
+
+(defsynprop *prop-variable*
+    "variable"
+    :font	"*courier-medium-r*12*"
+    :foreground	"Red3"
+)
+
+;;  The syntax-highlight definition does not try to flag errors, just show
+;; tabs in the start of lines for better visualization.
+(defsynprop *prop-tabulation*
+    "tabulation"
+    :font	"*courier-medium-r*12*"
+    :background	"Gray90"
+)
+
+
+(defsyntax *make-mode* :main nil nil nil
+    (syntoken "^\\t+" :property *prop-tabulation*)
+
+    (syntoken "^\\.\\w+" :property *prop-keyword*)
+
+    (syntoken "$("
+	:nospec t
+	:begin :shell
+	:property *prop-shell*)
+
+    (syntoken "[][(){};$<=>&@/\\,.:~!|*?'`+-]"
+	:property *prop-shell*)
+
+    ;;  Preprocessor start rule.
+    (syntoken "#.*"
+	:property *prop-comment*)
+
+    ;;  String start rule.
+    (syntoken "\""
+	:begin :string
+	:nospec t
+	:contained t)
+
+    ;;  Quoted string start rule.
+    (syntoken "\\\""
+	:begin :quoted-string
+	:nospec t
+	:contained t)
+
+    (syntable :shell *prop-variable* nil
+	(syntoken ")"
+	    :nospec t
+	    :property *prop-shell*
+	    :switch -1)
+    )
+
+    ;;  Rules for strings.
+    (syntable :string *prop-string* nil
+
+	;;  Ignore escaped characters, this includes \".
+	(syntoken "\\\\.")
+
+	;;  Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;;  Rule to finish a string.
+	(syntoken "\""
+	    :nospec t
+	    :switch -1)
+
+	;;  Don't allow strings continuing in the next line.
+	(syntoken ".?$"
+	    :begin :error)
+    )
+
+    ;;  Rules for quoted strings.
+    (syntable :quoted-string *prop-constant* nil
+
+	;;  Rule to finish the quoted string.
+	(syntoken "\\\""
+	    :nospec t
+	    :switch -1)
+
+	;;  Ignore escaped characters
+	(syntoken "\\\\.")
+
+	;;  Ignore continuation in the next line.
+	(syntoken "\\\\$")
+
+	;;  Don't allow strings continuing in the next line.
+	(syntoken ".?$"
+	    :begin :error)
+    )
+
+    (syntable :error *prop-error* nil
+	(syntoken "^.*$"
+	    :switch -2)
+    )
+)
diff --git a/lisp/modules/progmodes/man.lsp b/lisp/modules/progmodes/man.lsp
new file mode 100644
index 0000000..77a59a8
--- /dev/null
+++ b/lisp/modules/progmodes/man.lsp
@@ -0,0 +1,160 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/man.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-man-b*
+    "b"
+    :font	"*courier-bold-r*12*"
+    :foreground	"gray12"
+)
+
+(defsynprop *prop-man-i*
+    "i"
+    :font	"*courier-medium-o*12*"
+    :foreground	"black"
+)
+
+(defsynprop *prop-man-bi*
+    "bi"
+    :font	"*courier-bold-o*12*"
+    :foreground	"gray20"
+)
+
+(defsynprop *prop-man-th*
+    "th"
+    :font	"-*-courier-*-*-*-*-18-*-*-*-*-*-*-1"
+    :foreground	"Red3"
+)
+
+(defsynprop *prop-man-sh*
+    "sh"
+    :font	"-*-courier-*-*-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"OrangeRed3"
+)
+
+(defsynprop *prop-man-ss*
+    "ss"
+    :font	"-*-courier-*-*-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gold4"
+)
+
+(defsynprop *prop-man-escape*
+    "escape"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"RoyalBlue4"
+)
+
+(defsynprop *prop-man-string*
+    "string"
+    :font	"*lucidatypewriter-bold-r*12*"
+    :foreground	"RoyalBlue3"
+;    :underline	t
+)
+
+(defmacro man-syntoken (pattern)
+    `(syntoken (string-concat "^\\.(" ,pattern ")(\\s+|$)")
+	:icase t
+;	:contained t
+	:property *prop-preprocessor*
+	:begin (intern (string ,pattern) 'keyword)))
+
+(defmacro man-syntable (pattern property)
+    `(syntable (intern (string ,pattern) 'keyword) ,property nil
+	(syntoken "$" :switch -1)
+	(synaugment :extras)))
+
+
+(defsyntax *man-mode* :main nil nil nil
+    (syntoken "^\\.\\\\\".*"
+	:property *prop-comment*)
+
+    (man-syntoken "b|br|nm")
+    (man-syntable "b|br|nm" *prop-man-b*)
+
+    (man-syntoken "i|ir|ri|ip")
+    (man-syntable "i|ir|ri|ip" *prop-man-i*)
+
+    (man-syntoken "th|dt")
+    (man-syntable "th|dt" *prop-man-th*)
+
+    (man-syntoken "sh")
+    (man-syntable "sh" *prop-man-sh*)
+
+    (man-syntoken "ss")
+    (man-syntable "ss" *prop-man-ss*)
+
+    (man-syntoken "bi")
+    (man-syntable "bi" *prop-man-bi*)
+
+    ;; Anything not matched...
+    (syntoken "^\\.[a-z][a-z](\\s+|$)"
+	:icase t
+	:property *prop-preprocessor*)
+
+    (syntable :extras nil nil
+	(syntoken "\\<__\\l+__\\>"
+	    :property *prop-constant*)
+	(syntoken "\\\\fB"
+	    :property *prop-preprocessor*
+	    :begin :b)
+	(syntoken "\\\\fI"
+	    :property *prop-preprocessor*
+	    :begin :i)
+	(syntoken "\\\\f\\u"
+	    :property *prop-preprocessor*)
+
+	(syntoken "\\\\\\*?."
+	    :property *prop-man-escape*)
+
+	(syntoken "\""
+	    :property *prop-man-string*)
+
+	(syntable :i *prop-man-i* nil
+	    (syntoken "$"
+		:switch :main)
+	    (syntoken "\\\\f\\u"
+		:property *prop-preprocessor*
+		:switch -1)
+	)
+	(syntable :b *prop-man-b* nil
+	    (syntoken "$"
+		:switch :main)
+	    (syntoken "\\\\f\\u"
+		:property *prop-preprocessor*
+		:switch -1)
+	)
+    )
+
+    (synaugment :extras)
+)
diff --git a/lisp/modules/progmodes/rpm.lsp b/lisp/modules/progmodes/rpm.lsp
new file mode 100644
index 0000000..bd0cc6c
--- /dev/null
+++ b/lisp/modules/progmodes/rpm.lsp
@@ -0,0 +1,166 @@
+;;
+;; Copyright (c) 2003 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/rpm.lsp,v 1.1 2003/01/16 03:50:46 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+;; Only for testing, unifinished, good for viewing but too slow for real use...
+#|
+(defsynprop *prop-rpm-special*
+    "rpm-special"
+    :font	"*courier-bold-r*12*"
+    :foreground	"NavyBlue"
+)
+
+(defsynprop *prop-rpm-escape*
+    "rpm-escape"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"Red3")
+
+;; main package is implicit
+(defsyntax *rpm-mode* :package nil nil nil
+    (syntable :sections nil nil
+	(syntoken "^%package"
+	    :icase t
+	    :switch :package
+	    ;; XXX :begin :package was added just to test finishing and
+	    ;; starting a new syntax-table, unfortunately if using it
+	    ;; this way, frequently the entire file will be reparsed
+	    ;; at every character typed.
+	    ;; TODO study these cases and implement code to avoid it,
+	    ;; the easiest way is limiting the number of backtracked lines,
+	    ;; the screen contents sometimes could not correctly reflect
+	    ;; file contents in this case...
+	    :begin :package
+	    :property *prop-rpm-special*)
+	(syntoken "^%(build|setup|install|pre|preun|post|postun)\\>"
+	    :icase t
+	    :property *prop-rpm-special*
+	    :switch :package
+	    :begin :shell)
+	;; %changelog, XXX no rules to return to the toplevel
+	(syntoken "^%changelog\\>"
+	    :icase t
+	    :switch :package
+	    :begin :changelog
+	    :property *prop-rpm-special*)
+	(syntable :changelog nil nil
+	    ;; ignore if escaped
+	    (syntoken "%%")
+	    ;; "warn" if not escaped
+	    (syntoken "%" :property *prop-control*)
+	    ;; emails
+	    (syntoken "<[a-z0-9_-]+@[a-z0-9_-]+\\.\\w+(\\.\\w+)?>"
+		:icase t
+		:property *prop-string*)
+	)
+	;; comments
+	(syntoken "#" :contained t :nospec t :begin :comment)
+	(syntable :comment *prop-comment* nil
+	    ;; some macros are expanded even when inside comments, and may
+	    ;; cause surprises, "warn" about it
+	    (syntoken "%\\{?\\w+\\}?" :property *prop-rpm-special*)
+	    (syntoken "$" :switch -1)
+	)
+	(synaugment :global)
+    )
+
+    ;; may appear anywhere
+    (syntable :global nil nil
+	;; preprocessor like commands
+	(syntoken "^%(define|if|ifarch|else|endif)\\>"
+	    :icase t
+	    :property *prop-preprocessor*)
+	;; variables
+	(syntoken "%\\{.*\\}" :property *prop-constant*)
+    )
+
+    ;; example: "Group: ..." or "Group(pt_BR): ..."
+    (syntoken "^\\w+(\\(\\w+\\))?:" :property *prop-keyword*)
+
+    ;; for sections with shell commands
+    (syntable :shell nil nil
+	(syntoken "\\<(if|then|elif|else|fi|for|do|done|case|esac|while|until)\\>"
+	    :property *prop-keyword*)
+	(syntable :strings nil nil
+	    (syntoken "\"" :nospec t :begin :string :contained t)
+	    (syntable :string *prop-string* nil
+		(syntoken "\\$\\(?\\w+\\)?" :property *prop-constant*)
+		(syntoken "\\\\.")
+		(syntoken "\"" :nospec t :switch -1)
+	    )
+	    (syntoken "\'" :nospec t :begin :constant :contained t)
+	    (syntable :constant *prop-constant* nil
+		(syntoken "\\\\.")
+		(syntoken "\'" :nospec t :switch -1)
+	    )
+	    (syntoken "\`" :nospec t :begin :escape :contained t)
+	    (syntable :escape *prop-rpm-escape* nil
+		(syntoken "\\$\\(?\\w+\\)?" :property *prop-constant*)
+		(syntoken "\\\\.")
+		(syntoken "\`" :nospec t :switch -1)
+	    )
+	)
+	(synaugment :strings :sections)
+    )
+    (synaugment :sections)
+)
+|#
+
+
+(defsyntax *rpm-mode* :package nil nil nil
+    ;; commands, macro definitions, etc
+    (syntoken "^\\s*%\\s*\\w+" :property *prop-keyword*)
+
+    ;; rpm "variables"
+    (syntoken "%\\{.*\\}" :property *prop-constant*)
+
+    ;; package info, example: "Group: ...", "Group(pt_BR): ...", etc.
+    (syntoken "^\\w+(\\(\\w+\\))?:" :property *prop-preprocessor*)
+
+    ;; comments
+    (syntoken "#" :contained t :nospec t :begin :comment)
+    (syntable :comment *prop-comment* nil
+	;; some macros are expanded even when inside comments, and may
+	;; cause surprises, "warn" about it
+	(syntoken "%define\\>" :property *prop-control*)
+	(syntoken "%\\{?\\w+\\}?" :property *prop-string*)
+	(syntoken "$" :switch -1)
+    )
+
+    ;; emails
+    (syntoken "<?[a-z0-9_-]+@[a-z0-9_-]+\\.\\w+(\\.\\w+)*>?"
+	:icase t
+	:property *prop-string*)
+    ;; links
+    (syntoken "\\<(http|ftp)://\\S+" :property *prop-string*)
+)
diff --git a/lisp/modules/progmodes/sgml.lsp b/lisp/modules/progmodes/sgml.lsp
new file mode 100644
index 0000000..511aae5
--- /dev/null
+++ b/lisp/modules/progmodes/sgml.lsp
@@ -0,0 +1,428 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/sgml.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+;; Default property the text is shown.
+(defsynprop *prop-sgml-default*
+    "default"
+    :font	"-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gray10"
+)
+
+(defsynprop *prop-sgml-default-short*
+    "default-short"
+    :font	"-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gray10"
+    :underline	t
+)
+
+;; Large font.
+(defsynprop *prop-sgml-sect*
+    "sect"
+    :font	"-*-helvetica-bold-r-*-*-17-*-*-*-*-*-*-1"
+    :foreground	"Gray20"
+)
+
+;; Monospaced property.
+(defsynprop *prop-sgml-tt*
+    "tt"
+    :font	"-*-courier-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Black"
+)
+
+;; Italic property.
+(defsynprop *prop-sgml-it*
+    "it"
+    :font	"-*-helvetica-medium-o-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Black"
+)
+
+;; Bold font property.
+(defsynprop *prop-sgml-bf*
+    "bf"
+    :font	"-*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"Gray10"
+)
+
+;; Looks like a link...
+(defsynprop *prop-sgml-link*
+    "link"
+    :font	"-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"blue"
+    :underline	t
+)
+
+;; Monospaced, also looks like a link...
+(defsynprop *prop-sgml-email*
+    "email"
+    :font	"-*-courier-medium-r-*-*-12-*-*-*-*-*-*-1"
+    :foreground	"blue"
+    :underline	t
+)
+
+;; Another monospaced property,
+(defsynprop *prop-sgml-screen*
+    "screen"
+    :font	"-*-fixed-*-*-*-*-*-*-*-*-*-*-*-1"
+    :foreground	"Gray10"
+)
+
+(defsynprop *prop-sgml-maybe-entity*
+    "maybe-entity"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"VioletRed4"
+    :background	"LightYellow"
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  The macros sgml-syntoken and sgml-syntable allows creating rules for
+;; matching text inside tags in the format:
+;;	<tag> or <tag arg=value> or <tag arg1=value ... argn=value>
+;;		any-text
+;;	</tag>
+;;  The generated rules don't allow things like: < tag> or </tag >
+;;
+;;  This could also be done as a normal definition, with a starting rule like:
+;;	"<(tag1|tag2|tag3)\\>"
+;; and an ending rule like:
+;;	"</(tag1|tag2|tag3)>"
+;;  But is implemented in way that will fail on purpose for things like:
+;;	<tag1>any text</tag3></tag1>
+;;
+;; NOTE: These definitions aren't cheap in the time required to process the
+;;	file, and are just adaptations/tests with the syntax-highlight code,
+;;	probably it is better to avoid using it in other syntax definitions.
+;; NOTE2: It cannot be defined as a single macro because it is required to
+;;	  generate 2 entries in the main SGML syntax highlight definition,
+;;	  or, should generate the entire definition from a macro; you will
+;;	  need to type the tag name twice, but shouldn't be a problem if
+;;	  you are using sgml :-)
+;; XXX: Maybe the syntax-highlight code could save the starting match and
+;;	apply a regex generated at run-time to check for the ending tag,
+;;	but this probably would make the parser too slow, better to have
+;;	a specialized parser if that is required...
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro sgml-syntoken (name)
+    `(syntoken (string-concat "<" ,name "\\>")
+	:icase t
+	:contained t
+	:begin (intern (string-concat ,name "$") 'keyword))
+)
+(defmacro sgml-syntable (name property)
+    `(let
+	(
+	(label (intern (string-concat ,name "$") 'keyword))
+	(nested-label (intern (string (gensym)) 'keyword))
+	)
+	(syntable label *prop-preprocessor* nil
+	    ;; tag is still open, process any options
+	    (synaugment :generic-tag)
+	    (syntoken ">"
+		:nospec t
+		:property *prop-preprocessor*
+		:begin nested-label)
+	    ;;	Generate a nested table that includes everything, and only
+	    ;; returns when the closing tag is found.
+	    (syntable nested-label ,property nil
+		(syntoken (string-concat "</" ,name ">")
+		    :icase t
+		    :nospec t
+		    :property *prop-preprocessor*
+		    :switch -2)
+		(synaugment :main)
+	    )
+	)
+    )
+)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Generate tokens for tags that don't require and ending tag.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro sgml-syntable-simple (name property)
+    `(let
+	(
+	(label (intern (string-concat ,name "$") 'keyword))
+	(nested-label (intern (string (gensym)) 'keyword))
+	)
+	(syntable label *prop-preprocessor* nil
+	    ;; tag is still open, process any options
+	    (synaugment :generic-tag)
+	    (syntoken ">"
+		:nospec t
+		:property *prop-preprocessor*
+		:begin nested-label)
+	    ;;	Generate a nested table that finishes whenever an unmatched
+	    ;; start or end tag is found.
+	    (syntable nested-label ,property nil
+		(syntoken "</"
+		    :icase t
+		    :nospec t
+		    :contained t
+		    :begin :simple-nested-tag)
+		;;  These will take precedence over other rules
+		(syntoken "<"
+		    :icase t
+		    :nospec t
+		    :contained t
+		    :begin :simple-nested-tag)
+		(syntoken "<p>"
+		    :icase t
+		    :nospec t
+		    :property *prop-preprocessor*
+		    :switch :main)
+		(synaugment :main)
+	    )
+	)
+    )
+)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Define some macros to generate tokens for tags in the format:
+;;	<tag/  ... /
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro sgml-syntoken-short (name)
+    `(syntoken (string-concat "<" ,name "/")
+	:icase t
+	:property *prop-preprocessor*
+	:begin (intern (string-concat ,name "/") 'keyword))
+)
+(defmacro sgml-syntable-short (name property)
+    `(syntable (intern (string-concat ,name "/") 'keyword) ,property nil
+	(syntoken "/"
+	    :nospec t
+	    :property *prop-preprocessor*
+	    :switch -1)
+	(syntoken "</?\\w+>"
+	    :property *prop-control*
+	    :switch :main)
+    )
+)
+
+
+;; The main SGML syntax table
+(defsyntax *sgml-mode* :main *prop-sgml-default* nil nil
+    ;; Comments
+    (syntoken "<!--"
+	:nospec t
+	:contained t
+	:begin :comment)
+    (syntable :comment *prop-comment* nil
+	;; Only one rule, to finish the comment.
+	(syntoken "-->"
+	    :nospec t
+	    :switch -1)
+    )
+
+    ;; Entities
+    (syntoken "&[a-zA-Z0-9_.-]+;"
+	:property *prop-constant*)
+    ;; Probably an entity, missing ending `;'
+    (syntoken "&[a-zA-Z0-9_.-]+"
+	:property *prop-sgml-maybe-entity*)
+
+    ;; Strings
+    (syntable :string *prop-string* nil
+	;;  Ignore escaped characters.
+	(syntoken "\\\\.")
+	;;  Rule to finish the string.
+	(syntoken "\""
+	    :nospec t
+	    :switch -1)
+    )
+
+    ;; Links
+    (syntable :link *prop-preprocessor* nil
+	;; No link string following "url="
+	(syntoken ">"
+	    :nospec t
+	    :property *prop-control*
+	    :switch -1)
+	(syntoken "\""
+	    :nospec t
+	    :contained t
+	    :begin :link-string)
+	(syntable :link-string *prop-sgml-link* nil
+	    ;; Ignore escaped characters.
+	    (syntoken "\\\\.")
+	    ;; Rule to finish the link, note that returns two levels.
+	    (syntoken "\""
+		:nospec t
+		:switch -2)
+	)
+    )
+
+    ;; "Special" tag
+    (syntoken "<!"
+	:nospec t
+	:contained t
+	:begin :special-tag)
+    ;;  Rules for "special" tags
+    (syntable :special-tag *prop-preprocessor* nil
+	(syntoken "["
+	    :nospec t
+	    :property *prop-preprocessor*
+	    :begin :brackets)
+	;; Finish the "special" tag
+	(syntoken ">"
+	    :nospec t
+	    :switch -1)
+	(syntable :brackets *prop-sgml-default* nil
+	    (syntoken "]"
+		:nospec t
+		:property *prop-preprocessor*
+		:switch -1)
+	    ;; Allow nesting.
+	    (syntoken "["
+		:nospec t
+		:property *prop-preprocessor*
+		:begin :brackets)
+	    ;; Entities.
+	    (syntoken "%[a-zA-Z0-9_.-]+;?"
+		:property *prop-annotation*)
+	    ;;  Allow everything inside the brackets
+	    (synaugment :main)
+	)
+	;; Don't use generic tag tokens, only create a rule for strings
+	(syntoken "\""
+	    :nospec t
+	    :begin :string
+	    :contained t)
+	;; Allow everything inside the "special" tag
+	(synaugment :main)
+    )
+
+    ;; Some "short" tags
+    (sgml-syntoken-short "tt")
+    (sgml-syntable-short "tt" *prop-sgml-tt*)
+    (sgml-syntoken-short "it")
+    (sgml-syntable-short "it" *prop-sgml-it*)
+    (sgml-syntoken-short "bf")
+    (sgml-syntable-short "bf" *prop-sgml-bf*)
+    (sgml-syntoken-short "em")
+    (sgml-syntable-short "em" *prop-sgml-bf*)
+
+    ;; Short tag
+    (syntoken "<\\w+/"
+	:property *prop-preprocessor*
+	:begin :short-tag)
+    (syntable :short-tag *prop-sgml-default-short* nil
+	(syntoken "/"
+	    :nospec t
+	    :property *prop-preprocessor*
+	    :switch -1)
+	(syntoken "</?\\w+>"
+	    :property *prop-control*
+	    :switch -1)
+    )
+
+    ;;  Don't allow spaces, this may and may not be the start of a tag,
+    ;; but the syntax-highlight definition is not specialized...
+    (syntoken "<([^/a-zA-Z]|$)"
+	:property *prop-control*)
+
+    ;; Some tags that require an end tag
+    (sgml-syntoken "tt")
+    (sgml-syntable "tt" *prop-sgml-tt*)
+    (sgml-syntoken "code")
+    (sgml-syntable "code" *prop-sgml-tt*)
+    (sgml-syntoken "tag")
+    (sgml-syntable "tag" *prop-sgml-tt*)
+    (sgml-syntoken "verb")
+    (sgml-syntable "verb" *prop-sgml-tt*)
+    (sgml-syntoken "programlisting")
+    (sgml-syntable "programlisting" *prop-sgml-tt*)
+    (sgml-syntoken "it")
+    (sgml-syntable "it" *prop-sgml-it*)
+    (sgml-syntoken "bf")
+    (sgml-syntable "bf" *prop-sgml-bf*)
+    (sgml-syntoken "em")
+    (sgml-syntable "em" *prop-sgml-bf*)
+    (sgml-syntoken "mail")
+    (sgml-syntable "mail" *prop-sgml-email*)
+    (sgml-syntoken "email")
+    (sgml-syntable "email" *prop-sgml-email*)
+    (sgml-syntoken "screen")
+    (sgml-syntable "screen" *prop-sgml-screen*)
+    (sgml-syntoken "tscreen")
+    (sgml-syntable "tscreen" *prop-sgml-screen*)
+
+
+    ;;  Helper for tags that don't need an ending one.
+    ;;  NOTE: Since the parser is not specialized, if the tag is
+    ;;	      folowed by one that has a special property defined here,
+    ;;	      it may not be detected, i.e. put a <p> after the <sect>
+    ;;	      and it will work.
+    (syntable :simple-nested-tag *prop-preprocessor* nil
+	;; tag is still open, process any options
+	(synaugment :generic-tag)
+	(syntoken ">"
+	    :nospec t
+	    :property *prop-preprocessor*
+	    :switch -3)
+    )
+    (sgml-syntoken "sect")
+    (sgml-syntable-simple "sect" *prop-sgml-sect*)
+    (sgml-syntoken "sect1")
+    (sgml-syntable-simple "sect1" *prop-sgml-sect*)
+    (sgml-syntoken "sect2")
+    (sgml-syntable-simple "sect2" *prop-sgml-sect*)
+
+    ;; Generic tags
+    (syntoken "<"
+	:nospec t
+	:contained t
+	:begin :tag)
+    ;; Table :generic-tag is defined to be augmented, no rule to finish it.
+    (syntable :generic-tag *prop-preprocessor* nil
+	;; Start string
+	(syntoken "\""
+	    :nospec t
+	    :begin :string
+	    :contained t)
+	;; Start url link
+	(syntoken "url="
+	    :nospec t
+	    :begin :link)
+	;; Cannot nest
+	(syntoken "<"
+	    :nospec t
+	    :property *prop-control*)
+    )
+    (syntable :tag *prop-preprocessor* nil
+	;; Finish the tag
+	(syntoken ">"
+	    :nospec t
+	    :switch -1)
+	;; Import generic definitions
+	(synaugment :generic-tag)
+    )
+)
diff --git a/lisp/modules/progmodes/sh.lsp b/lisp/modules/progmodes/sh.lsp
new file mode 100644
index 0000000..79679ed
--- /dev/null
+++ b/lisp/modules/progmodes/sh.lsp
@@ -0,0 +1,113 @@
+;;
+;; Copyright (c) 2003 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/sh.lsp,v 1.1 2003/01/16 03:50:46 paulo Exp $
+;;
+
+(require "syntax")
+(require "indent")
+(in-package "XEDIT")
+
+(defsynprop *prop-escape*
+    "escape"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"Red3")
+
+(defsynprop *prop-variable*
+    "variable"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"Gold4")
+
+(defsynprop *prop-backslash*
+    "backslash"
+    :font	"*courier-bold-r*12*"
+    :foreground	"green4")
+
+;; XXX it would be interesting if "here-documents" could be parsed
+;; just searching for "<<\s*EOF\\>" and then for "^EOF\\>" should
+;; handle most cases, but would be a hack...
+(defsyntax *sh-mode* :main nil #'default-indent nil
+    ;; keywords and common commands/builtins
+    (syntoken "\\<(if|then|elif|else|fi|case|in|esac|for|do|done|while|until|break|continue|eval|exit|exec|test|echo|cd|shift|local|return)\\>"
+	:property *prop-keyword*)
+
+    ; comments
+    (syntoken "#.*$" :property *prop-comment*)
+
+    ;; punctuation
+    (syntoken "[][;:*?(){}<>&!|$#]+" :property *prop-punctuation*)
+
+    ;; variable declaration
+    (syntoken "\\w+=" :property *prop-preprocessor*)
+
+    ;; numbers
+    (syntoken "\\<\\d+\\>" :property *prop-number*)
+
+    ;; escaped characters at toplevel
+    (syntoken "\\\\." :property *prop-backslash*)
+
+    ;; single quote
+    (syntoken "'" :nospec t :contained t :begin :single)
+    (syntable :single *prop-constant* nil
+	;; do nothing, escaped characters
+	(syntoken "\\\\.")
+	(syntoken "'" :nospec t :switch -1)
+    )
+
+    ;; double quote
+    (syntoken "\"" :nospec t :contained t :begin :double)
+    (syntable :double *prop-string* #'default-indent
+	;; escaped characters
+	(syntoken "\\\\." :property *prop-backslash*)
+	(syntoken "\"" :nospec t :switch -1)
+	;; rule to start escape
+	(syntoken "`" :nospec t :contained t :begin :escape)
+	;; ignore single quote, required because escape is augmented
+	(syntoken "'" :nospec t)
+	(synaugment :escape :variable)
+    )
+
+    ;; escaped commands
+    (syntoken "`" :nospec t :contained t :begin :escape)
+    (syntable :escape *prop-escape* #'default-indent
+	;; escaped characters
+	(syntoken "\\\\." :property *prop-backslash*)
+	(syntoken "`" :nospec t :switch -1)
+	;; rule to start double quote inside escape
+	(syntoken "\"" :nospec t :contained t :begin :double)
+	;; rule to start single quote
+	(syntoken "'" :nospec t :contained t :begin :single)
+	(synaugment :double :variable)
+    )
+
+    (syntable :variable nil nil
+	(syntoken "\\$\\w+" :property *prop-variable*)
+    )
+    (synaugment :variable)
+)
diff --git a/lisp/modules/progmodes/xconf.lsp b/lisp/modules/progmodes/xconf.lsp
new file mode 100644
index 0000000..dea70a2
--- /dev/null
+++ b/lisp/modules/progmodes/xconf.lsp
@@ -0,0 +1,68 @@
+;;
+;; Copyright (c) 2003 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/xconf.lsp,v 1.1 2003/01/16 03:50:46 paulo Exp $
+;;
+
+(require "syntax")
+(require "indent")
+(in-package "XEDIT")
+
+(defsyntax *xconf-mode* :main nil #'default-indent nil
+    ;; section start
+    (syntoken "\\<(Section|SubSection)\\>"
+	:property *prop-keyword* :icase t :begin :section)
+    ;; just for fun, highlight the section name differently
+    (syntable :section *prop-constant* #'default-indent
+	(syntoken "\"" :nospec t :begin :name)
+	(syntable :name *prop-constant* nil
+	    ;; ignore escaped characters
+	    (syntoken "\\\\.")
+	    (syntoken "\"" :nospec t :switch -2)
+	)
+    )
+
+    ;; section end
+    (syntoken "\\<(EndSection|EndSubSection)\\>"
+	:property *prop-keyword* :icase t)
+
+    ;; numeric options
+    (syntoken "\\<\\d+(\\.\\d+)?\\>" :property *prop-number*)
+
+    ;; comments
+    (syntoken "#.*$" :property *prop-comment*)
+
+    ;; strings
+    (syntoken "\"" :nospec t :begin :string :contained t)
+    (syntable :string *prop-string* #'default-indent
+	;; ignore escaped characters
+	(syntoken "\\\\.")
+	(syntoken "\"" :nospec t :switch -1)
+    )
+)
diff --git a/lisp/modules/progmodes/xlog.lsp b/lisp/modules/progmodes/xlog.lsp
new file mode 100644
index 0000000..6bc8b57
--- /dev/null
+++ b/lisp/modules/progmodes/xlog.lsp
@@ -0,0 +1,102 @@
+;;
+;; Copyright (c) 2003 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/xlog.lsp,v 1.1 2003/01/16 06:25:51 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-xlog-probe*
+    "xlog-probe"
+    :font	"*courier-medium-r*12*"
+    :background	"rgb:c/f/c")
+
+(defsynprop *prop-xlog-config*
+    "xlog-config"
+    :font	"*courier-medium-r*12*"
+    :background	"rgb:c/e/f")
+
+(defsynprop *prop-xlog-default*
+    "xlog-default"
+    :font	"*courier-medium-r*12*"
+    :background	"rgb:e/c/f")
+
+(defsynprop *prop-xlog-warning*
+    "xlog-warning"
+    :font	"*courier-bold-r*12*"
+    :foreground	"Red4"
+    :background	"Yellow1"
+)
+
+(defsynprop *prop-xlog-error*
+    "xlog-error"
+    :font	"*courier-bold-r*12*"
+    :foreground	"Yellow2"
+    :background	"Red3"
+)
+
+(defsyntax *xlog-mode* :main nil nil nil
+    ;; highlight version
+    (syntoken "^XFree86 Version \\S+" :property *prop-annotation*)
+
+    ;; release date
+    (syntoken "^Release Date: " :property *prop-keyword* :begin :note)
+
+    ;; highlight operating system description
+    (syntoken "^Build Operating System: " :property *prop-keyword* :begin :note)
+
+    (syntable :note *prop-annotation* nil (syntoken "$" :switch -1))
+
+    ;; don't highlight info lines
+    (syntoken "^\\(II\\) " :property *prop-keyword*)
+
+    ;; default lines
+    (syntoken "^\\(==\\) " :property *prop-keyword* :begin :default)
+    (syntable :default *prop-xlog-default* nil (syntoken "$" :switch -1))
+
+    ;; probe lines
+    (syntoken "^\\(--\\) " :property *prop-keyword* :begin :probe)
+    (syntable :probe *prop-xlog-probe* nil (syntoken "$" :switch -1))
+
+    ;; config lines
+    (syntoken "^\\(\\*\\*\\) " :property *prop-keyword* :begin :config)
+    (syntable :config *prop-xlog-config* nil (syntoken "$" :switch -1))
+
+    ;; warnings
+    (syntoken "^\\(WW\\) " :property *prop-keyword* :begin :warning)
+    (syntable :warning *prop-xlog-warning* nil (syntoken "$" :switch -1))
+
+    ;; errors
+    (syntoken "^\\(EE\\) " :property *prop-keyword* :begin :error)
+    (syntable :error *prop-xlog-error* nil (syntoken "$" :switch -1))
+
+    ;; command line and "uncommon" messages
+    (syntoken "^\\(..\\) " :property *prop-control* :begin :warning)
+)
diff --git a/lisp/modules/progmodes/xrdb.lsp b/lisp/modules/progmodes/xrdb.lsp
new file mode 100644
index 0000000..c0a099c
--- /dev/null
+++ b/lisp/modules/progmodes/xrdb.lsp
@@ -0,0 +1,115 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/progmodes/xrdb.lsp,v 1.2 2002/10/06 17:11:48 paulo Exp $
+;;
+
+(require "syntax")
+(in-package "XEDIT")
+
+(defsynprop *prop-xrdb-comment*
+    "xrdb-comment"
+    :font	"*courier-medium-o*12*"
+    :foreground	"sienna"
+)
+
+(defsynprop *prop-xrdb-special*
+    "format"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"RoyalBlue4"
+)
+
+(defsynprop *prop-xrdb-punctuation*
+    "punctuation"
+    :font	"-*-courier-bold-r-*-*-14-*-*-*-*-*-*-1"
+    :foreground	"OrangeRed4"
+)
+
+(defsyntax *xrdb-mode* :main nil nil nil
+    (syntoken "^\\s*!.*"
+	:property *prop-xrdb-comment*)
+    (syntoken "^\\s*#.*"
+	:property *prop-preprocessor*)
+    (syntoken "\\*|\\.|\\?"
+	:property *prop-xrdb-punctuation*
+	:begin :resource)
+    (syntoken "."
+	:nospec t
+	:begin :resource)
+
+    ;; Extra comments
+    (syntoken "/*" :nospec t :begin :comment :contained t)
+    (syntable :comment *prop-comment* nil
+	(syntoken "/*" :nospec t :property *prop-error*)
+	;;  Rule to finish a comment.
+	(syntoken "*/" :nospec t :switch -1)
+    )
+
+    (syntable :resource nil nil
+	(syntoken "\\*|\\.|\\?" :property *prop-xrdb-punctuation*)
+	(syntoken ":\\s*" :property *prop-xrdb-punctuation* :begin :value)
+    )
+
+    (syntable :value *prop-string* nil
+	(syntoken "\\\\$" :property *prop-constant*)
+
+
+	;; If the pattern ends at a newline, must switch to the previous state.
+	;; Not sure yet how to better handle this. The parser does not detect
+	;; eol because it is a match to the empty string. A possible hack
+	;; would be to check if the pattern string ends in a "$", but probably
+	;; better in this case to have a syntoken option, to tell the parser
+	;; an eol may exist.
+	(syntoken
+	    (string-concat
+		"("
+		"\\d+|"				;; numbers
+		"(#\\x+|rgb:\\x+/\\x+/\\x+)|"	;; color spec
+		"#\\w+"				;; translation table
+		")$")
+	    :property *prop-xrdb-special* :switch -2)
+	(syntoken "(\\\\n?|\")$"
+	    :property *prop-constant* :switch -2)
+
+	;; XXX Cut&paste of the above, only without the match to eol
+	(syntoken
+	    (string-concat
+		"("
+		"\\d+|"
+		"(#\\x+|rgb:\\x+/\\x+/\\x+)|"
+		"#\\w+"
+		")")
+	    :property *prop-xrdb-special*)
+	(syntoken "(\\\\n?|\")"
+	    :property *prop-constant*)
+
+	(syntoken "/*" :nospec t :begin :comment :contained t)
+	(syntoken ".?$" :switch -2)
+    )
+)
diff --git a/lisp/modules/psql.c b/lisp/modules/psql.c
new file mode 100644
index 0000000..6945947
--- /dev/null
+++ b/lisp/modules/psql.c
@@ -0,0 +1,983 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/psql.c,v 1.12 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <libpq-fe.h>
+#undef USE_SSL		/* cannot get it to compile... */
+#include <postgres.h>
+#include <utils/geo_decls.h>
+#include "internal.h"
+#include "private.h"
+
+/*
+ * Prototypes
+ */
+int psqlLoadModule(void);
+
+LispObj *Lisp_PQbackendPID(LispBuiltin*);
+LispObj *Lisp_PQclear(LispBuiltin*);
+LispObj *Lisp_PQconsumeInput(LispBuiltin*);
+LispObj *Lisp_PQdb(LispBuiltin*);
+LispObj *Lisp_PQerrorMessage(LispBuiltin*);
+LispObj *Lisp_PQexec(LispBuiltin*);
+LispObj *Lisp_PQfinish(LispBuiltin*);
+LispObj *Lisp_PQfname(LispBuiltin*);
+LispObj *Lisp_PQfnumber(LispBuiltin*);
+LispObj *Lisp_PQfsize(LispBuiltin*);
+LispObj *Lisp_PQftype(LispBuiltin*);
+LispObj *Lisp_PQgetlength(LispBuiltin*);
+LispObj *Lisp_PQgetvalue(LispBuiltin*);
+LispObj *Lisp_PQhost(LispBuiltin*);
+LispObj *Lisp_PQnfields(LispBuiltin*);
+LispObj *Lisp_PQnotifies(LispBuiltin*);
+LispObj *Lisp_PQntuples(LispBuiltin*);
+LispObj *Lisp_PQoptions(LispBuiltin*);
+LispObj *Lisp_PQpass(LispBuiltin*);
+LispObj *Lisp_PQport(LispBuiltin*);
+LispObj *Lisp_PQresultStatus(LispBuiltin*);
+LispObj *Lisp_PQsetdb(LispBuiltin*);
+LispObj *Lisp_PQsetdbLogin(LispBuiltin*);
+LispObj *Lisp_PQsocket(LispBuiltin*);
+LispObj *Lisp_PQstatus(LispBuiltin*);
+LispObj *Lisp_PQtty(LispBuiltin*);
+LispObj *Lisp_PQuser(LispBuiltin*);
+
+/*
+ * Initialization
+ */
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_PQbackendPID, "pq-backend-pid connection"},
+    {LispFunction, Lisp_PQclear, "pq-clear result"},
+    {LispFunction, Lisp_PQconsumeInput, "pq-consume-input connection"},
+    {LispFunction, Lisp_PQdb, "pq-db connection"},
+    {LispFunction, Lisp_PQerrorMessage, "pq-error-message connection"},
+    {LispFunction, Lisp_PQexec, "pq-exec connection query"},
+    {LispFunction, Lisp_PQfinish, "pq-finish connection"},
+    {LispFunction, Lisp_PQfname, "pq-fname result field-number"},
+    {LispFunction, Lisp_PQfnumber, "pq-fnumber result field-name"},
+    {LispFunction, Lisp_PQfsize, "pq-fsize result field-number"},
+    {LispFunction, Lisp_PQftype, "pq-ftype result field-number"},
+    {LispFunction, Lisp_PQgetlength, "pq-getlength result tupple field-number"},
+    {LispFunction, Lisp_PQgetvalue, "pq-getvalue result tupple field-number &optional type"},
+    {LispFunction, Lisp_PQhost, "pq-host connection"},
+    {LispFunction, Lisp_PQnfields, "pq-nfields result"},
+    {LispFunction, Lisp_PQnotifies, "pq-notifies connection"},
+    {LispFunction, Lisp_PQntuples, "pq-ntuples result"},
+    {LispFunction, Lisp_PQoptions, "pq-options connection"},
+    {LispFunction, Lisp_PQpass, "pq-pass connection"},
+    {LispFunction, Lisp_PQport, "pq-port connection"},
+    {LispFunction, Lisp_PQresultStatus, "pq-result-status result"},
+    {LispFunction, Lisp_PQsetdb, "pq-setdb host port options tty dbname"},
+    {LispFunction, Lisp_PQsetdbLogin, "pq-setdb-login host port options tty dbname login password"},
+    {LispFunction, Lisp_PQsocket, "pq-socket connection"},
+    {LispFunction, Lisp_PQstatus, "pq-status connection"},
+    {LispFunction, Lisp_PQtty, "pq-tty connection"},
+    {LispFunction, Lisp_PQuser, "pq-user connection"},
+};
+
+LispModuleData psqlLispModuleData = {
+    LISP_MODULE_VERSION,
+    psqlLoadModule
+};
+
+static int PGconn_t, PGresult_t;
+
+/*
+ * Implementation
+ */
+int
+psqlLoadModule(void)
+{
+    int i;
+    char *fname = "PSQL-LOAD-MODULE";
+
+    PGconn_t = LispRegisterOpaqueType("PGconn*");
+    PGresult_t = LispRegisterOpaqueType("PGresult*");
+
+    GCDisable();
+    /* NOTE: Implemented just enough to make programming examples
+     * (and my needs) work.
+     * Completing this is an exercise to the reader, or may be implemented
+     * when/if required.
+     */
+    LispExecute("(DEFSTRUCT PG-NOTIFY RELNAME BE-PID)\n"
+		"(DEFSTRUCT PG-POINT X Y)\n"
+		"(DEFSTRUCT PG-BOX HIGH LOW)\n"
+		"(DEFSTRUCT PG-POLYGON SIZE NUM-POINTS BOUNDBOX POINTS)\n");
+
+    /* enum ConnStatusType */
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-OK"),
+			  REAL(CONNECTION_OK), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-BAD"),
+			  REAL(CONNECTION_BAD), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-STARTED"),
+			  REAL(CONNECTION_STARTED), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-MADE"),
+			  REAL(CONNECTION_MADE), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-AWAITING-RESPONSE"),
+			  REAL(CONNECTION_AWAITING_RESPONSE), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-AUTH-OK"),
+			  REAL(CONNECTION_AUTH_OK), fname, 0);
+    (void)LispSetVariable(ATOM2("PG-CONNECTION-SETENV"),
+			  REAL(CONNECTION_SETENV), fname, 0);
+
+
+    /* enum ExecStatusType */
+    (void)LispSetVariable(ATOM2("PGRES-EMPTY-QUERY"),
+			  REAL(PGRES_EMPTY_QUERY), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-COMMAND-OK"),
+			  REAL(PGRES_COMMAND_OK), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-TUPLES-OK"),
+			  REAL(PGRES_TUPLES_OK), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-COPY-OUT"),
+			  REAL(PGRES_COPY_OUT), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-COPY-IN"),
+			  REAL(PGRES_COPY_IN), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-BAD-RESPONSE"),
+			  REAL(PGRES_BAD_RESPONSE), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-NONFATAL-ERROR"),
+			  REAL(PGRES_NONFATAL_ERROR), fname, 0);
+    (void)LispSetVariable(ATOM2("PGRES-FATAL-ERROR"),
+			  REAL(PGRES_FATAL_ERROR), fname, 0);
+    GCEnable();
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+LispObj *
+Lisp_PQbackendPID(LispBuiltin *builtin)
+/*
+ pq-backend-pid connection
+ */
+{
+    int pid;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    pid = PQbackendPID(conn);
+
+    return (INTEGER(pid));
+}
+
+LispObj *
+Lisp_PQclear(LispBuiltin *builtin)
+/*
+ pq-clear result
+ */
+{
+    PGresult *res;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    PQclear(res);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_PQconsumeInput(LispBuiltin *builtin)
+/*
+ pq-consume-input connection
+ */
+{
+    int result;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    result = PQconsumeInput(conn);
+
+    return (INTEGER(result));
+}
+
+LispObj *
+Lisp_PQdb(LispBuiltin *builtin)
+/*
+ pq-db connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQdb(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQerrorMessage(LispBuiltin *builtin)
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQerrorMessage(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQexec(LispBuiltin *builtin)
+/*
+ pq-exec connection query
+ */
+{
+    PGconn *conn;
+    PGresult *res;
+
+    LispObj *connection, *query;
+
+    query = ARGUMENT(1);
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    CHECK_STRING(query);
+    res = PQexec(conn, THESTR(query));
+
+    return (res ? OPAQUE(res, PGresult_t) : NIL);
+}
+
+LispObj *
+Lisp_PQfinish(LispBuiltin *builtin)
+/*
+ pq-finish connection
+ */
+{
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    PQfinish(conn);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_PQfname(LispBuiltin *builtin)
+/*
+ pq-fname result field-number
+ */
+{
+    char *string;
+    int field;
+    PGresult *res;
+
+    LispObj *result, *field_number;
+
+    field_number = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    string = PQfname(res, field);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQfnumber(LispBuiltin *builtin)
+/*
+ pq-fnumber result field-name
+ */
+{
+    int number;
+    int field;
+    PGresult *res;
+
+    LispObj *result, *field_name;
+
+    field_name = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_STRING(field_name);
+    number = PQfnumber(res, THESTR(field_name));
+
+    return (INTEGER(number));
+}
+
+LispObj *
+Lisp_PQfsize(LispBuiltin *builtin)
+/*
+ pq-fsize result field-number
+ */
+{
+    int size, field;
+    PGresult *res;
+
+    LispObj *result, *field_number;
+
+    field_number = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    size = PQfsize(res, field);
+
+    return (INTEGER(size));
+}
+
+LispObj *
+Lisp_PQftype(LispBuiltin *builtin)
+{
+    Oid oid;
+    int field;
+    PGresult *res;
+
+    LispObj *result, *field_number;
+
+    field_number = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    oid = PQftype(res, field);
+
+    return (INTEGER(oid));
+}
+
+LispObj *
+Lisp_PQgetlength(LispBuiltin *builtin)
+/*
+ pq-getlength result tupple field-number
+ */
+{
+    PGresult *res;
+    int tuple, field, length;
+
+    LispObj *result, *otupple, *field_number;
+
+    field_number = ARGUMENT(2);
+    otupple = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(otupple);
+    tuple = FIXNUM_VALUE(otupple);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    length = PQgetlength(res, tuple, field);
+
+    return (INTEGER(length));
+}
+
+LispObj *
+Lisp_PQgetvalue(LispBuiltin *builtin)
+/*
+ pq-getvalue result tuple field &optional type-specifier
+ */
+{
+    char *string;
+    double real = 0.0;
+    PGresult *res;
+    int tuple, field, isint = 0, isreal = 0, integer;
+
+    LispObj *result, *otupple, *field_number, *type;
+
+    type = ARGUMENT(3);
+    field_number = ARGUMENT(2);
+    otupple = ARGUMENT(1);
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    CHECK_INDEX(otupple);
+    tuple = FIXNUM_VALUE(otupple);
+
+    CHECK_INDEX(field_number);
+    field = FIXNUM_VALUE(field_number);
+
+    string = PQgetvalue(res, tuple, field);
+
+    if (type != UNSPEC) {
+	char *typestring;
+
+	CHECK_SYMBOL(type);
+	typestring = ATOMID(type);
+
+	if (strcmp(typestring, "INT16") == 0) {
+	    integer = *(short*)string;
+	    isint = 1;
+	    goto simple_type;
+	}
+	else if (strcmp(typestring, "INT32") == 0) {
+	    integer = *(int*)string;
+	    isint = 1;
+	    goto simple_type;
+	}
+	else if (strcmp(typestring, "FLOAT") == 0) {
+	    real = *(float*)string;
+	    isreal = 1;
+	    goto simple_type;
+	}
+	else if (strcmp(typestring, "REAL") == 0) {
+	    real = *(double*)string;
+	    isreal = 1;
+	    goto simple_type;
+	}
+	else if (strcmp(typestring, "PG-POLYGON") == 0)
+	    goto polygon_type;
+	else if (strcmp(typestring, "STRING") != 0)
+	    LispDestroy("%s: unknown type %s",
+			STRFUN(builtin), typestring);
+    }
+
+simple_type:
+    return (isint ? INTEGER(integer) : isreal ? DFLOAT(real) :
+	    (string ? STRING(string) : NIL));
+
+polygon_type:
+  {
+    LispObj *poly, *box, *p = NIL, *cdr, *obj;
+    POLYGON *polygon;
+    int i, size;
+
+    size = PQgetlength(res, tuple, field);
+    polygon = (POLYGON*)(string - sizeof(int));
+
+    GCDisable();
+    /* get polygon->boundbox */
+    cdr = EVAL(CONS(ATOM("MAKE-PG-POINT"),
+		    CONS(KEYWORD("X"),
+			 CONS(REAL(polygon->boundbox.high.x),
+			      CONS(KEYWORD("Y"),
+				   CONS(REAL(polygon->boundbox.high.y), NIL))))));
+    obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
+		    CONS(KEYWORD("X"),
+			 CONS(REAL(polygon->boundbox.low.x),
+			      CONS(KEYWORD("Y"),
+				   CONS(REAL(polygon->boundbox.low.y), NIL))))));
+    box = EVAL(CONS(ATOM("MAKE-PG-BOX"),
+		    CONS(KEYWORD("HIGH"),
+			 CONS(cdr,
+			      CONS(KEYWORD("LOW"),
+				   CONS(obj, NIL))))));
+    /* get polygon->p values */
+    for (i = 0; i < polygon->npts; i++) {
+	obj = EVAL(CONS(ATOM("MAKE-PG-POINT"),
+			CONS(KEYWORD("X"),
+			     CONS(REAL(polygon->p[i].x),
+			      CONS(KEYWORD("Y"),
+				   CONS(REAL(polygon->p[i].y), NIL))))));
+	if (i == 0)
+	    p = cdr = CONS(obj, NIL);
+	else {
+	    RPLACD(cdr, CONS(obj, NIL));
+	    cdr = CDR(cdr);
+	}
+    }
+
+    /* make result */
+    poly = EVAL(CONS(ATOM("MAKE-PG-POLYGON"),
+		     CONS(KEYWORD("SIZE"),
+			  CONS(REAL(size),
+			       CONS(KEYWORD("NUM-POINTS"),
+				    CONS(REAL(polygon->npts),
+					 CONS(KEYWORD("BOUNDBOX"),
+					      CONS(box,
+						   CONS(KEYWORD("POINTS"),
+							CONS(QUOTE(p), NIL))))))))));
+    GCEnable();
+
+    return (poly);
+  }
+}
+
+LispObj *
+Lisp_PQhost(LispBuiltin *builtin)
+/*
+ pq-host connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQhost(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQnfields(LispBuiltin *builtin)
+/*
+ pq-nfields result
+ */
+{
+    int nfields;
+    PGresult *res;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    nfields = PQnfields(res);
+
+    return (INTEGER(nfields));
+}
+
+LispObj *
+Lisp_PQnotifies(LispBuiltin *builtin)
+/*
+ pq-notifies connection
+ */
+{
+    LispObj *result, *code, *cod = COD;
+    PGconn *conn;
+    PGnotify *notifies;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    if ((notifies = PQnotifies(conn)) == NULL)
+	return (NIL);
+
+    GCDisable();
+    code = CONS(ATOM("MAKE-PG-NOTIFY"),
+		  CONS(KEYWORD("RELNAME"),
+		       CONS(STRING(notifies->relname),
+			    CONS(KEYWORD("BE-PID"),
+				 CONS(REAL(notifies->be_pid), NIL)))));
+    COD = CONS(code, COD);
+    GCEnable();
+    result = EVAL(code);
+    COD = cod;
+
+    free(notifies);
+
+    return (result);
+}
+
+LispObj *
+Lisp_PQntuples(LispBuiltin *builtin)
+/*
+ pq-ntuples result
+ */
+{
+    int ntuples;
+    PGresult *res;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    ntuples = PQntuples(res);
+
+    return (INTEGER(ntuples));
+}
+
+LispObj *
+Lisp_PQoptions(LispBuiltin *builtin)
+/*
+ pq-options connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQoptions(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQpass(LispBuiltin *builtin)
+/*
+ pq-pass connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQpass(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQport(LispBuiltin *builtin)
+/*
+ pq-port connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQport(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQresultStatus(LispBuiltin *builtin)
+/*
+ pq-result-status result
+ */
+{
+    int status;
+    PGresult *res;
+
+    LispObj *result;
+
+    result = ARGUMENT(0);
+
+    if (!CHECKO(result, PGresult_t))
+	LispDestroy("%s: cannot convert %s to PGresult*",
+		    STRFUN(builtin), STROBJ(result));
+    res = (PGresult*)(result->data.opaque.data);
+
+    status = PQresultStatus(res);
+
+    return (INTEGER(status));
+}
+
+LispObj *
+LispPQsetdb(LispBuiltin *builtin, int loginp)
+/*
+ pq-setdb host port options tty dbname
+ pq-setdb-login host port options tty dbname login password
+ */
+{
+    PGconn *conn;
+    char *host, *port, *options, *tty, *dbname, *login, *password;
+
+    LispObj *ohost, *oport, *ooptions, *otty, *odbname, *ologin, *opassword;
+
+    if (loginp) {
+	opassword = ARGUMENT(6);
+	ologin = ARGUMENT(5);
+    }
+    else
+	opassword = ologin = NIL;
+    odbname = ARGUMENT(4);
+    otty = ARGUMENT(3);
+    ooptions = ARGUMENT(2);
+    oport = ARGUMENT(1);
+    ohost = ARGUMENT(0);
+
+    if (ohost != NIL) {
+	CHECK_STRING(ohost);
+	host = THESTR(ohost);
+    }
+    else
+	host = NULL;
+
+    if (oport != NIL) {
+	CHECK_STRING(oport);
+	port = THESTR(oport);
+    }
+    else
+	port = NULL;
+
+    if (ooptions != NIL) {
+	CHECK_STRING(ooptions);
+	options = THESTR(ooptions);
+    }
+    else
+	options = NULL;
+
+    if (otty != NIL) {
+	CHECK_STRING(otty);
+	tty = THESTR(otty);
+    }
+    else
+	tty = NULL;
+
+    if (odbname != NIL) {
+	CHECK_STRING(odbname);
+	dbname = THESTR(odbname);
+    }
+    else
+	dbname = NULL;
+
+    if (ologin != NIL) {
+	CHECK_STRING(ologin);
+	login = THESTR(ologin);
+    }
+    else
+	login = NULL;
+
+    if (opassword != NIL) {
+	CHECK_STRING(opassword);
+	password = THESTR(opassword);
+    }
+    else
+	password = NULL;
+
+    conn = PQsetdbLogin(host, port, options, tty, dbname, login, password);
+
+    return (conn ? OPAQUE(conn, PGconn_t) : NIL);
+}
+
+LispObj *
+Lisp_PQsetdb(LispBuiltin *builtin)
+/*
+ pq-setdb host port options tty dbname
+ */
+{
+    return (LispPQsetdb(builtin, 0));
+}
+
+LispObj *
+Lisp_PQsetdbLogin(LispBuiltin *builtin)
+/*
+ pq-setdb-login host port options tty dbname login password
+ */
+{
+    return (LispPQsetdb(builtin, 1));
+}
+
+LispObj *
+Lisp_PQsocket(LispBuiltin *builtin)
+/*
+ pq-socket connection
+ */
+{
+    int sock;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    sock = PQsocket(conn);
+
+    return (INTEGER(sock));
+}
+
+LispObj *
+Lisp_PQstatus(LispBuiltin *builtin)
+/*
+ pq-status connection
+ */
+{
+    int status;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    status = PQstatus(conn);
+
+    return (INTEGER(status));
+}
+
+LispObj *
+Lisp_PQtty(LispBuiltin *builtin)
+/*
+ pq-tty connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQtty(conn);
+
+    return (string ? STRING(string) : NIL);
+}
+
+LispObj *
+Lisp_PQuser(LispBuiltin *builtin)
+/*
+ pq-user connection
+ */
+{
+    char *string;
+    PGconn *conn;
+
+    LispObj *connection;
+
+    connection = ARGUMENT(0);
+
+    if (!CHECKO(connection, PGconn_t))
+	LispDestroy("%s: cannot convert %s to PGconn*",
+		    STRFUN(builtin), STROBJ(connection));
+    conn = (PGconn*)(connection->data.opaque.data);
+
+    string = PQuser(conn);
+
+    return (string ? STRING(string) : NIL);
+}
diff --git a/lisp/modules/syntax.lsp b/lisp/modules/syntax.lsp
new file mode 100644
index 0000000..c297235
--- /dev/null
+++ b/lisp/modules/syntax.lsp
@@ -0,0 +1,1452 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/syntax.lsp,v 1.11 2003/01/16 03:50:46 paulo Exp $
+;;
+
+(provide "syntax")
+(require "xedit")
+(in-package "XEDIT")
+
+(defvar *syntax-symbols* '(
+    syntax-highlight defsyntax defsynprop synprop-p syntax-p
+    syntable syntoken synaugment
+    *prop-default* *prop-keyword* *prop-number* *prop-string*
+    *prop-constant* *prop-comment* *prop-preprocessor*
+    *prop-punctuation* *prop-error* *prop-annotation*
+))
+(export *syntax-symbols*)
+(in-package "USER")
+(dolist (symbol xedit::*syntax-symbols*)
+    (import symbol)
+)
+(in-package "XEDIT")
+(makunbound '*syntax-symbols*)
+
+#|
+TODO:
+o Add a command to match without increment the offset in the input, this
+  may be useful for example in a case like:
+	some-table
+	    match "<"
+		switch -1
+	match "<"	<- the table already eated this, so it won't be matched.
+  This must be carefully checked at compile time, such instruction should
+  be in a token that returns or starts a new one, and even then, may need
+  runtime check to make sure it won't enter an infinite loop.
+o Allow combining properties, this is supported in Xaw, and could allow some
+  very interesting effects for complex documents.
+o Maybe have an separated function/loop for tables that don't have tokens
+  that start/switch to another table, and/or have the contained attribute set.
+  This could allow running considerably faster.
+o Do a better handling of interactive edition for tokens that start and end
+  with the same pattern, as an example strings, if the user types '"', it
+  will parse up to the end of the file, "inverting" all strings.
+o Allow generic code to be run once a match is found, such code could handle
+  some defined variables and take decisions based on the parser state. This
+  should be detected at compile time, to maybe run a different parser for
+  such syntax tables, due to the extra time building the environment to
+  call the code. This would be useful to "really" parse documents with
+  complex syntax, for example, a man page source file.
+o Add command to change current default property without initializing a new
+  state.
+o Fix problems matching EOL. Since EOL is an empty string match, if there
+  is a rule to match only EOL, but some other rule matches up to the end
+  of the input, the match to EOL will not be recognized. Currently the only
+  way to handle this is to have a nested table that always returns once a
+  match is found, so that it will restart the match loop code even if the
+  input is at EOL.
+  One possible solution would be to add the ending newline to the input,
+  and then instead of matching "$", should match "\\n".
+o XXX Usage of the variable newline-property must be reviewed in function
+  syntax-highlight, if the text property has a background attribute,
+  visual effect will look "strange", will paint a square with the
+  background attribute at the end of every line in the matched text.
+|#
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Some annotations to later write documentation for the module...
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+#|
+    The current interface logic should be easy to understand for people
+that have written lex scanners before. It has some extended semantics,
+that could be translated to stacked BEGIN() statements in lex, but
+currently does not have rules for matches in the format RE/TRAILING, as
+well as code attached to rules (the biggest difference) and/or things
+like REJECT and unput(). Also, at least currently, it is *really* quite
+slower than lex.
+
+	MATCHING RULES
+	--------------
+    When two tokens are matched at the same input offset, the longest
+token is used, if the length is the same, the first definition is
+used. For example:
+	token1	=>	int
+	token2	=>	[A-Za-z]+
+	input	=>	integer
+    Token1 matches "int" and token2 matches "integer", but since token2 is
+longer, it is used. But in the case:
+	token1	=>	int
+	token2	=>	[A-Za-z]+
+	input	=>	int
+    Both, token1 and token2 match "int", since token1 is defined first, it
+is used.
+|#
+
+
+;;  Initialize some default properties that may be shared in syntax
+;; highlight definitions. Use of these default properties is encouraged,
+;; so that "tokens" will be shown identically when editing program
+;; sources in different programming languages.
+(defsynprop *prop-default*
+    "default"
+    :font	"*courier-medium-r*12*"
+    :foreground	"black")
+
+(defsynprop *prop-keyword*
+    "keyword"
+    :font	"*courier-bold-r*12*"
+    :foreground	"gray12")
+
+(defsynprop *prop-number*
+    "number"
+    :font	"*courier-bold-r*12*"
+    :foreground	"OrangeRed3")
+
+(defsynprop *prop-string*
+    "string"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"RoyalBlue2")
+
+(defsynprop *prop-constant*
+    "constant"
+    :font	"*lucidatypewriter-medium-r*12*"
+    :foreground	"VioletRed3")
+
+(defsynprop *prop-comment*
+    "comment"
+    :font	"*courier-medium-o*12*"
+    :foreground	"SlateBlue3")
+
+(defsynprop *prop-preprocessor*
+    "preprocessor"
+    :font	"*courier-medium-r*12*"
+    :foreground	"green4")
+
+(defsynprop *prop-punctuation*
+    "punctuation"
+    :font	"*courier-bold-r*12*"
+    :foreground	"gray12")
+
+;; Control characters, not always errors...
+(defsynprop *prop-control*
+    "control"
+    :font	"*courier-bold-r*12*"
+    :foreground	"yellow2"
+    :background	"red3")
+
+(defsynprop *prop-error*
+    "error"
+    :font	"*new century schoolbook-bold*24*"
+    :foreground	"yellow"
+    :background	"red")
+
+(defsynprop *prop-annotation*
+    "annotation"
+    :font	"*courier-medium-r*12*"
+    :foreground	"black"
+    :background	"PaleGreen")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  The "main" definition of the syntax highlight coding interface.
+;;  Creates a "special" variable with the given name, associating to
+;; it an already compiled syntax table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro defsyntax (variable label property indent options &rest lists)
+    `(if (boundp ',variable)
+	,variable
+	(progn
+	    (proclaim '(special ,variable))
+	    (setq ,variable
+		(compile-syntax-table
+		    (string ',variable) ,options
+		    (syntable ,label ,property ,indent ,@lists)
+		)
+	    )
+	)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Just a wrapper to create a hash-table and bound it to a symbol.
+;;  Example of call:
+;;	(defsynoptions *my-syntax-options*
+;;	    (:indent		.	8)
+;;	    (:indent-option-1	.	1)
+;;	    (:indent-option-2	.	2)
+;;	)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro defsynoptions (variable &rest options)
+    `(if (boundp ',variable)
+	,variable
+	(progn
+	    (proclaim '(special ,variable))
+	    (setq ,variable (make-hash-table :initial-contents ',options))
+	)
+    )
+)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; These definitions should be "private".
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defstruct syntoken
+    regex		;; A compiled regexp.
+    property		;; NIL for default, or a synprop structure.
+    contained		;; Only used when switch/begin is not NIL. Values:
+			;;	NIL	  -> just switch to or begin new
+			;;		     syntax table.
+			;;	(not NIL) -> apply syntoken property
+			;;		     (or default one) to matched
+			;;		     text *after* switching to or
+			;;		     beginning a new syntax table.
+    switch		;; Values for switch are:
+			;;	NIL	  -> do nothing
+			;;	A keyword -> switch to the syntax table
+			;;		     identified by the keyword.
+			;;	A negative integer -> Pop the stack
+			;;			      -<swich-value> times.
+			;;			      A common value is -1,
+			;;			     to switch to the previous
+			;;			     state, but some times
+			;;			     it is desired to return
+			;;			     two or more times in
+			;;			     in the stack.
+			;;  NOTE: This is actually a jump, the stack is
+			;; popped until the named syntax table is found,
+			;; if the stack becomes empty, a new state is
+			;; implicitly created.
+    begin		;;  NIL or a keyword (like switch), but instead of
+			;; popping the stack, it pushes the current syntax
+			;; table to the stack and sets a new current one.
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Just a wrapper to make-syntoken.
+;;	TODO: Add support for structure constructors.
+;;	XXX: Note that the NOSUB only works with the xedit regex, it
+;; will still return the match offsets, but will ignore subexpressions,
+;; that is, parenthesis are used only for grouping.
+;;	TODO: Create a new version of the re-exec call that returns
+;; offsets in the format (<from> . <to>) and not
+;; ((<from0> . <to0>) ... (<fromN> . <toN>)). Only the global result
+;; is expected/used, so there is no reason to allocate more than one
+;; cons cell per call.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun syntoken (pattern
+		 &key icase nospec property contained switch begin (nosub t)
+		 &aux
+		 (regex
+		    (re-comp pattern :icase icase :nospec nospec :nosub nosub)
+		 )
+		 check)
+
+    ;;  Don't allow a regex that matches the null string enter the
+    ;; syntax table list.
+    (if (consp (setq check (re-exec regex "" :noteol t :notbol t)))
+#+xedit	(error "SYNTOKEN: regex matches empty string ~S" regex)
+#-xedit	()
+    )
+
+    (make-syntoken
+	:regex		regex
+	:property	property
+	:contained	contained
+	:switch		switch
+	:begin		begin
+    )
+)
+
+
+;;  This structure is defined only to do some type checking, it just
+;; holds a list of keywords.
+(defstruct synaugment
+    labels		;; List of keywords labeling syntax tables.
+)
+
+(defstruct syntable
+    label		;; A keyword naming this syntax table.
+    property		;; NIL or a default synprop structure.
+    indent		;; Indentation function for the syntax table.
+    tokens		;; A list of syntoken structures.
+    tables		;; A list of syntable structures.
+    augments		;;  A list of synaugment structures, used only
+			;; at "compile time", so that a table can be
+			;; used before it's definition.
+    bol			;;  One of the tokens match the empty string at
+			;; the start of a line (loop optimization hint).
+			;; Field filled at "link" time.
+    eol			;;  Same comments as bol, but in this case, for
+			;; the empty string at the end of a line.
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Just call make-syntable, but sorts the elements by type, allowing
+;; a cleaner code when defining the syntax highlight rules.
+;; XXX Same comments as for syntoken about the use of a constructor for
+;; structures. TODO: when/if clos is implemented in the interpreter.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun syntable (label default-property indent &rest definitions)
+
+    ;; Check for possible errors in the arguments.
+    (unless (keywordp label)
+	(error "SYNTABLE: ~A is not a keyword" label)
+    )
+    (unless
+	(or
+	    (null default-property)
+	    (synprop-p default-property)
+	)
+	(error "SYNTABLE: ~A is an invalid text property"
+	    default-property
+	)
+    )
+
+    ;; Don't allow unknown data in the definition list.
+    ;; XXX typecase should be added to the interpreter, and since
+    ;;     the code is traversing the entire list, it could build
+    ;;     now the arguments to make-syntable.
+    (dolist (item definitions)
+	(unless
+	    (or
+
+		;;  Allow NIL in the definition list, so that one
+		;; can put conditionals in the syntax definition,
+		;; and if the conditional is false, fill the slot
+		;; with a NIL value.
+		(atom item)
+		(syntoken-p item)
+		(syntable-p item)
+		(synaugment-p item)
+	    )
+	    (error "SYNTABLE: invalid syntax table argument ~A" item)
+	)
+    )
+
+    ;; Build the syntax table.
+    (make-syntable
+	:label		label
+	:property	default-property
+	:indent		indent
+	:tokens		(remove-if-not #'syntoken-p definitions)
+	:tables		(remove-if-not #'syntable-p definitions)
+	:augments	(remove-if-not #'synaugment-p definitions)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Just to do a "preliminary" error checking, every element must be a
+;; a keyword, and also check for reserved names.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun synaugment (&rest keywords)
+    (dolist (keyword keywords)
+	(unless (keywordp keyword)
+	    (error "SYNAUGMENT: bad syntax table label ~A" keyword)
+	)
+    )
+    (make-synaugment :labels keywords)
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Recursive compile utility function.
+;; Returns a cons in the format:
+;;	car	=>	List of all syntoken structures
+;;			(including child tables).
+;;	cdr	=>	List of all child syntable structures.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun list-syntable-elements (table &aux result sub-result)
+    (setq
+	result
+	(cons
+	    (syntable-tokens table)
+	    (syntable-tables table))
+    )
+
+    ;; For every child syntax table.
+    (dolist (child (syntable-tables table))
+
+	;; Recursively call list-syntable-elements.
+	(setq sub-result (list-syntable-elements child))
+
+	(rplaca result (append (car result) (car sub-result)))
+	(rplacd result (append (cdr result) (cdr sub-result)))
+    )
+
+    ;; Return the pair of nested tokens and tables.
+    result
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Append tokens of the augment list to the tokens of the specified
+;; syntax table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-syntax-augment-list (table table-list
+				    &aux labels augment tokens)
+
+    ;; Create a list of all augment tables.
+    (dolist (augment (syntable-augments table))
+	(setq labels (append labels (synaugment-labels augment)))
+    )
+
+    ;;  Remove duplicates and references to "itself",
+    ;; without warnings?
+    (setq
+	labels
+	(remove
+	    (syntable-label table)
+	    (remove-duplicates labels :from-end t)
+	)
+    )
+
+    ;; Check if the specified syntax tables exists!
+    (dolist (label labels)
+	(unless
+	    (setq
+		augment
+		(car (member label table-list :key #'syntable-label))
+	    )
+	    (error "COMPILE-SYNTAX-AUGMENT-LIST: Cannot augment ~A in ~A"
+		label
+		(syntable-label table)
+	    )
+	)
+
+	;; Increase list of tokens.
+	(setq tokens (append tokens (syntable-tokens augment)))
+    )
+
+    ;;  Store the tokens in the augment list. They will be added
+    ;; to the syntax table in the second pass.
+    (setf (syntable-augments table) tokens)
+
+    ;;  Recurse on every child table.
+    (dolist (child (syntable-tables table))
+	(compile-syntax-augment-list child table-list)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Just add the augmented tokens to the token list, recursing on
+;; every child syntax table.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun link-syntax-augment-table (table)
+    (setf
+	(syntable-tokens table)
+	;;  When augmenting a table, duplicated tokens or different tokens
+	;; that use the same regex pattern should be common.
+	(remove-duplicates
+	    (nconc (syntable-tokens table) (syntable-augments table))
+	    :key	#'syntoken-regex
+	    :test	#'equal
+	    :from-end	t
+	)
+
+	;;  Don't need to keep this list anymore.
+	(syntable-augments table)
+	()
+    )
+
+    ;;  Check if one of the tokens match the empty string at the
+    ;; start or end of a text line. XXX The fields bol and eol
+    ;; are expected to be initialized to NIL.
+    (dolist (token (syntable-tokens table))
+	(when (consp (re-exec (syntoken-regex token) "" :noteol t))
+	    (setf (syntable-bol table) t)
+	    (return)
+	)
+    )
+    (dolist (token (syntable-tokens table))
+	(when (consp (re-exec (syntoken-regex token) "" :notbol t))
+	    (setf (syntable-eol table) t)
+	    (return)
+	)
+    )
+
+    (dolist (child (syntable-tables table))
+	(link-syntax-augment-table child)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; "Compile" the main structure of the syntax highlight code.
+;; Variables "switches" and "begins" are used only for error checking.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-syntax-table (name options main-table &aux syntax elements
+			     switches begins tables properties)
+    (unless (stringp name)
+	(error "COMPILE-SYNTAX-TABLE: ~A is not a string" name)
+    )
+
+    (setq
+	elements
+	(list-syntable-elements main-table)
+
+	switches
+	(remove-if
+	    #'null
+	    (car elements)
+	    :key #'syntoken-switch
+	)
+
+	begins
+	(remove-if-not
+	    #'keywordp
+	    (car elements)
+	    :key #'syntoken-begin
+	)
+
+	;;  The "main-table" isn't in the list, because
+	;; list-syntable-elements includes only the child tables;
+	;; this is done to avoid the need of removing duplicates here.
+	tables
+	(cons main-table (cdr elements))
+    )
+
+    ;; Check for typos in the keywords, or for not defined syntax tables.
+    (dolist (item (mapcar #'syntoken-switch switches))
+	(unless
+	    (or
+		(and
+		    (integerp item)
+		    (minusp item)
+		)
+		(member item tables :key #'syntable-label)
+	    )
+	    (error "COMPILE-SYNTAX-TABLE: SWITCH ~A cannot be matched"
+		item
+	    )
+	)
+    )
+    (dolist (item (mapcar #'syntoken-begin begins))
+	(unless (member item tables :key #'syntable-label)
+	    (error "COMPILE-SYNTAX-TABLE: BEGIN ~A cannot be matched"
+		item
+	    )
+	)
+    )
+
+    ;; Create a list of all properties used by the syntax.
+    (setq
+	properties
+	(delete-duplicates
+
+	    ;; Remove explicitly set to "default" properties.
+	    (remove nil
+
+		(append
+
+		    ;; List all properties in the syntoken list.
+		    (mapcar
+			#'syntoken-property
+			(car elements)
+		    )
+
+		    ;; List all properties in the syntable list.
+		    (mapcar
+			#'syntable-property
+			tables
+		    )
+		)
+	    )
+	    :test #'string=
+	    :key  #'synprop-name
+	)
+    )
+
+    ;;  Provide a default property if none specified.
+    (unless
+	(member
+	    "default"
+	    properties
+	    :test #'string=
+	    :key #'synprop-name
+	)
+	(setq properties (append (list *prop-default*) properties))
+    )
+
+
+    ;;  Now that a list of all nested syntax tables is known, compile the
+    ;; augment list. Note that even the main-table can be augmented to
+    ;; include tokens of one of it's children.
+
+    ;;  Adding the tokens of the augment tables must be done in
+    ;; two passes, or it may cause surprises due to "inherited"
+    ;; tokens, as the augment table was processed first, and
+    ;; increased it's token list.
+    (compile-syntax-augment-list main-table tables)
+
+    ;;  Now just append the augmented tokens to the table's token list.
+    (link-syntax-augment-table main-table)
+
+    ;;  Change all syntoken switch and begin fields to point to the
+    ;; syntable.
+    (dolist (item switches)
+	(if (keywordp (syntoken-switch item))
+	    ;;  A switch may be relative, check if a keyword
+	    ;; was specified.
+	    (setf
+		(syntoken-switch item)
+		(car
+		    (member
+			(syntoken-switch item)
+			tables
+			:key #'syntable-label
+		    )
+		)
+	    )
+	)
+    )
+    (dolist (item begins)
+	(setf
+	    (syntoken-begin item)
+	    (car
+		(member
+		    (syntoken-begin item)
+		    tables
+		    :key #'syntable-label
+		)
+	    )
+	)
+    )
+
+    ;;  Don't need to add a entity for default properties
+    (dolist (item (car elements))
+	(and
+	    (syntoken-property item)
+	    (string= (synprop-name (syntoken-property item)) "default")
+	    (setf (syntoken-property item) ())
+	)
+    )
+    (dolist (item tables)
+	(and
+	    (syntable-property item)
+	    (string= (synprop-name (syntable-property item)) "default")
+	    (setf (syntable-property item) ())
+	)
+    )
+
+    (setq syntax
+	(make-syntax
+	    :name	name
+	    :options	options
+	    :labels	tables
+	    :quark
+		(compile-syntax-property-list
+		    name
+		    properties
+		)
+	    :token-count
+		(length (car elements))
+	)
+    )
+
+    ;; Ready to run!
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Loop applying the specifed syntax table to the text.
+;;  XXX This function needs a review. Should compile the regex patterns
+;; with newline sensitive match (and scan the entire file), and keep a
+;; cache of matched tokens (that may be at a very longer offset), and,
+;; when the match is removed from the cache, readd the token to the
+;; token-list; if the token does not match, it will not be in the cache,
+;; but should be removed from the token-list. If properly implemented, it
+;; should be somewhat like 4 times faster, but I would not be surprised
+;; if it becames even faster.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun syntax-highlight (*syntax*
+			 &optional
+			 (*from* (point-min))
+			 (*to* (point-max))
+			 interactive
+			 &aux
+#+debug			 (*line-number* 0)
+			 stream
+			 indent-table
+			)
+
+    ;;  Make sure the property list is in use.
+    ;;  The interactive flag is only set after loading the file.
+    (or interactive
+	(property-list (syntax-quark *syntax*))
+    )
+
+#+debug
+    (setq *from* 0 *to* 0)
+
+#-debug
+    (and (>= *from* *to*) (return-from syntax-highlight (values *from* nil)))
+
+    ;;  Remove any existing properties from the text.
+    (clear-entities *from* (1+ *to*))
+
+    (setq stream
+#-debug	(make-string-input-stream (read-text *from* (- *to* *from*)))
+#+debug	*standard-input*
+    )
+
+    (prog*
+	(
+	;;  Used to check if end of file found but syntax stack did
+	;; not finish.
+	(point-max (point-max))
+
+	;;  Used in interactive mode, to return the syntax table
+	;; where the cursor is located.
+	(point (point))
+
+	;;  The current stack of states.
+	stack
+
+	;;  The current syntable.
+	(syntax-table (car (syntax-labels *syntax*)))
+
+	;;  The current syntable's default property.
+	(default-property (syntable-property syntax-table))
+
+	;;  Add this property to newlines as a hint to the interactive
+	;; callback, so that it knows from where to restart parsing.
+	newline-property
+
+	;;  The tokens in the current syntax table that may match,
+	;; i.e. the items in this list are not in nomatch.
+	token-list
+
+	;;  A pointer to the syntable token list, if token-list is
+	;; eq to this value, cannot change it inplace.
+	current-token-list
+
+	;;  Help to avoid allocating too many new object cells, and
+	;; optmizes a bit time in [n]?set-difference.
+	;;  This optimizes only the processing of one line of text
+	;; as nomatch must be rebuilt when reading a new line of text.
+	token-list-stack
+
+	;;  Matches for the current list of tokens.
+	matches
+
+	;;  Line of text.
+	line
+
+	;;  Length of the text line.
+	length
+
+	;;  A inverse cache, don't call re-exec when the regex is
+	;; already known to not match.
+	nomatch
+
+	;;  Use cache as a list of matches to avoid repetitive
+	;; unnecessary calls to re-exec.
+	;;  cache is a list in which every element has the format:
+	;;	(token . (start . end))
+	;;  Line of text.
+	cache
+
+	;;  Used just to avoid a function call at every re-exec call.
+	notbol
+
+	match
+
+	start
+	left
+	right
+	result
+	property
+
+	;;  Beginig a new syntax table?
+	begin
+
+	;;  Switching to another syntax table?
+	switch
+
+	;;  Property flag when changing the current syntax table.
+	contained
+
+	;;  Flag to know if syntax table has changed.
+	change
+
+	;;  Variables used when removing invalid elements from the
+	;; the cache.
+	item
+	from
+	to
+	)
+
+;-----------------------------------------------------------------------
+:read
+#+debug-verbose
+	(format t "** Entering :READ stack length is ~D~%" (length stack))
+#+debug	(format t "~%[~D]> " (incf *line-number*))
+
+	;;  If input has finished, return.
+	(unless (setq line (read-line stream nil nil))
+	    (when
+		(and
+		    ;; If a nested syntax table wasn't finished
+		    (consp stack)
+		    (<
+			(setq *to* (scan *from* :eol :right))
+			point-max
+		    )
+		)
+		(setq line (read-text *from* (- *to* *from*)))
+		(clear-entities *from* (1+ *to*))
+		(go :again)
+	    )
+#-debug	    (close stream)
+	    (return)
+	)
+
+;------------------------------------------------------------------------
+:again
+	(setq
+	    start		0
+	    length		(length line)
+	    token-list		(syntable-tokens syntax-table)
+	    current-token-list	token-list
+	    token-list-stack	()
+	    nomatch		()
+	    cache		()
+	)
+
+
+	;;  If empty line, and current table does not have matches for
+	;; the empty string at start or end of a text line.
+	(when
+	    (and
+		(= length 0)
+		(not (syntable-eol syntax-table))
+		(not (syntable-bol syntax-table)))
+#+debug-verbose
+	    (format t "Empty line and table has no match to bol or eol~%")
+
+	    (and newline-property
+		(add-entity *from* 1 (synprop-quark newline-property)))
+	    (go :update)
+	)
+
+;------------------------------------------------------------------------
+:loop
+#+debug-verbose
+	(format t "** Entering :LOOP at offset ~D in table ~A, cache has ~D items~%"
+	    start
+	    (syntable-label syntax-table)
+	    (length cache))
+
+	(setq notbol (> start 0))
+
+	;;  For every token that may match.
+	(dolist
+	    (token
+		(setq
+		    token-list
+		    (if (eq token-list current-token-list)
+			(set-difference token-list nomatch :test #'eq)
+			(nset-difference token-list nomatch :test #'eq)
+		    )
+		)
+	    )
+
+	    ;;	Try to fetch match from cache.
+	    (if (setq match (member token cache :test #'eq :key #'car))
+		;;  Match is in the cache.
+
+		(progn
+		    ;;	Match must be moved to the beginning of the
+		    ;; matches list, as a match from another syntax
+		    ;; table may be also in the cache, but before
+		    ;; the match for the current token.
+#+debug-verbose	    (format t "cached: {~A:~S} ~A~%"
+			(cdar match)
+			(subseq line (cadar match) (cddar match))
+			(syntoken-regex token))
+
+		    ;;	Remove the match from the cache.
+		    (if (eq match cache)
+
+			;;  This could be changed to only set "matches"
+			;; if it is not the first element of cache,
+			;; but is unsafe, because other tokens may
+			;; be added to "matches", and will end up
+			;; before when joining "matches" and "cache".
+			(progn
+			    (setq cache (cdr cache))
+			    (rplacd match matches)
+			    (setq matches match))
+
+			(progn
+			    (if (= (length match) 1)
+				(progn
+				    (rplacd (last cache 2) nil)
+				    (rplacd match matches)
+				    (setq matches match))
+				(progn
+				    (setq matches (cons (car match) matches))
+				    (rplaca match (cadr match))
+				    (rplacd match (cddr match)))
+			    )
+			)
+		    )
+
+		    ;;	Exit loop if the all the remaining
+		    ;; input was matched.
+		    (when
+			(and
+			    (= start (cadar match))
+			    (= length (cddar match))
+			)
+#+debug-verbose 	(format t "Rest of line match~%")
+			(return)
+		    )
+		)
+
+		;;  Not in the cache, call re-exec.
+		(if
+		    (consp
+			(setq
+			    match
+			    (re-exec
+				(syntoken-regex token)
+				line
+				:start	start
+				:notbol	notbol)))
+
+		    ;;	Match found.
+		    (progn
+#+debug-verbose		(format t "Adding to cache: {~A:~S} ~A~%"
+			    (car match)
+			    (subseq line (caar match) (cdar match))
+			    (syntoken-regex token))
+
+			;; Only the first pair is used.
+			(setq match (car match))
+
+			(cond
+			    (
+				(or
+				    (null matches)
+				    ;;	No overlap and after most
+				    ;; recent match.
+				    (>= (car match) (cddar matches))
+				    ;; No overlap and before most
+				    ;; recent match.
+				    (<= (cdr match) (cadar matches))
+				)
+				(setq
+				    matches
+				    (cons (cons token match) matches)
+				)
+			    )
+			    (
+				(or
+				    ;;	Overlap, but start before most
+				    ;; recent match.
+				    (< (car match) (cadar matches))
+				    (and
+					;;  Same offset as most recent
+					;; match, but is longer.
+					(= (car match) (cadar matches))
+					(> (cdr match) (cddar matches))
+				    )
+				)
+				(rplaca (car matches) token)
+				(rplacd (car matches) match)
+#+debug-verbose 		(format t "Replaced most recent match~%")
+			    )
+			    (t
+#+debug-verbose 		(format t "Ignored~%")
+				;; XXX The interpreter does not yet implement
+				;; implicit tagbody in dolist, just comment
+				;; the go call in that case. (Will just do
+				;; an unecessary test...)
+				(go :ignored)
+			    )
+			)
+
+			;;  Exit loop if the all the remaining
+			;; input was matched.
+			(when
+			    (and
+				(= start (car match))
+				(= length (cdr match)))
+#+debug-verbose 	    (format t "Rest of line match~%")
+			    (return))
+		    )
+
+		    ;;	Match not found.
+		    (progn
+#+debug-verbose 	(format t "Adding to nomatch: ~A~%"
+			    (syntoken-regex token))
+			(setq nomatch (cons token nomatch)))
+		)
+	    )
+:ignored
+	)
+
+	;;  Add matches to the beginning of the cache list.
+	(setq
+	    ;;	Put matches with smaller offset first.
+	    cache
+	    (stable-sort (nconc (nreverse matches) cache) #'< :key #'cadr)
+
+	    ;;	Make sure that when the match loop is reentered, this
+	    ;; variable is NIL.
+	    matches
+	    ()
+	)
+
+	;;  While the first entry in the cache is not from the current table.
+	(until (or (null cache) (member (caar cache) token-list :test #'eq))
+
+#+debug-verbose
+	    (format t "Not in the current table, removing {~A:~S} ~A~%"
+		(cdar cache)
+		(subseq line (cadar cache) (cddar cache))
+		(syntoken-regex (caar cache)))
+
+	    (setq cache (cdr cache))
+	)
+
+
+	;;  If nothing was matched in the entire/remaining line.
+	(unless cache
+	    (when default-property
+		(if
+		    (or
+			(null result)
+			(> start (cadar result))
+			(not (eq (cddar result) default-property)))
+		    (setq
+			result
+			(cons
+			    (cons start (cons length default-property))
+			    result
+			)
+		    )
+		    (rplaca (cdar result) length)
+		)
+	    )
+
+#+debug-verbose
+	    (format t "No match until end of line~%")
+
+	    ;;  Result already known, and there is no syntax table
+	    ;; change, bypass :PARSE.
+	    (and interactive
+		(null indent-table)
+		(<= 0 (- point *from*) length)
+		(setq indent-table syntax-table))
+	    (go :process)
+	)
+
+#+debug-verbose
+	(format t "Removing first candidate from cache {~A:~S} ~A~%"
+	    (cdar cache)
+	    (subseq line (cadar cache) (cddar cache))
+	    (syntoken-regex (caar cache))
+	)
+
+	;;  Prepare to choose best match.
+	(setq
+	    match	(car cache)
+	    left	(cadr match)
+	    right	(cddr match)
+	    cache	(cdr cache)
+	)
+
+	;;  First element can be safely removed now.
+	;;  If there is only one, skip loop below.
+	(or cache (go :parse))
+
+	;;  Remove elements of cache that must be discarded.
+	(setq
+	    item   (car cache)
+	    from   (cadr item)
+	    to     (cddr item)
+	)
+
+	(loop
+	    (if
+		(or
+
+		    ;;	If everything removed from the cache.
+		    (null item)
+
+		    ;;	Or next item is at a longer offset than the
+		    ;; end of current match.
+		    (>= from right)
+		)
+		(return)
+	    )
+
+	    (and
+		;;  If another match at the same offset.
+		(= left from)
+
+		;;  And if this match is longer than the current one.
+		(> to right)
+
+		(member (car item) token-list :test #'eq)
+
+		(setq
+		    match   item
+		    right   to
+		)
+	    )
+
+#+debug-verbose
+	    (format t "Removing from cache {~A:~S} ~A~%"
+		(cdar cache)
+ 		(subseq line from to)
+		(syntoken-regex (caar cache)))
+
+	    (setq
+		cache	    (cdr cache)
+		item	    (car cache)
+		from	    (cadr item)
+		to	    (cddr item)
+	    )
+	)
+
+
+;-----------------------------------------------------------------------
+:parse
+#+debug-verbose
+	(format t "** Entering :PARSE~%")
+
+	(setq
+
+	    ;;  Change match value to the syntoken.
+	    match	(car match)
+
+	    begin	(syntoken-begin match)
+	    switch	(syntoken-switch match)
+	    contained	(syntoken-contained match)
+	    change	(or begin switch)
+	)
+
+	;;  Check for unmatched leading text.
+	(when (and default-property (> left start))
+#+debug-verbose (format t "No match in {(~D . ~D):~S}~%"
+		start
+		left
+		(subseq line start left)
+	    )
+	    (if
+		(or
+		    (null result)
+		    (> start (cadar result))
+		    (not (eq (cddar result) default-property)))
+		(setq
+		    result
+		    (cons
+			(cons start (cons left default-property))
+			result
+		    )
+		)
+		(rplaca (cdar result) left)
+	    )
+	)
+
+	;;  If the syntax table is not changed,
+	;; or if the new table requires that the
+	;; current default property be used.
+	(unless (and change contained)
+
+	    (and
+		(> right left)
+		(setq
+		    property
+		    (or
+			;;  If token specifies the property.
+			(syntoken-property match)
+			default-property
+		    )
+		)
+
+		;;  Add matched text.
+		(if
+		    (or
+			(null result)
+			(> left (cadar result))
+			(not (eq (cddar result) property))
+		    )
+		    (setq
+			result
+			(cons
+			    (cons left (cons right property))
+			    result
+			)
+		    )
+		    (rplaca (cdar result) right)
+		)
+	    )
+
+#+debug-verbose
+	    (format t "(0)Match found for {(~D . ~D):~S}~%"
+		left
+		right
+		(subseq line left right)
+	    )
+	)
+
+
+	;;  Update start offset in the input now!
+	(and interactive
+	    (null indent-table)
+	    (<= start (- point *from*) right)
+	    (setq indent-table syntax-table))
+	(setq start right)
+
+
+	;;  When changing the current syntax table.
+	(when change
+	    (when switch
+		(if (numberp switch)
+
+		    ;;	If returning to a previous state.
+		    ;;	Don't generate an error if the stack
+		    ;; becomes empty?
+		    (while
+			(< switch 0)
+
+			(setq
+			    syntax-table	(pop stack)
+			    token-list		(pop token-list-stack)
+			    switch		(1+ switch)
+			)
+		    )
+
+		    ;;	Else, not to a previous state, but
+		    ;; returning to a named syntax table,
+		    ;; search for it in the stack.
+		    (while
+			(and
+
+			    (setq
+				token-list	(pop token-list-stack)
+				syntax-table	(pop stack)
+			    )
+
+			    (not (eq switch syntax-table))
+			)
+			;;  Empty loop.
+		    )
+		)
+
+		;;  If no match found while popping
+		;; the stack.
+		(unless syntax-table
+
+		    ;;	Return to the topmost syntax table.
+		    (setq
+			syntax-table
+			(car (syntax-labels *syntax*))
+		    )
+		)
+
+#+debug-verbose	(format t "switching to ~A offset: ~D~%"
+		    (syntable-label syntax-table)
+		    start
+		)
+
+		(if (null token-list)
+		    (setq token-list (syntable-tokens syntax-table))
+		)
+	    )
+
+	    (when begin
+		;;  Save state for a possible
+		;; :SWITCH later.
+		(setq
+		    stack	     (cons syntax-table stack)
+		    token-list-stack (cons token-list token-list-stack)
+		    token-list	     (syntable-tokens begin)
+		    syntax-table     begin
+		)
+#+debug-verbose	(format t "begining ~A offset: ~D~%"
+		    (syntable-label syntax-table)
+		    start
+		)
+	    )
+
+	    ;;	Change current syntax table.
+	    (setq
+		default-property    (syntable-property syntax-table)
+		current-token-list  (syntable-tokens syntax-table)
+	    )
+
+	    ;;  Set newline property, to help interactive callback
+	    ;;  Only need to have a defined value, for now don't care
+	    ;; about wich value is being used, neither if there is
+	    ;; a value to be set.
+	    (if (null stack)
+		(setq newline-property nil)
+		(or newline-property
+		    (setq newline-property default-property)
+		    (setq newline-property (syntoken-property match))
+		)
+	    )
+
+	    ;; If processing of text was deferred.
+	    (when contained
+
+		(and
+		    (> right left)
+		    (setq
+			property
+			(or
+			    (syntoken-property match)
+			    default-property
+			)
+		    )
+		    ;;	Add matched text with the updated property.
+		    (if
+			(or
+			    (null result)
+			    (> left (cadar result))
+			    (not (eq (cddar result) property))
+			)
+			(setq
+			    result
+			    (cons
+				(cons left (cons right property))
+				result
+			    )
+			)
+			(rplaca (cdar result) right)
+		    )
+		)
+
+#+debug-verbose (format t "(1)Match found for {(~D . ~D):~S}~%"
+		    left
+		    right
+		    (subseq line left right)
+		)
+	    )
+
+	    (go :loop)
+	)
+
+
+;-----------------------------------------------------------------------
+	;;  Wait for the end of the line to process, so that
+	;; it is possible to join sequential matches with the
+	;; same text property.
+	(and (or cache (< start length)) (go :loop))
+:process
+
+#+debug-verbose
+	(format t "** Entering :PROCESS~%")
+
+	(if result
+	    (progn
+		;;  If the last property was at the end of the line,
+		;; there are nested syntax tables, and there is a
+		;; default property, include the newline in the property,
+		;; as a hint to the interactive callback.
+		(and
+		    newline-property
+		    (if
+			(and
+			    (eq (cddar result) newline-property)
+			    (= length (cadar result))
+			)
+			(rplaca (cdar result) (1+ length))
+			(setq
+			    result
+			    (cons
+				(cons length (cons (1+ length) newline-property))
+				result
+			    )
+			)
+		    )
+		)
+
+		;;  Result was created in reversed order.
+		(nreverse result)
+		(dolist (item result)
+		    (setq
+			left		(car item)
+			right		(cadr item)
+			property	(cddr item))
+
+		    ;; Use the information.
+		    (add-entity
+			(+ *from* left)
+			(- right left)
+			(synprop-quark property))
+		)
+	    )
+
+	    (and newline-property
+		(add-entity
+		    (+ *from* length)
+		    1
+		    (synprop-quark newline-property))
+	    )
+	)
+
+;------------------------------------------------------------------------
+:update
+	;; Prepare for new matches.
+	(setq
+	    result	nil
+
+	    ;;	Update offset to read text.
+	    ;;	Add 1 for the skipped newline.
+	    *from*	(+ *from* length 1)
+	)
+
+	(go :read)
+    )
+
+#+debug (terpri)
+    (values *to* indent-table)
+)
+
+(compile 'syntax-highlight)
diff --git a/lisp/modules/x11.c b/lisp/modules/x11.c
new file mode 100644
index 0000000..3cdb0bc
--- /dev/null
+++ b/lisp/modules/x11.c
@@ -0,0 +1,666 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/x11.c,v 1.10 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <string.h>
+#include "internal.h"
+#include "private.h"
+#include <X11/Xlib.h>
+
+/*
+ * Prototypes
+ */
+int x11LoadModule(void);
+
+LispObj *Lisp_XOpenDisplay(LispBuiltin *builtin);
+LispObj *Lisp_XCloseDisplay(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultRootWindow(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultScreen(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultScreenOfDisplay(LispBuiltin *builtin);
+LispObj *Lisp_XBlackPixel(LispBuiltin *builtin);
+LispObj *Lisp_XBlackPixelOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XWidthOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XHeightOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XWhitePixel(LispBuiltin *builtin);
+LispObj *Lisp_XWhitePixelOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultGC(LispBuiltin *builtin);
+LispObj *Lisp_XDefaultGCOfScreen(LispBuiltin *builtin);
+LispObj *Lisp_XCreateSimpleWindow(LispBuiltin *builtin);
+LispObj *Lisp_XMapWindow(LispBuiltin *builtin);
+LispObj *Lisp_XDestroyWindow(LispBuiltin *builtin);
+LispObj *Lisp_XFlush(LispBuiltin *builtin);
+LispObj *Lisp_XRaiseWindow(LispBuiltin *builtin);
+LispObj *Lisp_XBell(LispBuiltin *builtin);
+
+LispObj *Lisp_XDrawLine(LispBuiltin *builtin);
+
+/*
+ * Initialization
+ */
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_XOpenDisplay, "x-open-display &optional display-name"},
+    {LispFunction, Lisp_XCloseDisplay, "x-close-display display"},
+    {LispFunction, Lisp_XDefaultRootWindow, "x-default-root-window display"},
+    {LispFunction, Lisp_XDefaultScreen, "x-default-screen display"},
+    {LispFunction, Lisp_XDefaultScreenOfDisplay, "x-default-screen-of-display display"},
+    {LispFunction, Lisp_XBlackPixel, "x-black-pixel display &optional screen"},
+    {LispFunction, Lisp_XBlackPixelOfScreen, "x-black-pixel-of-screen screen"},
+    {LispFunction, Lisp_XWhitePixel, "x-white-pixel display &optional screen"},
+    {LispFunction, Lisp_XWhitePixelOfScreen, "x-white-pixel-of-screen screen"},
+    {LispFunction, Lisp_XDefaultGC, "x-default-gc display &optional screen"},
+    {LispFunction, Lisp_XDefaultGCOfScreen, "x-default-gc-of-screen screen"},
+    {LispFunction, Lisp_XCreateSimpleWindow, "x-create-simple-window display parent x y width height &optional border-width border background"},
+    {LispFunction, Lisp_XMapWindow, "x-map-window display window"},
+    {LispFunction, Lisp_XDestroyWindow, "X-DESTROY-WINDOW"},
+    {LispFunction, Lisp_XFlush, "x-flush display"},
+    {LispFunction, Lisp_XDrawLine, "x-draw-line display drawable gc x1 y1 x2 y2"},
+    {LispFunction, Lisp_XBell, "x-bell display &optional percent"},
+    {LispFunction, Lisp_XRaiseWindow, "x-raise-window display window"},
+    {LispFunction, Lisp_XWidthOfScreen, "x-width-of-screen screen"},
+    {LispFunction, Lisp_XHeightOfScreen, "x-height-of-screen screen"},
+};
+
+LispModuleData x11LispModuleData = {
+    LISP_MODULE_VERSION,
+    x11LoadModule
+};
+
+static int x11Display_t, x11Screen_t, x11Window_t, x11GC_t;
+
+/*
+ * Implementation
+ */
+int
+x11LoadModule(void)
+{
+    int i;
+
+    x11Display_t = LispRegisterOpaqueType("Display*");
+    x11Screen_t = LispRegisterOpaqueType("Screen*");
+    x11Window_t = LispRegisterOpaqueType("Window");
+    x11GC_t = LispRegisterOpaqueType("GC");
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+LispObj *
+Lisp_XOpenDisplay(LispBuiltin *builtin)
+/*
+x-open-display &optional display-name
+ */
+{
+    LispObj *display_name;
+    char *dname;
+
+    display_name = ARGUMENT(0);
+
+    if (display_name == UNSPEC)
+	dname = NULL;
+    else {
+	CHECK_STRING(display_name);
+	dname = THESTR(display_name);
+    }
+
+    return (OPAQUE(XOpenDisplay(dname), x11Display_t));
+}
+
+LispObj *
+Lisp_XCloseDisplay(LispBuiltin *builtin)
+/*
+ x-close-display display
+ */
+{
+    LispObj *display;
+
+    display = ARGUMENT(0);
+
+    if (!CHECKO(display, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(display));
+
+    XCloseDisplay((Display*)(display->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XDefaultRootWindow(LispBuiltin *builtin)
+/*
+ x-default-root-window display
+ */
+{
+    LispObj *display;
+
+    display = ARGUMENT(0);
+
+    if (!CHECKO(display, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(display));
+
+    return (OPAQUE(DefaultRootWindow((Display*)(display->data.opaque.data)),
+		   x11Window_t));
+}
+
+LispObj *
+Lisp_XDefaultScreen(LispBuiltin *builtin)
+/*
+ x-default-screen display
+ */
+{
+    LispObj *display;
+
+    display = ARGUMENT(0);
+
+    if (!CHECKO(display, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(display));
+
+    return (INTEGER(DefaultScreen((Display*)(display->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XDefaultScreenOfDisplay(LispBuiltin *builtin)
+/*
+ x-default-screen-of-display display
+ */
+{
+    LispObj *display;
+
+    display = ARGUMENT(0);
+
+    if (!CHECKO(display, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(display));
+
+    return (OPAQUE(DefaultScreenOfDisplay((Display*)(display->data.opaque.data)),
+		   x11Screen_t));
+}
+
+LispObj *
+Lisp_XBlackPixel(LispBuiltin *builtin)
+/*
+ x-black-pixel display &optional screen
+ */
+{
+    Display *display;
+    int screen;
+
+    LispObj *odisplay, *oscreen;
+
+    oscreen = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (oscreen == UNSPEC)
+	screen = DefaultScreen(display);
+    else
+	CHECK_INDEX(oscreen);
+    else
+	screen = FIXNUM_VALUE(oscreen);
+
+    if (screen >= ScreenCount(display))
+	LispDestroy("%s: screen index %d too large, %d screens available",
+		    STRFUN(builtin), screen, ScreenCount(display));
+
+    return (INTEGER(BlackPixel(display, screen)));
+}
+
+LispObj *
+Lisp_XBlackPixelOfScreen(LispBuiltin *builtin)
+/*
+ x-black-pixel-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (INTEGER(XBlackPixelOfScreen((Screen*)(screen->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XWhitePixel(LispBuiltin *builtin)
+/*
+ x-white-pixel display &optional screen
+ */
+{
+    Display *display;
+    int screen;
+
+    LispObj *odisplay, *oscreen;
+
+    oscreen = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (oscreen == UNSPEC)
+	screen = DefaultScreen(display);
+    else
+	CHECK_FIXNUM(oscreen);
+    else
+	screen = FIXNUM_VALUE(oscreen);
+
+    if (screen >= ScreenCount(display))
+	LispDestroy("%s: screen index %d too large, %d screens available",
+		    STRFUN(builtin), screen, ScreenCount(display));
+
+    return (INTEGER(WhitePixel(display, screen)));
+}
+
+LispObj *
+Lisp_XWhitePixelOfScreen(LispBuiltin *builtin)
+/*
+ x-white-pixel-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (INTEGER(WhitePixelOfScreen((Screen*)(screen->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XDefaultGC(LispBuiltin *builtin)
+/*
+ x-default-gc display &optional screen
+ */
+{
+    Display *display;
+    int screen;
+
+    LispObj *odisplay, *oscreen;
+
+    oscreen = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (oscreen == UNSPEC)
+	screen = DefaultScreen(display);
+    else
+	CHECK_FIXNUM(oscreen);
+    else
+	screen = FIXNUM_VALUE(oscreen);
+
+    if (screen >= ScreenCount(display))
+	LispDestroy("%s: screen index %d too large, %d screens available",
+		    STRFUN(builtin), screen, ScreenCount(display));
+
+    return (OPAQUE(DefaultGC(display, screen), x11GC_t));
+}
+
+LispObj *
+Lisp_XDefaultGCOfScreen(LispBuiltin *builtin)
+/*
+ x-default-gc-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (OPAQUE(DefaultGCOfScreen((Screen*)(screen->data.opaque.data)),
+		   x11GC_t));
+}
+
+LispObj *
+Lisp_XCreateSimpleWindow(LispBuiltin *builtin)
+/*
+ x-create-simple-window display parent x y width height &optional border-width border background
+ */
+{
+    Display *display;
+    Window parent;
+    int x, y;
+    unsigned int width, height, border_width;
+    unsigned long border, background;
+
+    LispObj *odisplay, *oparent, *ox, *oy, *owidth, *oheight,
+	    *oborder_width, *oborder, *obackground;
+
+    obackground = ARGUMENT(8);
+    oborder = ARGUMENT(7);
+    oborder_width = ARGUMENT(6);
+    oheight = ARGUMENT(5);
+    owidth = ARGUMENT(4);
+    oy = ARGUMENT(3);
+    ox = ARGUMENT(2);
+    oparent = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (!CHECKO(oparent, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Window",
+		    STRFUN(builtin), STROBJ(oparent));
+    parent = (Window)(oparent->data.opaque.data);
+
+    CHECK_FIXNUM(ox);
+    x = FIXNUM_VALUE(ox);
+
+    CHECK_FIXNUM(oy);
+    y = FIXNUM_VALUE(oy);
+
+    CHECK_INDEX(owidth);
+    width = FIXNUM_VALUE(owidth);
+
+    CHECK_INDEX(oheight);
+    height = FIXNUM_VALUE(oheight);
+
+    /* check &OPTIONAL parameters */
+    if (oborder_width == UNSPEC)
+	border_width = 1;
+    else
+	CHECK_INDEX(oborder_width);
+    else
+	border_width = FIXNUM_VALUE(oborder_width);
+
+    if (oborder == UNSPEC)
+	border = BlackPixel(display, DefaultScreen(display));
+    else
+	CHECK_LONGINT(oborder);
+    else
+	border = LONGINT_VALUE(oborder);
+
+    if (obackground == UNSPEC)
+	background = WhitePixel(display, DefaultScreen(display));
+    else
+	CHECK_LONGINT(obackground);
+    else
+	background = LONGINT_VALUE(obackground);
+
+    return (OPAQUE(
+	    XCreateSimpleWindow(display, parent, x, y, width, height,
+				border_width, border, background),
+	    x11Window_t));
+}
+
+LispObj *
+Lisp_XMapWindow(LispBuiltin *builtin)
+/*
+ x-map-window display window
+ */
+{
+    Display *display;
+    Window window;
+
+    LispObj *odisplay, *owindow;
+
+    owindow = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (!CHECKO(owindow, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Window",
+		    STRFUN(builtin), STROBJ(owindow));
+    window = (Window)(owindow->data.opaque.data);
+
+    XMapWindow(display, window);
+
+    return (owindow);
+}
+
+LispObj *
+Lisp_XDestroyWindow(LispBuiltin *builtin)
+/*
+ x-destroy-window display window
+ */
+{
+    Display *display;
+    Window window;
+
+    LispObj *odisplay, *owindow;
+
+    owindow = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (!CHECKO(owindow, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Window",
+		    STRFUN(builtin), STROBJ(owindow));
+    window = (Window)(owindow->data.opaque.data);
+
+    XDestroyWindow(display, window);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XFlush(LispBuiltin *builtin)
+/*
+ x-flush display
+ */
+{
+    Display *display;
+
+    LispObj *odisplay;
+
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    XFlush(display);
+
+    return (odisplay);
+}
+
+LispObj *
+Lisp_XDrawLine(LispBuiltin *builtin)
+/*
+ x-draw-line display drawable gc x1 y1 x2 y2
+ */
+{
+    Display *display;
+    Drawable drawable;
+    GC gc;
+    int x1, y1, x2, y2;
+
+    LispObj *odisplay, *odrawable, *ogc, *ox1, *oy1, *ox2, *oy2;
+
+    oy2 = ARGUMENT(6);
+    ox2 = ARGUMENT(5);
+    oy1 = ARGUMENT(4);
+    ox1 = ARGUMENT(3);
+    ogc = ARGUMENT(2);
+    odrawable = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    /* XXX correct check when drawing to pixmaps implemented */
+    if (!CHECKO(odrawable, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Drawable",
+		    STRFUN(builtin), STROBJ(odrawable));
+    drawable = (Drawable)(odrawable->data.opaque.data);
+
+    if (!CHECKO(ogc, x11GC_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(ogc));
+    gc = (GC)(ogc->data.opaque.data);
+
+    CHECK_FIXNUM(ox1);
+    x1 = FIXNUM_VALUE(ox1);
+
+    CHECK_FIXNUM(oy1);
+    y1 = FIXNUM_VALUE(oy1);
+
+    CHECK_FIXNUM(ox2);
+    x2 = FIXNUM_VALUE(ox2);
+
+    CHECK_FIXNUM(oy2);
+    y2 = FIXNUM_VALUE(oy2);
+
+    XDrawLine(display, drawable, gc, x1, y1, x2, y2);
+
+    return (odrawable);
+}
+
+LispObj *
+Lisp_XBell(LispBuiltin *builtin)
+/*
+ x-bell &optional percent
+ */
+{
+    Display *display;
+    int percent;
+
+    LispObj *odisplay, *opercent;
+
+    opercent = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (opercent == UNSPEC)
+	percent = 0;
+    else
+	CHECK_FIXNUM(opercent);
+    else
+	percent = FIXNUM_VALUE(opercent);
+
+    if (percent < -100 || percent > 100)
+	LispDestroy("%s: percent value %d out of range -100 to 100",
+		    STRFUN(builtin), percent);
+
+    XBell(display, percent);
+
+    return (odisplay);
+}
+
+LispObj *
+Lisp_XRaiseWindow(LispBuiltin *builtin)
+/*
+ x-raise-window display window
+ */
+{
+    Display *display;
+    Window window;
+
+    LispObj *odisplay, *owindow;
+
+    owindow = ARGUMENT(1);
+    odisplay = ARGUMENT(0);
+
+    if (!CHECKO(odisplay, x11Display_t))
+	LispDestroy("%s: cannot convert %s to Display*",
+		    STRFUN(builtin), STROBJ(odisplay));
+    display = (Display*)(odisplay->data.opaque.data);
+
+    if (!CHECKO(owindow, x11Window_t))
+	LispDestroy("%s: cannot convert %s to Window",
+		    STRFUN(builtin), STROBJ(owindow));
+    window = (Window)(owindow->data.opaque.data);
+
+    XRaiseWindow(display, window);
+
+    return (owindow);
+}
+
+LispObj *
+Lisp_XWidthOfScreen(LispBuiltin *builtin)
+/*
+ x-width-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (FIXNUM(WidthOfScreen((Screen*)(screen->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XHeightOfScreen(LispBuiltin *builtin)
+/*
+ x-height-of-screen screen
+ */
+{
+    LispObj *screen;
+
+    screen = ARGUMENT(0);
+
+    if (!CHECKO(screen, x11Screen_t))
+	LispDestroy("%s: cannot convert %s to Screen*",
+		    STRFUN(builtin), STROBJ(screen));
+
+    return (FIXNUM(HeightOfScreen((Screen*)(screen->data.opaque.data))));
+}
diff --git a/lisp/modules/xaw.c b/lisp/modules/xaw.c
new file mode 100644
index 0000000..c2b372b
--- /dev/null
+++ b/lisp/modules/xaw.c
@@ -0,0 +1,665 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/xaw.c,v 1.14 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <X11/Intrinsic.h>
+#include <X11/StringDefs.h>
+#include <X11/Xaw/AsciiSink.h>
+#include <X11/Xaw/AsciiSrc.h>
+#include <X11/Xaw/AsciiText.h>
+#include <X11/Xaw/Box.h>
+#include <X11/Xaw/Command.h>
+#include <X11/Xaw/Dialog.h>
+#include <X11/Xaw/Form.h>
+#include <X11/Xaw/Grip.h>
+#include <X11/Xaw/Label.h>
+#include <X11/Xaw/List.h>
+#include <X11/Xaw/MenuButton.h>
+#include <X11/Xaw/MultiSink.h>
+#include <X11/Xaw/MultiSrc.h>
+#include <X11/Xaw/Paned.h>
+#include <X11/Xaw/Panner.h>
+#include <X11/Xaw/Porthole.h>
+#include <X11/Xaw/Repeater.h>
+#include <X11/Xaw/Scrollbar.h>
+#include <X11/Xaw/Simple.h>
+#include <X11/Xaw/SimpleMenu.h>
+#include <X11/Xaw/SmeBSB.h>
+#include <X11/Xaw/Sme.h>
+#include <X11/Xaw/SmeLine.h>
+#include <X11/Xaw/StripChart.h>
+#include <X11/Xaw/Text.h>
+#include <X11/Xaw/TextSink.h>
+#include <X11/Xaw/TextSrc.h>
+#include <X11/Xaw/Tip.h>
+#include <X11/Xaw/Toggle.h>
+#include <X11/Xaw/Tree.h>
+#include <X11/Xaw/Viewport.h>
+#include <X11/Vendor.h>
+#include "internal.h"
+#include "private.h"
+
+/*
+ * Types
+ */
+typedef struct {
+    LispObj *object;
+    void *data;
+} WidgetData;
+
+/*
+ * Prototypes
+ */
+int xawLoadModule(void);
+void LispXawCleanupCallback(Widget, XtPointer, XtPointer);
+
+/* until a better/smarter interface be written... */
+LispObj *Lisp_XawCoerceToListReturnStruct(LispBuiltin*);
+LispObj *Lisp_XawScrollbarCoerceToReal(LispBuiltin*);
+
+LispObj *Lisp_XawFormDoLayout(LispBuiltin*);
+LispObj *Lisp_XawListChange(LispBuiltin*);
+LispObj *Lisp_XawListHighlight(LispBuiltin*);
+LispObj *Lisp_XawListUnhighlight(LispBuiltin*);
+LispObj *Lisp_XawTextGetSource(LispBuiltin*);
+LispObj *Lisp_XawTextLastPosition(LispBuiltin*);
+LispObj *Lisp_XawTextReplace(LispBuiltin*);
+LispObj *Lisp_XawTextSearch(LispBuiltin*);
+LispObj *Lisp_XawTextGetInsertionPoint(LispBuiltin*);
+LispObj *Lisp_XawTextSetInsertionPoint(LispBuiltin*);
+LispObj *Lisp_XawScrollbarSetThumb(LispBuiltin*);
+
+/*
+ * Initialization
+ */
+
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_XawCoerceToListReturnStruct, "xaw-coerce-to-list-return-struct opaque"},
+    {LispFunction, Lisp_XawScrollbarCoerceToReal, "xaw-scrollbar-coerce-to-real opaque"},
+
+    {LispFunction, Lisp_XawScrollbarSetThumb, "xaw-scrollbar-set-thumb widget top &optional shown"},
+    {LispFunction, Lisp_XawFormDoLayout, "xaw-form-do-layout widget force"},
+    {LispFunction, Lisp_XawListChange, "xaw-list-change widget list &optional longest resize"},
+    {LispFunction, Lisp_XawListHighlight, "xaw-list-highlight widget index"},
+    {LispFunction, Lisp_XawListUnhighlight, "xaw-list-unhighlight widget"},
+    {LispFunction, Lisp_XawTextGetSource, "xaw-text-get-source widget"},
+    {LispFunction, Lisp_XawTextLastPosition, "xaw-text-last-position widget"},
+    {LispFunction, Lisp_XawTextReplace, "xaw-text-replace widget left right text"},
+    {LispFunction, Lisp_XawTextSearch, "xaw-text-search widget direction text"},
+    {LispFunction, Lisp_XawTextGetInsertionPoint, "xaw-text-get-insertion-point widget"},
+    {LispFunction, Lisp_XawTextSetInsertionPoint, "xaw-text-set-insertion-point widget position"},
+};
+
+LispModuleData xawLispModuleData = {
+    LISP_MODULE_VERSION,
+    xawLoadModule
+};
+
+static int xawWidget_t, xawWidgetClass_t, xawListReturnStruct_t, xawFloatp_t;
+static WidgetData **list_data;
+static int num_list_data;
+
+/*
+ * Implementation
+ */
+int
+xawLoadModule(void)
+{
+    int i;
+    char *fname = "XAW-LOAD-MODULE";
+
+    xawWidget_t = LispRegisterOpaqueType("Widget");
+    xawWidgetClass_t = LispRegisterOpaqueType("WidgetClass");
+    xawListReturnStruct_t = LispRegisterOpaqueType("XawListReturnStruct");
+    xawFloatp_t = LispRegisterOpaqueType("float*");
+
+    LispExecute("(DEFSTRUCT XAW-LIST-RETURN-STRUCT STRING INDEX)\n");
+
+    GCDisable();
+    (void)LispSetVariable(ATOM2("ASCII-SINK-OBJECT-CLASS"),
+			  OPAQUE(asciiSinkObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("ASCII-SRC-OBJECT-CLASS"),
+			  OPAQUE(asciiSinkObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("ASCII-TEXT-WIDGET-CLASS"),
+			  OPAQUE(asciiTextWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("BOX-WIDGET-CLASS"),
+			  OPAQUE(boxWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("COMMAND-WIDGET-CLASS"),
+			  OPAQUE(commandWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("DIALOG-WIDGET-CLASS"),
+			  OPAQUE(dialogWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("FORM-WIDGET-CLASS"),
+			  OPAQUE(formWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("GRIP-WIDGET-CLASS"),
+			  OPAQUE(gripWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("LABEL-WIDGET-CLASS"),
+			  OPAQUE(labelWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("LIST-WIDGET-CLASS"),
+			  OPAQUE(listWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("MENU-BUTTON-WIDGET-CLASS"),
+			  OPAQUE(menuButtonWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("MULTI-SINK-OBJEC-TCLASS"),
+			  OPAQUE(multiSinkObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("MULTI-SRC-OBJECT-CLASS"),
+			  OPAQUE(multiSrcObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("PANED-WIDGET-CLASS"),
+			  OPAQUE(panedWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("PANNER-WIDGET-CLASS"),
+			  OPAQUE(pannerWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("PORTHOLE-WIDGET-CLASS"),
+			  OPAQUE(portholeWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("REPEATER-WIDGET-CLASS"),
+			  OPAQUE(repeaterWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SCROLLBAR-WIDGET-CLASS"),
+			  OPAQUE(scrollbarWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SIMPLE-MENU-WIDGET-CLASS"),
+			  OPAQUE(simpleMenuWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SIMPLE-WIDGET-CLASS"),
+			  OPAQUE(simpleWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SME-BSB-OBJECT-CLASS"),
+			  OPAQUE(smeBSBObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SME-LINE-OBJECT-CLASS"),
+			  OPAQUE(smeLineObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("SME-OBJECT-CLASS"),
+			  OPAQUE(smeObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("STRIP-CHART-WIDGET-CLASS"),
+			  OPAQUE(stripChartWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TEXT-WIDGET-CLASS"),
+			  OPAQUE(textWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TEXT-SINKOBJECT-CLASS"),
+			  OPAQUE(textSinkObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TEXT-SRC-OBJECT-CLASS"),
+			  OPAQUE(textSrcObjectClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TIP-WIDGET-CLASS"),
+			  OPAQUE(tipWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TOGGLE-WIDGET-CLASS"),
+			  OPAQUE(toggleWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TREE-WIDGET-CLASS"),
+			  OPAQUE(treeWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("VIEWPORT-WIDGET-CLASS"),
+			  OPAQUE(viewportWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("VENDOR-SHELL-WIDGET-CLASS"),
+			  OPAQUE(vendorShellWidgetClass, xawWidgetClass_t),
+			  fname, 0);
+
+    /* return codes of XawTextReplace */
+    (void)LispSetVariable(ATOM2("XAW-REPLACE-ERROR"),
+			  INTEGER(XawReplaceError), fname, 0);
+    (void)LispSetVariable(ATOM2("XAW-EDIT-DONE"),
+			  INTEGER(XawEditDone), fname, 0);
+    (void)LispSetVariable(ATOM2("XAW-EDIT-ERROR"),
+			  INTEGER(XawEditError), fname, 0);
+    (void)LispSetVariable(ATOM2("XAW-POSITION-ERROR"),
+			  INTEGER(XawPositionError), fname, 0);
+
+    /* return code of XawTextSearch */
+    (void)LispSetVariable(ATOM2("XAW-TEXT-SEARCH-ERROR"),
+			  INTEGER(XawTextSearchError), fname, 0);
+
+    /* enum XawTextScanDirection */
+    (void)LispSetVariable(ATOM2("XAWSD-LEFT"),
+			  INTEGER(XawsdLeft), fname, 0);
+    (void)LispSetVariable(ATOM2("XAWSD-RIGHT"),
+			  INTEGER(XawsdRight), fname, 0);
+    GCEnable();
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+void
+LispXawCleanupCallback(Widget w, XtPointer user_data, XtPointer call_data)
+{
+    WidgetData *data = (WidgetData*)user_data;
+
+    UPROTECT(CAR(data->object), data->object);
+    XtFree((XtPointer)data->data);
+    XtFree((XtPointer)data);
+}
+
+LispObj *
+Lisp_XawCoerceToListReturnStruct(LispBuiltin *builtin)
+/*
+ xaw-coerce-to-list-return-struct opaque
+ */
+{
+    LispObj *result, *code, *ocod = COD;
+    XawListReturnStruct *retlist;
+
+    LispObj *opaque;
+
+    opaque = ARGUMENT(0);
+
+    if (!CHECKO(opaque, xawListReturnStruct_t))
+	LispDestroy("%s: cannot convert %s to XawListReturnStruct",
+		    STRFUN(builtin), STROBJ(opaque));
+
+    retlist = (XawListReturnStruct*)(opaque->data.opaque.data);
+
+    GCDisable();
+    code = CONS(ATOM("MAKE-XAW-LIST-RETURN-STRUCT"),
+		CONS(KEYWORD("STRING"),
+		       CONS(STRING(retlist->string),
+			    CONS(KEYWORD("INDEX"),
+				 CONS(INTEGER(retlist->list_index), NIL)))));
+    COD = CONS(code, COD);
+    GCEnable();
+
+    result = EVAL(code);
+    COD = ocod;
+
+    return (result);
+}
+
+LispObj *
+Lisp_XawScrollbarCoerceToReal(LispBuiltin *builtin)
+/*
+ xaw-scrollbar-coerce-to-real opaque
+ */
+{
+    LispObj *result;
+    float *floatp;
+    double real;
+
+    LispObj *opaque;
+
+    opaque = ARGUMENT(0);
+
+    if (!CHECKO(opaque, xawFloatp_t))
+	LispDestroy("%s: cannot convert %s to float*",
+		    STRFUN(builtin), STROBJ(opaque));
+
+    floatp = (float*)(opaque->data.opaque.data);
+    real = *floatp;
+
+    return (DFLOAT(real));
+}
+
+LispObj *
+Lisp_XawFormDoLayout(LispBuiltin *builtin)
+/*
+ xaw-form-do-layout widget force
+ */
+{
+    int force;
+
+    LispObj *owidget, *oforce;
+
+    oforce = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    force = oforce != NIL;
+    XawFormDoLayout((Widget)(owidget->data.opaque.data), force);
+
+    return (oforce);
+}
+
+LispObj *
+Lisp_XawTextGetSource(LispBuiltin *builtin)
+/*
+ xaw-text-get-source widget
+ */
+{
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    return (OPAQUE(XawTextGetSource((Widget)(owidget->data.opaque.data)),
+		   xawWidget_t));
+}
+
+LispObj *
+Lisp_XawTextLastPosition(LispBuiltin *builtin)
+/*
+ xaw-text-last-position widget
+ */
+{
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    return (FIXNUM(XawTextLastPosition((Widget)(owidget->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XawTextGetInsertionPoint(LispBuiltin *builtin)
+/*
+ xaw-text-get-insertion-point widget
+ */
+{
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    return (FIXNUM(XawTextGetInsertionPoint((Widget)(owidget->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XawTextSetInsertionPoint(LispBuiltin *builtin)
+/*
+ xaw-text-set-insertion-point widget position
+ */
+{
+    Widget widget;
+    XawTextPosition position;
+
+    LispObj *owidget, *oposition;
+
+    oposition = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_INDEX(oposition);
+    position = (XawTextPosition)FIXNUM_VALUE(oposition);
+
+    XawTextSetInsertionPoint(widget, position);
+
+    return (oposition);
+}
+
+LispObj *
+Lisp_XawTextReplace(LispBuiltin *builtin)
+/*
+ xaw-text-replace widget left right text
+ */
+{
+    Widget widget;
+    XawTextPosition left, right;
+    XawTextBlock block;
+
+    LispObj *owidget, *oleft, *oright, *otext;
+
+    otext = ARGUMENT(3);
+    oright = ARGUMENT(2);
+    oleft = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_INDEX(oleft);
+    left = (XawTextPosition)FIXNUM_VALUE(oleft);
+
+    CHECK_INDEX(oright);
+    right = (XawTextPosition)FIXNUM_VALUE(oright);
+
+    CHECK_STRING(otext);
+    block.firstPos = 0;
+    block.ptr = THESTR(otext);
+    block.length = strlen(block.ptr);
+    block.format = FMT8BIT;
+
+    return (FIXNUM(XawTextReplace(widget, left, right, &block)));
+}
+
+LispObj *
+Lisp_XawTextSearch(LispBuiltin *builtin)
+/*
+ xaw-text-search widget direction text
+ */
+{
+    Widget widget;
+    XawTextScanDirection direction;
+    XawTextBlock block;
+
+    LispObj *owidget, *odirection, *otext;
+
+    otext = ARGUMENT(2);
+    odirection = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_INDEX(odirection);
+    direction = (XawTextPosition)FIXNUM_VALUE(odirection);
+    if (direction != XawsdLeft && direction != XawsdRight)
+	LispDestroy("%s: %d does not fit in XawTextScanDirection",
+		    STRFUN(builtin), direction);
+
+    CHECK_STRING(otext);
+    block.firstPos = 0;
+    block.ptr = THESTR(otext);
+    block.length = strlen(block.ptr);
+    block.format = FMT8BIT;
+
+    return (FIXNUM(XawTextSearch(widget, direction, &block)));
+}
+
+LispObj *
+Lisp_XawListChange(LispBuiltin *builtin)
+/*
+ xaw-list-change widget list &optional longest resize
+ */
+{
+    Widget widget;
+    String *list;
+    int i, nitems;
+    int longest;
+    Boolean resize;
+    LispObj *object;
+    WidgetData *data;
+
+    LispObj *owidget, *olist, *olongest, *oresize;
+
+    oresize = ARGUMENT(3);
+    olongest = ARGUMENT(2);
+    olist = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_LIST(olist);
+    for (nitems = 0, object = olist; CONSP(object);
+	 ++nitems, object = CDR(object))
+	CHECK_STRING(CAR(object));
+
+    if (olongest != UNSPEC) {
+	CHECK_INDEX(olongest);
+	longest = FIXNUM_VALUE(olongest);
+    }
+    else
+	XtVaGetValues(widget, XtNlongest, &longest, NULL, 0);
+    resize = oresize != UNSPEC && oresize != NIL;
+
+    /* No errors in arguments, build string list */
+    list = (String*)XtMalloc(sizeof(String) * nitems);
+    for (i = 0, object = olist; CONSP(object); i++, object = CDR(object))
+	list[i] = THESTR(CAR(object));
+
+    /* Check if xaw-list-change was already called
+      * for this widget and free previous data */
+    for (i = 0; i < num_list_data; i++)
+	if ((Widget)CAR(list_data[i]->object)->data.opaque.data == widget) {
+	    XtRemoveCallback(widget, XtNdestroyCallback,
+			     LispXawCleanupCallback, list_data[i]);
+	    LispXawCleanupCallback(widget, list_data[i], NULL);
+	    break;
+	}
+
+    if (i >= num_list_data) {
+	++num_list_data;
+	list_data = (WidgetData**)XtRealloc((XtPointer)list_data,
+					    sizeof(WidgetData*) * num_list_data);
+    }
+
+    data = (WidgetData*)XtMalloc(sizeof(WidgetData));
+    data->data = list;
+    list_data[i] = data;
+    data->object = CONS(owidget, olist);
+    PROTECT(owidget, data->object);
+    XtAddCallback(widget, XtNdestroyCallback, LispXawCleanupCallback, data);
+
+    XawListChange(widget, list, nitems, longest, resize);
+
+    return (olist);
+}
+
+LispObj *
+Lisp_XawListHighlight(LispBuiltin *builtin)
+/*
+ xaw-list-highlight widget index
+ */
+{
+    Widget widget;
+    int position;
+
+    LispObj *owidget, *oindex;
+
+    oindex = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_INDEX(oindex);
+    position = FIXNUM_VALUE(oindex);
+
+    XawListHighlight(widget, position);
+
+    return (oindex);
+}
+
+LispObj *
+Lisp_XawListUnhighlight(LispBuiltin *builtin)
+/*
+ xaw-list-unhighlight widget
+ */
+{
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+
+    XawListUnhighlight((Widget)(owidget->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XawScrollbarSetThumb(LispBuiltin *builtin)
+/*
+ xaw-scrollbar-set-thumb widget top &optional shown
+ */
+{
+    Widget widget;
+    double top, shown;
+
+    LispObj *owidget, *otop, *oshown;
+
+    oshown = ARGUMENT(2);
+    otop = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xawWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+
+    CHECK_DFLOAT(otop);
+    top = DFLOAT_VALUE(otop);
+
+    if (oshown == UNSPEC)
+	shown = 1.0;
+    else {
+	CHECK_DFLOAT(oshown);
+	shown = DFLOAT_VALUE(oshown);
+    }
+
+    XawScrollbarSetThumb(widget, top, shown);
+
+    return (oshown == UNSPEC ? DFLOAT(shown) : oshown);
+}
diff --git a/lisp/modules/xedit.lsp b/lisp/modules/xedit.lsp
new file mode 100644
index 0000000..87a85c7
--- /dev/null
+++ b/lisp/modules/xedit.lsp
@@ -0,0 +1,560 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/modules/xedit.lsp,v 1.10 2003/01/16 06:25:50 paulo Exp $
+;;
+
+(provide "xedit")
+
+#+debug	(make-package "XEDIT" :use '("LISP" "EXT"))
+(in-package "XEDIT")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  TODO The user should be able to define *auto-modes* prior to the
+;; initialization here in a configuration file, since defvar only binds
+;; the variable if it is unbound or doesn't have a value defined.
+;;  *auto-modes* is a list of conses where every car is compiled
+;; to a regexp to match the name of the file being loaded. The caddr is
+;; either a string, a pathname, or a syntax-p.
+;;  When loading a file, if the regexp in the car matches, it will check
+;; the caddr value, and if it is a:
+;;	string:		executes (load "progmodes/<the-string>.lsp")
+;;	pathname:	executes (load <the-pathhame>)
+;;	syntax-p:	does nothing, already loaded
+;;
+;;  If it fails to load the file, or the returned value is not a
+;; syntax-p, the entry is removed.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar *auto-modes* '(
+    ("\\.(c|cc|C|cxx|h|bm|xbm|xpm|l|y)$"
+	"C/C++"		"c"	. *c-mode*)
+    ("\\.(li?sp|scm)$"
+	"Lisp/Scheme"	"lisp"	. *lisp-mode*)
+    ("Imakefile|(\\.(cf|rules|tmpl|def|cpp)$)"
+	"X imake"	"imake"	. *imake-mode*)
+    ("[Mm]akefile.*|\\.mk$"
+	"Makefile"	"make"	. *make-mode*)
+    ("\\.sh$"
+	"Unix shell"	"sh"	. *sh-mode*)
+    ("\\.sgml?$"
+	"SGML"		"sgml"	. *sgml-mode*)
+    ("\\.html?$"
+	"HTML"		"html"	. *html-mode*)
+    ("\\.(man|\\d)$"
+	"Man page"	"man"	. *man-mode*)
+    ("app-defaults/\\w+|\\u[A-Za-z0-9_-]+\\.ad"
+	"X resource"	"xrdb"	. *xrdb-mode*)
+    ("\\<XF86Config[^/]*"
+	"XF86Config"	"xconf"	. *xconf-mode*)
+    ("\\.spec$"
+	"RPM spec"	"rpm"	. *rpm-mode*)
+    ("\\<XFree86\\.\\d+\\.log$"
+	"XFree86 log"	"xlog"	. *xlog-mode*)
+))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Compile the regexps in the *auto-modes* list.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(dolist (mode *auto-modes*)
+    (rplaca mode (re-comp (car mode) :nosub t))
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Find the progmode associated with the given filename.
+;; Returns nil if nothing matches.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun auto-mode (filename &optional symbol &aux syntax)
+    (if (and symbol (symbolp symbol))
+	(if (boundp symbol)
+	    (return-from auto-mode (symbol-value symbol))
+	    (setq syntax (cddr (find symbol *auto-modes* :key #'cdddr)))
+	)
+	;; symbol optional argument is not a symbol
+	(do*
+	    (
+	    (mode   *auto-modes*    (cdr mode))
+	    (regex  (caar mode)     (caar mode))
+	    )
+	    ((endp mode))
+
+	    ;; only wants to know if the regex match.
+	    (when (listp (re-exec regex filename :count 0))
+		(setq syntax (cddar mode) symbol (cdr syntax))
+		(return)
+	    )
+	)
+    )
+
+    ;; if file was already loaded
+    (if (and symbol (boundp symbol))
+	(return-from auto-mode (symbol-value symbol))
+    )
+
+    (when (consp syntax)
+	;; point to the syntax file specification
+	(setq syntax (car syntax))
+
+	;; try to load the syntax definition file
+	(if (stringp syntax)
+	    (load
+		(string-concat
+		    (namestring *default-pathname-defaults*)
+		    "progmodes/"
+		    syntax
+		    ".lsp"
+		)
+	    )
+	    (load syntax)
+	)
+
+	(and symbol (boundp symbol) (symbol-value symbol))
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Data types.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  The main syntax structure, normally, only one should exist per
+;; syntax highlight module.
+;;  The structure is defined here so it is not required to load all
+;; the extra data associated with syntax-highlight at initialization
+;; time, and will never be loaded if no syntax-highlight mode is
+;; defined to the files being edited.
+(defstruct syntax
+    name		;;  A unique string to identify the syntax mode.
+			;; Should be the name of the language/file type.
+    options		;;  A hash table of options specified for the
+			;; language.
+
+    ;; Field(s) defined at "compile time"
+    labels		;;  Not exactly a list of labels, but all syntax
+			;; tables for the module.
+    quark		;;  A XrmQuark associated with the XawTextPropertyList
+			;; used by this syntax mode.
+    token-count		;;  Number of distinct syntoken structures in
+			;; the syntax table.
+)
+
+;;  Xlfd description, used when combining properties.
+;;  Field names are self descriptive.
+;;	XXX Fields should be initialized as strings, but fields
+;;	    that have an integer value should be allowed to
+;;	    be initialized as such.
+;;  Combining properties in supported in Xaw, but not yet in the
+;; syntax highlight code interface. Combining properties allow easier
+;; implementation for markup languages, for example:
+;;	<b>bold<i>italic</i></b>
+;;	would render "bold" using a bold version of the default font,
+;;	and "italic" using a bold and italic version of the default font
+(defstruct xlfd
+    foundry
+    family
+    weight
+    slant
+    setwidth
+    addstyle
+    pixel-size
+    point-size
+    res-x
+    res-y
+    spacing
+    avgwidth
+    registry
+    encoding
+)
+
+
+;;   At some time this structure should also hold information for at least:
+;;	o fontset
+;;	o foreground pixmap
+;;	o background pixmap
+;;   XXX This is also a TODO in Xaw.
+(defstruct synprop
+    quark	;;   XrmQuark identifier of the XawTextProperty
+		;; structure. This field is filled when "compiling"
+		;; the syntax-table.
+
+    name	;;   String name of property, must be unique per
+		;; property list.
+    font	;; Optional font string name of property.
+    foreground	;; Optional string representation of foreground color.
+    background	;; Optional string representation of background color.
+    xlfd	;;   Optional xlfd structure, when combining properties.
+		;; Currently combining properties logic not implemented,
+		;; but fonts may be specified using the xlfd definition.
+
+    ;; Boolean properties.
+    underline	;; Draw a line below the text.
+    overstrike	;; Draw a line over the text.
+
+    ;; XXX Are these working in Xaw?
+    subscript	;; Align text to the bottom of the line.
+    superscript	;; Align text to the top of the line.
+    ;;  Note: subscript and superscript only have effect when the text
+    ;; line has different height fonts displayed.
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Utility macro, to create a "special" variable holding
+;; a synprop structure.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmacro defsynprop (variable name
+		      &key font foreground background xlfd underline
+			   overstrike subscript superscript)
+    `(progn
+	(proclaim '(special ,variable))
+	(setq ,variable
+	    (make-synprop
+		:name		,name
+		:font		,font
+		:foreground	,foreground
+		:background	,background
+		:xlfd		,xlfd
+		:underline	,underline
+		:overstrike	,overstrike
+		:subscript	,subscript
+		:superscript	,superscript
+	    )
+	)
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Convert a synprop structure  to a string in the format
+;; expected by Xaw.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun synprop-to-string (synprop &aux values booleans xlfd)
+    (if (setq xlfd (synprop-xlfd synprop))
+	(dolist
+	    (element
+	       `(
+		("foundry"	    ,(xlfd-foundry xlfd))
+		("family"	    ,(xlfd-family xlfd))
+		("weight"	    ,(xlfd-weight xlfd))
+		("slant"	    ,(xlfd-slant xlfd))
+		("setwidth"	    ,(xlfd-setwidth xlfd))
+		("addstyle"	    ,(xlfd-addstyle xlfd))
+		("pixelsize"	    ,(xlfd-pixel-size xlfd))
+		("pointsize"	    ,(xlfd-point-size xlfd))
+		("resx" 	    ,(xlfd-res-x xlfd))
+		("resy" 	    ,(xlfd-res-y xlfd))
+		("spacing"	    ,(xlfd-spacing xlfd))
+		("avgwidth"	    ,(xlfd-avgwidth xlfd))
+		("registry"	    ,(xlfd-registry xlfd))
+		("encoding"	    ,(xlfd-encoding xlfd))
+		)
+	    )
+	    (if (cadr element)
+		(setq values (append values element))
+	    )
+	)
+    )
+    (dolist
+	(element
+	   `(
+	    ("font"		,(synprop-font synprop))
+	    ("foreground"	,(synprop-foreground synprop))
+	    ("background"	,(synprop-background synprop))
+	    )
+	)
+	(if (cadr element)
+	    (setq values (append values element))
+	)
+    )
+
+    ;;  Boolean attributes. These can be specified in the format
+    ;; <name>=<anything>, but do a nicer output as the format
+    ;; <name> is accepted.
+    (dolist
+	(element
+	    `(
+	    ("underline"	,(synprop-underline synprop))
+	    ("overstrike"	,(synprop-overstrike synprop))
+	    ("subscript"	,(synprop-subscript synprop))
+	    ("superscript"	,(synprop-superscript synprop))
+	    )
+	)
+	(if (cadr element)
+	    (setq booleans (append booleans element))
+	)
+    )
+
+    ;;  Play with format conditionals, list iteration, and goto, to
+    ;; make resulting string.
+    (format
+	nil
+	"~A~:[~;?~]~:[~3*~;~A=~A~{&~A=~A~}~]~:[~;&~]~:[~2*~;~A~{&~A~*~}~]"
+
+	(synprop-name synprop)				;; ~A
+	(or values booleans)				;; ~:[~;?~]
+	values						;; ~:[
+	    (car values) (cadr values) (cddr values)	;; ~A=~A~{&~A=~A~}
+	(and values booleans)				;; ~:[~;&~]
+	booleans					;; ~:[
+	    (car booleans) (cddr booleans)		;; ~A~{&~A~*~}
+    )
+)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;  Use xedit protocol to create a XawTextPropertyList with the
+;; given arguments.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun compile-syntax-property-list (name properties
+				     &aux string-properties quark)
+
+    ;; Create a string representation of the properties.
+    (dolist (property properties)
+	(setq
+	    string-properties
+	    (append
+		string-properties
+		(list (synprop-to-string property))
+	    )
+	)
+    )
+
+    (setq
+	string-properties
+	(case (length string-properties)
+	    (0	"")
+	    (1	(car string-properties))
+	    (t	(format nil "~A~{,~A~}"
+		    (car string-properties)
+		    (cdr string-properties)
+		)
+	    )
+	)
+    )
+
+#+debug
+    (format *output* "~Cconvert-property-list ~S ~S~%"
+	*escape*
+	name
+	string-properties
+    )
+    (setq quark #-debug (convert-property-list name string-properties)
+		#+debug 0)
+
+    ;; Store the quark for properties not yet "initialized".
+    ;; XXX This is just a call to Xrm{Perm,}StringToQuark, and should
+    ;;     be made available if there were a wrapper/interface to
+    ;;     that Xlib function.
+    (dolist (property properties)
+	(unless (integerp (synprop-quark property))
+#+debug
+	    (format *output* "~Cxrm-string-to-quark ~S~%"
+		*escape*
+		(synprop-name property)
+	    )
+	    (setf
+		(synprop-quark property)
+#-debug		(xrm-string-to-quark (synprop-name property))
+#+debug		0
+	    )
+	)
+    )
+
+    quark
+)
+
+
+
+
+#+debug
+(progn
+    (defconstant *escape* #\$)
+
+    (defconstant *output* *standard-output*)
+
+    ;; Recognized identifiers for wrap mode.
+    (defconstant *wrap-modes* '(:never :line :word))
+
+    ;; Recognized identifiers for justification.
+    (defconstant *justifications* '(:left :right :center :full))
+
+    ;; XawTextScanType
+    (defconstant *scan-type*
+	'(:positions :white-space :eol :paragraph :all :alpha-numeric))
+
+    ;; XawTextScanDirection
+    (defconstant *scan-direction* '(:left :right))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; Debugging version of xedit functions.
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (defun clear-entities (left right)
+	(format *output* "~Cclear-entities ~D ~D~%"
+	    *escape* left right))
+
+    (defun add-entity (offset length identifier)
+	(format *output* "~Cadd-entity ~D ~D ~D~%"
+	    *escape* offset length identifier))
+
+    (defun background (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-background ~S~%" *escape* value)
+	    (format *output* "~Cget-background~%" *escape*)))
+
+    (defun foreground (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-foreground ~S~%" *escape* value)
+	    (format *output* "~Cget-foreground~%" *escape*)))
+
+    (defun font (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-font ~S~%" *escape* value)
+	    (format *output* "~Cget-font~%" *escape*)))
+
+    (defun point (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-point ~D~%" *escape* value)
+	    (format *output* "~Cget-point~%" *escape*)))
+
+    (defun point-min ()
+	(format *output* "~Cpoint-min~%" *escape*))
+
+    (defun point-max ()
+	(format *output* "~Cpoint-max~%" *escape*))
+
+    (defun property-list (&optional (quark nil specified))
+	(format *output* "~property-list ~D~%" *escape* quark))
+
+    (defun insert (string)
+	(format *output* "~Cinsert ~S~%" *escape* string))
+
+    (defun read-text (offset length)
+	(format *output* "~Cread-text ~D ~D~%"
+	    *escape* offset length))
+
+    (defun replace-text (left right string)
+	(format *output* "~Creplace-text ~D ~D ~S~%"
+	    *escape* left right string))
+
+    (defun scan (offset type direction &key (count 1) include)
+	(unless (setq type (position type *scan-type*))
+	    (error "SCAN: type must be one of ~A, not ~A"
+		*scan-type* type))
+	(unless (setq direction (position direction *scan-direction*))
+	    (error "SCAN: direction must be one of ~A, not ~A"
+		*scan-direction* direction))
+	(format *output* "~Cscan ~D ~D ~D ~D ~D~%"
+	    *escape* offset type direction count (if include 1 0)))
+
+    (defun search-forward (string &optional case-sensitive)
+	(format *output* "~Csearch-forward ~S ~D~%"
+	    *escape* string (if case-sensitive 1 0)))
+
+    (defun search-backward (string &optional case-sensitive)
+	(format *output* "~Csearch-backward ~S ~D~%"
+	    *escape* string (if case-sensitive 1 0)))
+
+    (defun wrap-mode (&optional (value nil specified))
+	(if specified
+	    (progn
+		(unless (member value *wrap-modes*)
+		    (error "WRAP-MODE: argument must be one of ~A, not ~A"
+			*wrap-modes* value))
+		(format *output* "~Cset-wrap-mode ~S~%"
+		    *escape* (string value)))
+	    (format *output* "~Cget-wrap-mode~%" *escape*)))
+
+    (defun auto-fill (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-auto-fill ~S~%"
+		*escape* (if value "true" "false"))
+	    (format *output* "~Cget-auto-fill~%" *escape*)))
+
+    (defun justification (&optional (value nil specified))
+	(if specified
+	    (progn
+		(unless (member value *justifications*)
+		    (error "JUSTIFICATION: argument must be one of ~A, not ~A"
+			*justifications* value))
+		(format *output* "~Cset-justification ~S~%"
+		    *escape* (string value)))
+	    (format *output* "~Cget-justification~%" *escape*)))
+
+    (defun left-column (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-left-column ~D~%" *escape* value)
+	    (format *output* "~Cget-left-column~%" *escape*)))
+
+    (defun right-column (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-right-column ~D~%" *escape* value)
+	    (format *output* "~Cget-right-column~%" *escape*)))
+
+    (defun vertical-scrollbar (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-vert-scrollbar ~S~%"
+		*escape* (if value "always" "never"))
+	    (format *output* "~Cget-vert-scrollbar~%" *escape*)))
+
+    (defun horizontal-scrollbar (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-horiz-scrollbar ~S~%"
+		*escape* (if value "always" "never"))
+	    (format *output* "~Cget-horiz-scrollbar~%" *escape*)))
+
+    #|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+    (defun create-buffer (name)
+	(format *output* "~Ccreate-buffer ~S~%" *escape* name))
+
+    (defun remove-buffer (name)
+	(format *output* "~Cremove-buffer ~S~%" *escape* name))
+
+    (defun buffer-name (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-buffer-name ~S~%" *escape* value)
+	    (format *output* "~Cget-buffer-name~%" *escape*)))
+
+    (defun buffer-filename (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-buffer-filename ~S~%"
+		*escape* (namestring value))
+	    (format *output* "~Cget-buffer-filename~%" *escape*)))
+
+    (defun current-buffer (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-current-buffer ~S~%" *escape* value)
+	    (format *output* "~Cget-current-buffer~%" *escape*)))
+
+    (defun other-buffer (&optional (value nil specified))
+	(if specified
+	    (format *output* "~Cset-other-buffer ~S~%" *escape* value)
+	    (format *output* "~Cget-other-buffer~%" *escape*)))
+    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||#
+)
diff --git a/lisp/modules/xt.c b/lisp/modules/xt.c
new file mode 100644
index 0000000..13c7ae7
--- /dev/null
+++ b/lisp/modules/xt.c
@@ -0,0 +1,1797 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/modules/xt.c,v 1.19 2002/11/23 08:26:52 paulo Exp $ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <X11/Intrinsic.h>
+#include <X11/StringDefs.h>
+#include <X11/Shell.h>
+#include "internal.h"
+#include "private.h"
+
+/*
+ * Types
+ */
+typedef struct {
+    XrmQuark qname;
+    XrmQuark qtype;
+    Cardinal size;
+} ResourceInfo;
+
+typedef struct {
+    WidgetClass widget_class;
+    ResourceInfo **resources;
+    Cardinal num_resources;
+    Cardinal num_cons_resources;
+} ResourceList;
+
+typedef struct {
+    Arg *args;
+    Cardinal num_args;
+} Resources;
+
+typedef struct {
+    LispObj *data;
+    /* data is => (list* widget callback argument) */
+} CallbackArgs;
+
+/*
+ * Prototypes
+ */
+int xtLoadModule(LispMac*);
+void LispXtCleanupCallback(Widget, XtPointer, XtPointer);
+
+void LispXtCallback(Widget, XtPointer, XtPointer);
+void LispXtInputCallback(XtPointer, int*, XtInputId*);
+
+/* a hack... */
+LispObj *Lisp_XtCoerceToWidgetList(LispBuiltin*);
+
+LispObj *Lisp_XtAddCallback(LispBuiltin*);
+LispObj *Lisp_XtAppInitialize(LispBuiltin*);
+LispObj *Lisp_XtAppMainLoop(LispBuiltin*);
+LispObj *Lisp_XtAppAddInput(LispBuiltin*);
+LispObj *Lisp_XtAppPending(LispBuiltin*);
+LispObj *Lisp_XtAppProcessEvent(LispBuiltin*);
+LispObj *Lisp_XtCreateWidget(LispBuiltin*);
+LispObj *Lisp_XtCreateManagedWidget(LispBuiltin*);
+LispObj *Lisp_XtCreatePopupShell(LispBuiltin*);
+LispObj *Lisp_XtDestroyWidget(LispBuiltin*);
+LispObj *Lisp_XtGetKeyboardFocusWidget(LispBuiltin*);
+LispObj *Lisp_XtGetValues(LispBuiltin*);
+LispObj *Lisp_XtManageChild(LispBuiltin*);
+LispObj *Lisp_XtUnmanageChild(LispBuiltin*);
+LispObj *Lisp_XtSetMappedWhenManaged(LispBuiltin*);
+LispObj *Lisp_XtMapWidget(LispBuiltin*);
+LispObj *Lisp_XtName(LispBuiltin*);
+LispObj *Lisp_XtParent(LispBuiltin*);
+LispObj *Lisp_XtUnmapWidget(LispBuiltin*);
+LispObj *Lisp_XtPopup(LispBuiltin*);
+LispObj *Lisp_XtPopdown(LispBuiltin*);
+LispObj *Lisp_XtIsRealized(LispBuiltin*);
+LispObj *Lisp_XtRealizeWidget(LispBuiltin*);
+LispObj *Lisp_XtUnrealizeWidget(LispBuiltin*);
+LispObj *Lisp_XtRemoveInput(LispBuiltin*);
+LispObj *Lisp_XtSetSensitive(LispBuiltin*);
+LispObj *Lisp_XtSetValues(LispBuiltin*);
+LispObj *Lisp_XtWidgetToApplicationContext(LispBuiltin*);
+LispObj *Lisp_XtDisplay(LispBuiltin*);
+LispObj *Lisp_XtDisplayOfObject(LispBuiltin*);
+LispObj *Lisp_XtScreen(LispBuiltin*);
+LispObj *Lisp_XtScreenOfObject(LispBuiltin*);
+LispObj *Lisp_XtSetKeyboardFocus(LispBuiltin*);
+LispObj *Lisp_XtWindow(LispBuiltin*);
+LispObj *Lisp_XtWindowOfObject(LispBuiltin*);
+LispObj *Lisp_XtAddGrab(LispBuiltin*);
+LispObj *Lisp_XtRemoveGrab(LispBuiltin*);
+LispObj *Lisp_XtAppGetExitFlag(LispBuiltin*);
+LispObj *Lisp_XtAppSetExitFlag(LispBuiltin*);
+
+LispObj *LispXtCreateWidget(LispBuiltin*, int);
+
+static Resources *LispConvertResources(LispObj*, Widget,
+				       ResourceList*, ResourceList*);
+static void LispFreeResources(Resources*);
+
+static int bcmp_action_resource(_Xconst void*, _Xconst void*);
+static ResourceInfo *GetResourceInfo(char*, ResourceList*, ResourceList*);
+static ResourceList *GetResourceList(WidgetClass);
+static int bcmp_action_resource_list(_Xconst void*, _Xconst void*);
+static ResourceList *FindResourceList(WidgetClass);
+static int qcmp_action_resource_list(_Xconst void*, _Xconst void*);
+static ResourceList *CreateResourceList(WidgetClass);
+static int qcmp_action_resource(_Xconst void*, _Xconst void*);
+static void BindResourceList(ResourceList*);
+
+static void PopdownAction(Widget, XEvent*, String*, Cardinal*);
+static void QuitAction(Widget, XEvent*, String*, Cardinal*);
+
+/*
+ * Initialization
+ */
+static LispBuiltin lispbuiltins[] = {
+    {LispFunction, Lisp_XtCoerceToWidgetList, "xt-coerce-to-widget-list number opaque"},
+
+    {LispFunction, Lisp_XtAddGrab, "xt-add-grab widget exclusive spring-loaded"},
+    {LispFunction, Lisp_XtAddCallback, "xt-add-callback widget callback-name callback &optional client-data"},
+    {LispFunction, Lisp_XtAppAddInput, "xt-app-add-input app-context fileno condition function &optional client-data"},
+    {LispFunction, Lisp_XtAppInitialize, "xt-app-initialize app-context-return application-class &optional options fallback-resources"},
+    {LispFunction, Lisp_XtAppPending, "xt-app-pending app-context"},
+    {LispFunction, Lisp_XtAppMainLoop, "xt-app-main-loop app-context"},
+    {LispFunction, Lisp_XtAppProcessEvent, "xt-app-process-event app-context &optional mask"},
+    {LispFunction, Lisp_XtAppGetExitFlag, "xt-app-get-exit-flag app-context"},
+    {LispFunction, Lisp_XtAppSetExitFlag, "xt-app-set-exit-flag app-context"},
+    {LispFunction, Lisp_XtCreateManagedWidget, "xt-create-managed-widget name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtCreateWidget, "xt-create-widget name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtCreatePopupShell, "xt-create-popup-shell name widget-class parent &optional arguments"},
+    {LispFunction, Lisp_XtDestroyWidget, "xt-destroy-widget widget"},
+    {LispFunction, Lisp_XtGetKeyboardFocusWidget, "xt-get-keyboard-focus-widget widget"},
+    {LispFunction, Lisp_XtGetValues, "xt-get-values widget arguments"},
+    {LispFunction, Lisp_XtManageChild, "xt-manage-child widget"},
+    {LispFunction, Lisp_XtName, "xt-name widget"},
+    {LispFunction, Lisp_XtUnmanageChild, "xt-unmanage-child widget"},
+    {LispFunction, Lisp_XtMapWidget, "xt-map-widget widget"},
+    {LispFunction, Lisp_XtUnmapWidget, "xt-unmap-widget widget"},
+    {LispFunction, Lisp_XtSetMappedWhenManaged, "xt-set-mapped-when-managed widget map-when-managed"},
+    {LispFunction, Lisp_XtParent, "xt-parent widget"},
+    {LispFunction, Lisp_XtPopup, "xt-popup widget grab-kind"},
+    {LispFunction, Lisp_XtPopdown, "xt-popdown widget"},
+    {LispFunction, Lisp_XtIsRealized, "xt-is-realized widget"},
+    {LispFunction, Lisp_XtRealizeWidget, "xt-realize-widget widget"},
+    {LispFunction, Lisp_XtUnrealizeWidget, "xt-unrealize-widget widget"},
+    {LispFunction, Lisp_XtRemoveInput, "xt-remove-input input"},
+    {LispFunction, Lisp_XtRemoveGrab, "xt-remove-grab widget"},
+    {LispFunction, Lisp_XtSetKeyboardFocus, "xt-set-keyboard-focus widget descendant"},
+    {LispFunction, Lisp_XtSetSensitive, "xt-set-sensitive widget sensitive"},
+    {LispFunction, Lisp_XtSetValues, "xt-set-values widget arguments"},
+    {LispFunction, Lisp_XtWidgetToApplicationContext, "xt-widget-to-application-context widget"},
+    {LispFunction, Lisp_XtDisplay, "xt-display widget"},
+    {LispFunction, Lisp_XtDisplayOfObject, "xt-display-of-object object"},
+    {LispFunction, Lisp_XtScreen, "xt-screen widget"},
+    {LispFunction, Lisp_XtScreenOfObject, "xt-screen-of-object object"},
+    {LispFunction, Lisp_XtWindow, "xt-window widget"},
+    {LispFunction, Lisp_XtWindowOfObject, "xt-window-of-object object"},
+};
+
+LispModuleData xtLispModuleData = {
+    LISP_MODULE_VERSION,
+    xtLoadModule,
+};
+
+static ResourceList **resource_list;
+static Cardinal num_resource_list;
+
+static Atom delete_window;
+static int xtAppContext_t, xtWidget_t, xtWidgetClass_t, xtWidgetList_t,
+	   xtInputId_t, xtDisplay_t, xtScreen_t, xtWindow_t;
+
+static XtActionsRec actions[] = {
+    {"xt-popdown",	PopdownAction},
+    {"xt-quit",		QuitAction},
+};
+
+static XrmQuark qCardinal, qInt, qString, qWidget, qFloat;
+
+static CallbackArgs **input_list;
+static Cardinal num_input_list, size_input_list;
+
+/*
+ * Implementation
+ */
+int
+xtLoadModule(void)
+{
+    int i;
+    char *fname = "XT-LOAD-MODULE";
+
+    xtAppContext_t = LispRegisterOpaqueType("XtAppContext");
+    xtWidget_t = LispRegisterOpaqueType("Widget");
+    xtWidgetClass_t = LispRegisterOpaqueType("WidgetClass");
+    xtWidgetList_t = LispRegisterOpaqueType("WidgetList");
+    xtInputId_t = LispRegisterOpaqueType("XtInputId");
+    xtDisplay_t = LispRegisterOpaqueType("Display*");
+    xtScreen_t = LispRegisterOpaqueType("Screen*");
+    xtWindow_t = LispRegisterOpaqueType("Window");
+
+    LispExecute("(DEFSTRUCT XT-WIDGET-LIST NUM-CHILDREN CHILDREN)\n");
+
+    GCDisable();
+    (void)LispSetVariable(ATOM2("CORE-WIDGET-CLASS"),
+			  OPAQUE(coreWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("COMPOSITE-WIDGET-CLASS"),
+			  OPAQUE(compositeWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("CONSTRAINT-WIDGET-CLASS"),
+			  OPAQUE(constraintWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+    (void)LispSetVariable(ATOM2("TRANSIENT-SHELL-WIDGET-CLASS"),
+			  OPAQUE(transientShellWidgetClass, xtWidgetClass_t),
+			  fname, 0);
+
+    /* parameters for XtPopup */
+    (void)LispSetVariable(ATOM2("XT-GRAB-EXCLUSIVE"),
+			  INTEGER(XtGrabExclusive), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-GRAB-NONE"),
+			  INTEGER(XtGrabNone), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-GRAB-NONE-EXCLUSIVE"),
+			  INTEGER(XtGrabNonexclusive), fname, 0);
+
+    /* parameters for XtAppProcessEvent */
+    (void)LispSetVariable(ATOM2("XT-IM-XEVENT"),
+			  INTEGER(XtIMXEvent), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-TIMER"),
+			  INTEGER(XtIMTimer), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-ALTERNATE-INPUT"),
+			  INTEGER(XtIMAlternateInput), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-SIGNAL"),
+			  INTEGER(XtIMSignal), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-IM-ALL"),
+			  INTEGER(XtIMAll), fname, 0);
+
+    /* parameters for XtAppAddInput */
+    (void)LispSetVariable(ATOM2("XT-INPUT-READ-MASK"),
+			  INTEGER(XtInputReadMask), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-INPUT-WRITE-MASK"),
+			  INTEGER(XtInputWriteMask), fname, 0);
+    (void)LispSetVariable(ATOM2("XT-INPUT-EXCEPT-MASK"),
+			  INTEGER(XtInputExceptMask), fname, 0);
+    GCEnable();
+
+    qCardinal = XrmPermStringToQuark(XtRCardinal);
+    qInt = XrmPermStringToQuark(XtRInt);
+    qString = XrmPermStringToQuark(XtRString);
+    qWidget = XrmPermStringToQuark(XtRWidget);
+    qFloat = XrmPermStringToQuark(XtRFloat);
+
+    for (i = 0; i < sizeof(lispbuiltins) / sizeof(lispbuiltins[0]); i++)
+	LispAddBuiltinFunction(&lispbuiltins[i]);
+
+    return (1);
+}
+
+void
+LispXtCallback(Widget w, XtPointer user_data, XtPointer call_data)
+{
+    CallbackArgs *args = (CallbackArgs*)user_data;
+    LispObj *code, *ocod = COD;
+
+    GCDisable();
+		/* callback name */	   /* reall caller */
+    code = CONS(CDR(CDR(args->data)), CONS(OPAQUE(w, xtWidget_t),
+		CONS(CAR(CDR(args->data)), CONS(OPAQUE(call_data, 0), NIL))));
+		     /* user arguments */
+    COD = CONS(code, COD);
+    GCEnable();
+
+    (void)EVAL(code);
+    COD = ocod;
+}
+
+
+void
+LispXtCleanupCallback(Widget w, XtPointer user_data, XtPointer call_data)
+{
+    CallbackArgs *args = (CallbackArgs*)user_data;
+
+    UPROTECT(CAR(args->data), args->data);
+    XtFree((XtPointer)args);
+}
+
+void
+LispXtInputCallback(XtPointer closure, int *source, XtInputId *id)
+{
+    CallbackArgs *args = (CallbackArgs*)closure;
+    LispObj *code, *ocod = COD;
+
+    GCDisable();
+		/* callback name */	  /* user arguments */
+    code = CONS(CDR(CDR(args->data)), CONS(CAR(CDR(args->data)),
+		CONS(INTEGER(*source), CONS(CAR(args->data), NIL))));
+		     /* input source */	   /* input id */
+    COD = CONS(code, COD);
+    GCEnable();
+
+    (void)EVAL(code);
+    COD = ocod;
+}
+
+LispObj *
+Lisp_XtCoerceToWidgetList(LispBuiltin *builtin)
+/*
+ xt-coerce-to-widget-list number opaque
+ */
+{
+    int i;
+    WidgetList children;
+    Cardinal num_children;
+    LispObj *cons, *widget_list, *result;
+
+    LispObj *onumber, *opaque;
+
+    opaque = ARGUMENT(1);
+    onumber = ARGUMENT(0);
+
+    CHECK_INDEX(onumber);
+    num_children = FIXNUM_VALUE(onumber);
+
+    if (!CHECKO(opaque, xtWidgetList_t))
+	LispDestroy("%s: cannot convert %s to WidgetList",
+		    STRFUN(builtin), STROBJ(opaque));
+    children = (WidgetList)(opaque->data.opaque.data);
+
+    GCDisable();
+    widget_list = cons = NIL;
+    for (i = 0; i < num_children; i++) {
+	result = CONS(OPAQUE(children[i], xtWidget_t), NIL);
+	if (widget_list == NIL)
+	    widget_list = cons = result;
+	else {
+	    RPLACD(cons, result);
+	    cons = CDR(cons);
+	}
+    }
+
+    result = APPLY(ATOM("MAKE-XT-WIDGET-LIST"),
+		   CONS(KEYWORD("NUM-CHILDREN"),
+			CONS(INTEGER(num_children),
+			     CONS(KEYWORD("CHILDREN"),
+				  CONS(widget_list, NIL)))));
+    GCEnable();
+
+    return (result);
+}
+
+LispObj *
+Lisp_XtAddCallback(LispBuiltin *builtin)
+/*
+ xt-add-callback widget callback-name callback &optional client-data
+ */
+{
+    CallbackArgs *arguments;
+    LispObj *data;
+
+    LispObj *widget, *callback_name, *callback, *client_data;
+
+    client_data = ARGUMENT(3);
+    callback = ARGUMENT(2);
+    callback_name = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    CHECK_STRING(callback_name);
+    if (!SYMBOLP(callback) && callback->type != LispLambda_t)
+	LispDestroy("%s: %s cannot be used as a callback",
+		    STRFUN(builtin), STROBJ(callback));
+
+    if (client_data == UNSPEC)
+	client_data = NIL;
+
+    data = CONS(widget, CONS(client_data, callback));
+    PROTECT(widget, data);
+
+    arguments = XtNew(CallbackArgs);
+    arguments->data = data;
+
+    XtAddCallback((Widget)(widget->data.opaque.data), THESTR(callback_name),
+		  LispXtCallback, (XtPointer)arguments);
+    XtAddCallback((Widget)(widget->data.opaque.data), XtNdestroyCallback,
+		  LispXtCleanupCallback, (XtPointer)arguments);
+
+    return (client_data);
+}
+
+LispObj *
+Lisp_XtAppAddInput(LispBuiltin *builtin)
+/*
+  xt-app-add-input app-context fileno condition function &optional client-data
+ */
+{
+    LispObj *data, *input;
+    XtAppContext appcon;
+    int source, condition;
+    CallbackArgs *arguments;
+    XtInputId id;
+
+    LispObj *app_context, *fileno, *ocondition, *function, *client_data;
+
+    client_data = ARGUMENT(4);
+    function = ARGUMENT(3);
+    ocondition = ARGUMENT(2);
+    fileno = ARGUMENT(1);
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+    appcon = (XtAppContext)(app_context->data.opaque.data);
+
+    CHECK_LONGINT(fileno);
+    source = LONGINT_VALUE(fileno);
+
+    CHECK_FIXNUM(ocondition);
+    condition = FIXNUM_VALUE(ocondition);
+
+    if (!SYMBOLP(function) && function->type != LispLambda_t)
+	LispDestroy("%s: %s cannot be used as a callback",
+		    STRFUN(builtin), STROBJ(function));
+
+    /* client data optional */
+    if (client_data == UNSPEC)
+	client_data = NIL;
+
+    data = CONS(NIL, CONS(client_data, function));
+
+    arguments = XtNew(CallbackArgs);
+    arguments->data = data;
+
+    id = XtAppAddInput(appcon, source, (XtPointer)condition,
+		       LispXtInputCallback, (XtPointer)arguments);
+    GCDisable();
+    input = OPAQUE(id, xtInputId_t);
+    GCEnable();
+    RPLACA(data, input);
+    PROTECT(input, data);
+
+    if (num_input_list + 1 >= size_input_list) {
+	++size_input_list;
+	input_list = (CallbackArgs**)
+	    XtRealloc((XtPointer)input_list,
+		      sizeof(CallbackArgs*) * size_input_list);
+    }
+    input_list[num_input_list++] = arguments;
+
+    return (input);
+}
+
+LispObj *
+Lisp_XtRemoveInput(LispBuiltin *builtin)
+/*
+ xt-remove-input input
+ */
+{
+    int i;
+    XtInputId id;
+    CallbackArgs *args;
+
+    LispObj *input;
+
+    input = ARGUMENT(0);
+
+    if (!CHECKO(input, xtInputId_t))
+	LispDestroy("%s: cannot convert %s to XtInputId",
+		    STRFUN(builtin), STROBJ(input));
+
+    id = (XtInputId)(input->data.opaque.data);
+    for (i = 0; i < num_input_list; i++) {
+	args = input_list[i];
+	if (id == (XtInputId)(CAR(args->data)->data.opaque.data)) {
+	    UPROTECT(CAR(args->data), args->data);
+	    XtFree((XtPointer)args);
+
+	    if (i + 1 < num_input_list)
+		memmove(input_list + i, input_list + i + 1,
+			sizeof(CallbackArgs*) * (num_input_list - i - 1));
+	    --num_input_list;
+
+	    XtRemoveInput(id);
+
+	    return (T);
+	}
+    }
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtAppInitialize(LispBuiltin *builtin)
+/*
+ xt-app-initialize app-context-return application-class &optional options fallback-resources
+ */
+{
+    XtAppContext appcon;
+    Widget shell;
+    int zero = 0;
+    Resources *resources = NULL;
+    String *fallback = NULL;
+
+    LispObj *app_context_return, *application_class,
+	    *options, *fallback_resources;
+
+    fallback_resources = ARGUMENT(3);
+    options = ARGUMENT(2);
+    application_class = ARGUMENT(1);
+    app_context_return = ARGUMENT(0);
+
+    CHECK_SYMBOL(app_context_return);
+    CHECK_STRING(application_class);
+    CHECK_LIST(options);
+
+    /* check fallback resources, if given */
+    if (fallback_resources != UNSPEC) {
+	LispObj *string;
+	int count;
+
+	CHECK_CONS(fallback_resources);
+	for (string = fallback_resources, count = 0; CONS_P(string);
+	     string = CDR(string), count++)
+	    CHECK_STRING(CAR(string));
+
+	/* fallback resources was correctly specified */
+	fallback = LispMalloc(sizeof(String) * (count + 1));
+	for (string = fallback_resources, count = 0; CONS_P(string);
+	     string = CDR(string), count++)
+	    fallback[count] = THESTR(CAR(string));
+	fallback[count] = NULL;
+    }
+
+    shell = XtAppInitialize(&appcon, THESTR(application_class), NULL,
+			    0, &zero, NULL, fallback, NULL, 0);
+    if (fallback)
+	LispFree(fallback);
+    (void)LispSetVariable(app_context_return,
+			  OPAQUE(appcon, xtAppContext_t),
+			  STRFUN(builtin), 0);
+
+    XtAppAddActions(appcon, actions, XtNumber(actions));
+
+    if (options != UNSPEC) {
+	resources = LispConvertResources(options, shell,
+					 GetResourceList(XtClass(shell)),
+					 NULL);
+	if (resources) {
+	    XtSetValues(shell, resources->args, resources->num_args);
+	    LispFreeResources(resources);
+	}
+    }
+
+    return (OPAQUE(shell, xtWidget_t));
+}
+
+LispObj *
+Lisp_XtAppMainLoop(LispBuiltin *builtin)
+/*
+ xt-app-main-loop app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    XtAppMainLoop((XtAppContext)(app_context->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtAppPending(LispBuiltin *builtin)
+/*
+ xt-app-pending app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    return (INTEGER(
+	    XtAppPending((XtAppContext)(app_context->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XtAppProcessEvent(LispBuiltin *builtin)
+/*
+ xt-app-process-event app-context &optional mask
+ */
+{
+    XtInputMask mask;
+    XtAppContext appcon;
+
+    LispObj *app_context, *omask;
+
+    omask = ARGUMENT(1);
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    appcon = (XtAppContext)(app_context->data.opaque.data);
+    if (omask == UNSPEC)
+	mask = XtIMAll;
+    else {
+	CHECK_FIXNUM(omask);
+	mask = FIXNUM_VALUE(omask);
+    }
+
+    if (mask != (mask & XtIMAll))
+	LispDestroy("%s: %d does not fit in XtInputMask %d",
+		    STRFUN(builtin), mask);
+
+    if (mask)
+	XtAppProcessEvent(appcon, mask);
+
+    return (omask == NIL ? FIXNUM(mask) : omask);
+}
+
+LispObj *
+Lisp_XtRealizeWidget(LispBuiltin *builtin)
+/*
+ xt-realize-widget widget
+ */
+{
+    Widget widget;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    XtRealizeWidget(widget);
+
+    if (XtIsSubclass(widget, shellWidgetClass)) {
+	if (!delete_window)
+	    delete_window = XInternAtom(XtDisplay(widget),
+					"WM_DELETE_WINDOW", False);
+	(void)XSetWMProtocols(XtDisplay(widget), XtWindow(widget),
+			      &delete_window, 1);
+    }
+
+    return (owidget);
+}
+
+LispObj *
+Lisp_XtUnrealizeWidget(LispBuiltin *builtin)
+/*
+ xt-unrealize-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtUnrealizeWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtIsRealized(LispBuiltin *builtin)
+/*
+ xt-is-realized widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (XtIsRealized((Widget)(widget->data.opaque.data)) ? T : NIL);
+}
+
+LispObj *
+Lisp_XtDestroyWidget(LispBuiltin *builtin)
+/*
+ xt-destroy-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtDestroyWidget((Widget)(widget->data.opaque.data));
+
+    return (NIL);
+}
+
+#define UNMANAGED	0
+#define MANAGED		1
+#define SHELL		2
+LispObj *
+Lisp_XtCreateWidget(LispBuiltin *builtin)
+/*
+ xt-create-widget name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, UNMANAGED));
+}
+
+LispObj *
+Lisp_XtCreateManagedWidget(LispBuiltin *builtin)
+/*
+ xt-create-managed-widget name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, MANAGED));
+}
+
+LispObj *
+Lisp_XtCreatePopupShell(LispBuiltin *builtin)
+/*
+ xt-create-popup-shell name widget-class parent &optional arguments
+ */
+{
+    return (LispXtCreateWidget(builtin, SHELL));
+}
+
+LispObj *
+LispXtCreateWidget(LispBuiltin *builtin, int options)
+/*
+ xt-create-widget name widget-class parent &optional arguments
+ xt-create-managed-widget name widget-class parent &optional arguments
+ xt-create-popup-shell name widget-class parent &optional arguments
+ */
+{
+    char *name;
+    WidgetClass widget_class;
+    Widget widget, parent;
+    Resources *resources = NULL;
+
+    LispObj *oname, *owidget_class, *oparent, *arguments;
+
+    arguments = ARGUMENT(3);
+    oparent = ARGUMENT(2);
+    owidget_class = ARGUMENT(1);
+    oname = ARGUMENT(0);
+
+    CHECK_STRING(oname);
+    name = THESTR(oname);
+
+    if (!CHECKO(owidget_class, xtWidgetClass_t))
+	LispDestroy("%s: cannot convert %s to WidgetClass",
+		    STRFUN(builtin), STROBJ(owidget_class));
+    widget_class = (WidgetClass)(owidget_class->data.opaque.data);
+
+    if (!CHECKO(oparent, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(oparent));
+    parent = (Widget)(oparent->data.opaque.data);
+
+    CHECK_LIST(arguments);
+
+    if (options == SHELL)
+	widget = XtCreatePopupShell(name, widget_class, parent, NULL, 0);
+    else
+	widget = XtCreateWidget(name, widget_class, parent, NULL, 0);
+
+    if (arguments == UNSPEC || arguments == NIL)
+	resources = NULL;
+    else {
+	resources = LispConvertResources(arguments, widget,
+					 GetResourceList(widget_class),
+					 GetResourceList(XtClass(parent)));
+	XtSetValues(widget, resources->args, resources->num_args);
+    }
+    if (options == MANAGED)
+	XtManageChild(widget);
+    if (resources)
+	LispFreeResources(resources);
+
+    return (OPAQUE(widget, xtWidget_t));
+}
+
+LispObj *
+Lisp_XtGetKeyboardFocusWidget(LispBuiltin *builtin)
+/*
+ xt-get-keyboard-focus-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    return (OPAQUE(XtGetKeyboardFocusWidget((Widget)(widget->data.opaque.data)),
+		   xtWidget_t));
+}
+
+LispObj *
+Lisp_XtGetValues(LispBuiltin *builtin)
+/*
+ xt-get-values widget arguments
+ */
+{
+    Arg args[1];
+    Widget widget;
+    ResourceList *rlist, *plist;
+    ResourceInfo *resource;
+    LispObj *list, *object = NIL, *result, *cons = NIL;
+    char c1;
+    short c2;
+    int c4;
+#ifdef LONG64
+    long c8;
+#endif
+
+    LispObj *owidget, *arguments;
+
+    arguments = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (arguments == NIL)
+	return (NIL);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    CHECK_CONS(arguments);
+
+    rlist = GetResourceList(XtClass(widget));
+    plist =  XtParent(widget) ?
+	     GetResourceList(XtClass(XtParent(widget))) : NULL;
+
+    GCDisable();
+    result = NIL;
+    for (list = arguments; CONS_P(list); list = CDR(list)) {
+	CHECK_STRING(CAR(list));
+	if ((resource = GetResourceInfo(THESTR(CAR(list)), rlist, plist))
+	     == NULL) {
+	    int i;
+	    Widget child;
+
+	    for (i = 0; i < rlist->num_resources; i++) {
+		if (rlist->resources[i]->qtype == qWidget) {
+		    XtSetArg(args[0],
+			     XrmQuarkToString(rlist->resources[i]->qname),
+			     &child);
+		    XtGetValues(widget, args, 1);
+		    if (child && XtParent(child) == widget) {
+			resource =
+			    GetResourceInfo(THESTR(CAR(list)),
+					    GetResourceList(XtClass(child)),
+					    NULL);
+			if (resource)
+			    break;
+		    }
+		}
+	    }
+	    if (resource == NULL) {
+		LispMessage("%s: resource %s not available",
+			    STRFUN(builtin), THESTR(CAR(list)));
+		continue;
+	    }
+	}
+	switch (resource->size) {
+	    case 1:
+		XtSetArg(args[0], THESTR(CAR(list)), &c1);
+		break;
+	    case 2:
+		XtSetArg(args[0], THESTR(CAR(list)), &c2);
+		break;
+	    case 4:
+		XtSetArg(args[0], THESTR(CAR(list)), &c4);
+		break;
+#ifdef LONG64
+	    case 1:
+		XtSetArg(args[0], THESTR(CAR(list)), &c8);
+		break;
+#endif
+	}
+	XtGetValues(widget, args, 1);
+
+	/* special resources */
+	if (resource->qtype == qString) {
+#ifdef LONG64
+	    object = CONS(CAR(list), STRING(c8));
+#else
+	    object = CONS(CAR(list), STRING(c4));
+#endif
+	}
+	else if (resource->qtype == qCardinal || resource->qtype == qInt) {
+#ifdef LONG64
+	    if (sizeof(int) == 8)
+		object = CONS(CAR(list), INTEGER(c8));
+	    else
+#endif
+	    object = CONS(CAR(list), INTEGER(c4));
+	}
+	else {
+	    switch (resource->size) {
+		case 1:
+		    object = CONS(CAR(list), OPAQUE(c1, 0));
+		    break;
+		case 2:
+		    object = CONS(CAR(list), OPAQUE(c2, 0));
+		    break;
+		case 4:
+		    object = CONS(CAR(list), OPAQUE(c4, 0));
+		    break;
+#ifdef LONG64
+		case 8:
+		    object = CONS(CAR(list), OPAQUE(c8, 0));
+		    break;
+#endif
+	    }
+	}
+
+	if (result == NIL)
+	    result = cons = CONS(object, NIL);
+	else {
+	    RPLACD(cons, CONS(object, NIL));
+	    cons = CDR(cons);
+	}
+    }
+    GCEnable();
+
+    return (result);
+}
+
+LispObj *
+Lisp_XtManageChild(LispBuiltin *builtin)
+/*
+ xt-manage-child widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtManageChild((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtUnmanageChild(LispBuiltin *builtin)
+/*
+ xt-unmanage-child widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtUnmanageChild((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtMapWidget(LispBuiltin *builtin)
+/*
+ xt-map-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtMapWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtUnmapWidget(LispBuiltin *builtin)
+/*
+ xt-unmap-widget widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtUnmapWidget((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetMappedWhenManaged(LispBuiltin *builtin)
+/*
+ xt-set-mapped-when-managed widget map-when-managed
+ */
+{
+    LispObj *widget, *map_when_managed;
+
+    map_when_managed = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtSetMappedWhenManaged((Widget)(widget->data.opaque.data),
+			   map_when_managed != NIL);
+
+    return (map_when_managed);
+}
+
+LispObj *
+Lisp_XtPopup(LispBuiltin *builtin)
+/*
+ xt-popup widget grab-kind
+ */
+{
+    XtGrabKind kind;
+
+    LispObj *widget, *grab_kind;
+
+    grab_kind = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    CHECK_INDEX(grab_kind);
+    kind = (XtGrabKind)FIXNUM_VALUE(grab_kind);
+    if (kind != XtGrabExclusive && kind != XtGrabNone &&
+	kind != XtGrabNonexclusive)
+	LispDestroy("%s: %d does not fit in XtGrabKind",
+		    STRFUN(builtin), kind);
+    XtPopup((Widget)(widget->data.opaque.data), kind);
+
+    return (grab_kind);
+}
+
+LispObj *
+Lisp_XtPopdown(LispBuiltin *builtin)
+/*
+ xt-popdown widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtPopdown((Widget)(widget->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetKeyboardFocus(LispBuiltin *builtin)
+/*
+ xt-set-keyboard-focus widget descendant
+ */
+{
+    LispObj *widget, *descendant;
+
+    descendant = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    if (!CHECKO(descendant, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(descendant));
+    XtSetKeyboardFocus((Widget)(widget->data.opaque.data),
+		       (Widget)(descendant->data.opaque.data));
+
+    return (widget);
+}
+
+LispObj *
+Lisp_XtSetSensitive(LispBuiltin *builtin)
+/*
+ xt-set-sensitive widget sensitive
+ */
+{
+    LispObj *widget, *sensitive;
+
+    sensitive = ARGUMENT(1);
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+    XtSetSensitive((Widget)(widget->data.opaque.data), sensitive != NIL);
+
+    return (sensitive);
+}
+
+LispObj *
+Lisp_XtSetValues(LispBuiltin *builtin)
+/*
+ xt-set-values widget arguments
+ */
+{
+    Widget widget;
+    Resources *resources;
+
+    LispObj *owidget, *arguments;
+
+    arguments = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (arguments == NIL)
+	return (owidget);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    CHECK_CONS(arguments);
+    resources = LispConvertResources(arguments, widget,
+				     GetResourceList(XtClass(widget)),
+				     XtParent(widget) ?
+					GetResourceList(XtClass(XtParent(widget))) :
+					NULL);
+    XtSetValues(widget, resources->args, resources->num_args);
+    LispFreeResources(resources);
+
+    return (owidget);
+}
+
+LispObj *
+Lisp_XtWidgetToApplicationContext(LispBuiltin *builtin)
+/*
+ xt-widget-to-application-context widget
+ */
+{
+    Widget widget;
+    XtAppContext appcon;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    appcon = XtWidgetToApplicationContext(widget);
+
+    return (OPAQUE(appcon, xtAppContext_t));
+}
+
+LispObj *
+Lisp_XtDisplay(LispBuiltin *builtin)
+/*
+ xt-display widget
+ */
+{
+    Widget widget;
+    Display *display;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    display = XtDisplay(widget);
+
+    return (OPAQUE(display, xtDisplay_t));
+}
+
+LispObj *
+Lisp_XtDisplayOfObject(LispBuiltin *builtin)
+/*
+ xt-display-of-object object
+ */
+{
+    Widget widget;
+    Display *display;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    display = XtDisplayOfObject(widget);
+
+    return (OPAQUE(display, xtDisplay_t));
+}
+
+LispObj *
+Lisp_XtScreen(LispBuiltin *builtin)
+/*
+ xt-screen widget
+ */
+{
+    Widget widget;
+    Screen *screen;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    screen = XtScreen(widget);
+
+    return (OPAQUE(screen, xtScreen_t));
+}
+
+LispObj *
+Lisp_XtScreenOfObject(LispBuiltin *builtin)
+/*
+ xt-screen-of-object object
+ */
+{
+    Widget widget;
+    Screen *screen;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    screen = XtScreenOfObject(widget);
+
+    return (OPAQUE(screen, xtScreen_t));
+}
+
+LispObj *
+Lisp_XtWindow(LispBuiltin *builtin)
+/*
+ xt-window widget
+ */
+{
+    Widget widget;
+    Window window;
+
+    LispObj *owidget;
+
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    window = XtWindow(widget);
+
+    return (OPAQUE(window, xtWindow_t));
+}
+
+LispObj *
+Lisp_XtWindowOfObject(LispBuiltin *builtin)
+/*
+ xt-window-of-object widget
+ */
+{
+    Widget widget;
+    Window window;
+
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    if (!CHECKO(object, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(object));
+    widget = (Widget)(object->data.opaque.data);
+    window = XtWindowOfObject(widget);
+
+    return (OPAQUE(window, xtWindow_t));
+}
+
+LispObj *
+Lisp_XtAddGrab(LispBuiltin *builtin)
+/*
+ xt-add-grab widget exclusive spring-loaded
+ */
+{
+    Widget widget;
+    Bool exclusive, spring_loaded;
+
+    LispObj *owidget, *oexclusive, *ospring_loaded;
+
+    ospring_loaded = ARGUMENT(2);
+    oexclusive = ARGUMENT(1);
+    owidget = ARGUMENT(0);
+
+    if (!CHECKO(owidget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(owidget));
+    widget = (Widget)(owidget->data.opaque.data);
+    exclusive = oexclusive != NIL;
+    spring_loaded = ospring_loaded != NIL;
+
+    XtAddGrab(widget, exclusive, spring_loaded);
+
+    return (T);
+}
+
+LispObj *
+Lisp_XtRemoveGrab(LispBuiltin *builtin)
+/*
+ xt-remove-grab widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    XtRemoveGrab((Widget)(widget->data.opaque.data));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_XtName(LispBuiltin *builtin)
+/*
+ xt-name widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (STRING(XtName((Widget)(widget->data.opaque.data))));
+}
+
+LispObj *
+Lisp_XtParent(LispBuiltin *builtin)
+/*
+ xt-parent widget
+ */
+{
+    LispObj *widget;
+
+    widget = ARGUMENT(0);
+
+    if (!CHECKO(widget, xtWidget_t))
+	LispDestroy("%s: cannot convert %s to Widget",
+		    STRFUN(builtin), STROBJ(widget));
+
+    return (OPAQUE(XtParent((Widget)widget->data.opaque.data), xtWidget_t));
+}
+
+LispObj *
+Lisp_XtAppGetExitFlag(LispBuiltin *builtin)
+/*
+ xt-app-get-exit-flag app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    return (XtAppGetExitFlag((XtAppContext)(app_context->data.opaque.data)) ?
+	    T : NIL);
+}
+
+LispObj *
+Lisp_XtAppSetExitFlag(LispBuiltin *builtin)
+/*
+ xt-app-get-exit-flag app-context
+ */
+{
+    LispObj *app_context;
+
+    app_context = ARGUMENT(0);
+
+    if (!CHECKO(app_context, xtAppContext_t))
+	LispDestroy("%s: cannot convert %s to XtAppContext",
+		    STRFUN(builtin), STROBJ(app_context));
+
+    XtAppSetExitFlag((XtAppContext)(app_context->data.opaque.data));
+
+    return (T);
+}
+
+static Resources *
+LispConvertResources(LispObj *list, Widget widget,
+		     ResourceList *rlist, ResourceList *plist)
+{
+    char c1;
+    short c2;
+    int c4;   
+#ifdef LONG64
+    long c8;
+#endif
+    XrmValue from, to;
+    LispObj *arg, *val;
+    ResourceInfo *resource;
+    char *fname = "XT-CONVERT-RESOURCES";
+    Resources *resources = (Resources*)XtCalloc(1, sizeof(Resources));
+
+    for (; CONSP(list); list = CDR(list)) {
+	if (!CONSP(CAR(list))) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: %s is not a cons", fname, STROBJ(CAR(list)));
+	}
+	arg = CAR(CAR(list));
+	val = CDR(CAR(list));
+
+	if (!STRINGP(arg)) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: %s is not a string", fname, STROBJ(arg));
+	}
+
+	if ((resource = GetResourceInfo(THESTR(arg), rlist, plist)) == NULL) {
+	    int i;
+	    Arg args[1];
+	    Widget child;
+
+	    for (i = 0; i < rlist->num_resources; i++) {
+		if (rlist->resources[i]->qtype == qWidget) {
+		    XtSetArg(args[0],
+			     XrmQuarkToString(rlist->resources[i]->qname),
+			     &child);
+		    XtGetValues(widget, args, 1);
+		    if (child && XtParent(child) == widget) {
+			resource =
+			    GetResourceInfo(THESTR(arg),
+					    GetResourceList(XtClass(child)),
+					    NULL);
+			if (resource)
+			    break;
+		    }
+		}
+	    }
+	    if (resource == NULL) {
+		LispMessage("%s: resource %s not available",
+			    fname, THESTR(arg));
+		continue;
+	    }
+	}
+
+	if (LONGINTP(val) || DFLOATP(val) || OPAQUEP(val)) {
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    if (!OPAQUEP(val)) {
+		float fvalue;
+
+		if (DFLOATP(val))
+		    fvalue = DFLOAT_VALUE(val);
+		else
+		    fvalue = LONGINT_VALUE(val);
+		if (resource->qtype == qFloat) {
+		    XtSetArg(resources->args[resources->num_args],
+			     XrmQuarkToString(resource->qname), fvalue);
+		}
+		else
+		    XtSetArg(resources->args[resources->num_args],
+			     XrmQuarkToString(resource->qname),
+			     (int)fvalue);
+	    }
+	    else
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), val->data.opaque.data);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (val == NIL) {
+	    /* XXX assume it is a pointer or a boolean */
+#ifdef DEBUG
+	    LispWarning("%s: assuming %s is a pointer or boolean",
+			fname, XrmQuarkToString(resource->qname));
+#endif
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    XtSetArg(resources->args[resources->num_args],
+		     XrmQuarkToString(resource->qname), NULL);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (val == T) {
+	    /* XXX assume it is a boolean */
+#ifdef DEBUG
+	    LispWarning("%s: assuming %s is a boolean",
+			fname, XrmQuarkToString(resource->qname));
+#endif
+	    resources->args = (Arg*)
+		XtRealloc((XtPointer)resources->args,
+			  sizeof(Arg) * (resources->num_args + 1));
+	    XtSetArg(resources->args[resources->num_args],
+		     XrmQuarkToString(resource->qname), True);
+	    ++resources->num_args;
+	    continue;
+	}
+	else if (!STRINGP(val)) {
+	    XtFree((XtPointer)resources);
+	    LispDestroy("%s: resource value must be string, number or opaque, not %s",
+			fname, STROBJ(val));
+	}
+
+	from.size = val == NIL ? 1 : strlen(THESTR(val)) + 1;
+	from.addr = val == NIL ? "" : THESTR(val);
+	switch (to.size = resource->size) {
+	    case 1:
+		to.addr = (XtPointer)&c1;
+		break;
+	    case 2:
+		to.addr = (XtPointer)&c2;
+		break;
+	    case 4:
+		to.addr = (XtPointer)&c4;
+		break;
+#ifdef LONG64
+	    case 8:
+		to.addr = (XtPointer)&c8;
+		break;
+#endif
+	    default:
+		LispWarning("%s: bad resource size %d for %s",
+			    fname, to.size, THESTR(arg));
+		continue;
+	}
+
+	if (qString == resource->qtype)
+#ifdef LONG64
+	    c8 = (long)from.addr;
+#else
+	    c4 = (long)from.addr;
+#endif
+	else if (!XtConvertAndStore(widget, XtRString, &from,
+				    XrmQuarkToString(resource->qtype), &to))
+	    /* The type converter already have printed an error message */
+	    continue;
+
+	resources->args = (Arg*)
+	    XtRealloc((XtPointer)resources->args,
+		      sizeof(Arg) * (resources->num_args + 1));
+	switch (to.size) {
+	    case 1:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c1);
+		break;
+	    case 2:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c2);
+		break;
+	    case 4:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c4);
+		break;
+#ifdef LONG64
+	    case 8:
+		XtSetArg(resources->args[resources->num_args],
+			 XrmQuarkToString(resource->qname), c8);
+		break;
+#endif
+	}
+	++resources->num_args;
+    }
+
+    return (resources);
+}
+
+static void
+LispFreeResources(Resources *resources)
+{
+    if (resources) {
+	XtFree((XtPointer)resources->args);
+	XtFree((XtPointer)resources);
+    }
+}
+
+static int
+bcmp_action_resource(_Xconst void *string, _Xconst void *resource)
+{
+    return (strcmp((String)string,
+		   XrmQuarkToString((*(ResourceInfo**)resource)->qname)));
+}   
+
+static ResourceInfo *
+GetResourceInfo(char *name, ResourceList *rlist, ResourceList *plist)
+{
+    ResourceInfo **resource = NULL;
+
+    if (rlist->resources)
+	resource = (ResourceInfo**)
+	    bsearch(name, rlist->resources, rlist->num_resources,
+		    sizeof(ResourceInfo*), bcmp_action_resource);
+
+    if (resource == NULL && plist) {
+	resource = (ResourceInfo**)
+	  bsearch(name, &plist->resources[plist->num_resources],
+		  plist->num_cons_resources, sizeof(ResourceInfo*),
+		  bcmp_action_resource);
+    }
+
+    return (resource ? *resource : NULL);
+}
+
+static ResourceList *
+GetResourceList(WidgetClass wc)
+{
+    ResourceList *list;
+
+    if ((list = FindResourceList(wc)) == NULL)
+	list = CreateResourceList(wc);
+
+    return (list);
+}
+
+static int
+bcmp_action_resource_list(_Xconst void *wc, _Xconst void *list)
+{
+    return ((char*)wc - (char*)((*(ResourceList**)list)->widget_class));
+}
+
+static ResourceList *
+FindResourceList(WidgetClass wc)
+{  
+    ResourceList **list;
+
+    if (!resource_list)
+	return (NULL);
+
+    list = (ResourceList**)
+	bsearch(wc, resource_list, num_resource_list,
+		sizeof(ResourceList*),  bcmp_action_resource_list);
+
+    return (list ? *list : NULL);
+}
+
+static int
+qcmp_action_resource_list(_Xconst void *left, _Xconst void *right)
+{
+    return ((char*)((*(ResourceList**)left)->widget_class) -
+	    (char*)((*(ResourceList**)right)->widget_class));
+}
+
+static ResourceList *
+CreateResourceList(WidgetClass wc)
+{
+    ResourceList *list;
+
+    list = (ResourceList*)XtMalloc(sizeof(ResourceList));
+    list->widget_class = wc;
+    list->num_resources = list->num_cons_resources = 0;
+    list->resources = NULL;
+
+    resource_list = (ResourceList**)
+	XtRealloc((XtPointer)resource_list, sizeof(ResourceList*) *
+		  (num_resource_list + 1));
+    resource_list[num_resource_list++] = list;
+    qsort(resource_list, num_resource_list, sizeof(ResourceList*),
+	  qcmp_action_resource_list);
+    BindResourceList(list);
+
+    return (list);
+}
+
+static int
+qcmp_action_resource(_Xconst void *left, _Xconst void *right)
+{
+    return (strcmp(XrmQuarkToString((*(ResourceInfo**)left)->qname),
+		   XrmQuarkToString((*(ResourceInfo**)right)->qname)));
+}
+
+static void
+BindResourceList(ResourceList *list)
+{
+    XtResourceList xt_list, cons_list;
+    Cardinal i, num_xt, num_cons;
+
+    XtGetResourceList(list->widget_class, &xt_list, &num_xt);
+    XtGetConstraintResourceList(list->widget_class, &cons_list, &num_cons);
+    list->num_resources = num_xt;
+    list->num_cons_resources = num_cons;
+
+    list->resources = (ResourceInfo**)
+	XtMalloc(sizeof(ResourceInfo*) * (num_xt + num_cons));
+
+    for (i = 0; i < num_xt; i++) {
+	list->resources[i] = (ResourceInfo*)XtMalloc(sizeof(ResourceInfo));
+	list->resources[i]->qname =
+	    XrmPermStringToQuark(xt_list[i].resource_name);
+	list->resources[i]->qtype =
+	    XrmPermStringToQuark(xt_list[i].resource_type);
+	list->resources[i]->size = xt_list[i].resource_size;
+    }
+
+    for (; i < num_xt + num_cons; i++) {
+	list->resources[i] = (ResourceInfo*)XtMalloc(sizeof(ResourceInfo));
+	list->resources[i]->qname =
+	    XrmPermStringToQuark(cons_list[i - num_xt].resource_name);
+	list->resources[i]->qtype =
+	    XrmPermStringToQuark(cons_list[i - num_xt].resource_type);
+	list->resources[i]->size = cons_list[i - num_xt].resource_size;
+    }
+
+    XtFree((XtPointer)xt_list);
+    if (cons_list)
+	XtFree((XtPointer)cons_list);
+
+    qsort(list->resources, list->num_resources, sizeof(ResourceInfo*),
+	  qcmp_action_resource);
+    if (num_cons)
+	qsort(&list->resources[num_xt], list->num_cons_resources,
+	      sizeof(ResourceInfo*), qcmp_action_resource);
+}
+
+/*ARGSUSED*/
+static void
+PopdownAction(Widget w, XEvent *event, String *params, Cardinal *num_params)
+{
+    XtPopdown(w);
+}
+
+/*ARGSUSED*/
+static void
+QuitAction(Widget w, XEvent *event, String *params, Cardinal *num_params)
+{
+    XtAppSetExitFlag(XtWidgetToApplicationContext(w));
+}
diff --git a/lisp/mp/mp.c b/lisp/mp/mp.c
new file mode 100644
index 0000000..78b7a0e
--- /dev/null
+++ b/lisp/mp/mp.c
@@ -0,0 +1,822 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/mp/mp.c,v 1.3 2002/11/20 07:44:43 paulo Exp $ */
+
+#include "mp.h"
+
+/*
+ * TODO:
+ *	o Optimize squaring
+ *	o Write better division code and move from mpi.c to here
+ *	o Make multiplication code don't required memory to be zeroed
+ *		+ The first step is easy, just multiply the low word,
+ *		then the high word, that may overlap with the result
+ *		of the first multiply (in case of carry), and then
+ *		just make sure carry is properly propagated in the
+ *		subsequent multiplications.
+ *		+ Some code needs also to be rewritten because some
+ *		intermediate addition code in mp_mul, mp_karatsuba_mul,
+ *		and mp_toom_mul is assuming the memory is zeroed.
+ */
+
+/*
+ * Prototypes
+ */
+	/* out of memory handler */
+static void mp_outmem(void);
+
+	/* memory allocation fallback functions */
+static void *_mp_malloc(size_t);
+static void *_mp_calloc(size_t, size_t);
+static void *_mp_realloc(void*, size_t);
+static void _mp_free(void*);
+
+/*
+ * Initialization
+ */
+static mp_malloc_fun __mp_malloc = _mp_malloc;
+static mp_calloc_fun __mp_calloc = _mp_calloc;
+static mp_realloc_fun __mp_realloc = _mp_realloc;
+static mp_free_fun __mp_free = _mp_free;
+
+/*
+ * Implementation
+ */
+static void
+mp_outmem(void)
+{
+    fprintf(stderr, "out of memory in MP library.\n");
+    exit(1);
+}
+
+static void *
+_mp_malloc(size_t size)
+{
+    return (malloc(size));
+}
+
+void *
+mp_malloc(size_t size)
+{
+    void *pointer = (*__mp_malloc)(size);
+
+    if (pointer == NULL)
+	mp_outmem();
+
+    return (pointer);
+}
+
+mp_malloc_fun
+mp_set_malloc(mp_malloc_fun fun)
+{
+    mp_malloc_fun old = __mp_malloc;
+
+    __mp_malloc = fun;
+
+    return (old);
+}
+
+static void *
+_mp_calloc(size_t nmemb, size_t size)
+{
+    return (calloc(nmemb, size));
+}
+
+void *
+mp_calloc(size_t nmemb, size_t size)
+{
+    void *pointer = (*__mp_calloc)(nmemb, size);
+
+    if (pointer == NULL)
+	mp_outmem();
+
+    return (pointer);
+}
+
+mp_calloc_fun
+mp_set_calloc(mp_calloc_fun fun)
+{
+    mp_calloc_fun old = __mp_calloc;
+
+    __mp_calloc = fun;
+
+    return (old);
+}
+
+static void *
+_mp_realloc(void *old, size_t size)
+{
+    return (realloc(old, size));
+}
+
+void *
+mp_realloc(void *old, size_t size)
+{
+    void *pointer = (*__mp_realloc)(old, size);
+
+    if (pointer == NULL)
+	mp_outmem();
+
+    return (pointer);
+}
+
+mp_realloc_fun
+mp_set_realloc(mp_realloc_fun fun)
+{
+    mp_realloc_fun old = __mp_realloc;
+
+    __mp_realloc = fun;
+
+    return (old);
+}
+
+static void
+_mp_free(void *pointer)
+{
+    free(pointer);
+}
+
+void
+mp_free(void *pointer)
+{
+    (*__mp_free)(pointer);
+}
+
+mp_free_fun
+mp_set_free(mp_free_fun fun)
+{
+    mp_free_fun old = __mp_free;
+
+    __mp_free = fun;
+
+    return (old);
+}
+
+long
+mp_add(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2)
+{
+    BNI value;			/* intermediate result */
+    BNS carry;			/* carry flag */
+    long size;			/* result size */
+
+    if (len1 < len2)
+	MP_SWAP(op1, op2, len1, len2);
+
+    /* unroll start of loop */
+    value = op1[0] + op2[0];
+    rop[0] = value;
+    carry = value >> BNSBITS;
+
+    /* add op1 and op2 */
+    for (size = 1; size < len2; size++) {
+	value = op1[size] + op2[size] + carry;
+	rop[size] = value;
+	carry = value >> BNSBITS;
+    }
+    if (rop != op1) {
+	for (; size < len1; size++) {
+	    value = op1[size] + carry;
+	    rop[size] = value;
+	    carry = value >> BNSBITS;
+	}
+    }
+    else {
+	/* if rop == op1, than just adjust carry */
+	for (; carry && size < len1; size++) {
+	    value = op1[size] + carry;
+	    rop[size] = value;
+	    carry = value >> BNSBITS;
+	}
+	size = len1;
+    }
+    if (carry)
+	rop[size++] = carry;
+
+    return (size);
+}
+
+long
+mp_sub(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2)
+{
+    long svalue;		/* intermediate result */
+    BNS carry;			/* carry flag */
+    long size;			/* result size */
+
+    /* special case */
+    if (op1 == op2) {
+	rop[0] = 0;
+
+	return (1);
+    }
+
+    /* unroll start of loop */
+    svalue = op1[0] - op2[0];
+    rop[0] = svalue;
+    carry = svalue < 0;
+
+    /* subtracts op2 from op1 */
+    for (size = 1; size < len2; size++) {
+	svalue = (long)(op1[size]) - op2[size] - carry;
+	rop[size] = svalue;
+	carry = svalue < 0;
+    }
+    if (rop != op1) {
+	for (; size < len1; size++) {
+	    svalue = op1[size] - carry;
+	    rop[size] = svalue;
+	    carry = svalue < 0;
+	}
+    }
+    else {
+	/* if rop == op1, than just adjust carry */
+	for (; carry && size < len1; size++) {
+	    svalue = op1[size] - carry;
+	    rop[size] = svalue;
+	    carry = svalue < 0;
+	}
+	size = len1;
+    }
+
+    /* calculate result size */
+    while (size > 1 && rop[size - 1] == 0)
+	--size;
+
+    return (size);
+}
+
+long
+mp_lshift(BNS *rop, BNS *op, BNI len, long shift)
+{
+    long i, size;
+    BNI words, bits;		/* how many word and bit shifts */
+
+    words = shift / BNSBITS;
+    bits = shift % BNSBITS;
+    size = len + words;
+
+    if (bits) {
+	BNS hi, lo;
+	BNI carry;
+	int adj;
+
+	for (i = 1, carry = CARRY >> 1; carry; i++, carry >>= 1)
+	    if (op[len - 1] & carry)
+		break;
+	adj = (bits + (BNSBITS - i)) / BNSBITS;
+	size += adj;
+
+	lo = hi = op[0];
+	rop[words] = lo << bits;
+	for (i = 1; i < len; i++) {
+	    hi = op[i];
+	    rop[words + i] = hi << bits | (lo >> (BNSBITS - bits));
+	    lo = hi;
+	}
+	if (adj)
+	    rop[size - 1] = hi >> (BNSBITS - bits);
+    }
+    else
+	memmove(rop + size - len, op, sizeof(BNS) * len);
+
+    if (words)
+	memset(rop, '\0', sizeof(BNS) * words);
+
+    return (size);
+}
+
+long
+mp_rshift(BNS *rop, BNS *op, BNI len, long shift)
+{
+    int adj = 0;
+    long i, size;
+    BNI words, bits;		/* how many word and bit shifts */
+
+    words = shift / BNSBITS;
+    bits = shift % BNSBITS;
+    size = len - words;
+
+    if (bits) {
+	BNS hi, lo;
+	BNI carry;
+
+	for (i = 0, carry = CARRY >> 1; carry; i++, carry >>= 1)
+	    if (op[len - 1] & carry)
+		break;
+	adj = (bits + i) / BNSBITS;
+	if (size - adj == 0) {
+	    rop[0] = 0;
+
+	    return (1);
+	}
+
+	hi = lo = op[words + size - 1];
+	rop[size - 1] = hi >> bits;
+	for (i = size - 2; i >= 0; i--) {
+	    lo = op[words + i];
+	    rop[i] = (lo >> bits) | (hi << (BNSBITS - bits));
+	    hi = lo;
+	}
+	if (adj)
+	    rop[0] |= lo << (BNSBITS - bits);
+    }
+    else
+	memmove(rop, op + len - size, size * sizeof(BNS));
+
+    return (size - adj);
+}
+
+	/* rop must be a pointer to len1 + len2 elements
+	 * rop cannot be either op1 or op2
+	 * rop must be all zeros */
+long
+mp_base_mul(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2)
+{
+    long i, j;			/* counters */
+    BNI value;			/* intermediate result */
+    BNS carry;			/* carry value */
+    long size = len1 + len2;
+
+    /* simple optimization: first pass does not need to deference rop[i+j] */
+    if (op1[0]) {
+	value = (BNI)(op1[0]) * op2[0];
+	rop[0] = value;
+	carry = (BNS)(value >> BNSBITS);
+	for (j = 1; j < len2; j++) {
+	    value = (BNI)(op1[0]) * op2[j] + carry;
+	    rop[j] = value;
+	    carry = (BNS)(value >> BNSBITS);
+	}
+	rop[j] = carry;
+    }
+
+    /* do the multiplication */
+    for (i = 1; i < len1; i++) {
+	if (op1[i]) {
+	    /* unrool loop initialization */
+	    value = (BNI)(op1[i]) * op2[0] + rop[i];
+	    rop[i] = value;
+	    carry = (BNS)(value >> BNSBITS);
+	    /* multiply */
+	    for (j = 1; j < len2; j++) {
+		value = (BNI)(op1[i]) * op2[j] + rop[i + j] + carry;
+		rop[i + j] = value;
+		carry = (BNS)(value >> BNSBITS);
+	    }
+	    rop[i + j] = carry;
+	}
+    }
+
+    if (size > 1 && rop[size - 1] == 0)
+	--size;
+
+    return (size);
+}
+
+	/* Karatsuba method
+	 * t + ((a0 + a1) (b0 + b1) - t - u) x + ux²
+	 * where t = a0b0 and u = a1b1
+	 *
+	 * Karatsuba method reduces the number of multiplications. Example:
+	 *	Square a 40 length number
+	 *	instead of a plain 40*40 = 1600 multiplies/adds, it does:
+	 *	20*20+20*20+20*20 = 1200
+	 *	but since it is recursive, every 20*20=400 is reduced to
+	 *	10*10+10*10+10*10=300
+	 *	and so on.
+	 * The multiplication by x and x² is a just a shift, as it is a
+	 * power of two, and is implemented below by just writting at the
+	 * correct offset */
+long
+mp_karatsuba_mul(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2)
+{
+    BNI x;				/* shift count */
+    BNI la0, la1, lb0, lb1;		/* length of a0, a1, b0, and b1 */
+    BNS *t;				/* temporary memory for t product */
+    BNS *u;				/* temporary memory for u product */
+    BNS *r;				/* pointer to rop */
+    long xlen, tlen, ulen;
+
+    /* calculate value of x, that is 2^(BNSBITS*x) */
+    if (len1 >= len2)
+	x = (len1 + 1) >> 1;
+    else
+	x = (len2 + 1) >> 1;
+
+    /* calculate length of operands */
+    la0 = x;
+    la1 = len1 - x;
+    lb0 = x;
+    lb1 = len2 - x;
+
+    /* allocate buffer for t and (a0 + a1) */
+    tlen = la0 + lb0;
+    t = mp_malloc(sizeof(BNS) * tlen);
+
+    /* allocate buffer for u and (b0 + b1) */
+    if (la1 + lb1 < lb0 + lb1 + 1)
+	ulen = lb0 + lb1 + 1;
+    else
+	ulen = la1 + lb1;
+    u = mp_malloc(sizeof(BNS) * ulen);
+
+    /* calculate a0 + a1, store result in t */
+    tlen = mp_add(t, op1, op1 + x, la0, la1);
+
+    /* calculate b0 + b1, store result in u */
+    ulen = mp_add(u, op2, op2 + x, lb0, lb1);
+
+    /* store (a0 + a1) * (b0 + b1) in rop */
+
+    r = rop + x;		/* multiplied by 2^(BNSBITS*x) */
+    xlen = mp_mul(r, t, u, tlen, ulen);
+
+    /* must zero t and u memory, this is required for mp_mul */
+
+    /* calculate t = a0 * b0 */
+    tlen = la0 + lb0;
+    memset(t, '\0', sizeof(BNS) * tlen);
+    tlen = mp_mul(t, op1, op2, la0, lb0);
+
+    /* calculate u = a1 * b1 */
+    ulen = la1 + lb1;
+    memset(u, '\0', sizeof(BNS) * ulen);
+    ulen = mp_mul(u, op1 + x, op2 + x, la1, lb1);
+
+    /* subtract t from partial result */
+    xlen = mp_sub(r, r, t, xlen, tlen);
+
+    /* subtract u form partial result */
+    xlen = mp_sub(r, r, u, xlen, ulen);
+
+    /* add ux^2 to partial result */
+
+    r = rop + (x << 1);		/* multiplied by x^2 = 2^(BNSBITS*x*2) */
+    xlen = len1 + len2;
+    xlen = mp_add(r, r, u, xlen, ulen);
+
+    /* now add t to final result */
+    xlen = mp_add(rop, rop, t, xlen, tlen);
+
+    mp_free(t);
+    mp_free(u);
+
+    if (xlen > 1 && rop[xlen - 1] == 0)
+	--xlen;
+
+    return (xlen);
+}
+
+	/* Toom method	(partially based on GMP documentation)
+	 * Evaluation at k = [ 0 1/2 1 2 oo ]
+	 * U(x) = (U2k + U1)k + U0
+	 * V(x) = (V2k + V1)k + V0
+	 * W(x) = U(x)V(x)
+	 *
+	 * Sample:
+	 *	123 * 456
+	 *
+	 *	EVALUATION:
+	 * U(0) = (1*0+2)*0+3	=> 3
+	 * U(1) = 1+(2+3*2)*2	=> 17
+	 * U(2) = 1+2+3		=> 6
+	 * U(3) = (1*2+2)*2+3	=> 11
+	 * U(4)	= 1+(2+3*0)*0	=> 1
+	 *
+	 * V(0) = (4*0+5)*0+6	=> 6
+	 * V(1) = 4+(5+6*2)*2	=> 38
+	 * V(2) = 4+5+6		=> 15
+	 * V(3) = (4*2+5)*2+6	=> 32
+	 * V(4)	= 4+(5+6*0)*0	=> 4
+	 *
+	 *	U = [ 3   17  6  11 1 ]
+	 *	V = [ 6   38 15  32 4 ]
+	 *	W = [ 18 646 90 352 4 ]
+	 *
+	 * After that, we have:
+	 *	a = 18					(w0 already known)
+	 *	b = 16w0 + 8w1 + 4w2 + 2w3 +   w4
+	 *	c =   w0 +  w1 +  w2 +  w3 +   w4
+	 *	d =   w0 + 2w1 + 4w2 + 8w3 + 16w4
+	 *	e = 4					(w4 already known)
+	 *
+	 *	INTERPOLATION:
+	 *	b = b -16a - e		(354)
+	 *	c = c - a - e		(68)
+	 *	d = d - a - 16e		(270)
+	 *
+	 *	w = (b + d) - 8c = (10w1+8w2+10w3) - (8w1+8w2+8w3) = 2w1+2w3
+	 *	w = 2c - w		(56)
+	 *	b = b/2 = 4w1+w+w3
+	 *	b = b-c = 4w1+w+w3 - w1+w2+w3 = 3w1+w2
+	 *	c = w/2			(w2 = 28)
+	 *	b = b-c = 3w1+c - c = 3w1
+	 *	b = b/3			(w1 = 27)
+	 *	d = d/2
+	 *	d = d-b-w = b+w+4w3 - b-w = 4w3
+	 *	d = d/4			(w3 = 13)
+	 *
+	 *	RESULT:
+	 *	w4*10^4 + w3*10³ + w2*10² + w1*10 + w0
+	 *	40000   + 13000   + 2800   + 270    + 18
+	 *	10 is the base where the calculation was done
+	 *
+	 *	This sample uses small numbers, so it does not show the
+	 * advantage of the method. But for example (in base 10), when squaring
+	 *	123456789012345678901234567890
+	 *	The normal method would do 30*30=900 multiplications
+	 *	Karatsuba method would do 15*15*3=675 multiplications
+	 *	Toom method would do 10*10*5=500 multiplications
+	 * Toom method has a larger overhead if compared with Karatsuba method,
+	 * due to evaluation and interpolation, so it should be used for larger
+	 * numbers, so that the computation time of evaluation/interpolation
+	 * would be smaller than the time spent using other methods.
+	 *
+	 *	Note that Karatsuba method can be seen as a special case of
+	 * Toom method, i.e:
+	 *	U1U0 * V1V0
+	 *	with k = [ 0 1 oo ]
+	 *	U = [ U0 U1+U0 U1 ]
+	 *	V = [ V0 V1+V0 V1 ]
+	 *	W = [ U0*V0 (U1+U0)*(V1+V0) (U1+V1) ]
+	 *
+	 *	w0 = U0*V0
+	 *	w = (U1+U0)*(V1+V0)
+	 *	w2 = (U1*V1)
+	 *
+	 *	w1 = w - w0 - w2
+	 * w2x² + w1x + w0
+	 *
+	 *	See Knuth's Seminumerical Algorithms for a sample implemention
+	 * using 4 stacks and k = [ 0 1 2 3 ... ], based on the size of the
+	 * input.
+	 */
+long
+mp_toom_mul(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2)
+{
+    long size, xsize, i;
+    BNI value;				/* used in division */
+    BNS carry;
+    BNI x;				/* shift count */
+    BNI l1, l2;
+    BNI al, bl, cl, dl, el, Ul[3], Vl[3];
+    BNS *a, *b, *c, *d, *e, *U[3], *V[3];
+
+    /* x is the base i.e. 2^(BNSBITS*x) */
+    x = (len1 + len2 + 4) / 6;
+    l1 = len1 - (x << 1);	/* length of remaining piece of op1 */
+    l2 = len2 - (x << 1);	/* length of remaining piece of op2 */
+
+    /* allocate memory for storing U and V */
+    U[0] = mp_malloc(sizeof(BNS) * (x + 2));
+    V[0] = mp_malloc(sizeof(BNS) * (x + 2));
+    U[1] = mp_malloc(sizeof(BNS) * (x + 1));
+    V[1] = mp_malloc(sizeof(BNS) * (x + 1));
+    U[2] = mp_malloc(sizeof(BNS) * (x + 2));
+    V[2] = mp_malloc(sizeof(BNS) * (x + 2));
+
+	/* EVALUATE U AND V */
+
+    /* Numbers are in the format U2x²+U1x+U0 and V2x²+V1x+V0 */
+
+	/* U[0] = U2+U1*2+U0*4 */
+
+    /* store U1*2 in U[1], this value is used twice */
+    Ul[1] = mp_lshift(U[1], op1 + x, x, 1);
+
+    /* store U0*4 in U[0] */
+    Ul[0] = mp_lshift(U[0], op1, x, 2);
+    /* add U1*2 to U[0] */
+    Ul[0] = mp_add(U[0], U[0], U[1], Ul[0], Ul[1]);
+    /* add U2 to U[0] */
+    Ul[0] = mp_add(U[0], U[0], op1 + x + x, Ul[0], l1);
+
+	/* U[2] = U2*4+U1*2+U0 */
+
+    /* store U2*4 in U[2] */
+    Ul[2] = mp_lshift(U[2], op1 + x + x, l1, 2);
+    /* add U1*2 to U[2] */
+    Ul[2] = mp_add(U[2], U[2], U[1], Ul[2], Ul[1]);
+    /* add U0 to U[2] */
+    Ul[2] = mp_add(U[2], U[2], op1, Ul[2], x);
+
+	/* U[1] = U2+U1+U0 */
+
+    Ul[1] = mp_add(U[1], op1, op1 + x, x, x);
+    Ul[1] = mp_add(U[1], U[1], op1 + x + x, Ul[1], l1);
+
+
+	/* Evaluate V[x], same code as U[x] */
+    Vl[1] = mp_lshift(V[1], op2 + x, x, 1);
+    Vl[0] = mp_lshift(V[0], op2, x, 2);
+    Vl[0] = mp_add(V[0], V[0], V[1], Vl[0], Vl[1]);
+    Vl[0] = mp_add(V[0], V[0], op2 + x + x, Vl[0], l2);
+    Vl[2] = mp_lshift(V[2], op2 + x + x, l2, 2);
+    Vl[2] = mp_add(V[2], V[2], V[1], Vl[2], Vl[1]);
+    Vl[2] = mp_add(V[2], V[2], op2, Vl[2], x);
+    Vl[1] = mp_add(V[1], op2, op2 + x, x, x);
+    Vl[1] = mp_add(V[1], V[1], op2 + x + x, Vl[1], l2);
+
+
+	/* MULTIPLY U[] AND V[] */
+
+	/* calculate (U2+U1*2+U0*4) * (V2+V1*2+V0*4) */
+    b = mp_calloc(1, sizeof(BNS) * (Ul[0] * Vl[0]));
+    bl = mp_mul(b, U[0], V[0], Ul[0], Vl[0]);
+    mp_free(U[0]);
+    mp_free(V[0]);
+
+	/* calculate (U2+U1+U0) * (V2+V1+V0) */
+    c = mp_calloc(1, sizeof(BNS) * (Ul[1] * Vl[1]));
+    cl = mp_mul(c, U[1], V[1], Ul[1], Vl[1]);
+    mp_free(U[1]);
+    mp_free(V[1]);
+
+	/* calculate (U2*4+U1*2+U0) * (V2*4+V1*2+V0) */
+    d = mp_calloc(1, sizeof(BNS) * (Ul[2] * Vl[2]));
+    dl = mp_mul(d, U[2], V[2], Ul[2], Vl[2]);
+    mp_free(U[2]);
+    mp_free(V[2]);
+
+	/* calculate U0 * V0 */
+    a = mp_calloc(1, sizeof(BNS) * (x + x));
+    al = mp_mul(a, op1, op2, x, x);
+
+	/* calculate U2 * V2 */
+    e = mp_calloc(1, sizeof(BNS) * (l1 + l2));
+    el = mp_mul(e, op1 + x + x, op2 + x + x, l1, l2);
+
+
+	/* INTERPOLATE COEFFICIENTS */
+
+    /* b = b - 16a - e */
+    size = mp_lshift(rop, a, al, 4);
+    bl = mp_sub(b, b, rop, bl, size);
+    bl = mp_sub(b, b, e, bl, el);
+
+    /* c = c - a - e*/
+    cl = mp_sub(c, c, a, cl, al);
+    cl = mp_sub(c, c, e, cl, el);
+
+    /* d = d - a - 16e */
+    dl = mp_sub(d, d, a, dl, al);
+    size = mp_lshift(rop, e, el, 4);
+    dl = mp_sub(d, d, rop, dl, size);
+
+    /* w = (b + d) - 8c */
+    size = mp_add(rop, b, d, bl, dl);
+    xsize = mp_lshift(rop + size, c, cl, 3);	/* rop has enough storage */
+    size = mp_sub(rop, rop, rop + size, size, xsize);
+
+    /* w = 2c - w*/
+    xsize = mp_lshift(rop + size, c, cl, 1);
+    size = mp_sub(rop, rop + size, rop, xsize, size);
+
+    /* b = b/2 */
+    bl = mp_rshift(b, b, bl, 1);
+
+    /* b = b - c */
+    bl = mp_sub(b, b, c, bl, cl);
+
+    /* c = w / 2 */
+    cl = mp_rshift(c, rop, size, 1);
+
+    /* b = b - c */
+    bl = mp_sub(b, b, c, bl, cl);
+
+    /* b = b/3 */
+	/* maybe the most expensive calculation */
+    i = bl - 1;
+    value = b[i];
+    b[i] = value / 3;
+    for (--i; i >= 0; i--) {
+	carry = value % 3;
+	value = ((BNI)carry << BNSBITS) + b[i];
+	b[i] = (BNS)(value / 3);
+    }
+
+    /* d = d/2 */
+    dl = mp_rshift(d, d, dl, 1);
+
+    /* d = d - b - w */
+    dl = mp_sub(d, d, b, dl, bl);
+    dl = mp_sub(d, d, rop, dl, size);
+
+    /* d = d/4 */
+    dl = mp_rshift(d, d, dl, 2);
+
+
+	/* STORE RESULT IN ROP */
+    /* first clear memory used as temporary variable w and 8c */
+    memset(rop, '\0', sizeof(BNS) * (len1 + len2));
+
+    i = x * 4;
+    xsize = (len1 + len2) - i;
+    size = mp_add(rop + i, rop + i, e, xsize, el) + i;
+    i = x * 3;
+    xsize = size - i;
+    size = mp_add(rop + i, rop + i, d, xsize, dl) + i;
+    i = x * 2;
+    xsize = size - i;
+    size = mp_add(rop + i, rop + i, c, xsize, cl) + i;
+    i = x;
+    xsize = size - i;
+    size = mp_add(rop + i, rop + i, b, xsize, bl) + i;
+    size = mp_add(rop, rop, a, size, al);
+
+    mp_free(e);
+    mp_free(d);
+    mp_free(c);
+    mp_free(b);
+    mp_free(a);
+
+    if (size > 1 && rop[size - 1] == 0)
+	--size;
+
+    return (size);
+}
+
+long
+mp_mul(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2)
+{
+    if (len1 < len2)
+	MP_SWAP(op1, op2, len1, len2);
+
+    if (len1 < KARATSUBA || len2 < KARATSUBA)
+	return (mp_base_mul(rop, op1, op2, len1, len2));
+    else if (len1 < TOOM && len2 < TOOM && len2 > ((len1 + 1) >> 1))
+	return (mp_karatsuba_mul(rop, op1, op2, len1, len2));
+    else if (len1 >= TOOM && len2 >= TOOM && (len2 + 2) / 3 == (len1 + 2) / 3)
+	return (mp_toom_mul(rop, op1, op2, len1, len2));
+    else {
+	long xsize, psize, isize;
+	BNS *ptr;
+
+	/* adjust index pointer and estimated size of result */
+	isize = 0;
+	xsize = len1 + len2;
+	mp_mul(rop, op1, op2, len2, len2);
+	/* adjust pointers */
+	len1 -= len2;
+	op1 += len2;
+
+	/* allocate buffer for intermediate multiplications */
+	if (len1 > len2)
+	    ptr = mp_calloc(1, sizeof(BNS) * (len2 + len2));
+	else
+	    ptr = mp_calloc(1, sizeof(BNS) * (len1 + len2));
+
+	/* loop multiplying len2 size operands at a time */
+	while (len1 >= len2) {
+	    isize += len2;
+	    psize = mp_mul(ptr, op1, op2, len2, len2);
+	    mp_add(rop + isize, rop + isize, ptr, xsize - isize, psize);
+	    len1 -= len2;
+	    op1 += len2;
+
+	    /* multiplication routines require zeroed memory */
+	    memset(ptr, '\0', sizeof(BNS) * (MIN(len1, len2) + len2));
+	}
+
+	/* len1 was not a multiple of len2 */
+	if (len1) {
+	    isize += len2;
+	    psize = mp_mul(ptr, op2, op1, len2, len1);
+	    mp_add(rop + isize, rop + isize, ptr, xsize, psize);
+	}
+
+	/* adjust result size */
+	if (rop[xsize - 1] == 0)
+	    --xsize;
+
+	mp_free(ptr);
+
+	return (xsize);
+    }
+}
diff --git a/lisp/mp/mp.h b/lisp/mp/mp.h
new file mode 100644
index 0000000..88f1b24
--- /dev/null
+++ b/lisp/mp/mp.h
@@ -0,0 +1,435 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/mp/mp.h,v 1.6 2003/01/12 03:55:51 tsi Exp $ */
+
+#include <stdio.h>
+#include <math.h>
+#ifdef sun
+#include <ieeefp.h>
+#endif
+#include <float.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <ctype.h>
+#include <string.h>
+
+#ifndef __mp_h_
+#define __mp_h_
+
+#ifdef __GNUC__
+#define INLINE __inline__
+#else
+#define INLINE /**/
+#endif
+
+/* this normally is better for multiplication and also
+ * simplify addition loops putting the larger value first */
+#define MP_SWAP(op1, op2, len1, len2) {	\
+    BNS *top = op1;			\
+    BNI tlen = len1;			\
+					\
+    op1 = op2;				\
+    len1 = len2;			\
+    op2 = top;				\
+    len2 = tlen;			\
+}
+
+/*
+ * At least this length to use Karatsuba multiplication method
+ */
+#define KARATSUBA		32
+
+/*
+ * At least this length to use Toom multiplication method
+ */
+#define TOOM			128
+
+#if ULONG_MAX > 4294967295UL
+  /* sizeof(long) == 8 and sizeof(int) == 4 */
+# define BNI		unsigned long
+# define BNS		unsigned int
+# define MINSLONG	0x8000000000000000UL
+# define CARRY		0x100000000
+# define LMASK		0xffffffff00000000UL
+# define SMASK		0x00000000ffffffffUL
+# define BNIBITS	64
+# define BNSBITS	32
+# ifndef LONG64
+#  define LONG64
+# endif
+#else
+  /* sizeof(long) == 4 and sizeof(short) == 2 */
+# define BNI		unsigned long
+# define BNS		unsigned short
+# define MINSLONG	0x80000000UL
+# define CARRY		0x10000
+# define LMASK		0xffff0000UL
+# define SMASK		0x0000ffffUL
+# define BNIBITS	32
+# define BNSBITS	16
+#endif
+
+#ifdef MAX
+#undef MAX
+#endif
+#define MAX(a, b)	((a) > (b) ? (a) : (b))
+
+#ifdef MIN
+#undef MIN
+#endif
+#define MIN(a, b)	((a) < (b) ? (a) : (b))
+
+/*
+ * Types
+ */
+typedef struct _mpi {
+    unsigned int size : 31;
+    unsigned int sign : 1;
+    BNI alloc;
+    BNS *digs;		/* LSF format */
+} mpi;
+
+typedef struct _mpr {
+    mpi num;
+    mpi den;
+} mpr;
+
+typedef void *(*mp_malloc_fun)(size_t);
+typedef void *(*mp_calloc_fun)(size_t, size_t);
+typedef void *(*mp_realloc_fun)(void*, size_t);
+typedef void (*mp_free_fun)(void*);
+
+/*
+ * Prototypes
+ */
+/* GENERIC FUNCTIONS */
+	/* memory allocation wrappers */
+void *mp_malloc(size_t size);
+void *mp_calloc(size_t nmemb, size_t size);
+void *mp_realloc(void *pointer, size_t size);
+void mp_free(void *pointer);
+mp_malloc_fun mp_set_malloc(mp_malloc_fun);
+mp_calloc_fun mp_set_calloc(mp_calloc_fun);
+mp_realloc_fun mp_set_realloc(mp_realloc_fun);
+mp_free_fun mp_set_free(mp_free_fun);
+
+	/* adds op1 and op2, stores result in rop
+	 * rop must pointer to at least len1 + len2 + 1 elements
+	 * rop can be either op1 or op2 */
+long mp_add(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2);
+
+	/* subtracts op2 from op1, stores result in rop
+	 * rop must pointer to at least len1 + len2 elements
+	 * op1 must be >= op2
+	 * rop can be either op1 or op2 */
+long mp_sub(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2);
+
+	/* shift op to the left shift bits
+	 * rop must have enough storage for result
+	 * rop can be op */
+long mp_lshift(BNS *rop, BNS *op, BNI len, long shift);
+
+	/* shift op to the right shift bits
+	 * shift must be positive
+	 * rop can be op */
+long mp_rshift(BNS *rop, BNS *op, BNI len, long shift);
+
+	/* use simple generic multiplication method
+	 * rop cannot be the same as op1 or op2
+	 * rop must be zeroed
+	 * op1 can be op2 */
+long mp_base_mul(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2);
+
+	/* use Karatsuba method
+	 * MIN(len1, len2) must be larger than (MAX(len1, len2) + 1) >> 1
+	 * MAX(len1, len2) should be at least 2
+	 * rop cannot be the same as op1 or op2
+	 * rop must be zeroed
+	 * op1 can be op2 */
+long mp_karatsuba_mul(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2);
+
+	/* use Toom method
+	 * len1 / 3 should be equal to len2 / 3
+	 * len1 / 3 should be at least 1
+	 * rop cannot be the same as op1 or op2
+	 * rop must be zeroed
+	 * op1 can be op2 */
+long mp_toom_mul(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2);
+
+	/* chooses the available multiplication methods based on it's input
+	 * rop must be a pointer to len1 + len2 elements
+	 * rop cannot be the same as op1 or op2
+	 * rop must be zeroed
+	 * op1 can be op2 */
+long mp_mul(BNS *rop, BNS *op1, BNS *op2, BNI len1, BNI len2);
+
+/* INTEGER FUNCTIONS */
+	/* initialize op and set it to 0 */
+void mpi_init(mpi *op);
+
+	/* clear memory associated to op */
+void mpi_clear(mpi *op);
+
+	/* set rop to the value of op */
+void mpi_set(mpi *rop, mpi *op);
+
+	/* set rop to the value of si */
+void mpi_seti(mpi *rop, long si);
+
+	/* set rop to the floor(fabs(d)) */
+void mpi_setd(mpi *rop, double d);
+
+	/* initialize rop to number representation in str in the given base.
+	 * leading zeros are skipped.
+	 * if sign present, it is processed.
+	 * base must be in the range 2 to 36. */
+void mpi_setstr(mpi *rop, char *str, int base);
+
+	/* adds two mp integers */
+void mpi_add(mpi *rop, mpi *op1, mpi *op2);
+
+	/* adds op1 and op2 */
+void mpi_addi(mpi *rop, mpi *op1, long op2);
+
+	/* subtracts two mp integers */
+void mpi_sub(mpi *rop, mpi *op1, mpi *op2);
+
+	/* subtracts op2 from op1 */
+void mpi_subi(mpi *rop, mpi *op1, long op2);
+
+	/* multiply two mp integers */
+void mpi_mul(mpi *rop, mpi *op1, mpi *op2);
+
+	/* multiply op1 by op2 */
+void mpi_muli(mpi *rop, mpi *op1, long op2);
+
+	/* divides num by den and sets rop to result */
+void mpi_div(mpi *rop, mpi *num, mpi *den);
+
+	/* divides num by den and sets rop to the remainder */
+void mpi_rem(mpi *rop, mpi *num, mpi *den);
+
+	/* divides num by den, sets quotient to qrop and remainder to rrop
+	 * qrop is truncated towards zero.
+	 * qrop and rrop are optional
+	 * qrop and rrop cannot be the same variable */
+void mpi_divqr(mpi *qrop, mpi *rrop, mpi *num, mpi *den);
+
+	/* divides num by then and stores result in rop */
+void mpi_divi(mpi *rop, mpi *num, long den);
+
+	/* divides num by den and returns remainder */
+long mpi_remi(mpi *num, long den);
+
+	/* divides num by den
+	 * stores quotient in qrop and returns remainder */
+long mpi_divqri(mpi *qrop, mpi *num, long den);
+
+	/* sets rop to num modulo den */
+void mpi_mod(mpi *rop, mpi *num, mpi *den);
+
+	/* returns num modulo den */
+long mpi_modi(mpi *num, long den);
+
+	/* sets rop to the greatest common divisor of num and den
+	 * result is always positive */
+void mpi_gcd(mpi *rop, mpi *num, mpi *den);
+
+	/* sets rop to the least common multiple of num and den
+	 * result is always positive */
+void mpi_lcm(mpi *rop, mpi *num, mpi *den);
+
+	/* sets rop to op raised to exp */
+void mpi_pow(mpi *rop, mpi *op, unsigned long exp);
+
+	/* sets rop to the integer part of the nth root of op.
+	 * returns 1 if result is exact, 0 otherwise */
+int mpi_root(mpi *rop, mpi *op, unsigned long nth);
+
+	/* sets rop to the integer part of the square root of op.
+	 * returns 1 if result is exact, 0 otherwise */
+int mpi_sqrt(mpi *rop, mpi *op);
+
+	/* bit shift, left if shift positive, right if negative
+	 * a fast way to multiply and divide by powers of two */
+void mpi_ash(mpi *rop, mpi *op, long shift);
+
+	/* sets rop to op1 logand op2 */
+void mpi_and(mpi *rop, mpi *op1, mpi *op2);
+
+	/* sets rop to op1 logior op2 */
+void mpi_ior(mpi *rop, mpi *op1, mpi *op2);
+
+	/* sets rop to op1 logxor op2 */
+void mpi_xor(mpi *rop, mpi *op1, mpi *op2);
+
+	/* sets rop to one's complement of op */
+void mpi_com(mpi *rop, mpi *op);
+
+	/* sets rop to -op */
+void mpi_neg(mpi *rop, mpi *op);
+
+	/* sets rop to the absolute value of op */
+void mpi_abs(mpi *rop, mpi *op);
+
+	/* compares op1 and op2
+	 * returns >0 if op1 > op2, 0 if op1 = op2, and  <0 if op1 < op2 */
+int mpi_cmp(mpi *op1, mpi *op2);
+
+	/* mpi_cmp with a long integer operand */
+int mpi_cmpi(mpi *op1, long op2);
+
+	/* compares absolute value of op1 and op2
+	 * returns >0 if abs(op1) > abs(op2), 0 if abs(op1) = abs(op2),
+	 * and  <0 if abs(op1) < abs(op2) */
+int mpi_cmpabs(mpi *op1, mpi *op2);
+
+	/* mpi_cmpabs with a long integer operand */
+int mpi_cmpabsi(mpi *op1, long op2);
+
+	/* returns 1 if op1 > 0, 0 if op1 = 0, and  -1 if op1 < 0 */
+int mpi_sgn(mpi *op);
+
+	/* fastly swaps contents of op1 and op2 */
+void mpi_swap(mpi *op1, mpi *op2);
+
+	/* returns 1 if op fits in a signed long int, 0 otherwise */
+int mpi_fiti(mpi *op);
+
+	/* converts mp integer to long int
+	 * to know if the value will fit, call mpi_fiti */
+long mpi_geti(mpi *op);
+
+	/* convert mp integer to double */
+double mpi_getd(mpi *op);
+
+	/* returns exact number of characters to represent mp integer
+	 * in given base, excluding sign and ending null character.
+	 * base must be in the range 2 to 36 */
+unsigned long mpi_getsize(mpi *op, int base);
+
+	/* returns pointer to string with representation of mp integer
+	 * if str is not NULL, it must have enough space to store integer
+	 * representation, if NULL a newly allocated string is returned.
+	 * base must be in the range 2 to 36 */
+char *mpi_getstr(char *str, mpi *op, int base);
+
+/* RATIO FUNCTIONS */
+#define mpr_num(op)	(&((op)->num))
+#define mpr_den(op)	(&((op)->den))
+
+	/* initialize op and set it to 0/1 */
+void mpr_init(mpr *op);
+
+	/* clear memory associated to op */
+void mpr_clear(mpr *op);
+
+	/* set rop to the value of op */
+void mpr_set(mpr *rop, mpr *op);
+
+	/* set rop to num/den */
+void mpr_seti(mpr *rop, long num, long den);
+
+	/* set rop to the value of d */
+void mpr_setd(mpr *rop, double d);
+
+	/* initialize rop to number representation in str in the given base.
+	 * leading zeros are skipped.
+	 * if sign present, it is processed.
+	 * base must be in the range 2 to 36. */
+void mpr_setstr(mpr *rop, char *str, int base);
+
+	/* remove common factors of op */
+void mpr_canonicalize(mpr *op);
+
+	/* adds two mp rationals */
+void mpr_add(mpr *rop, mpr *op1, mpr *op2);
+
+	/* adds op1 and op2 */
+void mpr_addi(mpr *rop, mpr *op1, long op2);
+
+	/* subtracts two mp rationals */
+void mpr_sub(mpr *rop, mpr *op1, mpr *op2);
+
+	/* subtracts op2 from op1 */
+void mpr_subi(mpr *rop, mpr *op1, long op2);
+
+	/* multiply two mp rationals */
+void mpr_mul(mpr *rop, mpr *op1, mpr *op2);
+
+	/* multiply op1 by op2 */
+void mpr_muli(mpr *rop, mpr *op1, long op2);
+
+	/* divide two mp rationals */
+void mpr_div(mpr *rop, mpr *op1, mpr *op2);
+
+	/* divides op1 by op2 */
+void mpr_divi(mpr *rop, mpr *op1, long op2);
+
+	/* sets rop to 1/op */
+void mpr_inv(mpr *rop, mpr *op);
+
+	/* sets rop to -op */
+void mpr_neg(mpr *rop, mpr *op);
+
+	/* sets rop to the absolute value of op */
+void mpr_abs(mpr *rop, mpr *op);
+
+	/* compares op1 and op2
+	 * returns >0 if op1 > op2, 0 if op1 = op2, and  <0 if op1 < op2 */
+int mpr_cmp(mpr *op1, mpr *op2);
+
+	/* mpr_cmp with a long integer operand */
+int mpr_cmpi(mpr *op1, long op2);
+
+	/* compares absolute value of op1 and op2
+	 * returns >0 if abs(op1) > abs(op2), 0 if abs(op1) = abs(op2),
+	 * and  <0 if abs(op1) < abs(op2) */
+int mpr_cmpabs(mpr *op1, mpr *op2);
+
+	/* mpr_cmpabs with a long integer operand */
+int mpr_cmpabsi(mpr *op1, long op2);
+
+	/* fastly swaps contents of op1 and op2 */
+void mpr_swap(mpr *op1, mpr *op2);
+
+	/* returns 1 if op fits in a signed long int, 0 otherwise */
+int mpr_fiti(mpr *op);
+
+	/* convert mp rational to double */
+double mpr_getd(mpr *op);
+
+	/* returns pointer to string with representation of mp rational
+	 * if str is not NULL, it must have enough space to store rational
+	 * representation, if NULL a newly allocated string is returned.
+	 * base must be in the range 2 to 36 */
+char *mpr_getstr(char *str, mpr *op, int base);
+
+#endif /* __mp_h_ */
diff --git a/lisp/mp/mpi.c b/lisp/mp/mpi.c
new file mode 100644
index 0000000..506dc7e
--- /dev/null
+++ b/lisp/mp/mpi.c
@@ -0,0 +1,1656 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/mp/mpi.c,v 1.12 2002/11/20 07:44:43 paulo Exp $ */
+
+#include "mp.h"
+
+/*
+ * Prototypes
+ */
+	/* do the hard work of mpi_add and mpi_sub */
+static void mpi_addsub(mpi *rop, mpi *op1, mpi *op2, int sub);
+
+	/* logical functions implementation */
+static INLINE BNS mpi_logic(BNS op1, BNS op2, BNS op);
+static void mpi_log(mpi *rop, mpi *op1, mpi *op2,  BNS op);
+
+	/* internal mpi_seti, whithout memory allocation */
+static void _mpi_seti(mpi *rop, long si);
+
+/*
+ * Initialization
+ */
+static BNS onedig[1] = { 1 };
+static mpi mpone = { 1, 1, 0, (BNS*)&onedig };
+
+/*
+ * Implementation
+ */
+void
+mpi_init(mpi *op)
+{
+    op->sign = 0;
+    op->size = op->alloc = 1;
+    op->digs = mp_malloc(sizeof(BNS));
+    op->digs[0] = 0;
+}
+
+void
+mpi_clear(mpi *op)
+{
+    op->sign = 0;
+    op->size = op->alloc = 0;
+    mp_free(op->digs);
+}
+
+void
+mpi_set(mpi *rop, mpi *op)
+{
+    if (rop != op) {
+	if (rop->alloc < op->size) {
+	    rop->digs = mp_realloc(rop->digs, sizeof(BNS) * op->size);
+	    rop->alloc = op->size;
+	}
+	rop->size = op->size;
+	memcpy(rop->digs, op->digs, sizeof(BNS) * op->size);
+	rop->sign = op->sign;
+    }
+}
+
+void
+mpi_seti(mpi *rop, long si)
+{
+    unsigned long ui;
+    int sign = si < 0;
+    int size;
+
+    if (si == MINSLONG) {
+	ui = MINSLONG;
+	size = 2;
+    }
+    else {
+	if (sign)
+	    ui = -si;
+	else
+	    ui = si;
+	if (ui < CARRY)
+	    size = 1;
+	else
+	    size = 2;
+    }
+
+    if (rop->alloc < size) {
+	rop->digs = mp_realloc(rop->digs, sizeof(BNS) * size);
+	rop->alloc = size;
+    }
+    rop->size = size;
+
+    /* store data in small mp integer */
+    rop->digs[0] = (BNS)ui;
+    if (size > 1)
+	rop->digs[1] = (BNS)(ui >> BNSBITS);
+    rop->size = size;
+
+    /* adjust result sign */
+    rop->sign = sign;
+}
+
+static void
+_mpi_seti(mpi *rop, long si)
+{
+    unsigned long ui;
+    int sign = si < 0;
+    int size;
+
+    if (si == MINSLONG) {
+	ui = MINSLONG;
+	size = 2;
+    }
+    else {
+	if (sign)
+	    ui = -si;
+	else
+	    ui = si;
+	if (ui < CARRY)
+	    size = 1;
+	else
+	    size = 2;
+    }
+
+    rop->digs[0] = (BNS)ui;
+    if (size > 1)
+	rop->digs[1] = (BNS)(ui >> BNSBITS);
+    rop->size = size;
+
+    rop->sign = sign;
+}
+
+void
+mpi_setd(mpi *rop, double d)
+{
+    long i;
+    double mantissa;
+    int shift, exponent;
+    BNI size;
+
+    if (isnan(d))
+	d = 0.0;
+    else if (!finite(d))
+	d = copysign(1.0, d) * DBL_MAX;
+
+    /* check if number is larger than 1 */
+    if (fabs(d) < 1.0) {
+	rop->digs[0] = 0;
+	rop->size = 1;
+	rop->sign = d < 0.0;
+
+	return;
+    }
+
+    mantissa = frexp(d, &exponent);
+    if (mantissa < 0)
+	mantissa = -mantissa;
+
+    size = (exponent + (BNSBITS - 1)) / BNSBITS;
+    shift = BNSBITS - (exponent & (BNSBITS - 1));
+
+    /* adjust amount of memory */
+    if (rop->alloc < size) {
+	rop->digs = mp_realloc(rop->digs, sizeof(BNS) * size);
+	rop->alloc = size;
+    }
+    rop->size = size;
+
+    /* adjust the exponent */
+    if (shift < BNSBITS)
+	mantissa = ldexp(mantissa, -shift);
+
+    /* convert double */
+    for (i = size - 1; i >= 0 && mantissa != 0.0; i--) {
+	mantissa = ldexp(mantissa, BNSBITS);
+	rop->digs[i] = (BNS)mantissa;
+	mantissa -= rop->digs[i];
+    }
+    for (; i >= 0; i--)
+	rop->digs[i] = 0;
+
+    /* normalize */
+    if (size > 1 && rop->digs[size - 1] == 0)
+	--rop->size;
+
+    rop->sign = d < 0.0;
+}
+
+/* how many BNS in the given base, log(base) / log(CARRY) */
+#ifdef LONG64
+static double str_bases[37] = {
+    0.0000000000000000, 0.0000000000000000, 0.0312500000000000,
+    0.0495300781475362, 0.0625000000000000, 0.0725602529652301,
+    0.0807800781475362, 0.0877298413143002, 0.0937500000000000,
+    0.0990601562950723, 0.1038102529652301, 0.1081072380824156,
+    0.1120300781475362, 0.1156387411919092, 0.1189798413143002,
+    0.1220903311127662, 0.1250000000000000, 0.1277332137890731,
+    0.1303101562950723, 0.1327477347951120, 0.1350602529652300,
+    0.1372599194618363, 0.1393572380824156, 0.1413613111267817,
+    0.1432800781475362, 0.1451205059304602, 0.1468887411919092,
+    0.1485902344426084, 0.1502298413143002, 0.1518119060977367,
+    0.1533403311127662, 0.1548186346995899, 0.1562500000000000,
+    0.1576373162299517, 0.1589832137890731, 0.1602900942795302,
+    0.1615601562950723,
+};
+#else
+static double str_bases[37] = {
+    0.0000000000000000, 0.0000000000000000, 0.0625000000000000,
+    0.0990601562950723, 0.1250000000000000, 0.1451205059304602,
+    0.1615601562950723, 0.1754596826286003, 0.1875000000000000,
+    0.1981203125901446, 0.2076205059304602, 0.2162144761648311,
+    0.2240601562950723, 0.2312774823838183, 0.2379596826286003,
+    0.2441806622255325, 0.2500000000000000, 0.2554664275781462,
+    0.2606203125901445, 0.2654954695902241, 0.2701205059304602,
+    0.2745198389236725, 0.2787144761648311, 0.2827226222535633,
+    0.2865601562950723, 0.2902410118609203, 0.2937774823838183,
+    0.2971804688852168, 0.3004596826286003, 0.3036238121954733,
+    0.3066806622255324, 0.3096372693991797, 0.3125000000000000,
+    0.3152746324599034, 0.3179664275781462, 0.3205801885590604,
+    0.3231203125901446,
+};
+#endif
+
+void
+mpi_setstr(mpi *rop, char *str, int base)
+{
+    long i;			/* counter */
+    int sign;			/* result sign */
+    BNI carry;			/* carry value */
+    BNI value;			/* temporary value */
+    BNI size;			/* size of result */
+    char *ptr;			/* end of valid input */
+
+    /* initialization */
+    sign = 0;
+    carry = 0;
+
+    /* skip leading spaces */
+    while (isspace(*str))
+	++str;
+
+    /* check if sign supplied */
+    if (*str == '-') {
+	sign = 1;
+	++str;
+    }
+    else if (*str == '+')
+	++str;
+
+    /* skip leading zeros */
+    while (*str == '0')
+	++str;
+
+    ptr = str;
+    while (*ptr) {
+	if (*ptr >= '0' && *ptr <= '9') {
+	    if (*ptr - '0' >= base)
+		break;
+	}
+	else if (*ptr >= 'A' && *ptr <= 'Z') {
+	    if (*ptr - 'A' + 10 >= base)
+		break;
+	}
+	else if (*ptr >= 'a' && *ptr <= 'z') {
+	    if (*ptr - 'a' + 10 >= base)
+		break;
+	}
+	else
+	    break;
+	++ptr;
+    }
+
+    /* resulting size */
+    size = (ptr - str) * str_bases[base] + 1;
+
+    /* make sure rop has enough storage */
+    if (rop->alloc < size) {
+	rop->digs = mp_realloc(rop->digs, size * sizeof(BNS));
+	rop->alloc = size;
+    }
+    rop->size = size;
+
+    /* initialize rop to zero */
+    memset(rop->digs, '\0', size * sizeof(BNS));
+
+    /* set result sign */
+    rop->sign = sign;
+
+    /* convert string */
+    for (; str < ptr; str++) {
+	value = *str;
+	if (islower(value))
+	    value = toupper(value);
+	value = value > '9' ? value - 'A' + 10 : value - '0';
+	value += rop->digs[0] * base;
+	carry = value >> BNSBITS;
+	rop->digs[0] = (BNS)value;
+	for (i = 1; i < size; i++) {
+	    value = (BNI)rop->digs[i] * base + carry;
+	    carry = value >> BNSBITS;
+	    rop->digs[i] = (BNS)value;
+	}
+    }
+
+    /* normalize */
+    if (rop->size > 1 && rop->digs[rop->size - 1] == 0)
+	--rop->size;
+}
+
+void
+mpi_add(mpi *rop, mpi *op1, mpi *op2)
+{
+    mpi_addsub(rop, op1, op2, 0);
+}
+
+void
+mpi_addi(mpi *rop, mpi *op1, long op2)
+{
+    BNS digs[2];
+    mpi op;
+
+    op.digs = (BNS*)digs;
+    _mpi_seti(&op, op2);
+
+    mpi_addsub(rop, op1, &op, 0);
+}
+
+void
+mpi_sub(mpi *rop, mpi *op1, mpi *op2)
+{
+    mpi_addsub(rop, op1, op2, 1);
+}
+
+void
+mpi_subi(mpi *rop, mpi *op1, long op2)
+{
+    BNS digs[2];
+    mpi op;
+
+    op.digs = (BNS*)digs;
+    _mpi_seti(&op, op2);
+
+    mpi_addsub(rop, op1, &op, 1);
+}
+
+static void
+mpi_addsub(mpi *rop, mpi *op1, mpi *op2, int sub)
+{
+    long xlen;				/* maximum result size */
+
+    if (sub ^ (op1->sign == op2->sign)) {
+	/* plus one for possible carry */
+	xlen = MAX(op1->size, op2->size) + 1;
+	if (rop->alloc < xlen) {
+	    rop->digs = mp_realloc(rop->digs, sizeof(BNS) * xlen);
+	    rop->alloc = xlen;
+	}
+	rop->size = mp_add(rop->digs, op1->digs, op2->digs,
+			   op1->size, op2->size);
+	rop->sign = op1->sign;
+    }
+    else {
+	long cmp;			/* check for larger operator */
+
+	cmp = mpi_cmpabs(op1, op2);
+	if (cmp == 0) {
+	    rop->digs[0] = 0;
+	    rop->size = 1;
+	    rop->sign = 0;
+	}
+	else {
+	    xlen = MAX(op1->size, op2->size);
+	    if (rop->alloc < xlen) {
+		rop->digs = mp_realloc(rop->digs, sizeof(BNS) * xlen);
+		rop->alloc = xlen;
+	    }
+	    if (cmp > 0) {
+		rop->size = mp_sub(rop->digs, op1->digs, op2->digs,
+				   op1->size, op2->size);
+		rop->sign = op1->sign;
+	    }
+	    else {
+		rop->size = mp_sub(rop->digs, op2->digs, op1->digs,
+				   op2->size, op1->size);
+		rop->sign = sub ^ op2->sign;
+	    }
+	}
+    }
+}
+
+void
+mpi_mul(mpi *rop, mpi *op1, mpi *op2)
+{
+    int sign;				/* sign flag */
+    BNS *digs;				/* result data */
+    long xsize;				/* result size */
+
+    /* get result sign */
+    sign = op1->sign ^ op2->sign;
+
+    /* check for special cases */
+    if (op1->size == 1) {
+	if (*op1->digs == 0) {
+	    /* multiply by 0 */
+	    mpi_seti(rop, 0);
+	    return;
+	}
+	else if (*op1->digs == 1) {
+	    /* multiply by +-1 */
+	    if (rop->alloc < op2->size) {
+		rop->digs = mp_realloc(rop->digs, sizeof(BNS) * op2->size);
+		rop->alloc = op2->size;
+	    }
+	    rop->size = op2->size;
+	    memmove(rop->digs, op2->digs, sizeof(BNS) * op2->size);
+	    rop->sign = op2->size > 1 || *op2->digs ? sign : 0;
+
+	    return;
+	}
+    }
+    else if (op2->size == 1) {
+	if (*op2->digs == 0) {
+	    /* multiply by 0 */
+	    mpi_seti(rop, 0);
+	    return;
+	}
+	else if (*op2->digs == 1) {
+	    /* multiply by +-1 */
+	    if (rop->alloc < op1->size) {
+		rop->digs = mp_realloc(rop->digs, sizeof(BNS) * op1->size);
+		rop->alloc = op1->size;
+	    }
+	    rop->size = op1->size;
+	    memmove(rop->digs, op1->digs, sizeof(BNS) * op1->size);
+	    rop->sign = op1->size > 1 || *op1->digs ? sign : 0;
+
+	    return;
+	}
+    }
+
+    /* allocate result data and set it to zero */
+    xsize = op1->size + op2->size;
+    if (rop->digs == op1->digs || rop->digs == op2->digs)
+	/* rop is also an operand */
+	digs = mp_calloc(1, sizeof(BNS) * xsize);
+    else {
+	if (rop->alloc < xsize) {
+	    rop->digs = mp_realloc(rop->digs, sizeof(BNS) * xsize);
+	    rop->alloc = xsize;
+	}
+	digs = rop->digs;
+	memset(digs, '\0', sizeof(BNS) * xsize);
+    }
+
+    /* multiply operands */
+    xsize = mp_mul(digs, op1->digs, op2->digs, op1->size, op2->size);
+
+    /* store result in rop */
+    if (digs != rop->digs) {
+	/* if rop was an operand, free old data */
+	mp_free(rop->digs);
+	rop->digs = digs;
+    }
+    rop->size = xsize;
+
+    /* set result sign */
+    rop->sign = sign;
+}
+
+void
+mpi_muli(mpi *rop, mpi *op1, long op2)
+{
+    BNS digs[2];
+    mpi op;
+
+    op.digs = (BNS*)digs;
+    _mpi_seti(&op, op2);
+
+    mpi_mul(rop, op1, &op);
+}
+
+void
+mpi_div(mpi *rop, mpi *num, mpi *den)
+{
+    mpi_divqr(rop, NULL, num, den);
+}
+
+void
+mpi_rem(mpi *rop, mpi *num, mpi *den)
+{
+    mpi_divqr(NULL, rop, num, den);
+}
+
+/*
+ * Could/should be changed to not allocate qdigs if qrop is NULL
+ * Performance wouldn't suffer too much with a test on every loop iteration.
+ */
+void
+mpi_divqr(mpi *qrop, mpi *rrop, mpi *num, mpi *den)
+{
+    long i, j;			/* counters */
+    int qsign;			/* sign of quotient */
+    int rsign;			/* sign of remainder */
+    BNI qsize;			/* size of quotient */
+    BNI rsize;			/* size of remainder */
+    BNS qest;			/* estimative of quotient value */
+    BNS *qdigs, *rdigs;		/* work copy or result */
+    BNS *ndigs, *ddigs;		/* work copy or divisor and dividend */
+    BNI value;			/* temporary result */
+    long svalue;		/* signed temporary result (2's complement) */
+    BNS carry, scarry, denorm;	/* carry and normalization */
+    BNI dpos, npos;		/* offsets in data */
+
+    /* get signs */
+    rsign = num->sign;
+    qsign = rsign ^ den->sign;
+
+    /* check for special case */
+    if (num->size < den->size) {
+	/* quotient is zero and remainder is numerator */
+	if (rrop && rrop->digs != num->digs) {
+	    if (rrop->alloc < num->size) {
+		rrop->digs = mp_realloc(rrop->digs, sizeof(BNS) * num->size);
+		rrop->alloc = num->size;
+	    }
+	    rrop->size = num->size;
+	    memcpy(rrop->digs, num->digs, sizeof(BNS) * num->size);
+	    rrop->sign = rsign;
+	}
+	if (qrop)
+	    mpi_seti(qrop, 0);
+
+	return;
+    }
+
+    /* estimate result sizes */
+    rsize = den->size;
+    qsize = num->size - den->size + 1;
+
+    /* offsets */
+    npos = num->size - 1;
+    dpos = den->size - 1;
+
+    /* allocate space for quotient and remainder */
+    if (qrop == NULL || qrop->digs == num->digs || qrop->digs == den->digs)
+	qdigs = mp_calloc(1, sizeof(BNS) * qsize);
+    else {
+	if (qrop->alloc < qsize) {
+	    qrop->digs = mp_realloc(qrop->digs, sizeof(BNS) * qsize);
+	    qrop->alloc = qsize;
+	}
+	memset(qrop->digs, '\0', sizeof(BNS) * qsize);
+	qdigs = qrop->digs;
+    }
+    if (rrop) {
+	if (rrop->digs == num->digs || rrop->digs == den->digs)
+	    rdigs = mp_calloc(1, sizeof(BNS) * rsize);
+	else {
+	    if (rrop->alloc < rsize) {
+		rrop->digs = mp_realloc(rrop->digs, sizeof(BNS) * rsize);
+		rrop->alloc = rsize;
+	    }
+	    memset(rrop->digs, '\0', sizeof(BNS) * rsize);
+	    rdigs = rrop->digs;
+	}
+    }
+    else
+	rdigs = NULL;	/* fix gcc warning */
+
+    /* special case, only one word in divisor */
+    if (dpos == 0) {
+	for (carry = 0, i = npos; i >= 0; i--) {
+	    value = ((BNI)carry << BNSBITS) + num->digs[i];
+	    qdigs[i] = (BNS)(value / den->digs[0]);
+	    carry = (BNS)(value % den->digs[0]);
+	}
+	if (rrop)
+	    rdigs[0] = carry;
+
+	goto mpi_divqr_done;
+    }
+
+    /* make work copy of numerator */
+    ndigs = mp_malloc(sizeof(BNS) * (num->size + 1));
+    /* allocate one extra word an update offset */
+    memcpy(ndigs, num->digs, sizeof(BNS) * num->size);
+    ndigs[num->size] = 0;
+    ++npos;
+
+    /* normalize */
+    denorm = (BNS)((BNI)CARRY / ((BNI)(den->digs[dpos]) + 1));
+
+    if (denorm > 1) {
+	/* i <= num->size because ndigs has an extra word */
+	for (carry = 0, i = 0; i <= num->size; i++) {
+	    value = ndigs[i] * (BNI)denorm + carry;
+	    ndigs[i] = (BNS)value;
+	    carry = (BNS)(value >> BNSBITS);
+	}
+	/* make work copy of denominator */
+	ddigs = mp_malloc(sizeof(BNS) * den->size);
+	memcpy(ddigs, den->digs, sizeof(BNS) * den->size);
+	for (carry = 0, i = 0; i < den->size; i++) {
+	    value = ddigs[i] * (BNI)denorm + carry;
+	    ddigs[i] = (BNS)value;
+	    carry = (BNS)(value >> BNSBITS);
+	}
+    }
+    else
+	/* only allocate copy of denominator if going to change it */
+	ddigs = den->digs;
+
+    /* divide mp integers */
+    for (j = qsize - 1; j >= 0; j--, npos--) {
+	/* estimate quotient */
+	if (ndigs[npos] == ddigs[dpos])
+	    qest = (BNS)SMASK;
+	else
+	    qest = (BNS)((((BNI)(ndigs[npos]) << 16) + ndigs[npos - 1]) /
+			 ddigs[dpos]);
+
+	while ((value = ((BNI)(ndigs[npos]) << 16) + ndigs[npos - 1] -
+	        qest * (BNI)(ddigs[dpos])) < CARRY &&
+		ddigs[dpos - 1] * (BNI)qest >
+		(value << BNSBITS) + ndigs[npos - 2])
+	       --qest;
+
+	/* multiply and subtract */
+	carry = scarry = 0;
+	for (i = 0; i < den->size; i++) {
+	    value = qest * (BNI)ddigs[i] + carry;
+	    carry = (BNS)(value >> BNSBITS);
+	    svalue = (long)ndigs[npos - dpos + i - 1] - (long)(value & SMASK) -
+		     (long)scarry;
+	    ndigs[npos - dpos + i - 1] = (BNS)svalue;
+	    scarry = svalue < 0;
+	}
+
+	svalue = (long)ndigs[npos] - (long)(carry & SMASK) - (long)scarry;
+	ndigs[npos] = (BNS)svalue;
+
+	if (svalue & LMASK) {
+	    /* quotient too big */
+	    --qest;
+	    carry = 0;
+	    for (i = 0; i < den->size; i++) {
+		value = ndigs[npos - dpos + i - 1] + (BNI)carry + (BNI)ddigs[i];
+		ndigs[npos - dpos + i - 1] = (BNS)value;
+		carry = (BNS)(value >> BNSBITS);
+	    }
+	    ndigs[npos] += carry;
+	}
+
+	qdigs[j] = qest;
+    }
+
+    /* calculate remainder */
+    if (rrop) {
+	for (carry = 0, j = dpos; j >= 0; j--) {
+	    value = ((BNI)carry << BNSBITS) + ndigs[j];
+	    rdigs[j] = (BNS)(value / denorm);
+	    carry = (BNS)(value % denorm);
+	}
+    }
+
+    mp_free(ndigs);
+    if (ddigs != den->digs)
+	mp_free(ddigs);
+
+mpi_divqr_done:
+    if (rrop) {
+	if (rrop->digs != rdigs)
+	    mp_free(rrop->digs);
+	/* normalize remainder */
+	for (i = rsize - 1; i >= 0; i--)
+	    if (rdigs[i] != 0)
+		break;
+	if (i != rsize - 1) {
+	    if (i < 0) {
+		rsign = 0;
+		rsize = 1;
+	    }
+	    else
+		rsize = i + 1;
+	}
+	rrop->digs = rdigs;
+	rrop->sign = rsign;
+	rrop->size = rsize;
+    }
+
+    /* normalize quotient */
+    if (qrop) {
+	if (qrop->digs != qdigs)
+	    mp_free(qrop->digs);
+	for (i = qsize - 1; i >= 0; i--)
+	    if (qdigs[i] != 0)
+		break;
+	if (i != qsize - 1) {
+	    if (i < 0) {
+		qsign = 0;
+		qsize = 1;
+	    }
+	    else
+		qsize = i + 1;
+	}
+	qrop->digs = qdigs;
+	qrop->sign = qsign;
+	qrop->size = qsize;
+    }
+    else
+	mp_free(qdigs);
+}
+
+long
+mpi_divqri(mpi *qrop, mpi *num, long den)
+{
+    BNS ddigs[2];
+    mpi dop, rrop;
+    long remainder;
+
+    dop.digs = (BNS*)ddigs;
+    _mpi_seti(&dop, den);
+
+    memset(&rrop, '\0', sizeof(mpi));
+    mpi_init(&rrop);
+    mpi_divqr(qrop, &rrop, num, &dop);
+    remainder = rrop.digs[0];
+    if (rrop.size > 1)
+	remainder |= (BNI)(rrop.digs[1]) << BNSBITS;
+    if (rrop.sign)
+	remainder = -remainder;
+    mpi_clear(&rrop);
+
+    return (remainder);
+}
+
+void
+mpi_divi(mpi *rop, mpi *num, long den)
+{
+    BNS ddigs[2];
+    mpi dop;
+
+    dop.digs = (BNS*)ddigs;
+    _mpi_seti(&dop, den);
+
+    mpi_divqr(rop, NULL, num, &dop);
+}
+
+long
+mpi_remi(mpi *num, long den)
+{
+    return (mpi_divqri(NULL, num, den));
+}
+
+void
+mpi_mod(mpi *rop, mpi *num, mpi *den)
+{
+    mpi_rem(rop, num, den);
+    if (num->sign ^ den->sign)
+	mpi_add(rop, rop, den);
+}
+
+long
+mpi_modi(mpi *num, long den)
+{
+    long remainder;
+
+    remainder = mpi_remi(num, den);
+    if (num->sign ^ (den < 0))
+	remainder += den;
+
+    return (remainder);
+}
+
+void
+mpi_gcd(mpi *rop, mpi *num, mpi *den)
+{
+    long cmp;
+    mpi rem;
+
+    /* check if result already given */
+    cmp = mpi_cmpabs(num, den);
+
+    /* check if num is equal to den or if num is zero */
+    if (cmp == 0 || (num->size == 1 && num->digs[0] == 0)) {
+	mpi_set(rop, den);
+	rop->sign = 0;
+	return;
+    }
+    /* check if den is not zero */
+    if (den->size == 1 && den->digs[0] == 0) {
+	mpi_set(rop, num);
+	rop->sign = 0;
+	return;
+    }
+
+    /* don't call mpi_init, relies on realloc(0, size) == malloc(size) */
+    memset(&rem, '\0', sizeof(mpi));
+
+    /* if num larger than den */
+    if (cmp > 0) {
+	mpi_rem(&rem, num, den);
+	if (rem.size == 1 && rem.digs[0] == 0) {
+	    /* exact division */
+	    mpi_set(rop, den);
+	    rop->sign = 0;
+	    mpi_clear(&rem);
+	    return;
+	}
+	mpi_set(rop, den);
+    }
+    else {
+	mpi_rem(&rem, den, num);
+	if (rem.size == 1 && rem.digs[0] == 0) {
+	    /* exact division */
+	    mpi_set(rop, num);
+	    rop->sign = 0;
+	    mpi_clear(&rem);
+	    return;
+	}
+	mpi_set(rop, num);
+    }
+
+    /* loop using positive values */
+    rop->sign = rem.sign = 0;
+
+    /* cannot optimize this inverting rem/rop assignment earlier
+     * because rop mais be an operand */
+    mpi_swap(rop, &rem);
+
+    /* Euclides algorithm */
+    for (;;) {
+	mpi_rem(&rem, &rem, rop);
+	if (rem.size == 1 && rem.digs[0] == 0)
+	    break;
+	mpi_swap(rop, &rem);
+    }
+    mpi_clear(&rem);
+}
+
+void
+mpi_lcm(mpi *rop, mpi *num, mpi *den)
+{
+    mpi gcd;
+
+    /* check for zero operand */
+    if ((num->size == 1 && num->digs[0] == 0) ||
+	(den->size == 1 && den->digs[0] == 0)) {
+	rop->digs[0] = 0;
+	rop->sign = 0;
+	return;
+    }
+
+    /* don't call mpi_init, relies on realloc(0, size) == malloc(size) */
+    memset(&gcd, '\0', sizeof(mpi));
+
+    mpi_gcd(&gcd, num, den);
+    mpi_div(&gcd, den, &gcd);
+    mpi_mul(rop, &gcd, num);
+    rop->sign = 0;
+
+    mpi_clear(&gcd);
+}
+
+void
+mpi_pow(mpi *rop, mpi *op, unsigned long exp)
+{
+    mpi zop, top;
+
+    if (exp == 2) {
+	mpi_mul(rop, op, op);
+	return;
+    }
+    /* check for op**0 */
+    else if (exp == 0) {
+	rop->digs[0] = 1;
+	rop->size = 1;
+	rop->sign = 0;
+	return;
+    }
+    else if (exp == 1) {
+	mpi_set(rop, op);
+	return;
+    }
+    else if (op->size == 1) {
+	if (op->digs[0] == 0) {
+	    mpi_seti(rop, 0);
+	    return;
+	}
+	else if (op->digs[0] == 1) {
+	    mpi_seti(rop, op->sign && (exp & 1) ? -1 : 1);
+	    return;
+	}
+    }
+
+    memset(&zop, '\0', sizeof(mpi));
+    memset(&top, '\0', sizeof(mpi));
+    mpi_set(&zop, op);
+    mpi_set(&top, op);
+    for (--exp; exp; exp >>= 1) {
+	if (exp & 1)
+	    mpi_mul(&zop, &top, &zop);
+	mpi_mul(&top, &top, &top);
+    }
+
+    mpi_clear(&top);
+    rop->sign = zop.sign;
+    mp_free(rop->digs);
+    rop->digs = zop.digs;
+    rop->size = zop.size;
+}
+
+/* Find integer root of given number using the iteration
+ *	x{n+1} = ((K-1) * x{n} + N / x{n}^(K-1)) / K
+ */
+int
+mpi_root(mpi *rop, mpi *op, unsigned long nth)
+{
+    long bits, cmp;
+    int exact;
+    int sign;
+    mpi *r, t, temp, quot, old, rem;
+
+    sign = op->sign;
+
+    /* divide by zero op**1/0 */
+    if (nth == 0) {
+	int one = 1, zero = 0;
+	one = one / zero;
+    }
+    /* result is complex */
+    if (sign && !(nth & 1)) {
+	int one = 1, zero = 0;
+	one = one / zero;
+    }
+
+    /* special case op**1/1 = op */
+    if (nth == 1) {
+	mpi_set(rop, op);
+	return (1);
+    }
+
+    bits = mpi_getsize(op, 2) - 2;
+
+    if (bits < 0 || bits / nth == 0) {
+	/* integral root is surely less than 2 */
+	exact = op->size == 1 && (op->digs[0] == 1 || op->digs[0] == 0);
+	mpi_seti(rop, sign ? -1 : op->digs[0] == 0 ? 0 : 1);
+
+	return (exact == 1);
+    }
+
+    /* initialize */
+    if (rop != op)
+	r = rop;
+    else {
+	r = &t;
+	memset(r, '\0', sizeof(mpi));
+    }
+    memset(&temp, '\0', sizeof(mpi));
+    memset(&quot, '\0', sizeof(mpi));
+    memset(&old, '\0', sizeof(mpi));
+    memset(&rem, '\0', sizeof(mpi));
+
+    if (sign)
+	r->sign = 0;
+
+    /* root aproximation */
+    mpi_ash(r, op, -(bits - (bits / nth)));
+
+    for (;;) {
+	mpi_pow(&temp, r, nth - 1);
+	mpi_divqr(&quot, &rem, op, &temp);
+	cmp = mpi_cmpabs(r, &quot);
+	if (cmp == 0) {
+	    exact = mpi_cmpi(&rem, 0) == 0;
+	    break;
+	}
+	else if (cmp < 0) {
+	    if (mpi_cmpabs(r, &old) == 0) {
+		exact = 0;
+		break;
+	    }
+	    mpi_set(&old, r);
+	}
+	mpi_muli(&temp, r, nth - 1);
+	mpi_add(&quot, &quot, &temp);
+	mpi_divi(r, &quot, nth);
+    }
+
+    mpi_clear(&temp);
+    mpi_clear(&quot);
+    mpi_clear(&old);
+    mpi_clear(&rem);
+    if (r != rop) {
+	mpi_set(rop, r);
+	mpi_clear(r);
+    }
+    rop->sign = sign;
+
+    return (exact);
+}
+
+/*
+ * Find square root using the iteration:
+ *	x{n+1} = (x{n}+N/x{n})/2
+ */
+int
+mpi_sqrt(mpi *rop, mpi *op)
+{
+    long bits, cmp;
+    int exact;
+    mpi *r, t, quot, rem, old;
+
+    /* result is complex */
+    if (op->sign) {
+	int one = 1, zero = 0;
+	one = one / zero;
+    }
+
+    bits = mpi_getsize(op, 2) - 2;
+
+    if (bits < 2) {
+	/* integral root is surely less than 2 */
+	exact = op->size == 1 && (op->digs[0] == 1 || op->digs[0] == 0);
+	mpi_seti(rop, op->digs[0] == 0 ? 0 : 1);
+
+	return (exact == 1);
+    }
+
+    /* initialize */
+    if (rop != op)
+	r = rop;
+    else {
+	r = &t;
+	memset(r, '\0', sizeof(mpi));
+    }
+    memset(&quot, '\0', sizeof(mpi));
+    memset(&rem, '\0', sizeof(mpi));
+    memset(&old, '\0', sizeof(mpi));
+
+    /* root aproximation */
+    mpi_ash(r, op, -(bits - (bits / 2)));
+
+    for (;;) {
+	if (mpi_cmpabs(r, &old) == 0) {
+	    exact = 0;
+	    break;
+	}
+	mpi_divqr(&quot, &rem, op, r);
+	cmp = mpi_cmpabs(&quot, r);
+	if (cmp == 0) {
+	    exact = mpi_cmpi(&rem, 0) == 0;
+	    break;
+	}
+	else if (cmp > 0 && rem.size == 1 && rem.digs[0] == 0)
+	    mpi_subi(&quot, &quot, 1);
+	mpi_set(&old, r);
+	mpi_add(r, r, &quot);
+	mpi_ash(r, r, -1);
+    }
+    mpi_clear(&quot);
+    mpi_clear(&rem);
+    mpi_clear(&old);
+    if (r != rop) {
+	mpi_set(rop, r);
+	mpi_clear(r);
+    }
+
+    return (exact);
+}
+
+void
+mpi_ash(mpi *rop, mpi *op, long shift)
+{
+    long i;			/* counter */
+    long xsize;			/* maximum result size */
+    BNS *digs;
+
+    /* check for 0 shift, multiply/divide by 1 */
+    if (shift == 0) {
+	if (rop != op) {
+	    if (rop->alloc < op->size) {
+		rop->digs = mp_realloc(rop->digs, sizeof(BNS) * op->size);
+		rop->alloc = op->size;
+	    }
+	    rop->size = op->size;
+	    memcpy(rop->digs, op->digs, sizeof(BNS) * op->size);
+	}
+
+	return;
+    }
+    else if (op->size == 1 && op->digs[0] == 0) {
+	rop->sign = 0;
+	rop->size = 1;
+	rop->digs[0] = 0;
+
+	return;
+    }
+
+    /* check shift and initialize */
+    if (shift > 0)
+	xsize = op->size + (shift / BNSBITS) + 1;
+    else {
+	xsize = op->size - ((-shift) / BNSBITS);
+	if (xsize <= 0) {
+	    rop->size = 1;
+	    rop->sign = op->sign;
+	    rop->digs[0] = op->sign ? 1 : 0;
+
+	    return;
+	}
+    }
+
+    /* allocate/adjust memory for result */
+    if (rop == op)
+	digs = mp_malloc(sizeof(BNS) * xsize);
+    else {
+	if (rop->alloc < xsize) {
+	    rop->digs = mp_realloc(rop->digs, sizeof(BNS) * xsize);
+	    rop->alloc = xsize;
+	}
+	digs = rop->digs;
+    }
+
+    /* left shift, multiply by power of two */
+    if (shift > 0)
+	rop->size = mp_lshift(digs, op->digs, op->size, shift);
+    /* right shift, divide by power of two */
+    else {
+	long carry = 0;
+
+	if (op->sign) {
+	    BNI words, bits;
+
+	    words = -shift / BNSBITS;
+	    bits = -shift % BNSBITS;
+	    for (i = 0; i < words; i++)
+		carry |= op->digs[xsize + i];
+	    if (!carry) {
+		for (i = 0; i < bits; i++)
+		    if (op->digs[op->size - xsize] & (1 << i)) {
+			carry = 1;
+			break;
+		    }
+	    }
+	}
+	rop->size = mp_rshift(digs, op->digs, op->size, -shift);
+
+	if (carry)
+	    /* emulates two's complement subtracting 1 from the result */
+	    rop->size = mp_add(digs, digs, mpone.digs, rop->size, 1);
+    }
+
+    if (rop->digs != digs) {
+	mp_free(rop->digs);
+	rop->alloc = rop->size;
+	rop->digs = digs;
+    }
+    rop->sign = op->sign;
+}
+
+static INLINE BNS
+mpi_logic(BNS op1, BNS op2, BNS op)
+{
+    switch (op) {
+	case '&':
+	    return (op1 & op2);
+	case '|':
+	    return (op1 | op2);
+	case '^':
+	    return (op1 ^ op2);
+    }
+
+    return (SMASK);
+}
+
+static void
+mpi_log(mpi *rop, mpi *op1, mpi *op2, BNS op)
+{
+    long i;			/* counter */
+    long c, c1, c2;		/* carry */
+    BNS *digs, *digs1, *digs2;	/* pointers to mp data */
+    BNI size, size1, size2;
+    BNS sign, sign1, sign2;
+    BNS n, n1, n2;		/* logical operands */
+    BNI sum;
+
+    /* initialize */
+    size1 = op1->size;
+    size2 = op2->size;
+
+    sign1 = op1->sign ? SMASK : 0;
+    sign2 = op2->sign ? SMASK : 0;
+
+    sign = mpi_logic(sign1, sign2, op);
+
+    size = MAX(size1, size2);
+    if (sign)
+	++size;
+    if (rop->alloc < size) {
+	rop->digs = mp_realloc(rop->digs, sizeof(BNS) * size);
+	rop->alloc = size;
+    }
+
+    digs = rop->digs;
+    digs1 = op1->digs;
+    digs2 = op2->digs;
+
+    c = c1 = c2 = 1;
+
+    /* apply logical operation */
+    for (i = 0; i < size; i++) {
+	if (i >= size1)
+	    n1 = sign1;
+	else if (sign1) {
+	    sum = (BNI)(BNS)(~digs1[i]) + c1;
+	    c1 = (long)(sum >> BNSBITS);
+	    n1 = (BNS)sum;
+	}
+	else
+	    n1 = digs1[i];
+
+	if (i >= size2)
+	    n2 = sign2;
+	else if (sign2) {
+	    sum = (BNI)(BNS)(~digs2[i]) + c2;
+	    c2 = (long)(sum >> BNSBITS);
+	    n2 = (BNS)sum;
+	}
+	else
+	    n2 = digs2[i];
+
+	n = mpi_logic(n1, n2, op);
+	if (sign) {
+	    sum = (BNI)(BNS)(~n) + c;
+	    c = (long)(sum >> BNSBITS);
+	    digs[i] = (BNS)sum;
+	}
+	else
+	    digs[i] = n;
+    }
+
+    /* normalize */
+    for (i = size - 1; i >= 0; i--)
+	if (digs[i] != 0)
+	    break;
+    if (i != size - 1) {
+	if (i < 0) {
+	    sign = 0;
+	    size = 1;
+	}
+	else
+	    size = i + 1;
+    }
+
+    rop->sign = sign != 0;
+    rop->size = size;
+}
+
+void
+mpi_and(mpi *rop, mpi *op1, mpi *op2)
+{
+    mpi_log(rop, op1, op2, '&');
+}
+
+void
+mpi_ior(mpi *rop, mpi *op1, mpi *op2)
+{
+    mpi_log(rop, op1, op2, '|');
+}
+
+void
+mpi_xor(mpi *rop, mpi *op1, mpi *op2)
+{
+    mpi_log(rop, op1, op2, '^');
+}
+
+void
+mpi_com(mpi *rop, mpi *op)
+{
+    static BNS digs[1] = { 1 };
+    static mpi one = { 0, 1, 1, (BNS*)&digs };
+
+    mpi_log(rop, rop, &one, '^');
+}
+
+void
+mpi_neg(mpi *rop, mpi *op)
+{
+    int sign = op->sign ^ 1;
+
+    if (rop->digs != op->digs) {
+	if (rop->alloc < op->size) {
+	    rop->digs = mp_realloc(rop->digs, sizeof(BNS) * rop->size);
+	    rop->alloc = op->size;
+	}
+	rop->size = op->size;
+	memcpy(rop->digs, op->digs, sizeof(BNS) * rop->size);
+    }
+
+    rop->sign = sign;
+}
+
+void
+mpi_abs(mpi *rop, mpi *op)
+{
+    if (rop->digs != op->digs) {
+	if (rop->alloc < op->size) {
+	    rop->digs = mp_realloc(rop->digs, sizeof(BNS) * rop->size);
+	    rop->alloc = op->size;
+	}
+	rop->size = op->size;
+	memcpy(rop->digs, op->digs, sizeof(BNS) * rop->size);
+    }
+
+    rop->sign = 0;
+}
+
+int
+mpi_cmp(mpi *op1, mpi *op2)
+{
+    if (op1->sign ^ op2->sign)
+	return (op1->sign ? -1 : 1);
+
+    if (op1->size == op2->size) {
+	long i, cmp = 0;
+
+	for (i = op1->size - 1; i >= 0; i--)
+	    if ((cmp = (long)op1->digs[i] - (long)op2->digs[i]) != 0)
+		break;
+
+	return (cmp == 0 ? 0 : (cmp < 0) ^ op1->sign ? -1 : 1);
+    }
+
+    return ((op1->size < op2->size) ^ op1->sign ? -1 : 1);
+}
+
+int
+mpi_cmpi(mpi *op1, long op2)
+{
+    long cmp;
+
+    if (op1->size > 2)
+	return (op1->sign ? -1 : 1);
+
+    cmp = op1->digs[0];
+    if (op1->size == 2) {
+	cmp |= (long)op1->digs[1] << BNSBITS;
+	if (cmp == MINSLONG)
+	    return (op2 == cmp && op1->sign ? 0 : op1->sign ? -1 : 1);
+    }
+    if (op1->sign)
+	cmp = -cmp;
+
+    return (cmp - op2);
+}
+
+int
+mpi_cmpabs(mpi *op1, mpi *op2)
+{
+    if (op1->size == op2->size) {
+	long i, cmp = 0;
+
+	for (i = op1->size - 1; i >= 0; i--)
+	    if ((cmp = (long)op1->digs[i] - (long)op2->digs[i]) != 0)
+		break;
+
+	return (cmp);
+    }
+
+    return ((op1->size < op2->size) ? -1 : 1);
+}
+
+int
+mpi_cmpabsi(mpi *op1, long op2)
+{
+    unsigned long cmp;
+
+    if (op1->size > 2)
+	return (1);
+
+    cmp = op1->digs[0];
+    if (op1->size == 2)
+	cmp |= (unsigned long)op1->digs[1] << BNSBITS;
+
+    return (cmp > op2 ? 1 : cmp == op2 ? 0 : -1);
+}
+
+int
+mpi_sgn(mpi *op)
+{
+    return (op->sign ? -1 : op->size > 1 || op->digs[0] ? 1 : 0);
+}
+
+void
+mpi_swap(mpi *op1, mpi *op2)
+{
+    if (op1 != op2) {
+	mpi swap;
+
+	memcpy(&swap, op1, sizeof(mpi));
+	memcpy(op1, op2, sizeof(mpi));
+	memcpy(op2, &swap, sizeof(mpi));
+    }
+}
+
+int
+mpi_fiti(mpi *op)
+{
+    if (op->size == 1)
+	return (1);
+    else if (op->size == 2) {
+	unsigned long value = ((BNI)(op->digs[1]) << BNSBITS) | op->digs[0];
+
+	if (value & MINSLONG)
+	    return (op->sign && value == MINSLONG) ? 1 : 0;
+
+	return (1);
+    }
+
+    return (0);
+}
+
+long
+mpi_geti(mpi *op)
+{
+    long value;
+
+    value = op->digs[0];
+    if (op->size > 1)
+	value |= (BNI)(op->digs[1]) << BNSBITS;
+
+    return (op->sign && value != MINSLONG ? -value : value);
+}
+
+double
+mpi_getd(mpi *op)
+{
+    long i, len;
+    double d = 0.0;
+    int exponent;
+
+#define FLOATDIGS	sizeof(double) / sizeof(BNS)
+
+    switch (op->size) {
+	case 2:
+	    d = (BNI)(op->digs[1]) << BNSBITS;
+	case 1:
+	    d += op->digs[0];
+	    return (op->sign ? -d : d);
+	default:
+	    break;
+    }
+
+    for (i = 0, len = op->size; len > 0 && i < FLOATDIGS; i++)
+	d = ldexp(d, BNSBITS) + op->digs[--len];
+    d = frexp(d, &exponent);
+    if (len > 0)
+	exponent += len * BNSBITS;
+
+    if (d == 0.0)
+	return (d);
+
+    d = ldexp(d, exponent);
+
+    return (op->sign ? -d : d);
+}
+
+/* how many digits in a given base, floor(log(CARRY) / log(base)) */
+#ifdef LONG64
+static char dig_bases[37] = {
+     0,  0, 32, 20, 16, 13, 12, 11, 10, 10,  9,  9,  8,  8,  8,  8,
+     8,  7,  7,  7,  7,  7,  7,  7,  6,  6,  6,  6,  6,  6,  6,  6,
+     6,  6,  6,  6,  6,
+};
+#else
+static char dig_bases[37] = {
+     0,  0, 16, 10,  8,  6,  6,  5,  5,  5,  4,  4,  4,  4,  4,  4,
+     4,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,
+     3,  3,  3,  3,  3,
+};
+#endif
+
+/* how many digits per bit in a given base, log(2) / log(base) */
+static double bit_bases[37] = {
+    0.0000000000000000, 0.0000000000000000, 1.0000000000000000,
+    0.6309297535714575, 0.5000000000000000, 0.4306765580733931,
+    0.3868528072345416, 0.3562071871080222, 0.3333333333333334,
+    0.3154648767857287, 0.3010299956639811, 0.2890648263178878,
+    0.2789429456511298, 0.2702381544273197, 0.2626495350371936,
+    0.2559580248098155, 0.2500000000000000, 0.2446505421182260,
+    0.2398124665681315, 0.2354089133666382, 0.2313782131597592,
+    0.2276702486969530, 0.2242438242175754, 0.2210647294575037,
+    0.2181042919855316, 0.2153382790366965, 0.2127460535533632,
+    0.2103099178571525, 0.2080145976765095, 0.2058468324604344,
+    0.2037950470905062, 0.2018490865820999, 0.2000000000000000,
+    0.1982398631705605, 0.1965616322328226, 0.1949590218937863,
+    0.1934264036172708,
+};
+
+/* normalization base for string conversion, pow(base, dig_bases[base]) & ~CARRY */
+#ifdef LONG64
+static BNS big_bases[37] = {
+    0x00000001, 0x00000001, 0x00000000, 0xCFD41B91, 0x00000000, 0x48C27395,
+    0x81BF1000, 0x75DB9C97, 0x40000000, 0xCFD41B91, 0x3B9ACA00, 0x8C8B6D2B,
+    0x19A10000, 0x309F1021, 0x57F6C100, 0x98C29B81, 0x00000000, 0x18754571,
+    0x247DBC80, 0x3547667B, 0x4C4B4000, 0x6B5A6E1D, 0x94ACE180, 0xCAF18367,
+    0x0B640000, 0x0E8D4A51, 0x1269AE40, 0x17179149, 0x1CB91000, 0x23744899,
+    0x2B73A840, 0x34E63B41, 0x40000000, 0x4CFA3CC1, 0x5C13D840, 0x6D91B519,
+    0x81BF1000,
+};
+#else
+static BNS big_bases[37] = {
+    0x0001, 0x0001, 0x0000, 0xE6A9, 0x0000, 0x3D09, 0xB640, 0x41A7, 0x8000,
+    0xE6A9, 0x2710, 0x3931, 0x5100, 0x6F91, 0x9610, 0xC5C1, 0x0000, 0x1331,
+    0x16C8, 0x1ACB, 0x1F40, 0x242D, 0x2998, 0x2F87, 0x3600, 0x3D09, 0x44A8,
+    0x4CE3, 0x55C0, 0x5F45, 0x6978, 0x745F, 0x8000, 0x8C61, 0x9988, 0xA77B,
+    0xb640,
+};
+#endif
+
+unsigned long
+mpi_getsize(mpi *op, int base)
+{
+    unsigned long value, bits;
+
+    value = op->digs[op->size - 1];
+
+    /* count leading bits */
+    if (value) {
+	unsigned long count, carry;
+
+	for (count = 0, carry = CARRY >> 1; carry; count++, carry >>= 1)
+	    if (value & carry)
+		break;
+
+	bits = BNSBITS - count;
+    }
+    else
+	bits = 0;
+
+    return ((bits + (op->size - 1) * BNSBITS) * bit_bases[base] + 1);
+}
+
+char *
+mpi_getstr(char *str, mpi *op, int base)
+{
+    long i;			/* counter */
+    BNS *digs, *xdigs;		/* copy of op data */
+    BNI size;			/* size of op */
+    BNI digits;			/* digits per word in given base */
+    BNI bigbase;		/* big base of given base */
+    BNI strsize;		/* size of resulting string */
+    char *cp;			/* pointer in str for conversion */
+
+    /* initialize */
+    size = op->size;
+    strsize = mpi_getsize(op, base) + op->sign + 1;
+
+    if (str == NULL)
+	str = mp_malloc(strsize);
+
+    /* check for zero */
+    if (size == 1 && op->digs[0] == 0) {
+	str[0] = '0';
+	str[1] = '\0';
+
+	return (str);
+    }
+
+    digits = dig_bases[base];
+    bigbase = big_bases[base];
+
+    cp = str + strsize;
+    *--cp = '\0';
+
+    /* make copy of op data and adjust digs */
+    xdigs = mp_malloc(size * sizeof(BNS));
+    memcpy(xdigs, op->digs, size * sizeof(unsigned short));
+    digs = xdigs + size - 1;
+
+    /* convert to string */
+    for (;;) {
+	long count = -1;
+	BNI value;
+	BNS quotient, remainder = 0;
+
+	/* if power of two base */
+	if ((base & (base - 1)) == 0) {
+	    for (i = 0; i < size; i++) {
+		quotient = remainder;
+		remainder = digs[-i];
+		digs[-i] = quotient;
+		if (count < 0 && quotient)
+		    count = i;
+	    }
+	}
+	else {
+	    for (i = 0; i < size; i++) {
+		value = digs[-i] + ((BNI)remainder << BNSBITS);
+		quotient = (BNS)(value / bigbase);
+		remainder = (BNS)(value % bigbase);
+		digs[-i] = quotient;
+		if (count < 0 && quotient)
+		    count = i;
+	    }
+	}
+	quotient = remainder;
+	for (i = 0; i < digits; i++) {
+	    if (quotient == 0 && count < 0)
+		break;
+	    remainder = quotient % base;
+	    quotient /= base;
+	    *--cp = remainder < 10 ? remainder + '0' : remainder - 10 + 'A';
+	}
+	if (count < 0)
+	    break;
+	digs -= count;
+	size -= count;
+    }
+
+    /* adjust sign */
+    if (op->sign)
+	*--cp = '-';
+
+    /* remove any extra characters */
+    if (cp > str)
+	strcpy(str, cp);
+
+    mp_free(xdigs);
+
+    return (str);
+}
diff --git a/lisp/mp/mpr.c b/lisp/mp/mpr.c
new file mode 100644
index 0000000..8b26fe0
--- /dev/null
+++ b/lisp/mp/mpr.c
@@ -0,0 +1,436 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/mp/mpr.c,v 1.2 2002/11/08 08:01:00 paulo Exp $ */
+
+#include "mp.h"
+
+/*
+ * TODO:
+ *  Implement a fast gcd and divexact for integers, so that this code
+ * could be changed to do intermediary calculations faster using smaller
+ * numbers.
+ */
+
+/*
+ * Prototypes
+ */
+	/* do the hard work of mpr_add and mpr_sub */
+static void mpr_addsub(mpr *rop, mpr *op1, mpr *op2, int sub);
+
+	/* do the hard work of mpr_cmp and mpr_cmpabs */
+static int mpr_docmp(mpr *op1, mpr *op2, int sign);
+
+/*
+ * Implementation
+ */
+void
+mpr_init(mpr *op)
+{
+    op->num.digs = mp_malloc(sizeof(BNS));
+    op->num.sign = 0;
+    op->num.size = op->num.alloc = 1;
+    op->num.digs[0] = 0;
+
+    op->den.digs = mp_malloc(sizeof(BNS));
+    op->den.sign = 0;
+    op->den.size = op->den.alloc = 1;
+    op->den.digs[0] = 1;
+}
+
+void
+mpr_clear(mpr *op)
+{
+    op->num.sign = 0;
+    op->num.size = op->num.alloc = 0;
+    mp_free(op->num.digs);
+
+    op->den.sign = 0;
+    op->den.size = op->den.alloc = 0;
+    mp_free(op->den.digs);
+}
+
+void
+mpr_set(mpr *rop, mpr *op)
+{
+    if (rop != op) {
+	mpi_set(mpr_num(rop), mpr_num(op));
+	mpi_set(mpr_den(rop), mpr_den(op));
+    }
+}
+
+void
+mpr_seti(mpr *rop, long num, long den)
+{
+    mpi_seti(mpr_num(rop), num);
+    mpi_seti(mpr_den(rop), den);
+}
+
+void
+mpr_setd(mpr *rop, double d)
+{
+    double val, num;
+    int e, sign;
+
+    /* initialize */
+    if (d < 0) {
+	sign = 1;
+	val = -d;
+    }
+    else {
+	sign = 0;
+	val = d;
+    }
+
+    val = frexp(val, &e);
+    while (modf(val, &num) != 0.0 && val <= DBL_MAX / 2.0) {
+	--e;
+	val *= 2.0;
+    }
+    if (e >= 0) {
+	mpi_setd(mpr_num(rop), d);
+	mpi_seti(mpr_den(rop), 1);
+    }
+    else {
+	mpi_setd(mpr_num(rop), sign ? -num : num);
+	mpi_setd(mpr_den(rop), ldexp(1.0, -e));
+    }
+}
+
+void
+mpr_setstr(mpr *rop, char *str, int base)
+{
+    char *slash = strchr(str, '/');
+
+    mpi_setstr(mpr_num(rop), str, base);
+    if (slash != NULL)
+	mpi_setstr(mpr_den(rop), slash + 1, base);
+    else
+	mpi_seti(mpr_den(rop), 1);
+}
+
+void
+mpr_canonicalize(mpr *op)
+{
+    mpi gcd;
+
+    memset(&gcd, '\0', sizeof(mpi));
+
+    mpi_gcd(&gcd, mpr_num(op), mpr_den(op));
+    if (mpi_cmpabsi(&gcd, 1)) {
+	mpi_div(mpr_num(op), mpr_num(op), &gcd);
+	mpi_div(mpr_den(op), mpr_den(op), &gcd);
+    }
+
+    if (op->den.sign) {
+	op->num.sign = !op->num.sign;
+	op->den.sign = 0;
+    }
+
+    mpi_clear(&gcd);
+}
+
+void
+mpr_add(mpr *rop, mpr *op1, mpr *op2)
+{
+    mpr_addsub(rop, op1, op2, 0);
+}
+
+void
+mpr_addi(mpr *rop, mpr *op1, long op2)
+{
+    mpi prod;
+
+    memset(&prod, '\0', sizeof(mpi));
+
+    mpi_muli(&prod, mpr_den(op1), op2);
+    mpi_add(mpr_num(rop), mpr_num(op1), &prod);
+    mpi_clear(&prod);
+}
+
+void
+mpr_sub(mpr *rop, mpr *op1, mpr *op2)
+{
+    mpr_addsub(rop, op1, op2, 1);
+}
+
+void
+mpr_subi(mpr *rop, mpr *op1, long op2)
+{
+    mpi prod;
+
+    memset(&prod, '\0', sizeof(mpi));
+
+    mpi_muli(&prod, mpr_den(op1), op2);
+    mpi_sub(mpr_num(rop), mpr_num(op1), &prod);
+    mpi_clear(&prod);
+}
+
+static void
+mpr_addsub(mpr *rop, mpr *op1, mpr *op2, int sub)
+{
+    mpi prod1, prod2;
+
+    memset(&prod1, '\0', sizeof(mpi));
+    memset(&prod2, '\0', sizeof(mpi));
+
+    mpi_mul(&prod1, mpr_num(op1), mpr_den(op2));
+    mpi_mul(&prod2, mpr_num(op2), mpr_den(op1));
+
+    if (sub)
+	mpi_sub(mpr_num(rop), &prod1, &prod2);
+    else
+	mpi_add(mpr_num(rop), &prod1, &prod2);
+
+    mpi_clear(&prod1);
+    mpi_clear(&prod2);
+
+    mpi_mul(mpr_den(rop), mpr_den(op1), mpr_den(op2));
+}
+
+void
+mpr_mul(mpr *rop, mpr *op1, mpr *op2)
+{
+    /* check if temporary storage is required */
+    if (op1 == op2 && rop == op1) {
+	mpi prod;
+
+	memset(&prod, '\0', sizeof(mpi));
+
+	mpi_mul(&prod, mpr_num(op1), mpr_num(op2));
+	mpi_mul(mpr_den(rop), mpr_den(op1), mpr_den(op2));
+	mpi_set(mpr_num(rop), &prod);
+
+	mpi_clear(&prod);
+    }
+    else {
+	mpi_mul(mpr_num(rop), mpr_num(op1), mpr_num(op2));
+	mpi_mul(mpr_den(rop), mpr_den(op1), mpr_den(op2));
+    }
+}
+
+void
+mpr_muli(mpr *rop, mpr *op1, long op2)
+{
+    mpi_muli(mpr_num(rop), mpr_num(op1), op2);
+}
+
+void
+mpr_div(mpr *rop, mpr *op1, mpr *op2)
+{
+    /* check if temporary storage is required */
+    if (op1 == op2 && rop == op1) {
+	mpi prod;
+
+	memset(&prod, '\0', sizeof(mpi));
+
+	mpi_mul(&prod, mpr_num(op1), mpr_den(op2));
+	mpi_mul(mpr_den(rop), mpr_num(op2), mpr_den(op1));
+	mpi_set(mpr_num(rop), &prod);
+
+	mpi_clear(&prod);
+    }
+    else {
+	mpi_mul(mpr_num(rop), mpr_num(op1), mpr_den(op2));
+	mpi_mul(mpr_den(rop), mpr_num(op2), mpr_den(op1));
+    }
+}
+
+void
+mpr_divi(mpr *rop, mpr *op1, long op2)
+{
+    mpi_muli(mpr_den(rop), mpr_den(op1), op2);
+}
+
+void
+mpr_inv(mpr *rop, mpr *op)
+{
+    if (rop == op)
+	mpi_swap(mpr_num(op), mpr_den(op));
+    else {
+	mpi_set(mpr_num(rop), mpr_den(op));
+	mpi_set(mpr_den(rop), mpr_num(op));
+    }
+}
+
+void
+mpr_neg(mpr *rop, mpr *op)
+{
+    mpi_neg(mpr_num(rop), mpr_num(op));
+    mpi_set(mpr_den(rop), mpr_den(op));
+}
+
+void
+mpr_abs(mpr *rop, mpr *op)
+{
+    if (mpr_num(op)->sign)
+	mpi_neg(mpr_num(rop), mpr_num(op));
+    else
+	mpi_set(mpr_num(rop), mpr_num(op));
+
+    /* op may not be canonicalized */
+    if (mpr_den(op)->sign)
+	mpi_neg(mpr_den(rop), mpr_den(op));
+    else
+	mpi_set(mpr_den(rop), mpr_den(op));
+}
+
+int
+mpr_cmp(mpr *op1, mpr *op2)
+{
+    return (mpr_docmp(op1, op2, 1));
+}
+
+int
+mpr_cmpi(mpr *op1, long op2)
+{
+    int cmp;
+    mpr rat;
+
+    mpr_init(&rat);
+    mpi_seti(mpr_num(&rat), op2);
+    cmp = mpr_docmp(op1, &rat, 1);
+    mpr_clear(&rat);
+
+    return (cmp);
+}
+
+int
+mpr_cmpabs(mpr *op1, mpr *op2)
+{
+    return (mpr_docmp(op1, op2, 0));
+}
+
+int
+mpr_cmpabsi(mpr *op1, long op2)
+{
+    int cmp;
+    mpr rat;
+
+    mpr_init(&rat);
+    mpi_seti(mpr_num(&rat), op2);
+    cmp = mpr_docmp(op1, &rat, 0);
+    mpr_clear(&rat);
+
+    return (cmp);
+}
+
+static int
+mpr_docmp(mpr *op1, mpr *op2, int sign)
+{
+    int cmp, neg;
+    mpi prod1, prod2;
+
+    neg = 0;
+    if (sign) {
+	/* if op1 is negative */
+	if (mpr_num(op1)->sign ^ mpr_den(op1)->sign) {
+	    /* if op2 is positive */
+	    if (!(mpr_num(op2)->sign ^ mpr_den(op2)->sign))
+		return (-1);
+	    else
+		neg = 1;
+	}
+	/* if op2 is negative */
+	else if (mpr_num(op2)->sign ^ mpr_den(op2)->sign)
+	    return (1);
+	/* else same sign */
+    }
+
+    /* if denominators are equal, compare numerators */
+    if (mpi_cmpabs(mpr_den(op1), mpr_den(op2)) == 0) {
+	cmp = mpi_cmpabs(mpr_num(op1), mpr_num(op2));
+	if (cmp == 0)
+	    return (0);
+	if (sign && neg)
+	    return (cmp < 0 ? 1 : -1);
+	return (cmp);
+    }
+
+    memset(&prod1, '\0', sizeof(mpi));
+    memset(&prod2, '\0', sizeof(mpi));
+
+    /* "divide" op1 by op2
+     * if result is smaller than 1, op1 is smaller than op2 */
+    mpi_mul(&prod1, mpr_num(op1), mpr_den(op2));
+    mpi_mul(&prod2, mpr_num(op2), mpr_den(op1));
+
+    cmp = mpi_cmpabs(&prod1, &prod2);
+
+    mpi_clear(&prod1);
+    mpi_clear(&prod2);
+
+    if (sign && neg)
+	return (cmp < 0 ? 1 : -1);
+    return (cmp);
+}
+
+void
+mpr_swap(mpr *op1, mpr *op2)
+{
+    if (op1 != op2) {
+	mpr swap;
+
+	memcpy(&swap, op1, sizeof(mpr));
+	memcpy(op1, op2, sizeof(mpr));
+	memcpy(op2, &swap, sizeof(mpr));
+    }
+}
+
+int
+mpr_fiti(mpr *op)
+{
+    return (mpi_fiti(mpr_num(op)) && mpi_fiti(mpr_den(op)));
+}
+
+double
+mpr_getd(mpr *op)
+{
+    return (mpi_getd(mpr_num(op)) / mpi_getd(mpr_den(op)));
+}
+
+char *
+mpr_getstr(char *str, mpr *op, int base)
+{
+    int len;
+
+    if (str == NULL) {
+	len = mpi_getsize(mpr_num(op), base) + mpr_num(op)->sign + 1 +
+	      mpi_getsize(mpr_den(op), base) + mpr_den(op)->sign + 1;
+
+	str = mp_malloc(len);
+    }
+
+    (void)mpi_getstr(str, mpr_num(op), base);
+    len = strlen(str);
+    str[len] = '/';
+    (void)mpi_getstr(str + len + 1, mpr_den(op), base);
+
+    return (str);
+}
diff --git a/lisp/package.c b/lisp/package.c
new file mode 100644
index 0000000..c046e55
--- /dev/null
+++ b/lisp/package.c
@@ -0,0 +1,865 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/package.c,v 1.20 2002/11/30 23:13:12 paulo Exp $ */
+
+#include "package.h"
+#include "private.h"
+
+/*
+ * Prototypes
+ */
+static int LispDoSymbol(LispObj*, LispAtom*, int, int);
+static LispObj *LispReallyDoSymbols(LispBuiltin*, int, int);
+static LispObj *LispDoSymbols(LispBuiltin*, int, int);
+static LispObj *LispFindSymbol(LispBuiltin*, int);
+static LispObj *LispFindPackageOrDie(LispBuiltin*, LispObj*);
+static void LispDoExport(LispBuiltin*, LispObj*, LispObj*, int);
+static void LispDoImport(LispBuiltin*, LispObj*);
+
+/*
+ * Initialization
+ */
+extern LispProperty *NOPROPERTY;
+static LispObj *Kinternal, *Kexternal, *Kinherited;
+
+/*
+ * Implementation
+ */
+void
+LispPackageInit(void)
+{
+    Kinternal	= KEYWORD("INTERNAL");
+    Kexternal	= KEYWORD("EXTERNAL");
+    Kinherited	= KEYWORD("INHERITED");
+}
+
+LispObj *
+LispFindPackageFromString(char *string)
+{
+    LispObj *list, *package, *nick;
+
+    for (list = PACK; CONSP(list); list = CDR(list)) {
+	package = CAR(list);
+	if (strcmp(THESTR(package->data.package.name), string) == 0)
+	    return (package);
+	for (nick = package->data.package.nicknames;
+	     CONSP(nick); nick = CDR(nick))
+	    if (strcmp(THESTR(CAR(nick)), string) == 0)
+		return (package);
+    }
+
+    return (NIL);
+}
+
+LispObj *
+LispFindPackage(LispObj *name)
+{
+    char *string = NULL;
+
+    if (PACKAGEP(name))
+	return (name);
+
+    if (SYMBOLP(name))
+	string = ATOMID(name);
+    else if (STRINGP(name))
+	string = THESTR(name);
+    else
+	LispDestroy("FIND-PACKAGE: %s is not a string or symbol", STROBJ(name));
+
+    return (LispFindPackageFromString(string));
+}
+
+int
+LispCheckAtomString(char *string)
+{
+    char *ptr;
+
+    if (*string == '\0')
+	return (0);
+
+    for (ptr = string; *ptr; ptr++) {
+	if (islower(*ptr) || strchr("\"\\;#()`'|:", *ptr) ||
+	    ((ptr == string || ptr[1] == '\0') && strchr(".,@", *ptr)))
+	    return (0);
+    }
+
+    return (1);
+}
+
+/*   This function is used to avoid some namespace polution caused by the
+ * way builtin functions are created, all function name arguments enter
+ * the current package, but most of them do not have a property */
+static int
+LispDoSymbol(LispObj *package, LispAtom *atom, int if_extern, int all_packages)
+{
+    int dosymbol;
+
+    /* condition 1: atom package is current package */
+    dosymbol = !all_packages || atom->package == package;
+    if (dosymbol) {
+	/* condition 2: intern and extern symbols or symbol is extern */
+	dosymbol = !if_extern || atom->ext;
+	if (dosymbol) {
+	    /* condition 3: atom has properties or is in
+	     * the current package */
+	    dosymbol = atom->property != NOPROPERTY ||
+		       package == lisp__data.keyword ||
+		       package == PACKAGE;
+	}
+    }
+
+    return (dosymbol);
+}
+
+static LispObj *
+LispFindPackageOrDie(LispBuiltin *builtin, LispObj *name)
+{
+    LispObj *package;
+
+    package = LispFindPackage(name);
+
+    if (package == NIL)
+	LispDestroy("%s: package %s is not available",
+		    STRFUN(builtin), STROBJ(name));
+
+    return (package);
+}
+
+/* package must be of type LispPackage_t, symbol type is checked
+   bypass lisp.c:LispExportSymbol() */
+static void
+LispDoExport(LispBuiltin *builtin,
+	     LispObj *package, LispObj *symbol, int export)
+{
+    CHECK_SYMBOL(symbol);
+    if (!export) {
+	if (package == lisp__data.keyword ||
+	    symbol->data.atom->package == lisp__data.keyword)
+	    LispDestroy("%s: symbol %s cannot be unexported",
+			STRFUN(builtin), STROBJ(symbol));
+    }
+
+    if (package == PACKAGE)
+	symbol->data.atom->ext = export ? 1 : 0;
+    else {
+	int i;
+	char *string;
+	LispAtom *atom;
+	LispPackage *pack;
+
+	string = ATOMID(symbol);
+	pack = package->data.package.package;
+	i = STRHASH(string);
+	atom = pack->atoms[i];
+	while (atom) {
+	    if (strcmp(atom->string, string) == 0) {
+		atom->ext = export ? 1 : 0;
+		return;
+	    }
+
+	    atom = atom->next;
+	}
+
+	LispDestroy("%s: the symbol %s is not available in package %s",
+		    STRFUN(builtin), STROBJ(symbol),
+		    THESTR(package->data.package.name));
+    }
+}
+
+static void
+LispDoImport(LispBuiltin *builtin, LispObj *symbol)
+{
+    CHECK_SYMBOL(symbol);
+    LispImportSymbol(symbol);
+}
+
+static LispObj *
+LispReallyDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols)
+{
+    int i, head = lisp__data.env.length;
+    LispPackage *pack = NULL;
+    LispAtom *atom, *next_atom;
+    LispObj *variable, *package = NULL, *list, *code, *result_form;
+
+    LispObj *init, *body;
+
+    body = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    /* Prepare for loop */
+    CHECK_CONS(init);
+    variable = CAR(init);
+    CHECK_SYMBOL(variable);
+
+    if (!all_symbols) {
+	/* if all_symbols, a package name is not specified in the init form */
+
+	init = CDR(init);
+	if (!CONSP(init))
+	    LispDestroy("%s: missing package name", STRFUN(builtin));
+
+	/* Evaluate package specification */
+	package = EVAL(CAR(init));
+	if (!PACKAGEP(package))
+	    package = LispFindPackageOrDie(builtin, package);
+
+	pack = package->data.package.package;
+    }
+
+    result_form = NIL;
+
+    init = CDR(init);
+    if (CONSP(init))
+	result_form = init;
+
+    /* Initialize iteration variable */
+    CHECK_CONSTANT(variable);
+    LispAddVar(variable, NIL);
+    ++lisp__data.env.head;
+
+    for (list = PACK; CONSP(list); list = CDR(list)) {
+	if (all_symbols) {
+	    package = CAR(list);
+	    pack = package->data.package.package;
+	}
+
+	/* Traverse the symbol list, executing body */
+	for (i = 0; i < STRTBLSZ; i++) {
+	    atom = pack->atoms[i];
+	    while (atom) {
+		/* Save pointer to next atom. If variable is removed,
+		 * predicatable result is only guaranteed if the bound
+		 * variable is removed. */
+		next_atom = atom->next;
+
+		if (LispDoSymbol(package, atom, only_externs, all_symbols)) {
+		    LispSetVar(variable, atom->object);
+		    for (code = body; CONSP(code); code = CDR(code))
+			EVAL(CAR(code));
+		}
+
+		atom = next_atom;
+	    }
+	}
+
+	if (!all_symbols)
+	    break;
+    }
+
+    /* Variable is still bound */
+    for (code = result_form; CONSP(code); code = CDR(code))
+	EVAL(CAR(code));
+
+    lisp__data.env.head = lisp__data.env.length = head;
+
+    return (NIL);
+}
+
+static LispObj *
+LispDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols)
+{
+    int did_jump, *pdid_jump = &did_jump;
+    LispObj *result, **presult = &result;
+    LispBlock *block;
+
+    *presult = NIL;
+    *pdid_jump = 1;
+    block = LispBeginBlock(NIL, LispBlockTag);
+    if (setjmp(block->jmp) == 0) {
+	*presult = LispReallyDoSymbols(builtin, only_externs, all_symbols);
+	*pdid_jump = 0;
+    }
+    LispEndBlock(block);
+    if (*pdid_jump)
+	*presult = lisp__data.block.block_ret;
+
+    return (*presult);
+}
+
+LispObj *
+LispFindSymbol(LispBuiltin *builtin, int intern)
+{
+    int i;
+    char *ptr;
+    LispAtom *atom;
+    LispObj *symbol;
+    LispPackage *pack;
+
+    LispObj *string, *package;
+
+    package = ARGUMENT(1);
+    string = ARGUMENT(0);
+
+    CHECK_STRING(string);
+    if (package != UNSPEC)
+	package = LispFindPackageOrDie(builtin, package);
+    else
+	package = PACKAGE;
+
+    /* If got here, package is a LispPackage_t */
+    pack = package->data.package.package;
+
+    /* Search symbol in specified package */
+    ptr = THESTR(string);
+
+    RETURN_COUNT = 1;
+
+    symbol = NULL;
+    /* Fix for current behaviour where NIL and T aren't symbols... */
+    if (STRLEN(string) == 3 && memcmp(ptr, "NIL", 3) == 0)
+	symbol = NIL;
+    else if (STRLEN(string) == 1 && ptr[0] == 'T')
+	symbol = T;
+    if (symbol) {
+	RETURN(0) = NIL;
+	return (symbol);
+    }
+
+    i = STRHASH(ptr);
+    atom = pack->atoms[i];
+    while (atom) {
+	if (strcmp(atom->string, ptr) == 0) {
+	    symbol = atom->object;
+	    break;
+	}
+	atom = atom->next;
+    }
+
+    if (symbol == NULL || symbol->data.atom->package == NULL) {
+	RETURN(0) = NIL;
+	if (intern) {
+	    /* symbol does not exist in the specified package, create a new
+	     * internal symbol */
+
+	    if (package == PACKAGE)
+		symbol = ATOM(ptr);
+	    else {
+		LispPackage *savepack;
+		LispObj *savepackage;
+
+		/* Save package environment */
+		savepackage = PACKAGE;
+		savepack = lisp__data.pack;
+
+		/* Change package environment */
+		PACKAGE = package;
+		lisp__data.pack = package->data.package.package;
+
+		symbol = ATOM(ptr);
+
+		/* Restore package environment */
+		PACKAGE = savepackage;
+		lisp__data.pack = savepack;
+	    }
+
+	    symbol->data.atom->unreadable = !LispCheckAtomString(ptr);
+	    /* If symbol being create in the keyword package, make it external */
+	    if (package == lisp__data.keyword)
+		symbol->data.atom->ext = symbol->data.atom->constant = 1;
+	}
+	else
+	    symbol = NIL;
+    }
+    else {
+	if (symbol->data.atom->package == package)
+	    RETURN(0) = symbol->data.atom->ext ? Kexternal : Kinternal;
+	else
+	    RETURN(0) = Kinherited;
+    }
+
+    return (symbol);
+}
+
+
+LispObj *
+Lisp_DoAllSymbols(LispBuiltin *builtin)
+/*
+ do-all-symbols init &rest body
+ */
+{
+    return (LispDoSymbols(builtin, 0, 1));
+}
+
+LispObj *
+Lisp_DoExternalSymbols(LispBuiltin *builtin)
+/*
+ do-external-symbols init &rest body
+ */
+{
+    return (LispDoSymbols(builtin, 1, 0));
+}
+
+LispObj *
+Lisp_DoSymbols(LispBuiltin *builtin)
+/*
+ do-symbols init &rest body
+ */
+{
+    return (LispDoSymbols(builtin, 0, 0));
+}
+
+LispObj *
+Lisp_FindAllSymbols(LispBuiltin *builtin)
+/*
+ find-all-symbols string-or-symbol
+ */
+{
+    GC_ENTER();
+    char *string = NULL;
+    LispAtom *atom;
+    LispPackage *pack;
+    LispObj *list, *package, *result;
+    int i;
+
+    LispObj *string_or_symbol;
+
+    string_or_symbol = ARGUMENT(0);
+
+    if (STRINGP(string_or_symbol))
+	string = THESTR(string_or_symbol);
+    else if (SYMBOLP(string_or_symbol))
+	string = ATOMID(string_or_symbol);
+    else
+	LispDestroy("%s: %s is not a string or symbol",
+		    STRFUN(builtin), STROBJ(string_or_symbol));
+
+    result = NIL;
+    i = STRHASH(string);
+
+    /* Traverse all packages, searching for symbols matching specified string */
+    for (list = PACK; CONSP(list); list = CDR(list)) {
+	package = CAR(list);
+	pack = package->data.package.package;
+
+	atom = pack->atoms[i];
+	while (atom) {
+	    if (strcmp(atom->string, string) == 0 &&
+		LispDoSymbol(package, atom, 0, 1)) {
+		/* Return only one pointer to a matching symbol */
+
+		if (result == NIL) {
+		    result = CONS(atom->object, NIL);
+		    GC_PROTECT(result);
+		}
+		else {
+		    /* Put symbols defined first in the
+		     * beginning of the result list */
+		    RPLACD(result, CONS(CAR(result), CDR(result)));
+		    RPLACA(result, atom->object);
+		}
+	    }
+	    atom = atom->next;
+	}
+    }
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_FindSymbol(LispBuiltin *builtin)
+/*
+ find-symbol string &optional package
+ */
+{
+    return (LispFindSymbol(builtin, 0));
+}
+
+LispObj *
+Lisp_FindPackage(LispBuiltin *builtin)
+/*
+ find-package name
+ */
+{
+    LispObj *name;
+
+    name = ARGUMENT(0);
+
+    return (LispFindPackage(name));
+}
+
+LispObj *
+Lisp_Export(LispBuiltin *builtin)
+/*
+ export symbols &optional package
+ */
+{
+    LispObj *list;
+
+    LispObj *symbols, *package;
+
+    package = ARGUMENT(1);
+    symbols = ARGUMENT(0);
+
+    /* If specified, make sure package is available */
+    if (package != UNSPEC)
+	package = LispFindPackageOrDie(builtin, package);
+    else
+	package = PACKAGE;
+
+    /* Export symbols */
+    if (CONSP(symbols)) {
+	for (list = symbols; CONSP(list); list = CDR(list))
+	    LispDoExport(builtin, package, CAR(list), 1);
+    }
+    else
+	LispDoExport(builtin, package, symbols, 1);
+
+    return (T);
+}
+
+LispObj *
+Lisp_Import(LispBuiltin *builtin)
+/*
+ import symbols &optional package
+ */
+{
+    int restore_package;
+    LispPackage *savepack = NULL;
+    LispObj *list, *savepackage = NULL;
+
+    LispObj *symbols, *package;
+
+    package = ARGUMENT(1);
+    symbols = ARGUMENT(0);
+
+    /* If specified, make sure package is available */
+    if (package != UNSPEC)
+	package = LispFindPackageOrDie(builtin, package);
+    else
+	package = PACKAGE;
+
+    restore_package = package != PACKAGE;
+    if (restore_package) {
+	/* Save package environment */
+	savepackage = PACKAGE;
+	savepack = lisp__data.pack;
+
+	/* Change package environment */
+	PACKAGE = package;
+	lisp__data.pack = package->data.package.package;
+    }
+
+    /* Export symbols */
+    if (CONSP(symbols)) {
+	for (list = symbols; CONSP(list); list = CDR(list))
+	    LispDoImport(builtin, CAR(list));
+    }
+    else
+	LispDoImport(builtin, symbols);
+
+    if (restore_package) {
+	/* Restore package environment */
+	PACKAGE = savepackage;
+	lisp__data.pack = savepack;
+    }
+
+    return (T);
+}
+
+LispObj *
+Lisp_InPackage(LispBuiltin *builtin)
+/*
+ in-package name
+ */
+{
+    LispObj *package;
+
+    LispObj *name;
+
+    name = ARGUMENT(0);
+
+    package = LispFindPackageOrDie(builtin, name);
+
+    /* Update pointer to package symbol table */
+    lisp__data.pack = package->data.package.package;
+    PACKAGE = package;
+
+    return (package);
+}
+
+LispObj *
+Lisp_Intern(LispBuiltin *builtin)
+/*
+ intern string &optional package
+ */
+{
+    return (LispFindSymbol(builtin, 1));
+}
+
+LispObj *
+Lisp_ListAllPackages(LispBuiltin *builtin)
+/*
+ list-all-packages
+ */
+{
+    /*   Maybe this should be read-only or a copy of the package list.
+     *   But, if properly implemented, it should be possible to (rplaca)
+     * this variable from lisp code with no problems. Don't do it at home. */
+
+    return (PACK);
+}
+
+LispObj *
+Lisp_MakePackage(LispBuiltin *builtin)
+/*
+ make-package package-name &key nicknames use
+ */
+{
+    GC_ENTER();
+    LispObj *list, *package, *nicks, *cons, *savepackage;
+
+    LispObj *package_name, *nicknames, *use;
+
+    use = ARGUMENT(2);
+    nicknames = ARGUMENT(1);
+    package_name = ARGUMENT(0);
+
+    /* Check if package already exists */
+    package = LispFindPackage(package_name);
+    if (package != NIL)
+	/* FIXME: this should be a correctable error */
+	LispDestroy("%s: package %s already defined",
+		    STRFUN(builtin), STROBJ(package_name));
+
+    /* Error checks done, package_name is either a symbol or string */
+    if (!XSTRINGP(package_name))
+	package_name = STRING(ATOMID(package_name));
+
+    GC_PROTECT(package_name);
+
+    /* Check nicknames */
+    nicks = cons = NIL;
+    for (list = nicknames; CONSP(list); list = CDR(list)) {
+	package = LispFindPackage(CAR(list));
+	if (package != NIL)
+	    /* FIXME: this should be a correctable error */
+	    LispDestroy("%s: nickname %s matches package %s",
+			STRFUN(builtin), STROBJ(CAR(list)),
+			THESTR(package->data.package.name));
+	/* Store all nicknames as strings */
+	package = CAR(list);
+	if (!XSTRINGP(package))
+	    package = STRING(ATOMID(package));
+	if (nicks == NIL) {
+	    nicks = cons = CONS(package, NIL);
+	    GC_PROTECT(nicks);
+	}
+	else {
+	    RPLACD(cons, CONS(package, NIL));
+	    cons = CDR(cons);
+	}
+    }
+
+    /* Check use list */
+    for (list = use; CONSP(list); list = CDR(list))
+	(void)LispFindPackageOrDie(builtin, CAR(list));
+
+    /* No errors, create new package */
+    package = LispNewPackage(package_name, nicks);
+
+    /* Update list of packages */
+    PACK = CONS(package, PACK);
+
+    /* No need for gc protection anymore */
+    GC_LEAVE();
+
+    /* Import symbols from use list */
+    savepackage = PACKAGE;
+
+    /* Update pointer to package symbol table */
+    lisp__data.pack = package->data.package.package;
+    PACKAGE = package;
+
+    if (use != UNSPEC) {
+	for (list = use; CONSP(list); list = CDR(list))
+	    LispUsePackage(LispFindPackage(CAR(list)));
+    }
+    else
+	LispUsePackage(lisp__data.lisp);
+
+    /* Restore pointer to package symbol table */
+    lisp__data.pack = savepackage->data.package.package;
+    PACKAGE = savepackage;
+
+    return (package);
+}
+
+LispObj *
+Lisp_Packagep(LispBuiltin *builtin)
+/*
+ packagep object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (PACKAGEP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_PackageName(LispBuiltin *builtin)
+/*
+ package-name package
+ */
+{
+    LispObj *package;
+
+    package = ARGUMENT(0);
+
+    package = LispFindPackageOrDie(builtin, package);
+
+    return (package->data.package.name);
+}
+
+LispObj *
+Lisp_PackageNicknames(LispBuiltin *builtin)
+/*
+ package-nicknames package
+ */
+{
+    LispObj *package;
+
+    package = ARGUMENT(0);
+
+    package = LispFindPackageOrDie(builtin, package);
+
+    return (package->data.package.nicknames);
+}
+
+LispObj *
+Lisp_PackageUseList(LispBuiltin *builtin)
+/*
+ package-use-list package
+ */
+{
+    /*  If the variable returned by this function is expected to be changeable,
+     * need to change the layout of the LispPackage structure. */
+
+    LispPackage *pack;
+    LispObj *package, *use, *cons;
+
+    package = ARGUMENT(0);
+
+    package = LispFindPackageOrDie(builtin, package);
+
+    use = cons = NIL;
+    pack = package->data.package.package;
+
+    if (pack->use.length) {
+	GC_ENTER();
+	int i = pack->use.length - 1;
+
+	use = cons = CONS(pack->use.pairs[i], NIL);
+	GC_PROTECT(use);
+	for (--i; i >= 0; i--) {
+	    RPLACD(cons, CONS(pack->use.pairs[i], NIL));
+	    cons = CDR(cons);
+	}
+	GC_LEAVE();
+    }
+
+    return (use);
+}
+
+LispObj *
+Lisp_PackageUsedByList(LispBuiltin *builtin)
+/*
+ package-used-by-list package
+ */
+{
+    GC_ENTER();
+    int i;
+    LispPackage *pack;
+    LispObj *package, *other, *used, *cons, *list;
+
+    package = ARGUMENT(0);
+
+    package = LispFindPackageOrDie(builtin, package);
+
+    used = cons = NIL;
+
+    for (list = PACK; CONSP(list); list = CDR(list)) {
+	other = CAR(list);
+	if (package == other)
+	    /* Surely package uses itself */
+	    continue;
+
+	pack = other->data.package.package;
+
+	for (i = 0; i < pack->use.length; i++) {
+	    if (pack->use.pairs[i] == package) {
+		if (used == NIL) {
+		    used = cons = CONS(other, NIL);
+		    GC_PROTECT(used);
+		}
+		else {
+		    RPLACD(cons, CONS(other, NIL));
+		    cons = CDR(cons);
+		}
+	    }
+	}
+    }
+
+    GC_LEAVE();
+
+    return (used);
+}
+
+LispObj *
+Lisp_Unexport(LispBuiltin *builtin)
+/*
+ unexport symbols &optional package
+ */
+{
+    LispObj *list;
+
+    LispObj *symbols, *package;
+
+    package = ARGUMENT(1);
+    symbols = ARGUMENT(0);
+
+    /* If specified, make sure package is available */
+    if (package != UNSPEC)
+	package = LispFindPackageOrDie(builtin, package);
+    else
+	package = PACKAGE;
+
+    /* Export symbols */
+    if (CONSP(symbols)) {
+	for (list = symbols; CONSP(list); list = CDR(list))
+	    LispDoExport(builtin, package, CAR(list), 0);
+    }
+    else
+	LispDoExport(builtin, package, symbols, 0);
+
+    return (T);
+}
diff --git a/lisp/package.h b/lisp/package.h
new file mode 100644
index 0000000..23ad822
--- /dev/null
+++ b/lisp/package.h
@@ -0,0 +1,62 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/package.h,v 1.7 2002/11/26 04:06:28 paulo Exp $ */
+
+#ifndef Lisp_package_h
+#define Lisp_package_h
+
+#include "internal.h"
+
+void LispPackageInit(void);
+LispObj *LispFindPackage(LispObj*);
+LispObj *LispFindPackageFromString(char*);
+/* returns 1 if string can safely be read back */
+int LispCheckAtomString(char*);
+
+LispObj *Lisp_DoAllSymbols(LispBuiltin*);
+LispObj *Lisp_DoExternalSymbols(LispBuiltin*);
+LispObj *Lisp_DoSymbols(LispBuiltin*);
+LispObj *Lisp_FindAllSymbols(LispBuiltin*);
+LispObj *Lisp_FindPackage(LispBuiltin*);
+LispObj *Lisp_FindSymbol(LispBuiltin*);
+LispObj *Lisp_Export(LispBuiltin*);
+LispObj *Lisp_Import(LispBuiltin*);
+LispObj *Lisp_InPackage(LispBuiltin*);
+LispObj *Lisp_Intern(LispBuiltin*);
+LispObj *Lisp_ListAllPackages(LispBuiltin*);
+LispObj *Lisp_MakePackage(LispBuiltin*);
+LispObj *Lisp_Packagep(LispBuiltin*);
+LispObj *Lisp_PackageName(LispBuiltin*);
+LispObj *Lisp_PackageNicknames(LispBuiltin*);
+LispObj *Lisp_PackageUseList(LispBuiltin*);
+LispObj *Lisp_PackageUsedByList(LispBuiltin*);
+LispObj *Lisp_Unexport(LispBuiltin*);
+
+#endif /* Lisp_package_h */
diff --git a/lisp/pathname.c b/lisp/pathname.c
new file mode 100644
index 0000000..6af8cd1
--- /dev/null
+++ b/lisp/pathname.c
@@ -0,0 +1,1096 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/pathname.c,v 1.17 2002/12/24 00:25:39 dawes Exp $ */
+
+#include <stdio.h>		/* including dirent.h first may cause problems */
+#include <sys/types.h>
+#include <dirent.h>
+#include <errno.h>
+#include <sys/stat.h>
+#include "pathname.h"
+#include "private.h"
+
+#define NOREAD_SKIP	0
+#define NOREAD_ERROR	1
+
+/*
+ * Initialization
+ */
+LispObj *Oparse_namestring, *Kerror, *Kabsolute, *Krelative, *Kskip;
+
+/*
+ * Implementation
+ */
+void
+LispPathnameInit(void)
+{
+    Kerror		= KEYWORD("ERROR");
+    Oparse_namestring	= STATIC_ATOM("PARSE-NAMESTRING");
+    Kabsolute		= KEYWORD("ABSOLUTE");
+    Krelative		= KEYWORD("RELATIVE");
+}
+
+static int
+glob_match(char *cmp1, char *cmp2)
+/*
+ * Note: this code was written from scratch, and may generate incorrect
+ * results for very complex glob masks.
+ */
+{
+    for (;;) {
+	while (*cmp1 && *cmp1 == *cmp2) {
+	    ++cmp1;
+	    ++cmp2;
+	}
+	if (*cmp2) {
+	    if (*cmp1 == '*') {
+		while (*cmp1 == '*')
+		    ++cmp1;
+		if (*cmp1) {
+		    int count = 0, settmp = 1;
+		    char *tmp = cmp2, *sav2;
+
+		    while (*cmp1 && *cmp1 == '?') {
+			++cmp1;
+			++count;
+		    }
+
+		    /* need to recurse here to make sure
+		     * all cases are tested.
+		     */
+		    while (*cmp2 && *cmp2 != *cmp1)
+			++cmp2;
+		    if (!*cmp1 && cmp2 - tmp < count)
+			return (0);
+		    sav2 = cmp2;
+
+		    /* if recursive calls fails, make sure all '?'
+		     * following '*' are processed */
+		    while (*sav2 && sav2 - tmp < count)
+			++sav2;
+
+		    for (; *cmp2;) {
+			if (settmp) /* repeated letters: *?o? => boot, root */
+			    tmp = cmp2;
+			else
+			    settmp = 1;
+			while (*cmp2 && *cmp2 != *cmp1)
+			    ++cmp2;
+			if (cmp2 - tmp < count) {
+			    if (*cmp2)
+				++cmp2;
+			    settmp = 0;
+			    continue;
+			}
+			if (*cmp2) {
+			    if (glob_match(cmp1, cmp2))
+				return (1);
+			    ++cmp2;
+			}
+		    }
+		    cmp2 = sav2;
+		}
+		else {
+		    while (*cmp2)
+			++cmp2;
+		    break;
+		}
+	    }
+	    else if (*cmp1 == '?') {
+		while (*cmp1 == '?' && *cmp2) {
+		    ++cmp1;
+		    ++cmp2;
+		}
+		continue;
+	    }
+	    else
+		break;
+	}
+	else {
+	    while (*cmp1 == '*')
+		++cmp1;
+	    break;
+	}
+    }
+
+    return (*cmp1 == '\0' && *cmp2 == '\0');
+}
+
+/*
+ * Since directory is a function to be extended by the implementation,
+ * current extensions are:
+ *	all		=> list files and directories
+ *			   it is an error to call
+ *			   (directory "<pathname-spec>/" :all t)
+ *			   if non nil, it is like the shell command
+ *			   echo <pathname-spec>, but normally, not in the
+ *			   same order, as the code does not sort the result.
+ *		!=nil	=> list files and directories
+ * (default)	nil	=> list only files, or only directories if
+ *			   <pathname-spec> ends with PATH_SEP char.
+ *	if-cannot-read	=> if opendir fails on a directory
+ *		:error	=> generate an error
+ * (default)	:skip	=> skip search in this directory
+ */
+LispObj *
+Lisp_Directory(LispBuiltin *builtin)
+/*
+ directory pathname &key all if-cannot-read
+ */
+{
+    GC_ENTER();
+    DIR *dir;
+    struct stat st;
+    struct dirent *ent;
+    int length, listdirs, i, ndirs, nmatches;
+    char name[PATH_MAX + 1], path[PATH_MAX + 2], directory[PATH_MAX + 2];
+    char *sep, *base, *ptr, **dirs, **matches,
+	  dot[] = {'.', PATH_SEP, '\0'},
+	  dotdot[] = {'.', '.', PATH_SEP, '\0'};
+    int cannot_read;
+
+    LispObj *pathname, *all, *if_cannot_read, *result, *cons, *object;
+
+    if_cannot_read = ARGUMENT(2);
+    all = ARGUMENT(1);
+    pathname = ARGUMENT(0);
+    result = NIL;
+
+    cons = NIL;
+
+    if (if_cannot_read != UNSPEC) {
+	if (!KEYWORDP(if_cannot_read) ||
+	    (if_cannot_read != Kskip &&
+	     if_cannot_read != Kerror))
+	    LispDestroy("%s: bad :IF-CANNOT-READ %s",
+			STRFUN(builtin), STROBJ(if_cannot_read));
+	if (if_cannot_read != Kskip)
+	    cannot_read = NOREAD_SKIP;
+	else
+	    cannot_read = NOREAD_ERROR;
+    }
+    else
+	cannot_read = NOREAD_SKIP;
+
+    if (PATHNAMEP(pathname))
+	pathname = CAR(pathname->data.pathname);
+    else if (STREAMP(pathname) && pathname->data.stream.type == LispStreamFile)
+	pathname = CAR(pathname->data.stream.pathname->data.pathname);
+    else if (!STRINGP(pathname))
+	LispDestroy("%s: %s is not a pathname",
+		    STRFUN(builtin), STROBJ(pathname));
+
+    strncpy(name, THESTR(pathname), sizeof(name) - 1);
+    name[sizeof(name) - 1] = '\0';
+    length = strlen(name);
+    if (length < STRLEN(pathname))
+	LispDestroy("%s: pathname too long %s",
+		    STRFUN(builtin), name);
+
+    if (length == 0) {
+	if (getcwd(path, sizeof(path) - 2) == NULL)
+	    LispDestroy("%s: getcwd(): %s", STRFUN(builtin), strerror(errno));
+	length = strlen(path);
+	if (!length || path[length - 1] != PATH_SEP) {
+	    path[length++] = PATH_SEP;
+	    path[length] = '\0';
+	}
+	result = APPLY1(Oparse_namestring, LSTRING(path, length));
+	GC_LEAVE();
+
+	return (result);
+    }
+
+    if (name[length - 1] == PATH_SEP) {
+	listdirs = 1;
+	if (length > 1) {
+	    --length;
+	    name[length] = '\0';
+	}
+    }
+    else
+	listdirs = 0;
+
+    if (name[0] != PATH_SEP) {
+	if (getcwd(path, sizeof(path) - 2) == NULL)
+	    LispDestroy("%s: getcwd(): %s", STRFUN(builtin), strerror(errno));
+	length = strlen(path);
+	if (!length || path[length - 1] != PATH_SEP) {
+	    path[length++] = PATH_SEP;
+	    path[length] = '\0';
+	}
+    }
+    else
+	path[0] = '\0';
+
+    result = NIL;
+
+    /* list intermediate directories */
+    matches = NULL;
+    nmatches = 0;
+    dirs = LispMalloc(sizeof(char*));
+    ndirs = 1;
+    if (snprintf(directory, sizeof(directory), "%s%s%c",
+		 path, name, PATH_SEP) > PATH_MAX)
+	LispDestroy("%s: pathname too long %s", STRFUN(builtin), directory);
+
+    /* Remove ../ */
+    sep = directory;
+    for (sep = strstr(sep, dotdot); sep; sep = strstr(sep, dotdot)) {
+	if (sep <= directory + 1)
+	    strcpy(directory, sep + 2);
+	else if (sep[-1] == PATH_SEP) {
+	    for (base = sep - 2; base > directory; base--)
+		if (*base == PATH_SEP)
+		    break;
+	    strcpy(base, sep + 2);
+	    sep = base;
+	}
+	else
+	    ++sep;
+    }
+
+    /* Remove "./" */
+    sep = directory;
+    for (sep = strstr(sep, dot); sep; sep = strstr(sep, dot)) {
+	if (sep == directory || sep[-1] == PATH_SEP)
+	    strcpy(sep, sep + 2);
+	else
+	    ++sep;
+    }
+
+    /* This will happen when there are too many '../'  in the path */
+    if (directory[1] == '\0') {
+	directory[1] = PATH_SEP;
+	directory[2] = '\0';
+    }
+
+    base = directory;
+    sep = strchr(base + 1, PATH_SEP);
+    dirs[0] = LispMalloc(2);
+    dirs[0][0] = PATH_SEP;
+    dirs[0][1] = '\0';
+
+    for (base = directory + 1, sep = strchr(base, PATH_SEP); ;
+	 base = sep + 1, sep = strchr(base, PATH_SEP)) {
+	*sep = '\0';
+	if (sep[1] == '\0')
+	    sep = NULL;
+	length = strlen(base);
+	if (length == 0) {
+	    if (sep)
+		*sep = PATH_SEP;
+	    else
+		break;
+	    continue;
+	}
+
+	for (i = 0; i < ndirs; i++) {
+	    length = strlen(dirs[i]);
+	    if (length > 1)
+		dirs[i][length - 1] = '\0';		/* remove trailing / */
+	    if ((dir = opendir(dirs[i])) != NULL) {
+		(void)readdir(dir);	/* "." */
+		(void)readdir(dir);	/* ".." */
+		if (length > 1)
+		    dirs[i][length - 1] = PATH_SEP;	/* add trailing / again */
+
+		snprintf(path, sizeof(path), "%s", dirs[i]);
+		length = strlen(path);
+		ptr = path + length;
+
+		while ((ent = readdir(dir)) != NULL) {
+		    int isdir;
+		    unsigned d_namlen = strlen(ent->d_name);
+
+		    if (length + d_namlen + 2 < sizeof(path))
+			strcpy(ptr, ent->d_name);
+		    else {
+			closedir(dir);
+			LispDestroy("%s: pathname too long %s",
+				    STRFUN(builtin), dirs[i]);
+		    }
+
+		    if (stat(path, &st) != 0)
+			isdir = 0;
+		    else
+			isdir = S_ISDIR(st.st_mode);
+
+		    if (all != UNSPEC || ((isdir && (listdirs || sep)) ||
+					  (!listdirs && !sep && !isdir))) {
+			if (glob_match(base, ent->d_name)) {
+			    if (isdir) {
+				length = strlen(ptr);
+				ptr[length++] = PATH_SEP;
+				ptr[length] = '\0';
+			    }
+			    /* XXX won't closedir on memory allocation failure! */
+			    matches = LispRealloc(matches, sizeof(char*) *
+						  nmatches + 1);
+			    matches[nmatches++] = LispStrdup(ptr);
+			}
+		    }
+		}
+		closedir(dir);
+
+		if (nmatches == 0) {
+		    if (sep || !listdirs || *base) {
+			LispFree(dirs[i]);
+			if (i + 1 < ndirs)
+			    memmove(dirs + i, dirs + i + 1,
+				    sizeof(char*) * (ndirs - (i + 1)));
+			--ndirs;
+			--i;		    /* XXX playing with for loop */
+		    }
+		}
+		else {
+		    int j;
+
+		    length = strlen(dirs[i]);
+		    if (nmatches > 1) {
+			dirs = LispRealloc(dirs, sizeof(char*) *
+					   (ndirs + nmatches));
+			if (i + 1 < ndirs)
+			    memmove(dirs + i + nmatches, dirs + i + 1,
+				    sizeof(char*) * (ndirs - (i + 1)));
+		    }
+		    for (j = 1; j < nmatches; j++) {
+			dirs[i + j] = LispMalloc(length +
+						 strlen(matches[j]) + 1);
+			sprintf(dirs[i + j], "%s%s", dirs[i], matches[j]);
+		    }
+		    dirs[i] = LispRealloc(dirs[i],
+					  length + strlen(matches[0]) + 1);
+		    strcpy(dirs[i] + length, matches[0]);
+		    i += nmatches - 1;	/* XXX playing with for loop */
+		    ndirs += nmatches - 1;
+
+		    for (j = 0; j < nmatches; j++)
+			LispFree(matches[j]);
+		    LispFree(matches);
+		    matches = NULL;
+		    nmatches = 0;
+		}
+	    }
+	    else {
+		if (cannot_read == NOREAD_ERROR)
+		    LispDestroy("%s: opendir(%s): %s",
+				STRFUN(builtin), dirs[i], strerror(errno));
+		else {
+		    LispFree(dirs[i]);
+		    if (i + 1 < ndirs)
+			memmove(dirs + i, dirs + i + 1,
+				sizeof(char*) * (ndirs - (i + 1)));
+		    --ndirs;
+		    --i;	    /* XXX playing with for loop */
+		}
+	    }
+	}
+	if (sep)
+	    *sep = PATH_SEP;
+	else
+	    break;
+    }
+
+    for (i = 0; i < ndirs; i++) {
+	object = APPLY1(Oparse_namestring, STRING2(dirs[i]));
+	if (result == NIL) {
+	    result = cons = CONS(object, NIL);
+	    GC_PROTECT(result);
+	}
+	else {
+	    RPLACD(cons, CONS(object, NIL));
+	    cons = CDR(cons);
+	}
+    }
+    LispFree(dirs);
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_ParseNamestring(LispBuiltin *builtin)
+/*
+ parse-namestring object &optional host defaults &key start end junk-allowed
+ */
+{
+    GC_ENTER();
+    LispObj *result;
+
+    LispObj *object, *host, *defaults, *ostart, *oend, *junk_allowed;
+
+    junk_allowed = ARGUMENT(5);
+    oend = ARGUMENT(4);
+    ostart = ARGUMENT(3);
+    defaults = ARGUMENT(2);
+    host = ARGUMENT(1);
+    object = ARGUMENT(0);
+
+    if (host == UNSPEC)
+	host = NIL;
+    if (defaults == UNSPEC)
+	defaults = NIL;
+
+    RETURN_COUNT = 1;
+    if (STREAMP(object)) {
+	if (object->data.stream.type == LispStreamFile)
+	    object = object->data.stream.pathname;
+	/* else just check for JUNK-ALLOWED... */
+    }
+    if (PATHNAMEP(object)) {
+	RETURN(0) = FIXNUM(0);
+	return (object);
+    }
+
+    if (host != NIL) {
+	CHECK_STRING(host);
+    }
+    if (defaults != NIL) {
+	if (!PATHNAMEP(defaults)) {
+	    defaults = APPLY1(Oparse_namestring, defaults);
+	    GC_PROTECT(defaults);
+	}
+    }
+
+    result = NIL;
+    if (STRINGP(object)) {
+	LispObj *cons, *cdr;
+	char *name = THESTR(object), *ptr, *str, data[PATH_MAX + 1],
+	      string[PATH_MAX + 1], *namestr, *typestr, *send;
+	long start, end, length, alength, namelen, typelen;
+
+	LispCheckSequenceStartEnd(builtin, object, ostart, oend,
+				  &start, &end, &length);
+	alength = end - start;
+
+	if (alength > sizeof(data) - 1)
+	    LispDestroy("%s: string %s too large",
+			STRFUN(builtin), STROBJ(object));
+	memcpy(data, name + start, alength);
+#ifndef KEEP_EXTRA_PATH_SEP
+	ptr = data;
+	send = ptr + alength;
+	while (ptr < send) {
+	    if (*ptr++ == PATH_SEP) {
+		for (str = ptr; str < send && *str == PATH_SEP; str++)
+		    ;
+		if (str - ptr) {
+		    memmove(ptr, str, alength - (str - data));
+		    alength -= str - ptr;
+		    send -= str - ptr;
+		}
+	    }
+	}
+#endif
+	data[alength] = '\0';
+	memcpy(string, data, alength + 1);
+
+	if (PATHNAMEP(defaults))
+	    defaults = defaults->data.pathname;
+
+	/* string name */
+	result = cons = CONS(NIL, NIL);
+	GC_PROTECT(result);
+
+	/* host */
+	if (defaults != NIL)
+	    defaults = CDR(defaults);
+	cdr = defaults == NIL ? NIL : CAR(defaults);
+	RPLACD(cons, CONS(cdr, NIL));
+	cons = CDR(cons);
+
+	/* device */
+	if (defaults != NIL)
+	    defaults = CDR(defaults);
+	cdr = defaults == NIL ? NIL : CAR(defaults);
+	RPLACD(cons, CONS(cdr, NIL));
+	cons = CDR(cons);
+
+	/* directory */
+	if (defaults != NIL)
+	    defaults = CDR(defaults);
+	if (*data == PATH_SEP)
+	    cdr = CONS(Kabsolute, NIL);
+	else
+	    cdr = CONS(Krelative, NIL);
+	RPLACD(cons, CONS(cdr, NIL));
+	cons = CDR(cons);
+	/* directory components */
+	ptr = data;
+	send = data + alength;
+	if (*ptr == PATH_SEP)
+	    ++ptr;
+	for (str = ptr; str < send; str++) {
+	    if (*str == PATH_SEP)
+		break;
+	}
+	while (str < send) {
+	    *str++ = '\0';
+	    if (str - ptr > NAME_MAX)
+		LispDestroy("%s: directory name too long %s",
+			    STRFUN(builtin), ptr);
+	    RPLACD(cdr, CONS(LSTRING(ptr, str - ptr - 1), NIL));
+	    cdr = CDR(cdr);
+	    for (ptr = str; str < send; str++) {
+		if (*str == PATH_SEP)
+		    break;
+	    }
+	}
+	if (str - ptr > NAME_MAX)
+	    LispDestroy("%s: file name too long %s", STRFUN(builtin), ptr);
+	if (CAAR(cons) == Krelative &&
+	    defaults != NIL && CAAR(defaults) == Kabsolute) {
+	    /* defaults specify directory and pathname doesn't */
+	    char *tstring;
+	    long dlength, tlength;
+	    LispObj *dir = CDAR(defaults);
+
+	    for (dlength = 1; CONSP(dir); dir = CDR(dir))
+		dlength += STRLEN(CAR(dir)) + 1;
+	    if (alength + dlength < PATH_MAX) {
+		memmove(data + dlength, data, alength + 1);
+		memmove(string + dlength, string, alength + 1);
+		alength += dlength;
+		ptr += dlength;
+		send += dlength;
+		CAAR(cons) = Kabsolute;
+		for (dir = CDAR(defaults), cdr = CAR(cons);
+		     CONSP(dir);
+		     dir = CDR(dir)) {
+		    RPLACD(cdr, CONS(CAR(dir), CDR(cdr)));
+		    cdr = CDR(cdr);
+		}
+		dir = CDAR(defaults);
+		data[0] = string[0] = PATH_SEP;
+		for (dlength = 1; CONSP(dir); dir = CDR(dir)) {
+		    tstring = THESTR(CAR(dir));
+		    tlength = STRLEN(CAR(dir));
+		    memcpy(data + dlength, tstring, tlength);
+		    memcpy(string + dlength, tstring, tlength);
+		    dlength += tlength;
+		    data[dlength] = string[dlength] = PATH_SEP;
+		    ++dlength;
+		}
+	    }
+	}
+
+	/* name */
+	if (defaults != NIL)
+	    defaults = CDR(defaults);
+	cdr = defaults == NIL ? NIL : CAR(defaults);
+	for (typelen = 0, str = ptr; str < send; str++) {
+	    if (*str == PATH_TYPESEP) {
+		typelen = 1;
+		break;
+	    }
+	}
+	if (*ptr)
+	    cdr = LSTRING(ptr, str - ptr);
+	if (STRINGP(cdr)) {
+	    namestr = THESTR(cdr);
+	    namelen = STRLEN(cdr);
+	}
+	else {
+	    namestr = "";
+	    namelen = 0;
+	}
+	RPLACD(cons, CONS(cdr, NIL));
+	cons = CDR(cons);
+
+	/* type */
+	if (defaults != NIL)
+	    defaults = CDR(defaults);
+	cdr = defaults == NIL ? NIL : CAR(defaults);
+	ptr = str + typelen;
+	if (*ptr)
+	    cdr = LSTRING(ptr, send - ptr);
+	if (STRINGP(cdr)) {
+	    typestr = THESTR(cdr);
+	    typelen = STRLEN(cdr);
+	}
+	else {
+	    typestr = "";
+	    typelen = 0;
+	}
+	RPLACD(cons, CONS(cdr, NIL));
+	cons = CDR(cons);
+
+	/* version */
+	if (defaults != NIL)
+	    defaults = CDR(defaults);
+	cdr = defaults == NIL ? NIL : CAR(defaults);
+	RPLACD(cons, CONS(cdr, NIL));
+
+	/* string representation, must be done here to use defaults */
+	for (ptr = string + alength; ptr >= string; ptr--) {
+	    if (*ptr == PATH_SEP)
+		break;
+	}
+	if (ptr >= string)
+	    ++ptr;
+	else
+	    ptr = string;
+	*ptr = '\0';
+
+	length = ptr - string;
+
+	alength = namelen;
+	if (alength) {
+	    if (length + alength + 2 > sizeof(string))
+		alength = sizeof(string) - length - 2;
+	    memcpy(string + length, namestr, alength);
+	    length += alength;
+	}
+
+	alength = typelen;
+	if (alength) {
+	    if (length + 2 < sizeof(string))
+		string[length++] = PATH_TYPESEP;
+	    if (length + alength + 2 > sizeof(string))
+		alength = sizeof(string) - length - 2;
+	    memcpy(string + length, typestr, alength);
+	    length += alength;
+	}
+	string[length] = '\0';
+
+	RPLACA(result,  LSTRING(string, length));
+	RETURN(0) = FIXNUM(end);
+
+	result = PATHNAME(result);
+    }
+    else if (junk_allowed == UNSPEC || junk_allowed == NIL)
+	LispDestroy("%s: bad argument %s", STRFUN(builtin), STROBJ(object));
+    else
+	RETURN(0) = NIL;
+
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_MakePathname(LispBuiltin *builtin)
+/*
+ make-pathname &key host device directory name type version defaults
+ */
+{
+    GC_ENTER();
+    int length, alength;
+    char *string, pathname[PATH_MAX + 1];
+    LispObj *result, *cdr, *cons;
+
+    LispObj *host, *device, *directory, *name, *type, *version, *defaults;
+
+    defaults = ARGUMENT(6);
+    version = ARGUMENT(5);
+    type = ARGUMENT(4);
+    name = ARGUMENT(3);
+    directory = ARGUMENT(2);
+    device = ARGUMENT(1);
+    host = ARGUMENT(0);
+
+    if (host != UNSPEC) {
+	CHECK_STRING(host);
+    }
+    if (device != UNSPEC) {
+	CHECK_STRING(device);
+    }
+
+    if (directory != UNSPEC) {
+	LispObj *dir;
+
+	CHECK_CONS(directory);
+	dir = CAR(directory);
+	CHECK_KEYWORD(dir);
+	if (dir != Kabsolute && dir != Krelative)
+	    LispDestroy("%s: directory type %s unknown",
+			STRFUN(builtin), STROBJ(dir));
+    }
+
+    if (name != UNSPEC) {
+	CHECK_STRING(name);
+    }
+    if (type != UNSPEC) {
+	CHECK_STRING(type);
+    }
+
+    if (version != UNSPEC && version != NIL) {
+	switch (OBJECT_TYPE(version)) {
+	    case LispFixnum_t:
+		if (FIXNUM_VALUE(version) >= 0)
+		    goto version_ok;
+	    case LispInteger_t:
+		if (INT_VALUE(version) >= 0)
+		    goto version_ok;
+		break;
+	    case LispDFloat_t:
+		if (DFLOAT_VALUE(version) >= 0.0)
+		    goto version_ok;
+		break;
+	    default:
+		break;
+	}
+	LispDestroy("%s: %s is not a positive real number",
+		    STRFUN(builtin), STROBJ(version));
+    }
+version_ok:
+
+    if (defaults != UNSPEC && !PATHNAMEP(defaults) &&
+	(host == UNSPEC || device == UNSPEC || directory == UNSPEC ||
+	 name == UNSPEC || type == UNSPEC || version == UNSPEC)) {
+	defaults = APPLY1(Oparse_namestring, defaults);
+	GC_PROTECT(defaults);
+    }
+
+    if (defaults != UNSPEC) {
+	defaults = defaults->data.pathname;
+	defaults = CDR(defaults);	/* host */
+	if (host == UNSPEC)
+	    host = CAR(defaults);
+	defaults = CDR(defaults);	/* device */
+	if (device == UNSPEC)
+	    device = CAR(defaults);
+	defaults = CDR(defaults);	/* directory */
+	if (directory == UNSPEC)
+	    directory = CAR(defaults);
+	defaults = CDR(defaults);	/* name */
+	if (name == UNSPEC)
+	    name = CAR(defaults);
+	defaults = CDR(defaults);	/* type */
+	if (type == UNSPEC)
+	    type = CAR(defaults);
+	defaults = CDR(defaults);	/* version */
+	if (version == UNSPEC)
+	    version = CAR(defaults);
+    }
+
+    /* string representation */
+    length = 0;
+    if (CONSP(directory)) {
+	if (CAR(directory) == Kabsolute)
+	    pathname[length++] = PATH_SEP;
+
+	for (cdr = CDR(directory); CONSP(cdr); cdr = CDR(cdr)) {
+	    CHECK_STRING(CAR(cdr));
+	    string = THESTR(CAR(cdr));
+	    alength = STRLEN(CAR(cdr));
+	    if (alength > NAME_MAX)
+		LispDestroy("%s: directory name too long %s",
+			    STRFUN(builtin), string);
+	    if (length + alength + 2 > sizeof(pathname))
+		alength = sizeof(pathname) - length - 2;
+	    memcpy(pathname + length, string, alength);
+	    length += alength;
+	    pathname[length++] = PATH_SEP;
+	}
+    }
+    if (STRINGP(name)) {
+	int xlength = 0;
+
+	if (STRINGP(type))
+	    xlength = STRLEN(type) + 1;
+
+	string = THESTR(name);
+	alength = STRLEN(name);
+	if (alength + xlength > NAME_MAX)
+	    LispDestroy("%s: file name too long %s",
+			STRFUN(builtin), string);
+	if (length + alength + 2 > sizeof(pathname))
+	    alength = sizeof(pathname) - length - 2;
+	memcpy(pathname + length, string, alength);
+	length += alength;
+    }
+    if (STRINGP(type)) {
+	if (length + 2 < sizeof(pathname))
+	    pathname[length++] = PATH_TYPESEP;
+	string = THESTR(type);
+	alength = STRLEN(type);
+	if (length + alength + 2 > sizeof(pathname))
+	    alength = sizeof(pathname) - length - 2;
+	memcpy(pathname + length, string, alength);
+	length += alength;
+    }
+    pathname[length] = '\0';
+    result = cons = CONS(LSTRING(pathname, length), NIL);
+    GC_PROTECT(result);
+
+    /* host */
+    RPLACD(cons, CONS(host == UNSPEC ? NIL : host, NIL));
+    cons = CDR(cons);
+
+    /* device */
+    RPLACD(cons, CONS(device == UNSPEC ? NIL : device, NIL));
+    cons = CDR(cons);
+
+    /* directory */
+    if (directory == UNSPEC)
+	cdr = CONS(Krelative, NIL);
+    else
+	cdr = directory;
+    RPLACD(cons, CONS(cdr, NIL));
+    cons = CDR(cons);
+
+    /* name */
+    RPLACD(cons, CONS(name == UNSPEC ? NIL : name, NIL));
+    cons = CDR(cons);
+
+    /* type */
+    RPLACD(cons, CONS(type == UNSPEC ? NIL : type, NIL));
+    cons = CDR(cons);
+
+    /* version */
+    RPLACD(cons, CONS(version == UNSPEC ? NIL : version, NIL));
+
+    GC_LEAVE();
+
+    return (PATHNAME(result));
+}
+
+LispObj *
+Lisp_PathnameHost(LispBuiltin *builtin)
+/*
+ pathname-host pathname
+ */
+{
+    return (LispPathnameField(PATH_HOST, 0));
+}
+
+LispObj *
+Lisp_PathnameDevice(LispBuiltin *builtin)
+/*
+ pathname-device pathname
+ */
+{
+    return (LispPathnameField(PATH_DEVICE, 0));
+}
+
+LispObj *
+Lisp_PathnameDirectory(LispBuiltin *builtin)
+/*
+ pathname-device pathname
+ */
+{
+    return (LispPathnameField(PATH_DIRECTORY, 0));
+}
+
+LispObj *
+Lisp_PathnameName(LispBuiltin *builtin)
+/*
+ pathname-name pathname
+ */
+{
+    return (LispPathnameField(PATH_NAME, 0));
+}
+
+LispObj *
+Lisp_PathnameType(LispBuiltin *builtin)
+/*
+ pathname-type pathname
+ */
+{
+    return (LispPathnameField(PATH_TYPE, 0));
+}
+
+LispObj *
+Lisp_PathnameVersion(LispBuiltin *builtin)
+/*
+ pathname-version pathname
+ */
+{
+    return (LispPathnameField(PATH_VERSION, 0));
+}
+
+LispObj *
+Lisp_FileNamestring(LispBuiltin *builtin)
+/*
+ file-namestring pathname
+ */
+{
+    return (LispPathnameField(PATH_NAME, 1));
+}
+
+LispObj *
+Lisp_DirectoryNamestring(LispBuiltin *builtin)
+/*
+ directory-namestring pathname
+ */
+{
+    return (LispPathnameField(PATH_DIRECTORY, 1));
+}
+
+LispObj *
+Lisp_EnoughNamestring(LispBuiltin *builtin)
+/*
+ enough-pathname pathname &optional defaults
+ */
+{
+    LispObj *pathname, *defaults;
+
+    defaults = ARGUMENT(1);
+    pathname = ARGUMENT(0);
+
+    if (defaults != UNSPEC && defaults != NIL) {
+	char *ppathname, *pdefaults, *pp, *pd;
+
+	if (!STRINGP(pathname)) {
+	    if (PATHNAMEP(pathname))
+		pathname  = CAR(pathname->data.pathname);
+	    else if (STREAMP(pathname) &&
+		     pathname->data.stream.type == LispStreamFile)
+		pathname  = CAR(pathname->data.stream.pathname->data.pathname);
+	    else
+		LispDestroy("%s: bad PATHNAME %s",
+			    STRFUN(builtin), STROBJ(pathname));
+	}
+
+	if (!STRINGP(defaults)) {
+	    if (PATHNAMEP(defaults))
+		defaults  = CAR(defaults->data.pathname);
+	    else if (STREAMP(defaults) &&
+		     defaults->data.stream.type == LispStreamFile)
+		defaults  = CAR(defaults->data.stream.pathname->data.pathname);
+	    else
+		LispDestroy("%s: bad DEFAULTS %s",
+			    STRFUN(builtin), STROBJ(defaults));
+	}
+
+	ppathname = pp = THESTR(pathname);
+	pdefaults = pd = THESTR(defaults);
+	while (*ppathname && *pdefaults && *ppathname == *pdefaults) {
+	    ppathname++;
+	    pdefaults++;
+	}
+	if (*pdefaults == '\0' && pdefaults > pd)
+	    --pdefaults;
+	if (*ppathname && *pdefaults && *pdefaults != PATH_SEP) {
+	    --ppathname;
+	    while (*ppathname != PATH_SEP && ppathname > pp)
+		--ppathname;
+	    if (*ppathname == PATH_SEP)
+		++ppathname;
+	}
+
+	return (STRING(ppathname));
+    }
+    else {
+	if (STRINGP(pathname))
+	    return (pathname);
+	else if (PATHNAMEP(pathname))
+	    return (CAR(pathname->data.pathname));
+	else if (STREAMP(pathname)) {
+	    if (pathname->data.stream.type == LispStreamFile)
+		return (CAR(pathname->data.stream.pathname->data.pathname));
+	}
+    }
+    LispDestroy("%s: bad PATHNAME %s", STRFUN(builtin), STROBJ(pathname));
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Namestring(LispBuiltin *builtin)
+/*
+ namestring pathname
+ */
+{
+    return (LispPathnameField(PATH_STRING, 1));
+}
+
+LispObj *
+Lisp_HostNamestring(LispBuiltin *builtin)
+/*
+ host-namestring pathname
+ */
+{
+    return (LispPathnameField(PATH_HOST, 1));
+}
+
+LispObj *
+Lisp_Pathnamep(LispBuiltin *builtin)
+/*
+ pathnamep object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (PATHNAMEP(object) ? T : NIL);
+}
+
+/* XXX only checks if host is a string and only checks the HOME enviroment
+ * variable */
+LispObj *
+Lisp_UserHomedirPathname(LispBuiltin *builtin)
+/*
+ user-homedir-pathname &optional host
+ */
+{
+    GC_ENTER();
+    int length;
+    char *home = getenv("HOME"), data[PATH_MAX + 1];
+    LispObj *result;
+
+    LispObj *host;
+
+    host = ARGUMENT(0);
+
+    if (host != UNSPEC && !STRINGP(host))
+	LispDestroy("%s: bad hostname %s", STRFUN(builtin), STROBJ(host));
+
+    length = 0;
+    if (home) {
+	length = strlen(home);
+	strncpy(data, home, length);
+	if (length && home[length - 1] != PATH_SEP)
+	    data[length++] = PATH_SEP;
+    }
+    data[length] = '\0';
+
+    result = LSTRING(data, length);
+    GC_PROTECT(result);
+    result = APPLY1(Oparse_namestring, result);
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_Truename(LispBuiltin *builtin)
+{
+    return (LispProbeFile(builtin, 0));
+}
+
+LispObj *
+Lisp_ProbeFile(LispBuiltin *builtin)
+{
+    return (LispProbeFile(builtin, 1));
+}
diff --git a/lisp/pathname.h b/lisp/pathname.h
new file mode 100644
index 0000000..f99917e
--- /dev/null
+++ b/lisp/pathname.h
@@ -0,0 +1,78 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/pathname.h,v 1.4 2002/11/08 08:00:57 paulo Exp $ */
+
+#ifndef Lisp_pathname_h
+#define Lisp_pathname_h
+
+#include "internal.h"
+
+#define	PATH_SEP	'/'
+#define	PATH_TYPESEP	'.'
+
+#ifndef PATH_MAX
+#define PATH_MAX	4096
+#endif
+
+#ifndef NAME_MAX
+#define NAME_MAX	256
+#endif
+
+
+#define PATH_STRING	0
+#define PATH_HOST	1
+#define PATH_DEVICE	2
+#define PATH_DIRECTORY	3
+#define PATH_NAME	4
+#define PATH_TYPE	5
+#define PATH_VERSION	6
+
+void LispPathnameInit(void);
+
+LispObj *Lisp_Directory(LispBuiltin*);
+LispObj *Lisp_Namestring(LispBuiltin*);
+LispObj *Lisp_FileNamestring(LispBuiltin*);
+LispObj *Lisp_DirectoryNamestring(LispBuiltin*);
+LispObj *Lisp_EnoughNamestring(LispBuiltin*);
+LispObj *Lisp_HostNamestring(LispBuiltin*);
+LispObj *Lisp_MakePathname(LispBuiltin*);
+LispObj *Lisp_Pathnamep(LispBuiltin*);
+LispObj *Lisp_ParseNamestring(LispBuiltin*);
+LispObj *Lisp_PathnameHost(LispBuiltin*);
+LispObj *Lisp_PathnameDevice(LispBuiltin*);
+LispObj *Lisp_PathnameDirectory(LispBuiltin*);
+LispObj *Lisp_PathnameName(LispBuiltin*);
+LispObj *Lisp_PathnameType(LispBuiltin*);
+LispObj *Lisp_PathnameVersion(LispBuiltin*);
+LispObj *Lisp_Truename(LispBuiltin*);
+LispObj *Lisp_ProbeFile(LispBuiltin*);
+LispObj *Lisp_UserHomedirPathname(LispBuiltin*);
+
+#endif /* Lisp_pathname_h */
diff --git a/lisp/private.h b/lisp/private.h
new file mode 100644
index 0000000..6e5b128
--- /dev/null
+++ b/lisp/private.h
@@ -0,0 +1,536 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/private.h,v 1.39 2002/12/20 04:32:46 paulo Exp $ */
+
+#ifndef Lisp_private_h
+#define Lisp_private_h
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <setjmp.h>
+#include <unistd.h>
+#include <sys/time.h>
+#include "internal.h"
+
+#include "core.h"
+#ifdef DEBUGGER
+#include "debugger.h"
+#endif
+#include "helper.h"
+#include "string.h"
+#include "struct.h"
+
+/*
+ * Defines
+ */
+#define	STRTBLSZ		23
+#define MULTIPLE_VALUES_LIMIT	127
+#define MAX_STACK_DEPTH		16384
+
+#define FEATURES						\
+    lisp__data.features->data.atom->a_object ?			\
+	lisp__data.features->data.atom->property->value :	\
+	NIL
+#define PACK	lisp__data.packlist
+#define PACKAGE	lisp__data.package->data.atom->property->value
+#define MOD	lisp__data.modlist
+#define COD	lisp__data.codlist
+#define RUN	lisp__data.runlist
+#define RES	lisp__data.reslist
+#define DBG	lisp__data.dbglist
+#define BRK	lisp__data.brklist
+#define PRO	lisp__data.prolist
+
+#define SINPUT	lisp__data.input
+#define SOUTPUT	lisp__data.output
+#define STANDARD_INPUT						\
+    lisp__data.standard_input->data.atom->property->value
+#define STANDARD_OUTPUT						\
+    lisp__data.standard_output->data.atom->property->value
+#define STANDARDSTREAM(file, desc, flags)			\
+	LispNewStandardStream(file, desc, flags)
+
+/*
+ * Types
+ */
+typedef struct _LispStream LispStream;
+typedef struct _LispBlock LispBlock;
+typedef struct _LispOpaque LispOpaque;
+typedef struct _LispModule LispModule;
+typedef struct _LispProperty LispProperty;
+typedef struct _LispObjList LispObjList;
+typedef struct _LispStringHash LispStringHash;
+typedef struct _LispCharInfo LispCharInfo;
+
+
+/* Normal function/macro arguments */
+typedef struct _LispNormalArgs {
+    int num_symbols;
+    LispObj **symbols;		/* symbol names */
+} LispNormalArgs;
+
+/* &optional function/macro arguments */
+typedef struct _LispOptionalArgs {
+    int num_symbols;
+    LispObj **symbols;		/* symbol names */
+    LispObj **defaults;		/* default values, when unspecifed */
+    LispObj **sforms;		/* T if variable specified, NIL otherwise */
+} LispOptionalArgs;
+
+/* &key function/macro arguments */
+typedef struct _LispKeyArgs {
+    int num_symbols;
+    LispObj **symbols;		/* symbol names */
+    LispObj **defaults;		/* default values */
+    LispObj **sforms;		/* T if variable specified, NIL otherwise */
+    LispObj **keys;		/* key names, for special keywords */
+} LispKeyArgs;
+
+/* &aux function/macro arguments */
+typedef struct _LispAuxArgs {
+    int num_symbols;
+    LispObj **symbols;		/* symbol names */
+    LispObj **initials;		/* initial values */
+} LispAuxArgs;
+
+/* characters in the field description have the format:
+ *	'.'	normals has a list of normal arguments
+ *	'o'	optionals has a list of &optional arguments
+ *	'k'	keys has a list of &key arguments
+ *	'r'	rest is a valid pointer to a &rest symbol
+ *	'a'	auxs has a list of &aux arguments
+ */
+typedef struct _LispArgList {
+    LispNormalArgs normals;
+    LispOptionalArgs optionals;
+    LispKeyArgs keys;
+    LispObj *rest;
+    LispAuxArgs auxs;
+    int num_arguments;
+    char *description;
+} LispArgList;
+
+typedef enum _LispDocType_t {
+    LispDocVariable,
+    LispDocFunction,
+    LispDocStructure,
+    LispDocType,
+    LispDocSetf
+} LispDocType_t;
+
+struct _LispProperty {
+    /* may be used by multiple packages */
+    unsigned int refcount;
+
+    /* package where the property was created */
+    LispPackage *package;
+
+    /* value of variable attached to symbol */
+    LispObj *value;
+
+    union {
+	/* function attached to symbol */
+	LispObj *function;
+	/* builtin function attached to symbol*/
+	LispBuiltin *builtin;
+    } fun;
+    /* function/macro argument list description */
+    LispArgList *alist;
+
+    /* symbol properties list */
+    LispObj *properties;
+
+    /* setf method */
+    LispObj *setf;
+    /* setf argument list description */
+    LispArgList *salist;
+
+    /* structure information */
+    struct {
+	LispObj *definition;
+#define STRUCT_NAME		-3
+#define STRUCT_CHECK		-2
+#define STRUCT_CONSTRUCTOR	-1
+	int function;		/* if >= 0, it is a structure field index */
+    } structure;
+};
+
+struct _LispAtom {
+    /* hint: dynamically binded variable */
+    unsigned int dyn : 1;
+
+    /* Property has useful data in value field */
+    unsigned int a_object : 1;
+    /* Property has useful data in fun.function field */
+    unsigned int a_function : 1;
+    /* Property has useful data in fun.builtin field */
+    unsigned int a_builtin : 1;
+    /* Property has useful data in fun.function field */
+    unsigned int a_compiled : 1;
+    /* Property has useful data in properties field */
+    unsigned int a_property : 1;
+    /* Property has useful data in setf field */
+    unsigned int a_defsetf : 1;
+    /* Property has useful data in defstruct field */
+    unsigned int a_defstruct : 1;
+
+    /* Symbol is extern */
+    unsigned int ext : 1;
+
+    /* Symbol must be quoted with '|' to be allow reading back */
+    unsigned int unreadable : 1;
+
+    /* Symbol value may need special handling when changed */
+    unsigned int watch : 1;
+
+    /* Symbol value is constant, cannot be changed */
+    unsigned int constant : 1;
+
+    char *string;
+    LispObj *object;		/* backpointer to object ATOM */
+    int offset;			/* in the environment list */
+    LispObj *package;		/* package home of symbol */
+    LispObj *function;		/* symbol function */
+    LispObj *name;		/* symbol string */
+    LispProperty *property;
+    struct _LispAtom *next;
+
+    LispObj *documentation[5];
+};
+
+struct _LispObjList {
+    LispObj **pairs;		/* name0 ... nameN */
+    int length;			/* number of objects */
+    int space;			/* space allocated in field pairs */
+};
+
+struct _LispPackage {
+    LispObjList glb;		/* global symbols in package */
+    LispObjList use;		/* inherited packages */
+    LispAtom *atoms[STRTBLSZ];	/* atoms in this package */
+};
+
+struct _LispOpaque {
+    int type;
+    char *desc;
+    LispOpaque *next;
+};
+
+/* These strings are never released, they are used to avoid
+ * the need of strcmp() on two symbol names, just compare pointers */
+struct _LispStringHash {
+    char *string;
+    LispStringHash *next;
+};
+
+typedef enum _LispBlockType {
+    LispBlockNone,	/* no block */
+    LispBlockTag,	/* may become "invisible" */
+    LispBlockCatch,	/* can be used to jump across function calls */
+    LispBlockClosure,	/* hides blocks of type LispBlockTag bellow it */
+    LispBlockProtect,	/* used by unwind-protect */
+    LispBlockBody	/* used by tagbody and go */
+} LispBlockType;
+
+struct _LispBlock {
+    LispBlockType type;
+    LispObj *tag;
+    jmp_buf jmp;
+    int stack;
+    int protect;
+    int block_level;
+#ifdef DEBUGGER
+    int debug_level;
+    int debug_step;
+#endif
+};
+
+struct _LispModule {
+    LispModule *next;
+    void *handle;
+    LispModuleData *data;
+};
+
+typedef struct _LispUngetInfo {
+    char buffer[16];
+    int offset;
+} LispUngetInfo;
+
+struct _LispMac {
+    /* stack for builtin function arguments */
+    struct {
+	LispObj **values;
+	int base;		/* base of arguments to function */
+	int length;
+	int space;
+    } stack;
+
+    /* environment */
+    struct {
+	LispObj **values;
+	Atom_id *names;
+	int lex;		/* until where variables are visible */
+	int head;		/* top of environment */
+	int length;		/* number of used pairs */
+	int space;		/* number of objects in pairs */
+    } env;
+
+    struct {
+	LispObj **values;
+	int count;
+    } returns;
+
+    struct {
+	LispObj **objects;
+	int length;
+	int space;
+    } protect;
+
+    LispObj *package;		/* package object */
+    LispPackage *pack;		/* pointer to lisp__data.package->data.package.package */
+
+    /* fast access to the KEYWORD package */
+    LispObj *keyword;
+    LispPackage *key;
+
+    /* the LISP package */
+    LispObj *lisp;
+
+    /* only used if the package was changed, but an error generated
+     * before returning to the toplevel */
+    LispObj *savepackage;
+    LispPackage *savepack;
+
+    struct {
+	int block_level;
+	int block_size;
+	LispObj *block_ret;
+	LispBlock **block;
+    } block;
+
+    sigjmp_buf jmp;
+
+    struct {
+	unsigned int expandbits : 3;	/* code doesn't look like reusing cells
+					 * so try to have a larger number of
+					 * free cells */
+	unsigned int immutablebits : 1;	/* need to reset immutable bits */
+	unsigned int timebits : 1;	/* update gctime counter */
+	unsigned int count;
+	long gctime;
+	int average;			/* of cells freed after gc calls */
+    } gc;
+
+    LispStringHash *strings[STRTBLSZ];
+    LispOpaque *opqs[STRTBLSZ];
+    int opaque;
+
+    LispObj *standard_input, *input, *input_list;
+    LispObj *standard_output, *output, *output_list;
+    LispObj *error_stream;
+    LispUngetInfo **unget;
+    int iunget, nunget;
+    int eof;
+
+    int interactive;
+    int errexit;
+
+    struct {
+	int index;
+	int level;
+	int space;
+	void **mem;
+    } mem;		/* memory from Lisp*Alloc, to be release in error */
+    LispModule *module;
+    LispObj *modules;
+    char *prompt;
+
+    LispObj *features;
+
+    LispObj *modlist;		/* module list */
+    LispObj *packlist;		/* list of packages */
+    LispObj *codlist;		/* current code */
+    LispObj *runlist[3];	/* +, ++, and +++ */
+    LispObj *reslist[3];	/* *, **, and *** */
+#ifdef DEBUGGER
+    LispObj *dbglist;		/* debug information */
+    LispObj *brklist;		/* breakpoints information */
+#endif
+    LispObj *prolist;		/* protect objects list */
+
+#ifdef SIGNALRETURNSINT
+    int (*sigint)(int);
+    int (*sigfpe)(int);
+#else
+    void (*sigint)(int);
+    void (*sigfpe)(int);
+#endif
+
+    int destroyed;		/* reached LispDestroy, used by unwind-protect */
+    int running;		/* there is somewhere to siglongjmp */
+
+    int ignore_errors;		/* inside a ignore-errors block */
+    LispObj *error_condition;	/* actually, a string */
+
+    int debugging;		/* debugger enabled? */
+#ifdef DEBUGGER
+    int debug_level;		/* almost always the same as lisp__data.level */
+    int debug_step;		/* control for stoping and printing output */
+    int debug_break;		/* next breakpoint number */
+    LispDebugState debug;
+#endif
+};
+
+struct _LispCharInfo {
+    char **names;
+};
+
+
+/*
+ * Prototypes
+ */
+void LispUseArgList(LispArgList*);
+void LispFreeArgList(LispArgList*);
+LispArgList *LispCheckArguments(LispFunType, LispObj*, char*, int);
+LispObj *LispListProtectedArguments(LispArgList*);
+
+LispObj *LispGetDoc(LispObj*);
+LispObj *LispGetVar(LispObj*);
+#ifdef DEBUGGER
+void *LispGetVarAddr(LispObj*);	/* used by debugger */
+#endif
+LispObj *LispAddVar(LispObj*, LispObj*);
+LispObj *LispSetVar(LispObj*, LispObj*);
+void LispUnsetVar(LispObj*);
+
+	/* only used at initialization time */
+LispObj *LispNewStandardStream(LispFile*, LispObj*, int);
+
+	/* create a new package */
+LispObj *LispNewPackage(LispObj*, LispObj*);
+	/* add package to use-list of current, and imports all extern symbols */
+void LispUsePackage(LispObj*);
+	/* make symbol extern in the current package */
+void LispExportSymbol(LispObj*);
+	/* imports symbol to current package */
+void LispImportSymbol(LispObj*);
+
+	/* always returns the same string */
+char *LispGetAtomString(char*, int);
+
+/* destructive fast reverse, note that don't receive a LispMac* argument */
+LispObj *LispReverse(LispObj *list);
+
+char *LispIntToOpaqueType(int);
+
+/* (print) */
+void LispPrint(LispObj*, LispObj*, int);
+
+LispBlock *LispBeginBlock(LispObj*, LispBlockType);
+#define BLOCKJUMP(block)				\
+    lisp__data.stack.length = (block)->stack;		\
+    lisp__data.protect.length = (block)->protect;	\
+    longjmp((block)->jmp, 1)
+void LispEndBlock(LispBlock*);
+	/* if unwind-protect active, jump to cleanup code, else do nothing */
+void LispBlockUnwind(LispBlock*);
+
+void LispUpdateResults(LispObj*, LispObj*);
+void LispTopLevel(void);
+
+#define STRHASH(string)		LispDoHashString(string)
+int LispDoHashString(char*);
+LispAtom *LispDoGetAtom(char *str, int);
+	/* get value from atom's property list */
+LispObj *LispGetAtomProperty(LispAtom*, LispObj*);
+	/* put value in atom's property list */
+LispObj *LispPutAtomProperty(LispAtom*, LispObj*, LispObj*);
+	/* remove value from atom's property list */
+LispObj *LispRemAtomProperty(LispAtom*, LispObj*);
+	/* replace atom's property list */
+LispObj *LispReplaceAtomPropertyList(LispAtom*, LispObj*);
+
+	/* returns function associated with symbol */
+LispObj *LispSymbolFunction(LispObj*);
+	/* returns symbol string name */
+LispObj *LispSymbolName(LispObj*);
+
+	/* define byte compiled function, or replace definition */
+void LispSetAtomCompiledProperty(LispAtom*, LispObj*);
+	/* remove byte compiled function property */
+void LispRemAtomCompiledProperty(LispAtom*);
+	/* define function, or replace function definition */
+void LispSetAtomFunctionProperty(LispAtom*, LispObj*, LispArgList*);
+	/* remove function property */
+void LispRemAtomFunctionProperty(LispAtom*);
+	/* define builtin, or replace builtin definition */
+void LispSetAtomBuiltinProperty(LispAtom*, LispBuiltin*, LispArgList*);
+	/* remove builtin property */
+void LispRemAtomBuiltinProperty(LispAtom*);
+	/* define setf macro, or replace current definition */
+void LispSetAtomSetfProperty(LispAtom*, LispObj*, LispArgList*);
+	/* remove setf macro */
+void LispRemAtomSetfProperty(LispAtom*);
+	/* create or change structure property */
+void LispSetAtomStructProperty(LispAtom*, LispObj*, int);
+	/* remove structure property */
+void LispRemAtomStructProperty(LispAtom*);
+
+void LispProclaimSpecial(LispObj*, LispObj*, LispObj*);
+void LispDefconstant(LispObj*, LispObj*, LispObj*);
+
+void LispAddDocumentation(LispObj*, LispObj*, LispDocType_t);
+void LispRemDocumentation(LispObj*, LispDocType_t);
+LispObj *LispGetDocumentation(LispObj*, LispDocType_t);
+
+/* increases storage for functions returning multiple values */
+void LispMoreReturns(void);
+
+/* increases storage for temporarily protected data */
+void LispMoreProtects(void);
+
+/* Initialization */
+extern int LispArgList_t;
+extern LispCharInfo LispChars[256];
+
+/* This function will return if the interpreter cannot be stopped */
+extern void LispSignal(int);
+
+void LispDisableInterrupts(void);
+void LispEnableInterrupts(void);
+#define DISABLE_INTERRUPTS()	LispDisableInterrupts()
+#define ENABLE_INTERRUPTS()	LispEnableInterrupts()
+
+/* Value returned by LispBegin, used everywhere in the code.
+ * Only one interpreter instance allowed. */
+extern LispMac lisp__data;
+
+#endif /* Lisp_private_h */
diff --git a/lisp/re/README b/lisp/re/README
new file mode 100644
index 0000000..848e1e9
--- /dev/null
+++ b/lisp/re/README
@@ -0,0 +1,121 @@
+$XFree86: xc/programs/xedit/lisp/re/README,v 1.4 2002/11/15 07:01:32 paulo Exp $
+
+LAST UPDATED:	$Date$
+
+  This is a small regex library for fast matching tokens in text. It was built
+to be used by xedit and it's syntax highlight code. It is not compliant with
+IEEE Std 1003.2, but is expected to be used where very fast matching is
+required, and exotic patterns will not be used.
+
+  To understand what kind of patterns this library is expected to be used with,
+see the file <XRoot>xc/programs/xedit/lisp/modules/progmodes/c.lsp and some
+samples in the file tests.txt, with comments for patterns that will not work,
+or may give incorrect results.
+
+  The library is not built upon the standard regex library by Henry Spencer,
+but is completely written from scratch, but it's syntax is heavily based on
+that library, and the only reason for it to exist is that unfortunately
+the standard version does not fit the requirements needed by xedit.
+Anyways, I would like to thanks Henry for his regex library, it is a really
+very useful tool.
+
+  Small description of understood tokens:
+
+		M A T C H I N G
+------------------------------------------------------------------------
+.		Any character (won't match newline if compiled with RE_NEWLINE)
+\w		Any word letter (shortcut to [a-zA-Z0-9_]
+\W		Not a word letter (shortcut to [^a-zA-Z0-9_]
+\d		Decimal number
+\D		Not a decimal number
+\s		A space
+\S		Not a space
+\l		A lower case letter
+\u		An upper case letter
+\c		A control character, currently the range 1-32 (minus tab)
+\C		Not a control character
+\o		Octal number
+\O		Not an octal number
+\x		Hexadecimal number
+\X		Not an hexadecimal number
+\<		Beginning of a word (matches an empty string)
+\>		End of a word (matches an empty string)
+^		Beginning of a line (matches an empty string)
+$		End of a line (matches an empty string)
+[...]		Matches one of the characters inside the brackets
+		ranges are specified separating two characters with "-".
+		If the first character is "^", matches only if the
+		character is not in this range. To add a "]" make it
+		the first character, and to add a "-" make it the last.
+\1 to \9	Backreference, matches the text that was matched by a group,
+		that is, text that was matched by the pattern inside
+		"(" and ")".
+
+
+		O P E R A T O R S
+------------------------------------------------------------------------
+()		Any pattern inside works as a backreference, and is also
+		used to group patterns.
+|		Alternation, allows choosing different possibilities, like
+		character ranges, but allows patterns of different lengths.
+
+
+		R E P E T I T I O N
+------------------------------------------------------------------------
+<re>*		<re> may occur any number of times, including zero
+<re>+		<re> must occur at least once
+<re>?		<re> is optional
+<re>{<e>}	<re> must occur exactly <e> times
+<re>{<n>,}	<re> must occur at least <n> times
+<re>{,<m>}	<re> must not occur more than <m> times
+<re>{<n>,<m>}	<re> must occur at least <n> times, but no more than <m>
+
+
+  Note that "." is a special character, and when used with a repetition
+operator it changes completely its meaning. For example, ".*" matches
+anything up to the end of the input string (unless the pattern was compiled
+with RE_NEWLINE, in that case it will match anything, but a newline).
+
+
+  Limitations:
+
+o Only minimal matches supported. The engine has only one level "backtracking",
+  so, it also only does minimal matches to allow backreferences working
+  properly, and to avoid failing to match depending on the input.
+
+o Only one level "grouping", for example, with the pattern:
+	(a(b)c)
+   If "abc" is anywhere in the input, it will be in "\1", but there will
+  not exist a "\2" for "b".
+
+o Some "special repetitions" were not implemented, these are:
+	.{<e>}
+	.{<n>,}
+	.{,<m>}
+	.{<n>,<m>}
+
+o Some patterns will never match, for example:
+	\w*\d
+    Since "\w*" already includes all possible matches of "\d", "\d" will
+  only be tested when "\w*" failed. There are no plans to make such
+  patterns work.
+
+
+  Some of these limitations may be worked on future versions of the library,
+but this is not what the library is expected to do, and, adding support for
+correct handling of these would probably make the library slower, what is
+not the reason of it to exist in the first time.
+
+  If you need "true" regex than this library is not for you, but if all
+you need is support for very quickly finding simple patterns, than this
+library can be a very powerful tool, on some patterns it can run more
+than 200 times faster than "true" regex implementations! And this is
+the reason it was written.
+
+
+
+  Send comments and code to me (paulo@XFree86.Org) or to the XFree86
+mailing/patch lists.
+
+--
+Paulo
diff --git a/lisp/re/re.c b/lisp/re/re.c
new file mode 100644
index 0000000..d848a4b
--- /dev/null
+++ b/lisp/re/re.c
@@ -0,0 +1,2648 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/re/re.c,v 1.9 2002/12/11 04:44:28 paulo Exp $ */
+
+#include <stdio.h>
+#include "rep.h"
+#define DEBUG
+/*
+ * Types
+ */
+
+/*  Information used when generating the final form of the compiled re.
+ */
+struct _re_inf {
+    rec_alt *alt;
+    unsigned char *cod;
+    long len;
+    long spc;
+
+    /* Start offset of special repetition instruction */
+    long sr[MAX_DEPTH];
+
+    /* Jump offset of special repetition instruction */
+    long sj[MAX_DEPTH];
+
+    /* Just a flag, to know if this nesting is for a special repetition */
+    char sp[MAX_DEPTH];
+
+    int bas;			/* Alternatives/repetitions depth */
+    int par;			/* Open parenthesis counter */
+    int ref;			/* Backreference counter */
+
+    rec_pat *apat;		/*  Alternatives duplicate patterns
+				 * if a special repetition is found,
+				 * this is done to somewhat simplify
+				 * the bytecode engine and still allow
+				 * some complex (and time consuming)
+				 * patterns. */
+
+    int flags;
+    int ecode;
+};
+
+/*  This structure is not associated with re_cod as it's data only matters
+ * to the current match search.
+ */
+struct _re_eng {
+    unsigned char *bas;		/* Base string pointer */
+    unsigned char *str;		/* String to search for pattern */
+    unsigned char *end;		/* Where to stop searching */
+    unsigned char *cod;		/* Pointer in the re_cod structure */
+    long off;			/* Number of used entries in so/eo etc */
+
+    /* Match offset/nesting information */
+    long so[MAX_DEPTH];		/* (s)tart of (m)atch */
+    long eo[MAX_DEPTH];		/* (e)nd of (m)atch */
+    long sv[MAX_DEPTH];		/* (s)a(v)e match end offset */
+    long re[MAX_DEPTH];		/* (re)petition count */
+    long ss[MAX_DEPTH];		/* (s)ave (s)tart of match */
+    unsigned char *rcod[MAX_DEPTH];	/* restart position in regex code */
+    unsigned char *rstr[MAX_DEPTH];	/* restart position in string */
+
+    /* Group/backreference information */
+    long goff;
+    long gso[9];
+    long geo[9];
+};
+
+/*
+ * Prototypes
+ */
+static void reinit(void);
+static int rec_check(re_inf*, int);
+static int rec_code(re_inf*, ReCode);
+static int rec_byte(re_inf*, int);
+static int rec_byte_byte(re_inf*, int, int);
+static int rec_code_byte(re_inf*, ReCode, int);
+static int rec_length(re_inf*, int);
+static int rec_code_byte_byte(re_inf*, ReCode, int, int);
+static int rec_build_alt(re_inf*, rec_alt*);
+static int rec_build_pat(re_inf*, rec_pat*);
+static int rec_build_rng(re_inf*, rec_rng*);
+static int rec_build_grp(re_inf*, rec_grp*);
+static int rec_build_stl(re_inf*, rec_stl*);
+static int rec_build_rep(re_inf*, rec_rep*);
+static int rec_inc_spc(re_inf*);
+static int rec_dec_spc(re_inf*);
+static int rec_add_spc(re_inf*, int);
+static int rec_off_spc(re_inf*);
+static int rec_alt_spc(re_inf*, int);
+static int rec_rep_spc(re_inf*, int);
+#ifdef DEBUG
+static void redump(re_cod*);
+#endif
+
+/*
+ * Initialization
+ */
+unsigned char re__alnum[256];
+unsigned char re__odigit[256];
+unsigned char re__ddigit[256];
+unsigned char re__xdigit[256];
+unsigned char re__control[256];
+
+/*
+ * Implementation
+ */
+int
+recomp(re_cod *preg, const char *pattern, int flags)
+{
+    int i, ecode;
+    re_inf inf;
+
+    reinit();
+
+    preg->cod = NULL;
+    inf.alt = irec_comp(pattern,
+			flags & RE_PEND ? preg->re_endp :
+				pattern + strlen(pattern),
+			flags, &ecode);
+    if (ecode != 0)
+	return (ecode);
+
+    inf.cod = NULL;
+    inf.len = inf.spc = 0;
+    inf.bas = 0;
+    inf.par = 0;
+    inf.ref = 0;
+    inf.apat = NULL;
+    inf.flags = flags;
+    inf.ecode = 0;
+    for (i = 0; i < MAX_DEPTH; i++)
+	inf.sp[i] = 0;
+
+    /* First byte is runtime modifier flags */
+    if (rec_byte(&inf, flags & (RE_NEWLINE | RE_NOSUB)) == 0 &&
+	rec_byte(&inf, 0xff) == 0 &&
+	rec_build_alt(&inf, inf.alt) == 0 &&
+	rec_rep_spc(&inf, 0) == 0 &&
+	rec_code(&inf, Re_Done) == 0) {
+	/*  Number of possible references, loops will not leave this
+	 * value correct, but it is cheap to read it from the second
+	 * byte, instead of adding several extra checks in the bytecode. */
+	if (inf.ref)
+	    inf.cod[1] = inf.ref - 1;
+	preg->cod = inf.cod;
+	/*  Public structure member */
+	preg->re_nsub = inf.ref;
+    }
+
+    irec_free_alt(inf.alt);
+    if (inf.ecode)
+	free(inf.cod);
+#ifdef DEBUG
+    else if (flags & RE_DUMP)
+	redump(preg);
+#endif
+
+    return (inf.ecode);
+}
+
+int
+reexec(const re_cod *preg, const char *string,
+       int nmatch, re_mat pmat[], int flags)
+{
+    unsigned char *ptr, *str, newline, nosub;
+    int len, si, ci, bas, i, j, k, l, m;
+    re_eng eng;
+
+    if (preg == NULL || preg->cod == NULL || nmatch < 0 ||
+	((flags & RE_STARTEND) &&
+	 (pmat == NULL || pmat[0].rm_eo < pmat[0].rm_so)))
+	return (RE_INVARG);
+
+    eng.str = (unsigned char*)string;
+    if (flags & RE_STARTEND) {
+	eng.end = eng.str + pmat[0].rm_eo;
+	eng.str += pmat[0].rm_so;
+    }
+    else
+	eng.end = eng.str + strlen(string);
+    eng.bas = eng.str;
+    nosub = preg->cod[0] & RE_NOSUB;
+    newline = preg->cod[0] & RE_NEWLINE;
+    eng.cod = preg->cod + 2;
+
+    if (!nosub && preg->cod[1] != 0xff) {
+	for (i = 0; i <= preg->cod[1]; i++) {
+	    eng.gso[i] = 0;
+	    eng.geo[i] = -1;
+	}
+    }
+
+    /* Setup to search for start of match from the first character */
+    eng.so[0] = 0;
+    eng.eo[0] = eng.sv[0] = -1;
+    eng.rcod[0] = eng.cod;
+    eng.rstr[0] = eng.str + 1;
+    eng.off = 0;
+    eng.goff = -1;
+    for (ci = si = 1;;) {
+reset:
+	switch (*eng.cod) {
+	    /****************************************************
+	     * One byte codes					*
+	     ****************************************************/
+	    case Re_Any:
+		if (eng.str == eng.end || (newline && eng.str[0] == '\n'))
+		    goto fail;
+		goto match;
+	    case Re_AnyEatAnyTimes:
+		if (newline) {
+		    for (ptr = eng.str; ptr < eng.end; ptr++) {
+			if (*ptr == '\n')
+			    break;
+		    }
+		    si = ptr - eng.str;
+		}
+		else
+		    si = eng.end - eng.str;
+		goto match;
+	    case Re_AnyEatMaybe:
+		si = eng.end > eng.str;
+		if (newline && si && eng.str[0] == '\n')
+		    si = 0;
+		goto match;
+	    case Re_AnyEatAtLeast:
+		if (newline) {
+		    for (ptr = eng.str; ptr < eng.end; ptr++) {
+			if (*ptr == '\n')
+			    break;
+		    }
+		    si = ptr - eng.str;
+		}
+		else
+		    si = eng.end - eng.str;
+		if (si == 0) {
+		    si = 1;
+		    goto fail;
+		}
+		goto match;
+	    case Re_Odigit:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (re__odigit[eng.str[0]])
+		    goto match;
+		goto fail;
+	    case Re_OdigitNot:
+		if (eng.str >= eng.end || re__odigit[eng.str[0]])
+		    goto fail;
+		goto match;
+	    case Re_Digit:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (re__ddigit[eng.str[0]])
+		    goto match;
+		goto fail;
+	    case Re_DigitNot:
+		if (eng.str >= eng.end || re__ddigit[eng.str[0]])
+		    goto fail;
+		goto match;
+	    case Re_Xdigit:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (re__xdigit[eng.str[0]])
+		    goto match;
+		goto fail;
+	    case Re_XdigitNot:
+		if (eng.str >= eng.end || re__xdigit[eng.str[0]])
+		    goto fail;
+		goto match;
+	    case Re_Space:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] == ' ' || eng.str[0] == '\t')
+		    goto match;
+		goto fail;
+	    case Re_SpaceNot:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] != ' ' && eng.str[0] != '\t')
+		    goto match;
+		goto fail;
+	    case Re_Tab:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] == '\t')
+		    goto match;
+		goto fail;
+	    case Re_Newline:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] == '\n')
+		    goto match;
+		goto fail;
+	    case Re_Lower:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] >= 'a' && eng.str[0] <= 'z')
+		    goto match;
+		goto fail;
+	    case Re_Upper:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] >= 'A' && eng.str[0] <= 'Z')
+		    goto match;
+		goto fail;
+	    case Re_Alnum:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (re__alnum[eng.str[0]])
+		    goto match;
+		goto fail;
+	    case Re_AlnumNot:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (re__alnum[eng.str[0]])
+		    goto fail;
+		goto match;
+	    case Re_Control:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (re__control[eng.str[0]])
+		    goto match;
+		goto fail;
+	    case Re_ControlNot:
+		if (eng.str >= eng.end || re__control[eng.str[0]])
+		    goto fail;
+		goto match;
+
+	    /****************************************************
+	     * One byte codes, match special emtpy strings	*
+	     ****************************************************/
+	    case Re_Bol:
+		if (eng.str == eng.bas) {
+		    if ((flags & RE_NOTBOL)) {
+			/* String does not start at the beginning of a line */
+			if (newline)
+			    goto fail;
+			goto wont;
+		    }
+		    si = 0;
+		    goto match;
+		}
+		if (newline && eng.str[-1] == '\n') {
+		    si = 0;
+		    goto match;
+		}
+		goto fail;
+	    case Re_Eol:
+		if (eng.str == eng.end) {
+		    if (flags & RE_NOTEOL)
+			/* String does not finish at the end of a line */
+			goto wont;
+		    si = 0;
+		    goto match;
+		}
+		if (newline && eng.str[0] == '\n') {
+		    si = 0;
+		    goto match;
+		}
+		goto fail;
+	    case Re_Bow:
+		if (eng.str >= eng.end ||
+		    (eng.str > eng.bas &&
+		     (re__alnum[eng.str[-1]])))
+		    goto fail;
+		if (re__alnum[eng.str[0]]) {
+		    si = 0;
+		    goto match;
+		}
+		goto fail;
+	    case Re_Eow:
+		if (eng.str == eng.bas ||
+		    (eng.str < eng.end &&
+		     re__alnum[eng.str[0]]))
+		    goto fail;
+		if (re__alnum[eng.str[-1]]) {
+		    si = 0;
+		    goto match;
+		}
+		goto fail;
+
+	    /****************************************************
+	     * One byte code, one byte argument			*
+	     ****************************************************/
+	    case Re_Literal:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] == eng.cod[1]) {
+		    ci = 2;
+		    goto match;
+		}
+		goto fail;
+	    case Re_LiteralNot:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] != eng.cod[1]) {
+		    ci = 2;
+		    goto match;
+		}
+		goto fail;
+	    case Re_SearchLiteral:
+		for (str = eng.str; str < eng.end; str++) {
+		    if (*str == eng.cod[1]) {
+			ci = 2;
+			eng.str = str;
+			goto match;
+		    }
+		}
+		/* This bytecode only happens in the toplevel */
+		eng.so[0] = str - eng.bas;
+		eng.str = str;
+		goto fail;
+
+	    /****************************************************
+	     * One byte code, two bytes argument		*
+	     ****************************************************/
+	    case Re_CaseLiteral:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] == eng.cod[1] || eng.str[0] == eng.cod[2]) {
+		    ci = 3;
+		    goto match;
+		}
+		goto fail;
+	    case Re_CaseLiteralNot:
+		if (eng.str >= eng.end)
+		    goto fail;
+		if (eng.str[0] != eng.cod[1] && eng.str[0] != eng.cod[2]) {
+		    ci = 3;
+		    goto match;
+		}
+		goto fail;
+	    case Re_SearchCaseLiteral:
+		for (str = eng.str; str < eng.end; str++) {
+		    if (*str == eng.cod[1] || *str == eng.cod[2]) {
+			ci = 3;
+			eng.str = str;
+			goto match;
+		    }
+		}
+		eng.so[0] = str - eng.bas;
+		eng.str = str;
+		goto fail;
+
+	    /****************************************************
+	     * One byte codes, two arguments, n bytes		*
+	     ****************************************************/
+	    case Re_String:
+		len = eng.cod[1];
+		if (len & 0x80) {
+		    i = 3;
+		    len = (len & 0x7f) + (eng.cod[2] << 7);
+		}
+		else
+		    i = 2;
+		if (eng.end - eng.str < len)
+		    goto fail;
+		ptr = eng.cod + i;
+		str = eng.str;
+		for (k = len; k > 0; k--) {
+		    if (*ptr++ != *str++)
+			goto fail;
+		}
+		ci = i + len;
+		si = len;
+		goto match;
+	    case Re_SearchString:
+		len = eng.cod[1];
+		if (len & 0x80) {
+		    i = 3;
+		    len = (len & 0x7f) + (eng.cod[2] << 7);
+		}
+		else
+		    i = 2;
+		for (str = eng.str; eng.end - str >= len; str = eng.str++) {
+		    for (ptr = eng.cod + i, str = eng.str, k = len; k > 0; k--)
+			if (*ptr++ != *str++)
+			    break;
+		    if (k == 0) {
+			/* Substring found */
+			ci = i + len;
+			si = str - eng.str;
+			goto match;
+		    }
+		}
+		eng.so[0] = eng.end - eng.bas;
+		eng.str = eng.end;
+		goto fail;
+
+	    case Re_CaseString:
+		len = eng.cod[1];
+		if (len & 0x80) {
+		    i = 3;
+		    len = (len & 0x7f) + (eng.cod[2] << 7);
+		}
+		else
+		    i = 2;
+
+		len >>= 1;
+		/*  Check if there are at least len/2 bytes left, string
+		 * is represented as two bytes, lower and upper case */
+		if (eng.end - eng.str < len)
+		    goto fail;
+		ptr = eng.cod + i;
+		str = eng.str;
+		for (k = len; k > 0; str++, ptr += 2, k--) {
+		    if (*str != ptr[0] && *str != ptr[1])
+			goto fail;
+		}
+		ci = i + (len << 1);
+		si = len;
+		goto match;
+	    case Re_SearchCaseString:
+		len = eng.cod[1];
+		if (len & 0x80) {
+		    i = 3;
+		    len = (len & 0x7f) + (eng.cod[2] << 7);
+		}
+		else
+		    i = 2;
+		len >>= 1;
+		for (str = eng.str; eng.end - str >= len; str = eng.str++) {
+		    for (ptr = eng.cod + i, str = eng.str, k = len;
+			 k > 0; k--, ptr += 2, str++)
+			if (ptr[0] != str[0] && ptr[1] != str[0])
+			    break;
+		    if (k == 0) {
+			/* Substring found */
+			ci = i + (len << 1);
+			si = str - eng.str;
+			goto match;
+		    }
+		}
+		eng.so[0] = eng.end - eng.bas;
+		eng.str = eng.end;
+		goto fail;
+
+	    case Re_StringList:
+		/* Number of strings */
+		k = eng.cod[1];
+
+		/* Where to jump after match */
+		bas = eng.cod[2] | (eng.cod[3] << 8);
+
+		str = eng.str;
+		ptr = eng.cod + k + 4;
+		l = eng.end - eng.str;
+		for (j = 0; j < k; j++) {
+		    len = eng.cod[j + 4];
+		    if (len <= l) {
+			for (i = 0; i < len; i++)
+			    if (ptr[i] != str[i])
+				goto next_stl;
+			goto stl_match;
+		    }
+next_stl:
+		    ptr += len;
+		}
+		goto fail;
+stl_match:
+		ci = bas;
+		si = len;
+		goto match;
+
+	    case Re_CaseStringList:
+		/* Number of strings */
+		k = eng.cod[1];
+
+		/* Where to jump after match */
+		bas = eng.cod[2] | (eng.cod[3] << 8);
+
+		str = eng.str;
+		ptr = eng.cod + k + 4;
+		l = eng.end - eng.str;
+		for (j = 0; j < k; j++) {
+		    len = eng.cod[j + 4];
+		    if ((len >> 1) <= l) {
+			for (i = m = 0; i < len; m++, i += 2)
+			    if (ptr[i] != str[m] && ptr[i + 1] != str[m])
+				goto next_cstl;
+			goto cstl_match;
+		    }
+next_cstl:
+		    ptr += len;
+		}
+		goto fail;
+cstl_match:
+		ci = bas;
+		si = len >> 1;
+		goto match;
+
+
+	    case Re_LargeStringList:
+		/* Where to jump after match */
+		bas = eng.cod[1] | (eng.cod[2] << 8);
+
+		str = eng.str;
+
+		/* First entry in index map */
+		ptr = eng.cod + 3;
+		i = (int)str[0] << 1;
+		j = ptr[i] | (ptr[i + 1] << 8);
+		if (j == 0xffff)
+		    /* No entry with this byte */
+		    goto fail;
+
+		/* Bytes left in input */
+		l = eng.end - eng.str;
+
+		/* First entry matching initial byte */
+		ptr += 512 + j;
+
+		for (len = ptr[0];
+		     str[0] == ptr[1];
+		     ptr += len + 1, len = ptr[0]) {
+		    if (len <= l) {
+			for (i = 1; i < len; i++) {
+			    if (ptr[i + 1] != str[i])
+				goto next_lstl;
+			}
+			ci = bas;
+			si = len;
+			goto match;
+		    }
+next_lstl:;
+		}
+		goto fail;
+
+	    case Re_LargeCaseStringList:
+		/* Where to jump after match */
+		bas = eng.cod[1] | (eng.cod[2] << 8);
+
+		str = eng.str;
+
+		/* First entry in index map */
+		ptr = eng.cod + 3;
+		i = (int)str[0] << 1;
+		j = ptr[i] | (ptr[i + 1] << 8);
+		if (j == 0xffff)
+		    /* No entry with this byte */
+		    goto fail;
+
+		/* Bytes left in input */
+		l = eng.end - eng.str;
+
+		/* First entry matching initial byte */
+		ptr += 512 + j;
+
+		for (len = ptr[0];
+		     str[0] == ptr[1] || str[0] == ptr[2];
+		     ptr += len + 1, len = ptr[0]) {
+		    if ((k = (len >> 1)) <= l) {
+			for (i = 2, j = 1; i < len; i += 2, j++) {
+			    if (ptr[i + 1] != str[j] && ptr[i + 2] != str[j])
+				goto next_lcstl;
+			}
+			ci = bas;
+			si = k;
+			goto match;
+		    }
+next_lcstl:;
+		}
+		goto fail;
+
+
+	    /****************************************************
+	     * Character range matching				*
+	     ****************************************************/
+	    case Re_Range:
+		if (eng.str < eng.end && eng.cod[eng.str[0] + 1]) {
+		    ci = 257;
+		    goto match;
+		}
+		goto fail;
+	    case Re_RangeNot:
+		if (eng.str >= eng.end || eng.cod[eng.str[0] + 1])
+		    goto fail;
+		ci = 257;
+		goto match;
+
+	    /****************************************************
+	     * Group handling					*
+	     ****************************************************/
+	    case Re_Open:
+		if (++eng.goff >= 9)
+		    return (RE_ASSERT);
+		eng.gso[eng.goff] = eng.str - eng.bas;
+		++eng.cod;
+		continue;
+	    case Re_Close:
+		eng.geo[eng.goff] = eng.str - eng.bas;
+		++eng.cod;
+		continue;
+	    case Re_Update:
+		bas = eng.cod[1];
+		eng.geo[eng.goff] = eng.str - eng.bas;
+		eng.cod += 2;		/* + Update + bas */
+		continue;
+
+	    /****************************************************
+	     * Backreference					*
+	     ****************************************************/
+	    case Re_Backref:
+		i = eng.cod[1];
+		j = eng.gso[i];
+		k = eng.geo[i];
+		len = k - j;
+		if (k < j || eng.end - eng.str < len)
+		    goto fail;
+		ptr = eng.bas + j;
+		str = eng.str;
+		for (l = len; l > 0; l--) {
+		    if (*ptr++ != *str++)
+			goto fail;
+		}
+		ci = 2;
+		si = len;
+		goto match;
+
+	    /****************************************************
+	     * Alternatives handling				*
+	     ****************************************************/
+	    case Re_Alt:
+		bas = eng.off;
+		if (++eng.off >= MAX_DEPTH)
+		    return (RE_ASSERT);
+
+		/* Get offset of next alternative */
+		i = eng.cod[1] | (eng.cod[2] << 8);
+
+		/* Setup for next alternative if the current fails */
+		eng.rcod[eng.off] = eng.cod + i + 1;	/* + Alt */
+
+		/* If fail, test the next alternative in the same string */
+		eng.rstr[eng.off] = eng.str;
+
+		/* Setup match offsets */
+		if (eng.so[bas] <= eng.eo[bas])
+		    eng.so[eng.off] = eng.eo[bas];
+		else
+		    eng.so[eng.off] = eng.so[bas];
+		eng.sv[eng.off] = eng.eo[eng.off] = eng.so[eng.off] - 1;
+
+		/* Save start of possible previous matches */
+		eng.ss[eng.off] = eng.so[bas];
+
+		/* Skip code */
+		eng.cod += 3;
+
+		/* Go try the first alternative */
+		continue;
+
+	    case Re_AltNext:
+		bas = eng.off - 1;
+		/* Check if matched and if it is a better match */
+		if (eng.sv[eng.off] - eng.so[eng.off] <
+		    eng.eo[eng.off] - eng.so[eng.off])
+		    eng.sv[eng.off] = eng.eo[eng.off];
+
+		/* Get offset of next alternative */
+		i = eng.cod[1] | (eng.cod[2] << 8);
+
+		/* Setup for next alternative if the current fails */
+		eng.rcod[eng.off] = eng.cod + i + 1;	/* + AltNext */
+
+		/* Setup match offset */
+		eng.eo[eng.off] = eng.so[eng.off] - 1;
+
+		/* Reset string for next alternative */
+		eng.str = eng.rstr[eng.off];
+
+		/* Skip code */
+		eng.cod += 3;
+
+		/* Go try the next alternative */
+		continue;
+
+	    case Re_AltDone:
+		bas = eng.off - 1;
+		/* Check if matched and if it is a better match */
+		if (eng.sv[eng.off] - eng.so[eng.off] <
+		    eng.eo[eng.off] - eng.so[eng.off])
+		    eng.sv[eng.off] = eng.eo[eng.off];
+
+		/* If there is a match */
+		if (eng.sv[eng.off] >= eng.so[eng.off]) {
+		    eng.so[bas] = eng.ss[eng.off];
+		    eng.eo[bas] = eng.sv[eng.off];
+		    eng.str = eng.bas + eng.eo[bas];
+
+		    /* Pop stack and skip code */
+		    --eng.off;
+		    ++eng.cod;
+
+		    /* Go try next regular expression pattern */
+		    continue;
+		}
+
+		/* Failed, reset string and pop stack */
+		eng.str = eng.rstr[eng.off];
+		--eng.off;
+		goto fail;
+
+
+	    /****************************************************
+	     * Repetition					*
+	     ****************************************************/
+
+		/*  Note that the repetition counter is not
+		 * updated for <re>*, <re>+ and <re>?
+		 * it is easy to updated, but since it is not
+		 * really useful, code to do it was removed
+		 * to save a few cpu cicles. */
+
+#define REPETITION_SETUP()					\
+	if (++eng.off >= MAX_DEPTH)				\
+	    return (RE_ASSERT);					\
+								\
+	/* Return here for recovery if match fail */		\
+	eng.rcod[eng.off] = eng.cod;				\
+								\
+	/* Setup match offsets */				\
+	if (eng.so[bas] <= eng.eo[bas])				\
+	    eng.so[eng.off] = eng.eo[bas];			\
+	else							\
+	    eng.so[eng.off] = eng.so[bas];			\
+	eng.ss[eng.off] = eng.so[bas];				\
+	eng.sv[eng.off] = eng.eo[eng.off] = eng.so[eng.off] - 1;\
+								\
+	/* Skip repetition instruction */			\
+	eng.cod += 4;
+
+
+	    case Re_AnyTimes:
+		bas = eng.cod[1];
+		if (eng.off == bas) {
+		    /* First iteration */
+		    REPETITION_SETUP();
+		}
+		else {
+		    if (eng.eo[eng.off] >= eng.so[eng.off] &&
+			eng.eo[eng.off] > eng.sv[eng.off]) {
+			/* Update offset of match */
+			eng.sv[eng.off] = eng.eo[eng.off];
+
+			/* Skip repetition instruction */
+			eng.cod += 4;
+		    }
+		    else {
+			/* Match failed but it is ok */
+			len = eng.cod[2] | (eng.cod[3] << 8);
+			eng.so[bas] = eng.ss[eng.off];
+			if (eng.sv[eng.off] >= eng.so[eng.off])
+			    /* Something matched earlier, update */
+			    eng.eo[bas] = eng.sv[eng.off];
+			else if (eng.eo[bas] < eng.so[bas])
+			    /* Empty match */
+			    eng.eo[bas] = eng.so[bas];
+
+			/* Try next pattern at correct offset */
+			eng.str = eng.bas + eng.eo[bas];
+
+			/* Pop stack and skip code */
+			--eng.off;
+			eng.cod += len;
+		    }
+		}
+		continue;
+
+	    case Re_Maybe:
+		bas = eng.cod[1];
+		if (eng.off == bas) {
+		    /* First iteration */
+		    REPETITION_SETUP();
+		}
+		else {
+		    /* Matched or first iteration is done */
+		    len = eng.cod[2] | (eng.cod[3] << 8);
+		    eng.so[bas] = eng.ss[eng.off];
+		    if (eng.eo[eng.off] > eng.so[eng.off]) {
+			/* Something matched earlier, update */
+			eng.eo[bas] = eng.eo[eng.off];
+			eng.str = eng.bas + eng.eo[bas];
+			/* Don't need to update counter */
+		    }
+		    else {
+			/* Empty match */
+			if (eng.eo[bas] < eng.so[bas])
+			    eng.eo[bas] = eng.so[bas];
+
+			/* Try next pattern at correct offset */
+			eng.str = eng.bas + eng.eo[bas];
+		    }
+
+		    /* Pop stack */
+		    --eng.off;
+
+		    /* Skip code */
+		    eng.cod += len;
+		}
+		continue;
+
+	    case Re_AtLeast:
+		bas = eng.cod[1];
+		if (eng.off == bas) {
+		    /* First iteration */
+		    REPETITION_SETUP();
+		}
+		else {
+		    if (eng.eo[eng.off] >= eng.so[eng.off] &&
+			eng.eo[eng.off] > eng.sv[eng.off]) {
+			/* Update offset of match */
+			eng.sv[eng.off] = eng.eo[eng.off];
+
+			/* Skip repetition instruction */
+			eng.cod += 4;
+		    }
+		    else {
+			/* Last try failed */
+			len = eng.cod[2] | (eng.cod[3] << 8);
+			if (eng.sv[eng.off] >= eng.so[eng.off]) {
+			    /* Something matched earlier, update */
+			    eng.so[bas] = eng.ss[eng.off];
+			    eng.eo[bas] = eng.sv[eng.off];
+			    eng.str = eng.bas + eng.eo[bas];
+			}
+			else {
+			    /*	Do it here, so that the fail label does
+			     * not need to do too expensive work for
+			     * simple patterns. */
+			    eng.so[bas] = eng.str - eng.bas;
+
+			    /* Zero matches, pop stack and restart */
+			    --eng.off;
+			    goto fail;
+			}
+
+			/* Pop stack and skip code */
+			--eng.off;
+			eng.cod += len;
+		    }
+		}
+		continue;
+
+
+	    /****************************************************
+	     * Repetition with arguments			*
+	     ****************************************************/
+	    case Re_Exact:
+#define COMPLEX_REPETITION_SETUP_0()				\
+	i = eng.cod[1];						\
+	bas = eng.cod[2];
+
+#define COMPLEX_REPETITION_SETUP()				\
+	/* First iteration */					\
+	if (++eng.off >= MAX_DEPTH)				\
+	    return (RE_ASSERT);					\
+								\
+	/*  Remeber number or repetitions */			\
+	eng.re[eng.off] = 0;					\
+								\
+	/* Return here for recovery if match fail */		\
+	eng.rcod[eng.off] = eng.cod;				\
+								\
+	/* Setup match offsets */				\
+	if (eng.so[bas] <= eng.eo[bas])				\
+	    eng.so[eng.off] = eng.eo[bas];			\
+	else							\
+	    eng.so[eng.off] = eng.so[bas];			\
+	eng.sv[eng.off] = eng.eo[eng.off] = eng.so[eng.off] - 1;\
+	eng.ss[eng.off] = eng.so[bas];				\
+								\
+	/* Skip repetition instruction */			\
+	eng.cod += 5;
+
+		COMPLEX_REPETITION_SETUP_0();
+		if (eng.off == bas) {
+		    /* First iteration */
+		    COMPLEX_REPETITION_SETUP();
+		}
+		else {
+		    if (eng.eo[eng.off] >= eng.so[eng.off] &&
+			eng.eo[eng.off] > eng.sv[eng.off]) {
+			/* Update offset of match */
+			eng.sv[eng.off] = eng.eo[eng.off];
+
+			/* Update repetition counter */
+			if (++eng.re[eng.off] == i) {
+			    /* Matched the required times */
+			    eng.so[bas] = eng.ss[eng.off];
+			    eng.eo[bas] = eng.sv[eng.off];
+			    eng.str = eng.bas + eng.eo[bas];
+
+			    /* Update code */
+			    k = eng.cod[3] | (eng.cod[4] << 8);
+			    eng.cod += k;
+
+			    /* Pop stack and go for next pattern */
+			    --eng.off;
+			    continue;
+			}
+
+			/* Skip repetition instruction */
+			eng.cod += 5;
+		    }
+		    else {
+			/*  Do it here, so that the fail label does
+			 * not need to do too expensive work for
+			 * simple patterns. */
+			eng.so[bas] = eng.str - eng.bas;
+
+			/* Pop stack and restart */
+			--eng.off;
+			goto fail;
+		    }
+		}
+		continue;
+
+	    case Re_Min:
+		COMPLEX_REPETITION_SETUP_0();
+		if (eng.off == bas) {
+		    /* First iteration */
+		    COMPLEX_REPETITION_SETUP();
+		}
+		else {
+		    if (eng.eo[eng.off] >= eng.so[eng.off] &&
+			eng.eo[eng.off] > eng.sv[eng.off]) {
+			/* Update offset of match */
+			eng.sv[eng.off] = eng.eo[eng.off];
+
+			/* Update repetition counter */
+			++eng.re[eng.off];
+
+			/* Skip repetition instruction and try again */
+			eng.cod += 5;
+		    }
+		    else {
+			/* Match failed! */
+			if (eng.re[eng.off] < i) {
+			    /*	Do it here, so that the fail label does
+			     * not need to do too expensive work for
+			     * simple patterns. */
+			    eng.so[bas] = eng.str - eng.bas;
+
+			    /* Didn't match required number of times */
+			    --eng.off;
+			    goto fail;
+			}
+			else {
+			    /* Matched minimum number of times */
+			    eng.eo[bas] = eng.sv[eng.off];
+			    eng.str = eng.bas + eng.eo[bas];
+			    k = eng.cod[3] | (eng.cod[4] << 8);
+
+			    /* Update code and pop stack */
+			    eng.cod += k;
+			    --eng.off;
+			}
+		    }
+		}
+		continue;
+
+	    case Re_Max:
+		COMPLEX_REPETITION_SETUP_0();
+		if (eng.off == bas) {
+		    /* First iteration */
+		    COMPLEX_REPETITION_SETUP();
+		}
+		else {
+		    if (eng.eo[eng.off] >= eng.so[eng.off] &&
+			eng.eo[eng.off] > eng.sv[eng.off]) {
+			/* Update offset of match */
+			eng.sv[eng.off] = eng.eo[eng.off];
+
+			/* Update repetition counter */
+			if (++eng.re[eng.off] == i) {
+			    /* Matched the maximum times */
+			    eng.so[bas] = eng.ss[eng.off];
+			    eng.eo[bas] = eng.sv[eng.off];
+			    eng.str = eng.bas + eng.eo[bas];
+
+			    k = eng.cod[3] | (eng.cod[4] << 8);
+
+			    /* Update code and pop stack */
+			    eng.cod += k;
+			    --eng.off;
+			    continue;
+			}
+
+			/* Skip repetition instruction and try again */
+			eng.cod += 5;
+		    }
+		    else {
+			/* No matches, but zero matches are ok */
+			k = eng.cod[3] | (eng.cod[4] << 8);
+			if (eng.sv[eng.off] >= eng.so[eng.off]) {
+			    /* Something matched earlier, update */
+			    eng.so[bas] = eng.ss[eng.off];
+			    eng.eo[bas] = eng.sv[eng.off];
+			    eng.str = eng.bas + eng.eo[bas];
+			}
+			else {
+			    /* Empty match */
+			    if (eng.eo[bas] < eng.so[bas])
+				eng.eo[bas] = eng.so[bas];
+
+			    /* Try next pattern at correct offset */
+			    eng.str = eng.bas + eng.eo[bas];
+			}
+
+			/* Pop stack and update code */
+			--eng.off;
+			eng.cod += k;
+		    }
+		}
+		continue;
+
+	    case Re_MinMax:
+		bas = eng.cod[3];
+		if (eng.off == bas) {
+		    /* First iteration */
+		    COMPLEX_REPETITION_SETUP();
+		}
+		else {
+		    if (eng.eo[eng.off] >= eng.so[eng.off] &&
+			eng.eo[eng.off] > eng.sv[eng.off]) {
+			/* Update offset of match */
+			eng.sv[eng.off] = eng.eo[eng.off];
+
+			/* Update repetition counter */
+			if (++eng.re[eng.off] == eng.cod[2]) {
+			    /* Matched the maximum times */
+			    eng.so[bas] = eng.ss[eng.off];
+			    eng.eo[bas] = eng.sv[eng.off];
+			    eng.str = eng.bas + eng.eo[bas];
+			    k = eng.cod[4] | (eng.cod[5] << 8);
+
+			    /* Update code and pop stack */
+			    eng.cod += k;
+			    --eng.off;
+			    continue;
+			}
+
+			/* Skip repetition instruction and try again */
+			eng.cod += 6;
+		    }
+		    else {
+			/* Match failed! */
+			if (eng.re[eng.off] < eng.cod[1]) {
+			    /*	Do it here, so that the fail label does
+			     * not need to do too expensive work for
+			     * simple patterns. */
+			    eng.so[bas] = eng.str - eng.bas;
+
+			    /* Didn't match required number of times */
+			    --eng.off;
+			    goto fail;
+			}
+			else {
+			    /* Matched minimum number of times */
+			    eng.so[bas] = eng.ss[eng.off];
+			    eng.eo[bas] = eng.sv[eng.off];
+			    eng.str = eng.bas + eng.eo[bas];
+			    k = eng.cod[4] | (eng.cod[5] << 8);
+
+			    /* Update code and pop stack */
+			    eng.cod += k;
+			    --eng.off;
+			}
+		    }
+		}
+		continue;
+
+
+	    /****************************************************
+	     * Special repetition handling			*
+	     ****************************************************/
+	    case Re_AnyAnyTimes:
+		/* code(1) + bas(1) + gbas(1) + jump(2) */
+		bas = eng.cod[1];
+		if (eng.off == bas) {
+		    /* First iteration */
+		    if (++eng.off >= MAX_DEPTH)
+			return (RE_ASSERT);
+
+		    /* Return here for recovery if match fail */
+		    eng.rcod[eng.off] = eng.cod;
+
+		    /* If fail, test the next pattern at the same point */
+		    eng.rstr[eng.off] = eng.str;
+
+		    /* Setup match offsets */
+		    eng.so[eng.off] = eng.str - eng.bas;
+		    eng.eo[eng.off] = eng.so[eng.off] - 1;
+
+		    if (newline)
+			/*  Use the repetition counter to store start of
+			 * skipped string, to later check if skipping a
+			 * newline. */
+			eng.re[eng.off] = eng.so[eng.off];
+
+		    /* Save start of possible previous matches */
+		    eng.ss[eng.off] = eng.so[bas];
+
+		    /* Skip repetition instruction */
+		    eng.cod += 5;
+		}
+		else {
+		    /* -1 as an unsigned char */
+		    if (eng.cod[2] != 0xff)
+			eng.goff = eng.cod[2];
+		    else
+			eng.goff = -1;
+
+		    if (newline) {
+			ptr = eng.bas + eng.re[eng.off];
+			str = eng.bas + eng.so[eng.off];
+			for (; ptr < str; ptr++)
+			    if (*ptr == '\n') {
+				eng.cod = eng.rcod[0];
+				eng.so[0] = ptr - eng.bas + 1;
+				eng.eo[0] = eng.so[0] - 1;
+				eng.rstr[0] = eng.str = ptr + 1;
+				eng.off = 0;
+				goto reset;
+			    }
+			/* If looping, don't do too many noops */
+			eng.re[eng.off] = ptr - eng.bas;
+		    }
+
+		    if (eng.eo[eng.off] >= eng.so[eng.off]) {
+			/* Note that this is only true if all possibly
+			 * nested special repetitions also matched. */
+
+			if (eng.goff >= 0) {
+			    if (eng.cod[5] == Re_Update)
+				eng.gso[eng.goff] = eng.eo[bas] +
+						    (eng.so[bas] > eng.eo[bas]);
+			    else if (eng.geo[eng.goff] < eng.so[eng.off])
+				eng.geo[eng.goff] = eng.so[eng.off];
+			}
+
+			/* Jump relative offset */
+			len = eng.cod[3] | (eng.cod[4] << 8);
+
+			/* Restore offset from where started trying */
+			eng.so[bas] = eng.ss[eng.off];
+			eng.eo[bas] = eng.eo[eng.off];
+
+			/* Pop stack and skip code */
+			--eng.off;
+			eng.cod += len;
+		    }
+		    else {
+			/* Only give up if the entire string was scanned */
+			if (eng.str < eng.end) {
+			    /* Update restart point for next pattern */
+			    eng.str = ++eng.rstr[eng.off];
+
+			    /* Reset start of nested match */
+			    eng.so[eng.off] = eng.str - eng.bas;
+
+			    /* Skip repetition instruction */
+			    eng.cod += 5;
+			}
+			else {
+			    /* Entire string scanned and failed */
+
+			    /* Jump relative offset */
+			    len = eng.cod[3] | (eng.cod[4] << 8);
+
+			    /* Restore offset from where started trying */
+			    eng.so[bas] = eng.ss[eng.off];
+			    eng.eo[bas] = eng.ss[eng.off] - 1;
+
+			    /* Pop stack and skip code */
+			    --eng.off;
+			    eng.cod += len;
+			}
+		    }
+		}
+		continue;
+
+	    /*  This is significantly different than matching <re>.*<re>
+	     * because it may need to restart several times since it is
+	     * possible to find too many false positives, for example:
+	     *	a.*b	=> once one "a" is found, scan all
+	     *		   the remaining string searching for a "b"
+	     *  a.?b	=> the string may have too many "a"s, but the
+	     *		   first occurrences of "a" may not be followed
+	     *		   by any-character and a "b" or a single "b".
+	     */
+	    case Re_AnyMaybe:
+		bas = eng.cod[1];
+		if (eng.off == bas) {
+		    /* First iteration */
+		    if (++eng.off >= MAX_DEPTH)
+			return (RE_ASSERT);
+
+		    /* Return here for recovery if match fail */
+		    eng.rcod[eng.off] = eng.cod;
+
+		    /* First try without eating a byte */
+		    eng.rstr[eng.off] = eng.str;
+
+		    /* Remember this is the first try if match fail */
+		    eng.re[eng.off] = 0;
+
+		    /* Setup match offsets */
+		    eng.so[eng.off] = eng.str - eng.bas;
+		    eng.eo[eng.off] = eng.so[eng.off] - 1;
+
+		    /* Save start of possible previous matches */
+		    eng.ss[eng.off] = eng.so[bas];
+
+		    /* Skip repetition instruction */
+		    eng.cod += 5;
+		}
+		else {
+		    /* -1 as an unsigned char */
+		    if (eng.cod[2] != 0xff)
+			eng.goff = eng.cod[2];
+		    else
+			eng.goff = -1;
+
+		    if (eng.eo[eng.off] >= eng.so[eng.off]) {
+			/* Something matched */
+
+			if (eng.goff >= 0) {
+			    if (eng.cod[5] == Re_Update)
+				eng.gso[eng.goff] = eng.eo[bas] +
+						    (eng.so[bas] > eng.eo[bas]);
+			    else if (eng.geo[eng.goff] < eng.so[eng.off])
+				eng.geo[eng.goff] = eng.so[eng.off];
+			}
+
+			/* Jump relative offset */
+			len = eng.cod[3] | (eng.cod[4] << 8);
+
+			/* Update offset of match */
+			eng.eo[bas] = eng.eo[eng.off];
+
+			/* Pop stack and skip code */
+			--eng.off;
+			eng.cod += len;
+		    }
+		    else if (eng.re[eng.off] == 0 &&
+			     (!newline || eng.rstr[eng.off][1] != '\n')) {
+			/* Try this time skiping a byte */
+			++eng.re[eng.off];
+
+			/* Reset string, skip code and go try one time more */
+			eng.str = ++eng.rstr[eng.off];
+			eng.cod += 5;
+		    }
+		    else {
+			/* Failed to match */
+
+			/* Update offsets */
+			eng.eo[bas] = eng.ss[eng.off];
+			eng.so[bas] = eng.eo[bas] + 1;
+
+			eng.str = eng.rstr[eng.off] + (eng.re[eng.off] == 0);
+
+			/* Pop stack and return to toplevel code */
+			--eng.off;
+			if (eng.str >= eng.end)
+			    goto wont;
+			eng.cod = eng.rcod[bas];
+		    }
+		}
+		continue;
+
+	    /* .+ almost identical to .* but requires eating at least one byte */
+	    case Re_AnyAtLeast:
+		bas = eng.cod[1];
+		if (eng.off == bas) {
+		    /* First iteration */
+		    if (++eng.off >= MAX_DEPTH)
+			return (RE_ASSERT);
+
+		    /* Return here for recovery if match fail */
+		    eng.rcod[eng.off] = eng.cod;
+
+		    /* Skip one byte for the restart string */
+		    if (newline && eng.str[0] == '\n') {
+			/* Cannot skip newline */
+			eng.cod = eng.rcod[0];
+			eng.rstr[0] = ++eng.str;
+			eng.so[0] = eng.str - eng.bas;
+			eng.eo[0] = eng.so[0] - 1;
+			eng.off = 0;
+			goto reset;
+		    }
+		    eng.rstr[eng.off] = ++eng.str;
+
+		    /* Setup match offsets */
+		    eng.so[eng.off] = eng.str - eng.bas;
+		    eng.eo[eng.off] = eng.so[eng.off] - 1;
+
+		    if (newline)
+			/*  Use the repetition counter to store start of
+			 * skipped string, to later check if skipping a
+			 * newline. */
+			eng.re[eng.off] = eng.so[eng.off];
+
+		    /* Save start of possible previous matches */
+		    eng.ss[eng.off] = eng.so[bas];
+
+		    /* Skip repetition instruction */
+		    eng.cod += 5;
+		}
+		else {
+		    /* -1 as an unsigned char */
+		    if (eng.cod[2] != 0xff)
+			eng.goff = eng.cod[2];
+		    else
+			eng.goff = -1;
+
+		    if (newline) {
+			ptr = eng.bas + eng.re[eng.off];
+			str = eng.bas + eng.so[eng.off];
+			for (; ptr < str; ptr++)
+			    if (*ptr == '\n') {
+				eng.cod = eng.rcod[0];
+				eng.so[0] = ptr - eng.bas + 1;
+				eng.eo[0] = eng.so[0] - 1;
+				eng.rstr[0] = eng.str = ptr + 1;
+				eng.off = 0;
+				goto reset;
+			    }
+			/* If looping, don't do too many noops */
+			eng.re[eng.off] = ptr - eng.bas;
+		    }
+
+		    if (eng.eo[eng.off] >= eng.so[eng.off]) {
+			/* Note that this is only true if all possibly
+			 * nested special repetitions also matched. */
+
+			if (eng.goff >= 0) {
+			    if (eng.cod[5] == Re_Update)
+				eng.gso[eng.goff] = eng.eo[bas] +
+						    (eng.so[bas] > eng.eo[bas]);
+			    else if (eng.geo[eng.goff] < eng.so[eng.off])
+				eng.geo[eng.goff] = eng.so[eng.off];
+			}
+
+			/* Jump relative offset */
+			len = eng.cod[3] | (eng.cod[4] << 8);
+
+			/* Restore offset from where started trying */
+			eng.so[bas] = eng.ss[eng.off];
+			eng.eo[bas] = eng.eo[eng.off];
+
+			/* Pop stack and skip code */
+			--eng.off;
+			eng.cod += len;
+		    }
+		    else {
+			/* Only give up if the entire string was scanned */
+			if (eng.str < eng.end) {
+			    /* Update restart point for next pattern */
+			    eng.str = ++eng.rstr[eng.off];
+
+			    /* Reset start of nested match */
+			    eng.so[eng.off] = eng.str - eng.bas;
+
+			    /* Skip repetition instruction */
+			    eng.cod += 5;
+			}
+			else {
+			    /* Entire string scanned and failed */
+
+			    /* Jump relative offset */
+			    len = eng.cod[3] | (eng.cod[4] << 8);
+
+			    /* Restore offset from where started trying */
+			    eng.so[bas] = eng.ss[eng.off];
+			    eng.eo[bas] = eng.ss[eng.off] - 1;
+
+			    /* Pop stack and skip code */
+			    --eng.off;
+			    eng.cod += len;
+			}
+		    }
+		}
+		continue;
+
+
+	    /****************************************************
+	     * Repetition matched!				*
+	     ****************************************************/
+	    case Re_RepJump:
+		/* eng.cod[1] is toplevel offset of repetition */
+		if (eng.off > eng.cod[1])
+		    /* If still needs to try matches */
+		    eng.cod -= eng.cod[2];
+		else
+		    eng.cod += 3;	/* + RepJump + bas + len-size */
+		continue;
+
+	    case Re_RepLongJump:
+		/* eng.cod[1] is toplevel offset of repetition */
+		if (eng.off > eng.cod[1])
+		    /* If still needs to try matches */
+		    eng.cod -= eng.cod[2] | (eng.cod[3] << 8);
+		else
+		    eng.cod += 4;	/* + RepLongJump + bas + len-size */
+		continue;
+
+	    /****************************************************
+	     * Finished						*
+	     ****************************************************/
+	    case Re_DoneIf:
+		if (eng.eo[eng.off] >= eng.so[eng.off]) {
+		    eng.so[0] = eng.ss[eng.off];
+		    eng.eo[0] = eng.eo[eng.off];
+		    goto done;
+		}
+		++eng.cod;
+		continue;
+	    case Re_MaybeDone:
+		if (eng.eo[eng.off] >= eng.so[eng.off]) {
+		    eng.so[0] = eng.ss[eng.off];
+		    eng.eo[0] = eng.eo[eng.off];
+		    goto done;
+		}
+		++eng.cod;
+		continue;
+	    case Re_Done:
+		goto done;
+
+	    default:
+		/* Fatal internal error */
+		return (RE_ASSERT);
+	}
+
+
+wont:
+	/* Surely won't match */
+	if (eng.off == 0) {
+	    eng.eo[0] = eng.so[0] - 1;
+	    break;
+	}
+
+
+fail:
+	if (eng.off == 0) {
+	    /* If the entire string scanned */
+	    if (++eng.str > eng.end) {
+		eng.eo[0] = eng.so[0] - 1;
+		break;
+	    }
+	    eng.goff = -1;
+	    /* Update start of possible match after restart */
+	    if (eng.eo[0] >= eng.so[0]) {
+		/* If first fail */
+		eng.str = eng.rstr[0];
+		++eng.rstr[0];
+		eng.so[0] = eng.str - eng.bas;
+		eng.eo[0] = eng.so[eng.off] - 1;
+	    }
+	    else
+		/* Just trying at next byte */
+		++eng.so[0];
+	}
+	else
+	    /* Remember this match failed */
+	    eng.eo[eng.off] = eng.so[eng.off] - 1;
+
+	/* Restart code */
+	eng.cod = eng.rcod[eng.off];
+	continue;
+
+
+match:
+	/* If first match */
+	if (eng.eo[eng.off] < eng.so[eng.off]) {
+	    if (eng.off == 0)
+		eng.rstr[0] = eng.str + 1;
+	    eng.so[eng.off] = eng.eo[eng.off] = eng.str - eng.bas;
+	}
+	eng.eo[eng.off] += si;
+	eng.cod += ci;
+	eng.str += si;
+	ci = si = 1;
+	continue;
+
+done:
+	break;
+    }
+
+    if (nmatch) {
+	if (flags & RE_STARTEND)
+	    len = pmat[0].rm_so;
+	else
+	    len = 0;
+	if (!nosub) {
+	    if (preg->cod[1] != 0xff)
+		eng.goff = preg->cod[1];
+	    pmat[0].rm_so = eng.so[0];
+	    pmat[0].rm_eo = eng.eo[0];
+	    for (i = 1; i < nmatch; i++) {
+		if (i - 1 <= eng.goff) {
+		    pmat[i].rm_so = eng.gso[i - 1];
+		    pmat[i].rm_eo = eng.geo[i - 1];
+		}
+		else {
+		    pmat[i].rm_so = 0;
+		    pmat[i].rm_eo = -1;
+		}
+	    }
+	    if (len) {
+		/* Update offsets, since the match was done in a substring */
+		j = eng.goff + 2 > nmatch ? nmatch : eng.goff + 2;
+		for (i = 0; i < j; i++) {
+		    pmat[i].rm_so += len;
+		    pmat[i].rm_eo += len;
+		}
+	    }
+	}
+	else {
+	    /*	Already know these values, allow compiling the regex with
+	     * RE_NOSUB to use parenthesis only for grouping, but avoiding
+	     * the runtime overhead of keeping track of the subexpression
+	     * offsets. */
+	    pmat[0].rm_so = eng.so[0] + len;
+	    pmat[0].rm_eo = eng.eo[0] + len;
+	}
+    }
+
+    return (eng.so[0] <= eng.eo[0] ? 0 : RE_NOMATCH);
+}
+
+int
+reerror(int ecode, const re_cod *preg, char *ebuffer, int ebuffer_size)
+{
+    static char *errors[] = {
+	"No error",
+	"Failed to match",			/* NOMATCH */
+
+	/* Errors not generated */
+	"Invalid regular expression",		/* BADPAT */
+	"Invalid collating element",		/* ECOLLATE */
+	"Invalid character class",		/* ECTYPE */
+
+	"`\' applied to unescapable character",	/* EESCAPE */
+	"Invalid backreference number",		/* ESUBREG */
+	"Brackets `[ ]' not balanced",		/* EBRACK */
+	"Parentheses `( )' not balanced",	/* EPAREN */
+	"Braces `{ }' not balanced",		/* EBRACE */
+	"Invalid repetition count(s) in `{ }'",	/* BADBR */
+	"Invalid character range in `[ ]'",	/* ERANGE */
+	"Out of memory",			/* ESPACE */
+	"`?', `*', or `+' operand invalid",	/* BADRPT */
+	"Empty (sub)expression",		/* EMPTY */
+	"Assertion error - you found a bug",	/* ASSERT */
+	"Invalid argument"			/* INVARG */
+    };
+    char *str;
+
+    if (ecode >= 0 && ecode < sizeof(errors) / sizeof(errors[0]))
+	str = errors[ecode];
+    else
+	str = "Unknown error";
+
+    return (snprintf(ebuffer, ebuffer_size, "%s", str));
+}
+
+void
+refree(re_cod *cod)
+{
+    free(cod->cod);
+    cod->cod = NULL;
+}
+
+static void
+reinit(void)
+{
+    int i;
+    static int first = 1;
+
+    if (!first)
+	return;
+    first = 0;
+
+    re__alnum['_'] = 1;
+
+    for (i = '0'; i <= '7'; i++)
+	re__alnum[i] = re__odigit[i] = re__ddigit[i] = re__xdigit[i] = 1;
+
+    for (; i <= '9'; i++)
+	re__alnum[i] = re__ddigit[i] = re__xdigit[i] = 1;
+
+    for (i = 'a'; i <= 'f'; i++)
+	re__alnum[i] = re__xdigit[i] = 1;
+    for (; i <= 'z'; i++)
+	re__alnum[i] = 1;
+
+    for (i = 'A'; i <= 'F'; i++)
+	re__alnum[i] = re__xdigit[i] = 1;
+    for (; i <= 'Z'; i++)
+	re__alnum[i] = 1;
+
+    for (i = 1; i < 32; i++)
+	re__control[i] = 1;
+    re__control[127] = 1;
+    /* Don't show tabs as control characters */
+    re__control['\t'] = 0;
+}
+
+static int
+rec_check(re_inf *inf, int count)
+{
+    if (inf->len + count >= inf->spc) {
+	int spc;
+	unsigned char *cod;
+
+	if ((spc = (count % 64)) != 0)
+	    spc = 64 - spc;
+	spc += count + inf->spc;
+	if ((cod = realloc(inf->cod, spc)) == NULL)
+	    return (inf->ecode = RE_ESPACE);
+	inf->cod = cod;
+	inf->spc = spc;
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_code(re_inf *inf, ReCode code)
+{
+    if (rec_check(inf, 1) == 0)
+	inf->cod[inf->len++] = code;
+
+    return (inf->ecode);
+}
+
+static int
+rec_byte(re_inf *inf, int value)
+{
+    if (rec_check(inf, 1) == 0)
+	inf->cod[inf->len++] = value;
+
+    return (inf->ecode);
+}
+
+static int
+rec_code_byte(re_inf *inf, ReCode code, int value)
+{
+    if (rec_check(inf, 2) == 0) {
+	inf->cod[inf->len++] = code;
+	inf->cod[inf->len++] = value;
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_length(re_inf *inf, int length)
+{
+    int lo, hi, two;
+
+    if (length >= 16384)
+	return (inf->ecode = RE_ESPACE);
+
+    lo = length & 0xff;
+    hi = length & 0xff00;
+    two = ((length > 0x7f) != 0) + 1;
+    if (two == 2) {
+	hi <<= 1;
+	hi |= (lo & 0x80) != 0;
+	lo |= 0x80;
+    }
+
+    if (rec_check(inf, two) == 0) {
+	inf->cod[inf->len++] = lo;
+	if (two == 2)
+	    inf->cod[inf->len++] = hi >> 8;
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_byte_byte(re_inf *inf, int value0, int value1)
+{
+    if (rec_check(inf, 2) == 0) {
+	inf->cod[inf->len++] = value0;
+	inf->cod[inf->len++] = value1;
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_code_byte_byte(re_inf *inf, ReCode code, int value0, int value1)
+{
+    if (rec_check(inf, 3) == 0) {
+	inf->cod[inf->len++] = code;
+	inf->cod[inf->len++] = value0;
+	inf->cod[inf->len++] = value1;
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_build_alt(re_inf *inf, rec_alt *alt)
+{
+    int offset, value, bas = inf->bas + 1;
+
+    if (alt) {
+	if (alt->next) {
+	    if (rec_inc_spc(inf))
+		return (inf->ecode);
+
+	    /* A real a list of alternatives */
+	    rec_code(inf, Re_Alt);
+
+	    offset = inf->len;		/* Remember current offset */
+	    rec_byte_byte(inf, 0, 0);	/* Reserve two bytes for retry address */
+	    while (alt && inf->ecode == 0) {
+		if (rec_build_pat(inf, alt->pat))
+		    break;
+		alt = alt->next;
+		if (alt && inf->ecode == 0) {
+		    /* Handle (hyper)complex repetitions */
+		    if (inf->bas != bas) {
+			/* Duplicate patterns up to end of expression */
+			rec_build_pat(inf, inf->apat);
+			/* Restore engine state for next alternative(s) */
+			rec_alt_spc(inf, bas - 1);
+		    }
+
+		    /* If the jump would be so long */
+		    if ((value = inf->len - offset) >= 16384) {
+			inf->ecode = RE_ESPACE;
+			break;
+		    }
+		    inf->cod[offset] = value & 0xff;
+		    inf->cod[offset + 1] = (value & 0xff00) >> 8;
+
+		    rec_code(inf, Re_AltNext);
+		    offset = inf->len;
+		    rec_byte_byte(inf, 0, 0);
+		}
+	    }
+	    if (inf->ecode == 0) {
+		/* Handle (hyper)complex repetitions */
+		if (inf->bas != bas) {
+		    /* Duplicate patterns up to end of expression */
+		    rec_build_pat(inf, inf->apat);
+		    /* Restore engine state for next alternative(s) */
+		    rec_alt_spc(inf, bas - 1);
+		}
+
+		/* If the jump would be so long */
+		if ((value = inf->len - offset) >= 16384)
+		    return (inf->ecode = RE_ESPACE);
+		inf->cod[offset] = value & 0xff;
+		inf->cod[offset + 1] = (value & 0xff00) >> 8;
+		/* Last jump is here */
+		rec_code(inf, Re_AltDone);
+	    }
+	    rec_dec_spc(inf);
+	}
+	else
+	    /* Single alternative */
+	    rec_build_pat(inf, alt->pat);
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_build_pat(re_inf *inf, rec_pat *pat)
+{
+    rec_pat *apat;
+    int length, offset = 0, distance, jump = 0, bas = 0;
+
+    while (pat && inf->ecode == 0) {
+	if (pat->rep) {
+	    bas = inf->bas;
+	    if (pat->type == Rep_Group && !inf->par && rec_code(inf, Re_Open))
+		return (inf->ecode);
+	    if (rec_inc_spc(inf))
+		return (inf->ecode);
+	    offset = inf->len;
+	    if (rec_build_rep(inf, pat->rep))
+		break;
+	    /* Reserve space to jump after repetition done */
+	    jump = inf->len;
+	    rec_byte_byte(inf, 0, 0);
+	}
+	switch (pat->type) {
+	    case Rep_AnyAnyTimes:
+	    case Rep_AnyMaybe:
+	    case Rep_AnyAtLeast:
+		if (rec_add_spc(inf, pat->type == Rep_AnyMaybe))
+		    return (inf->ecode);
+		if (rec_code(inf, (ReCode)pat->type) == 0 &&
+		    rec_byte(inf, inf->bas - 1) == 0 &&
+		    rec_byte(inf, inf->ref - 1) == 0)
+		    rec_off_spc(inf);
+		break;
+	    case Rep_Literal:
+	    case Rep_LiteralNot:
+	    case Rep_SearchLiteral:
+		rec_code_byte(inf, (ReCode)pat->type, pat->data.chr);
+		break;
+	    case Rep_CaseLiteral:
+	    case Rep_CaseLiteralNot:
+	    case Rep_SearchCaseLiteral:
+		rec_code_byte_byte(inf, (ReCode)pat->type,
+				   pat->data.cse.lower, pat->data.cse.upper);
+		break;
+	    case Rep_Range:
+	    case Rep_RangeNot:
+		if (rec_code(inf, (ReCode)pat->type) == 0)
+		    rec_build_rng(inf, pat->data.rng);
+		break;
+	    case Rep_String:
+	    case Rep_SearchString:
+	    case Rep_CaseString:
+	    case Rep_SearchCaseString:
+		rec_code(inf, (ReCode)pat->type);
+		length = strlen((char*)pat->data.str);
+		if (rec_length(inf, length) == 0 && rec_check(inf, length) == 0) {
+		    memcpy(inf->cod + inf->len, pat->data.str, length);
+		    inf->len += length;
+		}
+		break;
+	    case Rep_Any:
+	    case Rep_AnyEatAnyTimes:
+	    case Rep_AnyEatMaybe:
+	    case Rep_AnyEatAtLeast:
+	    case Rep_Odigit:
+	    case Rep_OdigitNot:
+	    case Rep_Digit:
+	    case Rep_DigitNot:
+	    case Rep_Xdigit:
+	    case Rep_XdigitNot:
+	    case Rep_Space:
+	    case Rep_SpaceNot:
+	    case Rep_Tab:
+	    case Rep_Newline:
+	    case Rep_Lower:
+	    case Rep_Upper:
+	    case Rep_Alnum:
+	    case Rep_AlnumNot:
+	    case Rep_Control:
+	    case Rep_ControlNot:
+	    case Rep_Bol:
+	    case Rep_Eol:
+	    case Rep_Bow:
+	    case Rep_Eow:
+		rec_code(inf, (ReCode)pat->type);
+		break;
+	    case Rep_Backref:
+		rec_code_byte(inf, Re_Backref, pat->data.chr);
+		break;
+	    case Rep_Group:
+		if (pat->rep == NULL && !inf->par && rec_code(inf, Re_Open))
+		    break;
+		apat = inf->apat;
+		inf->apat = pat->next;
+		rec_build_grp(inf, pat->data.grp);
+		inf->apat = apat;
+		break;
+	    case Rep_StringList:
+		rec_build_stl(inf, pat->data.stl);
+		break;
+	}
+	if (pat->rep) {
+#if 0
+	    if (rec_dec_spc(inf))
+		return (inf->ecode);
+#else
+	    if (rec_rep_spc(inf, bas))
+		return (inf->ecode);
+#endif
+	    distance = inf->len - offset;
+	    if (distance > 255) {
+		if (rec_code(inf, Re_RepLongJump) ||
+		    rec_byte(inf, inf->bas) ||
+		    rec_byte(inf, distance & 0xff) ||
+		    rec_byte(inf, (distance & 0xff00) >> 8))
+		break;
+	    }
+	    else if (rec_code(inf, Re_RepJump) ||
+		     rec_byte(inf, inf->bas) ||
+		     rec_byte(inf, distance))
+		break;
+	    distance = inf->len - offset;
+	    inf->cod[jump] = distance & 0xff;
+	    inf->cod[jump + 1] = (distance & 0xff00) >> 8;
+	}
+	pat = pat->next;
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_build_rng(re_inf *inf, rec_rng *rng)
+{
+    if (rec_check(inf, sizeof(rng->range)) == 0) {
+	memcpy(inf->cod + inf->len, rng->range, sizeof(rng->range));
+	inf->len += sizeof(rng->range);
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_build_grp(re_inf *inf, rec_grp *grp)
+{
+    int par = inf->par;
+
+    if (!(inf->flags & RE_NOSUB)) {
+	++inf->par;
+	if (par == 0)
+	    ++inf->ref;
+	if (rec_build_alt(inf, grp->alt) == 0) {
+	    if (par == 0) {
+		if (grp->comp)
+		    rec_code_byte(inf, Re_Update, inf->ref - 1);
+		else
+		    rec_code(inf, Re_Close);
+	    }
+	}
+	--inf->par;
+    }
+    else
+	rec_build_alt(inf, grp->alt);
+
+    return (inf->ecode);
+}
+
+static int
+rec_build_stl(re_inf *inf, rec_stl *stl)
+{
+    int i, len, rlen;
+    ReCode code;
+
+    /* Calculate jump distance information */
+    rlen = stl->tlen + stl->nstrs + 4;
+    /* + code + nstrs + place-offset + data-length */
+
+    if (stl->nstrs >= LARGE_STL_COUNT) {
+	rlen += 511;		/* Don't write number of strings */
+	code = stl->type == Rep_StringList ?
+		Re_LargeStringList : Re_LargeCaseStringList;
+    }
+    else
+	code = (ReCode)stl->type;
+
+    if (rlen >= 16386)
+	return (inf->ecode = RE_ESPACE);
+    if (rec_check(inf, rlen) ||
+	rec_code(inf, code))
+	return (inf->ecode);
+
+    /* Space is allocated, just write the data */
+    if (stl->nstrs < LARGE_STL_COUNT)
+	inf->cod[inf->len++] = stl->nstrs;
+
+    inf->cod[inf->len++] = rlen & 0xff;
+    inf->cod[inf->len++] = (rlen & 0xff00) >> 8;
+
+    if (stl->nstrs < LARGE_STL_COUNT) {
+	for (i = 0; i < stl->nstrs; i++)
+	    inf->cod[inf->len++] = stl->lens[i];
+	for (i = 0; i < stl->nstrs; i++) {
+	    len = stl->lens[i];
+	    if (len > 2) {
+		memcpy(inf->cod + inf->len, stl->strs[i], len);
+		inf->len += len;
+	    }
+	    else {
+		if (len == 1)
+		    inf->cod[inf->len++] = (long)stl->strs[i];
+		else {
+		    inf->cod[inf->len++] = (long)stl->strs[i] & 0xff;
+		    inf->cod[inf->len++] = ((long)stl->strs[i] & 0xff00) >> 8;
+		}
+	    }
+	}
+    }
+    else {
+	/* The string length goes before the string itself */
+	int j, chl, chu;
+
+	/* Fill everything with an invalid jump address */
+	memset(inf->cod + inf->len, 0xff, 512);
+	for (i = len = 0, j = -1; i < stl->nstrs; i++) {
+	    chl = stl->lens[i] > 2 ? stl->strs[i][0] : (long)stl->strs[i] & 0xff;
+	    if (chl != j) {
+		inf->cod[inf->len + (chl << 1)] = len & 0xff;
+		inf->cod[inf->len + (chl << 1) + 1] = (len & 0xff00) >> 8;
+		if (code == Re_LargeCaseStringList) {
+		    chu = stl->lens[i] > 2 ?
+			stl->strs[i][1] : ((long)(stl->strs[i]) & 0xff00) >> 8;
+		    inf->cod[inf->len + (chu << 1)] = len & 0xff;
+		    inf->cod[inf->len + (chu << 1) + 1] = (len & 0xff00) >> 8;
+		}
+		j = chl;
+	    }
+	    len += stl->lens[i] + 1;
+	}
+	inf->len += 512;
+
+	for (i = 0; i < stl->nstrs; i++) {
+	    len = stl->lens[i];
+	    inf->cod[inf->len++] = len;
+	    if (len > 2) {
+		memcpy(inf->cod + inf->len, stl->strs[i], len);
+		inf->len += len;
+	    }
+	    else {
+		if (len == 1)
+		    inf->cod[inf->len++] = (long)stl->strs[i];
+		else {
+		    inf->cod[inf->len++] = (long)stl->strs[i] & 0xff;
+		    inf->cod[inf->len++] = ((long)stl->strs[i] & 0xff00) >> 8;
+		}
+	    }
+	}
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_build_rep(re_inf *inf, rec_rep *rep)
+{
+    if (rep) {
+	switch (rep->type) {
+	    case Rer_AnyTimes:
+	    case Rer_AtLeast:
+	    case Rer_Maybe:
+		rec_code(inf, (ReCode)rep->type);
+		break;
+	    case Rer_Exact:
+		if (rec_code(inf, Re_Exact) == 0)
+		    rec_byte(inf, rep->mine);
+		break;
+	    case Rer_Min:
+		if (rec_code(inf, Re_Min) == 0)
+		    rec_byte(inf, rep->mine);
+		break;
+	    case Rer_Max:
+		if (rec_code(inf, Re_Max) == 0)
+		    rec_byte(inf, rep->maxc);
+		break;
+	    case Rer_MinMax:
+		if (rec_code(inf, Re_MinMax) == 0 &&
+		    rec_byte(inf, rep->mine) == 0)
+		    rec_byte(inf, rep->maxc);
+		break;
+	}
+	/* It is incremented in rec_build_pat */
+	rec_byte(inf, inf->bas - 1);
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_inc_spc(re_inf *inf)
+{
+    if (++inf->bas >= MAX_DEPTH)
+	return (inf->ecode = RE_ESPACE);
+
+    return (inf->ecode);
+}
+
+static int
+rec_dec_spc(re_inf *inf)
+{
+    if (--inf->bas < 0)
+	return (inf->ecode = RE_ASSERT);
+
+    return (inf->ecode);
+}
+
+static int
+rec_add_spc(re_inf *inf, int maybe)
+{
+    if (++inf->bas >= MAX_DEPTH)
+	return (inf->ecode = RE_ESPACE);
+    inf->sp[inf->bas] = maybe + 1;
+
+    return (inf->ecode);
+}
+
+/* Could be joined with rec_rep_spc, code almost identical */
+static int
+rec_alt_spc(re_inf *inf, int top)
+{
+    int distance, i, bas = inf->bas;
+
+    while ((inf->bas > top) && inf->sp[inf->bas]) {
+	/* Jump to this repetition for cleanup */
+	distance = inf->len - inf->sr[inf->bas];
+
+	/* This will generate a jump to a jump decision opcode */
+	inf->sj[inf->bas] = inf->len;
+
+	if (distance > 255) {
+	    if (rec_code(inf, Re_RepLongJump) ||
+		rec_byte(inf, inf->bas - 1) ||
+		rec_byte(inf, distance & 0xff) ||
+		rec_byte(inf, (distance & 0xff00) >> 8))
+	    break;
+	}
+	else if (rec_code(inf, Re_RepJump) ||
+		 rec_byte(inf, inf->bas - 1) ||
+		 rec_byte(inf, distance))
+ 	    break;
+
+	/* Top of stack value before repetition, or end condition value */
+	--inf->bas;
+    }
+
+    i = inf->bas + 1;
+
+    if (inf->ecode == 0 && i <= bas && inf->sp[i]) {
+	/*  Only the repetition at the bottom jump to code after testing
+	 * all possibilities */
+	distance = inf->len - inf->sr[i];
+	inf->cod[inf->sr[i] + 3] = distance & 0xff;
+	inf->cod[inf->sr[i] + 4] = (distance & 0xff00) >> 8;
+
+	/* The bottom jump is here */
+	if (rec_code(inf, inf->sp[i] == 1 ? Re_DoneIf : Re_MaybeDone))
+	   return (inf->ecode);
+
+	/*  Generate jumps to the previous special repetition */
+	for (++i; i <= bas; i++) {
+	    if (inf->sp[i]) {
+		distance = inf->sj[i] - inf->sr[i];
+		inf->cod[inf->sr[i] + 3] = distance & 0xff;
+		inf->cod[inf->sr[i] + 4] = (distance & 0xff00) >> 8;
+	    }
+	}
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_rep_spc(re_inf *inf, int top)
+{
+    int distance, i, bas = inf->bas;
+
+    while (inf->bas > top) {
+	if (inf->sp[inf->bas]) {
+	    /* Jump to this repetition for cleanup */
+	    distance = inf->len - inf->sr[inf->bas];
+
+	    /* This will generate a jump to a jump decision opcode */
+	    inf->sj[inf->bas] = inf->len;
+
+	    if (distance > 255) {
+		if (rec_code(inf, Re_RepLongJump) ||
+		    rec_byte(inf, inf->bas - 1) ||
+		    rec_byte(inf, distance & 0xff) ||
+		    rec_byte(inf, (distance & 0xff00) >> 8))
+		break;
+	    }
+	    else if (rec_code(inf, Re_RepJump) ||
+		     rec_byte(inf, inf->bas - 1) ||
+		     rec_byte(inf, distance))
+		break;
+	}
+
+	/* Top of stack value before repetition, or end condition value */
+	--inf->bas;
+    }
+
+    /* Find first special repetition offset. XXX This should be a noop */
+    for (i = 0; i < bas; i++)
+	if (inf->sp[i])
+	    break;
+
+    if (inf->ecode == 0 && i <= bas && inf->sp[i]) {
+	/*  Only the repetition at the bottom jump to code after testing
+	 * all possibilities */
+	distance = inf->len - inf->sr[i];
+	inf->cod[inf->sr[i] + 3] = distance & 0xff;
+	inf->cod[inf->sr[i] + 4] = (distance & 0xff00) >> 8;
+
+	/*  Generate jumps to the previous special repetition */
+	for (++i; i <= bas; i++) {
+	    if (inf->sp[i]) {
+		distance = inf->sj[i] - inf->sr[i];
+		inf->cod[inf->sr[i] + 3] = distance & 0xff;
+		inf->cod[inf->sr[i] + 4] = (distance & 0xff00) >> 8;
+	    }
+	}
+    }
+
+    return (inf->ecode);
+}
+
+static int
+rec_off_spc(re_inf *inf)
+{
+    /* The jump address before the three bytes instruction */
+    inf->sr[inf->bas] = inf->len - 3;
+    /*  Don't know yet where to go after done with the special
+     * repetition, just reserve two bytes for the jump address. */
+    return (rec_byte_byte(inf, 0, 0));
+}
+
+#ifdef DEBUG
+static void
+redump(re_cod *code)
+{
+    int i, j, k;
+    unsigned char *cod = code->cod, *stl;
+
+    if (cod[0] & RE_NOSUB)
+	printf("Nosub\n");
+    if (cod[0] & RE_NEWLINE)
+	printf("Newline\n");
+    ++cod;
+    if (cod[0] != 0xff)
+	printf("%d backrefs\n", cod[0] + 1);
+    ++cod;
+    for (;;) {
+	switch (*cod++) {
+	    case Re_Open:
+		printf("Open");
+		break;
+	    case Re_Close:
+		printf("Close");
+		break;
+	    case Re_Update:
+		printf("Update (%d)", (int)*cod++);
+		break;
+	    case Re_Alt:
+		printf("Alt");
+		i = cod[0] | cod[1];
+		cod += 2;
+		printf(" %d", i);
+		break;
+	    case Re_AltNext:
+		printf("Alt-next");
+		i = cod[0] | cod[1];
+		cod += 2;
+		printf(" %d", i);
+		break;
+	    case Re_AltDone:
+		printf("Alt-done");
+		break;
+	    case Re_AnyTimes:
+		printf("-> Anytimes %d", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_AnyEatAnyTimes:
+		printf("Any-eat-anytimes");
+		break;
+	    case Re_AnyAnyTimes:
+		printf("-> Any-anytimes %d", (int)*cod++);
+		printf(" (%d)", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_AnyEatMaybe:
+		printf("Any-eat-maybe");
+		break;
+	    case Re_AnyMaybe:
+		printf("-> Any-maybe %d", (int)*cod++);
+		printf(" (%d)", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_AnyAtLeast:
+		printf("-> Any-atleast %d", (int)*cod++);
+		printf(" (%d)", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_AnyEatAtLeast:
+		printf("Any-eat-atleast");
+		break;
+	    case Re_Maybe:
+		printf("-> Maybe %d", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_AtLeast:
+		printf("-> Atleast %d", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_Exact:
+		printf("-> Exact ");
+		i = *cod++;
+		printf("%d", i);
+		printf(" %d", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_Min:
+		printf("-> Min ");
+		i = *cod++;
+		printf("%d", i);
+		printf(" %d", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_Max:
+		printf("-> Max ");
+		i = *cod++;
+		printf("%d", i);
+		printf(" %d", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_MinMax:
+		printf("-> Min-max ");
+		i = *cod++;
+		printf("%d ", i);
+		i = *cod++;
+		printf("%d", i);
+		printf(" %d", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		cod += 2;
+		printf(" /%d", i);
+		break;
+	    case Re_RepJump:
+		printf("<- Rep-jump %d ", (int)*cod++);
+		i = *cod++;
+		printf("%d", i);
+		break;
+	    case Re_RepLongJump:
+		printf("<- Rep-long-jump %d ", (int)*cod++);
+		i = cod[0] | (cod[1] << 8);
+		printf("%d", i);
+		break;
+	    case Re_Any:
+		printf("Any");
+		break;
+	    case Re_Odigit:
+		printf("Odigit");
+		break;
+	    case Re_OdigitNot:
+		printf("Odigit-not");
+		break;
+	    case Re_Digit:
+		printf("Digit");
+		break;
+	    case Re_DigitNot:
+		printf("Digit-not");
+		break;
+	    case Re_Xdigit:
+		printf("Xdigit");
+		break;
+	    case Re_XdigitNot:
+		printf("Xdigit-not");
+		break;
+	    case Re_Space:
+		printf("Space");
+		break;
+	    case Re_SpaceNot:
+		printf("Space-not");
+		break;
+	    case Re_Tab:
+		printf("Tab");
+		break;
+	    case Re_Newline:
+		printf("Newline");
+		break;
+	    case Re_Lower:
+		printf("Lower");
+		break;
+	    case Re_Upper:
+		printf("Upper");
+		break;
+	    case Re_Alnum:
+		printf("Alnum");
+		break;
+	    case Re_AlnumNot:
+		printf("Alnum-not");
+		break;
+	    case Re_Control:
+		printf("Control");
+		break;
+	    case Re_ControlNot:
+		printf("Control-not");
+		break;
+	    case Re_Bol:
+		printf("Bol");
+		break;
+	    case Re_Eol:
+		printf("Eol");
+		break;
+	    case Re_Bow:
+		printf("Bow");
+		break;
+	    case Re_Eow:
+		printf("Eow");
+		break;
+	    case Re_Range:
+		printf("Range ");
+		goto range;
+	    case Re_RangeNot:
+		printf("Range-not ");
+range:
+		for (i = 0; i < 256; i += 32) {
+		    for (j = k = 0; j < 32; j++)
+			k |= (*cod++ & 1) << (31 - j);
+		    printf("%x ", k);
+		}
+		break;
+	    case Re_Literal:
+		printf("Literal %c", *cod++);
+		break;
+	    case Re_LiteralNot:
+		printf("Literal-not %c", *cod++);
+		break;
+	    case Re_SearchLiteral:
+		printf("Search-literal %c", *cod++);
+		break;
+	    case Re_CaseLiteral:
+		printf("Case-literal %c", *cod++);
+		putchar(*cod++);
+		break;
+	    case Re_CaseLiteralNot:
+		printf("Case-literal-not %c", *cod++);
+		putchar(*cod++);
+		break;
+	    case Re_SearchCaseLiteral:
+		printf("Search-case-literal %c", *cod++);
+		putchar(*cod++);
+		break;
+	    case Re_String:
+		printf("String ");
+		goto string;
+	    case Re_SearchString:
+		printf("Search-string ");
+		goto string;
+	    case Re_CaseString:
+		printf("Case-string ");
+		goto string;
+	    case Re_SearchCaseString:
+		printf("Search-case-string ");
+string:
+		i = *cod++;
+		if (i & 0x80)
+		    i = (i & 0x7f) | (*cod++ << 7);
+		for (j = 0; j < i; j++)
+		    putchar(*cod++);
+		break;
+	    case Re_StringList:
+		printf("String-list");
+		goto string_list;
+	    case Re_CaseStringList:
+		printf("Case-string-list");
+string_list:
+		j = *cod++;
+		cod += 2;
+		stl = cod + j;
+		for (i = 0; i < j; i++) {
+		    k = *cod++;
+		    putchar(i ? ',' : ' ');
+		    fwrite(stl, k, 1, stdout);
+		    stl += k;
+		}
+		cod = stl;
+		break;
+	    case Re_LargeStringList:
+		printf("Large-string-list");
+large_string_list:
+		i = cod[0] | (cod[1] << 8);
+		stl = cod + i - 1;
+		for (i = 0, cod += 514; cod < stl; i++) {
+		    k = *cod++;
+		    putchar(i ? ',' : ' ');
+		    fwrite(cod, k, 1, stdout);
+		    cod += k;
+		}
+		cod = stl;
+		break;
+	    case Re_LargeCaseStringList:
+		printf("Large-case-string-list");
+		goto large_string_list;
+	    case Re_Backref:
+		printf("Backref %d", (int)*cod++);
+		break;
+	    case Re_DoneIf:
+		printf("Done-if");
+		break;
+	    case Re_MaybeDone:
+		printf("Maybe-done");
+		break;
+	    case Re_Done:
+		printf("Done\n");
+		return;
+	}
+	putchar('\n');
+    }
+}
+#endif
diff --git a/lisp/re/re.h b/lisp/re/re.h
new file mode 100644
index 0000000..332366e
--- /dev/null
+++ b/lisp/re/re.h
@@ -0,0 +1,123 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/re/re.h,v 1.2 2002/09/23 01:25:41 paulo Exp $ */
+
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+
+#ifndef _re_h
+#define _re_h
+
+/*
+ * Defines
+ */
+
+	/* Compile flags options */
+#define REG_BASIC		0000	/* Not used */
+#define REG_EXTENDED		0001	/* Not used, only extended supported */
+
+#define RE_ICASE		0002
+#define RE_NOSUB		0004
+#define RE_NEWLINE		0010
+#define RE_NOSPEC		0020
+#define RE_PEND			0040
+#define RE_DUMP			0200
+
+
+
+	/* Execute flag options */
+#define RE_NOTBOL		1
+#define RE_NOTEOL		2
+#define RE_STARTEND		4
+#define RE_TRACE		00400	/* Not used/supported */
+#define RE_LARGE		01000	/* Not used/supported */
+#define RE_BACKR		02000	/* Not used/supported */
+
+	/* Value returned by reexec when match fails */
+#define RE_NOMATCH		1
+	/* Compile error values */
+#define RE_BADPAT		2
+#define RE_ECOLLATE		3
+#define RE_ECTYPE		4
+#define RE_EESCAPE		5
+#define RE_ESUBREG		6
+#define RE_EBRACK		7
+#define RE_EPAREN		8
+#define RE_EBRACE		9
+#define RE_EBADBR		10
+#define RE_ERANGE		11
+#define RE_ESPACE		12
+#define RE_BADRPT		13
+#define RE_EMPTY		14
+#define RE_ASSERT		15
+#define RE_INVARG		16
+#define RE_ATOI			255	/* Not used/supported */
+#define RE_ITOA			0400	/* Not used/supported */
+
+
+/*
+ * Types
+ */
+
+/* (re)gular expression (mat)ch result */
+typedef struct _re_mat {
+    long rm_so;
+    long rm_eo;
+} re_mat;
+
+/* (re)gular expression (cod)e */
+typedef struct _re_cod {
+    unsigned char *cod;
+    int re_nsub;		/* Public member */
+    const char *re_endp;	/* Support for RE_PEND */
+} re_cod;
+
+
+/*
+ * Prototypes
+ */
+	/* compile the given pattern string
+	 * returns 0 on success, error code otherwise */
+int recomp(re_cod *preg, const char *pattern, int flags);
+
+	/* execute the compiled pattern on the string.
+	 * returns 0 if matched, RE_NOMATCH if failed, error code otherwise */
+int reexec(const re_cod *preg, const char *string,
+	   int nmat, re_mat pmat[], int flags);
+
+	/* formats an error message for the given code in ebuffer */
+int reerror(int ecode, const re_cod *preg, char *ebuffer, int ebuffer_size);
+
+	/* frees the given parameter */
+void refree(re_cod *preg);
+
+
+#endif /* _re_h */
diff --git a/lisp/re/rec.c b/lisp/re/rec.c
new file mode 100644
index 0000000..20f9fd9
--- /dev/null
+++ b/lisp/re/rec.c
@@ -0,0 +1,1015 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/re/rec.c,v 1.4 2003/01/16 06:25:52 paulo Exp $ */
+
+#include "rep.h"
+
+/*
+ * Types
+ */
+
+/*  Information used while compiling the intermediate format of the re. */
+typedef struct _irec_info {
+    unsigned char *ptr;		/* Pointer in the given regex pattern */
+    unsigned char *end;		/* End of regex pattern */
+    int flags;			/* Compile flags */
+    rec_alt *alt;		/* Toplevel first/single alternative */
+
+    rec_alt *palt;		/* Current alternative being compiled */
+    rec_grp *pgrp;		/* Current group, if any */
+    rec_pat *ppat;		/* Current pattern, if any */
+
+    /*  Number of open parenthesis, for error checking */
+    int nparens;
+
+    int ngrps;			/* Number of groups, for backreference */
+
+    int ecode;
+} irec_info;
+
+
+/*
+ * Prototypes
+ */
+
+	/* (i)ntermediate (r)egular (e)xpression (c)ompile
+	 *  Generates an intermediate stage compiled regex from
+	 * the specified pattern argument. Basically builds an
+	 * intermediate data structure to analyse and do syntax
+	 * error checking.
+	 */
+static void irec_simple_pattern(irec_info*, rec_pat_t);
+static void irec_literal_pattern(irec_info*, int);
+static void irec_case_literal_pattern(irec_info*, int);
+static void irec_open_group(irec_info*);
+static void irec_close_group(irec_info*);
+static void irec_range(irec_info*);
+static void irec_range_single(irec_info*, int);
+static void irec_range_complex(irec_info*, int, int);
+static void irec_escape(irec_info*);
+static void irec_simple_repetition(irec_info*, rec_rep_t);
+static void irec_complex_repetition(irec_info*);
+static void irec_add_repetition(irec_info*, rec_rep*);
+static void irec_free(irec_info*);
+static void irec_free_grp(rec_grp*);
+static void irec_free_pats(rec_pat*);
+
+
+/*
+ * Implementation
+ */
+rec_alt *
+irec_comp(const char *pattern, const char *endp, int flags, int *ecode)
+{
+    unsigned char *ptr;
+    rec_alt *alt;
+    irec_info inf;
+
+    if (pattern == NULL || endp < pattern) {
+	*ecode = RE_INVARG;
+	return (NULL);
+    }
+
+    if (endp == pattern) {
+	*ecode = RE_EMPTY;
+	return (NULL);
+    }
+
+    alt = calloc(1, sizeof(rec_alt));
+    if (alt == NULL) {
+	*ecode = RE_ESPACE;
+	return (NULL);
+    }
+
+    inf.ptr = (unsigned char*)pattern;
+    inf.end = (unsigned char*)endp;
+    inf.flags = flags;
+    inf.alt = inf.palt = alt;
+    inf.pgrp = NULL;
+    inf.ppat = NULL;
+    inf.nparens = inf.ngrps = 0;
+    inf.ecode = 0;
+
+    if (flags & RE_NOSPEC) {
+	/* Just searching for a character or substring */
+	for (; inf.ecode == 0 && inf.ptr < inf.end; inf.ptr++) {
+	    if (!(flags & RE_ICASE) ||
+		(!isupper(*inf.ptr) && !islower(*inf.ptr)))
+		irec_literal_pattern(&inf, *inf.ptr);
+	    else
+		irec_case_literal_pattern(&inf, *inf.ptr);
+	}
+    }
+    /* inf.ptr = inf.end is nul if flags & RE_NOSPEC */
+    for (; inf.ecode == 0 && inf.ptr < inf.end;) {
+	switch (*inf.ptr++) {
+	    case '*':
+		irec_simple_repetition(&inf, Rer_AnyTimes);
+		break;
+	    case '+':
+		irec_simple_repetition(&inf, Rer_AtLeast);
+		break;
+	    case '?':
+		irec_simple_repetition(&inf, Rer_Maybe);
+		break;
+	    case '.':
+		irec_simple_pattern(&inf, Rep_Any);
+		break;
+	    case '^':
+		if (flags & RE_NEWLINE)
+		    /* It is up to the user decide if this can match */
+		    irec_simple_pattern(&inf, Rep_Bol);
+		else {
+		    for (ptr = inf.ptr - 1;
+			 ptr > (unsigned char*)pattern && *ptr == '('; ptr--)
+			;
+		    /* If at the start of a pattern */
+		    if (ptr == (unsigned char*)pattern || *ptr == '|')
+			irec_simple_pattern(&inf, Rep_Bol);
+		    else
+			/* In the middle of a pattern, treat as literal */
+			irec_literal_pattern(&inf, '^');
+		}
+		break;
+	    case '$':
+		if (flags & RE_NEWLINE)
+		    irec_simple_pattern(&inf, Rep_Eol);
+		else {
+		    /* Look ahead to check if is the last char of a group */
+		    for (ptr = inf.ptr; ptr < inf.end && *ptr == ')'; ptr++)
+			;
+		    if (*ptr == '\0' || *ptr == '|')
+			/* Last character of pattern, an EOL match */
+			irec_simple_pattern(&inf, Rep_Eol);
+		    else
+			/* Normal character */
+			irec_literal_pattern(&inf, '$');
+		}
+		break;
+	    case '(':
+		irec_open_group(&inf);
+		break;
+	    case ')':
+		/* Look ahead to check if need to close the group now */
+		ptr = inf.ptr;
+		if (*ptr != '*' && *ptr != '+' && *ptr != '?' && *ptr != '{')
+		    /* If a repetition does not follow */
+		    irec_close_group(&inf);
+		else if (inf.pgrp == NULL)
+		    /* A repetition follows, but current group is implicit */
+		    inf.ecode = RE_EPAREN;
+		else
+		    /* Can do this as next character is known */
+		    inf.ppat = NULL;
+		break;
+	    case '[':
+		irec_range(&inf);
+		break;
+	    case ']':
+		irec_literal_pattern(&inf, ']');
+		break;
+	    case '{':
+		irec_complex_repetition(&inf);
+		break;
+	    case '}':
+		irec_literal_pattern(&inf, '}');
+		break;
+	    case '|':
+		    /* If first character in the pattern */
+		if (inf.ptr - 1 == (unsigned char*)pattern ||
+		    /* If last character in the pattern */
+		    inf.ptr >= inf.end ||
+		    /* If empty pattern */
+		    inf.ptr[0] == '|' ||
+		    inf.ptr[0] == ')')
+		    inf.ecode = RE_EMPTY;
+		else {
+		    rec_alt *alt = calloc(1, sizeof(rec_alt));
+
+		    if (alt) {
+			alt->prev = inf.palt;
+			inf.palt->next = alt;
+			inf.palt = alt;
+			inf.ppat = NULL;
+		    }
+		    else
+			inf.ecode = RE_ESPACE;
+		}
+		break;
+	    case '\\':
+		irec_escape(&inf);
+		break;
+	    default:
+		if (!(flags & RE_ICASE) ||
+		    (!isupper(inf.ptr[-1]) && !islower(inf.ptr[-1])))
+		    irec_literal_pattern(&inf, inf.ptr[-1]);
+		else
+		    irec_case_literal_pattern(&inf, inf.ptr[-1]);
+		break;
+	}
+    }
+
+    /* Check if not all groups closed */
+    if (inf.ecode == 0 && inf.nparens)
+	inf.ecode = RE_EPAREN;
+
+    if (inf.ecode == 0)
+	inf.ecode = orec_comp(inf.alt, flags);
+
+    /* If an error generated */
+    if (inf.ecode) {
+	irec_free(&inf);
+	alt = NULL;
+    }
+
+    *ecode = inf.ecode;
+
+    return (alt);
+}
+
+void
+irec_free_alt(rec_alt *alt)
+{
+    rec_alt *next;
+
+    while (alt) {
+	next = alt->next;
+	irec_free_pats(alt->pat);
+	free(alt);
+	alt = next;
+    }
+}
+
+
+
+static void
+irec_simple_pattern(irec_info *inf, rec_pat_t type)
+{
+    rec_pat *pat;
+
+    /* Always add a new pattern to list */
+    if ((pat = calloc(1, sizeof(rec_pat))) == NULL) {
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    pat->type = type;
+    if ((pat->prev = inf->ppat) != NULL)
+	inf->ppat->next = pat;
+    else
+	inf->palt->pat = pat;
+    inf->ppat = pat;
+}
+
+static void
+irec_literal_pattern(irec_info *inf, int value)
+{
+    int length;
+    rec_pat *pat;
+    unsigned char chr, *str;
+
+	/* If there is a current pattern */
+    if (inf->ppat && inf->ppat->rep == NULL) {
+	switch (inf->ppat->type) {
+	    case Rep_Literal:
+		/* Start literal string */
+		chr = inf->ppat->data.chr;
+		if ((str = malloc(16)) == NULL) {
+		    inf->ecode = RE_ESPACE;
+		    return;
+		}
+		inf->ppat->type = Rep_String;
+		inf->ppat->data.str = str;
+		str[0] = chr;
+		str[1] = value;
+		str[2] = '\0';
+		return;
+
+	    case Rep_String:
+		/* Augments literal string */
+		length = strlen((char*)inf->ppat->data.str);
+		if ((length % 16) >= 14) {
+		    if ((str = realloc(inf->ppat->data.str,
+				       length + 18)) == NULL) {
+			inf->ecode = RE_ESPACE;
+			return;
+		    }
+		    inf->ppat->data.str = str;
+		}
+		inf->ppat->data.str[length] = value;
+		inf->ppat->data.str[length + 1] = '\0';
+		return;
+
+	    default:
+		/* Anything else is added as a new pattern list element */
+		break;
+	}
+    }
+
+    if ((pat = calloc(1, sizeof(rec_pat))) == NULL) {
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    pat->type = Rep_Literal;
+    pat->data.chr = value;
+    if ((pat->prev = inf->ppat) != NULL)
+	inf->ppat->next = pat;
+    else
+	inf->palt->pat = pat;
+    inf->ppat = pat;
+}
+
+static void
+irec_case_literal_pattern(irec_info *inf, int value)
+{
+    int length;
+    rec_pat *pat;
+    unsigned char plower, pupper, lower, upper, *str;
+
+    lower = tolower(value);
+    upper = toupper(value);
+
+	/* If there is a current pattern */
+    if (inf->ppat && inf->ppat->rep == NULL) {
+	switch (inf->ppat->type) {
+	    case Rep_CaseLiteral:
+		/* Start case literal string */
+		plower = inf->ppat->data.cse.lower;
+		pupper = inf->ppat->data.cse.upper;
+		if ((str = malloc(32)) == NULL) {
+		    inf->ecode = RE_ESPACE;
+		    return;
+		}
+		inf->ppat->type = Rep_CaseString;
+		inf->ppat->data.str = str;
+		str[0] = plower;
+		str[1] = pupper;
+		str[2] = lower;
+		str[3] = upper;
+		str[4] = '\0';
+		return;
+
+	    case Rep_CaseString:
+		/* Augments case literal string */
+		length = strlen((char*)inf->ppat->data.str);
+		if (((length) % 32) >= 28) {
+		    if ((str = realloc(inf->ppat->data.str,
+				       length + 36)) == NULL) {
+			inf->ecode = RE_ESPACE;
+			return;
+		    }
+		    inf->ppat->data.str = str;
+		}
+		inf->ppat->data.str[length] = lower;
+		inf->ppat->data.str[length + 1] = upper;
+		inf->ppat->data.str[length + 2] = '\0';
+		return;
+
+	    default:
+		/* Anything else is added as a new pattern list element */
+		break;
+	}
+    }
+
+    if ((pat = calloc(1, sizeof(rec_pat))) == NULL) {
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    pat->type = Rep_CaseLiteral;
+    pat->data.cse.lower = lower;
+    pat->data.cse.upper = upper;
+    pat->prev = inf->ppat;
+    if ((pat->prev = inf->ppat) != NULL)
+	inf->ppat->next = pat;
+    else
+	inf->palt->pat = pat;
+    inf->ppat = pat;
+}
+
+static void
+irec_open_group(irec_info *inf)
+{
+    rec_pat *pat;
+    rec_alt *alt;
+    rec_grp *grp;
+
+    if ((grp = calloc(1, sizeof(rec_grp))) == NULL) {
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    if ((pat = calloc(1, sizeof(rec_pat))) == NULL) {
+	free(grp);
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    if ((alt = calloc(1, sizeof(rec_alt))) == NULL) {
+	free(grp);
+	free(pat);
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    pat->type = Rep_Group;
+    pat->data.grp = grp;
+    grp->parent = pat;
+    grp->palt = inf->palt;
+    grp->pgrp = inf->pgrp;
+    grp->alt = alt;
+    grp->comp = 0;
+    if ((pat->prev = inf->ppat) != NULL)
+	inf->ppat->next = pat;
+    else
+	inf->palt->pat = pat;
+    inf->palt = alt;
+    inf->ppat = NULL;
+
+    /* Only toplevel parenthesis supported */
+    if (++inf->nparens == 1)
+	++inf->ngrps;
+
+    inf->pgrp = grp;
+}
+
+static void
+irec_close_group(irec_info *inf)
+{
+    if (inf->pgrp == NULL) {
+	inf->ecode = RE_EPAREN;
+	return;
+    }
+
+    inf->palt = inf->pgrp->palt;
+    inf->ppat = inf->pgrp->parent;
+    inf->pgrp = inf->pgrp->pgrp;
+
+    --inf->nparens;
+}
+
+static void
+irec_range(irec_info *inf)
+{
+    int count;
+    rec_pat *pat;
+    rec_rng *rng;
+    int not = inf->ptr[0] == '^';
+
+    if (not)
+	++inf->ptr;
+
+    pat = calloc(1, sizeof(rec_pat));
+    if (pat == NULL) {
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    rng = calloc(1, sizeof(rec_rng));
+    if (pat == NULL) {
+	free(pat);
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    pat->data.rng = rng;
+    pat->type = not ? Rep_RangeNot : Rep_Range;
+    if ((pat->prev = inf->ppat) != NULL)
+	inf->ppat->next = pat;
+    else
+	inf->palt->pat = pat;
+    inf->ppat = pat;
+
+    /* First pass, add everything seen */
+    for (count = 0; inf->ecode == 0; count++) {
+	/* If bracket not closed */
+	if (inf->ptr == inf->end) {
+	    inf->ecode = RE_EBRACK;
+	    return;
+	}
+	/* If not the first character */
+	else if (inf->ptr[0] == ']' && count)
+	    break;
+	else {
+	    /* If not a range of characters */
+	    if (inf->ptr[1] != '-' || inf->ptr[2] == ']') {
+		irec_range_single(inf, inf->ptr[0]);
+		++inf->ptr;
+	    }
+	    else {
+		if ((inf->flags & RE_NEWLINE) &&
+		    inf->ptr[0] < '\n' && inf->ptr[2] > '\n') {
+		    /*  Unless it is forced to be a delimiter, don't allow
+		     * a newline in a character range */
+		    if (inf->ptr[0] == '\n' - 1)
+			irec_range_single(inf, inf->ptr[0]);
+		    else
+			irec_range_complex(inf, inf->ptr[0], '\n' - 1);
+		    if (inf->ptr[2] == '\n' + 1)
+			irec_range_single(inf, inf->ptr[2]);
+		    else
+			irec_range_complex(inf, '\n' + 1, inf->ptr[2]);
+		}
+		else
+		    irec_range_complex(inf, inf->ptr[0], inf->ptr[2]);
+		inf->ptr += 3;
+	    }
+	}
+    }
+
+    /* Skip ] */
+    ++inf->ptr;
+}
+
+static void
+irec_range_single(irec_info *inf, int value)
+{
+    if (value >= 0 && value <= 255)
+	inf->ppat->data.rng->range[value] = 1;
+
+    if (inf->flags & RE_ICASE) {
+	if (islower(value)) {
+	    value = toupper(value);
+	    if (value >= 0 && value <= 255)
+		inf->ppat->data.rng->range[value] = 1;
+	}
+	else if (isupper(value)) {
+	    value = tolower(value);
+	    if (value >= 0 && value <= 255)
+		inf->ppat->data.rng->range[value] = 1;
+	}
+    }
+}
+
+static void
+irec_range_complex(irec_info *inf, int chrf, int chrt)
+{
+    if (chrf > chrt) {
+	inf->ecode = RE_ERANGE;
+	return;
+    }
+
+    for (; chrf <= chrt; chrf++)
+	irec_range_single(inf, chrf);
+}
+
+static void
+irec_escape(irec_info *inf)
+{
+    rec_pat *pat;
+    unsigned char chr = inf->ptr[0];
+
+    if (chr == 0) {
+	inf->ecode = RE_EESCAPE;
+	return;
+    }
+    ++inf->ptr;
+    switch (chr) {
+	case 'o':
+	    irec_simple_pattern(inf, Rep_Odigit);
+	    break;
+	case 'O':
+	    irec_simple_pattern(inf, Rep_OdigitNot);
+	    break;
+	case 'd':
+	    irec_simple_pattern(inf, Rep_Digit);
+	    break;
+	case 'D':
+	    irec_simple_pattern(inf, Rep_DigitNot);
+	    break;
+	case 'x':
+	    irec_simple_pattern(inf, Rep_Xdigit);
+	    break;
+	case 'X':
+	    irec_simple_pattern(inf, Rep_XdigitNot);
+	    break;
+	case 's':
+	    irec_simple_pattern(inf, Rep_Space);
+	    break;
+	case 'S':
+	    irec_simple_pattern(inf, Rep_SpaceNot);
+	    break;
+	case 't':
+	    irec_simple_pattern(inf, Rep_Tab);
+	    break;
+	case 'n':
+	    irec_simple_pattern(inf, Rep_Newline);
+	    break;
+	case 'l':
+	    irec_simple_pattern(inf, Rep_Lower);
+	    break;
+	case 'u':
+	    irec_simple_pattern(inf, Rep_Upper);
+	    break;
+	case 'w':
+	    irec_simple_pattern(inf, Rep_Alnum);
+	    break;
+	case 'W':
+	    irec_simple_pattern(inf, Rep_AlnumNot);
+	    break;
+	case 'c':
+	    irec_simple_pattern(inf, Rep_Control);
+	    break;
+	case 'C':
+	    irec_simple_pattern(inf, Rep_ControlNot);
+	    break;
+	case '<':
+	    irec_simple_pattern(inf, Rep_Bow);
+	    break;
+	case '>':
+	    irec_simple_pattern(inf, Rep_Eow);
+	    break;
+	case '1':	case '2':	case '3':
+	case '4':	case '5':	case '6':
+	case '7':	case '8':	case '9':
+	    if ((inf->flags & RE_NOSUB) || (chr -= '1') >= inf->ngrps) {
+		inf->ecode = RE_ESUBREG;
+		return;
+	    }
+	    if ((pat = calloc(1, sizeof(rec_pat))) == NULL) {
+		inf->ecode = RE_ESPACE;
+		return;
+	    }
+	    pat->type = Rep_Backref;
+	    pat->data.chr = chr;
+	    pat->prev = inf->ppat;
+	    if (inf->ppat)
+		inf->ppat->next = pat;
+	    else
+		inf->palt->pat = pat;
+	    inf->ppat = pat;
+	    break;
+
+	/* True literals */
+	case '0':
+	    irec_literal_pattern(inf, '\0');
+	    break;
+	case 'a':
+	    irec_literal_pattern(inf, '\a');
+	    break;
+	case 'b':
+	    irec_literal_pattern(inf, '\b');
+	    break;
+	case 'f':
+	    irec_literal_pattern(inf, '\f');
+	    break;
+	case 'r':
+	    irec_literal_pattern(inf, '\r');
+	    break;
+	case 'v':
+	    irec_literal_pattern(inf, '\v');
+	    break;
+
+	default:
+	    /* Don't check if case insensitive regular expression */
+	    irec_literal_pattern(inf, chr);
+	    break;
+    }
+}
+
+static void
+irec_simple_repetition(irec_info *inf, rec_rep_t type)
+{
+    rec_rep *rep;
+
+	/* If nowhere to add repetition */
+    if ((inf->pgrp == NULL && inf->ppat == NULL) ||
+	/* If repetition already added to last/current pattern */
+	(inf->pgrp == NULL && inf->ppat->rep != NULL) ||
+	/* If repetition already added to last/current group */
+	(inf->ppat == NULL && inf->pgrp->parent->rep != NULL)) {
+	inf->ecode = RE_BADRPT;
+	return;
+    }
+
+    if ((rep = calloc(1, sizeof(rec_rep))) == NULL) {
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+    rep->type = type;
+    irec_add_repetition(inf, rep);
+}
+
+static void
+irec_complex_repetition(irec_info *inf)
+{
+    int exact;
+    rec_rep *rep;
+    long mine, maxc;
+    unsigned char *end;
+
+	/* If nowhere to add repetition */
+    if ((inf->pgrp == NULL && inf->ppat == NULL) ||
+	/* If repetition already added to last/current pattern */
+	(inf->pgrp == NULL && inf->ppat->rep != NULL) ||
+	/* If repetition already added to last/current group */
+	(inf->ppat == NULL && inf->pgrp->parent->rep != NULL)) {
+	inf->ecode = RE_EBADBR;
+	return;
+    }
+
+    exact = 0;
+    mine = maxc = -1;
+    if (inf->ptr[0] == ',')
+	/* Specify max number of ocurrences only */
+	goto domax;
+    else if (!isdigit(inf->ptr[0]))
+	goto badbr;
+
+    mine = strtol((char*)inf->ptr, (char**)&end, 10);
+    inf->ptr = end;
+    if (inf->ptr[0] == '}') {
+	exact = 1;
+	++inf->ptr;
+	goto redone;
+    }
+    else if (inf->ptr[0] != ',')
+	goto badbr;
+
+domax:
+	/* Add one to skip comma */
+    ++inf->ptr;
+    if (inf->ptr[0] == '}') {
+	++inf->ptr;
+	goto redone;
+    }
+    else if (!isdigit(inf->ptr[0]))
+	goto badbr;
+    maxc = strtol((char*)inf->ptr, (char**)&end, 10);
+    inf->ptr = end;
+    if (inf->ptr[0] != '}')
+	goto badbr;
+    ++inf->ptr;
+
+redone:
+    if (mine == maxc) {
+	maxc = -1;
+	exact = 1;
+    }
+
+    /* Check range and if min-max parameters are valid */
+    if (mine >= 255 || maxc >= 255 ||
+	(mine >= 0 && maxc >= 0 && mine > maxc))
+	goto badbr;
+
+    /* Check for noop */
+    if (exact && mine == 1)
+	return;
+
+    if ((rep = calloc(1, sizeof(rec_rep))) == NULL) {
+	inf->ecode = RE_ESPACE;
+	return;
+    }
+
+	/* Convert {0,1} to ? */
+    if (mine == 0 && maxc == 1)
+	rep->type = Rer_Maybe;
+    else if (exact) {
+	rep->type = Rer_Exact;
+	rep->mine = mine;
+    }
+	/* Convert {0,} to * */
+    else if (mine == 0 && maxc == -1)
+	rep->type = Rer_AnyTimes;
+	/* Convert {1,} to + */
+    else if (mine == 1 && maxc == -1)
+	rep->type = Rer_AtLeast;
+    else if (maxc == -1) {
+	rep->type = Rer_Min;
+	rep->mine = mine;
+    }
+    else if (mine < 1) {
+	rep->type = Rer_Max;
+	rep->maxc = maxc;
+    }
+    else {
+	rep->type = Rer_MinMax;
+	rep->mine = mine;
+	rep->maxc = maxc;
+    }
+
+    irec_add_repetition(inf, rep);
+
+    return;
+
+badbr:
+    inf->ecode = RE_EBADBR;
+}
+
+/*  The rep argument is allocated and has no reference yet,
+ * if something fails it must be freed before returning.
+ */
+static void
+irec_add_repetition(irec_info *inf, rec_rep *rep)
+{
+    int length;
+    rec_pat *pat;
+    rec_grp *grp;
+    rec_rep_t rept;
+    unsigned char value, upper;
+
+    rept = rep->type;
+
+    if (inf->ppat == NULL) {
+	rec_pat *any;
+	rec_grp *grp = inf->pgrp;
+
+	if (rept == Rer_AnyTimes || rept == Rer_Maybe || rept == Re_AtLeast) {
+	    /* Convert (.)* to (.*), ((.))* not handled and may not match */
+	    any = NULL;
+
+	    if (grp->alt && grp->alt->pat) {
+		for (any = grp->alt->pat; any->next; any = any->next)
+		    ;
+		switch (any->type) {
+		    case Rep_Any:
+			break;
+		    case Rep_AnyAnyTimes:
+		    case Rep_AnyMaybe:
+		    case Rep_AnyAtLeast:
+			free(rep);
+			inf->ecode = RE_BADRPT;
+			return;
+		    default:
+			any = NULL;
+			break;
+		}
+	    }
+	    if (any) {
+		free(rep);
+		rep = NULL;
+		any->type = (rept == Rer_AnyTimes) ? Rep_AnyAnyTimes :
+			    (rept == Rer_AtLeast) ? Rep_AnyAtLeast :
+			    Rep_AnyMaybe;
+		while (grp) {
+		    ++grp->comp;
+		    grp = grp->pgrp;
+		}
+	    }
+	}
+	inf->pgrp->parent->rep = rep;
+	irec_close_group(inf);
+	return;
+    }
+
+    switch (inf->ppat->type) {
+	case Rep_Bol:
+	case Rep_Eol:
+	case Rep_Bow:
+	case Rep_Eow:
+	case Rep_AnyAnyTimes:
+	case Rep_AnyMaybe:
+	case Rep_AnyAtLeast:
+	    /* Markers that cannot repeat */
+	    free(rep);
+	    inf->ecode = RE_BADRPT;
+	    return;
+
+	case Rep_Any:
+	    grp = inf->pgrp;
+	    free(rep);
+	    if (rept == Rer_AnyTimes ||
+		rept == Rer_Maybe ||
+		rept == Rer_AtLeast) {
+		inf->ppat->type = (rept == Rer_AnyTimes) ?
+				   Rep_AnyAnyTimes :
+				  (rept == Rer_Maybe) ?
+				   Rep_AnyMaybe :
+				   Rep_AnyAtLeast;
+		while (grp) {
+		    ++grp->comp;
+		    grp = grp->pgrp;
+		}
+	    }
+	    else
+		/* XXX Not (yet) implemented */
+		inf->ecode = RE_BADRPT;
+	    rep = NULL;
+	    break;
+
+	case Rep_String:
+	    if ((pat = calloc(1, sizeof(rec_pat))) == NULL) {
+		free(rep);
+		inf->ecode = RE_ESPACE;
+		return;
+	    }
+
+	    length = strlen((char*)inf->ppat->data.str);
+	    pat->type = Rep_Literal;
+	    pat->prev = inf->ppat;
+	    pat->data.chr = inf->ppat->data.str[length - 1];
+	    if (length == 2) {
+		/* Must convert to two Rep_Literals */
+		value = inf->ppat->data.str[0];
+		free(inf->ppat->data.str);
+		inf->ppat->data.chr = value;
+		inf->ppat->type = Rep_Literal;
+	    }
+	    else
+		/* Must remove last character from string */
+		inf->ppat->data.str[length - 1] = '\0';
+	    inf->ppat->next = pat;
+	    inf->ppat = pat;
+	    break;
+
+	case Rep_CaseString:
+	    if ((pat = calloc(1, sizeof(rec_pat))) == NULL) {
+		free(rep);
+		inf->ecode = RE_ESPACE;
+		return;
+	    }
+
+	    length = strlen((char*)inf->ppat->data.str);
+	    pat->type = Rep_CaseLiteral;
+	    pat->prev = inf->ppat;
+	    pat->data.cse.lower = inf->ppat->data.str[length - 2];
+	    pat->data.cse.upper = inf->ppat->data.str[length - 1];
+	    if (length == 4) {
+		/* Must convert to two Rep_CaseLiterals */
+		value = inf->ppat->data.str[0];
+		upper = inf->ppat->data.str[1];
+		free(inf->ppat->data.str);
+		inf->ppat->data.cse.lower = value;
+		inf->ppat->data.cse.upper = upper;
+		inf->ppat->next = pat;
+		inf->ppat->type = Rep_CaseLiteral;
+	    }
+	    else
+		/* Must remove last character pair from string */
+		inf->ppat->data.str[length - 2] = '\0';
+	    inf->ppat->next = pat;
+	    inf->ppat = pat;
+	    break;
+
+	default:
+	    /* Anything else does not need special handling */
+	    break;
+    }
+
+    inf->ppat->rep = rep;
+}
+
+static void
+irec_free(irec_info *inf)
+{
+    irec_free_alt(inf->alt);
+}
+
+static void
+irec_free_grp(rec_grp *grp)
+{
+    if (grp->alt)
+	irec_free_alt(grp->alt);
+    free(grp);
+}
+
+static void
+irec_free_pats(rec_pat *pat)
+{
+    rec_pat *next;
+    rec_pat_t rect;
+
+    while (pat) {
+	next = pat->next;
+	if (pat->rep)
+	    free(pat->rep);
+	rect = pat->type;
+	if (rect == Rep_Range || rect == Rep_RangeNot)
+	    free(pat->data.rng);
+	else if (rect == Rep_Group)
+	    irec_free_grp(pat->data.grp);
+	else if (rect == Rep_StringList)
+	    orec_free_stl(pat->data.stl);
+	free(pat);
+	pat = next;
+    }
+}
diff --git a/lisp/re/reo.c b/lisp/re/reo.c
new file mode 100644
index 0000000..59cbf3b
--- /dev/null
+++ b/lisp/re/reo.c
@@ -0,0 +1,685 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/re/reo.c,v 1.9 2002/11/15 07:01:33 paulo Exp $ */
+
+#include "rep.h"
+
+/*
+ *  This file is a placeholder to add code to analyse and optimize the
+ * intermediate data structure generated in rep.c.
+ *  Character ranges are optimized while being generated.
+ */
+
+/*
+ * Types
+ */
+typedef struct _orec_inf {
+    rec_alt *alt;			/* Main alternatives list */
+    rec_grp *grp;			/* Current group pointer */
+    int flags;
+    int ecode;
+} orec_inf;
+
+/*
+ * Prototypes
+ */
+static int orec_alt(orec_inf*, rec_alt*);
+static int orec_pat(orec_inf*, rec_pat*);
+static int orec_grp(orec_inf*, rec_grp*);
+static int orec_pat_bad_rpt(orec_inf*, rec_pat*);
+static int orec_pat_bad_forward_rpt(orec_inf*, rec_pat*);
+static int orec_pat_rng(orec_inf*, rec_pat*);
+static int orec_pat_cse(orec_inf*, rec_pat*);
+static int orec_pat_cse_can(orec_inf*, rec_pat*);
+static int orec_str_list(orec_inf*, rec_alt*, int, int);
+
+/*
+ * Initialization
+ */
+extern unsigned char re__alnum[256];
+extern unsigned char re__odigit[256];
+extern unsigned char re__ddigit[256];
+extern unsigned char re__xdigit[256];
+extern unsigned char re__control[256];
+
+/*
+ * Implementation
+ */
+int
+orec_comp(rec_alt *alt, int flags)
+{
+    orec_inf inf;
+
+    inf.alt = alt;
+    inf.grp = NULL;
+    inf.flags = flags;
+    inf.ecode = 0;
+
+    orec_alt(&inf, alt);
+
+    return (inf.ecode);
+}
+
+void
+orec_free_stl(rec_stl *stl)
+{
+    int i;
+
+    for (i = 0; i < stl->nstrs; i++) {
+	if (stl->lens[i] > 2)
+	    free(stl->strs[i]);
+    }
+
+    free(stl->lens);
+    free(stl->strs);
+    free(stl);
+}
+
+
+static int
+orec_alt(orec_inf *inf, rec_alt *alt)
+{
+    if (alt) {
+	rec_alt *ptr = alt;
+	int ret, count = 0, str = 1, cstr = 1, lits = 0, clits = 0;
+
+	/* Check if can build a string list */
+	if (ptr->next) {
+	    /* If more than one alternative */
+	    while (ptr && (str || cstr)) {
+		if (ptr->pat == NULL || ptr->pat->rep != NULL) {
+		    cstr = str = 0;
+		    break;
+		}
+		if ((inf->flags & RE_ICASE)) {
+		    if (!(ret = orec_pat_cse_can(inf, ptr->pat))) {
+			cstr = str = 0;
+			break;
+		    }
+		    if (ret == 1)
+			++lits;
+		    else if (ret == 2)
+			++clits;
+		}
+		else if (ptr->pat->next == NULL) {
+		    if (ptr->pat->type != Rep_String) {
+			if (ptr->pat->type != Rep_Literal) {
+			    str = 0;
+			    if (ptr->pat->type != Rep_CaseString) {
+				if (ptr->pat->type != Rep_CaseLiteral)
+				    cstr = 0;
+				else
+				    ++clits;
+			    }
+			    else if (strlen((char*)ptr->pat->data.str) >= 255)
+				str = cstr = 0;
+			}
+			else
+			    ++lits;
+		    }
+		    else if (strlen((char*)ptr->pat->data.str) >= 255)
+			str = cstr = 0;
+		}
+		else {
+		    str = cstr = 0;
+		    break;
+		}
+		if (++count >= 255)
+		    str = cstr = 0;
+		ptr = ptr->next;
+	    }
+
+	    if (str || cstr) {
+		if (inf->flags & RE_ICASE) {
+		    for (ptr = alt; ptr; ptr = ptr->next) {
+			if (orec_pat_cse(inf, ptr->pat))
+			    return (inf->ecode);
+		    }
+		    str = 0;
+		}
+		return (orec_str_list(inf, alt, str, count));
+	    }
+	}
+	else if (alt == inf->alt && alt->pat && alt->pat->rep == NULL) {
+	    /* If the toplevel single alternative */
+	    switch (alt->pat->type) {
+		/*  One of these will always be true for RE_NOSPEC,
+		 * but can also be optimized for simple patterns */
+		case Rep_Literal:
+		    alt->pat->type = Rep_SearchLiteral;
+		    break;
+		case Rep_CaseLiteral:
+		    alt->pat->type = Rep_SearchCaseLiteral;
+		    break;
+		case Rep_String:
+		    alt->pat->type = Rep_SearchString;
+		    break;
+		case Rep_CaseString:
+		    alt->pat->type = Rep_SearchCaseString;
+		    break;
+		default:
+		    break;
+	    }
+	}
+
+	while (alt) {
+	    orec_pat(inf, alt->pat);
+	    alt = alt->next;
+	}
+    }
+
+    return (inf->ecode);
+}
+
+static int
+orec_pat(orec_inf *inf, rec_pat *pat)
+{
+    rec_pat *next;
+
+    while (pat) {
+	switch (pat->type) {
+	    case Rep_AnyAnyTimes:
+		if (pat->next == NULL) {
+		    rec_grp *grp = inf->grp;
+
+		    next = NULL;
+		    while (grp) {
+			next = grp->parent->next;
+			/* Cannot check if is .*$ as the input
+			 * may be a substring */
+			if (next)
+			    break;
+			grp = grp->pgrp;
+		    }
+		    if (next == NULL) {
+			/*    <re>.*    */
+			pat->type = Rep_AnyEatAnyTimes;
+			grp = inf->grp;
+			while (grp) {
+			    --grp->comp;
+			    next = grp->parent->next;
+			    if (next)
+				break;
+			    grp = grp->pgrp;
+			}
+		    }
+		    else if (orec_pat_bad_rpt(inf, next))
+			return (inf->ecode);
+		}
+		else if (orec_pat_bad_rpt(inf, pat->next))
+		    return (inf->ecode);
+		break;
+	    case Rep_AnyMaybe:
+		if (pat->next == NULL) {
+		    rec_grp *grp = inf->grp;
+
+		    next = NULL;
+		    while (grp) {
+			next = grp->parent->next;
+			if (next)
+			    break;
+			grp = grp->pgrp;
+		    }
+		    if (next == NULL) {
+			/*    <re>.?    */
+			pat->type = Rep_AnyEatMaybe;
+			grp = inf->grp;
+			while (grp) {
+			    --grp->comp;
+			    next = grp->parent->next;
+			    if (next)
+				break;
+			    grp = grp->pgrp;
+			}
+		    }
+		    else if (orec_pat_bad_rpt(inf, next))
+			return (inf->ecode);
+		}
+		else if (orec_pat_bad_rpt(inf, pat->next))
+		    return (inf->ecode);
+		break;
+	    case Rep_AnyAtLeast:
+		if (pat->next == NULL) {
+		    rec_grp *grp = inf->grp;
+
+		    next = NULL;
+		    while (grp) {
+			next = grp->parent->next;
+			if (next)
+			    break;
+			grp = grp->pgrp;
+		    }
+		    if (next == NULL) {
+			/*    <re>.+    */
+			pat->type = Rep_AnyEatAtLeast;
+			grp = inf->grp;
+			while (grp) {
+			    --grp->comp;
+			    next = grp->parent->next;
+			    if (next)
+				break;
+			    grp = grp->pgrp;
+			}
+		    }
+		    else if (orec_pat_bad_rpt(inf, next))
+			return (inf->ecode);
+		}
+		else if (orec_pat_bad_rpt(inf, pat->next))
+		    return (inf->ecode);
+		break;
+	    case Rep_Range:
+	    case Rep_RangeNot:
+		orec_pat_rng(inf, pat);
+		break;
+	    case Rep_Group:
+		orec_grp(inf, pat->data.grp);
+		break;
+	    default:
+		break;
+	}
+	pat = pat->next;
+    }
+
+    return (inf->ecode);
+}
+
+static int
+orec_pat_bad_rpt(orec_inf *inf, rec_pat *pat)
+{
+    switch (pat->type) {
+	/* Not really an error, but aren't supported by the library.
+	 * Includes:  .*.*, .+<re>?  .*<re>*, (.*)(<re>*), etc.
+	 */
+
+	/* Not a repetition, but mathes anything... */
+	case Rep_Any:
+
+	/* Zero length matches */
+	case Rep_Eol:
+	    if (!(inf->flags & RE_NEWLINE))
+		break;
+	case Rep_Bol:
+	case Rep_Bow:
+	case Rep_Eow:
+
+	/* Repetitions */
+	case Rep_AnyAnyTimes:
+	case Rep_AnyMaybe:
+	case Rep_AnyAtLeast:
+	    inf->ecode = RE_BADRPT;
+	    break;
+
+	/* Check if the first group element is a complex pattern */
+	case Rep_Group:
+	    if (pat->rep == NULL) {
+		if (pat->data.grp->alt) {
+		    for (pat = pat->data.grp->alt->pat; pat; pat = pat->next) {
+			if (orec_pat_bad_rpt(inf, pat))
+			    break;
+		    }
+		}
+		break;
+	    }
+	    /*FALLTHROUGH*/
+	default:
+	    if (pat->rep)
+		inf->ecode = RE_BADRPT;
+	    break;
+    }
+
+    if (!inf->ecode && pat && pat->next)
+	orec_pat_bad_forward_rpt(inf, pat->next);
+
+    return (inf->ecode);
+}
+
+static int
+orec_pat_bad_forward_rpt(orec_inf *inf, rec_pat *pat)
+{
+    if (pat->rep) {
+	switch (pat->rep->type) {
+	    case Rer_MinMax:
+		if (pat->rep->mine > 0)
+		    break;
+	    case Rer_AnyTimes:
+	    case Rer_Maybe:
+	    case Rer_Max:
+		inf->ecode = RE_BADRPT;
+	    default:
+		break;
+	}
+    }
+    else if (pat->type == Rep_Group &&
+	     pat->data.grp->alt &&
+	     pat->data.grp->alt->pat)
+	orec_pat_bad_forward_rpt(inf, pat->data.grp->alt->pat);
+
+    return (inf->ecode);
+}
+
+static int
+orec_grp(orec_inf *inf, rec_grp *grp)
+{
+    rec_grp *prev = inf->grp;
+
+    inf->grp = grp;
+    orec_alt(inf, grp->alt);
+    /* Could also just say: inf->grp = grp->gparent */
+    inf->grp = prev;
+
+    return (inf->ecode);
+}
+
+static int
+orec_pat_rng(orec_inf *inf, rec_pat *pat)
+{
+    int i, j[2], count;
+    rec_pat_t type = pat->type;
+    unsigned char *range = pat->data.rng->range;
+
+    for (i = count = j[0] = j[1] = 0; i < 256; i++) {
+	if (range[i]) {
+	    if (count == 2) {
+		++count;
+		break;
+	    }
+	    j[count++] = i;
+	}
+    }
+
+    if (count == 1 ||
+	(count == 2 &&
+	 ((islower(j[0]) && toupper(j[0]) == j[1]) ||
+	  (isupper(j[0]) && tolower(j[0]) == j[1])))) {
+	free(pat->data.rng);
+	if (count == 1) {
+	    pat->data.chr = j[0];
+	    pat->type = type == Rep_Range ? Rep_Literal : Rep_LiteralNot;
+	}
+	else {
+	    pat->data.cse.upper = j[0];
+	    pat->data.cse.lower = j[1];
+	    pat->type = type == Rep_Range ? Rep_CaseLiteral : Rep_CaseLiteralNot;
+	}
+    }
+    else {
+	if (memcmp(re__alnum, range, 256) == 0)
+	    type = type == Rep_Range ? Rep_Alnum : Rep_AlnumNot;
+	else if (memcmp(re__odigit, range, 256) == 0)
+	    type = type == Rep_Range ? Rep_Odigit : Rep_OdigitNot;
+	else if (memcmp(re__ddigit, range, 256) == 0)
+	    type = type == Rep_Range ? Rep_Digit : Rep_DigitNot;
+	else if (memcmp(re__xdigit, range, 256) == 0)
+	    type = type == Rep_Range ? Rep_Xdigit : Rep_XdigitNot;
+	else if (memcmp(re__control, range, 256) == 0)
+	    type = type == Rep_Range ? Rep_Control : Rep_ControlNot;
+
+	if (type != pat->type) {
+	    free(pat->data.rng);
+	    pat->type = type;
+	}
+    }
+
+    return (inf->ecode);
+}
+
+/*  Join patterns if required, will only fail on memory allocation failure:
+ */
+static int
+orec_pat_cse(orec_inf *inf, rec_pat *pat)
+{
+    rec_pat_t type;
+    int i, len, length;
+    rec_pat *ptr, *next;
+    unsigned char *str, *tofree;
+
+    if (pat->next == NULL && pat->type == Rep_CaseString)
+	return (inf->ecode);
+
+    type = Rep_CaseString;
+
+    /* First calculate how many bytes will be required */
+    for (ptr = pat, length = 1; ptr; ptr = ptr->next) {
+	switch (ptr->type) {
+	    case Rep_Literal:
+		length += 2;
+		break;
+	    case Rep_String:
+		length += strlen((char*)ptr->data.str) << 1;
+		break;
+	    case Rep_CaseLiteral:
+		length += 2;
+		break;
+	    case Rep_CaseString:
+		length += strlen((char*)ptr->data.str);
+		break;
+	    default:
+		break;
+	}
+    }
+
+    if ((str = malloc(length)) == NULL)
+	return (inf->ecode = RE_ESPACE);
+
+    for (ptr = pat, length = 0; ptr; ptr = next) {
+	tofree = NULL;
+	next = ptr->next;
+	switch (ptr->type) {
+	    case Rep_Literal:
+		str[length++] = ptr->data.chr;
+		str[length++] = ptr->data.chr;
+		break;
+	    case Rep_String:
+		tofree = ptr->data.str;
+		len = strlen((char*)tofree);
+		for (i = 0; i < len; i++) {
+		    str[length++] = tofree[i];
+		    str[length++] = tofree[i];
+		}
+		break;
+	    case Rep_CaseLiteral:
+		str[length++] = ptr->data.cse.lower;
+		str[length++] = ptr->data.cse.upper;
+		break;
+	    case Rep_CaseString:
+		tofree = ptr->data.str;
+		len = strlen((char*)tofree);
+		memcpy(str + length, tofree, len);
+		length += len;
+		break;
+	    default:
+		break;
+	}
+	if (tofree)
+	    free(tofree);
+	if (ptr != pat)
+	    free(ptr);
+    }
+    str[length] = '\0';
+
+    pat->type = type;
+    pat->data.str = str;
+    pat->next = NULL;
+
+    return (inf->ecode);
+}
+
+/*  Return 0 if the patterns in the list cannot be merged, 1 if will
+ * be a simple string, 2 if a case string.
+ *  This is useful when building an alternative list that is composed
+ * only of strings, but the regex is case insensitive, in wich case
+ * the first pass may have splited some patterns, but if it is a member
+ * of an alternatives list, the cost of using a string list is smaller */
+static int
+orec_pat_cse_can(orec_inf *inf, rec_pat *pat)
+{
+    int ret;
+
+    if (pat == NULL)
+	return (0);
+
+    for (ret = 1; pat; pat = pat->next) {
+	if (pat->rep)
+	    return (0);
+	switch (pat->type) {
+	    case Rep_Literal:
+	    case Rep_String:
+		break;
+	    case Rep_CaseLiteral:
+	    case Rep_CaseString:
+		ret = 2;
+		break;
+	    default:
+		return (0);
+	}
+    }
+
+    return (ret);
+}
+
+
+/*  XXX If everything is a (case) byte, the pattern should be
+ * [abcde] instead of a|b|c|d|e (or [aAbBcCdDeE] instead of aA|bB|cC|dD|eE)
+ * as a string list works fine, but as a character range
+ * should be faster, and maybe could be converted here. But not
+ * very important, if performance is required, it should have already
+ * been done in the pattern.
+ */
+static int
+orec_str_list(orec_inf *inf, rec_alt *alt, int str, int count)
+{
+    rec_stl *stl;
+    rec_pat *pat;
+    rec_alt *ptr, *next;
+    int i, j, tlen, len, is;
+
+    if ((stl = calloc(1, sizeof(rec_stl))) == NULL)
+	return (inf->ecode = RE_ESPACE);
+
+    if ((stl->lens = malloc(sizeof(unsigned char) * count)) == NULL) {
+	free(stl);
+	return (inf->ecode = RE_ESPACE);
+    }
+
+    if ((stl->strs = malloc(sizeof(char*) * count)) == NULL) {
+	free(stl->lens);
+	free(stl);
+	return (inf->ecode = RE_ESPACE);
+    }
+
+    if ((pat = calloc(1, sizeof(rec_pat))) == NULL) {
+	free(stl->strs);
+	free(stl->lens);
+	free(stl);
+	return (inf->ecode = RE_ESPACE);
+    }
+
+    pat->data.stl = stl;
+    pat->type = Rep_StringList;
+    stl->type = str ? Resl_StringList : Resl_CaseStringList;
+    for (i = tlen = 0, ptr = alt; i < count; i++) {
+	next = ptr->next;
+	switch (ptr->pat->type) {
+	    case Rep_Literal:
+		is = len = 1;
+		break;
+	    case Rep_CaseLiteral:
+		is = len = 2;
+		break;
+	    default:
+		is = 0;
+		len = strlen((char*)ptr->pat->data.str);
+		break;
+	}
+	tlen += len;
+	stl->lens[i] = len;
+	if (!is) {
+	    if (len > 2)
+		stl->strs[i] = ptr->pat->data.str;
+	    else {
+		if (len == 1)
+		    stl->strs[i] = (void*)(long)(ptr->pat->data.str[0]);
+		else
+		    stl->strs[i] = (void*)(long)
+				   (ptr->pat->data.str[0] |
+				    ((int)ptr->pat->data.str[1] << 8));
+		free(ptr->pat->data.str);
+	    }
+	}
+	else {
+	    if (is == 1)
+		stl->strs[i] = (void*)(long)ptr->pat->data.chr;
+	    else
+		stl->strs[i] = (void*)(long)
+			       (ptr->pat->data.cse.lower |
+				(ptr->pat->data.cse.upper << 8));
+	}
+	free(ptr->pat);
+	if (i)
+	    free(ptr);
+	ptr = next;
+    }
+    stl->tlen = tlen;
+    stl->nstrs = count;
+
+    alt->pat = pat;
+    alt->next = NULL;
+
+    {
+	int li, lj;
+	unsigned char ci, cj, *str;
+
+	/*  Don't need a stable sort, there shouldn't be duplicated strings,
+	 * but don't check for it either. Only need to make sure that all
+	 * strings that start with the same byte are together */
+	for (i = 0; i < count; i++) {
+	    li = stl->lens[i];
+	    ci = li > 2 ? stl->strs[i][0] : (long)stl->strs[i] & 0xff;
+	    for (j = i + 1; j < count; j++) {
+		lj = stl->lens[j];
+		cj = lj > 2 ? stl->strs[j][0] : (long)stl->strs[j] & 0xff;
+		if ((count >= LARGE_STL_COUNT && cj < ci) ||
+		    (cj == ci && lj > li)) {
+		    /* If both strings start with the same byte,
+		     * put the longer first */
+		    str = stl->strs[j];
+		    stl->strs[j] = stl->strs[i];
+		    stl->strs[i] = str;
+		    stl->lens[j] = li;
+		    stl->lens[i] = lj;
+		    li ^= lj; lj ^= li; li ^= lj;
+		    ci ^= cj; cj ^= ci; ci ^= cj;
+		}
+	    }
+	}
+    }
+
+    return (inf->ecode);
+}
diff --git a/lisp/re/rep.h b/lisp/re/rep.h
new file mode 100644
index 0000000..5e4d5d5
--- /dev/null
+++ b/lisp/re/rep.h
@@ -0,0 +1,369 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/re/rep.h,v 1.3 2002/11/25 02:35:32 paulo Exp $ */
+
+#include "re.h"
+
+#ifndef _rep_h
+#define _rep_h
+
+/*
+ * Local defines
+ */
+
+#ifdef MIN
+#undef MIN
+#endif
+#define MIN(a, b)	((a) < (b) ? (a) : (b))
+
+#ifdef MAX
+#undef MAX
+#endif
+#define MAX(a, b)	((a) > (b) ? (a) : (b))
+
+/*  This value can not be larger than 255, a depth value is the nesting of
+ * repetition operations and alternatives. The number of nested parenthesis
+ * does not matter, but a repetition on the pattern inside the parenthesis
+ * does. Note also that you cannot have more than 9 parenthesis pairs in
+ * an expression.
+ *  Depth is always at least 1. So for MAX_DEPTH 8, it is only allowed
+ * 7 complex repetitions. A complex repetition is a dot followed by an
+ * repetition operator. It is called a complex repetition because dot
+ * matches anything but the empty string, so the engine needs to test
+ * all possible combinations until the end of the string is found.
+ *  Repetitions like .* use one depth until the end of the string is found,
+ * for example a.*b.*c.*d has depth 4, while a*b*c*d has depth 2.
+ */
+#define MAX_DEPTH	8
+
+/*  Minimum number of strings to generate a "large" string list, that is,
+ * sort the strings and allocate 512 extra bytes to map the first string
+ * with a given initial byte. */
+#define LARGE_STL_COUNT	16
+
+/*
+ * Local types
+ */
+/* Intermediate compilation types declaration */
+	/* (r)egular (e)xpression (c)ompile (c)a(se) */
+typedef struct _rec_cse rec_cse;
+
+	/* (r)egular (e)xpression (c)ompile (r)a(ng)e */
+typedef struct _rec_rng rec_rng;
+
+	/* (r)egular (e)xpression (c)ompile (pat)tern */
+typedef struct _rec_pat rec_pat;
+
+	/* (r)egular (e)xpression (c)ompile (rep)etition */
+typedef struct _rec_rep rec_rep;
+
+	/* (r)egular (e)xpression (c)ompile (gr)ou(p) */
+typedef struct _rec_grp rec_grp;
+
+	/* (r)egular (e)xpression (c)ompile (alt)ernatives */
+typedef struct _rec_alt rec_alt;
+
+
+/* Optimization types */
+	/* (r)egular (e)xpression (c)ompile (st)ring (l)ist */
+typedef struct _rec_stl rec_stl;
+
+/* Final compilation and execution types */
+	/* (re)gular expression (inf)ormation */
+typedef struct _re_inf re_inf;
+
+	/* (re)gular expression (eng)ine */
+typedef struct _re_eng re_eng;
+
+
+/* Codes used by the engine */
+typedef enum {
+    /* Grouping */
+    Re_Open,			/* ( */
+    Re_Close,			/* ) */
+    Re_Update,			/* Like Re_Close, but is inside a loop */
+
+    /* Alternatives */
+    Re_Alt,			/* Start alternative list, + next offset */
+    Re_AltNext,			/* Next alternative, + next offset */
+    Re_AltDone,			/* Finish alternative list */
+
+    /* Repetition */
+    Re_AnyTimes,		/* * */
+    Re_Maybe,			/* ? */
+    Re_AtLeast,			/* +, at least one */
+
+    /* Repetition like */
+    Re_AnyAnyTimes,		/* .*<re> */
+    Re_AnyMaybe,		/* .?<re> */
+    Re_AnyAtLeast,		/* .+<re> */
+
+    Re_AnyEatAnyTimes,		/* Expression ends with .* */
+    Re_AnyEatMaybe,		/* Expression ends with .? */
+    Re_AnyEatAtLeast,		/* Expression ends with .+ */
+
+    /* Repetition with arguments */
+    Re_Exact,			/* {e} */
+    Re_Min,			/* {n,} */
+    Re_Max,			/* {,m} */
+    Re_MinMax,			/* {n,m} */
+
+    /* Repetition helper instruction */
+    Re_RepJump,			/* Special code, go back to repetition */
+    Re_RepLongJump,		/* Jump needs two bytes */
+	/*  After the repetition data, all repetitions have an offset
+	 * to the code after the repetition */
+
+    /* Matching */
+    Re_Any,			/* . */
+    Re_Odigit,			/* \o */
+    Re_OdigitNot,		/* \O */
+    Re_Digit,			/* \d */
+    Re_DigitNot,		/* \D */
+    Re_Xdigit,			/* \x */
+    Re_XdigitNot,		/* \x */
+    Re_Space,			/* \s */
+    Re_SpaceNot,		/* \S */
+    Re_Tab,			/* \t */
+    Re_Newline,			/* \n */
+    Re_Lower,			/* \l */
+    Re_Upper,			/* \u */
+    Re_Alnum,			/* \w */
+    Re_AlnumNot,		/* \W */
+    Re_Control,			/* \c */
+    Re_ControlNot,		/* \C */
+    Re_Bol,			/* ^ */
+    Re_Eol,			/* $ */
+    Re_Bow,			/* \< */
+    Re_Eow,			/* \> */
+
+    /* Range matching information */
+    Re_Range,			/* + 256 bytes */
+    Re_RangeNot,		/* + 256 bytes */
+
+    /* Matching with arguments */
+    Re_Literal,			/* + character */
+    Re_CaseLiteral,		/* + lower + upper */
+    Re_LiteralNot,		/* + character */
+    Re_CaseLiteralNot,		/* + lower + upper */
+    Re_String,			/* + length + string */
+    Re_CaseString,		/* + length + string in format lower-upper */
+
+    /* These are useful to start matching, or when RE_NOSPEC is used. */
+    Re_SearchLiteral,
+    Re_SearchCaseLiteral,
+    Re_SearchString,
+    Re_SearchCaseString,
+
+    Re_StringList,		/* + total-length + lengths + strings */
+    Re_CaseStringList,		/* + total-length + lengths + strings */
+
+    Re_LargeStringList,		/* + total-length + lengths + map + strings */
+    Re_LargeCaseStringList,	/* + total-length + lengths + map + strings */
+
+    /* Backreference */
+    Re_Backref,			/* + reference number */
+
+    /* The last codes */
+    Re_DoneIf,			/* Done if at end of input */
+    Re_MaybeDone,		/* Done */
+    Re_Done			/* If this code found, finished execution */
+} ReCode;
+
+
+/* (r)egular (e)xpresssion (pat)rern (t)ype */
+typedef enum _rec_pat_t {
+    Rep_Literal			= Re_Literal,
+    Rep_CaseLiteral		= Re_CaseLiteral,
+    Rep_LiteralNot		= Re_LiteralNot,
+    Rep_CaseLiteralNot		= Re_CaseLiteralNot,
+    Rep_Range			= Re_Range,
+    Rep_RangeNot		= Re_RangeNot,
+    Rep_String			= Re_String,
+    Rep_CaseString		= Re_CaseString,
+    Rep_SearchLiteral		= Re_SearchLiteral,
+    Rep_SearchCaseLiteral	= Re_SearchCaseLiteral,
+    Rep_SearchString		= Re_SearchString,
+    Rep_SearchCaseString	= Re_SearchCaseString,
+    Rep_Any			= Re_Any,
+    Rep_AnyAnyTimes		= Re_AnyAnyTimes,
+    Rep_AnyEatAnyTimes		= Re_AnyEatAnyTimes,
+    Rep_AnyMaybe		= Re_AnyMaybe,
+    Rep_AnyEatMaybe		= Re_AnyEatMaybe,
+    Rep_AnyAtLeast		= Re_AnyAtLeast,
+    Rep_AnyEatAtLeast		= Re_AnyEatAtLeast,
+    Rep_Odigit			= Re_Odigit,
+    Rep_OdigitNot		= Re_OdigitNot,
+    Rep_Digit			= Re_Digit,
+    Rep_DigitNot		= Re_DigitNot,
+    Rep_Xdigit			= Re_Xdigit,
+    Rep_XdigitNot		= Re_XdigitNot,
+    Rep_Space			= Re_Space,
+    Rep_SpaceNot		= Re_SpaceNot,
+    Rep_Tab			= Re_Tab,
+    Rep_Newline			= Re_Newline,
+    Rep_Lower			= Re_Lower,
+    Rep_Upper			= Re_Upper,
+    Rep_Alnum			= Re_Alnum,
+    Rep_AlnumNot		= Re_AlnumNot,
+    Rep_Control			= Re_Control,
+    Rep_ControlNot		= Re_ControlNot,
+    Rep_Bol			= Re_Bol,
+    Rep_Eol			= Re_Eol,
+    Rep_Bow			= Re_Bow,
+    Rep_Eow			= Re_Eow,
+    Rep_Backref			= Re_Backref,
+    Rep_StringList		= Re_StringList,
+    Rep_Group			= Re_Open
+} rec_pat_t;
+
+
+/* (r)egular (e)xpression (rep)etition (t)ype */
+typedef enum _rec_rep_t {
+    Rer_AnyTimes		= Re_AnyTimes,
+    Rer_AtLeast			= Re_AtLeast,
+    Rer_Maybe			= Re_Maybe,
+    Rer_Exact			= Re_Exact,
+    Rer_Min			= Re_Min,
+    Rer_Max			= Re_Max,
+    Rer_MinMax			= Re_MinMax
+} rec_rep_t;
+
+
+/*  Decide at re compilation time what is lowercase and what is uppercase */
+struct _rec_cse {
+    unsigned char lower;
+    unsigned char upper;
+};
+
+
+/*  A rec_rng is used only during compilation, just a character map */
+struct _rec_rng {
+    unsigned char range[256];
+};
+
+
+/*  A rec_pat is used only during compilation, and can be viewed as
+ * a regular expression element like a match to any character, a match
+ * to the beginning or end of the line, etc.
+ *  It is implemented as a linked list, and does not have nesting.
+ *  The data field can contain:
+ *	chr:	the value of a single character to match.
+ *	cse:	the upper and lower case value of a character to match.
+ *	rng:	a character map to match or not match.
+ *	str:	a simple string or a string where every two bytes
+ *		represents the character to match, in lower/upper
+ *		case sequence.
+ *  The rep field is not used for strings, strings are broken in the
+ * last character in this case. That is, strings are just a concatenation
+ * of several character matches.
+ */
+struct _rec_pat {
+    rec_pat_t type;
+    rec_pat *next, *prev;	/* Linked list information */
+    union {
+	unsigned char chr;
+	rec_cse cse;
+	rec_rng *rng;
+	rec_grp *grp;
+	unsigned char *str;
+	rec_stl *stl;
+    } data;
+    rec_rep *rep;		/* Pattern repetition information */
+};
+
+
+/*  A rec_rep is used only during compilation, and can be viewed as:
+ *
+ *	? or * or + or {<e>} or {<m>,} or {,<M>} or {<m>,<M>}
+ *
+ * where <e> is "exact", <m> is "minimum" and <M> is "maximum".
+ *  In the compiled step it can also be just a NULL pointer, that
+ * is actually equivalent to {1}.
+ */
+struct _rec_rep {
+    rec_rep_t type;
+    short mine;			/* minimum or exact number of matches */
+    short maxc;			/* maximum number of matches */
+};
+
+
+/*  A rec_alt is used only during compilation, and can be viewed as:
+ *
+ *	<re>|<re>
+ *
+ * where <re> is any regular expression. The expressions are nested
+ * using the grp field of the rec_pat structure.
+ */
+struct _rec_alt {
+    rec_alt *next, *prev;	/* Linked list information */
+    rec_pat *pat;
+};
+
+
+/*  A rec_grp is a place holder for expressions enclosed in parenthesis
+ * and is linked to the compilation data by an rec_pat structure. */
+struct _rec_grp {
+    rec_pat *parent;		/* Reference to parent pattern */
+    rec_alt *alt;		/* The pattern information */
+    rec_alt *palt;		/* Parent alternative */
+    rec_grp *pgrp;		/* Nested groups */
+    int comp;			/* (comp)lex repetition pattern inside group */
+};
+
+
+/* Optimization compilation types definition */
+	/* (r)egular (e)xpression (c)ompile (st)ring (l)ist (t)ype */
+typedef enum {
+    Resl_StringList		= Re_StringList,
+    Resl_CaseStringList		= Re_CaseStringList
+} rec_stl_t;
+
+struct _rec_stl {
+    rec_stl_t type;
+    int nstrs;			/* Number of strings in list */
+    int tlen;			/* Total length of all strings */
+    unsigned char *lens;	/* Vector of string lengths */
+    unsigned char **strs;	/* The strings */
+};
+
+
+/*
+ * Prototypes
+ */
+	/* rep.c */
+rec_alt *irec_comp(const char*, const char*, int, int*);
+void irec_free_alt(rec_alt*);
+
+	/* reo.c */
+int orec_comp(rec_alt*, int);
+void orec_free_stl(rec_stl*);
+
+#endif /* _rep_h */
diff --git a/lisp/re/tests.c b/lisp/re/tests.c
new file mode 100644
index 0000000..bd5c55d
--- /dev/null
+++ b/lisp/re/tests.c
@@ -0,0 +1,199 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/re/tests.c,v 1.1 2002/09/08 02:29:50 paulo Exp $ */
+
+/*
+ * Compile with:	cc -o tests tests.c -L. -lre
+ */
+
+#include <stdio.h>
+#include <string.h>
+#include "re.h"
+
+int
+main(int argc, char *argv[])
+{
+    re_cod cod;
+    re_mat mat[10];
+    int line, ecode, i, len, group, failed;
+    long eo, so;
+    char buf[8192];
+    char str[8192];
+    FILE *fp = fopen("tests.txt", "r");
+
+    if (fp == NULL) {
+	fprintf(stderr, "failed to open tests.txt\n");
+	exit(1);
+    }
+
+    ecode = line = group = failed = 0;
+    cod.cod = NULL;
+    while (fgets(buf, sizeof(buf), fp)) {
+	++line;
+	if (buf[0] == '#' || buf[0] == '\n')
+	    continue;
+	else if (buf[0] == '/') {
+	    char *ptr = strrchr(buf, '/');
+
+	    if (ptr == buf) {
+		fprintf(stderr, "syntax error at line %d\n", line);
+		break;
+	    }
+	    else {
+		int flags = 0;
+
+		refree(&cod);
+		for (*ptr++ = '\0'; *ptr; ptr++) {
+		    if (*ptr == 'i')
+			flags |= RE_ICASE;
+		    else if (*ptr == 'n')
+			flags |= RE_NEWLINE;
+		}
+		ecode = recomp(&cod, buf + 1, flags);
+		failed = ecode;
+	    }
+	}
+	else if (buf[0] == '>') {
+	    if (cod.cod == NULL) {
+		fprintf(stderr, "no previous pattern at line %d\n", line);
+		break;
+	    }
+	    len = strlen(buf) - 1;
+	    buf[len] = '\0';
+	    strcpy(str, buf + 1);
+	    for (i = 0, --len; i < len - 1; i++) {
+		if (str[i] == '\\') {
+		    memmove(str + i, str + i + 1, len);
+		    --len;
+		    switch (str[i]) {
+			case 'a':
+			    str[i] = '\a';
+			    break;
+			case 'b':
+			    str[i] = '\b';
+			    break;
+			case 'f':
+			    str[i] = '\f';
+			    break;
+			case 'n':
+			    str[i] = '\n';
+			    break;
+			case 'r':
+			    str[i] = '\r';
+			    break;
+			case 't':
+			    str[i] = '\t';
+			    break;
+			case 'v':
+			    str[i] = '\v';
+			    break;
+			default:
+			    break;
+		    }
+		}
+	    }
+	    group = 0;
+	    ecode = reexec(&cod, str, 10, &mat[0], 0);
+	    if (ecode && ecode != RE_NOMATCH) {
+		reerror(failed, &cod, buf, sizeof(buf));
+		fprintf(stderr, "%s, at line %d\n", buf, line);
+		break;
+	    }
+	}
+	else if (buf[0] == ':') {
+	    if (failed) {
+		len = strlen(buf) - 1;
+		buf[len] = '\0';
+		if (failed == RE_EESCAPE && strcmp(buf, ":EESCAPE") == 0)
+		    continue;
+		if (failed == RE_ESUBREG && strcmp(buf, ":ESUBREG") == 0)
+		    continue;
+		if (failed == RE_EBRACK && strcmp(buf, ":EBRACK") == 0)
+		    continue;
+		if (failed == RE_EPAREN && strcmp(buf, ":EPAREN") == 0)
+		    continue;
+		if (failed == RE_EBRACE && strcmp(buf, ":EBRACE") == 0)
+		    continue;
+		if (failed == RE_EBADBR && strcmp(buf, ":EBADBR") == 0)
+		    continue;
+		if (failed == RE_ERANGE && strcmp(buf, ":ERANGE") == 0)
+		    continue;
+		if (failed == RE_ESPACE && strcmp(buf, ":ESPACE") == 0)
+		    continue;
+		if (failed == RE_BADRPT && strcmp(buf, ":BADRPT") == 0)
+		    continue;
+		if (failed == RE_EMPTY && strcmp(buf, ":EMPTY") == 0)
+		    continue;
+		reerror(failed, &cod, buf, sizeof(buf));
+		fprintf(stderr, "Error value %d doesn't match: %s, at line %d\n",
+			failed, buf, line);
+		break;
+	    }
+	    else if (!ecode) {
+		fprintf(stderr, "found match when shoudn't, at line %d\n", line);
+		break;
+	    }
+	}
+	else {
+	    if (failed) {
+		reerror(failed, &cod, buf, sizeof(buf));
+		fprintf(stderr, "%s, at line %d\n", line);
+		break;
+	    }
+	    if (sscanf(buf, "%ld,%ld:", &so, &eo) != 2) {
+		fprintf(stderr, "expecting match offsets at line %d\n", line);
+		break;
+	    }
+	    else if (ecode) {
+		fprintf(stderr, "didn't match, at line %d\n", line);
+		break;
+	    }
+	    else if (group >= 10) {
+		fprintf(stderr, "syntax error at line %d (too many groups)\n",
+			line);
+		break;
+	    }
+	    else if (so != mat[group].rm_so || eo != mat[group].rm_eo) {
+		fprintf(stderr, "match failed at line %d, got %ld,%ld: ",
+			line, mat[group].rm_so, mat[group].rm_eo);
+		if (mat[group].rm_so < mat[group].rm_eo)
+		    fwrite(str + mat[group].rm_so,
+		 	   mat[group].rm_eo - mat[group].rm_so, 1, stderr);
+		fputc('\n', stderr);
+		break;
+	    }
+	    ++group;
+	}
+    }
+
+    fclose(fp);
+
+    return (ecode);
+}
diff --git a/lisp/re/tests.txt b/lisp/re/tests.txt
new file mode 100644
index 0000000..e3da032
--- /dev/null
+++ b/lisp/re/tests.txt
@@ -0,0 +1,461 @@
+#
+#  Copyright (c) 2002 by The XFree86 Project, Inc.
+#
+#  Permission is hereby granted, free of charge, to any person obtaining a
+#  copy of this software and associated documentation files (the "Software"),
+#  to deal in the Software without restriction, including without limitation
+#  the rights to use, copy, modify, merge, publish, distribute, sublicense,
+#  and/or sell copies of the Software, and to permit persons to whom the
+#  Software is furnished to do so, subject to the following conditions:
+#
+#  The above copyright notice and this permission notice shall be included in
+#  all copies or substantial portions of the Software.
+#
+#  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+#  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+#  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+#  THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+#  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+#  OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+#  SOFTWARE.
+#
+#  Except as contained in this notice, the name of the XFree86 Project shall
+#  not be used in advertising or otherwise to promote the sale, use or other
+#  dealings in this Software without prior written authorization from the
+#  XFree86 Project.
+#
+#  Author: Paulo César Pereira de Andrade
+#
+#
+# $XFree86: xc/programs/xedit/lisp/re/tests.txt,v 1.3 2002/11/08 08:01:00 paulo Exp $
+
+# Some tests for the library:
+#	lines starting with # are comments
+#	lines starting with / are a regular expression pattern
+#		The pattern must end with / and may be followed by:
+#			i -> ignore case
+#			n -> create newline sensitive regex
+#	lines starting with > are a string input to the last pattern
+#		To test newline sensitive matching, add \n to the string.
+#	lines starting with a number are the expected result
+#		If more than one line, every subsequent line is the
+#		value of an "subresult".
+#	:NOMATCH means that the string input should not match
+
+# Simple string
+/abc/
+>abc
+0,3: abc
+>aaaaaaaaaaaaaaabc
+14,17: abc
+>xxxxxxxxxxxxxxaaaaaaaaaaaaaaaaabcxx
+30,33: abc
+
+# String list
+/abc|bcd|cde/
+>abc
+0,3: abc
+>aabc
+1,4: abc
+>xxxbcdef
+3,6: bcd
+>abdzzzcdabcde
+8,11: abc
+>xxxxabdecdabdcde
+13,16: cde
+
+# Complex string
+/a?bc|ab?c|abc?/
+>abc
+0,3: abc
+>xxxb
+:NOMATCH
+>xxxbc
+3,5: bc
+>sssssab
+5,7: ab
+
+# Another complex string
+/a*bc|ab*c|abc*/
+>aaaaaaabc
+0,9: aaaaaaabc
+>xaaaaaaabc
+1,10: aaaaaaabc
+>xyzaaaaaaabc
+3,12: aaaaaaabc
+>abbc
+0,4: abbc
+>xxabbbbbc
+2,9: abbbbbc
+>abcccccccccc
+0,12: abcccccccccc
+>abccccccccccd
+0,12: abcccccccccc
+>xxxxxxxaaaaaaaaaabbbbbbbbbbbccccccccccc
+16,29: abbbbbbbbbbbc
+>xxxbbbbbbbbbc
+11,13: bc
+
+# Another complex string
+/a+bc|ab+c|abc+/
+>xxxbc
+:NOMATCH
+>xaaabc
+1,6: aaabc
+>zzzzaaaaabbc
+8,12: abbc
+>zzzzaaaabbbbbbcccc
+7,15: abbbbbbc
+
+# Simple pattern
+/a.c/
+>abc
+0,3: abc
+>aaac
+1,4: aac
+>xac
+:NOMATCH
+>xaac
+1,4: aac
+>xxabc
+2,5: abc
+>xxxaxc
+3,6: axc
+
+# Another simple pattern
+/a*c/
+>c
+0,1: c
+>xxxxxxxxc
+8,9: c
+>xxxxxxxcc
+7,8: c
+>ac
+0,2: ac
+>aaaac
+0,5: aaaac
+>xac
+1,3: ac
+>xxxaac
+3,6: aac
+>xxac
+2,4: ac
+>xxxxac
+4,6: ac
+
+# Another simple pattern
+/a+c/
+>xxaac
+2,5: aac
+>xxxaaaac
+3,8: aaaac
+>xaaaabac
+6,8: ac
+>xxxc
+:NOMATCH
+>xxxxaaaaccc
+4,9: aaaac
+
+# Another simple pattern
+/a{4}b/
+>xabxxaabxxxaaabxxxxaaaab
+19,24: aaaab
+>aaabaaaab
+4,9: aaaab
+
+# Another simple pattern
+/a{4,}b/
+>xxxaaaab
+3,8: aaaab
+>zaaabzzzaaaaaaaaaaaaaaaab
+8,25: aaaaaaaaaaaaaaaab
+
+# Another simple pattern
+/a{,4}b/
+>b
+0,1: b
+>xxxxxxxxb
+8,9: b
+>xaaaaaaaaab
+6,11: aaaab
+>xxxab
+3,5: ab
+>aaaaaxaaab
+6,10: aaab
+
+# Another simple pattern
+/a{2,4}b/
+>xab
+:NOMATCH
+>xaab
+1,4: aab
+>xaaab
+1,5: aaab
+>xxaaaab
+2,7: aaaab
+>xxxaaaaab
+4,9: aaaab
+
+# Some simple grouping tests
+/foo(bar|baz)fee/
+>feebarbazfoobarfee
+9,18: foobarfee
+12,15: bar
+>foofooobazfeefoobazfee
+13,22: foobazfee
+/f(oo|ee)ba[rz]/
+>barfoebaz
+:NOMATCH
+>bazfoobar
+3,9: foobar
+4,6: oo
+>barfeebaz
+3,9: feebaz
+4,6: ee
+/\<(int|char)\>/
+>aint character int foo
+15,18: int
+15,18: int
+
+# Some complex repetitions
+/foo.*bar/
+>barfoblaboofoobarfoobarfoobar
+11,17: foobar
+/foo.+bar/
+>foobar
+:NOMATCH
+>fobbarfooxbarfooybar
+6,13: fooxbar
+/foo.?bar/
+>xfoobar
+1,7: foobar
+>xxfooxxbar
+:NOMATCH
+>yyyfootbar
+3,10: footbar
+
+# Some nested complex repetitions
+/a.*b.*c/
+>abc
+0,3: abc
+>xxxxxxxxxabbbbbbbccaaaaabbbc
+9,18: abbbbbbbc
+/a.+b.*c/
+>xxxabc 
+:NOMATCH
+>xxaxbbc
+2,7: axbbc
+/a.+b.?c/
+>xaabc
+1,5: aabc
+>xxaabbc
+2,7: aabbc
+
+# Very complex repetitions
+/(foo.*|bar)fee/
+# XXX NOTE
+# This pattern does not return the correct offset for the group.
+# Support for this may and may not be added.
+
+>barfoofee
+3,9: foofee
+>foobarfee
+0,9: foobarfee
+>xxfobarfee
+4,10: barfee
+>barfooooooobarfee
+3,17: fooooooobarfee
+>xxfobarfeefoobar
+4,10: barfee
+/(foo.+|bar)fee/
+>barfoofee
+:NOMATCH
+>barfooxfee
+3,10: fooxfee
+/(foo.?|bar)fee/
+>foobar
+:NOMATCH
+>bafoofee
+2,8:foofee
+>bafooofeebarfee
+2,9: fooofee
+>bafoofeebarfee
+2,8: foofee
+
+# Simple backreference
+/(a|b|c)\1/
+>aa
+0,2: aa
+0,1: a
+/(a|b|c)(a|b|c)\1\2/
+>acac
+0,4: acac
+0,1: a
+1,2: c
+>xxxxacac
+4,8: acac
+4,5: a
+5,6: c
+>xxacabacbcacbbacbcaaccabcaca
+24,28: caca
+24,25: c
+25,26: a
+>xyabcccc
+4,8: cccc
+4,5: c
+5,6: c
+
+# Complex backreference
+/(a*b)\1/
+>xxxaaaaabaaaaab
+3,15: aaaaabaaaaab
+3,9: aaaaab
+/(ab+c)\1/
+>xaaabbbcabbbc
+3,13: abbbcabbbc
+3,8: abbbc
+/(ab?c)\1/
+>abcac
+:NOMATCH
+>abcacabcabc
+5,11: abcabc
+5,8: abc
+>abcacac
+3,7: acac
+3,5: acac
+
+# Very complex backreference
+/a(.*)b\1/
+>xxxab
+3,5: ab
+4,4: 
+>xxxxazzzbzzz
+4,12: azzzbzzz
+5,8: zzz
+
+# Case testing
+/abc/i
+>AbC
+0,3: AbC
+/[0-9][a-z]+/i
+>xxx0aaZxYT9
+3,10: 0aaZxYT
+/a.b/i
+>aaaaaaaaaaaxB
+10,13: axB
+/a.*z/i
+>xxxAaaaaZ
+3,9: AaaaaZ
+>xxaaaZaaa
+2,6: aaaZ
+/\<(lambda|defun|defmacro)\>/i
+>    (lambda
+5,11: lambda
+5,11: lambda
+/\<(nil|t)\>/i
+>it Nil
+3,6: Nil
+3,6: Nil
+/\<(begin|end)\>/i
+>beginning the ending EnD
+21,24: EnD
+21,24: EnD
+
+# Some newline tests
+/a.*/n
+>a\naaa
+0,1:a
+>xyza\naa
+3,4: a
+/a.+/n
+>a\naaa
+2,5: aaa
+>xyza\naa
+5,7: aa
+/a.?/n
+>a\naaa
+0,1: a
+>xyza\naa
+3,4: a
+
+# Newline tests envolving complex patterns
+/a.*b.*c/n
+>xxaa\nzyacb\nabc
+11,14: abc
+>xxxab\nabc\nc
+6,9: abc
+/a.+b.*c/n
+>ab\nbc\nabbc
+6,10: abbc
+/a.?b.*c/n
+>ab\ncabbc\ncc
+4,8: abbc
+/^foo$/n
+>bar\nfoobar\nfoo
+11,14: foo
+
+# Not so complex test involving a newline...
+/^\s*#\s*(define|include)\s+.+/n
+>#define\n#include x
+8,18: #include x
+9,16: include
+
+# Check if large strings are working
+/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx/
+>zzzxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxzzz
+3,259: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+/ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~/
+>String here: ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~/
+13,333: ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~
+
+
+# Some complex repetitions not supported
+# Listed here only to make sure the library is not crashing on these
+#  Repetitions that match an empty match, or an empty string cannot follow
+# a complex repetition. A complex repetition is:
+#	.* or .+ or .?
+#	.{...} is not supported.
+/(.*)(\d*)/
+:BADRPT
+/(.*).(\d*)/
+:BADRPT
+/(.*)\<(\d*)/
+:BADRPT
+/(.*)\s(\d*)/
+:BADRPT
+/(.*)\D(\d*)/
+:BADRPT
+
+# This is a more clear pattern and partially works
+/(.*)\D(\d+)/
+>abcW12
+0,6: abcW12
+0,3: abc
+4,6: 12
+>abcW12abcW12
+0,6: abcW12
+0,3: abc
+4,6: 12
+# This wasn't working in the previous version, but now with only minimal
+# matches supported, it works.
+>abcW12abcW12a
+0,6: abcW12
+0,3: abc
+4,6: 12
+
+# Note the minimal match
+/.*\d/
+>a1a1a1aaaaaaa
+0,2: a1
+# Check match offsets
+/(.*)\d/
+>a1a1a1aaaaaaa
+0,2: a1
+0,1: a
+/.*(\d)/
+>a1a1a1aaaaaaa
+0,2: a1
+1,2: 1
+
+/.*(\d+)/
+:BADRPT
diff --git a/lisp/read.c b/lisp/read.c
new file mode 100644
index 0000000..b8872a2
--- /dev/null
+++ b/lisp/read.c
@@ -0,0 +1,2058 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/read.c,v 1.34 2003/01/13 03:57:58 paulo Exp $ */
+
+#include <errno.h>
+#include "read.h"
+#include "package.h"
+#include "write.h"
+#include <fcntl.h>
+#include <stdarg.h>
+
+/* This should be visible only in read.c, but if an error is generated,
+ * the current code in write.c will print it as #<ERROR> */
+#define LABEL_BIT_COUNT		8
+#define LABEL_BIT_MASK		0xff
+#define MAX_LABEL_VALUE		((1L << (sizeof(long) * 8 - 9)) - 1)
+#define READLABEL(label)						\
+    (LispObj*)(((label) << LABEL_BIT_COUNT) | READLABEL_MASK)
+#define READLABELP(object)						\
+    (((unsigned long)(object) & LABEL_BIT_MASK) == READLABEL_MASK)
+#define READLABEL_VALUE(object)						\
+    ((long)(object) >> LABEL_BIT_COUNT)
+
+#define READ_ENTER()							\
+    LispObj *read__stream = SINPUT;					\
+    int read__line = LispGetLine(read__stream)
+#define READ_ERROR0(format)						\
+    LispReadError(read__stream, read__line, format)
+#define READ_ERROR1(format, arg1)					\
+    LispReadError(read__stream, read__line, format, arg1)
+#define READ_ERROR2(format, arg1, arg2)					\
+    LispReadError(read__stream, read__line, format, arg1, arg2)
+
+#define READ_ERROR_EOF()	READ_ERROR0("unexpected end of input")
+#define READ_ERROR_FIXNUM()	READ_ERROR0("number is not a fixnum")
+#define READ_ERROR_INVARG()	READ_ERROR0("invalid argument")
+
+/*
+ * Types
+ */
+typedef struct _object_info {
+    long label;		/* the read label of this object */
+    LispObj *object;	/* the resulting object */
+    long num_circles;	/* references to object before it was completely read */
+} object_info;
+
+typedef struct _read_info {
+    int level;		/* level of open parentheses */
+
+    int nodot;		/* flag set when reading a "special" list */
+
+    int discard;	/* flag used when reading an unavailable feature */
+
+    long circle_count;	/* if non zero, must resolve some labels */
+
+    /* information for #<number>= and #<number># */
+    object_info *objects;
+    long num_objects;
+
+    /* could use only the objects field as all circular data is known,
+     * but check every object so that circular/shared references generated
+     * by evaluations would not cause an infinite loop at read time */
+    LispObj **circles;
+    long num_circles;
+} read_info;
+
+/*
+ * Protypes
+ */
+static LispObj *LispReadChar(LispBuiltin*, int);
+
+static int LispGetLine(LispObj*);
+#ifdef __GNUC__
+#define PRINTF_FORMAT	__attribute__ ((format (printf, 3, 4)))
+#else
+#define PRINTF_FORMAT	/**/
+#endif
+static void LispReadError(LispObj*, int, char*, ...);
+#undef PRINTF_FORMAT
+static void LispReadFixCircle(LispObj*, read_info*);
+static LispObj *LispReadLabelCircle(LispObj*, read_info*);
+static int LispReadCheckCircle(LispObj*, read_info*);
+static LispObj *LispDoRead(read_info*);
+static int LispSkipWhiteSpace(void);
+static LispObj *LispReadList(read_info*);
+static LispObj *LispReadQuote(read_info*);
+static LispObj *LispReadBackquote(read_info*);
+static LispObj *LispReadCommaquote(read_info*);
+static LispObj *LispReadObject(int, read_info*);
+static LispObj *LispParseAtom(char*, char*, int, int, LispObj*, int);
+static LispObj *LispParseNumber(char*, int, LispObj*, int);
+static int StringInRadix(char*, int, int);
+static int AtomSeparator(int, int, int);
+static LispObj *LispReadVector(read_info*);
+static LispObj *LispReadMacro(read_info*);
+static LispObj *LispReadFunction(read_info*);
+static LispObj *LispReadRational(int, read_info*);
+static LispObj *LispReadCharacter(read_info*);
+static void LispSkipComment(void);
+static LispObj *LispReadEval(read_info*);
+static LispObj *LispReadComplex(read_info*);
+static LispObj *LispReadPathname(read_info*);
+static LispObj *LispReadStruct(read_info*);
+static LispObj *LispReadMacroArg(read_info*);
+static LispObj *LispReadArray(long, read_info*);
+static LispObj *LispReadFeature(int, read_info*);
+static LispObj *LispEvalFeature(LispObj*);
+
+/*
+ * Initialization
+ */
+static char *Char_Nul[] = {"Null", "Nul", NULL};
+static char *Char_Soh[] = {"Soh", NULL};
+static char *Char_Stx[] = {"Stx", NULL};
+static char *Char_Etx[] = {"Etx", NULL};
+static char *Char_Eot[] = {"Eot", NULL};
+static char *Char_Enq[] = {"Enq", NULL};
+static char *Char_Ack[] = {"Ack", NULL};
+static char *Char_Bel[] = {"Bell", "Bel", NULL};
+static char *Char_Bs[]  = {"Backspace", "Bs", NULL};
+static char *Char_Tab[] = {"Tab", NULL};
+static char *Char_Nl[]  = {"Newline", "Nl", "Lf", "Linefeed", NULL};
+static char *Char_Vt[]  = {"Vt", NULL};
+static char *Char_Np[]  = {"Page", "Np", NULL};
+static char *Char_Cr[]  = {"Return", "Cr", NULL};
+static char *Char_Ff[]  = {"So", "Ff", NULL};
+static char *Char_Si[]  = {"Si", NULL};
+static char *Char_Dle[] = {"Dle", NULL};
+static char *Char_Dc1[] = {"Dc1", NULL};
+static char *Char_Dc2[] = {"Dc2", NULL};
+static char *Char_Dc3[] = {"Dc3", NULL};
+static char *Char_Dc4[] = {"Dc4", NULL};
+static char *Char_Nak[] = {"Nak", NULL};
+static char *Char_Syn[] = {"Syn", NULL};
+static char *Char_Etb[] = {"Etb", NULL};
+static char *Char_Can[] = {"Can", NULL};
+static char *Char_Em[]  = {"Em", NULL};
+static char *Char_Sub[] = {"Sub", NULL};
+static char *Char_Esc[] = {"Escape", "Esc", NULL};
+static char *Char_Fs[]  = {"Fs", NULL};
+static char *Char_Gs[]  = {"Gs", NULL};
+static char *Char_Rs[]  = {"Rs", NULL};
+static char *Char_Us[]  = {"Us", NULL};
+static char *Char_Sp[]  = {"Space", "Sp", NULL};
+static char *Char_Del[] = {"Rubout", "Del", "Delete", NULL};
+
+LispCharInfo LispChars[256] = {
+    {Char_Nul},
+    {Char_Soh},
+    {Char_Stx},
+    {Char_Etx},
+    {Char_Eot},
+    {Char_Enq},
+    {Char_Ack},
+    {Char_Bel},
+    {Char_Bs},
+    {Char_Tab},
+    {Char_Nl},
+    {Char_Vt},
+    {Char_Np},
+    {Char_Cr},
+    {Char_Ff},
+    {Char_Si},
+    {Char_Dle},
+    {Char_Dc1},
+    {Char_Dc2},
+    {Char_Dc3},
+    {Char_Dc4},
+    {Char_Nak},
+    {Char_Syn},
+    {Char_Etb},
+    {Char_Can},
+    {Char_Em},
+    {Char_Sub},
+    {Char_Esc},
+    {Char_Fs},
+    {Char_Gs},
+    {Char_Rs},
+    {Char_Us},
+    {Char_Sp},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {Char_Del},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL},
+    {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}, {NULL}
+    
+};
+
+Atom_id Sand, Sor, Snot;
+
+
+/*
+ * Implementation
+ */
+LispObj *
+Lisp_Read(LispBuiltin *builtin)
+/*
+ read &optional input-stream eof-error-p eof-value recursive-p
+ */
+{
+    LispObj *result;
+
+    LispObj *input_stream, *eof_error_p, *eof_value, *recursive_p;
+
+    recursive_p = ARGUMENT(3);
+    eof_value = ARGUMENT(2);
+    eof_error_p = ARGUMENT(1);
+    input_stream = ARGUMENT(0);
+
+    if (input_stream == UNSPEC)
+	input_stream = NIL;
+    else if (input_stream != NIL) {
+	CHECK_STREAM(input_stream);
+	else if (!input_stream->data.stream.readable)
+	    LispDestroy("%s: stream %s is not readable",
+			STRFUN(builtin), STROBJ(input_stream));
+	LispPushInput(input_stream);
+    }
+    else if (CONSP(lisp__data.input_list)) {
+	input_stream = STANDARD_INPUT;
+	LispPushInput(input_stream);
+    }
+
+    if (eof_value == UNSPEC)
+	eof_value = NIL;
+
+    result = LispRead();
+    if (input_stream != NIL)
+	LispPopInput(input_stream);
+
+    if (result == NULL) {
+	if (eof_error_p != NIL)
+	    LispDestroy("%s: EOF reading stream %s",
+			STRFUN(builtin), STROBJ(input_stream));
+	else
+	    result = eof_value;
+    }
+
+    return (result);
+}
+
+static LispObj *
+LispReadChar(LispBuiltin *builtin, int nohang)
+{
+    int character;
+    LispObj *result;
+
+    LispObj *input_stream, *eof_error_p, *eof_value, *recursive_p;
+
+    recursive_p = ARGUMENT(3);
+    eof_value = ARGUMENT(2);
+    eof_error_p = ARGUMENT(1);
+    input_stream = ARGUMENT(0);
+
+    if (input_stream == UNSPEC)
+	input_stream = NIL;
+    else if (input_stream != NIL) {
+	CHECK_STREAM(input_stream);
+    }
+    else
+	input_stream = lisp__data.input;
+
+    if (eof_value == UNSPEC)
+	eof_value = NIL;
+
+    result = NIL;
+    character = EOF;
+
+    if (input_stream->data.stream.readable) {
+	LispFile *file = NULL;
+
+	switch (input_stream->data.stream.type) {
+	    case LispStreamStandard:
+	    case LispStreamFile:
+		file = FSTREAMP(input_stream);
+		break;
+	    case LispStreamPipe:
+		file = IPSTREAMP(input_stream);
+		break;
+	    case LispStreamString:
+		character = LispSgetc(SSTREAMP(input_stream));
+		break;
+	    default:
+		break;
+	}
+	if (file != NULL) {
+	    if (file->available || file->offset < file->length)
+		character = LispFgetc(file);
+	    else {
+		if (nohang && !file->nonblock) {
+		    if (fcntl(file->descriptor, F_SETFL, O_NONBLOCK) < 0)
+			LispDestroy("%s: fcntl(%d): %s",
+				    STRFUN(builtin), file->descriptor,
+				    strerror(errno));
+		    file->nonblock = 1;
+		}
+		else if (!nohang && file->nonblock) {
+		    if (fcntl(file->descriptor, F_SETFL, 0) < 0)
+			LispDestroy("%s: fcntl(%d): %s",
+				    STRFUN(builtin), file->descriptor,
+				    strerror(errno));
+		    file->nonblock = 0;
+		}
+		if (nohang) {
+		    unsigned char ch;
+
+		    if (read(file->descriptor, &ch, 1) == 1)
+			character = ch;
+		    else if (errno == EAGAIN)
+			return (NIL);	/* XXX no character available */
+		    else
+			character = EOF;
+		}
+		else
+		    character = LispFgetc(file);
+	    }
+	}
+    }
+    else
+	LispDestroy("%s: stream %s is unreadable",
+		    STRFUN(builtin), STROBJ(input_stream));
+
+    if (character == EOF) {
+	if (eof_error_p != NIL)
+	    LispDestroy("%s: EOF reading stream %s",
+			STRFUN(builtin), STROBJ(input_stream));
+
+	return (eof_value);
+    }
+
+    return (SCHAR(character));
+}
+
+LispObj *
+Lisp_ReadChar(LispBuiltin *builtin)
+/*
+ read-char &optional input-stream eof-error-p eof-value recursive-p
+ */
+{
+    return (LispReadChar(builtin, 0));
+}
+
+LispObj *
+Lisp_ReadCharNoHang(LispBuiltin *builtin)
+/*
+ read-char-no-hang &optional input-stream eof-error-p eof-value recursive-p
+ */
+{
+    return (LispReadChar(builtin, 1));
+}
+
+LispObj *
+Lisp_ReadLine(LispBuiltin *builtin)
+/*
+ read-line &optional input-stream eof-error-p eof-value recursive-p
+ */
+{
+    char *string;
+    int ch, length;
+    LispObj *result, *status = NIL;
+
+    LispObj *input_stream, *eof_error_p, *eof_value, *recursive_p;
+
+    recursive_p = ARGUMENT(3);
+    eof_value = ARGUMENT(2);
+    eof_error_p = ARGUMENT(1);
+    input_stream = ARGUMENT(0);
+
+    if (input_stream == UNSPEC)
+	input_stream = NIL;
+    else if (input_stream == NIL)
+	input_stream = STANDARD_INPUT;
+    else {
+	CHECK_STREAM(input_stream);
+    }
+
+    if (eof_value == UNSPEC)
+	eof_value = NIL;
+
+    result = NIL;
+    string = NULL;
+    length = 0;
+
+    if (!input_stream->data.stream.readable)
+	LispDestroy("%s: stream %s is unreadable",
+		    STRFUN(builtin), STROBJ(input_stream));
+    if (input_stream->data.stream.type == LispStreamString) {
+	char *start, *end, *ptr;
+
+	if (SSTREAMP(input_stream)->input >=
+	    SSTREAMP(input_stream)->length) {
+	    if (eof_error_p != NIL)
+		LispDestroy("%s: EOS found reading %s",
+			    STRFUN(builtin), STROBJ(input_stream));
+
+	    status = T;
+	    result = eof_value;
+	    goto read_line_done;
+	}
+
+	start = SSTREAMP(input_stream)->string +
+		SSTREAMP(input_stream)->input;
+	end = SSTREAMP(input_stream)->string +
+	      SSTREAMP(input_stream)->length;
+	/* Search for a newline */
+	for (ptr = start; *ptr != '\n' && ptr < end; ptr++)
+	    ;
+	if (ptr == end)
+	    status = T;
+	else if (!SSTREAMP(input_stream)->binary)
+	    ++SSTREAMP(input_stream)->line;
+	length = ptr - start;
+	string = LispMalloc(length + 1);
+	memcpy(string, start, length);
+	string[length] = '\0';
+	result = LSTRING2(string, length);
+	/* macro LSTRING2 does not make a copy of it's arguments, and
+	 * calls LispMused on it. */
+	SSTREAMP(input_stream)->input += length + (status == NIL);
+    }
+    else /*if (input_stream->data.stream.type == LispStreamFile ||
+	     input_stream->data.stream.type == LispStreamStandard ||
+	     input_stream->data.stream.type == LispStreamPipe)*/ {
+	LispFile *file;
+
+	if (input_stream->data.stream.type == LispStreamPipe)
+	    file = IPSTREAMP(input_stream);
+	else
+	    file = FSTREAMP(input_stream);
+
+	if (file->nonblock) {
+	    if (fcntl(file->descriptor, F_SETFL, 0) < 0)
+		LispDestroy("%s: fcntl: %s",
+			    STRFUN(builtin), strerror(errno));
+	    file->nonblock = 0;
+	}
+
+	while (1) {
+	    ch = LispFgetc(file);
+	    if (ch == EOF) {
+		if (length)
+		    break;
+		if (eof_error_p != NIL)
+		    LispDestroy("%s: EOF found reading %s",
+				STRFUN(builtin), STROBJ(input_stream));
+		if (string)
+		    LispFree(string);
+
+		status = T;
+		result = eof_value;
+		goto read_line_done;
+	    }
+	    else if (ch == '\n')
+		break;
+	    else if ((length % 64) == 0)
+		string = LispRealloc(string, length + 64);
+	    string[length++] = ch;
+	}
+	if (string) {
+	    if ((length % 64) == 0)
+		string = LispRealloc(string, length + 1);
+	    string[length] = '\0';
+	    result = LSTRING2(string, length);
+	}
+	else
+	    result = STRING("");
+    }
+
+read_line_done:
+    RETURN(0) = status;
+    RETURN_COUNT = 1;
+
+    return (result);
+}
+
+LispObj *
+LispRead(void)
+{
+    READ_ENTER();
+    read_info info;
+    LispObj *result, *code = COD;
+
+    info.level = info.nodot = info.discard = 0;
+    info.circle_count = 0;
+    info.objects = NULL;
+    info.num_objects = 0;
+
+    result = LispDoRead(&info);
+
+    /* fix circular/shared lists, note that this is done when returning to
+     * the toplevel, so, if some circular/shared reference was evaluated,
+     * it should have generated an expected error */
+    if (info.num_objects) {
+	if (info.circle_count) {
+	    info.circles = NULL;
+	    info.num_circles = 0;
+	    LispReadFixCircle(result, &info);
+	    if (info.num_circles)
+		LispFree(info.circles);
+	}
+	LispFree(info.objects);
+    }
+
+    if (result == EOLIST)
+	READ_ERROR0("object cannot start with #\\)");
+    else if (result == DOT)
+	READ_ERROR0("dot allowed only on lists");
+
+    if (result != NULL && POINTERP(result)) {
+	if (code == NIL)
+	    COD = result;
+	else
+	    COD = CONS(COD, result);
+    }
+
+    return (result);
+}
+
+static int
+LispGetLine(LispObj *stream)
+{
+    int line = -1;
+
+    if (STREAMP(stream)) {
+	switch (stream->data.stream.type) {
+	    case LispStreamStandard:
+	    case LispStreamFile:
+		if (!FSTREAMP(stream)->binary)
+		    line = FSTREAMP(stream)->line;
+		break;
+	    case LispStreamPipe:
+		if (!IPSTREAMP(stream)->binary)
+		    line = IPSTREAMP(stream)->line;
+		break;
+	    case LispStreamString:
+		if (!SSTREAMP(stream)->binary)
+		    line = SSTREAMP(stream)->line;
+		break;
+	    default:
+		break;
+	}
+    }
+    else if (stream == NIL && !Stdin->binary)
+	line = Stdin->line;
+
+    return (line);
+}
+
+static void
+LispReadError(LispObj *stream, int line, char *fmt, ...)
+{
+    char string[128], *buffer_string;
+    LispObj *buffer = LSTRINGSTREAM("", STREAM_READ | STREAM_WRITE, 0);
+    int length;
+    va_list ap;
+
+    va_start(ap, fmt);
+    vsnprintf(string, sizeof(string), fmt, ap);
+    va_end(ap);
+
+    LispFwrite(Stderr, "*** Reading ", 12);
+    LispWriteObject(buffer, stream);
+    buffer_string = LispGetSstring(SSTREAMP(buffer), &length);
+    LispFwrite(Stderr, buffer_string, length);
+    LispFwrite(Stderr, " at line ", 9);
+    if (line < 0)
+	LispFwrite(Stderr, "?\n", 2);
+    else {
+	char str[32];
+
+	sprintf(str, "%d\n", line);
+	LispFputs(Stderr, str);
+    }
+
+    LispDestroy("READ: %s", string);
+}
+
+static void
+LispReadFixCircle(LispObj *object, read_info *info)
+{
+    LispObj *cons;
+
+fix_again:
+    switch (OBJECT_TYPE(object)) {
+	case LispCons_t:
+	    for (cons = object;
+		 CONSP(object);
+		 cons = object, object = CDR(object)) {
+		if (READLABELP(CAR(object)))
+		    CAR(object) = LispReadLabelCircle(CAR(object), info);
+		else if (LispReadCheckCircle(object, info))
+		    return;
+		else
+		    LispReadFixCircle(CAR(object), info);
+	    }
+	    if (READLABELP(object))
+		CDR(cons) = LispReadLabelCircle(object, info);
+	    else
+		goto fix_again;
+	    break;
+	case LispArray_t:
+	    if (READLABELP(object->data.array.list))
+		object->data.array.list =
+		    LispReadLabelCircle(object->data.array.list, info);
+	    else if (!LispReadCheckCircle(object, info)) {
+		object = object->data.array.list;
+		goto fix_again;
+	    }
+	    break;
+	case LispStruct_t:
+	    if (READLABELP(object->data.struc.fields))
+		object->data.struc.fields =
+		    LispReadLabelCircle(object->data.struc.fields, info);
+	    else if (!LispReadCheckCircle(object, info)) {
+		object = object->data.struc.fields;
+		goto fix_again;
+	    }
+	    break;
+	case LispQuote_t:
+	case LispBackquote_t:
+	case LispFunctionQuote_t:
+	    if (READLABELP(object->data.quote))
+		object->data.quote =
+		    LispReadLabelCircle(object->data.quote, info);
+	    else {
+		object = object->data.quote;
+		goto fix_again;
+	    }
+	    break;
+	case LispComma_t:
+	    if (READLABELP(object->data.comma.eval))
+		object->data.comma.eval =
+		    LispReadLabelCircle(object->data.comma.eval, info);
+	    else {
+		object = object->data.comma.eval;
+		goto fix_again;
+	    }
+	    break;
+	case LispLambda_t:
+	    if (READLABELP(object->data.lambda.code))
+		object->data.lambda.code =
+		    LispReadLabelCircle(object->data.lambda.code, info);
+	    else if (!LispReadCheckCircle(object, info)) {
+		object = object->data.lambda.code;
+		goto fix_again;
+	    }
+	    break;
+	default:
+	    break;
+    }
+}
+
+static LispObj *
+LispReadLabelCircle(LispObj *label, read_info *info)
+{
+    long i, value = READLABEL_VALUE(label);
+
+    for (i = 0; i < info->num_objects; i++)
+	if (info->objects[i].label == value)
+	    return (info->objects[i].object);
+
+    LispDestroy("READ: internal error");
+    /*NOTREACHED*/
+    return (label);
+}
+
+static int
+LispReadCheckCircle(LispObj *object, read_info *info)
+{
+    long i;
+
+    for (i = 0; i < info->num_circles; i++)
+	if (info->circles[i] == object)
+	    return (1);
+
+    if ((info->num_circles % 16) == 0)
+	info->circles = LispRealloc(info->circles, sizeof(LispObj*) *
+				    (info->num_circles + 16));
+    info->circles[info->num_circles++] = object;
+
+    return (0);
+}
+
+static LispObj *
+LispDoRead(read_info *info)
+{
+    LispObj *object;
+    int ch = LispSkipWhiteSpace();
+
+    switch (ch) {
+	case '(':
+	    object = LispReadList(info);
+	    break;
+	case ')':
+	    for (ch = LispGet(); ch != EOF && ch != '\n'; ch = LispGet()) {
+		if (!isspace(ch)) {
+		    LispUnget(ch);
+		    break;
+		}
+	    }
+	    return (EOLIST);
+	case EOF:
+	    return (NULL);
+	case '\'':
+	    object = LispReadQuote(info);
+	    break;
+	case '`':
+	    object = LispReadBackquote(info);
+	    break;
+	case ',':
+	    object = LispReadCommaquote(info);
+	    break;
+	case '#':
+	    object = LispReadMacro(info);
+	    break;
+	default:
+	    LispUnget(ch);
+	    object = LispReadObject(0, info);
+	    break;
+    }
+
+    return (object);
+}
+
+static LispObj *
+LispReadMacro(read_info *info)
+{
+    READ_ENTER();
+    LispObj *result = NULL;
+    int ch = LispGet();
+
+    switch (ch) {
+	case '(':
+	    result = LispReadVector(info);
+	    break;
+	case '\'':
+	   result = LispReadFunction(info);
+	   break;
+	case 'b':
+	case 'B':
+	    result = LispReadRational(2, info);
+	    break;
+	case 'o':
+	case 'O':
+	    result = LispReadRational(8, info);
+	    break;
+	case 'x':
+	case 'X':
+	    result = LispReadRational(16, info);
+	    break;
+	case '\\':
+	    result = LispReadCharacter(info);
+	    break;
+	case '|':
+	    LispSkipComment();
+	    result = LispDoRead(info);
+	    break;
+	case '.':	/* eval when compiling */
+	case ',':	/* eval when loading */
+	    result = LispReadEval(info);
+	    break;
+	case 'c':
+	case 'C':
+	    result = LispReadComplex(info);
+	    break;
+	case 'p':
+	case 'P':
+	    result = LispReadPathname(info);
+	    break;
+	case 's':
+	case 'S':
+	    result = LispReadStruct(info);
+	    break;
+	case '+':
+	    result = LispReadFeature(1, info);
+	    break;
+	case '-':
+	    result = LispReadFeature(0, info);
+	    break;
+	case ':':
+	    /* Uninterned symbol */
+	    result = LispReadObject(1, info);
+	    break;
+	default:
+	    if (isdigit(ch)) {
+		LispUnget(ch);
+		result = LispReadMacroArg(info);
+	    }
+	    else if (!info->discard)
+		READ_ERROR1("undefined dispatch macro character #%c", ch);
+	    break;
+    }
+
+    return (result);
+}
+
+static LispObj *
+LispReadMacroArg(read_info *info)
+{
+    READ_ENTER();
+    LispObj *result = NIL;
+    long i, integer;
+    int ch;
+
+    /* skip leading zeros */
+    while (ch = LispGet(), ch != EOF && isdigit(ch) && ch == '0')
+	;
+
+    if (ch == EOF)
+	READ_ERROR_EOF();
+
+    /* if ch is not a number the argument was zero */
+    if (isdigit(ch)) {
+	char stk[32], *str;
+	int len = 1;
+
+	stk[0] = ch;
+	for (;;) {
+	    ch = LispGet();
+	    if (!isdigit(ch))
+		break;
+	    if (len + 1 >= sizeof(stk))
+		READ_ERROR_FIXNUM();
+	    stk[len++] = ch;
+	}
+	stk[len] = '\0';
+	errno = 0;
+	integer = strtol(stk, &str, 10);
+	/* number is positive because sign is not processed here */
+	if (*str || errno == ERANGE || integer > MOST_POSITIVE_FIXNUM)
+	    READ_ERROR_FIXNUM();
+    }
+    else
+	integer = 0;
+
+    switch (ch) {
+	case 'a':
+	case 'A':
+	    if (integer == 1) {
+		/* LispReadArray and LispReadList expect
+		 * the '(' being already read  */
+		if ((ch = LispSkipWhiteSpace()) != '(') {
+		    if (info->discard)
+			return (ch == EOF ? NULL : NIL);
+		    READ_ERROR0("bad array specification");
+		}
+		result = LispReadVector(info);
+	    }
+	    else
+		result = LispReadArray(integer, info);
+	    break;
+	case 'r':
+	case 'R':
+	    result = LispReadRational(integer, info);
+	    break;
+	case '=':
+	    if (integer > MAX_LABEL_VALUE)
+		READ_ERROR_FIXNUM();
+	    if (!info->discard) {
+		long num_objects = info->num_objects;
+
+		/* check for duplicated label */
+		for (i = 0; i < info->num_objects; i++) {
+		    if (info->objects[i].label == integer)
+			READ_ERROR1("label #%ld# defined more than once",
+				    integer);
+		}
+		info->objects = LispRealloc(info->objects,
+					    sizeof(object_info) *
+					    (num_objects + 1));
+		/* if this label is referenced it is a shared/circular object */
+		info->objects[num_objects].label = integer;
+		info->objects[num_objects].object = NULL;
+		info->objects[num_objects].num_circles = 0;
+		++info->num_objects;
+		result = LispDoRead(info);
+		if (READLABELP(result) && READLABEL_VALUE(result) == integer)
+		    READ_ERROR2("incorrect syntax #%ld= #%ld#",
+				integer, integer);
+		/* any reference to it now is not shared/circular */
+		info->objects[num_objects].object = result;
+	    }
+	    else
+		result = LispDoRead(info);
+	    break;
+	case '#':
+	    if (integer > MAX_LABEL_VALUE)
+		READ_ERROR_FIXNUM();
+	    if (!info->discard) {
+		/* search object */
+		for (i = 0; i < info->num_objects; i++) {
+		    if (info->objects[i].label == integer) {
+			result = info->objects[i].object;
+			if (result == NULL) {
+			    ++info->objects[i].num_circles;
+			    ++info->circle_count;
+			    result = READLABEL(integer);
+			}
+			break;
+		    }
+		}
+		if (i == info->num_objects)
+		    READ_ERROR1("undefined label #%ld#", integer);
+	    }
+	    break;
+	default:
+	    if (!info->discard)
+		READ_ERROR1("undefined dispatch macro character #%c", ch);
+	    break;
+    }
+
+    return (result);
+}
+
+static int
+LispSkipWhiteSpace(void)
+{
+    int ch;
+
+    for (;;) {
+	while (ch = LispGet(), isspace(ch) && ch != EOF)
+	    ;
+	if (ch == ';') {
+	    while (ch = LispGet(), ch != '\n' && ch != EOF)
+		;
+	    if (ch == EOF)
+		return (EOF);
+	}
+	else
+	    break;
+    }
+
+    return (ch);
+}
+
+/* any data in the format '(' FORM ')' is read here */
+static LispObj *
+LispReadList(read_info *info)
+{
+    READ_ENTER();
+    GC_ENTER();
+    LispObj *result, *cons, *object;
+    int dot = 0;
+
+    ++info->level;
+    /* check for () */
+    object = LispDoRead(info);
+    if (object == EOLIST) {
+	--info->level;
+
+	return (NIL);
+    }
+
+    if (object == DOT)
+	READ_ERROR0("illegal start of dotted list");
+
+    result = cons = CONS(object, NIL);
+
+    /* make sure GC will not release data being read */
+    GC_PROTECT(result);
+
+    while ((object = LispDoRead(info)) != EOLIST) {
+	if (object == NULL)
+	    READ_ERROR_EOF();
+	if (object == DOT) {
+	    if (info->nodot == info->level)
+		READ_ERROR0("dotted list not allowed");
+	    /* this is a dotted list */
+	    if (dot)
+		READ_ERROR0("more than one . in list");
+	    dot = 1;
+	}
+	else {
+	    if (dot) {
+		/* only one object after a dot */
+		if (++dot > 2)
+		    READ_ERROR0("more than one object after . in list");
+		RPLACD(cons, object);
+	    }
+	    else {
+		RPLACD(cons, CONS(object, NIL));
+		cons = CDR(cons);
+	    }
+	}
+    }
+
+    /* this will happen if last list element was a dot */
+    if (dot == 1)
+	READ_ERROR0("illegal end of dotted list");
+
+    --info->level;
+    GC_LEAVE();
+
+    return (result);
+}
+
+static LispObj *
+LispReadQuote(read_info *info)
+{
+    READ_ENTER();
+    LispObj *quote = LispDoRead(info), *result;
+
+    if (INVALIDP(quote))
+	READ_ERROR_INVARG();
+
+    result = QUOTE(quote);
+
+    return (result);
+}
+
+static LispObj *
+LispReadBackquote(read_info *info)
+{
+    READ_ENTER();
+    LispObj *backquote = LispDoRead(info), *result;
+
+    if (INVALIDP(backquote))
+	READ_ERROR_INVARG();
+
+    result = BACKQUOTE(backquote);
+
+    return (result);
+}
+
+static LispObj *
+LispReadCommaquote(read_info *info)
+{
+    READ_ENTER();
+    LispObj *comma, *result;
+    int atlist = LispGet();
+
+    if (atlist == EOF)
+	READ_ERROR_EOF();
+    else if (atlist != '@' && atlist != '.')
+	LispUnget(atlist);
+
+    comma = LispDoRead(info);
+    if (comma == DOT) {
+	atlist = '@';
+	comma = LispDoRead(info);
+    }
+    if (INVALIDP(comma))
+	READ_ERROR_INVARG();
+
+    result = COMMA(comma, atlist == '@' || atlist == '.');
+
+    return (result);
+}
+
+/*
+ * Read anything that is not readily identifiable by it's first character
+ * and also put the code for reading atoms, numbers and strings together.
+ */
+static LispObj *
+LispReadObject(int unintern, read_info *info)
+{
+    READ_ENTER();
+    LispObj *object;
+    char stk[128], *string, *package, *symbol;
+    int ch, length, backslash, size, quote, unreadable, collon;
+
+    package = symbol = string = stk;
+    size = sizeof(stk);
+    backslash = quote = unreadable = collon = 0;
+    length = 0;
+
+    ch = LispGet();
+    if (unintern && (ch == ':' || ch == '"'))
+	READ_ERROR0("syntax error after #:");
+    else if (ch == '"' || ch == '|')
+	quote = ch;
+    else if (ch == '\\') {
+	unreadable = backslash = 1;
+	string[length++] = ch;
+    }
+    else if (ch == ':') {
+	collon = 1;
+	string[length++] = ch;
+	symbol = string + 1;
+    }
+    else if (ch) {
+	if (islower(ch))
+	    ch = toupper(ch);
+	string[length++] = ch;
+    }
+    else
+	unreadable = 1;
+
+    /* read remaining data */
+    for (; ch;) {
+	ch = LispGet();
+
+	if (ch == EOF) {
+	    if (quote) {
+		/* if quote, file ended with an open quoted object */
+		if (string != stk)
+		    LispFree(string);
+		return (NULL);
+	    }
+	    break;
+	}
+	else if (ch == '\0')
+	    break;
+
+	if (ch == '\\') {
+	    backslash = !backslash;
+	    if (quote == '"') {
+		/* only remove backslashs from strings */
+		if (backslash)
+		    continue;
+	    }
+	    else
+		unreadable = 1;
+	}
+	else if (backslash)
+	    backslash = 0;
+	else if (ch == quote)
+	    break;
+	else if (!quote && !backslash) {
+	    if (islower(ch))
+		ch = toupper(ch);
+	    else if (isspace(ch))
+		break;
+	    else if (AtomSeparator(ch, 0, 0)) {
+		LispUnget(ch);
+		break;
+	    }
+	    else if (ch == ':') {
+		if (collon == 0 ||
+		    (collon == (1 - unintern) && symbol == string + length)) {
+		    ++collon;
+		    symbol = string + length + 1;
+		}
+		else
+		    READ_ERROR0("too many collons");
+	    }
+	}
+
+	if (length + 2 >= size) {
+	    if (string == stk) {
+		size = 1024;
+		string = LispMalloc(size);
+		strcpy(string, stk);
+	    }
+	    else {
+		size += 1024;
+		string = LispRealloc(string, size);
+	    }
+	    symbol = string + (symbol - package);
+	    package = string;
+	}
+	string[length++] = ch;
+    }
+
+    if (info->discard) {
+	if (string != stk)
+	    LispFree(string);
+
+	return (ch == EOF ? NULL : NIL);
+    }
+
+    string[length] = '\0';
+
+    if (unintern) {
+	if (length == 0)
+	    READ_ERROR0("syntax error after #:");
+	object = UNINTERNED_ATOM(string);
+    }
+
+    else if (quote == '"')
+	object = LSTRING(string, length);
+
+    else if (quote == '|' || (unreadable && !collon)) {
+	/* Set unreadable field, this atom needs quoting to be read back */
+	object = ATOM(string);
+	object->data.atom->unreadable = 1;
+    }
+
+    else if (collon) {
+	/* Package specified in object name */
+	symbol[-1] = '\0';
+	if (collon > 1)
+	    symbol[-2] = '\0';
+	object = LispParseAtom(package, symbol,
+			       collon == 2, unreadable,
+			       read__stream, read__line);
+    }
+
+    /* Check some common symbols */
+    else if (length == 1 && string[0] == 'T')
+	/* The T */
+	object = T;
+
+    else if (length == 1 && string[0] == '.')
+	/* The dot */
+	object = DOT;
+
+    else if (length == 3 &&
+	     string[0] == 'N' && string[1] == 'I' && string[2] == 'L')
+	/* The NIL */
+	object = NIL;
+
+    else if (isdigit(string[0]) || string[0] == '.' ||
+	     ((string[0] == '-' || string[0] == '+') && string[1]))
+	/* Looks like a number */
+	object = LispParseNumber(string, 10, read__stream, read__line);
+
+    else
+	/* A normal atom */
+	object = ATOM(string);
+
+    if (string != stk)
+	LispFree(string);
+
+    return (object);
+}
+
+static LispObj *
+LispParseAtom(char *package, char *symbol, int intern, int unreadable,
+	      LispObj *read__stream, int read__line)
+{
+    LispObj *object = NULL, *thepackage = NULL;
+    LispPackage *pack = NULL;
+
+    if (!unreadable) {
+	/* Until NIL and T be treated as normal symbols */
+	if (symbol[0] == 'N' && symbol[1] == 'I' &&
+	    symbol[2] == 'L' && symbol[3] == '\0')
+	    return (NIL);
+	if (symbol[0] == 'T' && symbol[1] == '\0')
+	    return (T);
+	unreadable = !LispCheckAtomString(symbol);
+    }
+
+    /* If package is empty, it is a keyword */
+    if (package[0] == '\0') {
+	thepackage = lisp__data.keyword;
+	pack = lisp__data.key;
+    }
+
+    else {
+	/* Else, search it in the package list */
+	thepackage = LispFindPackageFromString(package);
+
+	if (thepackage == NIL)
+	    READ_ERROR1("the package %s is not available", package);
+
+	pack = thepackage->data.package.package;
+    }
+
+    if (pack == lisp__data.pack && intern) {
+	/* Redundant package specification, since requesting a
+	 * intern symbol, create it if does not exist */
+
+	object = ATOM(symbol);
+	if (unreadable)
+	    object->data.atom->unreadable = 1;
+    }
+
+    else if (intern || pack == lisp__data.key) {
+	/* Symbol is created, or just fetched from the specified package */
+
+	LispPackage *savepack;
+	LispObj *savepackage = PACKAGE;
+
+	/* Remember curent package */
+	savepack = lisp__data.pack;
+
+	/* Temporarily set another package */
+	lisp__data.pack = pack;
+	PACKAGE = thepackage;
+
+	/* Get the object pointer */
+	if (pack == lisp__data.key)
+	    object = KEYWORD(LispDoGetAtom(symbol, 0)->string);
+	else
+	    object = ATOM(symbol);
+	if (unreadable)
+	    object->data.atom->unreadable = 1;
+
+	/* Restore current package */
+	lisp__data.pack = savepack;
+	PACKAGE = savepackage;
+    }
+
+    else {
+	/* Symbol must exist (and be extern) in the specified package */
+
+	int i;
+	LispAtom *atom;
+
+	i = STRHASH(symbol);
+	atom = pack->atoms[i];
+	while (atom) {
+	    if (strcmp(atom->string, symbol) == 0) {
+		object = atom->object;
+		break;
+	    }
+
+	    atom = atom->next;
+	}
+
+	/* No object found */
+	if (object == NULL || object->data.atom->ext == 0)
+	    READ_ERROR2("no extern symbol %s in package %s", symbol, package);
+    }
+
+    return (object);
+}
+
+static LispObj *
+LispParseNumber(char *str, int radix, LispObj *read__stream, int read__line)
+{
+    int len;
+    long integer;
+    double dfloat;
+    char *ratio, *ptr;
+    LispObj *number;
+    mpi *bignum;
+    mpr *bigratio;
+
+    if (radix < 2 || radix > 36)
+	READ_ERROR1("radix %d is not in the range 2 to 36", radix);
+
+    if (*str == '\0')
+	return (NULL);
+
+    ratio = strchr(str, '/');
+    if (ratio) {
+	/* check if looks like a correctly specified ratio */
+	if (ratio[1] == '\0' || strchr(ratio + 1, '/') != NULL)
+	    return (ATOM(str));
+
+	/* ratio must point to an integer in radix base */
+	*ratio++ = '\0';
+    }
+    else if (radix == 10) {
+	int dot = 0;
+	int type = 0;
+
+	/* check if it is a floating point number */
+	ptr = str;
+	if (*ptr == '-' || *ptr == '+')
+	    ++ptr;
+	else if (*ptr == '.') {
+	    dot = 1;
+	    ++ptr;
+	}
+	while (*ptr) {
+	    if (*ptr == '.') {
+		if (dot)
+		    return (ATOM(str));
+		/* ignore it if last char is a dot */
+		if (ptr[1] == '\0') {
+		    *ptr = '\0';
+		    break;
+		}
+		dot = 1;
+	    }
+	    else if (!isdigit(*ptr))
+		break;
+	    ++ptr;
+	}
+
+	switch (*ptr) {
+	    case '\0':
+		if (dot)		/* if dot, it is default float */
+		    type = 'E';
+		break;
+	    case 'E': case 'S': case 'F': case 'D': case 'L':
+		type = *ptr;
+		*ptr = 'E';
+		break;
+	    default:
+		return (ATOM(str));	/* syntax error */
+	}
+
+	/* if type set, it is not an integer specification */
+	if (type) {
+	    if (*ptr) {
+		int itype = *ptr;
+		char *ptype = ptr;
+
+		++ptr;
+		if (*ptr == '+' || *ptr == '-')
+		    ++ptr;
+		while (*ptr && isdigit(*ptr))
+		    ++ptr;
+		if (*ptr) {
+		    *ptype = itype;
+
+		    return (ATOM(str));
+		}
+	    }
+
+	    dfloat = strtod(str, NULL);
+	    if (!finite(dfloat))
+		READ_ERROR0("floating point overflow");
+
+	    return (DFLOAT(dfloat));
+	}
+    }
+
+    /* check if correctly specified in the given radix */
+    len = strlen(str) - 1;
+    if (!ratio && radix != 10 && str[len] == '.')
+	str[len] = '\0';
+
+    if (ratio || radix != 10) {
+	if (!StringInRadix(str, radix, 1)) {
+	    if (ratio)
+		ratio[-1] = '/';
+	    return (ATOM(str));
+	}
+	if (ratio && !StringInRadix(ratio, radix, 0)) {
+	    ratio[-1] = '/';
+	    return (ATOM(str));
+	}
+    }
+
+    bignum = NULL;
+    bigratio = NULL;
+
+    errno = 0;
+    integer = strtol(str, NULL, radix);
+
+    /* if does not fit in a long */
+    if (errno == ERANGE &&
+	((*str == '-' && integer == LONG_MIN) ||
+	 (*str != '-' && integer == LONG_MAX))) {
+	bignum = LispMalloc(sizeof(mpi));
+	mpi_init(bignum);
+	mpi_setstr(bignum, str, radix);
+    }
+
+
+    if (ratio && integer != 0) {
+	long denominator;
+
+	errno = 0;
+	denominator = strtol(ratio, NULL, radix);
+	if (denominator == 0)
+	    READ_ERROR0("divide by zero");
+
+	if (bignum == NULL) {
+	    if (integer == MINSLONG ||
+		(denominator == LONG_MAX && errno == ERANGE)) {
+		bigratio = LispMalloc(sizeof(mpr));
+		mpr_init(bigratio);
+		mpi_seti(mpr_num(bigratio), integer);
+		mpi_setstr(mpr_den(bigratio), ratio, radix);
+	    }
+	}
+	else {
+	    bigratio = LispMalloc(sizeof(mpr));
+	    mpr_init(bigratio);
+	    mpi_set(mpr_num(bigratio), bignum);
+	    mpi_clear(bignum);
+	    LispFree(bignum);
+	    mpi_setstr(mpr_den(bigratio), ratio, radix);
+	}
+
+	if (bigratio) {
+	    mpr_canonicalize(bigratio);
+	    if (mpi_fiti(mpr_num(bigratio)) &&
+		mpi_fiti(mpr_den(bigratio))) {
+		integer = mpi_geti(mpr_num(bigratio));
+		denominator = mpi_geti(mpr_den(bigratio));
+		mpr_clear(bigratio);
+		LispFree(bigratio);
+		if (denominator == 1)
+		    number = INTEGER(integer);
+		else
+		    number = RATIO(integer, denominator);
+	    }
+	    else
+		number = BIGRATIO(bigratio);
+	}
+	else {
+	    long num = integer, den = denominator, rest;
+
+	    if (num < 0)
+		num = -num;
+	    for (;;) {
+		if ((rest = den % num) == 0)
+		    break;
+		den = num;
+		num = rest;
+	    }
+	    if (den != 1) {
+		denominator /= num;
+		integer /= num;
+	    }
+	    if (denominator < 0) {
+		integer = -integer;
+		denominator = -denominator;
+	    }
+	    if (denominator == 1)
+		number = INTEGER(integer);
+	    else
+		number = RATIO(integer, denominator);
+	}
+    }
+    else if (bignum)
+	number = BIGNUM(bignum);
+    else
+	number = INTEGER(integer);
+
+    return (number);
+}
+
+static int
+StringInRadix(char *str, int radix, int skip_sign)
+{
+    if (skip_sign && (*str == '-' || *str == '+'))
+	++str;
+    while (*str) {
+	if (*str >= '0' && *str <= '9') {
+	    if (*str - '0' >= radix)
+		return (0);
+	}
+	else if (*str >= 'A' && *str <= 'Z') {
+	    if (radix <= 10 || *str - 'A' + 10 >= radix)
+		return (0);
+	}
+	else
+	    return (0);
+	str++;
+    }
+
+    return (1);
+}
+
+static int
+AtomSeparator(int ch, int check_space, int check_backslash)
+{
+    if (check_space && isspace(ch))
+	return (1);
+    if (check_backslash && ch == '\\')
+	return (1);
+    return (strchr("(),\";'`#|,", ch) != NULL);
+}
+
+static LispObj *
+LispReadVector(read_info *info)
+{
+    LispObj *objects;
+    int nodot = info->nodot;
+
+    info->nodot = info->level + 1;
+    objects = LispReadList(info);
+    info->nodot = nodot;
+
+    if (info->discard)
+	return (objects);
+
+    return (VECTOR(objects));
+}
+
+static LispObj *
+LispReadFunction(read_info *info)
+{
+    READ_ENTER();
+    int nodot = info->nodot;
+    LispObj *function;
+
+    info->nodot = info->level + 1;
+    function = LispDoRead(info);
+    info->nodot = nodot;
+
+    if (info->discard)
+	return (function);
+
+    if (INVALIDP(function)) 
+	READ_ERROR_INVARG();
+    else if (CONSP(function)) {
+	if (CAR(function) != Olambda)
+	    READ_ERROR_INVARG();
+
+	return (FUNCTION_QUOTE(function));
+    }
+    else if (!SYMBOLP(function))
+	READ_ERROR_INVARG();
+
+    return (FUNCTION_QUOTE(function));
+}
+
+static LispObj *
+LispReadRational(int radix, read_info *info)
+{
+    READ_ENTER();
+    LispObj *number;
+    int ch, len, size;
+    char stk[128], *str;
+
+    len = 0;
+    str = stk;
+    size = sizeof(stk);
+
+    for (;;) {
+	ch = LispGet();
+	if (ch == EOF || isspace(ch))
+	    break;
+	else if (AtomSeparator(ch, 0, 1)) {
+	    LispUnget(ch);
+	    break;
+	}
+	else if (islower(ch))
+	    ch = toupper(ch);
+	if ((ch < '0' || ch > '9') && (ch < 'A' || ch > 'Z') &&
+	    ch != '+' && ch != '-' && ch != '/') {
+	    if (str != stk)
+		LispFree(str);
+	    if (!info->discard)
+		READ_ERROR1("bad character %c for rational number", ch);
+	}
+	if (len + 1 >= size) {
+	    if (str == stk) {
+		size = 512;
+		str = LispMalloc(size);
+		strcpy(str + 1, stk + 1);
+	    }
+	    else {
+		size += 512;
+		str = LispRealloc(str, size);
+	    }
+	}
+	str[len++] = ch;
+    }
+
+    if (info->discard) {
+	if (str != stk)
+	    LispFree(str);
+
+	return (ch == EOF ? NULL : NIL);
+    }
+
+    str[len] = '\0';
+
+    number = LispParseNumber(str, radix, read__stream, read__line);
+    if (str != stk)
+	LispFree(str);
+
+    if (!RATIONALP(number))
+	READ_ERROR0("bad rational number specification");
+
+    return (number);
+}
+
+static LispObj *
+LispReadCharacter(read_info *info)
+{
+    READ_ENTER();
+    long c;
+    int ch, len;
+    char stk[64];
+
+    ch = LispGet();
+    if (ch == EOF)
+	return (NULL);
+
+    stk[0] = ch;
+    len = 1;
+
+    for (;;) {
+	ch = LispGet();
+	if (ch == EOF)
+	    break;
+	else if (ch != '-' && !isalnum(ch)) {
+	    LispUnget(ch);
+	    break;
+	}
+	if (len + 1 < sizeof(stk))
+	    stk[len++] = ch;
+    }
+    if (len > 1) {
+	char **names;
+	int found = 0;
+	stk[len] = '\0';
+
+	for (c = ch = 0; ch <= ' ' && !found; ch++) {
+	    for (names = LispChars[ch].names; *names; names++)
+		if (strcasecmp(*names, stk) == 0) {
+		    c = ch;
+		    found = 1;
+		    break;
+		}
+	}
+	if (!found) {
+	    for (names = LispChars[0177].names; *names; names++)
+		if (strcasecmp(*names, stk) == 0) {
+		    c = 0177;
+		    found = 1;
+		    break;
+		}
+	}
+
+	if (!found) {
+	    if (info->discard)
+		return (NIL);
+	    READ_ERROR1("unkwnown character %s", stk);
+	}
+    }
+    else
+	c = stk[0];
+
+    return (SCHAR(c));
+}
+
+static void
+LispSkipComment(void)
+{
+    READ_ENTER();
+    int ch, comm = 1;
+
+    for (;;) {
+	ch = LispGet();
+	if (ch == '#') {
+	    ch = LispGet();
+	    if (ch == '|')
+		++comm;
+	    continue;
+	}
+	while (ch == '|') {
+	    ch = LispGet();
+	    if (ch == '#' && --comm == 0)
+		return;
+	}
+	if (ch == EOF)
+	    READ_ERROR_EOF();
+    }
+}
+
+static LispObj *
+LispReadEval(read_info *info)
+{
+    READ_ENTER();
+    int nodot = info->nodot;
+    LispObj *code;
+
+    info->nodot = info->level + 1;
+    code = LispDoRead(info);
+    info->nodot = nodot;
+
+    if (info->discard)
+	return (code);
+
+    if (INVALIDP(code))
+	READ_ERROR_INVARG();
+
+    return (EVAL(code));
+}
+
+static LispObj *
+LispReadComplex(read_info *info)
+{
+    READ_ENTER();
+    GC_ENTER();
+    int nodot = info->nodot;
+    LispObj *number, *arguments;
+
+    info->nodot = info->level + 1;
+    arguments = LispDoRead(info);
+    info->nodot = nodot;
+
+    /* form read */
+    if (info->discard)
+	return (arguments);
+
+    if (INVALIDP(arguments) || !CONSP(arguments))
+	READ_ERROR_INVARG();
+
+    GC_PROTECT(arguments);
+    number = APPLY(Ocomplex, arguments);
+    GC_LEAVE();
+
+    return (number);
+}
+
+static LispObj *
+LispReadPathname(read_info *info)
+{
+    READ_ENTER();
+    GC_ENTER();
+    int nodot = info->nodot;
+    LispObj *path, *arguments;
+
+    info->nodot = info->level + 1;
+    arguments = LispDoRead(info);
+    info->nodot = nodot;
+
+    /* form read */
+    if (info->discard)
+	return (arguments);
+
+    if (INVALIDP(arguments))
+	READ_ERROR_INVARG();
+
+    GC_PROTECT(arguments);
+    path = APPLY1(Oparse_namestring, arguments);
+    GC_LEAVE();
+
+    return (path);
+}
+
+static LispObj *
+LispReadStruct(read_info *info)
+{
+    READ_ENTER();
+    GC_ENTER();
+    int len, nodot = info->nodot;
+    char stk[128], *str;
+    LispObj *struc, *fields;
+
+    info->nodot = info->level + 1;
+    fields = LispDoRead(info);
+    info->nodot = nodot;
+
+    /* form read */
+    if (info->discard)
+	return (fields);
+
+    if (INVALIDP(fields) || !CONSP(fields) || !SYMBOLP(CAR(fields)))
+	READ_ERROR_INVARG();
+
+    GC_PROTECT(fields);
+
+    len = strlen(ATOMID(CAR(fields)));
+	   /* MAKE- */
+    if (len + 6 > sizeof(stk))
+	str = LispMalloc(len + 6);
+    else
+	str = stk;
+    sprintf(str, "MAKE-%s", ATOMID(CAR(fields)));
+    RPLACA(fields, ATOM(str));
+    if (str != stk)
+	LispFree(str);
+    struc = APPLY(Omake_struct, fields);
+    GC_LEAVE();
+
+    return (struc);
+}
+
+/* XXX This is broken, needs a rewritten as soon as true vector/arrays be
+ * implemented. */
+static LispObj *
+LispReadArray(long dimensions, read_info *info)
+{
+    READ_ENTER();
+    GC_ENTER();
+    long count;
+    int nodot = info->nodot;
+    LispObj *arguments, *initial, *dim, *cons, *array, *data;
+
+    info->nodot = info->level + 1;
+    data = LispDoRead(info);
+    info->nodot = nodot;
+
+    /* form read */
+    if (info->discard)
+	return (data);
+
+    if (INVALIDP(data))
+	READ_ERROR_INVARG();
+
+    initial = Kinitial_contents;
+
+    dim = cons = NIL;
+    if (dimensions) {
+	LispObj *array;
+
+	for (count = 0, array = data; count < dimensions; count++) {
+	    long length;
+	    LispObj *item;
+
+	    if (!CONSP(array))
+		READ_ERROR0("bad array for given dimension");
+	    item = array;
+	    array = CAR(array);
+
+	    for (length = 0; CONSP(item); item = CDR(item), length++)
+		;
+
+	    if (dim == NIL) {
+		dim = cons = CONS(FIXNUM(length), NIL);
+		GC_PROTECT(dim);
+	    }
+	    else {
+		RPLACD(cons, CONS(FIXNUM(length), NIL));
+		cons = CDR(cons);
+	    }
+	}
+    }
+
+    arguments = CONS(dim, CONS(initial, CONS(data, NIL)));
+    GC_PROTECT(arguments);
+    array = APPLY(Omake_array, arguments);
+    GC_LEAVE();
+
+    return (array);
+}
+
+static LispObj *
+LispReadFeature(int with, read_info *info)
+{
+    READ_ENTER();
+    LispObj *status;
+    LispObj *feature = LispDoRead(info);
+
+    /* form read */
+    if (info->discard)
+	return (feature);
+
+    if (INVALIDP(feature))
+	READ_ERROR_INVARG();
+
+    /* paranoia check, features must be a list, possibly empty */
+    if (!CONSP(FEATURES) && FEATURES != NIL)
+	READ_ERROR1("%s is not a list", STROBJ(FEATURES));
+
+    status = LispEvalFeature(feature);
+
+    if (with) {
+	if (status == T)
+	    return (LispDoRead(info));
+
+	/* need to use the field discard because the following expression
+	 * may be #.FORM or #,FORM or any other form that may generate
+	 * side effects */
+	info->discard = 1;
+	LispDoRead(info);
+	info->discard = 0;
+
+	return (LispDoRead(info));
+    }
+
+    if (status == NIL)
+	return (LispDoRead(info));
+
+    info->discard = 1;
+    LispDoRead(info);
+    info->discard = 0;
+
+    return (LispDoRead(info));
+}
+
+/*
+ * A very simple eval loop with AND, NOT, and OR functions for testing
+ * the available features.
+ */
+static LispObj *
+LispEvalFeature(LispObj *feature)
+{
+    READ_ENTER();
+    Atom_id test;
+    LispObj *object;
+
+    if (CONSP(feature)) {
+	LispObj *function = CAR(feature), *arguments = CDR(feature);
+
+	if (!SYMBOLP(function))
+	    READ_ERROR1("bad feature test function %s", STROBJ(function));
+	if (!CONSP(arguments))
+	    READ_ERROR1("bad feature test arguments %s", STROBJ(arguments));
+	test = ATOMID(function);
+	if (test == Sand) {
+	    for (; CONSP(arguments); arguments = CDR(arguments)) {
+		if (LispEvalFeature(CAR(arguments)) == NIL)
+		    return (NIL);
+	    }
+	    return (T);
+	}
+	else if (test == Sor) {
+	    for (; CONSP(arguments); arguments = CDR(arguments)) {
+		if (LispEvalFeature(CAR(arguments)) == T)
+		    return (T);
+	    }
+	    return (NIL);
+	}
+	else if (test == Snot) {
+	    if (CONSP(CDR(arguments)))
+		READ_ERROR0("too many arguments to NOT");
+
+	    return (LispEvalFeature(CAR(arguments)) == NIL ? T : NIL);
+	}
+	else
+	    READ_ERROR1("unimplemented feature test function %s", test);
+    }
+
+    if (KEYWORDP(feature))
+	feature = feature->data.quote;
+    else if (!SYMBOLP(feature))
+	READ_ERROR1("bad feature specification %s", STROBJ(feature));
+
+    test = ATOMID(feature);
+
+    for (object = FEATURES; CONSP(object); object = CDR(object)) {
+	/* paranoia check, elements in the feature list must ge keywords */
+	if (!KEYWORDP(CAR(object)))
+	    READ_ERROR1("%s is not a keyword", STROBJ(CAR(object)));
+	if (ATOMID(CAR(object)) == test)
+	    return (T);
+    }
+
+    /* unknown feature */
+    return (NIL);
+}
diff --git a/lisp/read.h b/lisp/read.h
new file mode 100644
index 0000000..229ced5
--- /dev/null
+++ b/lisp/read.h
@@ -0,0 +1,47 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/read.h,v 1.3 2002/11/15 07:01:30 paulo Exp $ */
+
+#ifndef Lisp_read_h
+#define Lisp_read_h
+
+#include "io.h"
+
+/*
+ * Prototypes
+ */
+LispObj *LispRead(void);
+
+LispObj *Lisp_Read(LispBuiltin*);
+LispObj *Lisp_ReadChar(LispBuiltin*);
+LispObj *Lisp_ReadCharNoHang(LispBuiltin*);
+LispObj *Lisp_ReadLine(LispBuiltin*);
+
+#endif /* Lisp_read_h */
diff --git a/lisp/regex.c b/lisp/regex.c
new file mode 100644
index 0000000..bf3390d
--- /dev/null
+++ b/lisp/regex.c
@@ -0,0 +1,223 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/regex.c,v 1.10 2002/12/11 04:44:28 paulo Exp $ */
+
+#include "regex.h"
+#include "private.h"
+#include "helper.h"
+
+/*
+ * Prototypes
+ */
+static re_cod *LispRecomp(LispBuiltin*, char*, int);
+
+/*
+ * Initialization
+ */
+LispObj *Knomatch;
+
+/*
+ * Implementation
+ */
+static re_cod *
+LispRecomp(LispBuiltin *builtin, char *pattern, int cflags)
+{
+    int code;
+    re_cod *regex = LispMalloc(sizeof(re_cod));
+
+    if ((code = recomp(regex, pattern, cflags)) != 0) {
+	char buffer[256];
+
+	reerror(code, regex, buffer, sizeof(buffer));
+	refree(regex);
+	LispFree(regex);
+	LispDestroy("%s: recomp(\"%s\"): %s", STRFUN(builtin), pattern, buffer);
+    }
+
+    return (regex);
+}
+
+void
+LispRegexInit(void)
+{
+    Knomatch = KEYWORD("NOMATCH");
+}
+
+LispObj *
+Lisp_Recomp(LispBuiltin *builtin)
+/*
+ re-comp pattern &key nospec icase nosub newline
+ */
+{
+    re_cod *regex;
+    int cflags = 0;
+
+    LispObj *result;
+
+    LispObj *pattern, *nospec, *icase, *nosub, *newline;
+
+    newline = ARGUMENT(4);
+    nosub = ARGUMENT(3);
+    icase = ARGUMENT(2);
+    nospec = ARGUMENT(1);
+    pattern = ARGUMENT(0);
+
+    /* Don't generate an error if it is already a compiled regex. */
+    if (REGEXP(pattern))
+	return (pattern);
+
+    CHECK_STRING(pattern);
+
+    if (nospec != UNSPEC && nospec != NIL)
+	cflags |= RE_NOSPEC;
+    if (icase != UNSPEC && icase != NIL)
+	cflags |= RE_ICASE;
+    if (nosub != UNSPEC && nosub != NIL)
+	cflags |= RE_NOSUB;
+    if (newline != UNSPEC && newline != NIL)
+	cflags |= RE_NEWLINE;
+
+    regex = LispRecomp(builtin, THESTR(pattern), cflags);
+    result = LispNew(pattern, NIL);
+    result->type = LispRegex_t;
+    result->data.regex.regex = regex;
+    result->data.regex.pattern = pattern;
+    result->data.regex.options = cflags;
+    LispMused(regex);
+
+    return (result);
+}
+
+LispObj *
+Lisp_Reexec(LispBuiltin *builtin)
+/*
+ re-exec regex string &key count start end notbol noteol
+ */
+{
+    size_t nmatch;
+    re_mat match[10];
+    long start, end, length;
+    int code, cflags, eflags;
+    char *string;
+    LispObj *result;
+    re_cod *regexp;
+
+    LispObj *regex, *ostring, *count, *ostart, *oend, *notbol, *noteol;
+
+    noteol = ARGUMENT(6);
+    notbol = ARGUMENT(5);
+    oend = ARGUMENT(4);
+    ostart = ARGUMENT(3);
+    count = ARGUMENT(2);
+    ostring = ARGUMENT(1);
+    regex = ARGUMENT(0);
+
+    if (STRINGP(regex))
+	regexp = LispRecomp(builtin, THESTR(regex), cflags = 0);
+    else {
+	CHECK_REGEX(regex);
+	regexp = regex->data.regex.regex;
+	cflags = regex->data.regex.options;
+    }
+
+    CHECK_STRING(ostring);
+
+    if (count == UNSPEC)
+	nmatch = 1;
+    else {
+	CHECK_INDEX(count);
+	nmatch = FIXNUM_VALUE(count);
+	if (nmatch > 10)
+	    LispDestroy("%s: COUNT cannot be larger than 10", STRFUN(builtin));
+    }
+    if (nmatch && (cflags & RE_NOSUB))
+	nmatch = 1;
+
+    eflags = RE_STARTEND;
+    if (notbol != UNSPEC && notbol != NIL)
+	eflags |= RE_NOTBOL;
+    if (noteol != UNSPEC && noteol != NIL)
+	eflags |= RE_NOTEOL;
+
+    string = THESTR(ostring);
+    LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
+			      &start, &end, &length);
+
+    match[0].rm_so = start;
+    match[0].rm_eo = end;
+    code = reexec(regexp, string, nmatch, &match[0], eflags);
+
+    if (code == 0) {
+	if (nmatch && match[0].rm_eo >= match[0].rm_so) {
+	    result = CONS(CONS(FIXNUM(match[0].rm_so),
+			       FIXNUM(match[0].rm_eo)), NIL);
+	    if (nmatch > 1 && match[1].rm_eo >= match[1].rm_so) {
+		int i;
+		GC_ENTER();
+		LispObj *cons = result;
+
+		GC_PROTECT(result);
+		for (i = 1;
+		     i < nmatch && match[i].rm_eo >= match[i].rm_so;
+		     i++) {
+		    RPLACD(cons, CONS(CONS(FIXNUM(match[i].rm_so),
+					   FIXNUM(match[i].rm_eo)), NIL));
+		    cons = CDR(cons);
+		}
+		GC_LEAVE();
+	    }
+	}
+	else
+	    result = NIL;
+    }
+    else
+	result = Knomatch;
+
+    /* Maybe shoud cache compiled regex, but better the caller do it */
+    if (!XREGEXP(regex)) {
+	refree(regexp);
+	LispFree(regexp);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_Rep(LispBuiltin *builtin)
+/*
+ re-p object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (REGEXP(object) ? T : NIL);
+}
diff --git a/lisp/regex.h b/lisp/regex.h
new file mode 100644
index 0000000..cc4d7e6
--- /dev/null
+++ b/lisp/regex.h
@@ -0,0 +1,46 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/regex.h,v 1.3 2002/11/08 08:00:57 paulo Exp $ */
+
+#ifndef Lisp_regex_h
+#define Lisp_regex_h
+
+#include "internal.h"
+
+/*
+ * Prototypes
+ */
+void LispRegexInit(void);
+
+LispObj *Lisp_Recomp(LispBuiltin*);
+LispObj *Lisp_Reexec(LispBuiltin*);
+LispObj *Lisp_Rep(LispBuiltin*);
+
+#endif /* Lisp_regex_h */
diff --git a/lisp/require.c b/lisp/require.c
new file mode 100644
index 0000000..7f80c3f
--- /dev/null
+++ b/lisp/require.c
@@ -0,0 +1,159 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/require.c,v 1.16 2002/11/23 08:26:50 paulo Exp $ */
+
+#include "require.h"
+
+/*
+ * Implementation
+ */
+LispObj *
+Lisp_Load(LispBuiltin *builtin)
+/*
+ load filename &key verbose print if-does-not-exist
+ */
+{
+    LispObj *filename, *verbose, *print, *if_does_not_exist;
+
+    if_does_not_exist = ARGUMENT(3);
+    print = ARGUMENT(2);
+    verbose = ARGUMENT(1);
+    filename = ARGUMENT(0);
+
+    if (PATHNAMEP(filename))
+	filename = CAR(filename->data.pathname);
+    else {
+	CHECK_STRING(filename);
+    }
+
+    return (LispLoadFile(filename,
+			 verbose != UNSPEC && verbose != NIL,
+			 print != UNSPEC && print != NIL,
+			 if_does_not_exist != UNSPEC &&
+			 if_does_not_exist != NIL));
+}
+
+LispObj *
+Lisp_Require(LispBuiltin *builtin)
+/*
+ require module &optional pathname
+ */
+{
+    char filename[1024], *ext;
+    int len;
+
+    LispObj *obj, *module, *pathname;
+
+    pathname = ARGUMENT(1);
+    module = ARGUMENT(0);
+
+    CHECK_STRING(module);
+    if (pathname != UNSPEC) {
+	if (PATHNAMEP(pathname))
+	    pathname = CAR(pathname->data.pathname);
+	else {
+	    CHECK_STRING(pathname);
+	}
+    }
+    else
+	pathname = module;
+
+    for (obj = MOD; CONSP(obj); obj = CDR(obj)) {
+	if (strcmp(THESTR(CAR(obj)), THESTR(module)) == 0)
+	    return (module);
+    }
+
+    if (THESTR(pathname)[0] != '/') {
+#ifdef LISPDIR
+	snprintf(filename, sizeof(filename), "%s", LISPDIR);
+#else
+	getcwd(filename, sizeof(filename));
+#endif
+    }
+    else
+	filename[0] = '\0';
+    *(filename + sizeof(filename) - 5) = '\0';	/* make sure there is place for ext */
+    len = strlen(filename);
+    if (!len || filename[len - 1] != '/') {
+	strcat(filename, "/");
+	++len;
+    }
+
+    snprintf(filename + len, sizeof(filename) - len - 5, "%s", THESTR(pathname));
+
+    ext = filename + strlen(filename);
+
+#ifdef SHARED_MODULES
+    strcpy(ext, ".so");
+    if (access(filename, R_OK) == 0) {
+	LispModule *lisp_module;
+	char data[64];
+	int len;
+
+	if (lisp__data.module == NULL) {
+	    /* export our own symbols */
+	    if (dlopen(NULL, RTLD_LAZY | RTLD_GLOBAL) == NULL)
+		LispDestroy(mac, "%s: ", STRFUN(builtin), dlerror());
+	}
+
+	lisp_module = (LispModule*)LispMalloc(sizeof(LispModule));
+	if ((lisp_module->handle =
+	     dlopen(filename, RTLD_LAZY | RTLD_GLOBAL)) == NULL)
+	    LispDestroy(mac, "%s: dlopen: %s", STRFUN(builtin), dlerror());
+	snprintf(data, sizeof(data), "%sLispModuleData", THESTR(module));
+	if ((lisp_module->data =
+	     (LispModuleData*)dlsym(lisp_module->handle, data)) == NULL) {
+	    dlclose(lisp_module->handle);
+	    LispDestroy("%s: cannot find LispModuleData for %s",
+			STRFUN(builtin), STROBJ(module));
+	}
+	LispMused(lisp_module);
+	lisp_module->next = lisp__data.module;
+	lisp__data.module = lisp_module;
+	if (lisp_module->data->load)
+	    (lisp_module->data->load)();
+
+	if (MOD == NIL)
+	    MOD = CONS(module, NIL);
+	else {
+	    RPLACD(MOD, CONS(CAR(MOD), CDR(MOD)));
+	    RPLACA(MOD, module);
+	}
+	LispSetVar(lisp__data.modules, MOD);
+
+	return (module);
+    }
+#endif
+
+    strcpy(ext, ".lsp");
+    (void)LispLoadFile(STRING(filename), 0, 0, 0);
+
+    return (module);
+}
diff --git a/lisp/require.h b/lisp/require.h
new file mode 100644
index 0000000..42c2064
--- /dev/null
+++ b/lisp/require.h
@@ -0,0 +1,44 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/require.h,v 1.4 2002/11/08 08:00:57 paulo Exp $ */
+
+#ifndef Lisp_require_h
+#define Lisp_require_h
+
+#include "private.h"
+#include "helper.h"
+#ifdef SHARED_MODULES
+#include <dlfcn.h>
+#endif
+
+LispObj *Lisp_Load(LispBuiltin*);
+LispObj *Lisp_Require(LispBuiltin*);
+
+#endif /* Lisp_require_h */
diff --git a/lisp/stream.c b/lisp/stream.c
new file mode 100644
index 0000000..be0f44d
--- /dev/null
+++ b/lisp/stream.c
@@ -0,0 +1,866 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/stream.c,v 1.21 2002/12/10 03:59:03 paulo Exp $ */
+
+#include "read.h"
+#include "stream.h"
+#include "pathname.h"
+#include "write.h"
+#include "private.h"
+#include <errno.h>
+#include <fcntl.h>
+#include <signal.h>
+#include <string.h>
+#include <sys/wait.h>
+
+/*
+ * Initialization
+ */
+#define DIR_PROBE		0
+#define DIR_INPUT		1
+#define DIR_OUTPUT		2
+#define DIR_IO			3
+
+#define EXT_NIL			0
+#define EXT_ERROR		1
+#define EXT_NEW_VERSION		2
+#define EXT_RENAME		3
+#define EXT_RENAME_DELETE	4
+#define EXT_OVERWRITE		5
+#define EXT_APPEND		6
+#define EXT_SUPERSEDE		7
+
+#define NOEXT_NIL		0
+#define NOEXT_ERROR		1
+#define NOEXT_CREATE		2
+#define NOEXT_NOTHING		3
+
+extern char **environ;
+
+LispObj *Oopen, *Oclose, *Otruename;
+
+LispObj *Kif_does_not_exist, *Kprobe, *Kinput, *Koutput, *Kio,
+	*Knew_version, *Krename, *Krename_and_delete, *Koverwrite,
+	*Kappend, *Ksupersede, *Kcreate;
+
+/*
+ * Implementation
+ */
+void
+LispStreamInit(void)
+{
+    Oopen		= STATIC_ATOM("OPEN");
+    Oclose		= STATIC_ATOM("CLOSE");
+    Otruename		= STATIC_ATOM("TRUENAME");
+
+    Kif_does_not_exist	= KEYWORD("IF-DOES-NOT-EXIST");
+    Kprobe		= KEYWORD("PROBE");
+    Kinput		= KEYWORD("INPUT");
+    Koutput		= KEYWORD("OUTPUT");
+    Kio			= KEYWORD("IO");
+    Knew_version	= KEYWORD("NEW-VERSION");
+    Krename		= KEYWORD("RENAME");
+    Krename_and_delete	= KEYWORD("RENAME-AND-DELETE");
+    Koverwrite		= KEYWORD("OVERWRITE");
+    Kappend		= KEYWORD("APPEND");
+    Ksupersede		= KEYWORD("SUPERSEDE");
+    Kcreate		= KEYWORD("CREATE");
+}
+
+LispObj *
+Lisp_DeleteFile(LispBuiltin *builtin)
+/*
+ delete-file filename
+ */
+{
+    GC_ENTER();
+    LispObj *filename;
+
+    filename = ARGUMENT(0);
+
+    if (STRINGP(filename)) {
+	filename = APPLY1(Oparse_namestring, filename);
+	GC_PROTECT(filename);
+    }
+    else if (STREAMP(filename)) {
+	if (filename->data.stream.type != LispStreamFile)
+	    LispDestroy("%s: %s is not a FILE-STREAM",
+			STRFUN(builtin), STROBJ(filename));
+	filename = filename->data.stream.pathname;
+    }
+    else {
+	CHECK_PATHNAME(filename);
+    }
+    GC_LEAVE();
+
+    return (LispUnlink(THESTR(CAR(filename->data.pathname))) ? NIL : T);
+}
+
+LispObj *
+Lisp_RenameFile(LispBuiltin *builtin)
+/*
+ rename-file filename new-name
+ */
+{
+    int code;
+    GC_ENTER();
+    char *from, *to;
+    LispObj *old_truename, *new_truename;
+
+    LispObj *filename, *new_name;
+
+    new_name = ARGUMENT(1);
+    filename = ARGUMENT(0);
+
+    if (STRINGP(filename)) {
+	filename = APPLY1(Oparse_namestring, filename);
+	GC_PROTECT(filename);
+    }
+    else if (STREAMP(filename)) {
+	if (filename->data.stream.type != LispStreamFile)
+	    LispDestroy("%s: %s is not a FILE-STREAM",
+			STRFUN(builtin), STROBJ(filename));
+	filename = filename->data.stream.pathname;
+    }
+    else {
+	CHECK_PATHNAME(filename);
+    }
+    old_truename = APPLY1(Otruename, filename);
+    GC_PROTECT(old_truename);
+
+    if (STRINGP(new_name)) {
+	new_name = APPLY3(Oparse_namestring, new_name, NIL, filename);
+	GC_PROTECT(new_name);
+    }
+    else {
+	CHECK_PATHNAME(new_name);
+    }
+
+    from = THESTR(CAR(filename->data.pathname));
+    to = THESTR(CAR(new_name->data.pathname));
+    code = LispRename(from, to);
+    if (code)
+	LispDestroy("%s: rename(%s, %s): %s",
+		    STRFUN(builtin), from, to, strerror(errno));
+    GC_LEAVE();
+
+    new_truename = APPLY1(Otruename, new_name);
+    RETURN_COUNT = 2;
+    RETURN(0) = old_truename;
+    RETURN(1) = new_truename;
+
+    return (new_name);
+}
+
+LispObj *
+Lisp_Streamp(LispBuiltin *builtin)
+/*
+ streamp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (STREAMP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_InputStreamP(LispBuiltin *builtin)
+/*
+ input-stream-p stream
+ */
+{
+    LispObj *stream;
+
+    stream = ARGUMENT(0);
+
+    CHECK_STREAM(stream);
+
+    return (stream->data.stream.readable ? T : NIL);
+}
+
+LispObj *
+Lisp_OpenStreamP(LispBuiltin *builtin)
+/*
+ open-stream-p stream
+ */
+{
+   LispObj *stream;
+
+    stream = ARGUMENT(0);
+
+    CHECK_STREAM(stream);
+
+    return (stream->data.stream.readable || stream->data.stream.writable ?
+	    T : NIL);
+}
+
+LispObj *
+Lisp_OutputStreamP(LispBuiltin *builtin)
+/*
+ output-stream-p stream
+ */
+{
+    LispObj *stream;
+
+    stream = ARGUMENT(0);
+
+    CHECK_STREAM(stream);
+
+    return (stream->data.stream.writable ? T : NIL);
+}
+
+LispObj *
+Lisp_Open(LispBuiltin *builtin)
+/*
+ open filename &key direction element-type if-exists if-does-not-exist external-format
+ */
+{
+    GC_ENTER();
+    char *string;
+    LispObj *stream = NIL;
+    int mode, flags, direction, exist, noexist, file_exist;
+    LispFile *file;
+
+    LispObj *filename, *odirection, *element_type, *if_exists,
+	    *if_does_not_exist, *external_format;
+
+    external_format = ARGUMENT(5);
+    if_does_not_exist = ARGUMENT(4);
+    if_exists = ARGUMENT(3);
+    element_type = ARGUMENT(2);
+    odirection = ARGUMENT(1);
+    filename = ARGUMENT(0);
+
+    if (STRINGP(filename)) {
+	filename = APPLY1(Oparse_namestring, filename);
+	GC_PROTECT(filename);
+    }
+    else if (STREAMP(filename)) {
+	if (filename->data.stream.type != LispStreamFile)
+	    LispDestroy("%s: %s is not a FILE-STREAM",
+			STRFUN(builtin), STROBJ(filename));
+	filename = filename->data.stream.pathname;
+    }
+    else {
+	CHECK_PATHNAME(filename);
+    }
+
+    if (odirection != UNSPEC) {
+	direction = -1;
+	if (KEYWORDP(odirection)) {
+	    if (odirection == Kprobe)
+		direction = DIR_PROBE;
+	    else if (odirection == Kinput)
+		direction = DIR_INPUT;
+	    else if (odirection == Koutput)
+		direction = DIR_OUTPUT;
+	    else if (odirection == Kio)
+		direction = DIR_IO;
+	}
+	if (direction == -1)
+	    LispDestroy("%s: bad :DIRECTION %s",
+			STRFUN(builtin), STROBJ(odirection));
+    }
+    else
+	direction = DIR_INPUT;
+
+    if (element_type != UNSPEC) {
+	/* just check argument... */
+	if (SYMBOLP(element_type) &&
+	    ATOMID(element_type) == Scharacter)
+	    ;	/* do nothing */
+	else if (KEYWORDP(element_type) &&
+	    ATOMID(element_type) == Sdefault)
+	    ;	/* do nothing */
+	else
+	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
+			STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
+    }
+
+    if (if_exists != UNSPEC) {
+	exist = -1;
+	if (if_exists == NIL)
+	    exist = EXT_NIL;
+	else if (KEYWORDP(if_exists)) {
+	    if (if_exists == Kerror)
+		exist = EXT_ERROR;
+	    else if (if_exists == Knew_version)
+		exist = EXT_NEW_VERSION;
+	    else if (if_exists == Krename)
+		exist = EXT_RENAME;
+	    else if (if_exists == Krename_and_delete)
+		exist = EXT_RENAME_DELETE;
+	    else if (if_exists == Koverwrite)
+		exist = EXT_OVERWRITE;
+	    else if (if_exists == Kappend)
+		exist = EXT_APPEND;
+	    else if (if_exists == Ksupersede)
+		exist = EXT_SUPERSEDE;
+	}
+	if (exist == -1)
+	    LispDestroy("%s: bad :IF-EXISTS %s",
+			STRFUN(builtin), STROBJ(if_exists));
+    }
+    else
+	exist = EXT_ERROR;
+
+    if (if_does_not_exist != UNSPEC) {
+	noexist = -1;
+	if (if_does_not_exist == NIL)
+	    noexist = NOEXT_NIL;
+	if (KEYWORDP(if_does_not_exist)) {
+	    if (if_does_not_exist == Kerror)
+		noexist = NOEXT_ERROR;
+	    else if (if_does_not_exist == Kcreate)
+		noexist = NOEXT_CREATE;
+	}
+	if (noexist == -1)
+	    LispDestroy("%s: bad :IF-DOES-NO-EXISTS %s",
+			STRFUN(builtin), STROBJ(if_does_not_exist));
+    }
+    else
+	noexist = direction != DIR_INPUT ? NOEXT_NOTHING : NOEXT_ERROR;
+
+    if (external_format != UNSPEC) {
+	/* just check argument... */
+	if (SYMBOLP(external_format) &&
+	    ATOMID(external_format) == Scharacter)
+	    ;	/* do nothing */
+	else if (KEYWORDP(external_format) &&
+	    ATOMID(external_format) == Sdefault)
+	    ;	/* do nothing */
+	else
+	    LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
+			STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
+    }
+
+    /* string representation of pathname */
+    string = THESTR(CAR(filename->data.pathname));
+    mode = 0;
+
+    file_exist = access(string, F_OK) == 0;
+    if (file_exist) {
+	if (exist == EXT_NIL) {
+	    GC_LEAVE();
+	    return (NIL);
+	}
+    }
+    else {
+	if (noexist == NOEXT_NIL) {
+	    GC_LEAVE();
+	    return (NIL);
+	}
+	if (noexist == NOEXT_ERROR)
+	    LispDestroy("%s: file %s does not exist",
+			STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
+	else if (noexist == NOEXT_CREATE) {
+	    LispFile *tmp = LispFopen(string, FILE_WRITE);
+
+	    if (tmp)
+		LispFclose(tmp);
+	    else
+		LispDestroy("%s: cannot create file %s",
+			    STRFUN(builtin),
+			    STROBJ(CAR(filename->data.quote)));
+	}
+    }
+
+    if (direction == DIR_OUTPUT || direction == DIR_IO) {
+	if (file_exist) {
+	    if (exist == EXT_ERROR)
+		LispDestroy("%s: file %s already exists",
+			    STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
+	    if (exist == EXT_RENAME) {
+		/* Add an ending '~' at the end of the backup file */
+		char tmp[PATH_MAX + 1];
+
+		strcpy(tmp, string);
+		if (strlen(tmp) + 1 > PATH_MAX)
+		    LispDestroy("%s: backup name for %s too long",
+				STRFUN(builtin),
+				STROBJ(CAR(filename->data.quote)));
+		strcat(tmp, "~");
+		if (rename(string, tmp))
+		    LispDestroy("%s: rename: %s",
+				STRFUN(builtin), strerror(errno));
+		mode |= FILE_WRITE;
+	    }
+	    else if (exist == EXT_OVERWRITE)
+		mode |= FILE_WRITE;
+	    else if (exist == EXT_APPEND)
+		mode |= FILE_APPEND;
+	}
+	else
+	    mode |= FILE_WRITE;
+	if (direction == DIR_IO)
+	    mode |= FILE_IO;
+    }
+    else
+	mode |= FILE_READ;
+
+    file = LispFopen(string, mode);
+    if (file == NULL)
+	LispDestroy("%s: open: %s", STRFUN(builtin), strerror(errno));
+
+    flags = 0;
+    if (direction == DIR_PROBE) {
+	LispFclose(file);
+	file = NULL;
+    }
+    else {
+	if (direction == DIR_INPUT || direction == DIR_IO)
+	    flags |= STREAM_READ;
+	if (direction == DIR_OUTPUT || direction == DIR_IO)
+	    flags |= STREAM_WRITE;
+    }
+    stream = FILESTREAM(file, filename, flags);
+    GC_LEAVE();
+
+    return (stream);
+}
+
+LispObj *
+Lisp_Close(LispBuiltin *builtin)
+/*
+ close stream &key abort
+ */
+{
+    LispObj *stream, *oabort;
+
+    oabort = ARGUMENT(1);
+    stream = ARGUMENT(0);
+
+    CHECK_STREAM(stream);
+
+    if (stream->data.stream.readable || stream->data.stream.writable) {
+	stream->data.stream.readable = stream->data.stream.writable = 0;
+	if (stream->data.stream.type == LispStreamFile) {
+	    LispFclose(stream->data.stream.source.file);
+	    stream->data.stream.source.file = NULL;
+	}
+	else if (stream->data.stream.type == LispStreamPipe) {
+	    if (IPSTREAMP(stream)) {
+		LispFclose(IPSTREAMP(stream));
+		IPSTREAMP(stream) = NULL;
+	    }
+	    if (OPSTREAMP(stream)) {
+		LispFclose(OPSTREAMP(stream));
+		OPSTREAMP(stream) = NULL;
+	    }
+	    if (EPSTREAMP(stream)) {
+		LispFclose(EPSTREAMP(stream));
+		EPSTREAMP(stream) = NULL;
+	    }
+	    if (PIDPSTREAMP(stream) > 0) {
+		kill(PIDPSTREAMP(stream),
+		     oabort == UNSPEC || oabort == NIL ? SIGTERM : SIGKILL);
+		waitpid(PIDPSTREAMP(stream), NULL, 0);
+	    }
+	}
+	return (T);
+    }
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Listen(LispBuiltin *builtin)
+/*
+ listen &optional input-stream
+ */
+{
+    LispFile *file = NULL;
+    LispObj *result = NIL;
+
+    LispObj *stream;
+
+    stream = ARGUMENT(0);
+
+    if (stream == UNSPEC)
+	stream = NIL;
+    else if (stream != NIL) {
+	CHECK_STREAM(stream);
+    }
+    else
+	stream = lisp__data.standard_input;
+
+    if (stream->data.stream.readable) {
+	switch (stream->data.stream.type) {
+	    case LispStreamString:
+		if (SSTREAMP(stream)->input < SSTREAMP(stream)->length)
+		    result = T;
+		break;
+	    case LispStreamFile:
+		file = FSTREAMP(stream);
+		break;
+	    case LispStreamStandard:
+		file = FSTREAMP(stream);
+		break;
+	    case LispStreamPipe:
+		file = IPSTREAMP(stream);
+		break;
+	}
+
+	if (file != NULL) {
+	    if (file->available || file->offset < file->length)
+		result = T;
+	    else {
+		unsigned char c;
+
+		if (!file->nonblock) {
+		    if (fcntl(file->descriptor, F_SETFL, O_NONBLOCK) < 0)
+			LispDestroy("%s: fcntl: %s",
+				    STRFUN(builtin), strerror(errno));
+		    file->nonblock = 1;
+		}
+		if (read(file->descriptor, &c, 1) == 1) {
+		    LispFungetc(file, c);
+		    result = T;
+		}
+	    }
+	}
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_MakeStringInputStream(LispBuiltin *builtin)
+/*
+ make-string-input-stream string &optional start end
+ */
+{
+    char *string;
+    long start, end, length;
+
+    LispObj *ostring, *ostart, *oend, *result;
+
+    oend = ARGUMENT(2);
+    ostart = ARGUMENT(1);
+    ostring = ARGUMENT(0);
+
+    start = end = 0;
+    CHECK_STRING(ostring);
+    LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
+			      &start, &end, &length);
+    string = THESTR(ostring);
+
+    if (end - start != length)
+	length = end - start;
+    result = LSTRINGSTREAM(string + start, STREAM_READ, length);
+
+    return (result);
+}
+
+LispObj *
+Lisp_MakeStringOutputStream(LispBuiltin *builtin)
+/*
+ make-string-output-stream &key element-type
+ */
+{
+    LispObj *element_type;
+
+    element_type = ARGUMENT(0);
+
+    if (element_type != UNSPEC) {
+	/* just check argument... */
+	if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
+	    ;	/* do nothing */
+	else if (KEYWORDP(element_type) &&
+	    ATOMID(element_type) == Sdefault)
+	    ;	/* do nothing */
+	else
+	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
+			STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
+    }
+
+    return (LSTRINGSTREAM("", STREAM_WRITE, 1));
+}
+
+LispObj *
+Lisp_GetOutputStreamString(LispBuiltin *builtin)
+/*
+ get-output-stream-string string-output-stream
+ */
+{
+    int length;
+    char *string;
+    LispObj *string_output_stream, *result;
+
+    string_output_stream = ARGUMENT(0);
+
+    if (!STREAMP(string_output_stream) ||
+	string_output_stream->data.stream.type != LispStreamString ||
+	string_output_stream->data.stream.readable ||
+	!string_output_stream->data.stream.writable)
+	LispDestroy("%s: %s is not an output string stream",
+		    STRFUN(builtin), STROBJ(string_output_stream));
+
+    string = LispGetSstring(SSTREAMP(string_output_stream), &length);
+    result = LSTRING(string, length);
+
+    /* reset string */
+    SSTREAMP(string_output_stream)->output =
+	SSTREAMP(string_output_stream)->length =
+	SSTREAMP(string_output_stream)->column = 0;
+
+    return (result);
+}
+
+
+/* XXX Non standard functions below
+ */
+LispObj *
+Lisp_MakePipe(LispBuiltin *builtin)
+/*
+ make-pipe command-line &key :direction :element-type :external-format
+ */
+{
+    char *string;
+    LispObj *stream = NIL;
+    int flags, direction;
+    LispFile *error_file;
+    LispPipe *program;
+    int ifd[2];
+    int ofd[2];
+    int efd[2];
+    char *argv[4];
+
+    LispObj *command_line, *odirection, *element_type, *external_format;
+
+    external_format = ARGUMENT(3);
+    element_type = ARGUMENT(2);
+    odirection = ARGUMENT(1);
+    command_line = ARGUMENT(0);
+
+    if (PATHNAMEP(command_line))
+	command_line = CAR(command_line->data.quote);
+    else if (!STRINGP(command_line))
+	LispDestroy("%s: %s is a bad pathname",
+		    STRFUN(builtin), STROBJ(command_line));
+
+    if (odirection != UNSPEC) {
+	direction = -1;
+	if (KEYWORDP(odirection)) {
+	    if (odirection == Kprobe)
+		direction = DIR_PROBE;
+	    else if (odirection == Kinput)
+		direction = DIR_INPUT;
+	    else if (odirection == Koutput)
+		direction = DIR_OUTPUT;
+	    else if (odirection == Kio)
+		direction = DIR_IO;
+	}
+	if (direction == -1)
+	    LispDestroy("%s: bad :DIRECTION %s",
+			STRFUN(builtin), STROBJ(odirection));
+    }
+    else
+	direction = DIR_INPUT;
+
+    if (element_type != UNSPEC) {
+	/* just check argument... */
+	if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
+	    ;	/* do nothing */
+	else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault)
+	    ;	/* do nothing */
+	else
+	    LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
+			STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
+    }
+
+    if (external_format != UNSPEC) {
+	/* just check argument... */
+	if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter)
+	    ;	/* do nothing */
+	else if (KEYWORDP(external_format) &&
+		 ATOMID(external_format) == Sdefault)
+	    ;	/* do nothing */
+	else
+	    LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
+			STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
+    }
+
+    string = THESTR(command_line);
+    program = LispMalloc(sizeof(LispPipe));
+    if (direction != DIR_PROBE) {
+	argv[0] = "sh";
+	argv[1] = "-c";
+	argv[2] = string;
+	argv[3] = NULL;
+	pipe(ifd);
+	pipe(ofd);
+	pipe(efd);
+	if ((program->pid = fork()) == 0) {
+	    close(0);
+	    close(1);
+	    close(2);
+	    dup2(ofd[0], 0);
+	    dup2(ifd[1], 1);
+	    dup2(efd[1], 2);
+	    close(ifd[0]);
+	    close(ifd[1]);
+	    close(ofd[0]);
+	    close(ofd[1]);
+	    close(efd[0]);
+	    close(efd[1]);
+	    execve("/bin/sh", argv, environ);
+	    exit(-1);
+	}
+	else if (program->pid < 0)
+	    LispDestroy("%s: fork: %s", STRFUN(builtin), strerror(errno));
+
+	program->input = LispFdopen(ifd[0], FILE_READ | FILE_UNBUFFERED);
+	close(ifd[1]);
+	program->output = LispFdopen(ofd[1], FILE_WRITE | FILE_UNBUFFERED);
+	close(ofd[0]);
+	error_file = LispFdopen(efd[0], FILE_READ | FILE_UNBUFFERED);
+	close(efd[1]);
+    }
+    else {
+	program->pid = -1;
+	program->input = program->output = error_file = NULL;
+    }
+
+    flags = direction == DIR_PROBE ? 0 : STREAM_READ;
+    program->errorp = FILESTREAM(error_file, command_line, flags);
+
+    flags = 0;
+    if (direction != DIR_PROBE) {
+	if (direction == DIR_INPUT || direction == DIR_IO)
+	    flags |= STREAM_READ;
+	if (direction == DIR_OUTPUT || direction == DIR_IO)
+	    flags |= STREAM_WRITE;
+    }
+    stream = PIPESTREAM(program, command_line, flags);
+    LispMused(program);
+
+    return (stream);
+}
+
+/* Helper function, primarily for use with the xt module
+ */
+LispObj *
+Lisp_PipeBroken(LispBuiltin *builtin)
+/*
+ pipe-broken pipe-stream
+ */
+{
+    int pid, status, retval;
+    LispObj *result = NIL;
+
+    LispObj *pipe_stream;
+
+    pipe_stream = ARGUMENT(0);
+
+    if (!STREAMP(pipe_stream) ||
+	pipe_stream->data.stream.type != LispStreamPipe)
+	LispDestroy("%s: %s is not a pipe stream",
+		    STRFUN(builtin), STROBJ(pipe_stream));
+
+    if ((pid = PIDPSTREAMP(pipe_stream)) > 0) {
+	retval = waitpid(pid, &status, WNOHANG | WUNTRACED);
+	if (retval == pid || (retval == -1 && errno == ECHILD))
+	    result = T;
+    }
+
+    return (result);
+}
+
+/*
+ Helper function, so that it is not required to redirect error output
+ */
+LispObj *
+Lisp_PipeErrorStream(LispBuiltin *builtin)
+/*
+ pipe-error-stream pipe-stream
+ */
+{
+    LispObj *pipe_stream;
+
+    pipe_stream = ARGUMENT(0);
+
+    if (!STREAMP(pipe_stream) ||
+	pipe_stream->data.stream.type != LispStreamPipe)
+	LispDestroy("%s: %s is not a pipe stream",
+		    STRFUN(builtin), STROBJ(pipe_stream));
+
+    return (pipe_stream->data.stream.source.program->errorp);
+}
+
+/*
+ Helper function, primarily for use with the xt module
+ */
+LispObj *
+Lisp_PipeInputDescriptor(LispBuiltin *builtin)
+/*
+ pipe-input-descriptor pipe-stream
+ */
+{
+    LispObj *pipe_stream;
+
+    pipe_stream = ARGUMENT(0);
+
+    if (!STREAMP(pipe_stream) ||
+	pipe_stream->data.stream.type != LispStreamPipe)
+	LispDestroy("%s: %s is not a pipe stream",
+		    STRFUN(builtin), STROBJ(pipe_stream));
+    if (!IPSTREAMP(pipe_stream))
+	LispDestroy("%s: pipe %s is unreadable",
+		    STRFUN(builtin), STROBJ(pipe_stream));
+
+    return (INTEGER(LispFileno(IPSTREAMP(pipe_stream))));
+}
+
+/*
+ Helper function, primarily for use with the xt module
+ */
+LispObj *
+Lisp_PipeErrorDescriptor(LispBuiltin *builtin)
+/*
+ pipe-error-descriptor pipe-stream
+ */
+{
+    LispObj *pipe_stream;
+
+    pipe_stream = ARGUMENT(0);
+
+    if (!STREAMP(pipe_stream) ||
+	pipe_stream->data.stream.type != LispStreamPipe)
+	LispDestroy("%s: %s is not a pipe stream",
+		    STRFUN(builtin), STROBJ(pipe_stream));
+    if (!EPSTREAMP(pipe_stream))
+	LispDestroy("%s: pipe %s is closed",
+		    STRFUN(builtin), STROBJ(pipe_stream));
+
+    return (INTEGER(LispFileno(EPSTREAMP(pipe_stream))));
+}
diff --git a/lisp/stream.h b/lisp/stream.h
new file mode 100644
index 0000000..c510224
--- /dev/null
+++ b/lisp/stream.h
@@ -0,0 +1,58 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/stream.h,v 1.8 2002/12/06 03:25:27 paulo Exp $ */
+
+#ifndef Lisp_stream_h
+#define Lisp_stream_h
+
+#include "io.h"
+#include "internal.h"
+
+void LispStreamInit(void);
+
+LispObj *Lisp_DeleteFile(LispBuiltin*);
+LispObj *Lisp_RenameFile(LispBuiltin*);
+LispObj *Lisp_InputStreamP(LispBuiltin*);
+LispObj *Lisp_OpenStreamP(LispBuiltin*);
+LispObj *Lisp_OutputStreamP(LispBuiltin*);
+LispObj *Lisp_Open(LispBuiltin*);
+LispObj *Lisp_MakePipe(LispBuiltin*);
+LispObj *Lisp_PipeBroken(LispBuiltin*);
+LispObj *Lisp_PipeErrorStream(LispBuiltin*);
+LispObj *Lisp_PipeInputDescriptor(LispBuiltin*);
+LispObj *Lisp_PipeErrorDescriptor(LispBuiltin*);
+LispObj *Lisp_Close(LispBuiltin*);
+LispObj *Lisp_Listen(LispBuiltin*);
+LispObj *Lisp_Streamp(LispBuiltin*);
+LispObj *Lisp_MakeStringInputStream(LispBuiltin*);
+LispObj *Lisp_MakeStringOutputStream(LispBuiltin*);
+LispObj *Lisp_GetOutputStreamString(LispBuiltin*);
+
+#endif /* Lisp_stream_h */
diff --git a/lisp/string.c b/lisp/string.c
new file mode 100644
index 0000000..95952bd
--- /dev/null
+++ b/lisp/string.c
@@ -0,0 +1,1383 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/string.c,v 1.22 2002/12/04 05:27:58 paulo Exp $ */
+
+#include "helper.h"
+#include "read.h"
+#include "string.h"
+#include "private.h"
+#include <ctype.h>
+
+#define CHAR_LESS		1
+#define CHAR_LESS_EQUAL		2
+#define CHAR_EQUAL		3
+#define CHAR_GREATER_EQUAL	4
+#define CHAR_GREATER		5
+#define CHAR_NOT_EQUAL		6
+
+#define CHAR_ALPHAP		1
+#define CHAR_DOWNCASE		2
+#define CHAR_UPCASE		3
+#define CHAR_INT		4
+#define CHAR_BOTHP		5
+#define CHAR_UPPERP		6
+#define CHAR_LOWERP		7
+#define CHAR_GRAPHICP		8
+
+#ifndef MIN
+#define MIN(a, b)		((a) < (b) ? (a) : (b))
+#endif
+
+/*
+ * Prototypes
+ */
+static LispObj *LispCharCompare(LispBuiltin*, int, int);
+static LispObj *LispStringCompare(LispBuiltin*, int, int);
+static LispObj *LispCharOp(LispBuiltin*, int);
+static LispObj *LispStringTrim(LispBuiltin*, int, int, int);
+static LispObj *LispStringUpcase(LispBuiltin*, int);
+static LispObj *LispStringDowncase(LispBuiltin*, int);
+static LispObj *LispStringCapitalize(LispBuiltin*, int);
+
+/*
+ * Implementation
+ */
+static LispObj *
+LispCharCompare(LispBuiltin *builtin, int operation, int ignore_case)
+{
+    LispObj *object;
+    int cmp, value, next_value;
+
+    LispObj *character, *more_characters;
+
+    more_characters = ARGUMENT(1);
+    character = ARGUMENT(0);
+
+    CHECK_SCHAR(character);
+    value = SCHAR_VALUE(character);
+    if (ignore_case && islower(value))
+	value = toupper(value);
+
+    if (!CONSP(more_characters))
+	return (T);
+
+    /* First check if all parameters are characters */
+    for (object = more_characters; CONSP(object); object = CDR(object))
+	CHECK_SCHAR(CAR(object));
+
+    /* All characters in list must be different */
+    if (operation == CHAR_NOT_EQUAL) {
+	/* Compare all characters */
+	do {
+	    for (object = more_characters; CONSP(object); object = CDR(object)) {
+		character = CAR(object);
+		next_value = SCHAR_VALUE(character);
+		if (ignore_case && islower(next_value))
+		    next_value = toupper(next_value);
+		if (value == next_value)
+		    return (NIL);
+	    }
+	    value = SCHAR_VALUE(CAR(more_characters));
+	    if (ignore_case && islower(value))
+		value = toupper(value);
+	    more_characters = CDR(more_characters);
+	} while (CONSP(more_characters));
+
+	return (T);
+    }
+
+    /* Linearly compare characters */
+    for (; CONSP(more_characters); more_characters = CDR(more_characters)) {
+	character = CAR(more_characters);
+	next_value = SCHAR_VALUE(character);
+	if (ignore_case && islower(next_value))
+	    next_value = toupper(next_value);
+
+	switch (operation) {
+	    case CHAR_LESS:		cmp = value < next_value;	break;
+	    case CHAR_LESS_EQUAL:	cmp = value <= next_value;	break;
+	    case CHAR_EQUAL:		cmp = value == next_value;	break;
+	    case CHAR_GREATER_EQUAL:	cmp = value >= next_value;	break;
+	    case CHAR_GREATER:		cmp = value > next_value;	break;
+	    default:			cmp = 0;			break;
+	}
+
+	if (!cmp)
+	    return (NIL);
+	value = next_value;
+    }
+
+    return (T);
+}
+
+LispObj *
+Lisp_CharLess(LispBuiltin *builtin)
+/*
+ char< character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_LESS, 0));
+}
+
+LispObj *
+Lisp_CharLessEqual(LispBuiltin *builtin)
+/*
+ char<= character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_LESS_EQUAL, 0));
+}
+
+LispObj *
+Lisp_CharEqual_(LispBuiltin *builtin)
+/*
+ char= character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_EQUAL, 0));
+}
+
+LispObj *
+Lisp_CharGreater(LispBuiltin *builtin)
+/*
+ char> character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_GREATER, 0));
+}
+
+LispObj *
+Lisp_CharGreaterEqual(LispBuiltin *builtin)
+/*
+ char>= character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_GREATER_EQUAL, 0));
+}
+
+LispObj *
+Lisp_CharNotEqual_(LispBuiltin *builtin)
+/*
+ char/= character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_NOT_EQUAL, 0));
+}
+
+LispObj *
+Lisp_CharLessp(LispBuiltin *builtin)
+/*
+ char-lessp character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_LESS, 1));
+}
+
+LispObj *
+Lisp_CharNotGreaterp(LispBuiltin *builtin)
+/*
+ char-not-greaterp character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_LESS_EQUAL, 1));
+}
+
+LispObj *
+Lisp_CharEqual(LispBuiltin *builtin)
+/*
+ char-equalp character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_EQUAL, 1));
+}
+
+LispObj *
+Lisp_CharGreaterp(LispBuiltin *builtin)
+/*
+ char-greaterp character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_GREATER, 1));
+}
+
+LispObj *
+Lisp_CharNotLessp(LispBuiltin *builtin)
+/*
+ char-not-lessp &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_GREATER_EQUAL, 1));
+}
+
+LispObj *
+Lisp_CharNotEqual(LispBuiltin *builtin)
+/*
+ char-not-equal character &rest more-characters
+ */
+{
+    return (LispCharCompare(builtin, CHAR_NOT_EQUAL, 1));
+}
+
+static LispObj *
+LispCharOp(LispBuiltin *builtin, int operation)
+{
+    int value;
+    LispObj *result, *character;
+
+    character = ARGUMENT(0);
+    CHECK_SCHAR(character);
+    value = (int)SCHAR_VALUE(character);
+
+    switch (operation) {
+	case CHAR_ALPHAP:
+	    result = isalpha(value) ? T : NIL;
+	    break;
+	case CHAR_DOWNCASE:
+	    result = SCHAR(tolower(value));
+	    break;
+	case CHAR_UPCASE:
+	    result = SCHAR(toupper(value));
+	    break;
+	case CHAR_INT:
+	    result = FIXNUM(value);
+	    break;
+	case CHAR_BOTHP:
+	    result = isupper(value) || islower(value) ? T : NIL;
+	    break;
+	case CHAR_UPPERP:
+	    result = isupper(value) ? T : NIL;
+	    break;
+	case CHAR_LOWERP:
+	    result = islower(value) ? T : NIL;
+	    break;
+	case CHAR_GRAPHICP:
+	    result = value == ' ' || isgraph(value) ? T : NIL;
+	    break;
+	default:
+	    result = NIL;
+	    break;
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_AlphaCharP(LispBuiltin *builtin)
+/*
+ alpha-char-p char
+ */
+{
+    return (LispCharOp(builtin, CHAR_ALPHAP));
+}
+
+LispObj *
+Lisp_CharDowncase(LispBuiltin *builtin)
+/*
+ char-downcase character
+ */
+{
+    return (LispCharOp(builtin, CHAR_DOWNCASE));
+}
+
+LispObj *
+Lisp_CharInt(LispBuiltin *builtin)
+/*
+ char-int character
+ char-code character
+ */
+{
+    return (LispCharOp(builtin, CHAR_INT));
+}
+
+LispObj *
+Lisp_CharUpcase(LispBuiltin *builtin)
+/*
+ char-upcase character
+ */
+{
+    return (LispCharOp(builtin, CHAR_UPCASE));
+}
+
+LispObj *
+Lisp_BothCaseP(LispBuiltin *builtin)
+/*
+ both-case-p character
+ */
+{
+    return (LispCharOp(builtin, CHAR_BOTHP));
+}
+
+LispObj *
+Lisp_UpperCaseP(LispBuiltin *builtin)
+/*
+ upper-case-p character
+ */
+{
+    return (LispCharOp(builtin, CHAR_UPPERP));
+}
+
+LispObj *
+Lisp_LowerCaseP(LispBuiltin *builtin)
+/*
+ upper-case-p character
+ */
+{
+    return (LispCharOp(builtin, CHAR_LOWERP));
+}
+
+LispObj *
+Lisp_GraphicCharP(LispBuiltin *builtin)
+/*
+ graphic-char-p char
+ */
+{
+    return (LispCharOp(builtin, CHAR_GRAPHICP));
+}
+
+LispObj *
+Lisp_Char(LispBuiltin *builtin)
+/*
+ char string index
+ schar simple-string index
+ */
+{
+    char *string;
+    long offset, length;
+
+    LispObj *ostring, *oindex;
+
+    oindex = ARGUMENT(1);
+    ostring = ARGUMENT(0);
+
+    CHECK_STRING(ostring);
+    CHECK_INDEX(oindex);
+    offset = FIXNUM_VALUE(oindex);
+    string = THESTR(ostring);
+    length = STRLEN(ostring);
+
+    if (offset >= length)
+	LispDestroy("%s: index %ld too large for string length %ld",
+		    STRFUN(builtin), offset, length);
+
+    return (SCHAR(string[offset]));
+}
+
+/* helper function for setf
+ *	DONT explicitly call. Non standard function
+ */
+LispObj *
+Lisp_XeditCharStore(LispBuiltin *builtin)
+/*
+ xedit::char-store string index value
+ */
+{
+    int character;
+    long offset, length;
+    LispObj *ostring, *oindex, *ovalue;
+
+    ovalue = ARGUMENT(2);
+    oindex = ARGUMENT(1);
+    ostring = ARGUMENT(0);
+
+    CHECK_STRING(ostring);
+    CHECK_INDEX(oindex);
+    length = STRLEN(ostring);
+    offset = FIXNUM_VALUE(oindex);
+    if (offset >= length)
+	LispDestroy("%s: index %ld too large for string length %ld",
+		    STRFUN(builtin), offset, length);
+    CHECK_SCHAR(ovalue);
+    CHECK_STRING_WRITABLE(ostring);
+
+    character = SCHAR_VALUE(ovalue);
+
+    if (character < 0 || character > 255)
+	LispDestroy("%s: cannot represent character %d",
+		    STRFUN(builtin), character);
+
+    THESTR(ostring)[offset] = character;
+
+    return (ovalue);
+}
+
+LispObj *
+Lisp_Character(LispBuiltin *builtin)
+/*
+ character object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (LispCharacterCoerce(builtin, object));
+}
+
+LispObj *
+Lisp_Characterp(LispBuiltin *builtin)
+/*
+ characterp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (SCHARP(object) ? T : NIL);
+}
+
+LispObj *
+Lisp_DigitChar(LispBuiltin *builtin)
+/*
+ digit-char weight &optional radix
+ */
+{
+    long radix = 10, weight;
+    LispObj *oweight, *oradix, *result = NIL;
+
+    oradix = ARGUMENT(1);
+    oweight = ARGUMENT(0);
+
+    CHECK_FIXNUM(oweight);
+    weight = FIXNUM_VALUE(oweight);
+
+    if (oradix != UNSPEC) {
+	CHECK_INDEX(oradix);
+	radix = FIXNUM_VALUE(oradix);
+    }
+    if (radix < 2 || radix > 36)
+	LispDestroy("%s: radix must be >= 2 and <= 36, not %ld",
+		    STRFUN(builtin), radix);
+
+    if (weight >= 0 && weight < radix) {
+	if (weight < 9)
+	    weight += '0';
+	else
+	    weight += 'A' - 10;
+	result = SCHAR(weight);
+    }
+
+    return (result);
+}
+
+LispObj *
+Lisp_DigitCharP(LispBuiltin *builtin)
+/*
+ digit-char-p character &optional radix
+ */
+{
+    long radix = 10, character;
+    LispObj *ochar, *oradix, *result = NIL;
+
+    oradix = ARGUMENT(1);
+    ochar = ARGUMENT(0);
+
+    CHECK_SCHAR(ochar);
+    character = SCHAR_VALUE(ochar);
+    if (oradix != UNSPEC) {
+	CHECK_INDEX(oradix);
+	radix = FIXNUM_VALUE(oradix);
+    }
+    if (radix < 2 || radix > 36)
+	LispDestroy("%s: radix must be >= 2 and <= 36, not %ld",
+		    STRFUN(builtin), radix);
+
+    if (character >= '0' && character <= '9')
+	character -= '0';
+    else if (character >= 'A' && character <= 'Z')
+	character -= 'A' - 10;
+    else if (character >= 'a' && character <= 'z')
+	character -= 'a' - 10;
+    if (character < radix)
+	result = FIXNUM(character);
+
+    return (result);
+}
+
+LispObj *
+Lisp_IntChar(LispBuiltin *builtin)
+/*
+ int-char integer
+ code-char integer
+ */
+{
+    long character = 0;
+    LispObj *integer;
+
+    integer = ARGUMENT(0);
+
+    CHECK_FIXNUM(integer);
+    character = FIXNUM_VALUE(integer);
+
+    return (character >= 0 && character < 0xff ? SCHAR(character) : NIL);
+}
+
+/* XXX ignoring element-type */
+LispObj *
+Lisp_MakeString(LispBuiltin *builtin)
+/*
+ make-string size &key initial-element element-type
+ */
+{
+    long length;
+    char *string, initial;
+
+    LispObj *size, *initial_element, *element_type;
+
+    element_type = ARGUMENT(2);
+    initial_element = ARGUMENT(1);
+    size = ARGUMENT(0);
+
+    CHECK_INDEX(size);
+    length = FIXNUM_VALUE(size);
+    if (initial_element != UNSPEC) {
+	CHECK_SCHAR(initial_element);
+	initial = SCHAR_VALUE(initial_element);
+    }
+    else
+	initial = 0;
+
+    string = LispMalloc(length + 1);
+    memset(string, initial, length);
+    string[length] = '\0';
+
+    return (LSTRING2(string, length));
+}
+
+LispObj *
+Lisp_ParseInteger(LispBuiltin *builtin)
+/*
+ parse-integer string &key start end radix junk-allowed
+ */
+{
+    GC_ENTER();
+    char *ptr, *string;
+    int character, junk, sign, overflow;
+    long i, start, end, radix, length, integer, check;
+    LispObj *result;
+
+    LispObj *ostring, *ostart, *oend, *oradix, *junk_allowed;
+
+    junk_allowed = ARGUMENT(4);
+    oradix = ARGUMENT(3);
+    oend = ARGUMENT(2);
+    ostart = ARGUMENT(1);
+    ostring = ARGUMENT(0);
+
+    start = end = radix = 0;
+    result = NIL;
+
+    CHECK_STRING(ostring);
+    LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
+			      &start, &end, &length);
+    string = THESTR(ostring);
+    if (radix < 2 || radix > 36)
+	LispDestroy("%s: :RADIX %ld must be in the range 2 to 36",
+		    STRFUN(builtin), radix);
+
+    integer = check = 0;
+    ptr = string + start;
+    sign = overflow = 0;
+
+    /* Skip leading white spaces */
+    for (i = start; i < end && *ptr && isspace(*ptr); ptr++, i++)
+	;
+
+    /* Check for sign specification */
+    if (i < end && (*ptr == '-' || *ptr == '+')) {
+	sign = *ptr == '-';
+	++ptr;
+	++i;
+    }
+
+    for (junk = 0; i < end; i++, ptr++) {
+	character = *ptr;
+	if (islower(character))
+	    character = toupper(character);
+	if (character >= '0' && character <= '9') {
+	    if (character - '0' >= radix)
+		junk = 1;
+	    else {
+		check = integer;
+		integer = integer * radix + character - '0';
+	    }
+	}
+	else if (character >= 'A' && character <= 'Z') {
+	    if (character - 'A' + 10 >= radix)
+		junk = 1;
+	    else {
+		check = integer;
+		integer = integer * radix + character - 'A' + 10;
+	    }
+	}
+	else {
+	    if (isspace(character))
+		break;
+	    junk = 1;
+	}
+
+	if (junk)
+	    break;
+
+	if (!overflow && check > integer)
+	    overflow = 1;
+	/* keep looping just to count read bytes */
+    }
+
+    if (!junk)
+	/* Skip white spaces */
+	for (; i < end && *ptr && isspace(*ptr); ptr++, i++)
+	    ;
+
+    if ((junk || ptr == string) &&
+	(junk_allowed == UNSPEC || junk_allowed == NIL))
+	LispDestroy("%s: %s has a bad integer representation",
+		    STRFUN(builtin), STROBJ(ostring));
+    else if (ptr == string)
+	result = NIL;
+    else if (overflow) {
+	mpi *bigi = LispMalloc(sizeof(mpi));
+	char *str;
+
+	length = end - start + sign;
+	str = LispMalloc(length + 1);
+
+	strncpy(str, string - sign, length + sign);
+	str[length + sign] = '\0';
+	mpi_init(bigi);
+	mpi_setstr(bigi, str, radix);
+	LispFree(str);
+	result = BIGNUM(bigi);
+    }
+    else
+	result = INTEGER(sign ? -integer : integer);
+
+    GC_PROTECT(result);
+    RETURN(0) = FIXNUM(i);
+    RETURN_COUNT = 1;
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+Lisp_String(LispBuiltin *builtin)
+/*
+ string object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (LispStringCoerce(builtin, object));
+}
+
+LispObj *
+Lisp_Stringp(LispBuiltin *builtin)
+/*
+ stringp object
+ */
+{
+    LispObj *object;
+
+    object = ARGUMENT(0);
+
+    return (STRINGP(object) ? T : NIL);
+}
+
+/* XXX preserve-whitespace is being ignored */
+LispObj *
+Lisp_ReadFromString(LispBuiltin *builtin)
+/*
+ read-from-string string &optional eof-error-p eof-value &key start end preserve-whitespace
+ */
+{
+    GC_ENTER();
+    char *string;
+    LispObj *stream, *result;
+    long length, start, end, bytes_read;
+
+    LispObj *ostring, *eof_error_p, *eof_value,
+	    *ostart, *oend, *preserve_white_space;
+
+    preserve_white_space = ARGUMENT(5);
+    oend = ARGUMENT(4);
+    ostart = ARGUMENT(3);
+    eof_value = ARGUMENT(2);
+    eof_error_p = ARGUMENT(1);
+    ostring = ARGUMENT(0);
+
+    CHECK_STRING(ostring);
+    string = THESTR(ostring);
+    LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
+			      &start, &end, &length);
+
+    if (start > 0 || end < length)
+	length = end - start;
+    stream = LSTRINGSTREAM(string + start, STREAM_READ, length);
+
+    if (eof_value == UNSPEC)
+	eof_value = NIL;
+
+    LispPushInput(stream);
+    result = LispRead();
+    /* stream->data.stream.source.string->input is
+     * the offset of the last byte read in string */
+    bytes_read = stream->data.stream.source.string->input;
+    LispPopInput(stream);
+
+    if (result == NULL) {
+	if (eof_error_p == NIL)
+	    result = eof_value;
+	else
+	    LispDestroy("%s: unexpected end of input", STRFUN(builtin));
+    }
+
+    GC_PROTECT(result);
+    RETURN(0) = FIXNUM(start + bytes_read);
+    RETURN_COUNT = 1;
+    GC_LEAVE();
+
+    return (result);
+}
+
+static LispObj *
+LispStringTrim(LispBuiltin *builtin, int left, int right, int inplace)
+/*
+ string-{,left-,right-}trim character-bag string
+*/
+{
+    unsigned char *string;
+    long start, end, length;
+
+    LispObj *ochars, *ostring;
+
+    ostring = ARGUMENT(1);
+    ochars = ARGUMENT(0);
+
+    if (!POINTERP(ochars) || !(XSTRINGP(ochars) || XCONSP(ochars))) {
+	if (ARRAYP(ochars) && ochars->data.array.rank == 1)
+	    ochars = ochars->data.array.list;
+	else
+	    LispDestroy("%s: %s is not a sequence",
+			STRFUN(builtin), STROBJ(ochars));
+    }
+    CHECK_STRING(ostring);
+
+    string = (unsigned char*)THESTR(ostring);
+    length = STRLEN(ostring);
+
+    start = 0;
+    end = length;
+
+    if (XSTRINGP(ochars)) {
+	unsigned char *chars = (unsigned char*)THESTR(ochars);
+	long i, clength = STRLEN(ochars);
+
+	if (left) {
+	    for (; start < end; start++) {
+		for (i = 0; i < clength; i++)
+		    if (string[start] == chars[i])
+			break;
+		if (i >= clength)
+		    break;
+	    }
+	}
+	if (right) {
+	    for (--end; end >= 0; end--) {
+		for (i = 0; i < clength; i++)
+		    if (string[end] == chars[i])
+			break;
+		if (i >= clength)
+		    break;
+	    }
+	    ++end;
+	}
+    }
+    else {
+	LispObj *ochar, *list;
+
+	if (left) {
+	    for (; start < end; start++) {
+		for (list = ochars; CONSP(list); list = CDR(list)) {
+		    ochar = CAR(list);
+		    if (SCHARP(ochar) && string[start] == SCHAR_VALUE(ochar))
+			break;
+		}
+		if (!CONSP(list))
+		    break;
+	    }
+	}
+	if (right) {
+	    for (--end; end >= 0; end--) {
+		for (list = ochars; CONSP(list); list = CDR(list)) {
+		    ochar = CAR(list);
+		    if (SCHARP(ochar) && string[end] == SCHAR_VALUE(ochar))
+			break;
+		}
+		if (!CONSP(list))
+		    break;
+	    }
+	    ++end;
+	}
+    }
+
+    if (start == 0 && end == length)
+	return (ostring);
+
+    length = end - start;
+
+    if (inplace) {
+	CHECK_STRING_WRITABLE(ostring);
+	memmove(string, string + start, length);
+	string[length] = '\0';
+	STRLEN(ostring) = length;
+    }
+    else {
+	string = LispMalloc(length + 1);
+	memcpy(string, THESTR(ostring) + start, length);
+	string[length] = '\0';
+	ostring = LSTRING2((char*)string, length);
+    }
+
+    return (ostring);
+}
+
+LispObj *
+Lisp_StringTrim(LispBuiltin *builtin)
+/*
+ string-trim character-bag string
+ */
+{
+    return (LispStringTrim(builtin, 1, 1, 0));
+}
+
+LispObj *
+Lisp_NstringTrim(LispBuiltin *builtin)
+/*
+ ext::nstring-trim character-bag string
+ */
+{
+    return (LispStringTrim(builtin, 1, 1, 1));
+}
+
+LispObj *
+Lisp_StringLeftTrim(LispBuiltin *builtin)
+/*
+ string-left-trim character-bag string
+ */
+{
+    return (LispStringTrim(builtin, 1, 0, 0));
+}
+
+LispObj *
+Lisp_NstringLeftTrim(LispBuiltin *builtin)
+/*
+ ext::nstring-left-trim character-bag string
+ */
+{
+    return (LispStringTrim(builtin, 1, 0, 1));
+}
+
+LispObj *
+Lisp_StringRightTrim(LispBuiltin *builtin)
+/*
+ string-right-trim character-bag string
+ */
+{
+    return (LispStringTrim(builtin, 0, 1, 0));
+}
+
+LispObj *
+Lisp_NstringRightTrim(LispBuiltin *builtin)
+/*
+ ext::nstring-right-trim character-bag string
+ */
+{
+    return (LispStringTrim(builtin, 0, 1, 1));
+}
+
+static LispObj *
+LispStringCompare(LispBuiltin *builtin, int function, int ignore_case)
+{
+    int cmp1, cmp2;
+    LispObj *fixnum;
+    unsigned char *string1, *string2;
+    long start1, end1, start2, end2, offset, length;
+
+    LispGetStringArgs(builtin, (char**)&string1, (char**)&string2,
+		      &start1, &end1, &start2, &end2);
+
+    string1 += start1;
+    string2 += start2;
+
+    if (function == CHAR_EQUAL) {
+	length = end1 - start1;
+
+	if (length != (end2 - start2))
+	    return (NIL);
+
+	if (!ignore_case)
+	    return (memcmp(string1, string2, length) ? NIL : T);
+
+	for (; length; length--, string1++, string2++)
+	    if (toupper(*string1) != toupper(*string2))
+		return (NIL);
+	return (T);
+    }
+
+    end1 -= start1;
+    end2 -= start2;
+    length = MIN(end1, end2);
+    for (offset = 0;
+	 offset < length;
+	 string1++, string2++, offset++, start1++, start2++) {
+	cmp1 = *string1;
+	cmp2 = *string2;
+	if (ignore_case) {
+	    cmp1 = toupper(cmp1);
+	    cmp2 = toupper(cmp2);
+	}
+	if (cmp1 != cmp2) {
+	    fixnum = FIXNUM(start1);
+	    switch (function) {
+		case CHAR_LESS:
+		    return ((cmp1 < cmp2) ? fixnum : NIL);
+		case CHAR_LESS_EQUAL:
+		    return ((cmp1 <= cmp2) ? fixnum : NIL);
+		case CHAR_NOT_EQUAL:
+		    return (fixnum);
+		case CHAR_GREATER_EQUAL:
+		    return ((cmp1 >= cmp2) ? fixnum : NIL);
+		case CHAR_GREATER:
+		    return ((cmp1 > cmp2) ? fixnum : NIL);
+	    }
+	}
+    }
+
+    fixnum = FIXNUM(start1);
+    switch (function) {
+	case CHAR_LESS:
+	    return (start1 >= end1 && start2 < end2 ? fixnum : NIL);
+	case CHAR_LESS_EQUAL:
+	    return (start1 >= end1 ? fixnum : NIL);
+	case CHAR_NOT_EQUAL:
+	    return (start1 >= end1 && start2 >= end2 ? NIL : fixnum);
+	case CHAR_GREATER_EQUAL:
+	    return (start2 >= end2 ? fixnum : NIL);
+	case CHAR_GREATER:
+	    return (start2 >= end2 && start1 < end1 ? fixnum : NIL);
+    }
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_StringEqual_(LispBuiltin *builtin)
+/*
+ string= string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_EQUAL, 0));
+}
+
+LispObj *
+Lisp_StringLess(LispBuiltin *builtin)
+/*
+ string< string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_LESS, 0));
+}
+
+LispObj *
+Lisp_StringGreater(LispBuiltin *builtin)
+/*
+ string> string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_GREATER, 0));
+}
+
+LispObj *
+Lisp_StringLessEqual(LispBuiltin *builtin)
+/*
+ string<= string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_LESS_EQUAL, 0));
+}
+
+LispObj *
+Lisp_StringGreaterEqual(LispBuiltin *builtin)
+/*
+ string>= string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_GREATER_EQUAL, 0));
+}
+
+LispObj *
+Lisp_StringNotEqual_(LispBuiltin *builtin)
+/*
+ string/= string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_NOT_EQUAL, 0));
+}
+
+LispObj *
+Lisp_StringEqual(LispBuiltin *builtin)
+/*
+ string-equal string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_EQUAL, 1));
+}
+
+LispObj *
+Lisp_StringLessp(LispBuiltin *builtin)
+/*
+ string-lessp string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_LESS, 1));
+}
+
+LispObj *
+Lisp_StringGreaterp(LispBuiltin *builtin)
+/*
+ string-greaterp string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_GREATER, 1));
+}
+
+LispObj *
+Lisp_StringNotGreaterp(LispBuiltin *builtin)
+/*
+ string-not-greaterp string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_LESS_EQUAL, 1));
+}
+
+LispObj *
+Lisp_StringNotLessp(LispBuiltin *builtin)
+/*
+ string-not-lessp string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_GREATER_EQUAL, 1));
+}
+
+LispObj *
+Lisp_StringNotEqual(LispBuiltin *builtin)
+/*
+ string-not-equal string1 string2 &key start1 end1 start2 end2
+ */
+{
+    return (LispStringCompare(builtin, CHAR_NOT_EQUAL, 1));
+}
+
+LispObj *
+LispStringUpcase(LispBuiltin *builtin, int inplace)
+/*
+ string-upcase string &key start end
+ nstring-upcase string &key start end
+ */
+{
+    LispObj *result;
+    char *string, *newstring;
+    long start, end, length, offset;
+
+    LispObj *ostring, *ostart, *oend;
+
+    oend = ARGUMENT(2);
+    ostart = ARGUMENT(1);
+    ostring = ARGUMENT(0);
+    CHECK_STRING(ostring);
+    LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
+			      &start, &end, &offset);
+    result = ostring;
+    string = THESTR(ostring);
+    length = STRLEN(ostring);
+
+    /* first check if something need to be done */
+    for (offset = start; offset < end; offset++)
+	if (string[offset] != toupper(string[offset]))
+	    break;
+
+    if (offset >= end)
+	return (result);
+
+    if (inplace) {
+	CHECK_STRING_WRITABLE(ostring);
+	newstring = string;
+    }
+    else {
+	/* upcase a copy of argument */
+	newstring = LispMalloc(length + 1);
+	if (offset)
+	    memcpy(newstring, string, offset);
+	if (length > end)
+	    memcpy(newstring + end, string + end, length - end);
+	newstring[length] = '\0';
+    }
+
+    for (; offset < end; offset++)
+	newstring[offset] = toupper(string[offset]);
+
+    if (!inplace)
+	result = LSTRING2(newstring, length);
+
+    return (result);
+}
+
+LispObj *
+Lisp_StringUpcase(LispBuiltin *builtin)
+/*
+ string-upcase string &key start end
+ */
+{
+    return (LispStringUpcase(builtin, 0));
+}
+
+LispObj *
+Lisp_NstringUpcase(LispBuiltin *builtin)
+/*
+ nstring-upcase string &key start end
+ */
+{
+    return (LispStringUpcase(builtin, 1));
+}
+
+LispObj *
+LispStringDowncase(LispBuiltin *builtin, int inplace)
+/*
+ string-downcase string &key start end
+ nstring-downcase string &key start end
+ */
+{
+    LispObj *result;
+    char *string, *newstring;
+    long start, end, length, offset;
+
+    LispObj *ostring, *ostart, *oend;
+
+    oend = ARGUMENT(2);
+    ostart = ARGUMENT(1);
+    ostring = ARGUMENT(0);
+    CHECK_STRING(ostring);
+    LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
+			      &start, &end, &offset);
+    result = ostring;
+    string = THESTR(ostring);
+    length = STRLEN(ostring);
+
+    /* first check if something need to be done */
+    for (offset = start; offset < end; offset++)
+	if (string[offset] != tolower(string[offset]))
+	    break;
+
+    if (offset >= end)
+	return (result);
+
+    if (inplace) {
+	CHECK_STRING_WRITABLE(ostring);
+	newstring = string;
+    }
+    else {
+	/* downcase a copy of argument */
+	newstring = LispMalloc(length + 1);
+	if (offset)
+	    memcpy(newstring, string, offset);
+	if (length > end)
+	    memcpy(newstring + end, string + end, length - end);
+	newstring[length] = '\0';
+    }
+    for (; offset < end; offset++)
+	newstring[offset] = tolower(string[offset]);
+
+    if (!inplace)
+	result = LSTRING2(newstring, length);
+
+    return (result);
+}
+
+LispObj *
+Lisp_StringDowncase(LispBuiltin *builtin)
+/*
+ string-downcase string &key start end
+ */
+{
+    return (LispStringDowncase(builtin, 0));
+}
+
+LispObj *
+Lisp_NstringDowncase(LispBuiltin *builtin)
+/*
+ nstring-downcase string &key start end
+ */
+{
+    return (LispStringDowncase(builtin, 1));
+}
+
+LispObj *
+LispStringCapitalize(LispBuiltin *builtin, int inplace)
+/*
+ string-capitalize string &key start end
+ nstring-capitalize string &key start end
+ */
+{
+    LispObj *result;
+    char *string, *newstring;
+    long start, end, length, offset, upcase;
+
+    LispObj *ostring, *ostart, *oend;
+
+    oend = ARGUMENT(2);
+    ostart = ARGUMENT(1);
+    ostring = ARGUMENT(0);
+    CHECK_STRING(ostring);
+    LispCheckSequenceStartEnd(builtin, ostring, ostart, oend,
+			      &start, &end, &offset);
+    result = ostring;
+    string = THESTR(ostring);
+    length = STRLEN(ostring);
+
+    /* first check if something need to be done */
+    for (upcase = 1, offset = start; offset < end; offset++) {
+	if (upcase) {
+	    if (!isalnum(string[offset]))
+		continue;
+	    if (string[offset] != toupper(string[offset]))
+		break;
+	    upcase = 0;
+	}
+	else {
+	    if (isalnum(string[offset])) {
+		if (string[offset] != tolower(string[offset]))
+		    break;
+	    }
+	    else
+		upcase = 1;
+	}
+    }
+
+    if (offset >= end)
+	return (result);
+
+    if (inplace) {
+	CHECK_STRING_WRITABLE(ostring);
+	newstring = string;
+    }
+    else {
+	/* capitalize a copy of argument */
+	newstring = LispMalloc(length + 1);
+	memcpy(newstring, string, length);
+	newstring[length] = '\0';
+    }
+    for (; offset < end; offset++) {
+	if (upcase) {
+	    if (!isalnum(string[offset]))
+		continue;
+	    newstring[offset] = toupper(string[offset]);
+	    upcase = 0;
+	}
+	else {
+	    if (isalnum(newstring[offset]))
+		newstring[offset] = tolower(string[offset]);
+	    else
+		upcase = 1;
+	}
+    }
+
+    if (!inplace)
+	result = LSTRING2(newstring, length);
+
+    return (result);
+}
+
+LispObj *
+Lisp_StringCapitalize(LispBuiltin *builtin)
+/*
+ string-capitalize string &key start end
+ */
+{
+    return (LispStringCapitalize(builtin, 0));
+}
+
+LispObj *
+Lisp_NstringCapitalize(LispBuiltin *builtin)
+/*
+ nstring-capitalize string &key start end
+ */
+{
+    return (LispStringCapitalize(builtin, 1));
+}
+
+LispObj *
+Lisp_StringConcat(LispBuiltin *builtin)
+/*
+ string-concat &rest strings
+ */
+{
+    char *buffer;
+    long size, length;
+    LispObj *object, *string;
+
+    LispObj *strings;
+
+    strings = ARGUMENT(0);
+
+    if (strings == NIL)
+	return (STRING(""));
+
+    for (length = 1, object = strings; CONSP(object); object = CDR(object)) {
+	string = CAR(object);
+	CHECK_STRING(string);
+	length += STRLEN(string);
+    }
+
+    buffer = LispMalloc(length);
+
+    for (length = 0, object = strings; CONSP(object); object = CDR(object)) {
+	string = CAR(object);
+	size = STRLEN(string);
+	memcpy(buffer + length, THESTR(string), size);
+	length += size;
+    }
+    buffer[length] = '\0';
+    object = LSTRING2(buffer, length);
+
+    return (object);
+}
diff --git a/lisp/string.h b/lisp/string.h
new file mode 100644
index 0000000..02b416b
--- /dev/null
+++ b/lisp/string.h
@@ -0,0 +1,95 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/string.h,v 1.11 2002/11/25 02:35:30 paulo Exp $ */
+
+#ifndef Lisp_string_h
+#define Lisp_string_h
+
+#include "internal.h"
+
+LispObj *Lisp_AlphaCharP(LispBuiltin*);
+LispObj *Lisp_BothCaseP(LispBuiltin*);
+LispObj *Lisp_Char(LispBuiltin*);
+LispObj *Lisp_CharLess(LispBuiltin*);
+LispObj *Lisp_CharLessEqual(LispBuiltin*);
+LispObj *Lisp_CharEqual_(LispBuiltin*);
+LispObj *Lisp_CharGreater(LispBuiltin*);
+LispObj *Lisp_CharGreaterEqual(LispBuiltin*);
+LispObj *Lisp_CharNotEqual_(LispBuiltin*);
+LispObj *Lisp_CharLessp(LispBuiltin*);
+LispObj *Lisp_CharNotGreaterp(LispBuiltin*);
+LispObj *Lisp_CharEqual(LispBuiltin*);
+LispObj *Lisp_CharGreaterp(LispBuiltin*);
+LispObj *Lisp_CharNotLessp(LispBuiltin*);
+LispObj *Lisp_CharNotEqual(LispBuiltin*);
+LispObj *Lisp_Character(LispBuiltin*);
+LispObj *Lisp_Characterp(LispBuiltin*);
+LispObj *Lisp_CharDowncase(LispBuiltin*);
+LispObj *Lisp_CharInt(LispBuiltin*);
+LispObj *Lisp_CharUpcase(LispBuiltin*);
+LispObj *Lisp_DigitChar(LispBuiltin*);
+LispObj *Lisp_DigitCharP(LispBuiltin*);
+LispObj *Lisp_IntChar(LispBuiltin*);
+LispObj *Lisp_GraphicCharP(LispBuiltin*);
+LispObj *Lisp_LowerCaseP(LispBuiltin*);
+LispObj *Lisp_MakeString(LispBuiltin*);
+LispObj *Lisp_ParseInteger(LispBuiltin*);
+LispObj *Lisp_ReadFromString(LispBuiltin*);
+LispObj *Lisp_String(LispBuiltin*);
+LispObj *Lisp_Stringp(LispBuiltin*);
+LispObj *Lisp_StringTrim(LispBuiltin*);
+LispObj *Lisp_StringLeftTrim(LispBuiltin*);
+LispObj *Lisp_StringRightTrim(LispBuiltin*);
+LispObj *Lisp_NstringTrim(LispBuiltin*);
+LispObj *Lisp_NstringLeftTrim(LispBuiltin*);
+LispObj *Lisp_NstringRightTrim(LispBuiltin*);
+LispObj *Lisp_StringEqual_(LispBuiltin*);
+LispObj *Lisp_StringLess(LispBuiltin*);
+LispObj *Lisp_StringGreater(LispBuiltin*);
+LispObj *Lisp_StringLessEqual(LispBuiltin*);
+LispObj *Lisp_StringGreaterEqual(LispBuiltin*);
+LispObj *Lisp_StringNotEqual_(LispBuiltin*);
+LispObj *Lisp_StringEqual(LispBuiltin*);
+LispObj *Lisp_StringGreaterp(LispBuiltin*);
+LispObj *Lisp_StringLessp(LispBuiltin*);
+LispObj *Lisp_StringNotLessp(LispBuiltin*);
+LispObj *Lisp_StringNotGreaterp(LispBuiltin*);
+LispObj *Lisp_StringNotEqual(LispBuiltin*);
+LispObj *Lisp_NstringUpcase(LispBuiltin*);
+LispObj *Lisp_StringUpcase(LispBuiltin*);
+LispObj *Lisp_StringDowncase(LispBuiltin*);
+LispObj *Lisp_NstringDowncase(LispBuiltin*);
+LispObj *Lisp_StringCapitalize(LispBuiltin*);
+LispObj *Lisp_NstringCapitalize(LispBuiltin*);
+LispObj *Lisp_StringConcat(LispBuiltin*);
+LispObj *Lisp_UpperCaseP(LispBuiltin*);
+LispObj *Lisp_XeditCharStore(LispBuiltin*);
+
+#endif /* Lisp_string_h */
diff --git a/lisp/struct.c b/lisp/struct.c
new file mode 100644
index 0000000..0d2a768
--- /dev/null
+++ b/lisp/struct.c
@@ -0,0 +1,371 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/struct.c,v 1.22 2002/11/23 08:26:50 paulo Exp $ */
+
+#include "struct.h"
+
+/*
+ * Prototypes
+ */
+static LispObj *LispStructAccessOrStore(LispBuiltin*, int);
+
+/*
+ * Initialization
+ */
+LispObj *Omake_struct, *Ostruct_access, *Ostruct_store, *Ostruct_type;
+
+Atom_id Smake_struct, Sstruct_access, Sstruct_store, Sstruct_type;
+
+/*
+ * Implementation
+ */
+LispObj *
+Lisp_Defstruct(LispBuiltin *builtin)
+/*
+ defstruct name &rest description
+ */
+{
+    int intern;
+    LispAtom *atom;
+    int i, size, length, slength;
+    char *name, *strname, *sname;
+    LispObj *list, *cons, *object, *definition, *documentation;
+
+    LispObj *oname, *description;
+
+    description = ARGUMENT(1);
+    oname = ARGUMENT(0);
+
+    CHECK_SYMBOL(oname);
+
+    strname = ATOMID(oname);
+    length = strlen(strname);
+
+	    /* MAKE- */
+    size = length + 6;
+    name = LispMalloc(size);
+
+    sprintf(name, "MAKE-%s", strname);
+    atom = (object = ATOM(name))->data.atom;
+
+    if (atom->a_builtin)
+	LispDestroy("%s: %s cannot be a structure name",
+		    STRFUN(builtin), STROBJ(oname));
+
+    intern = !atom->ext;
+
+    if (CONSP(description) && STRINGP(CAR(description))) {
+	documentation = CAR(description);
+	description = CDR(description);
+    }
+    else
+	documentation = NIL;
+
+    /* get structure fields and default values */
+    for (list = description; CONSP(list); list = CDR(list)) {
+	object = CAR(list);
+
+	cons = list;
+	if (CONSP(object)) {
+	    if ((CONSP(CDR(object)) && CDR(CDR(object)) != NIL) ||
+		(!CONSP(CDR(object)) && CDR(object) != NIL))
+	    LispDestroy("%s: bad initialization %s",
+			STRFUN(builtin), STROBJ(object));
+	    cons = object;
+	    object = CAR(object);
+	}
+	if (!SYMBOLP(object) || strcmp(ATOMID(object), "P") == 0)
+	    /* p is invalid as a field name due to `type'-p */
+	    LispDestroy("%s: %s cannot be a field for %s",
+			STRFUN(builtin), STROBJ(object), ATOMID(oname));
+
+	if (!KEYWORDP(object))
+	    CAR(cons) = KEYWORD(ATOMID(object));
+
+	/* check for repeated field names */
+	for (object = description; object != list; object = CDR(object)) {
+	    LispObj *left = CAR(object), *right = CAR(list);
+
+	    if (CONSP(left))
+		left = CAR(left);
+	    if (CONSP(right))
+		right = CAR(right);
+
+	    if (ATOMID(left) == ATOMID(right))
+		LispDestroy("%s: only one slot named %s allowed",
+			    STRFUN(builtin), STROBJ(left));
+	}
+    }
+
+    /* atom should not have been modified */
+    definition = CONS(oname, description);
+    LispSetAtomStructProperty(atom, definition, STRUCT_CONSTRUCTOR);
+    if (!intern)
+	LispExportSymbol(object);
+
+    atom = oname->data.atom;
+    if (atom->a_defstruct)
+	LispWarning("%s: structure %s is being redefined",
+		    STRFUN(builtin), strname);
+    LispSetAtomStructProperty(atom, definition, STRUCT_NAME);
+
+    sprintf(name, "%s-P", strname);
+    atom = (object = ATOM(name))->data.atom;
+    LispSetAtomStructProperty(atom, definition, STRUCT_CHECK);
+    if (!intern)
+	LispExportSymbol(object);
+
+    for (i = 0, list = description; CONSP(list); i++, list = CDR(list)) {
+	if (CONSP(CAR(list)))
+	    sname = ATOMID(CAR(CAR(list)));
+	else
+	    sname = ATOMID(CAR(list));
+	slength = strlen(sname);
+	if (length + slength + 2 > size) {
+	    size = length + slength + 2;
+	    name = LispRealloc(name, size);
+	}
+	sprintf(name, "%s-%s", strname, sname);
+	atom = (object = ATOM(name))->data.atom;
+	LispSetAtomStructProperty(atom, definition, i);
+	if (!intern)
+	    LispExportSymbol(object);
+    }
+
+    LispFree(name);
+
+    if (documentation != NIL)
+	LispAddDocumentation(oname, documentation, LispDocStructure);
+
+    return (oname);
+}
+
+/* helper functions
+ *	DONT explicitly call them. Non standard functions.
+ */
+LispObj *
+Lisp_XeditMakeStruct(LispBuiltin *builtin)
+/*
+ lisp::make-struct atom &rest init
+ */
+{
+    int nfld, ncvt, length = lisp__data.protect.length;
+    LispAtom *atom = NULL;
+
+    LispObj *definition, *object, *field, *fields, *value = NIL, *cons, *list;
+    LispObj *struc, *init;
+
+    init = ARGUMENT(1);
+    struc = ARGUMENT(0);
+
+    field = cons = NIL;
+    if (!POINTERP(struc) ||
+	!(XSYMBOLP(struc) || XFUNCTIONP(struc)) ||
+	(atom = struc->data.atom)->a_defstruct == 0 ||
+	 atom->property->structure.function != STRUCT_CONSTRUCTOR)
+	LispDestroy("%s: invalid constructor %s",
+		    STRFUN(builtin), STROBJ(struc));
+    definition = atom->property->structure.definition;
+
+    ncvt = nfld = 0;
+    fields = NIL;
+
+    /* check for errors in argument list */
+    for (list = init, nfld = 0; CONSP(list); list = CDR(list)) {
+	CHECK_KEYWORD(CAR(list));
+	if (!CONSP(CDR(list)))
+	    LispDestroy("%s: values must be provided as pairs",
+			ATOMID(struc));
+	nfld++;
+	list = CDR(list);
+    }
+
+    /* create structure, CAR(definition) is structure name */
+    for (list = CDR(definition); CONSP(list); list = CDR(list)) {
+	Atom_id id;
+	LispObj *defvalue = NIL;
+
+	++nfld;
+	field = CAR(list);
+	if (CONSP(field)) {
+	    /* if default value provided */
+	    if (CONSP(CDR(field)))
+		defvalue = CAR(CDR(field));
+	    field = CAR(field);
+	}
+	id = ATOMID(field);
+
+	for (object = init; CONSP(object); object = CDR(object)) {
+	    /* field is a keyword, test above checked it */
+	    field = CAR(object);
+	    if (id == ATOMID(field)) {
+		/* value provided */
+		value = CAR(CDR(object));
+		ncvt++;
+		break;
+	    }
+	    object = CDR(object);
+	}
+
+	/* if no initialization given */
+	if (!CONSP(object)) {
+	    /* if default value in structure definition */
+	    if (defvalue != NIL)
+		value = EVAL(defvalue);
+	    else
+		value = NIL;
+	}
+
+	if (fields == NIL) {
+	    fields = cons = CONS(value, NIL);
+	    if (length + 1 >= lisp__data.protect.space)
+		LispMoreProtects();
+	    lisp__data.protect.objects[lisp__data.protect.length++] = fields;
+	}
+	else {
+	    RPLACD(cons, CONS(value, NIL));
+	    cons = CDR(cons);
+	}
+    }
+
+    /* if not enough arguments were converted, need to check because
+     * it is acceptable to set a field more than once, but in that case,
+     * only the first value will be used. */
+    if (nfld > ncvt) {
+	for (list = init; CONSP(list); list = CDR(list)) {
+	    Atom_id id = ATOMID(CAR(list));
+
+	    for (object = CDR(definition); CONSP(object);
+		 object = CDR(object)) {
+		field = CAR(object);
+		if (CONSP(field))
+		    field = CAR(field);
+		if (ATOMID(field) == id)
+		    break;
+	    }
+	    if (!CONSP(object))
+		LispDestroy("%s: %s is not a field for %s",
+			    ATOMID(struc), STROBJ(CAR(list)),
+			    ATOMID(CAR(definition)));
+	    list = CDR(list);
+	}
+    }
+
+    lisp__data.protect.length = length;
+
+    return (STRUCT(fields, definition));
+}
+
+static LispObj *
+LispStructAccessOrStore(LispBuiltin *builtin, int store)
+/*
+ lisp::struct-access atom struct
+ lisp::struct-store atom struct value
+ */
+{
+    long offset;
+    LispAtom *atom;
+    LispObj *definition, *list;
+
+    LispObj *name, *struc, *value = NIL;
+
+    if (store)
+	value = ARGUMENT(2);
+    struc = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    if (!POINTERP(name) ||
+	!(XSYMBOLP(name) || XFUNCTIONP(name)) ||
+	(atom = name->data.atom)->a_defstruct == 0 ||
+	(offset = atom->property->structure.function) < 0) {
+	LispDestroy("%s: invalid argument %s",
+		    STRFUN(builtin), STROBJ(name));
+	/*NOTREACHED*/
+	offset = 0;
+	atom = NULL;
+    }
+    definition = atom->property->structure.definition;
+
+    /* check if the object is of the required type */
+    if (!STRUCTP(struc) || struc->data.struc.def != definition)
+	LispDestroy("%s: %s is not a %s",
+		    ATOMID(name), STROBJ(struc), ATOMID(CAR(definition)));
+
+    for (list = struc->data.struc.fields; offset; list = CDR(list), offset--)
+	;
+
+    return (store ? RPLACA(list, value) : CAR(list));
+}
+
+LispObj *
+Lisp_XeditStructAccess(LispBuiltin *builtin)
+/*
+ lisp::struct-access atom struct
+ */
+{
+    return (LispStructAccessOrStore(builtin, 0));
+}
+
+LispObj *
+Lisp_XeditStructStore(LispBuiltin *builtin)
+/*
+ lisp::struct-store atom struct value
+ */
+{
+    return (LispStructAccessOrStore(builtin, 1));
+}
+
+LispObj *
+Lisp_XeditStructType(LispBuiltin *builtin)
+/*
+ lisp::struct-type atom struct
+ */
+{
+    LispAtom *atom = NULL;
+
+    LispObj *definition, *struc, *name;
+
+    struc = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    if (!POINTERP(name) ||
+	!(XSYMBOLP(name) || XFUNCTIONP(name)) ||
+	(atom = name->data.atom)->a_defstruct == 0 ||
+	(atom->property->structure.function != STRUCT_CHECK))
+	LispDestroy("%s: invalid argument %s",
+		    STRFUN(builtin), STROBJ(name));
+    definition = atom->property->structure.definition;
+
+    /* check if the object is of the required type */
+    if (STRUCTP(struc) && struc->data.struc.def == definition)
+	return (T);
+
+    return (NIL);
+}
diff --git a/lisp/struct.h b/lisp/struct.h
new file mode 100644
index 0000000..7559a02
--- /dev/null
+++ b/lisp/struct.h
@@ -0,0 +1,53 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/struct.h,v 1.6 2002/11/10 16:29:07 paulo Exp $ */
+
+#ifndef Lisp_struct_h
+#define Lisp_struct_h
+
+#include "private.h"
+
+/*
+ * Defines
+ */
+#define XSTRUCTP(object)	((object)->type == LispStruct_t)
+#define STRUCTP(object)		(POINTERP(object) && XSTRUCTP(object))
+#define STRUCT(fields, def)	LispNewStruct(fields, def)
+
+/*
+ * Prototypes
+ */
+LispObj *Lisp_Defstruct(LispBuiltin*);
+LispObj *Lisp_XeditMakeStruct(LispBuiltin*);
+LispObj *Lisp_XeditStructAccess(LispBuiltin*);
+LispObj *Lisp_XeditStructStore(LispBuiltin*);
+LispObj *Lisp_XeditStructType(LispBuiltin*);
+
+#endif /* Lisp_struct_h */
diff --git a/lisp/test/hello.lsp b/lisp/test/hello.lsp
new file mode 100644
index 0000000..5446919
--- /dev/null
+++ b/lisp/test/hello.lsp
@@ -0,0 +1,72 @@
+;;
+;; Copyright (c) 2001 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;  
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/test/hello.lsp,v 1.3 2002/11/08 08:01:01 paulo Exp $
+;;
+(require "xaw")
+(require "xt")
+
+(defun quit-callback (widget user call) (quit))
+
+(defun fix-shell-size (shell)
+    (let ((size (xt-get-values shell '("width" "height"))))
+	 (xt-set-values shell
+	     (list (cons "minWidth" (cdar size))
+		   (cons "maxWidth" (cdar size))
+		   (cons "minHeight" (cdadr size))
+		   (cons "maxHeight" (cdadr size)))
+	 )
+    )
+)
+
+(setq toplevel
+    (xt-app-initialize 'appcontext "Hello"
+	'(("title" . "Hello World!"))))
+
+(setq form
+    (xt-create-managed-widget "form" form-widget-class toplevel
+	'(("background" . "gray85")
+	  ("displayList" . "foreground rgb:7/9/7;lines 1,-1,-1,-1,-1,1;foreground gray90;lines -1,0,0,0,0,-1")
+	)))
+
+(setq button
+    (xt-create-managed-widget "button" command-widget-class form
+	'(("label" . "Goodbye world!")
+	  ("tip" . "This sample uses some customizations")
+	  ("foreground" . "gray10")
+	  ("background" . "gray80")
+	  ("displayList" . "foreground rgb:7/9/7;lines 1,-1,-1,-1,-1,1;foreground gray90;lines -1,0,0,0,0,-1")
+	)))
+(xt-add-callback button "callback" 'quit-callback)
+
+(xt-realize-widget toplevel)
+
+(fix-shell-size toplevel)
+
+(xt-app-main-loop appcontext)
diff --git a/lisp/test/list.lsp b/lisp/test/list.lsp
new file mode 100644
index 0000000..23f4496
--- /dev/null
+++ b/lisp/test/list.lsp
@@ -0,0 +1,1895 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/test/list.lsp,v 1.6 2002/12/06 03:25:29 paulo Exp $
+;;
+
+;; basic lisp function tests
+
+;; Most of the tests are just the examples from the
+;;
+;;	Common Lisp HyperSpec (TM)
+;;	Copyright 1996-2001, Xanalys Inc. All rights reserved.
+;;
+;; Some tests are hand crafted, to test how the interpreter treats
+;; uncommon arguments or special conditions
+
+
+#|
+ MAJOR PROBLEMS:
+
+ o NIL and T should be always treated as symbols, actually it is
+   legal to say (defun nil (...) ...)
+ o There aren't true uninterned symbols, there are only symbols that
+   did not yet establish the home package, but once one is created, an
+   interned symbol is always returned.
+|#
+
+(defun compare-test (test expect function arguments
+		     &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (apply function arguments))
+	    (setq error nil)
+	)
+    )
+    (if error
+	(format t "ERROR: (~S~{ ~S~}) => ~S~%" function arguments error-value)
+	(or (funcall test result expect)
+	    (format t "(~S~{ ~S~}) => should be ~S not ~S~%"
+		function arguments expect result
+	    )
+	)
+    )
+)
+
+(defun compare-eval (test expect form
+		     &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (eval form))
+	    (setq error nil)
+	)
+    )
+    (if error
+	(format t "ERROR: ~S => ~S~%" form error-value)
+	(or (funcall test result expect)
+	    (format t "~S => should be ~S not ~S~%"
+		form expect result
+	    )
+	)
+    )
+)
+
+(defun error-test (function &rest arguments &aux result (error t))
+    (ignore-errors
+	(setq result (apply function arguments))
+	(setq error nil)
+    )
+    (or error
+	(format t "ERROR: no error for (~S~{ ~S~}), result was ~S~%"
+	    function arguments result)
+    )
+)
+
+(defun error-eval (form &aux result (error t))
+    (ignore-errors
+	(setq result (eval form))
+	(setq error nil)
+    )
+    (or error
+	(format t "ERROR: no error for ~S, result was ~S~%" form result)
+    )
+)
+
+(defun eq-test (expect function &rest arguments)
+    (compare-test #'eq expect function arguments))
+
+(defun eql-test (expect function &rest arguments)
+    (compare-test #'eql expect function arguments))
+
+(defun equal-test (expect function &rest arguments)
+    (compare-test #'equal expect function arguments))
+
+(defun equalp-test (expect function &rest arguments)
+    (compare-test #'equalp expect function arguments))
+
+
+(defun eq-eval (expect form)
+    (compare-eval #'eq expect form))
+
+(defun eql-eval (expect form)
+    (compare-eval #'eql expect form))
+
+(defun equal-eval (expect form)
+    (compare-eval #'equal expect form))
+
+(defun equalp-eval (expect form)
+    (compare-eval #'equalp expect form))
+
+;; clisp treats strings loaded from a file as constants
+(defun xseq (sequence)
+    #+clisp (if *load-pathname* (copy-seq sequence) sequence)
+    #-clisp sequence
+)
+
+;; apply				- function
+(equal-test '((+ 2 3) . 4) #'apply 'cons '((+ 2 3) 4))
+(eql-test -1 #'apply #'- '(1 2))
+(eql-test 7 #'apply #'max 3 5 '(2 7 3))
+(error-test #'apply #'+ 1)
+(error-test #'apply #'+ 1 2)
+(error-test #'apply #'+ 1 . 2)
+(error-test #'apply #'+ 1 2 3)
+(error-test #'apply #'+ 1 2 . 3)
+(eql-test 6 #'apply #'+ 1 2 3 ())
+
+;; eq					- function
+(eq-eval t '(let* ((a #\a) (b a)) (eq a b)))
+(eq-test t #'eq 'a 'a)
+(eq-test nil #'eq 'a 'b)
+(eq-eval t '(eq #1=1 #1#))
+(eq-test nil #'eq "abc" "abc")
+(setq a '('x #c(1 2) #\z))
+(eq-test nil #'eq a (copy-seq a))
+
+;; eql					- function
+(eq-test t #'eql 1 1)
+(eq-test t #'eql 1.3d0 1.3d0)
+(eq-test nil #'eql 1 1d0)
+(eq-test t #'eql #c(1 -5) #c(1 -5))
+(eq-test t #'eql 'a 'a)
+(eq-test nil #'eql :a 'a)
+(eq-test t #'eql #c(5d0 0) 5d0)
+(eq-test nil #'eql #c(5d0 0d0) 5d0)
+(eq-test nil #'eql "abc" "abc")
+(equal-eval '(1 5/6 #p"test" #\#) '(setq a '(1 5/6 #p"test" #\#)))
+(eq-test nil #'eql a (copy-seq a))
+
+(setf
+    hash0 (make-hash-table)
+    hash1 (make-hash-table)
+    (gethash 1 hash0) 2
+    (gethash 1 hash1) 2
+    (gethash :foo hash0) :bar
+    (gethash :foo hash1) :bar
+)
+(defstruct test a b c)
+(setq
+    struc0 (make-test :a 1 :b 2 :c #\c)
+    struc1 (make-test :a 1 :b 2 :c #\c)
+)
+
+;; equal				- function
+(eq-test t #'equal "abc" "abc")
+(eq-test t #'equal 1 1)
+(eq-test t #'equal #c(1 2) #c(1 2))
+(eq-test nil #'equal #c(1 2) #c(1 2d0))
+(eq-test t #'equal #\A #\A)
+(eq-test nil #'equal #\A #\a)
+(eq-test nil #'equal "abc" "Abc")
+(equal-eval '(1 2 3/5 #\a) '(setq a '(1 2 3/5 #\a)))
+(eq-test t #'equal a (copy-seq a))
+(eq-test nil #'equal hash0 hash1)
+(eq-test nil #'equal struc0 struc1)
+(eq-test nil #'equal #(1 2 3 4) #(1 2 3 4))
+
+;; equalp				- function
+(eq-test t #'equalp hash0 hash1)
+(setf
+    (gethash 2 hash0) "FoObAr"
+    (gethash 2 hash1) "fOoBaR"
+)
+(eq-test t #'equalp hash0 hash1)
+(setf
+    (gethash 3 hash0) 3
+    (gethash 3d0 hash1) 3
+)
+(eq-test nil #'equalp hash0 hash1)
+(eq-test t #'equalp struc0 struc1)
+(setf
+    (test-a struc0) #\a
+    (test-a struc1) #\A
+)
+(eq-test t #'equalp struc0 struc1)
+(setf
+    (test-b struc0) 'test
+    (test-b struc1) :test
+)
+(eq-test nil #'equalp struc0 struc1)
+(eq-test t #'equalp #c(1/2 1d0) #c(0.5d0 1))
+(eq-test t #'equalp 1 1d0)
+(eq-test t #'equalp #(1 2 3 4) #(1 2 3 4))
+(eq-test t #'equalp #(1 #\a 3 4d0) #(1 #\A 3 4))
+
+;; acons				- function
+(equal-test '((1 . "one")) #'acons 1 "one" nil)
+(equal-test '((2 . "two") (1 . "one")) #'acons 2 "two" '((1 . "one")))
+
+;; adjoin				- function
+(equal-test '(nil) #'adjoin nil nil)
+(equal-test '(a) #'adjoin 'a nil)
+(equal-test '(1 2 3) #'adjoin 1 '(1 2 3))
+(equal-test '(1 2 3) #'adjoin 2 '(1 2 3))
+(equal-test '((1) (1) (2) (3)) #'adjoin '(1) '((1) (2) (3)))
+(equal-test '((1) (2) (3)) #'adjoin '(1) '((1) (2) (3)) :key #'car)
+(error-test #'adjoin nil 1)
+
+;; alpha-char-p				- function
+(eq-test t #'alpha-char-p #\a)
+(eq-test nil #'alpha-char-p #\5)
+(error-test #'alpha-char-p 'a)
+
+;; alphanumericp			- function
+(eq-test t #'alphanumericp #\Z)
+(eq-test t #'alphanumericp #\8)
+(eq-test nil #'alphanumericp #\#)
+
+;; and					- macro
+(eql-eval 1 '(setq temp1 1 temp2 1 temp3 1))
+(eql-eval 2 '(and (incf temp1) (incf temp2) (incf temp3)))
+(eq-eval t '(and (eql 2 temp1) (eql 2 temp2) (eql 2 temp3)))
+(eql-eval 1 '(decf temp3))
+(eq-eval nil '(and (decf temp1) (decf temp2) (eq temp3 'nil) (decf temp3)))
+(eq-eval t '(and (eql temp1 temp2) (eql temp2 temp3)))
+(eq-eval t '(and))
+(equal-eval '(1 2 3) '(multiple-value-list (and (values 'a) (values 1 2 3))))
+(equal-eval nil '(and (values) t))
+
+;; append				- function
+(equal-test '(a b c d e f g) #'append '(a b c) '(d e f) '() '(g))
+(equal-test '(a b c . d) #'append '(a b c) 'd)
+(eq-test nil #'append)
+(eql-test 'a #'append nil 'a)
+(error-test #'append 1 2)
+
+;; assoc				- function
+(equal-test '(1 . "one") #'assoc 1 '((2 . "two") (1 . "one")))
+(equal-test '(2 . "two") #'assoc 2 '((1 . "one") (2 . "two")))
+(eq-test nil #'assoc 1 nil)
+(equal-test '(2 . "two") #'assoc-if #'evenp '((1 . "one") (2 . "two")))
+(equal-test '(3 . "three") #'assoc-if-not #'(lambda(x) (< x 3))
+	'((1 . "one") (2 . "two") (3 . "three")))
+(equal-test '("two" . 2) #'assoc #\o '(("one" . 1) ("two" . 2) ("three" . 3))
+	:key #'(lambda (x) (char x 2)))
+(equal-test '(a . b) #'assoc 'a '((x . a) (y . b) (a . b) (a . c)))
+
+;; atom					- function
+(eq-test t #'atom 1)
+(eq-test t #'atom '())
+(eq-test nil #'atom '(1))
+(eq-test t #'atom 'a)
+
+;; block				- special operator
+(eq-eval nil '(block empty))
+(eql-eval 2 '(let ((x 1))
+		(block stop (setq x 2) (return-from stop) (setq x 3)) x))
+(eql-eval 2 '(block twin (block twin (return-from twin 1)) 2))
+
+;; both-case-p				- function
+(eq-test t #'both-case-p #\a)
+(eq-test nil #'both-case-p #\1)
+
+;; boundp				- function
+(eql-eval 1 '(setq x 1))
+(eq-test t #'boundp 'x)
+(makunbound 'x)
+(eq-test nil #'boundp 'x)
+(eq-eval nil '(let ((x 1)) (boundp 'x)))
+(error-test #'boundp 1)
+
+;; butlast, nbutlast			- function
+(setq x '(1 2 3 4 5 6 7 8 9))
+(equal-test '(1 2 3 4 5 6 7 8) #'butlast x)
+(equal-eval '(1 2 3 4 5 6 7 8 9) 'x)
+(eq-eval nil '(nbutlast x 9))
+(equal-test '(1) #'nbutlast x 8)
+(equal-eval '(1) 'x)
+(eq-test nil #'butlast nil)
+(eq-test nil #'nbutlast '())
+(error-test #'butlast 1 2)
+(error-test #'butlast -1 '(1 2))
+
+;; car, cdr, caar ...			- function
+(eql-test 1 #'car '(1 2))
+(eql-test 2 #'cdr '(1 . 2))
+(eql-test 1 #'caar '((1 2)))
+(eql-test 2 #'cadr '(1 2))
+(eql-test 2 #'cdar '((1 . 2)))
+(eql-test 3 #'cddr '(1 2 . 3))
+(eql-test 1 #'caaar '(((1 2))))
+(eql-test 2 #'caadr '(1 (2 3)))
+(eql-test 2 #'cadar '((1 2) 2 3))
+(eql-test 3 #'caddr '(1 2 3 4))
+(eql-test 2 #'cdaar '(((1 . 2)) 3))
+(eql-test 3 #'cdadr '(1 (2 . 3) 4))
+(eql-test 3 #'cddar '((1 2 . 3) 3))
+(eql-test 4 #'cdddr '(1 2 3 . 4))
+(eql-test 1 #'caaaar '((((1 2)))))
+(eql-test 2 #'caaadr '(1 ((2))))
+(eql-test 2 #'caadar '((1 (2)) 3))
+(eql-test 3 #'caaddr '(1 2 (3 4)))
+(eql-test 2 #'cadaar '(((1 2)) 3))
+(eql-test 3 #'cadadr '(1 (2 3) 4))
+(eql-test 3 #'caddar '((1 2 3) 4))
+(eql-test 4 #'cadddr '(1 2 3 4 5))
+(eql-test 2 #'cdaaar '((((1 . 2))) 3))
+(eql-test 3 #'cdaadr '(1 ((2 . 3)) 4))
+(eql-test 3 #'cdadar '((1 (2 . 3)) 4))
+(eql-test 4 #'cdaddr '(1 2 (3 . 4) 5))
+(eql-test 3 #'cddaar '(((1 2 . 3)) 4))
+(eql-test 4 #'cddadr '(1 (2 3 . 4) 5))
+(eql-test 4 #'cdddar '((1 2 3 . 4) 5))
+(eql-test 5 #'cddddr '(1 2 3 4 . 5))
+
+;; first ... tenth, rest		- function
+(eql-test 2 #'rest '(1 . 2))
+(eql-test 1 #'first '(1 2))
+(eql-test 2 #'second '(1 2 3))
+(eql-test 2 #'second '(1 2 3))
+(eql-test 3 #'third '(1 2 3 4))
+(eql-test 4 #'fourth '(1 2 3 4 5))
+(eql-test 5 #'fifth '(1 2 3 4 5 6))
+(eql-test 6 #'sixth '(1 2 3 4 5 6 7))
+(eql-test 7 #'seventh '(1 2 3 4 5 6 7 8))
+(eql-test 8 #'eighth '(1 2 3 4 5 6 7 8 9))
+(eql-test 9 #'ninth '(1 2 3 4 5 6 7 8 9 10))
+(eql-test 10 #'tenth '(1 2 3 4 5 6 7 8 9 10 11))
+(error-test #'car 1)
+(error-test #'car #c(1 2))
+(error-test #'car #(1 2))
+
+;; case					- macro
+(eql-eval t '(let ((a 1)) (case a ((4 5 6) nil) ((3 2 1) t) (otherwise :error))))
+(eql-eval t '(let ((a 1)) (case a ((3 2) nil) (1 t) (t :error))))
+(error-eval '(let ((a 1)) (case a (2 :error) (t nil) (otherwise t))))
+(error-eval '(let ((a 1)) (case a (2 :error) (otherwise t) (t nil))))
+
+;; catch				- special operator
+(eql-eval 3 '(catch 'dummy-tag 1 2 (throw 'dummy-tag 3) 4))
+(eql-eval 4 '(catch 'dummy-tag 1 2 3 4))
+(eq-eval 'throw-back '(defun throw-back (tag) (throw tag t)))
+(eq-eval t '(catch 'dummy-tag (throw-back 'dummy-tag) 2))
+
+;; char					- function
+(eql-test #\a #'char "abc" 0)
+(eql-test #\b #'char "abc" 1)
+(error-test #'char "abc" 3)
+
+;; char-*				- function
+(eq-test nil #'alpha-char-p #\3)
+(eq-test t #'alpha-char-p #\y)
+(eql-test #\a #'char-downcase #\a)
+(eql-test #\a #'char-downcase #\a)
+(eql-test #\1 #'char-downcase #\1)
+(error-test #'char-downcase 1)
+(eql-test #\A #'char-upcase #\a)
+(eql-test #\A #'char-upcase #\A)
+(eql-test #\1 #'char-upcase #\1)
+(error-test #'char-upcase 1)
+(eq-test t #'lower-case-p #\a)
+(eq-test nil #'lower-case-p #\A)
+(eq-test t #'upper-case-p #\W)
+(eq-test nil #'upper-case-p #\w)
+(eq-test t #'both-case-p #\x)
+(eq-test nil #'both-case-p #\%)
+(eq-test t #'char= #\d #\d)
+(eq-test t #'char-equal #\d #\d)
+(eq-test nil #'char= #\A #\a)
+(eq-test t #'char-equal #\A #\a)
+(eq-test nil #'char= #\d #\x)
+(eq-test nil #'char-equal #\d #\x)
+(eq-test nil #'char= #\d #\D)
+(eq-test t #'char-equal #\d #\D)
+(eq-test nil #'char/= #\d #\d)
+(eq-test nil #'char-not-equal #\d #\d)
+(eq-test nil #'char/= #\d #\d)
+(eq-test nil #'char-not-equal #\d #\d)
+(eq-test t #'char/= #\d #\x)
+(eq-test t #'char-not-equal #\d #\x)
+(eq-test t #'char/= #\d #\D)
+(eq-test nil #'char-not-equal #\d #\D)
+(eq-test t #'char= #\d #\d #\d #\d)
+(eq-test t #'char-equal #\d #\d #\d #\d)
+(eq-test nil #'char= #\d #\D #\d #\d)
+(eq-test t #'char-equal #\d #\D #\d #\d)
+(eq-test nil #'char/= #\d #\d #\d #\d)
+(eq-test nil #'char-not-equal #\d #\d #\d #\d)
+(eq-test nil #'char/= #\d #\d #\D #\d)
+(eq-test nil #'char-not-equal #\d #\d #\D #\d)
+(eq-test nil #'char= #\d #\d #\x #\d)
+(eq-test nil #'char-equal #\d #\d #\x #\d)
+(eq-test nil #'char/= #\d #\d #\x #\d)
+(eq-test nil #'char-not-equal #\d #\d #\x #\d)
+(eq-test nil #'char= #\d #\y #\x #\c)
+(eq-test nil #'char-equal #\d #\y #\x #\c)
+(eq-test t #'char/= #\d #\y #\x #\c)
+(eq-test t #'char-not-equal #\d #\y #\x #\c)
+(eq-test nil #'char= #\d #\c #\d)
+(eq-test nil #'char-equal #\d #\c #\d)
+(eq-test nil #'char/= #\d #\c #\d)
+(eq-test nil #'char-not-equal #\d #\c #\d)
+(eq-test t #'char< #\d #\x)
+(eq-test t #'char-lessp #\d #\x)
+(eq-test t #'char-lessp #\d #\X)
+(eq-test t #'char-lessp #\D #\x)
+(eq-test t #'char-lessp #\D #\X)
+(eq-test t #'char<= #\d #\x)
+(eq-test t #'char-not-greaterp #\d #\x)
+(eq-test t #'char-not-greaterp #\d #\X)
+(eq-test t #'char-not-greaterp #\D #\x)
+(eq-test t #'char-not-greaterp #\D #\X)
+(eq-test nil #'char< #\d #\d)
+(eq-test nil #'char-lessp #\d #\d)
+(eq-test nil #'char-lessp #\d #\D)
+(eq-test nil #'char-lessp #\D #\d)
+(eq-test nil #'char-lessp #\D #\D)
+(eq-test t #'char<= #\d #\d)
+(eq-test t #'char-not-greaterp #\d #\d)
+(eq-test t #'char-not-greaterp #\d #\D)
+(eq-test t #'char-not-greaterp #\D #\d)
+(eq-test t #'char-not-greaterp #\D #\D)
+(eq-test t #'char< #\a #\e #\y #\z)
+(eq-test t #'char-lessp #\a #\e #\y #\z)
+(eq-test t #'char-lessp #\a #\e #\y #\Z)
+(eq-test t #'char-lessp #\a #\E #\y #\z)
+(eq-test t #'char-lessp #\A #\e #\y #\Z)
+(eq-test t #'char<= #\a #\e #\y #\z)
+(eq-test t #'char-not-greaterp #\a #\e #\y #\z)
+(eq-test t #'char-not-greaterp #\a #\e #\y #\Z)
+(eq-test t #'char-not-greaterp #\A #\e #\y #\z)
+(eq-test nil #'char< #\a #\e #\e #\y)
+(eq-test nil #'char-lessp #\a #\e #\e #\y)
+(eq-test nil #'char-lessp #\a #\e #\E #\y)
+(eq-test nil #'char-lessp #\A #\e #\E #\y)
+(eq-test t #'char<= #\a #\e #\e #\y)
+(eq-test t #'char-not-greaterp #\a #\e #\e #\y)
+(eq-test t #'char-not-greaterp #\a #\E #\e #\y)
+(eq-test t #'char> #\e #\d)
+(eq-test t #'char-greaterp #\e #\d)
+(eq-test t #'char-greaterp #\e #\D)
+(eq-test t #'char-greaterp #\E #\d)
+(eq-test t #'char-greaterp #\E #\D)
+(eq-test t #'char>= #\e #\d)
+(eq-test t #'char-not-lessp #\e #\d)
+(eq-test t #'char-not-lessp #\e #\D)
+(eq-test t #'char-not-lessp #\E #\d)
+(eq-test t #'char-not-lessp #\E #\D)
+(eq-test t #'char> #\d #\c #\b #\a)
+(eq-test t #'char-greaterp #\d #\c #\b #\a)
+(eq-test t #'char-greaterp #\d #\c #\b #\A)
+(eq-test t #'char-greaterp #\d #\c #\B #\a)
+(eq-test t #'char-greaterp #\d #\C #\b #\a)
+(eq-test t #'char-greaterp #\D #\C #\b #\a)
+(eq-test t #'char>= #\d #\c #\b #\a)
+(eq-test t #'char-not-lessp #\d #\c #\b #\a)
+(eq-test t #'char-not-lessp #\d #\c #\b #\A)
+(eq-test t #'char-not-lessp #\D #\c #\b #\a)
+(eq-test t #'char-not-lessp #\d #\C #\B #\a)
+(eq-test nil #'char> #\d #\d #\c #\a)
+(eq-test nil #'char-greaterp #\d #\d #\c #\a)
+(eq-test nil #'char-greaterp #\d #\d #\c #\A)
+(eq-test nil #'char-greaterp #\d #\D #\c #\a)
+(eq-test nil #'char-greaterp #\d #\D #\C #\a)
+(eq-test t #'char>= #\d #\d #\c #\a)
+(eq-test t #'char-not-lessp #\d #\d #\c #\a)
+(eq-test t #'char-not-lessp #\d #\D #\c #\a)
+(eq-test t #'char-not-lessp #\D #\d #\c #\a)
+(eq-test t #'char-not-lessp #\D #\D #\c #\A)
+(eq-test nil #'char> #\e #\d #\b #\c #\a)
+(eq-test nil #'char-greaterp #\e #\d #\b #\c #\a)
+(eq-test nil #'char-greaterp #\E #\d #\b #\c #\a)
+(eq-test nil #'char-greaterp #\e #\D #\b #\c #\a)
+(eq-test nil #'char-greaterp #\E #\d #\B #\c #\A)
+(eq-test nil #'char>= #\e #\d #\b #\c #\a)
+(eq-test nil #'char-not-lessp #\e #\d #\b #\c #\a)
+(eq-test nil #'char-not-lessp #\e #\d #\b #\c #\A)
+(eq-test nil #'char-not-lessp #\E #\d #\B #\c #\a)
+
+;; char-code				- function
+;; XXX assumes ASCII
+(eql-test 49 #'char-code #\1)
+(eql-test 90 #'char-code #\Z)
+(eql-test 127 #'char-code #\Delete)
+(eql-test 27 #'char-code #\Escape)
+(eql-test 13 #'char-code #\Return)
+(eql-test 0 #'char-code #\Null)
+(eql-test 10 #'char-code #\Newline)
+(error-test #'char-code 65)
+
+;; character				- function
+(eql-test #\a #'character #\a)
+(eql-test #\a #'character "a")
+(eql-test #\A #'character 'a)
+
+;; XXX assumes ASCII, and should be allowed to fail?
+(eql-test #\A #'character 65)
+
+(error-test #'character 1/2)
+(error-test #'character "abc")
+(error-test #'character :test)
+(eq-test #\T #'character t)
+(error-test #'character nil)
+
+;; characterp				- function
+(eq-test t #'characterp #\a)
+(eq-test nil #'characterp 1)
+(eq-test nil #'characterp 1/2)
+(eq-test nil #'characterp 'a)
+(eq-test nil #'characterp '`a)
+
+
+
+
+;; TODO coerce
+
+
+
+
+;; cond					- macro
+(eql-eval 2 '(let ((a 1)) (cond ((= a 2) 1) ((= a 1) 2) ((= a 0) 1) (t nil))))
+(eql-eval nil '(let ((a 1)) (cond ((= a 2) 1) (t nil) ((= a 1) 2) ((= a 0) 1))))
+
+;; consp				- function (predicate)
+(eq-test t #'consp '(1 2))
+(eq-test t #'consp '(1 . 2))
+(eq-test nil #'consp nil)
+(eq-test nil #'consp 1)
+
+;; constantp				- function (predicate)
+(eq-test t #'constantp 1)
+(eq-test t #'constantp #\x)
+(eq-test t #'constantp :test)
+(eq-test nil #'constantp 'test)
+(eq-test t #'constantp ''1)
+(eq-test t #'constantp '(quote 1))
+(eq-test t #'constantp "string")
+(eq-test t #'constantp #c(1 2))
+(eq-test t #'constantp #(1 2))
+(eq-test nil #'constantp #p"test")
+(eq-test nil #'constantp '(1 2))
+(eq-test nil #'constantp (make-hash-table))
+(eq-test nil #'constantp *package*)
+(eq-test nil #'constantp *standard-input*)
+
+;; copy-list, copy-alist and copy-tree	- function
+(equal-test '(1 2) #'copy-list '(1 2))
+(equal-test '(1 . 2) #'copy-list '(1 . 2))
+(eq-test nil #'copy-list nil)
+(error-test #'copy-list 1)
+(equal-eval '(1 (2 3)) '(setq x '(1 (2 3))))
+(equal-eval x '(setq y (copy-list x)))
+(equal-test '("one" (2 3)) #'rplaca x "one")
+(eql-test 1 #'car y)
+(equal-test '("two" 3) #'rplaca (cadr x) "two")
+(eq-test (caadr x) #'caadr y)
+(equal-eval '(1 (2 3) 4) '(setq a '(1 (2 3) 4) b (copy-list a)))
+(eq-eval t '(eq (cadr a) (cadr b)))
+(eq-eval t '(eq (car a) (car b)))
+(setq a '(1 (2 3) 4) b (copy-alist a))
+(eq-eval nil '(eq (cadr a) (cadr b)))
+(eq-eval t '(eq (car a) (car b)))
+(eq-test nil #'copy-alist nil)
+(eq-test nil #'copy-list nil)
+(error-test #'copy-list 1)
+(setq a '(1 (2 (3))))
+(setq as-list (copy-list a))
+(setq as-alist (copy-alist a))
+(setq as-tree (copy-tree a))
+(eq-eval t '(eq (cadadr a) (cadadr as-list)))
+(eq-eval t '(eq (cadadr a) (cadadr as-alist)))
+(eq-eval nil '(eq (cadadr a) (cadadr as-tree)))
+
+;; decf					- macro
+(setq n 2)
+(eql-eval 1 '(decf n))
+(eql-eval 1 'n)
+(setq n -2147483648)
+(eql-eval -2147483649 '(decf n))
+(eql-eval -2147483649 'n)
+(setq n 0)
+(eql-eval -0.5d0 '(decf n 0.5d0))
+(eql-eval -0.5d0 'n)
+(setq n 1)
+(eql-eval 1/2 '(decf n 1/2))
+(eql-eval 1/2 'n)
+
+;; delete and remove			- function
+(setq a '(1 3 4 5 9) b a)
+(equal-test '(1 3 5 9) #'remove 4 a)
+(eq-eval t '(eq a b))
+(setq a (delete 4 a))
+(equal-eval '(1 3 5 9) 'a)
+(setq a '(1 2 4 1 3 4 5) b a)
+(equal-test '(1 2 1 3 5) #'remove 4 a)
+(eq-eval t '(eq a b))
+(equal-test '(1 2 1 3 4 5) #'remove 4 a :count 1)
+(eq-eval t '(eq a b))
+(equal-test '(1 2 4 1 3 5) #'remove 4 a :count 1 :from-end t)
+(eq-eval t '(eq a b))
+(equal-test '(4 3 4 5) #'remove 3 a :test #'>)
+(eq-eval t '(eq a b))
+(setq a (delete 4 '(1 2 4 1 3 4 5)))
+(equal-eval '(1 2 1 3 5) 'a)
+(setq a (delete 4 '(1 2 4 1 3 4 5) :count 1))
+(equal-eval '(1 2 1 3 4 5) 'a)
+(setq a (delete 4 '(1 2 4 1 3 4 5) :count 1 :from-end t))
+(equal-eval '(1 2 4 1 3 5) 'a)
+(equal-test "abc" #'delete-if #'digit-char-p "a1b2c3")
+(equal-test "123" #'delete-if-not #'digit-char-p "a1b2c3")
+(eq-test nil #'delete 1 nil)
+(eq-test nil #'remove 1 nil)
+(setq a '(1 2 3 4 :test 5 6 7 8) b a)
+(equal-test '(1 2 :test 7 8) #'remove-if #'numberp a :start 2 :end 7)
+(eq-eval t '(eq a b))
+(setq a (delete-if #'numberp a :start 2 :end 7))
+(equal-eval '(1 2 :test 7 8) 'a)
+
+;; digit-char				- function
+(eql-test #\0 #'digit-char 0)
+(eql-test #\A #'digit-char 10 11)
+(eq-test nil #'digit-char 10 10)
+(eql-test 35 #'digit-char-p #\z 36)
+(error-test #'digit-char #\a)
+(error-test #'digit-char-p 1/2)
+
+
+
+;; TODO directory (known to have problems with parameters like "../*/../*/")
+
+
+
+;; elt					- function
+(eql-test #\a #'elt "xabc" 1)
+(eql-test 3 #'elt '(0 1 2 3) 3)
+(error-test #'elt nil 0)
+
+;; endp					- function
+(eql-test t #'endp nil)
+(error-test #'endp t)
+(eql-test nil #'endp '(1 . 2))
+(error-test #'endp #(1 2))
+
+;; every				- function
+(eql-test t #'every 'not-used ())
+(eql-test t #'every #'characterp "abc")
+(eql-test nil #'every #'< '(1 2 3) '(4 5 6) #(7 8 -1))
+(eql-test t #'every #'< '(1 2 3) '(4 5 6) #(7 8))
+
+;; fboundp and fmakunbound		- function
+(eq-test t #'fboundp 'car)
+(eq-eval 'test '(defun test ()))
+(eq-test t #'fboundp 'test)
+(eq-test 'test #'fmakunbound 'test)
+(eq-test nil #'fboundp 'test)
+(eq-eval 'test '(defmacro test (x) x))
+(eq-test t #'fboundp 'test)
+(eq-test 'test #'fmakunbound 'test)
+
+;; fill					- function
+(setq x (list 1 2 3 4))
+(equal-test '((4 4 4 4) (4 4 4 4) (4 4 4 4) (4 4 4 4)) #'fill x '(4 4 4 4))
+(eq-eval t '(eq (car x) (cadr x)))
+(equalp-test '#(a z z d e) #'fill '#(a b c d e) 'z :start 1 :end 3)
+(equal-test "012ee" #'fill (xseq "01234") #\e :start 3)
+(error-test #'fill 1 #\a)
+
+;; find					- function
+(eql-test #\Space #'find #\d "here are some letters that can be looked at" :test #'char>)
+(eql-test 3 #'find-if #'oddp '(1 2 3 4 5) :end 3 :from-end t)
+(eq-test nil #'find-if-not #'complexp '#(3.5 2 #C(1.0 0.0) #C(0.0 1.0)) :start 2)
+(eq-test nil #'find 1 "abc")
+(error-test #'find 1 #c(1 2))
+
+;; find-symbol				- function
+(equal-eval '(nil nil)
+    '(multiple-value-list (find-symbol "NEVER-BEFORE-USED")))
+(equal-eval '(nil nil)
+    '(multiple-value-list (find-symbol "NEVER-BEFORE-USED")))
+(setq test (multiple-value-list (intern "NEVER-BEFORE-USED")))
+(equal-eval test '(read-from-string "(never-before-used nil)"))
+(equal-eval '(never-before-used :internal)
+    '(multiple-value-list (intern "NEVER-BEFORE-USED")))
+(equal-eval '(never-before-used :internal)
+    '(multiple-value-list (find-symbol "NEVER-BEFORE-USED")))
+(equal-eval '(nil nil)
+    '(multiple-value-list (find-symbol "never-before-used")))
+(equal-eval '(car :inherited)
+    '(multiple-value-list (find-symbol "CAR" 'common-lisp-user)))
+(equal-eval '(car :external)
+   '(multiple-value-list  (find-symbol "CAR" 'common-lisp)))
+;; XXX these will generate wrong results, NIL is not really a symbol
+;; currently in the interpreter
+(equal-eval '(nil :inherited)
+    '(multiple-value-list (find-symbol "NIL" 'common-lisp-user)))
+(equal-eval '(nil :external)
+    '(multiple-value-list (find-symbol "NIL" 'common-lisp)))
+(setq test (multiple-value-list
+     (find-symbol "NIL" (prog1 (make-package "JUST-TESTING" :use '())
+			       (intern "NIL" "JUST-TESTING")))))
+(equal-eval (read-from-string "(just-testing::nil :internal)") 'test)
+(eq-eval t '(export 'just-testing::nil 'just-testing))
+(equal-eval '(just-testing:nil :external)
+    '(multiple-value-list (find-symbol "NIL" 'just-testing)))
+
+#+xedit (equal-eval '(nil nil)
+	'(multiple-value-list (find-symbol "NIL" "KEYWORD")))
+#|
+;; optional result of previous form:
+(equal-eval '(:nil :external)
+    '(multiple-value-list (find-symbol "NIL" "KEYWORD")))
+|#
+
+
+
+;; funcall				- function
+(eql-test 6 #'funcall #'+ 1 2 3)
+(eql-test 1 #'funcall #'car '(1 2 3))
+(equal-test '(1 2 3) #'funcall #'list 1 2 3)
+
+
+
+;; TODO properly implement ``function''
+
+
+
+;; functionp				- function (predicate)
+(eq-test nil #'functionp 'append)
+(eq-test t #'functionp #'append)
+(eq-test nil #'functionp '(lambda (x) (* x x)))
+(eq-test t #'functionp #'(lambda (x) (* x x)))
+(eq-test t #'functionp (symbol-function 'append))
+(eq-test nil #'functionp 1)
+(eq-test nil #'functionp nil)
+
+;; gensym				- function
+(setq sym1 (gensym))
+(eq-test nil #'symbol-package sym1)
+(setq sym1 (gensym 100))
+(setq sym2 (gensym 100))
+(eq-test nil #'eq sym1 sym2)
+(eq-test nil #'equalp (gensym) (gensym))
+
+;; get					- accessor
+(defun make-person (first-name last-name)
+  (let ((person (gensym "PERSON")))
+    (setf (get person 'first-name) first-name)
+    (setf (get person 'last-name) last-name)
+    person))
+(eq-eval '*john* '(defvar *john* (make-person "John" "Dow")))
+(eq-eval '*sally* '(defvar *sally* (make-person "Sally" "Jones")))
+(equal-eval "John" '(get *john* 'first-name))
+(equal-eval "Jones" '(get *sally* 'last-name))
+(defun marry (man woman married-name)
+  (setf (get man 'wife) woman)
+  (setf (get woman 'husband) man)
+  (setf (get man 'last-name) married-name)
+  (setf (get woman 'last-name) married-name)
+  married-name)
+(equal-eval "Dow-Jones" '(marry *john* *sally* "Dow-Jones"))
+(equal-eval "Dow-Jones" '(get *john* 'last-name))
+(equal-eval "Sally" '(get (get *john* 'wife) 'first-name))
+(equal-eval `(wife ,*sally* last-name "Dow-Jones" first-name "John")
+    '(symbol-plist *john*))
+(eq-eval 'age
+    '(defmacro age (person &optional (default ''thirty-something))
+      `(get ,person 'age ,default)))
+(eq-eval 'thirty-something '(age *john*))
+(eql-eval 20 '(age *john* 20))
+(eql-eval 25 '(setf (age *john*) 25))
+(eql-eval 25 '(age *john*))
+(eql-eval 25 '(age *john* 20))
+
+;; graphic-char-p			- function
+(eq-test t #'graphic-char-p #\a)
+(eq-test t #'graphic-char-p #\Space)
+(eq-test nil #'graphic-char-p #\Newline)
+(eq-test nil #'graphic-char-p #\Tab)
+(eq-test nil #'graphic-char-p #\Rubout)
+
+;; if					- special operator
+(eq-eval nil '(if nil t))
+(eq-eval nil '(if t nil t))
+(eq-eval nil '(if nil t nil))
+(eq-eval nil '(if nil t (if nil (if nil t) nil)))
+
+;; incf					- macro
+(setq n 1)
+(eql-eval 2 '(incf n))
+(eql-eval 2 'n)
+(setq n 2147483647)
+(eql-eval 2147483648 '(incf n))
+(eql-eval 2147483648 'n)
+(setq n 0)
+(eql-eval 0.5d0 '(incf n 0.5d0))
+(eql-eval 0.5d0 'n)
+(setq n 1)
+(eql-eval 3/2 '(incf n 1/2))
+(eql-eval 3/2 'n)
+
+;; intersection				- function
+(setq list1 (list 1 1 2 3 4 'a 'b 'c "A" "B" "C" "d")
+      list2 (list 1 4 5 'b 'c 'd "a" "B" "c" "D"))
+(equal-test '(1 1 4 b c) #'intersection list1 list2)
+(equal-test '(1 1 4 b c "B") #'intersection list1 list2 :test 'equal)
+(equal-test '(1 1 4 b c "A" "B" "C" "d")
+    #'intersection list1 list2 :test #'equalp)
+(setq list1 (nintersection list1 list2))
+(equal-eval '(1 1 4 b c) 'list1)
+(setq list1 (copy-list '((1 . 2) (2 . 3) (3 . 4) (4 . 5))))
+(setq list2 (copy-list '((1 . 3) (2 . 4) (3 . 6) (4 . 8))))
+(equal-test '((2 . 3) (3 . 4)) #'nintersection list1 list2 :key #'cdr)
+
+;; keywordp				- function (predicate)
+(eq-test t #'keywordp :test)
+(eq-test nil #'keywordp 'test)
+(eq-test nil #'keywordp '#:test)
+(eq-test nil #'keywordp 1)
+(eq-test nil #'keywordp #'keywordp)
+(eq-test nil #'keywordp nil)
+
+;; last					- function
+(equal-test '(3) #'last '(1 2 3))
+(equal-test '(2 . 3) #'last '(1 2 . 3))
+(eq-test nil #'last nil)
+(eql-test () #'last '(1 2 3) 0)
+(setq a '(1 . 2))
+(eql-test 2 #'last a 0)
+(eq-test a #'last a 1)
+(eq-test a #'last a 2)
+(eq-test t #'last t)
+(equal-test #c(1 2) #'last #c(1 2))
+(equalp-test #(1 2 3) #'last #(1 2 3))
+
+;; length				- function
+(eql-test 3 #'length "abc")
+(eql-test 0 #'length nil)
+(eql-test 1 #'length '(1 . 2))
+(eql-test 2 #'length #(1 2))
+(error-test #'length #c(1 2))
+(error-test #'length t)
+
+;; let					- special operator
+(eql-eval 2 '(setq a 1 b 2))
+(eql-eval 2 '(let ((a 2)) a))
+(eql-eval 1 'a)
+(eql-eval 1 '(let ((a 3) (b a)) b))
+(eql-eval 2 'b)
+
+;; let*					- special operator
+(setq a 1 b 2)
+(eql-eval 2 '(let* ((a 2)) a))
+(eql-eval 1 'a)
+(eql-eval 3 '(let* ((a 3) (b a)) b))
+(eql-eval 2 'b)
+
+;; list					- function
+(equal-test '(1) #'list 1)
+(equal-test '(3 4 a b 4) #'list 3 4 'a (car '(b . c)) (+ 6 -2))
+(eq-test nil #'list)
+
+;; list-length				- function
+(eql-test 4 #'list-length '(a b c d))
+(eql-test 3 #'list-length '(a (b c) d))
+(eql-test 0 #'list-length '())
+(eql-test 0 #'list-length nil)
+(defun circular-list (&rest elements)
+  (let ((cycle (copy-list elements))) 
+    (nconc cycle cycle)))
+(eq-test nil #'list-length (circular-list 'a 'b))
+(eq-test nil #'list-length (circular-list 'a))
+(eql-test 0 #'list-length (circular-list))
+
+;; list*				- function
+(eql-test 1 #'list* 1)
+(equal-test '(a b c . d) #'list* 'a 'b 'c 'd)
+(error-test #'list*)
+(setq a '(1 2))
+(eq-test a #'list* a)
+
+;; listp				- function (predicate)
+(eq-test t #'listp nil)
+(eq-test t #'listp '(1 . 2))
+(eq-test nil #'listp t)
+(eq-test nil #'listp #'listp)
+(eq-test nil #'listp #(1 2))
+(eq-test nil #'listp #c(1 2))
+
+;; lower-case-p				- function
+(eq-test t #'lower-case-p #\a)
+(eq-test nil #'lower-case-p #\1)
+(eq-test nil #'lower-case-p #\Newline)
+(error-test #'lower-case-p 1)
+
+
+
+;; TODO make-array	(will be rewritten)
+
+
+
+;; make-list				- function
+(equal-test '(nil nil nil) #'make-list 3)
+(equal-test '((1 2) (1 2)) #'make-list 2 :initial-element '(1 2))
+(eq-test nil #'make-list 0)
+(eq-test nil #'make-list 0 :initial-element 1)
+
+;; make-package				- function
+(setq pack1 (make-package "PACKAGE-1" :nicknames '("PACK-1" "PACK1")))
+(setq pack2 (make-package "PACKAGE-2" :nicknames '("PACK-2" "PACK2") :use '("PACK1")))
+(equal-test (list pack2) #'package-used-by-list pack1)
+(equal-test (list pack1) #'package-use-list pack2)
+(eq-test pack1 #'symbol-package 'pack1::test)
+(eq-test pack2 #'symbol-package 'pack2::test)
+
+;; make-string				- function
+(equal-test "55555" #'make-string 5 :initial-element #\5)
+(equal-test "" #'make-string 0)
+(error-test #'make-string 10 :initial-element t)
+(error-test #'make-string 10 :initial-element nil)
+(error-test #'make-string 10 :initial-element 1)
+(eql-test 10 #'length (make-string 10))
+
+;; make-symbol				- function
+(setq a "TEST")
+;; This will fail
+(eq-test nil #'eq (make-symbol a) (make-symbol a))
+(equal-test a #'symbol-name (make-symbol a))
+(setq temp-string "temp")
+(setq temp-symbol (make-symbol temp-string))
+(equal-test temp-string #'symbol-name temp-symbol)
+(equal-eval '(nil nil) '(multiple-value-list (find-symbol temp-string)))
+
+;; makunbound				- function
+(eq-eval 1 '(setf (symbol-value 'a) 1))
+(eq-test t #'boundp 'a)
+(eql-eval 1 'a)
+(eq-test 'a #'makunbound 'a)
+(eq-test nil #'boundp 'a)
+(error-test #'makunbound 1)
+
+;; mapc					- function
+(setq dummy nil)
+(equal-test '(1 2 3 4)
+    #'mapc #'(lambda (&rest x) (setq dummy (append dummy x)))
+   '(1 2 3 4)
+   '(a b c d e)
+   '(x y z))
+(equal-eval '(1 a x 2 b y 3 c z) 'dummy)
+
+;; mapcan				- function
+(equal-test '(d 4 e 5)
+    #'mapcan #'(lambda (x y) (if (null x) nil (list x y)))
+    '(nil nil nil d e)
+    '(1 2 3 4 5 6))
+(equal-test '(1 3 4 5)
+    #'mapcan #'(lambda (x) (and (numberp x) (list x)))
+    '(a 1 b c 3 4 d 5))
+
+;; mapcar				- function
+(equal-test '(1 2 3) #'mapcar #'car '((1 a) (2 b) (3 c)))
+(equal-test '(3 4 2 5 6) #'mapcar #'abs '(3 -4 2 -5 -6))
+(equal-test '((a . 1) (b . 2) (c . 3)) #'mapcar #'cons '(a b c) '(1 2 3))
+(equal-test '((1 3 5)) #'mapcar #'list* '(1 2) '(3 4) '((5)))
+(equal-test '((1 3 5) (2 4 6)) #'mapcar #'list* '(1 2) '(3 4) '((5) (6)))
+
+;; mapcon				- function
+(equal-test '(1 a 2 b (3) c) #'mapcon #'car '((1 a) (2 b) ((3) c)))
+(equal-test '((1 2 3 4) (2 3 4) (3 4) (4)) #'mapcon #'list '(1 2 3 4))
+
+;; mapl					- function
+(setq dummy nil)
+(equal-test '(1 2 3 4) #'mapl #'(lambda (x) (push x dummy)) '(1 2 3 4))
+(equal-eval '((4) (3 4) (2 3 4) (1 2 3 4)) 'dummy)
+
+;; maplist				- function
+(equal-test '((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3))
+    #'maplist #'append '(1 2 3 4) '(1 2) '(1 2 3))
+(equal-test '((foo a b c d) (foo b c d) (foo c d) (foo d))
+    #'maplist #'(lambda (x) (cons 'foo x)) '(a b c d))
+(equal-test '(0 0 1 0 1 1 1)
+    #'maplist #'(lambda (x) (if (member (car x) (cdr x)) 0 1)) '(a b a c d b c))
+
+;; member				- function
+(setq a '(1 2 3))
+(eq-test (cdr a) #'member 2 a)
+(setq a '((1 . 2) (3 . 4)))
+(eq-test (cdr a) #'member 2 a :test-not #'= :key #'cdr)
+(eq-test nil #'member 'e '(a b c d))
+(eq-test nil #'member 1 nil)
+(error-test #'member 2 '(1 . 2))
+(setq a '(a b nil c d))
+(eq-test (cddr a) #'member-if #'listp a)
+(setq a '(a #\Space 5/3 foo))
+(eq-test (cddr a) #'member-if #'numberp a)
+(setq a '(3 6 9 11 . 12))
+(eq-test (cdddr a) #'member-if-not #'zerop a :key #'(lambda (x) (mod x 3)))
+
+;; multiple-value-bind			- macro
+(equal-eval '(11 9) '(multiple-value-bind (f r) (floor 130 11) (list f r)))
+
+;; multiple-value-call			- special operator
+(equal-eval '(1 / 2 3 / / 2 0.5)
+    '(multiple-value-call #'list 1 '/ (values 2 3) '/ (values) '/ (floor 2.5)))
+(eql-eval 10 '(multiple-value-call #'+ (floor 5 3) (floor 19 4)))
+
+;; multiple-value-list			- macro
+(equal-eval '(-1 1) '(multiple-value-list (floor -3 4)))
+(eql-eval nil '(multiple-value-list (values)))
+(equal-eval '(nil) '(multiple-value-list (values nil)))
+
+;; multiple-value-prog1			- special operator
+(setq temp '(1 2 3))
+(equal-eval temp
+    '(multiple-value-list
+	(multiple-value-prog1
+	    (values-list temp)
+	    (setq temp nil)
+	    (values-list temp))))
+
+;; multiple-value-setq			- macro
+(eql-eval 1 '(multiple-value-setq (quotient remainder) (truncate 3.5d0 2)))
+(eql-eval 1 quotient)
+(eql-eval 1.5d0 'remainder)
+(eql-eval 1 '(multiple-value-setq (a b c) (values 1 2)))
+(eql-eval 1 'a)
+(eql-eval 2 'b)
+(eq-eval nil 'c)
+(eql-eval 4 '(multiple-value-setq (a b) (values 4 5 6)))
+(eql-eval 4 'a)
+(eql-eval 5 'b)
+(setq a 1)
+(eql-eval nil '(multiple-value-setq (a) (values)))
+(eql-eval nil 'a)
+
+;; nconc				- function
+(eq-test nil #'nconc)
+(setq x '(a b c))
+(setq y '(d e f))
+(equal-test '(a b c d e f) #'nconc x y)
+(equal-eval '(a b c d e f) 'x)
+(eq-test y #'cdddr x)
+(equal-test '(1 . 2) #'nconc (list 1) 2)
+(error-test #'nconc 1 2 3)
+(equal-eval '(k l m)
+   '(setq foo (list 'a 'b 'c 'd 'e)
+	  bar (list 'f 'g 'h 'i 'j)
+	  baz (list 'k 'l 'm)))
+(equal-test '(a b c d e f g h i j k l m) #'nconc foo bar baz)
+(equal-eval '(a b c d e f g h i j k l m) 'foo)
+(equal-eval (nthcdr 5 foo) 'bar)
+(equal-eval (nthcdr 10 foo) 'baz)
+(setq foo (list 'a 'b 'c 'd 'e)
+      bar (list 'f 'g 'h 'i 'j)
+      baz (list 'k 'l 'm))
+(equal-eval '(a b c d e f g h i j k l m) '(setq foo (nconc nil foo bar nil baz)))
+(equal-eval '(a b c d e f g h i j k l m) 'foo)
+(equal-eval (nthcdr 5 foo) 'bar)
+(equal-eval (nthcdr 10 foo) 'baz)
+
+;; notany				- function
+(eql-test t #'notany #'> '(1 2 3 4) '(5 6 7 8) '(9 10 11 12))
+(eql-test t #'notany 'not-used ())
+(eql-test nil #'notany #'characterp #(1 2 3 4 5 #\6 7 8))
+
+;; notevery				- function
+(eql-test nil #'notevery #'< '(1 2 3 4) '(5 6 7 8) '(9 10 11 12))
+(eql-test nil #'notevery 'not-used ())
+(eql-test t #'notevery #'numberp #(1 2 3 4 5 #\6 7 8))
+
+;; nth					- accessor (function)
+(eql-test 'foo #'nth 0 '(foo bar baz))
+(eql-test 'bar #'nth 1 '(foo bar baz))
+(eq-test nil #'nth 3 '(foo bar baz))
+(error-test #'nth 0 #c(1 2))
+(error-test #'nth 0 #(1 2))
+(error-test #'nth 0 "test")
+
+;; nth-value				- macro
+(equal-eval 'a '(nth-value 0 (values 'a 'b)))
+(equal-eval 'b '(nth-value 1 (values 'a 'b)))
+(eq-eval nil '(nth-value 2 (values 'a 'b)))
+(equal-eval '(3332987528 3332987528 t)
+    '(multiple-value-list
+	(let* ((x 83927472397238947423879243432432432)
+	       (y 32423489732)
+	       (a (nth-value 1 (floor x y)))
+	       (b (mod x y)))
+	  (values a b (= a b)))))
+
+;; nthcdr				- function
+(eq-test nil #'nthcdr 0 '())
+(eq-test nil #'nthcdr 3 '())
+(equal-test '(a b c) #'nthcdr 0 '(a b c))
+(equal-test '(c) #'nthcdr 2 '(a b c))
+(eq-test () #'nthcdr 4 '(a b c))
+(eql-test 1 #'nthcdr 1 '(0 . 1))
+(error-test #'nthcdr -1 '(1 2))
+(error-test #'nthcdr #\Null '(1 2))
+(error-test #'nthcdr 1 t)
+(error-test #'nthcdr 1 #(1 2 3))
+
+;; or					- macro
+(eq-eval nil '(or))
+(setq temp0 nil temp1 10 temp2 20 temp3 30)
+(eql-eval 10 '(or temp0 temp1 (setq temp2 37)))
+(eql-eval 20 'temp2)
+(eql-eval 11 '(or (incf temp1) (incf temp2) (incf temp3)))
+(eql-eval 11 'temp1)
+(eql-eval 20 temp2)
+(eql-eval 30 'temp3)
+(eql-eval 11 '(or (values) temp1))
+(eql-eval 11 '(or (values temp1 temp2) temp3))
+(equal-eval '(11 20) '(multiple-value-list (or temp0 (values temp1 temp2))))
+(equal-eval '(20 30)
+    '(multiple-value-list (or (values temp0 temp1) (values temp2 temp3))))
+
+;; packagep				- function (predicate)
+(eq-test t #'packagep *package*)
+(eq-test nil #'packagep 10)
+(eq-test t #'packagep (make-package "TEST-PACKAGE"))
+(eq-test nil #'packagep 'keyword)
+(eq-test t #'packagep (find-package 'keyword))
+
+;; pairlis				- function
+#+xedit	;; order of result may vary
+(progn
+    (equal-test '((one . 1) (two . 2) (three . 3) (four . 19))
+	#'pairlis '(one two) '(1 2) '((three . 3) (four . 19)))
+    (setq keys '(1 2 3)
+	  data '("one" "two" "three")
+	  alist '((4 . "four")))
+    (equal-test '((1 . "one") (2 . "two") (3 . "three"))
+	#'pairlis keys data)
+    (equal-test '((1 . "one") (2 . "two") (3 . "three") (4 . "four"))
+	#'pairlis keys data alist)
+    (equal-eval '(1 2 3) 'keys)
+    (equal-eval '("one" "two" "three") 'data)
+    (equal-eval '((4 . "four")) 'alist)
+    (eq-test nil #'pairlis 1 2)
+    (error-test #'pairlis '(1 2 3) '(4 5))
+)
+
+;; pop					- macro
+(setq stack '(a b c) test stack)
+(eq-eval 'a '(pop stack))
+(eq-eval (cdr test) 'stack)
+(setq llst '((1 2 3 4)) test (car llst))
+(eq-eval 1 '(pop (car llst)))
+(eq-eval (cdr test) '(car llst))
+(error-eval '(pop 1))
+(error-eval '(pop nil))
+;; dotted list
+(setq stack (cons 1 2))
+(eq-eval 1 '(pop stack))
+(error-eval '(pop stack))
+;; circular list
+(setq stack '#1=(1 . #1#) *print-circle* t)
+(eql-eval 1 '(pop stack))
+(eql-eval 1 '(pop stack))
+(eql-eval 1 '(pop (cdr stack)))
+
+;; position				- function
+(eql-test 4 #'position #\a "baobab" :from-end t)
+(eql-test 2 #'position-if #'oddp '((1) (2) (3) (4)) :start 1 :key #'car)
+(eq-test nil #'position 595 '())
+(eq-test 4 #'position-if-not #'integerp '(1 2 3 4 5.0))
+(eql-test 1 #'position (char-int #\1) "0123" :key #'char-int)
+
+;; prog					- macro
+(eq-eval nil '(prog () :error))
+(eq-eval 'ok
+    '(prog ((a 0))
+	l1 (if (< a 10) (go l3) (go l2))
+	(return 'failed)
+	l2 (return 'ok)
+	(return 'failed)
+	l3 (incf a) (go l1)
+	(return 'failed)
+    ))
+(setq a 1)
+(eq-eval '/= '(prog ((a 2) (b a)) (return (if (= a b) '= '/=))))
+
+;; prog*				- macro
+(setq a 1)
+(eq-eval nil '(prog* () :error))
+(eq-eval 'ok
+    '(prog* ((a 0) (b 0))
+	l1 (if (< a 10) (go l3) (go l2))
+	(return 'failed)
+	l2 (if (< b 10) (go l4) (return 'ok))
+	(return 'failed)
+	l3 (incf a) (go l1)
+	(return 'failed)
+	l4 (incf b) (setq a 0) (go l1)
+	(return 'failed)
+    ))
+(eq-eval '= '(prog* ((a 2) (b a)) (return (if (= a b) '= '/=))))
+
+;; prog1				- macro
+(setq temp 1)
+(eql-eval 1 '(prog1 temp (incf temp) (eql-eval 2 'temp) temp))
+(eql-eval 2 'temp)
+(eql-eval 2 '(prog1 temp (setq temp nil) (eql-eval nil 'temp) temp))
+(eq-eval nil 'temp)
+(eql-eval 1 '(prog1 (values 1 2 3) 4))
+(setq temp (list 'a 'b 'c))
+(eq-eval 'a '(prog1 (car temp) (setf (car temp) 'alpha)))
+(equal-eval '(alpha b c) 'temp)
+(equal-eval '(1)
+    '(multiple-value-list (prog1 (values 1 2) (values 4 5))))
+
+;; prog2				- macro
+(setq temp 1)
+(eql-eval 3 '(prog2 (incf temp) (incf temp) (incf temp)))
+(eql-eval 4 'temp)
+(eql-eval 2 '(prog2 1 (values 2 3 4) 5))
+(equal-eval '(3)
+    '(multiple-value-list (prog2 (values 1 2) (values 3 4) (values 5 6))))
+
+;; progn				- special operator
+(eq-eval nil '(progn))
+(eql-eval 3 '(progn 1 2 3))
+(equal-eval '(1 2 3) '(multiple-value-list (progn (values 1 2 3))))
+(setq a 1)
+(eq-eval 'here '(if a (progn (setq a nil) 'here) (progn (setq a t) 'there)))
+(eq-eval nil 'a)
+
+;; progv				- special operator
+(makunbound '*x*)	;; make sure it is not bound
+(setq *x* 1)
+(eql-eval 2 '(progv '(*x*) '(2) *x*))
+(eql-eval 1 '*x*)
+(equal-eval '(3 4)
+    '(let ((*x* 3)) (progv '(*x*) '(4) (list *x* (symbol-value '*x*)))))
+(makunbound '*x*)
+(defvar *x* 1)
+(equal-eval '(4 4)
+    '(let ((*x* 3)) (progv '(*x*) '(4) (list *x* (symbol-value '*x*)))))
+(equal-eval '(4 4)
+    '(multiple-value-list
+	(let ((*x* 3))
+	     (progv '(*x*) '(4) (values-list (list *x* (symbol-value '*x*)))))))
+
+;; push					- macro
+(setq llst '(nil))
+(equal-eval '(1) '(push 1 (car llst)))
+(equal-eval '((1)) 'llst)
+(equal-eval '(1 1) '(push 1 (car llst)))
+(equal-eval '((1 1)) 'llst)
+(setq x '(a (b c) d))
+(equal-eval '(5 B C) '(push 5 (cadr x)))
+(equal-eval '(a (5 b c) d) 'x)
+
+;; pushnew				- macro
+(setq x '(a (b c) d))
+(equal-eval '(5 b c) '(pushnew 5 (cadr x)))
+(equal-eval '(a (5 b c) d) 'x)
+(equal-eval '(5 b c) '(pushnew 'b (cadr x)))
+(equal-eval '(a (5 b c) d) 'x)
+(setq lst '((1) (1 2) (1 2 3)))
+(equal-eval '((2) (1) (1 2) (1 2 3)) '(pushnew '(2) lst))
+(equal-eval '((1) (2) (1) (1 2) (1 2 3)) '(pushnew '(1) lst))
+(equal-eval '((1) (2) (1) (1 2) (1 2 3)) '(pushnew '(1) lst :test 'equal))
+(equal-eval '((1) (2) (1) (1 2) (1 2 3)) '(pushnew '(1) lst :key #'car))
+
+;; remove-duplicates			- function
+(equal-test "aBcD" #'remove-duplicates "aBcDAbCd" :test #'char-equal :from-end t)
+(equal-test '(a c b d e) #'remove-duplicates '(a b c b d d e))
+(equal-test '(a b c d e) #'remove-duplicates '(a b c b d d e) :from-end t)
+(equal-test '((bar #\%) (baz #\A))
+    #'remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
+     :test #'char-equal :key #'cadr)
+(equal-test '((foo #\a) (bar #\%))
+    #'remove-duplicates '((foo #\a) (bar #\%) (baz #\A))
+     :test #'char-equal :key #'cadr :from-end t)
+(setq tester (list 0 1 2 3 4 5 6))
+(equal-test '(0 4 5 6) #'delete-duplicates tester :key #'oddp :start 1 :end 6)
+
+;; replace				- function
+(equal-test "abcd456hij"
+    #'replace (copy-seq "abcdefghij") "0123456789" :start1 4 :end1 7 :start2 4)
+(setq lst (xseq "012345678"))
+(equal-test "010123456" #'replace lst lst :start1 2 :start2 0)
+(equal-eval "010123456" 'lst)
+
+;; rest					- accessor
+(equal-eval '(2) '(rest '(1 2)))
+(eql-eval 2 '(rest '(1 . 2)))
+(eq-eval nil '(rest '(1)))
+(setq *cons* '(1 . 2))
+(equal-eval "two" '(setf (rest *cons*) "two"))
+(equal-eval '(1 . "two") '*cons*)
+
+;; return				- macro
+(eq-eval nil '(block nil (return) 1))
+(eql-eval 1 '(block nil (return 1) 2))
+(equal-eval '(1 2) '(multiple-value-list (block nil (return (values 1 2)) 3)))
+(eql-eval 1 '(block nil (block alpha (return 1) 2)))
+(eql-eval 2 '(block alpha (block nil (return 1)) 2))
+(eql-eval 1 '(block nil (block nil (return 1) 2)))
+
+;; return-from				- special operator
+(eq-eval nil '(block alpha (return-from alpha) 1))
+(eql-eval 1 '(block alpha (return-from alpha 1) 2))
+(equal-eval '(1 2)
+    '(multiple-value-list (block alpha (return-from alpha (values 1 2)) 3)))
+(eql-eval 2
+    '(let ((a 0)) (dotimes (i 10) (incf a) (when (oddp i) (return))) a))
+(eq-eval 'temp '(defun temp (x) (if x (return-from temp ''dummy)) 44))
+(eql-eval 44 '(temp nil))
+(eq-eval 'dummy (temp t))
+(eql-eval 2 (block nil (unwind-protect (return-from nil 1) (return-from nil 2))))
+(error-eval '(funcall (block nil #'(lambda () (return-from nil)))))
+
+;; reverse				- function
+(setq str (xseq "abc") test str)
+(equal-test "cba" #'reverse str)
+(eq-eval test 'str)
+(equal-eval "cba" '(setq test (nreverse str)))
+(equal-eval "cba" 'test)
+(setq l (list 1 2 3) test l)
+(equal-eval '(3 2 1) '(setq test (nreverse l)))
+(equal-eval '(3 2 1) 'test)
+
+;; rplac?				- function
+(eql-eval '*some-list*
+    '(defparameter *some-list* (list* 'one 'two 'three 'four)))
+(equal-eval '(one two three . four) '*some-list*)
+(equal-test '(uno two three . four) #'rplaca *some-list* 'uno)
+(equal-eval '(uno two three . four) '*some-list*)
+(equal-test '(three iv) #'rplacd (last *some-list*) (list 'iv))
+(equal-eval '(uno two three iv) '*some-list*)
+
+;; search				- function
+(eql-test 7 #'search "dog" "it's a dog's life")
+(eql-test 2 #'search '(0 1) '(2 4 6 1 3 5) :key #'oddp)
+(eql-test 8 #'search "foo" "foooobarfooooobarfo" :from-end t)
+(eql-test 5
+    #'search "123"
+	(mapcar #'(lambda (x) (+ x (char-code #\0)))
+	'(1 2 34 3 2 1 2 3 4 3 2 1)) :from-end t
+	:key #'(lambda (x) (if (integerp x) (code-char x) x)))
+(eql-test 0 #'search "abc" "abcd" :from-end t)
+(eql-test 3 #'search "bar" "foobar")
+
+;; set					- function
+(eql-eval 1 '(setf (symbol-value 'n) 1))
+(eql-test 2 #'set 'n 2)
+(eql-test 2 #'symbol-value 'n)
+(eql-eval 4
+   '(let ((n 3))
+	(setq n (+ n 1))
+	(setf (symbol-value 'n) (* n 10))
+	(set 'n (+ (symbol-value 'n) n))
+	n))
+(eql-eval 44 'n)
+(defvar *n* 2)
+(eql-eval 80
+   '(let ((*n* 3))
+	(setq *n* (+ *n* 1))
+	(setf (symbol-value '*n*) (* *n* 10))
+	(set '*n* (+ (symbol-value '*n*) *n*))
+	*n*))
+(eql-eval 2 '*n*)
+(eq-eval '*even-count* '(defvar *even-count* 0))
+(eq-eval '*odd-count* '(defvar *odd-count* 0))
+(eql-eval 'tally-list
+   '(defun tally-list (list)
+      (dolist (element list)
+	(set (if (evenp element) '*even-count* '*odd-count*)
+	     (+ element (if (evenp element) *even-count* *odd-count*))))))
+(eq-eval nil '(tally-list '(1 9 4 3 2 7)))
+(eql-eval 6 '*even-count*)
+(eql-eval 20 '*odd-count*)
+
+;; set-difference			- function
+(setq lst1 (list "A" "b" "C" "d") lst2 (list "a" "B" "C" "d"))
+(equal-test '("A" "b" "C" "d") #'set-difference lst1 lst2)
+(equal-test '("A" "b") #'set-difference lst1 lst2 :test 'equal)
+(eq-test nil #'set-difference lst1 lst2 :test #'equalp)
+(equal-test '("A" "b") #'nset-difference lst1 lst2 :test #'string=)
+(setq lst1 '(("a" . "b") ("c" . "d") ("e" . "f"))
+      lst2 '(("c" . "a") ("e" . "b") ("d" . "a")))
+(equal-test '(("c" . "d") ("e" . "f"))
+    #'nset-difference lst1 lst2 :test #'string= :key #'cdr)
+(equal-eval '(("c" . "a") ("e" . "b") ("d" . "a")) 'lst2)
+(equal-test '("banana" "lemon" "rhubarb")
+   #'set-difference
+	'("strawberry" "chocolate" "banana" "lemon" "pistachio" "rhubarb")
+	'(#\c #\w) :test #'(lambda (s c) (find c s)))
+
+;; set-exclusive-or			- function
+(setq lst1 (list 1 "a" "b") lst2 (list 1 "A" "b"))
+(equal-test '("a" "b" "A" "b") #'set-exclusive-or lst1 lst2)
+(equal-test '("a" "A") #'set-exclusive-or lst1 lst2 :test #'equal)
+(eq-test nil #'set-exclusive-or lst1 lst2 :test 'equalp)
+(equal-test '("a" "b" "A" "b") #'nset-exclusive-or lst1 lst2)
+(setq lst1 '(("a" . "b") ("c" . "d") ("e" . "f"))
+      lst2 '(("c" . "a") ("e" . "b") ("d" . "a")))
+(equal-test '(("c" . "d") ("e" . "f") ("c" . "a") ("d" . "a"))
+    #'nset-exclusive-or lst1 lst2 :test #'string= :key #'cdr)
+
+;; setf					- macro
+(setq x (cons 'a 'b) y (list 1 2 3))
+(equal-eval '(1 x 3) '(setf (car x) 'x (cadr y) (car x) (cdr x) y))
+(equal-eval '(x 1 x 3) 'x)
+(equal-eval '(1 x 3) 'y)
+(setq x (cons 'a 'b) y (list 1 2 3))
+(eq-eval nil '(psetf (car x) 'x (cadr y) (car x) (cdr x) y))
+(equal-eval '(x 1 a 3) 'x)
+(equal-eval '(1 a 3) 'y)
+(error-eval '(setf x))
+(error-eval '(psetf x))
+
+;; setq					- special form
+(eql-eval 3 '(setq a 1 b 2 c 3))
+(eql-eval 1 'a)
+(eql-eval 2 'b)
+(eql-eval 3 'c)
+(eql-eval 7 '(setq a (1+ b) b (1+ a) c (+ a b)))
+(eql-eval 3 'a)
+(eql-eval 4 'b)
+(eql-eval 7 'c)
+(eq-eval nil '(psetq a 1 b 2 c 3))
+(eql-eval 1 'a)
+(eql-eval 2 'b)
+(eql-eval 3 'c)
+(equal-eval '(2 1)
+    '(multiple-value-list (let ((a 1) (b 2)) (psetq a b  b a) (values a b))))
+(error-eval '(setq x))
+(error-eval '(setq x 1 y))
+
+;; some					- function
+(eq-test t #'some #'= '(1 2 3 4 5) '(5 4 3 2 1))
+
+;; sort					- function
+(setq tester (copy-seq "lkjashd"))
+(equal-test "adhjkls" #'sort tester #'char-lessp)
+(setq tester (list '(1 2 3) '(4 5 6) '(7 8 9)))
+(equal-test '((7 8 9) (4 5 6) (1 2 3)) #'sort tester #'> :key #'car)
+(setq tester (list 1 2 3 4 5 6 7 8 9 0))
+(equal-test '(1 3 5 7 9 2 4 6 8 0)
+    #'stable-sort tester #'(lambda (x y) (and (oddp x) (evenp y))))
+(equalp-test
+  #((("Kathy" "Chapman") "Editorial")
+    (("Dick" "Gabriel") "Objects")
+    (("Gregor" "Kiczales") "Objects")
+    (("Sandra" "Loosemore") "Compiler")
+    (("Larry" "Masinter") "Cleanup")
+    (("David" "Moon") "Objects")
+    (("Kent" "Pitman") "Conditions")
+    (("Dick" "Waters") "Iteration")
+    (("JonL" "White") "Iteration"))
+   #'sort (setq committee-data
+	    (vector (list (list "JonL" "White") "Iteration")
+		    (list (list "Dick" "Waters") "Iteration")
+		    (list (list "Dick" "Gabriel") "Objects")
+		    (list (list "Kent" "Pitman") "Conditions")
+		    (list (list "Gregor" "Kiczales") "Objects")
+		    (list (list "David" "Moon") "Objects")
+		    (list (list "Kathy" "Chapman") "Editorial")
+		    (list (list "Larry" "Masinter") "Cleanup")
+		    (list (list "Sandra" "Loosemore") "Compiler")))
+      #'string-lessp :key #'cadar)
+(equalp-eval
+  #((("Larry" "Masinter") "Cleanup")
+    (("Sandra" "Loosemore") "Compiler")
+    (("Kent" "Pitman") "Conditions")
+    (("Kathy" "Chapman") "Editorial")
+    (("Dick" "Waters") "Iteration")
+    (("JonL" "White") "Iteration")
+    (("Dick" "Gabriel") "Objects")
+    (("Gregor" "Kiczales") "Objects")
+    (("David" "Moon") "Objects"))
+    '(setq committee-data
+	(stable-sort committee-data #'string-lessp :key #'cadr)))
+(error-test #'sort #c(1 2))
+
+;; string				- function
+(setq a "already a string")
+(eq-test a #'string a)
+(equal-test "ELM" #'string 'elm)
+(equal-test "c" #'string #\c)
+
+;; string-*				- function
+(eq-test t #'string= "foo" "foo")
+(eq-test nil #'string= "foo" "Foo")
+(eq-test nil #'string= "foo" "bar")
+(eq-test t #'string= "together" "frog" :start1 1 :end1 3 :start2 2)
+(eq-test t #'string-equal "foo" "Foo")
+(eq-test t #'string= "abcd" "01234abcd9012" :start2 5 :end2 9)
+(eql-test 3 #'string< "aaaa" "aaab")
+(eql-test 4 #'string>= "aaaaa" "aaaa")
+(eql-test 5 #'string-not-greaterp "Abcde" "abcdE")
+(eql-test 6 #'string-lessp "012AAAA789" "01aaab6" :start1 3 :end1 7
+						  :start2 2 :end2 6)
+(eq-test nil #'string-not-equal "AAAA" "aaaA")
+(error-test #'string= #(1 2 3) '(1 2 3))
+(eql-test 0 #'string< "abcd" "efg")
+(eql-test 1 #'string< "abcd" "afg")
+(eql-test 0 #'string/= "foo" "baar")
+(eql-test nil #'string/= "foobar" "foobar")
+
+;; string-{upcase,downcase,capitalize}	- function
+(equal-test "ABCDE" #'string-upcase "abcde")
+(equal-test "aBCDe" #'string-upcase "abcde" :start 1 :end 4)
+(equal-test "aBCDe" #'nstring-upcase (xseq "abcde") :start 1 :end 4)
+(equal-test "DR. LIVINGSTON, I PRESUME?"
+    #'string-upcase "Dr. Livingston, I presume?")
+(equal-test "Dr. LIVINGSTON, I Presume?"
+    #'string-upcase "Dr. Livingston, I presume?" :start 4 :end 19)
+(equal-test "Dr. LIVINGSTON, I Presume?"
+    #'nstring-upcase (xseq "Dr. Livingston, I presume?") :start 4 :end 19)
+(equal-test "Dr. LiVINGston, I presume?"
+    #'string-upcase "Dr. Livingston, I presume?" :start 6 :end 10)
+(equal-test "Dr. LiVINGston, I presume?"
+    #'nstring-upcase (xseq "Dr. Livingston, I presume?") :start 6 :end 10)
+(equal-test "dr. livingston, i presume?"
+    #'string-downcase "Dr. Livingston, I presume?")
+(equal-test "Dr. livingston, i Presume?"
+    #'string-downcase "Dr. Livingston, I Presume?" :start 1 :end 17)
+(equal-test "Dr. livingston, i Presume?"
+    #'nstring-downcase (xseq "Dr. Livingston, I Presume?") :start 1 :end 17)
+(equal-test "Elm 13c Arthur;Fig Don'T"
+    #'string-capitalize "elm 13c arthur;fig don't")
+(equal-test "elm 13C Arthur;Fig Don't"
+    #'string-capitalize "elm 13c arthur;fig don't" :start 6 :end 21)
+(equal-test "elm 13C Arthur;Fig Don't"
+    #'nstring-capitalize (xseq "elm 13c arthur;fig don't") :start 6 :end 21)
+(equal-test " Hello " #'string-capitalize " hello ")
+(equal-test " Hello " #'nstring-capitalize (xseq " hello "))
+(equal-test "Occluded Casements Forestall Inadvertent Defenestration"
+   #'string-capitalize "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")
+(equal-test "Don'T!" #'string-capitalize "DON'T!")
+(equal-test "Pipe 13a, Foo16c" #'string-capitalize "pipe 13a, foo16c")
+(setq str (copy-seq "0123ABCD890a"))
+(equal-test "0123AbcD890a" #'nstring-downcase str :start 5 :end 7)
+(equal-eval "0123AbcD890a" 'str)
+(error-test #'nstring-capitalize 1)
+(error-test #'string-capitalize "foobar" :start 4 :end 2)
+(equal-test "foobar" #'string-capitalize "foobar" :start 0 :end 0)
+
+;; string-{,left-,right-}trim		- function
+(equal-test "kaaak" #'string-trim "abc" "abcaakaaakabcaaa")
+#+xedit (equal-test "kaaak" #'nstring-trim "abc" "abcaakaaakabcaaa")
+(equal-test "garbanzo beans"
+    #'string-trim '(#\Space #\Tab #\Newline) " garbanzo beans
+        ")
+#+xedit (equal-test "garbanzo beans"
+    #'nstring-trim '(#\Space #\Tab #\Newline) " garbanzo beans
+        ")
+(equal-test "three (silly) words"
+    #'string-trim " (*)" " ( *three (silly) words* ) ")
+#+xedit (equal-test "three (silly) words"
+    #'nstring-trim " (*)" " ( *three (silly) words* ) ")
+(equal-test "labcabcabc" #'string-left-trim "abc" "labcabcabc")
+#+xedit (equal-test "labcabcabc" #'nstring-left-trim "abc" "labcabcabc")
+(equal-test "three (silly) words* ) "
+    #'string-left-trim " (*)" " ( *three (silly) words* ) ")
+#+xedit (equal-test "three (silly) words* ) "
+    #'nstring-left-trim " (*)" " ( *three (silly) words* ) ")
+(equal-test " ( *three (silly) words"
+    #'string-right-trim " (*)" " ( *three (silly) words* ) ")
+#+xedit (equal-test " ( *three (silly) words"
+    #'nstring-right-trim " (*)" " ( *three (silly) words* ) ")
+(error-test #'string-trim 123 "123")
+(error-test #'string-left-trim 123 "123")
+
+;; stringp				- function (predicate)
+(eq-test t #'stringp "abc")
+(eq-test nil #'stringp #\a)
+(eq-test nil #'stringp 1)
+(eq-test nil #'stringp #(#\a #\b #\c))
+
+;; subseq				- accessor
+(setq str (xseq "012345"))
+(equal-test "2345" #'subseq str 2)
+(equal-test "34" #'subseq str 3 5)
+(equal-eval "abc" '(setf (subseq str 4) "abc"))
+(equal-eval "0123ab" 'str)
+(equal-eval "A" '(setf (subseq str 0 2) "A"))
+(equal-eval "A123ab" 'str)
+
+;; subsetp				- function
+(setq cosmos '(1 "a" (1 2)))
+(eq-test t #'subsetp '(1) cosmos)
+(eq-test nil #'subsetp '((1 2)) cosmos)
+(eq-test t #'subsetp '((1 2)) cosmos :test 'equal)
+(eq-test t #'subsetp '(1 "A") cosmos :test #'equalp)
+(eq-test nil #'subsetp '((1) (2)) '((1) (2)))
+(eq-test t #'subsetp '((1) (2)) '((1) (2)) :key #'car)
+
+;; svref				- function
+;; XXX vectors will be reimplemented, just a test for the current implementation
+(setq v (vector 1 2 'sirens))
+(eql-eval 1 '(svref v 0))
+(eql-eval 'sirens '(svref v 2))
+(eql-eval 'newcomer '(setf (svref v 1) 'newcomer))
+(equalp-eval #(1 newcomer sirens) 'v)
+
+;; symbol-name				- function
+(equal-test "TEMP" #'symbol-name 'temp)
+(equal-test "START" #'symbol-name :start)
+(error-test #'symbol-name 1)
+
+;; symbol-package			- function
+(eq-test (find-package "LISP") #'symbol-package 'car)
+(eql-test *package* #'symbol-package 'bus)
+(eq-test (find-package "KEYWORD") #'symbol-package :optional)
+;; Gensyms are uninterned, so have no home package.
+(eq-test nil #'symbol-package (gensym))
+(setq pk1 (make-package 'pk1))
+(intern "SAMPLE1" "PK1")
+(eq-eval t '(export (find-symbol "SAMPLE1" "PK1") "PK1"))
+(setq pk2 (make-package 'pk2 :use '(pk1)))
+(equal-eval '(pk1:sample1 :inherited)
+    '(multiple-value-list (find-symbol "SAMPLE1" "PK2")))
+(eq-test pk1 #'symbol-package 'pk1::sample1)
+(eq-test pk1 #'symbol-package 'pk2::sample1)
+(eq-test pk1 #'symbol-package 'pk1::sample2)
+(eq-test pk2 #'symbol-package 'pk2::sample2)
+;; The next several forms create a scenario in which a symbol
+;; is not really uninterned, but is "apparently uninterned",
+;; and so SYMBOL-PACKAGE still returns NIL.
+(setq s3 'pk1::sample3)
+(eq-eval t '(import s3 'pk2))
+(eq-eval t '(unintern s3 'pk1))		;; XXX unintern not yet implemented
+(eq-test nil #'symbol-package s3)	;; fail due to unintern not implemented
+(eq-test t #'eq s3 'pk2::sample3)
+
+;; symbol-plist				- accessor
+(setq sym (gensym))
+(eq-eval () '(symbol-plist sym))
+(eq-eval 'val1 '(setf (get sym 'prop1) 'val1))
+(equal-eval '(prop1 val1) '(symbol-plist sym))
+(eq-eval 'val2 '(setf (get sym 'prop2) 'val2))
+(equal-eval '(prop2 val2 prop1 val1) '(symbol-plist sym))
+(setq sym-plist (list 'prop3 'val3))
+(eq-eval sym-plist '(setf (symbol-plist sym) sym-plist))
+(eq-eval sym-plist '(symbol-plist sym))
+
+;; symbol-value				- accessor
+(eql-eval 1 '(setf (symbol-value 'a) 1))
+(eql-eval 1 '(symbol-value 'a))
+;; SYMBOL-VALUE cannot see lexical variables.
+(eql-eval 1 '(let ((a 2)) (symbol-value 'a)))
+(eql-eval 1 '(let ((a 2)) (setq a 3) (symbol-value 'a)))
+
+#+xedit	;; incorrect...
+(progn
+    ;; SYMBOL-VALUE can see dynamic variables.
+	    ;; declare not yet implemented
+	    (proclaim '(special a))
+    (eql-eval 2 '(let ((a 2)) (symbol-value 'a)))
+    (eql-eval 1 'a)
+    (eql-eval 3 '(let ((a 2)) (setq a 3) (symbol-value 'a)))
+    (eql-eval 1 'a)
+	    ;; declare not yet implement
+	    (makunbound 'a)
+    (eql-eval 2 '(let ((a 2)) (setf (symbol-value 'a) 3) a))
+    (eql-eval 3 'a)
+    (eql-eval 3 '(symbol-value 'a))
+	    ;; declare not yet implement
+	    (makunbound 'a)
+    (equal-eval '(5 4)
+	'(multiple-value-list
+	    (let ((a 4))
+
+			;; declare not yet implemented
+			(defparameter a 3)
+
+	      (let ((b (symbol-value 'a)))
+		(setf (symbol-value 'a) 5)
+		(values a b)))))
+    (eql-eval 3 'a)
+)
+(eq-eval :any-keyword '(symbol-value :any-keyword))
+;; XXX these will fail
+(eq-eval nil '(symbol-value 'nil))
+(eq-eval nil '(symbol-value '()))
+
+;; symbolp				- function (predicate)
+(eq-test t #'symbolp 'elephant)
+(eq-test nil #'symbolp 12)
+;; XXX these will fail
+(eq-test t #'symbolp nil)
+(eq-test t #'symbolp '())
+(eq-test t #'symbolp :test)
+(eq-test nil #'symbolp "hello")
+
+;; remprop				- function
+(setq test (make-symbol "PSEUDO-PI"))
+(eq-eval () '(symbol-plist test))
+(eq-eval t '(setf (get test 'constant) t))
+(eql-eval 3.14 '(setf (get test 'approximation) 3.14))
+(eql-eval 'noticeable '(setf (get test 'error-range) 'noticeable))
+(equal-eval '(error-range noticeable approximation 3.14 constant t)
+    '(symbol-plist test))
+(eq-eval nil '(setf (get test 'approximation) nil))
+(equal-eval '(error-range noticeable approximation nil constant t)
+    '(symbol-plist test))
+(eq-eval nil (get test 'approximation))
+(eq-test t #'remprop test 'approximation)
+(eq-eval nil '(get test 'approximation))
+(equal-eval '(error-range noticeable constant t) '(symbol-plist test))
+(eq-test nil #'remprop test 'approximation)
+(equal-eval '(error-range noticeable constant t) '(symbol-plist test))
+(eq-test t #'remprop test 'error-range)
+(eql-eval 3 '(setf (get test 'approximation) 3))
+(equal-eval '(approximation 3 constant t) '(symbol-plist test))
+
+;; throw				- special operator
+(equal-eval '(3 9)
+    '(multiple-value-list
+	(catch 'result
+	    (setq i 0 j 0)
+	    (loop (incf j 3) (incf i)
+		  (if (= i 3) (throw 'result (values i j)))))))
+(eql-eval 2 '(catch nil (unwind-protect (throw nil 1) (throw nil 2))))
+
+;; XXX undefined consequences
+(eql-eval 2
+   '(catch 'a
+      (catch 'b
+	(unwind-protect (throw 'a 1)
+	  (throw 'b 2)))))
+(eq-eval :outer-catch
+   '(catch 'foo
+	(setq string (format nil "The inner catch returns ~s."
+	    (catch 'foo
+		(unwind-protect (throw 'foo :first-throw)
+		    (throw 'foo :second-throw)))))
+         :outer-catch))
+(equal-eval "The inner catch returns :SECOND-THROW." 'string)
+
+;; tree-equal				- function
+(setq tree1 '(1 (1 2))
+      tree2 '(1 (1 2)))
+(eq-test t #'tree-equal tree1 tree2)
+(eq-test nil #'eql tree1 tree2)
+(setq tree1 '('a ('b 'c))
+      tree2 '('a ('b 'c)))
+(eq-test t #'tree-equal tree1 tree2 :test 'eq)
+(eq-test t #'tree-equal 1 1)
+(eq-test nil #'tree-equal (list 1 2) (cons 1 2))
+(eq-test nil #'tree-equal 1 2)
+
+;; union				- function
+(equal-test '(b c f a d) #'union '(a b c) '(f a d))
+(equal-test '((y 6) (z 2) (x 4))
+    #'union '((x 5) (y 6)) '((z 2) (x 4)) :key #'car)
+(setq lst1 (list 1 2 '(1 2) "a" "b")
+      lst2 (list 2 3 '(2 3) "B" "C"))
+(equal-test '(1 (1 2) "a" "b" 2 3 (2 3) "B" "C") #'nunion lst1 lst2)
+
+;; unless				- macro
+(eq-eval 'hello '(when t 'hello))
+(eq-eval nil '(unless t 'hello))
+(eq-eval nil (when nil 'hello))
+(eq-eval 'hello '(unless nil 'hello))
+(eq-eval nil (when t))
+(eql-eval nil '(unless nil))
+(setq test nil)
+(equal-eval '(3 2 1) '(when t (push 1 test) (push 2 test) (push 3 test)))
+(equal-eval '(3 2 1) 'test)
+(setq test nil)
+(eq-eval nil '(unless t (push 1 test) (push 2 test) (push 3 test)))
+(eq-eval nil 'test)
+(eq-eval nil '(when nil (push 1 test) (push 2 test) (push 3 test)))
+(eq-eval nil 'test)
+(equal-eval '(3 2 1) '(unless nil (push 1 test) (push 2 test) (push 3 test)))
+(equal-eval '(3 2 1) 'test)
+(equal-eval '((4) nil (5) nil 6 (6) 7 (7))
+   '(let ((x 3))
+      (list (when (oddp x) (incf x) (list x))
+	    (when (oddp x) (incf x) (list x))
+	    (unless (oddp x) (incf x) (list x))
+	    (unless (oddp x) (incf x) (list x))
+	    (if (oddp x) (incf x) (list x))
+	    (if (oddp x) (incf x) (list x))
+	    (if (not (oddp x)) (incf x) (list x))
+	    (if (not (oddp x)) (incf x) (list x)))))
+
+;; unwind-protect			- special operator
+(defun dummy-function (x)
+   (setq state 'running)
+   (unless (numberp x) (throw 'abort 'not-a-number))
+   (setq state (1+ x)))
+(eql-eval 2 '(catch 'abort (dummy-function 1)))
+(eql-eval 2 'state)
+(eq-eval 'not-a-number '(catch 'abort (dummy-function 'trash)))
+(eq-eval 'running 'state)
+(eq-eval 'not-a-number
+    '(catch 'abort (unwind-protect (dummy-function 'trash)
+		   (setq state 'aborted))))
+(eq-eval 'aborted 'state)
+(eql-eval 2 '(block nil (unwind-protect (return 1) (return 2))))
+;; XXX undefined consequences
+(eql-eval 2
+   '(block a
+	(block b
+	    (unwind-protect (return-from a 1)
+			    (return-from b 2)))))
+(eql-eval 2 '(catch nil (unwind-protect (throw nil 1) (throw nil 2))))
+;; XXX undefined consequences
+(eql-eval 2
+   '(catch 'a (catch 'b (unwind-protect (throw 'a 1) (throw 'b 2)))))
+(eq-eval ':outer-catch
+   '(catch 'foo
+	(setq string
+	    (format nil "The inner catch returns ~s."
+		(catch 'foo
+		    (unwind-protect (throw 'foo :first-throw)
+		    (throw 'foo :second-throw)))))
+         :outer-catch))
+(equal-eval "The inner catch returns :SECOND-THROW." 'string)
+(eql-eval 10
+   '(catch 'a
+	(catch 'b
+	    (unwind-protect (1+ (catch 'a (throw 'b 1)))
+		(throw 'a 10)))))
+;; XXX undefined consequences
+(eql-eval 4
+   '(catch 'foo
+       (catch 'bar
+	   (unwind-protect (throw 'foo 3)
+	     (throw 'bar 4)
+	     (print 'xxx)))))
+(eql-eval 4
+   '(catch 'bar
+       (catch 'foo
+	   (unwind-protect (throw 'foo 3)
+	     (throw 'bar 4)
+	     (print 'xxx)))))
+(eql-eval 5
+   '(block nil
+       (let ((x 5))
+	 (unwind-protect (return)
+	   (return x)))))
+
+;; upper-case-p				- function
+(eq-test t #'upper-case-p #\A)
+(eq-test nil #'upper-case-p #\a)
+(eq-test nil #'upper-case-p #\5)
+(error-test #'upper-case-p 1)
+
+;; values				- accessor
+(eq-eval () '(multiple-value-list (values)))
+(equal-eval '(1) '(multiple-value-list (values 1)))
+(equal-eval '(1 2) '(multiple-value-list (values 1 2)))
+(equal-eval '(1 2 3) '(multiple-value-list (values 1 2 3)))
+(equal-eval '(1 4 5) '(multiple-value-list (values (values 1 2 3) 4 5)))
+
+;; values-list				- function
+(eq-eval nil '(multiple-value-list (values-list nil)))
+(equal-eval '(1) '(multiple-value-list (values-list '(1))))
+(equal-eval '(1 2) '(multiple-value-list (values-list '(1 2))))
+(equal-eval '(1 2 3) '(multiple-value-list (values-list '(1 2 3))))
diff --git a/lisp/test/math.lsp b/lisp/test/math.lsp
new file mode 100644
index 0000000..162f73f
--- /dev/null
+++ b/lisp/test/math.lsp
@@ -0,0 +1,982 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/test/math.lsp,v 1.5 2003/01/30 02:46:26 paulo Exp $
+;;
+
+;; basic math tests
+;; This is far from a good regression test, but in the current stage of
+;; the interpreter, this is good enough to make sure it is not "so"
+;; broken. But note that this does not test all cases where there is
+;; change in the type of a numeric object.
+
+(setq *default-float-format* 'double-float)
+
+;; floating point results may differ from implementation to implementation (?!)
+
+(defun test (expect function &rest arguments &aux result (error t))
+    (ignore-errors
+	(setq result (apply function arguments))
+	(setq error nil)
+    )
+    (if error
+	(format t "ERROR: (~A~{ ~A~})~%" function arguments)
+	;; Use eql to make sure result and expect have the same type
+	(or (eql result expect)
+#-xedit	;; hack...
+	    (or
+		(and
+		    (floatp result)
+		    (floatp expect)
+		    (< (abs (- (abs result) (abs expect)))
+			0.00000000000001d0)
+		)
+		(format t "(~A~{ ~A~}) => should be ~A not ~A~%"
+		    function arguments expect result
+		)
+	    )
+#+xedit     (format t "(~A~{ ~A~}) => should be ~A not ~A~%"
+		function arguments expect result
+	    )
+	)
+    )
+)
+
+(defun div-test (quotient remainder function &rest arguments
+		 &aux quo rem  (error t))
+    (ignore-errors
+	(multiple-value-setq (quo rem) (apply function arguments))
+	(setq error nil)
+    )
+    (if error
+	(format t "ERROR: (~A~{ ~A~})~%" function arguments)
+	(or (and (eql quotient quo) (eql remainder rem))
+#-xedit	;; hack
+	    (or
+		(or
+		    (eql quotient quo)
+		    (and
+			(floatp quotient)
+			(floatp quo)
+			(< (abs (- (abs quotient) (abs quo)))
+			    0.00000000000001d0)
+		    )
+		)
+		(or
+		    (eql remainder rem)
+		    (and
+			(floatp remainder)
+			(floatp rem)
+			(< (abs (- (abs remainder) (abs rem)))
+			    0.00000000000001d0)
+		    )
+		)
+		(format t "(~A~{ ~A~}) => should be ~A; ~A not ~A; ~A~%"
+		    function arguments quotient remainder quo rem
+		)
+	    )
+#+xedit	    (format t "(~A~{ ~A~}) => should be ~A; ~A not ~A; ~A~%"
+		function arguments quotient remainder quo rem
+	    )
+	)
+    )
+)
+
+(defun bool-test (expect function &rest arguments &aux result (error t))
+    (ignore-errors
+	(setq result (apply function arguments))
+	(setq error nil)
+    )
+    (if error
+	(format t "ERROR: (~A~{ ~A~})~%" function arguments)
+	(or (eq result expect)
+	    (format t "(~A~{ ~A~}) => should be ~A not ~A~%"
+		function arguments expect result
+	    )
+	)
+    )
+)
+
+(defun error-test (function &rest arguments &aux result (error t))
+  (ignore-errors
+    (setq result (apply function arguments))
+    (setq error nil))
+  (unless error
+    (format t "ERROR: no error for (~A~{ ~A}), result was ~A~%"
+      function arguments result)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixnum fixnum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 0 #'+)
+(test 5 #'+ 5)
+(test -2 #'+ -2)
+(test 3 #'+ 2 1)
+(test 134217728 #'+ 134217727 1)
+(test -134217729 #'+ -134217728 -1)
+(test 2147483648 #'+ 2147483647 1)
+(test -2147483649 #'+ -2147483648 -1)
+(test -5 #'- 5)
+(test 6 #'- -6)
+(test 1 #'- 2 1)
+(test 134217728 #'- 134217727 -1)
+(test -2147483649 #'- -2147483648 1)
+(test 4294967295 #'- 2147483647 -2147483648)
+(test 1 #'*)
+(test 4 #'* 4)
+(test -5 #'* -5)
+(test 6 #'* 2 3)
+(test 2147483648 #'* 65536 32768)
+(test 2147418112 #'* 65536 32767)
+(test 134217728 #'* 65536 2048)
+(test -134217728 #'* 65536 -2048)
+(test 1/3 #'/ 3)
+(test -1/4 #'/ -4)
+(test 1/3 #'/ 10 30)
+(test -1/2 #'/ -5 10)
+(test -4 #'/ 20 -5)
+(test 431432412345/32 #'/ 431432412345 32)
+(test -2147483647/2147483648 #'/ 2147483647 -2147483648)
+(test -1 #'/ 2147483648 -2147483648)
+(test 2147483648 #'/ -2147483648 -1)
+(test -1/2147483648 #'/ 1 -2147483648)
+(test 1 #'min 2 3 4 1 5)
+(test 7 #'max 0 -2 7 6 3)
+(test -2147483648 #'min -2147483648 2147483647)
+(test 2147483647 #'max -2147483648 2147483647)
+(bool-test t #'< 1 2)
+(bool-test nil #'< 2 2)
+(bool-test nil #'< 4 3)
+(bool-test t #'< -2147483648 -1)
+(bool-test t #'< -2147483648 2147483648)
+(bool-test t #'<= 3 3)
+(bool-test nil #'<= 3 2)
+(bool-test t #'<= 3 7)
+(bool-test t #'<= -2147483648 2147483648)
+(bool-test t #'= 1 1)
+(bool-test nil #'= 1 -1)
+(bool-test t #'= -2147483648 -2147483648)
+(bool-test t #'>= 4 3)
+(bool-test t #'>= 5 5)
+(bool-test nil #'>= 4 9)
+(bool-test t #'>= 2147483647 -2147483648)
+(bool-test t #'> 7 5)
+(bool-test nil #'> 20 20)
+(bool-test nil #'> 19 31)
+(bool-test nil #'> 2147483647 2147483648)
+(bool-test nil #'> -2147483648 2147483647)
+(bool-test nil #'/= 2147483647 2147483647)
+(bool-test t #'/= 2147483647 -2147483648)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixnum bignum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 4123412341238575768576858308380 #'+
+	431412 4123412341238575768576857876968)
+(test -653653534554686349560628211 #'-
+	4231423 653653534554686349564859634)
+(test 17952112630025927929 #'* 4342423 4134123421423)
+(test 412341/766687896595678 #'/ 412341 766687896595678)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixnum flonum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 566594.4123d0 #'+ 43141 523453.4123d0)
+(test -2.106249523586876d9 #'+ -2147483647 41234123.413124d0)
+(test -6530250.653d0 #'- 4314 6534564.653d0)
+(test -358687.653d0 #'- -324123 34564.653d0)
+(test 3.26338916904d67 #'* 431234 756756d56)
+(test 5.731169192902366d-50 #'/ 3 5234534d43)
+(bool-test t #'< 423421 646454d0)
+(bool-test t #'= 43242113 43242113d0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixnum fixratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 38654705646/17 #'+ 2147483647 2147483647/17)
+(test -2146748499/17 #'+ 43244 -2147483647/17)
+(test 17633127/4232 #'- 4321 653345/4232)
+(test 28227714415090/4323 #'* 4312442 6545645/4323)
+(test 639030/1441 #'* 42 15215/1441)
+(test 924444112/547 #'/ 3432342 1641/808)
+(bool-test t #'> 41342 42423/32)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixnum bigratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 134681902103055335/31231131234 #'+ 4312423 53453535353/31231131234)
+(test 134681795195984629/31231131234 #'- 4312423 53453535353/31231131234)
+(test 230514255287590319/31231131234 #'* 4312423 53453535353/31231131234)
+(test 134681848649519982/53453535353 #'/ 4312423 53453535353/31231131234)
+(bool-test t #'> 4312423 53453535353/31231131234)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bignum fixnum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 4123412341234124068 #'+ 4123412341234123412 656)
+(test 2147483647 #'+ 2147483648 -1)
+(test 2147483648 #'- 2147483647 -1)
+(test 3245393337480 #'* 4242344232 765)
+(test 1414114744/255 #'/ 4242344232 765)
+(bool-test nil #'< 2147483648 1)
+(bool-test t #'> 2147483648 -2147483648)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bignum flonum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 5.452523543454353d15 #'+ 5452523543454353 423d-6)
+(test -3.41423d205 #'- 54235423452345424443423 341423d200)
+(test 2.7061221650759596d89 #'* 413423412341231232 6.545643242d71)
+(test 9.744908405310087d-29 #'/ 41341234214 4242342d32)
+(bool-test t #'< 4314123412312341234123 4234242d46)
+(bool-test nil #'> 42342342142142421412341242 423423.432423d51)
+(bool-test t #'= 100000000000000000000 1d20)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bignum fixratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 3027180466416641662/7 #'+ 432454352345234523 1/7)
+(test 4294967295/2 #'- 2147483648 1/2)
+(test 14113747078041141/152263 #'* 42341241234123423 1/456789)
+(test 475355357536664/19 #'* 43214123412424 11/19)
+(test 143960192608 #'/ 4234123312 1/34)
+(test 15032385536/5 #'/ 2147483648 5/7)
+(bool-test nil #'< 4123412341234123 423424/23)
+(bool-test nil #'= 2147483648 1/3)
+(bool-test t #'> 2147483648 1/3)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bignum bigratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test -493153721444554600746963362777609/11404707804137
+	#'+ -43241241241241234234 18178448448449/11404707804137)
+(test 22573725350444837506376255369215081106984960/431241324242143434377
+	#'- 52345923457394857234895 455/431241324242143434377)
+(test 355905909219316970540364021939287762325439304380984344811607132990/14374707710807
+	#'* 45523452345234790345923405723902389345782390 23454234524234523623623/43124123132421)
+(test -853356237922877963618542794532291751029677352/21566206170617061706171
+	#'/ 4131234123412342 -43132412341234123412342/413124123412312234123412312312)
+(bool-test nil #'< 9482384762389461234892 463124869123897/43124123456678)
+(bool-test t #'/= 4689123469123846123843 4123894623894612/211)
+(bool-test t #'> 90437849234701234891203 4234123423/37)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; flonum fixnum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 4.3291328479d86 #'+ 43291328479d76 431243)
+(test 4.123123123432d58 #'- 4123123123432d46 2147483647)
+(test 4.1974800714094d109 #'* 970874791d96 43234)
+(test -1.0004838618250252d55 #'/ -432423.432d56 4322143)
+(bool-test nil #'< 4324932.342d5 4321421)
+(bool-test t #'> 2147483648d0 2147483647)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; flonum bignum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 4.3124325345d62 #'+ 4312432.5345d56 431241234901234791023479023)
+(test 4.123123443242d39 #'- 41231234.43242d32 -10947390284720389)
+(test 9.81681448753991d48 #'* 42342.89d27 231840917980324712)
+(test 6.837110051466236d49 #'/ -64832d57 -948236894126)
+(bool-test nil #'< 7589079203d56 43214124124312)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; flonum flonum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 4.12685643412d7 #'+ 34442.3412d0 41234122d0)
+(test -4.23432d84 #'- -45523453d56 423432d79)
+(test 2.0000000000000004d0 #'* 1.4142135623730951d0 1.4142135623730951d0)
+(test -1.414213562373095d0 #'/ -2d0 1.4142135623730951d0)
+(test 0.7071067811865476d0 #'/ 1.4142135623730951d0 2d0)
+(bool-test nil #'< 43124123d56 4231412d43)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; flonum fixratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 3.41412d61 #'+ 341412d56 3/652)
+(test 4.312443d72 #'- 43124.43d68 42421/5678)
+(test -4.32112300201218d73 #'* 4321123d67 -2147483648/2147483647)
+(test 3.388443859138533d58 #'/ 432412d54 13744/1077)
+(bool-test t #'> 423194237d43 4231412/23)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; flonum bigratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 4.378904431d62 #'+ 4378904.431d56 49230471923047129/32412341234126)
+(test 0d0 #'- 1.7320508075688772d0 3900231685776981/2251799813685248)
+(test 5.000000000000001d0 #'* 2.23606797749979d0 629397181890197/281474976710656)
+(test 7.000000000000001d0 #'/ 2.6457513110645907d0 1125899906842624/2978851154656373)
+(bool-test nil #'< 790412390412d45 1005712007432/10518078881)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixratio fixnum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 23502480199/57 #'+ 1/57 412324214)
+(test -1608505/39 #'- 11/39 41244) 
+(test 241844976595/3121 #'* 45245/3121 5345231)
+(test 4231/30211050 #'/ 4231/67890 445)
+(bool-test nil #'< 43123/12 -3432)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixratio bignum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 290071443963580821646/4115 #'+ -14119/4115 70491237901234711)
+(test 92654360215843653827434431256/1237 #'- 423412/1237 -74902473901247901234789012)
+(test 139081825032265225396/111 #'* 13/777 74890213478912044444)
+(test -22/19000187487170108051697772680759 #'/ -176/31 4903274190237447239147812304712)
+(bool-test t #'< 7094123/312 423412429047)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixratio flonum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 3756.777956289953d0 #'+ 41290/11 3.141592653589793d0)
+(test 3750.494770982774d0 #'- 41290/11 3.141592653589793d0)
+(test 11792.396424247505d0 #'* 41290/11 3.141592653589793d0)
+(test 1194.8195636844289d0 #'/ 41290/11 3.141592653589793d0)
+(bool-test nil #'< 41290/11 3.141592653589793d0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixratio fixratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test -2/2147483647 #'+ 2147483646/2147483647 -2147483648/2147483647)
+(test 4611686015206162432/2305843005992468481 #'+ 2147483648/2147483646 2147483648/2147483647)
+(test 114/91 #'+ 5/7 7/13)
+(test 2 #'- 2147483646/2147483647 -2147483648/2147483647)
+(test -6442450939/4611686009837453315 #'- 2147483646/2147483647 2147483647/2147483645)
+(test 214/231 #'- 5/7 -7/33)
+(test 183092240452/408559 #'* '432421/3217 423412/127)
+(test 1057751/7345 #'* 34121/65 31/113)
+(test -93866791/102381559 #'/ 143747/107 -956837/653)
+(test 117/517 #'/ 13/33 47/27)
+(bool-test nil #'< 5/3 7/9)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; fixratio bigratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 1211321073398067249731082729214954013/1099249926163926018396018404101914
+	#'+ 23141/21 572903572390457239/52345234579234572304572304957234)
+(test -1210401943424090457832980748892408320175/1099249926163926018396018404101914
+	#'+ -23123441/21 572903572390457239/52345234579234572304572304957234)
+(test -130565585970579643613431728982140/1297324236427391
+	#'- 6/83 1573079349043128237436315709694/15630412487077)
+(test 119377824848653/98027 #'* 4123/61 28954117111/1607)
+(test -533081148/1126543487854337661125 #'/ 4132412/125 -9012347902834701289/129)
+(bool-test nil #'< 4132412/125 -9012347902834701289/129)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bigratio fixnum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 48668779872364438/8438103123 #'+ 49032749012471920/8438103123 -43134)
+(test 49396718152579402/8438103123 #'- 49032749012471920/8438103123 -43134)
+(test -704992865301321265760/2812701041 #'* 49032749012471920/8438103123 -43134)
+(test -24516374506235960/181984570053741 #'/ 49032749012471920/8438103123 -43134)
+(bool-test t #'> 49032749012471920/8438103123 -43134)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bigratio bignum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 22765322736543569109219273030163417097453878379283263605274270/46382946123894712341
+	#'+ 4692318468912374612389461278/46382946123894712341 490812348912346238794612389461238961238912)
+(test -22765322736543569109219273030163417097453878379283263605274270/46382946123894712341
+	#'- -4692318468912374612389461278/46382946123894712341 490812348912346238794612389461238961238912)
+(test -2303047849571666696101160700266058250647016644840659232609643130849536/46382946123894712341
+	#'* 4692318468912374612389461278/46382946123894712341 -490812348912346238794612389461238961238912)
+(test 2346159234456187306194730639/11382661368271784554609636515081706202567704733454325607906496
+	#'/ -4692318468912374612389461278/46382946123894712341 -490812348912346238794612389461238961238912)
+(bool-test t #'< 4692318468912374612389461278/46382946123894712341 490812348912346238794612389461238961238912)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bigratio flonum
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 63.2771680782255d0 #'+ 31.63858403911275d0 4452734852783697/140737488355328)
+(test 0d0 #'+ -31.63858403911275d0 4452734852783697/140737488355328)
+(test -1001.0000000000001d0 #'* -31.63858403911275d0 4452734852783697/140737488355328)
+(test 1d0 #'/ -31.63858403911275d0 -4452734852783697/140737488355328)
+(bool-test nil #'< -31.63858403911275d0 -4452734852783697/140737488355328)
+(bool-test nil #'> -31.63858403911275d0 -4452734852783697/140737488355328)
+(bool-test nil #'/= -31.63858403911275d0 -4452734852783697/140737488355328)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bigratio fixratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 0 #'+ 2147483648/2147483647 -2147483648/2147483647)
+(test 3230093924913437/413416372043776 #'+ 45705840067699/8796093022208 123/47)
+(test 4294967296/2147483647 #'- 2147483648/2147483647 -2147483648/2147483647)
+(test 1066255041450269/413416372043776 #'- 45705840067699/8796093022208 123/47)
+(test -5621818328326977/413416372043776 #'* -45705840067699/8796093022208 123/47)
+(test -2148174483181853/1081919441731584 #'/ 45705840067699/8796093022208 -123/47)
+(bool-test t #'> 45705840067699/8796093022208 123/47)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bigratio bigratio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 2679495973598190955776211861634126560767052764822779809414184089582/140710542183009389719255843429922029722593
+	#'+ 649812364891236481923461238946128/34124123 -7489023423142/4123491823746192384761238946123891)
+(test 2679495973598190955776211861634126560767052765333892522296541398514/140710542183009389719255843429922029722593
+	#'- 649812364891236481923461238946128/34124123 -7489023423142/4123491823746192384761238946123891)
+(test -4866460021317766216371472892133283923086494176/140710542183009389719255843429922029722593
+	#'* 649812364891236481923461238946128/34124123 -7489023423142/4123491823746192384761238946123891)
+(test -1339747986799095477888105930817063280383526382539168082927681372024/127778178220589327233
+	#'/ 649812364891236481923461238946128/34124123 -7489023423142/4123491823746192384761238946123891)
+(bool-test t #'> 649812364891236481923461238946128/34124123 -7489023423142/4123491823746192384761238946123891)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; complex real
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test #c(2147483648 -1) #'+ #c(1 -1) 2147483647)
+(test #c(2.147483648d9 -1) #'+ #c(2147483647 -1) 1d0)
+(test #c(129642370237029633787/3 0.25d0) #'- #c(-11/3 0.25d0) -43214123412343211266)
+(test #c(23470/21 4.333333333333334d0) #'* #c(2347/7 1.3d0) 10/3)
+(test #c(134217728/11 67108864/11) #'* #c(65536 32768) 2048/11)
+(test #c(1.3133333333333332d0 82304) #'/ #c(1.97d0 123456) 3/2)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; real complex
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test #c(80/7 7/13) #'+ 3/7 #c(11 7/13))
+(test #c(1.2345d47 -1) #'+ 12345d43 #c(-2147483648 -1))
+(test #c(-2147483649 2147483647) #'+ -2147483648 #c(-1 2147483647))
+(test #c(41/15 1.23456d68) #'- #c(7/5 1234.56d65) -4/3)
+(test #c(-41/19 2147483648) #'* #c(41/19 -2147483648) -1)
+(test #c(-88046829568/40802189293 2.147483649d41) #'* #c(41/19 -2147483648d32) -2147483648/2147483647)
+(test #c(-5.0691244239631335d0 1.3911008563333336d16)
+	#'/ #c(-11/7 4312412654633334) 0.31d0)
+(bool-test t #'= #c(1 0.0) 1)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; complex complex
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test #c(-16.0d0 -4.0d0) #'+ #c(-16.0d0 -4.0d0))
+(test #c(0d0 1d0) #'- #c(0d0 -1d0))
+(test #c(1d0 3d0) #'- #c(-1d0 -3d0))
+(test #c(-16.0d0 -4.0d0) #'* #c(-16.0d0 -4.0d0))
+(test #c(-0.058823529411764705d0 0.014705882352941176d0) #'/ #c(-16d0 -4d0))
+(test #c(1.94d0 301868863889/7) #'+ #c(3/5 5/7) #c(1.34d0 43124123412))
+(test #c(8641975242/7 -3.4596d0) #'- #c(1234567890 0.0004d0) #c(-12/7 3.46d0))
+(test #c(2944.315858312371d0 5.59002d13) #'* #c(-11/7 -1234d9) #c(-45.3d0 5/2147483647))
+(test #c(1.9635384272224412d-8 -0.33333333317811176d0)
+	#'/ #c(2147483647/3 -0.5d0) #c(128 2147483648.0d0))
+(test #c(8.154945137073864d11 2.621232365490813d12)
+	#'/ #c(-1.3d0 4312412654633) #c(3/2 7/15))
+(test #c(0.003674737027278924d0 -257.6948748113586d0)
+	#'/ #c(1.5d0 -432412) #c(1678 -567/31313))
+(bool-test t #'= #c(1 2d0) #c(1 2))
+(bool-test nil #'/= #c(1 2) #c(1d0 2d0))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; abs
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 2147483648 #'abs -2147483648)
+(test 2147483647 #'abs -2147483647)
+(test 2147483647 #'abs 2147483647)
+(test 1 #'abs 1)
+(test 5/7 #'abs -5/7)
+(test 2147483648/2147483647 #'abs -2147483648/2147483647)
+(test 3.12d0 #'abs -3.12d0)
+(test 4312412341234124124123412 #'abs 4312412341234124124123412)
+(test 4312412341234124124123412 #'abs -4312412341234124124123412)
+(test 1.0 #'abs #c(1 0.0))
+(test 11.40175425099138d0 #'abs #c(-11 3d0))
+(test 4.47213595499958d0 #'abs #c(-4 -2))
+(test 1.0 #'abs #c(0.0 -1.0))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; sqrt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 3.4641016151377544d0 #'sqrt 12)
+(test #c(0 12) #'sqrt -144)
+(test 6.429728792199102d18 #'sqrt 41341412341234123412490123470912347210)
+(test 41341412341234123412490123470912347210
+	#'sqrt 1709112374367945085349927261774254951456404621200206927501652414831594784100)
+(test 46340.95001184158d0 #'sqrt 2147483648)
+(test 0.7071067811865476d0 #'sqrt 0.5d0)
+(test 0 #'sqrt 0)
+(test 0d0 #'sqrt 0d0)
+(test 111.1106106544285d0 #'sqrt 12345.5678d0)
+(test #c(0 11.119982014373944d0) #'sqrt -123.654d0)
+(test 3/8 #'sqrt 9/64)
+(test #c(0 1.1832159566199232d0) #'sqrt -7/5)
+(test 514.7536007118473d0 #'sqrt 821974900428408092/3102128401119)
+(test 413412341293461238946192384612893/314212341412341246128361289
+	#'sqrt 170909763933741276657131032282211169869649489782500833989461829449/98729395495825697643724477479624921705328808513741521)
+;; check for overflow
+(error-test #'sqrt 402387260077093773543702433923003985719374864210714632543799910429938512398629020592044208486969404800479988610197196058631666872994808558901323829669944590997424504087073759918823627727188732519779505950995276120874975462497043601418278094646496291056393887437886487337119181045825783647849977012476632889835955735432513185323958463075557409114262417474349347553428646576611667797396668820291207379143853719588249808126867838374559731746136085379534524221586593201928090878297308431392844403281231558611036976801357304216168747609675871348312025478589320767169132448426236131412508780208000261683151027341827977704784635868170164365024153691398281264810213092761244896359928705114964975419909342221566832572080821333186116811553615836546984046708975602900950537616475847728421889679646244945160765353408198901385442487984959953319101723355556602139450399736280750137837615307127761926849034352625200015888535147331611702103968175921510907788019393178114194545257223865541461062892187960223838971476088506276862967146674697562911234082439208160153780889893964518263243671616762179168909779911903754031274622289988005195444414282012187361745992642956581746628302955570299024324153181617210465832036786906117260158783520751516284225540265170483304226143974286933061690897968482590125458327168226458066526769958652682272807075781391858178889652208164348344825993266043367660176999612831860788386150279465955131156552036093988180612138558600301435694527224206344631797460594682573103790084024432438465657245014402821885252470935190620929023136493273497565513958720559654228749774011413346962715422845862377387538230483865688976461927383814900140767310446640259899490222221765904339901886018566526485061799702356193897017860040811889729918311021171229845901641921068884387121855646124960798722908519296819372388642614839657382291123125024186649353143970137428531926649875337218940694281434118520158014123344828015051399694290153483077644569099073152433278288269864602789864321139083506217095002597389863554277196742822248757586765752344220207573630569498825087968928162753848863396909959826280956121450994871701244516461260379029309120889086942028510640182154399457156805941872748998094254742173582401063677404595741785160829230135358081840096996372524230560855903700624271243416909004153690105933983835777939410970027753472000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; mod
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 5 #'mod 5 9)
+(test 4 #'mod -5 9)
+(test -4 #'mod 5 -9)
+(test -5 #'mod -5 -9)
+(test 2147483646 #'mod -2147483648 2147483647)
+(test -1 #'mod -2147483648 -2147483647)
+(test 1 #'mod 2147483648 2147483647)
+(test 0 #'mod -170909763933741276657131032282211169869649489782500833989461829449 413412341293461238946192384612893)
+(test -1709112374367945085349927261774254951415063208858972804089162291360682436890
+	#'mod 41341412341234123412490123470912347210 -1709112374367945085349927261774254951456404621200206927501652414831594784100)
+(test 9.666666666666666d0 #'mod -1/3 10d0)
+(test -9.666666666666666d0 #'mod 1/3 -10d0)
+(test -0.3333333333333333d0 #'mod -1/3 -10d0)
+(test 0.3333333333333333d0 #'mod 1/3 10d0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; rem
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 2 #'rem 11 3)
+(test 2 #'rem 11 -3)
+(test -2 #'rem -11 3)
+(test -2 #'rem -11 -3)
+(test -1 #'rem -2147483648 2147483647)
+(test  0.1499999999999999d0 #'rem 1.35d0 1/5)
+(test  -0.1499999999999999d0 #'rem -1.35d0 1/5)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gcd
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 11 #'gcd 33 11)
+(test 7 #'gcd 91 -49)
+(test 4 #'gcd -4)
+(test 0 #'gcd)
+(test 11 #'gcd 3333 -33 1002001)
+(test 1 #'gcd -2147483648 2147483647)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; lcm
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 1 #'lcm)
+(test 10 #'lcm 10)
+(test 5 #'lcm -5)
+(test 4611686016279904256 #'lcm -2147483648 2147483647)
+(test 0 #'lcm 0 5)
+(test 60 #'lcm 1 2 3 4 5 6)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; and
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test -1 #'logand)
+(test 0 #'logand 1 2)
+(test -2147483648 #'logand -2147483648 -1)
+(test 2147483647 #'logand 2147483647 -1)
+(test 2147479552 #'logand 8796093018112 2147483647)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; eqv
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test -1 #'logeqv)
+(test -4 #'logeqv 1 2)
+(test -2147483648 #'logeqv -2147483648 -1)
+(test 2147483647 #'logeqv 2147483647 -1)
+(test -8793945542656 #'logeqv 8796093018112 2147483647)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; or
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 0 #'logior)
+(test 3 #'logior 1 2)
+(test -1 #'logior -2147483648 -1)
+(test -1 #'logior 2147483647 -1)
+(test 8796093022207 #'logior 8796093018112 2147483647)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; xor
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test 0 #'logxor)
+(test 3 #'logxor 1 2)
+(test 2147483647 #'logxor -2147483648 -1)
+(test -2147483648 #'logxor 2147483647 -1)
+(test 8793945542655 #'logxor 8796093018112 2147483647)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; not
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test -1 #'lognot 0)
+(test 0 #'lognot -1)
+(test -2 #'lognot 1)
+(test 1 #'lognot -2)
+(test -3 #'lognot 2)
+(test 2 #'lognot -3)
+(test -2147483648 #'lognot 2147483647)
+(test 2147483647 #'lognot -2147483648)
+(test -8793945542656 #'lognot 8793945542655)
+(test -8796093018113 #'lognot 8796093018112)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; floor
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(div-test 1 1/2 #'floor 3/2)
+(div-test 1d0 1 #'ffloor 3 2)
+(div-test -2 2147483646 #'floor -2147483648 2147483647)
+(div-test 2147483648 0 #'floor -2147483648 -1)
+(div-test 17179869184 0 #'floor 18446744073709551616 1073741824)
+(div-test -17179869201 -1073741807 #'floor 18446744073709551616 -1073741823)
+(div-test 2147483648 0d0 #'floor -2147483648 -1d0)
+(div-test -2 2147483646/2147483647 #'floor -2147483648/2147483647)
+(div-test 32768 32768/2147483647 #'floor 2147483648/2147483647 65535/2147483647)
+(div-test -32769 -32767/2147483647 #'floor 2147483648/2147483647 -65535/2147483647)
+(div-test -32769 32767/2147483647 #'floor -2147483648/2147483647 65535/2147483647)
+(div-test 32768 -32768/2147483647 #'floor -2147483648/2147483647 -65535/2147483647)
+(div-test 2 0.5d0 #'floor 3d0 1.25d0)
+(div-test 2 1d0 #'floor 4d0 1.5d0)
+(div-test -3 -0.5d0 #'floor 4d0 -1.5d0)
+(div-test -3 0.5d0 #'floor -4d0 1.5d0)
+(div-test 2 -1d0 #'floor -4d0 -1.5d0)
+(div-test 1 2/91 #'floor 5/7 9/13)
+(div-test -2 -61/91 #'floor 5/7 -9/13)
+(div-test -2 61/91 #'floor -5/7 9/13)
+(div-test 1 -2/91 #'floor -5/7 -9/13)
+(div-test 1 0 #'floor 2147483648/2147483647 2147483648/2147483647)
+(div-test -1 0 #'floor 2147483648/2147483647 -2147483648/2147483647)
+(div-test -1 0 #'floor -2147483648/2147483647 2147483648/2147483647)
+(div-test 1 0 #'floor -2147483648/2147483647 -2147483648/2147483647)
+(div-test 9437 1416337955817765/144137437447079
+	#'floor 16324116304212832041/144137437447079 12)
+(div-test -9438 -313311293547183/144137437447079
+	#'floor 16324116304212832041/144137437447079 -12)
+(div-test -9438 313311293547183/144137437447079
+	#'floor -16324116304212832041/144137437447079 12)
+(div-test 9437 -1416337955817765/144137437447079
+	#'floor -16324116304212832041/144137437447079 -12)
+(div-test 8081 1138147903718848755797/4324123123412370
+	#'floor 2147483648 1148972348912638496123/4324123123412370)
+(div-test -8082 -1804074198964956721/720687187235395
+	#'floor 2147483648 -1148972348912638496123/4324123123412370)
+(div-test -8082 1804074198964956721/720687187235395
+	#'floor -2147483648 1148972348912638496123/4324123123412370)
+(div-test 8081 -1138147903718848755797/4324123123412370
+	#'floor -2147483648 -1148972348912638496123/4324123123412370)
+(div-test 0 1148972348912638496123/4324123123412370111
+	#'floor 1148972348912638496123/4324123123412370111 2147483648)
+(div-test -1 -9285982550494401861657948805/4324123123412370111
+	#'floor 1148972348912638496123/4324123123412370111 -2147483648)
+(div-test -1 9285982550494401861657948805/4324123123412370111
+	#'floor -1148972348912638496123/4324123123412370111 2147483648)
+(div-test 0 -1148972348912638496123/4324123123412370111
+	#'floor -1148972348912638496123/4324123123412370111 -2147483648)
+(div-test 0.0d0 1.0000000004656613d0 #'ffloor 2147483648/2147483647 2147483648d0)
+(div-test -1.0d0 -2.147483647d9 #'ffloor 2147483648/2147483647 -2147483648d0)
+(div-test -1.0d0 2.147483647d9 #'ffloor -2147483648/2147483647 2147483648d0)
+(div-test 0.0d0 -1.0000000004656613d0 #'ffloor -2147483648/2147483647 -2147483648d0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ceiling
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(div-test 2 -1/2 #'ceiling 3/2)
+(div-test 2d0 -1 #'fceiling 3 2)
+(div-test -1 -1 #'ceiling -2147483648 2147483647)
+(div-test 2147483648 0 #'ceiling -2147483648 -1)
+(div-test 17179869184 0 #'ceiling 18446744073709551616 1073741824)
+(div-test -17179869200 16 #'ceiling 18446744073709551616 -1073741823)
+(div-test 2147483648 0d0 #'ceiling -2147483648 -1d0)
+(div-test -1 -1/2147483647 #'ceiling -2147483648/2147483647)
+(div-test 32769 -32767/2147483647 #'ceiling 2147483648/2147483647 65535/2147483647)
+(div-test -32768 32768/2147483647 #'ceiling 2147483648/2147483647 -65535/2147483647)
+(div-test -32768 -32768/2147483647 #'ceiling -2147483648/2147483647 65535/2147483647)
+(div-test 32769 32767/2147483647 #'ceiling -2147483648/2147483647 -65535/2147483647)
+(div-test 3 -0.75d0 #'ceiling 3d0 1.25d0)
+(div-test 3 -0.5d0 #'ceiling 4d0 1.5d0)
+(div-test -2 1d0 #'ceiling 4d0 -1.5d0)
+(div-test -2 -1d0 #'ceiling -4d0 1.5d0)
+(div-test 3 0.5d0 #'ceiling -4d0 -1.5d0)
+(div-test 2 -61/91 #'ceiling 5/7 9/13)
+(div-test -1 2/91 #'ceiling 5/7 -9/13)
+(div-test -1 -2/91 #'ceiling -5/7 9/13)
+(div-test 2 61/91 #'ceiling -5/7 -9/13)
+(div-test 1 0 #'ceiling 2147483648/2147483647 2147483648/2147483647)
+(div-test -1 0 #'ceiling 2147483648/2147483647 -2147483648/2147483647)
+(div-test -1 0 #'ceiling -2147483648/2147483647 2147483648/2147483647)
+(div-test 1 0 #'ceiling -2147483648/2147483647 -2147483648/2147483647)
+(div-test 9438 -313311293547183/144137437447079
+	#'ceiling 16324116304212832041/144137437447079 12)
+(div-test -9437 1416337955817765/144137437447079
+	#'ceiling 16324116304212832041/144137437447079 -12)
+(div-test -9437 -1416337955817765/144137437447079
+	#'ceiling -16324116304212832041/144137437447079 12)
+(div-test 9438 313311293547183/144137437447079
+	#'ceiling -16324116304212832041/144137437447079 -12)
+(div-test 8082 -1804074198964956721/720687187235395
+	#'ceiling 2147483648 1148972348912638496123/4324123123412370)
+(div-test -8081 1138147903718848755797/4324123123412370
+	#'ceiling 2147483648 -1148972348912638496123/4324123123412370)
+(div-test -8081 -1138147903718848755797/4324123123412370
+	#'ceiling -2147483648 1148972348912638496123/4324123123412370)
+(div-test 8082 1804074198964956721/720687187235395
+	#'ceiling -2147483648 -1148972348912638496123/4324123123412370)
+(div-test 1 -9285982550494401861657948805/4324123123412370111
+	#'ceiling 1148972348912638496123/4324123123412370111 2147483648)
+(div-test 0 1148972348912638496123/4324123123412370111
+	#'ceiling 1148972348912638496123/4324123123412370111 -2147483648)
+(div-test 0 -1148972348912638496123/4324123123412370111
+	#'ceiling -1148972348912638496123/4324123123412370111 2147483648)
+(div-test 1 9285982550494401861657948805/4324123123412370111
+	#'ceiling -1148972348912638496123/4324123123412370111 -2147483648)
+(div-test 1.0d0 -2.147483647d9 #'fceiling 2147483648/2147483647 2147483648d0)
+(div-test 0d0 1.0000000004656613d0 #'fceiling 2147483648/2147483647 -2147483648d0)
+(div-test 0d0 -1.0000000004656613d0 #'fceiling -2147483648/2147483647 2147483648d0)
+(div-test 1d0 2.147483647d9 #'fceiling -2147483648/2147483647 -2147483648d0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; truncate
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(div-test 1 1/2 #'truncate 3/2)
+(div-test 1d0 1 #'ftruncate 3 2)
+(div-test -1 -1 #'truncate -2147483648 2147483647)
+(div-test 2147483648 0 #'truncate -2147483648 -1)
+(div-test 17179869184 0 #'truncate 18446744073709551616 1073741824)
+(div-test -17179869200 16 #'truncate 18446744073709551616 -1073741823)
+(div-test 2147483648 0d0 #'truncate -2147483648 -1d0)
+(div-test -1 -1/2147483647 #'truncate -2147483648/2147483647)
+(div-test 32768 32768/2147483647 #'truncate 2147483648/2147483647 65535/2147483647)
+(div-test -32768 32768/2147483647 #'truncate 2147483648/2147483647 -65535/2147483647)
+(div-test -32768 -32768/2147483647 #'truncate -2147483648/2147483647 65535/2147483647)
+(div-test 32768 -32768/2147483647 #'truncate -2147483648/2147483647 -65535/2147483647)
+(div-test 2 0.5d0 #'truncate 3d0 1.25d0)
+(div-test 2 1d0 #'truncate 4d0 1.5d0)
+(div-test -2 1d0 #'truncate 4d0 -1.5d0)
+(div-test -2 -1d0 #'truncate -4d0 1.5d0)
+(div-test 2 -1d0 #'truncate -4d0 -1.5d0)
+(div-test 1 2/91 #'truncate 5/7 9/13)
+(div-test -1 2/91 #'truncate 5/7 -9/13)
+(div-test -1 -2/91 #'truncate -5/7 9/13)
+(div-test 1 -2/91 #'truncate -5/7 -9/13)
+(div-test 1 0 #'truncate 2147483648/2147483647 2147483648/2147483647)
+(div-test -1 0 #'truncate 2147483648/2147483647 -2147483648/2147483647)
+(div-test -1 0 #'truncate -2147483648/2147483647 2147483648/2147483647)
+(div-test 1 0 #'truncate -2147483648/2147483647 -2147483648/2147483647)
+(div-test 9437 1416337955817765/144137437447079
+	#'truncate 16324116304212832041/144137437447079 12)
+(div-test -9437 1416337955817765/144137437447079
+	#'truncate 16324116304212832041/144137437447079 -12)
+(div-test -9437 -1416337955817765/144137437447079
+	#'truncate -16324116304212832041/144137437447079 12)
+(div-test 9437 -1416337955817765/144137437447079
+	#'truncate -16324116304212832041/144137437447079 -12)
+(div-test 8081 1138147903718848755797/4324123123412370
+	#'truncate 2147483648 1148972348912638496123/4324123123412370)
+(div-test -8081 1138147903718848755797/4324123123412370
+	#'truncate 2147483648 -1148972348912638496123/4324123123412370)
+(div-test -8081 -1138147903718848755797/4324123123412370
+	#'truncate -2147483648 1148972348912638496123/4324123123412370)
+(div-test 8081 -1138147903718848755797/4324123123412370
+	#'truncate -2147483648 -1148972348912638496123/4324123123412370)
+(div-test 0 1148972348912638496123/4324123123412370111
+	#'truncate 1148972348912638496123/4324123123412370111 2147483648)
+(div-test 0 1148972348912638496123/4324123123412370111
+	#'truncate 1148972348912638496123/4324123123412370111 -2147483648)
+(div-test 0 -1148972348912638496123/4324123123412370111
+	#'truncate -1148972348912638496123/4324123123412370111 2147483648)
+(div-test 0 -1148972348912638496123/4324123123412370111
+	#'truncate -1148972348912638496123/4324123123412370111 -2147483648)
+(div-test 0d0 1.0000000004656613d0 #'ftruncate 2147483648/2147483647 2147483648d0)
+(div-test 0d0 1.0000000004656613d0 #'ftruncate 2147483648/2147483647 -2147483648d0)
+(div-test 0d0 -1.0000000004656613d0 #'ftruncate -2147483648/2147483647 2147483648d0)
+(div-test 0d0 -1.0000000004656613d0 #'ftruncate -2147483648/2147483647 -2147483648d0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; round
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(div-test 2 -1/2 #'round 3/2)
+(div-test 2d0 -1 #'fround 3 2)
+(div-test -1 -1 #'round -2147483648 2147483647)
+(div-test 2147483648 0 #'round -2147483648 -1)
+(div-test 17179869184 0 #'round 18446744073709551616 1073741824)
+(div-test -17179869200 16 #'round 18446744073709551616 -1073741823)
+(div-test 2147483648 0d0 #'round -2147483648 -1d0)
+(div-test -1 -1/2147483647 #'round -2147483648/2147483647)
+(div-test 32769 -32767/2147483647 #'round 2147483648/2147483647 65535/2147483647)
+(div-test -32769 -32767/2147483647 #'round 2147483648/2147483647 -65535/2147483647)
+(div-test -32769 32767/2147483647 #'round -2147483648/2147483647 65535/2147483647)
+(div-test 32769 32767/2147483647 #'round -2147483648/2147483647 -65535/2147483647)
+(div-test 2 0.5d0 #'round 3d0 1.25d0)
+(div-test 3 -0.5d0 #'round 4d0 1.5d0)
+(div-test -3 -0.5d0 #'round 4d0 -1.5d0)
+(div-test -3 0.5d0 #'round -4d0 1.5d0)
+(div-test 3 0.5d0 #'round -4d0 -1.5d0)
+(div-test 1 2/91 #'round 5/7 9/13)
+(div-test -1 2/91 #'round 5/7 -9/13)
+(div-test -1 -2/91 #'round -5/7 9/13)
+(div-test 1 -2/91 #'round -5/7 -9/13)
+(div-test 1 0 #'round 2147483648/2147483647 2147483648/2147483647)
+(div-test -1 0 #'round 2147483648/2147483647 -2147483648/2147483647)
+(div-test -1 0 #'round -2147483648/2147483647 2147483648/2147483647)
+(div-test 1 0 #'round -2147483648/2147483647 -2147483648/2147483647)
+(div-test 9438 -313311293547183/144137437447079
+	#'round 16324116304212832041/144137437447079 12)
+(div-test -9438 -313311293547183/144137437447079
+	#'round 16324116304212832041/144137437447079 -12)
+(div-test -9438 313311293547183/144137437447079
+	#'round -16324116304212832041/144137437447079 12)
+(div-test 9438 313311293547183/144137437447079
+	#'round -16324116304212832041/144137437447079 -12)
+(div-test 8082 -1804074198964956721/720687187235395
+	#'round 2147483648 1148972348912638496123/4324123123412370)
+(div-test -8082 -1804074198964956721/720687187235395
+	#'round 2147483648 -1148972348912638496123/4324123123412370)
+(div-test -8082 1804074198964956721/720687187235395
+	#'round -2147483648 1148972348912638496123/4324123123412370)
+(div-test 8082 1804074198964956721/720687187235395
+	#'round -2147483648 -1148972348912638496123/4324123123412370)
+(div-test 0 1148972348912638496123/4324123123412370111
+	#'round 1148972348912638496123/4324123123412370111 2147483648)
+(div-test 0 1148972348912638496123/4324123123412370111
+	#'round 1148972348912638496123/4324123123412370111 -2147483648)
+(div-test 0 -1148972348912638496123/4324123123412370111
+	#'round -1148972348912638496123/4324123123412370111 2147483648)
+(div-test 0 -1148972348912638496123/4324123123412370111
+	#'round -1148972348912638496123/4324123123412370111 -2147483648)
+(div-test 0d0 1.0000000004656613d0 #'fround 2147483648/2147483647 2147483648d0)
+(div-test 0d0 1.0000000004656613d0 #'fround 2147483648/2147483647 -2147483648d0)
+(div-test 0d0 -1.0000000004656613d0 #'fround -2147483648/2147483647 2147483648d0)
+(div-test 0d0 -1.0000000004656613d0 #'fround -2147483648/2147483647 -2147483648d0)
+(div-test 2 0.5d0 #'round 2.5d0)
+(div-test -2 -0.5d0 #'round -2.5d0)
+(div-test 5 0d0 #'round 2.5d0 0.5d0)
+(div-test -5 0d0 #'round 2.5d0 -0.5d0)
+(div-test -5 0d0 #'round 2.5d0 -0.5d0)
+(div-test -5 0d0 #'round -2.5d0 0.5d0)
+(div-test 5 0d0 #'round -2.5d0 -0.5d0)
+(div-test 1 -2/7 #'round 5/7)
+(div-test -1 2/7 #'round -5/7)
+(div-test 2 -1/2 #'round 3/2)
+(div-test -2 1/2 #'round -3/2)
+(div-test 2 1 #'round 30/2 7)
+(div-test -2 1 #'round 30/2 -7)
+(div-test -2 -1 #'round -30/2 7)
+(div-test 2 -1 #'round -30/2 -7)
+(div-test 1073741824 -1/2 #'round 2147483647/2)
+(div-test -1073741824 1/2 #'round -2147483647/2)
+(div-test 1 -2147483645/2 #'round 2147483647/2 2147483646)
+(div-test -1 -2147483645/2 #'round 2147483647/2 -2147483646)
+(div-test -1 2147483645/2 #'round -2147483647/2 2147483646)
+(div-test 1 -2147483645/2 #'round 2147483647/2 2147483646)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; misc
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(test #c(5 -5) #'conjugate #c(5 5))
+(test #c(5 5) #'conjugate #c(5 -5))
+(test #c(-5 -5) #'conjugate #c(-5 5))
+(test #c(-5 5) #'conjugate #c(-5 -5))
+
+(test 1 #'denominator 10)
+(test 3 #'denominator 10/3)
+(test 3 #'denominator 1804074198964956721/3)
+(test 4324123123412370111 #'denominator -1148972348912638496123/4324123123412370111)
+
+(bool-test nil #'evenp -1)
+(bool-test t #'evenp -2147483648)
+(bool-test t #'evenp -4294967296)
+(bool-test nil #'evenp -4294967295)
+
+(test 0.5d0 #'float 1/2)
+(test 10.0d0 #'float 10)
+(test 4.978341823462786d22 #'float 49783418234627861238926)
+(test 1.845867531346429d12 #'float 643827946123846123984/348794231)
+
+(bool-test t #'floatp 0.3d0)
+(bool-test nil #'floatp 1/3)
+
+(test 0 #'imagpart 1)
+(test -5 #'imagpart #c(1 -5))
+
+(bool-test t #'integerp 12)
+(bool-test nil #'integerp 1/2)
+(bool-test nil #'integerp :test)
+(bool-test nil #'integerp 0d0)
+(bool-test t #'integerp 49783418234627861238926)
+
+(test 3 #'isqrt 12)
+(test 46340 #'isqrt 2147483648)
+(test 46340 #'isqrt 2147483647)
+(test 25373764918 #'isqrt 643827946123846123984)
+
+(bool-test nil #'logtest 1 2)
+(bool-test t #'logtest 1 3)
+(bool-test t #'logtest 7 -1)
+
+(bool-test nil #'minusp 0)
+(bool-test nil #'minusp 2147483648)
+(bool-test t #'minusp -2147483648)
+(bool-test t #'minusp -1/4)
+(bool-test nil #'minusp 0.2d0)
+(bool-test nil #'minusp 0d0)
+(bool-test nil #'minusp 984723891462817946123897416)
+(bool-test t #'minusp -1148972348912638496123/4324123123412370111)
+
+(bool-test t #'numberp #c(1 2))
+(bool-test t #'numberp -200)
+(bool-test nil #'numberp :test)
+
+(test 10 #'numerator 10)
+(test 10 #'numerator 10/3)
+(test 1804074198964956721 #'numerator 1804074198964956721/3)
+(test -1148972348912638496123 #'numerator -1148972348912638496123/4324123123412370111)
+
+(bool-test t #'oddp -1)
+(bool-test nil #'oddp -2147483648)
+(bool-test nil #'oddp -4294967296)
+(bool-test t #'oddp -4294967295)
+
+(bool-test nil #'plusp 0)
+(bool-test t #'plusp 2147483648)
+(bool-test nil #'plusp -2147483648)
+(bool-test nil #'plusp -1/4)
+(bool-test t #'plusp 0.2d0)
+(bool-test nil #'plusp 0d0)
+(bool-test t #'plusp 984723891462817946123897416)
+(bool-test nil #'plusp -1148972348912638496123/4324123123412370111)
+
+(test 1/4 #'rational 0.25d0)
+(test 5/2 #'rational 2.5d0)
+(test 1/8 #'rational 0.125d0)
+(test -5/8 #'rational -0.625d0)
+(test 524293/8 #'rational 65536.625d0)
+(test 17179869181/8 #'rational 2147483647.625d0)
+
+(bool-test t #'rationalp -3)
+(bool-test t #'rationalp 1/2)
+(bool-test t #'rationalp 1/2412341242424122412)
+(bool-test nil #'rationalp :test)
+(bool-test nil #'rationalp 0d0)
+(bool-test t #'rationalp 49783418234627861238926)
+
+(test -1 #'realpart #c(-1 0.5d0))
+
+(test 1 #'signum 123/5)
+(test 0d0 #'signum 0d0)
+(test -1d0 #'signum -7.3d0)
+
+(bool-test nil #'zerop 1)
+(bool-test nil #'zerop 1/4312412341234123412)
+(bool-test nil #'zerop 0.000003d0)
+(bool-test t #'zerop 0)
+(bool-test t #'zerop 0d0)
+(bool-test t #'zerop #c(0 0d0))
+
+(bool-test t #'= 10 #c(10 0d0))
+
diff --git a/lisp/test/psql-1.lsp b/lisp/test/psql-1.lsp
new file mode 100644
index 0000000..2410fd8
--- /dev/null
+++ b/lisp/test/psql-1.lsp
@@ -0,0 +1,80 @@
+;; Postgresql C library interface, example program 1, using the xedit
+;; lisp interface
+
+;; Test the C version of libpq, the PostgreSQL frontend library. 
+(require "psql")
+
+(defun exit-nicely (conn)
+    (pq-finish conn)
+    (quit 1)
+)
+
+;; begin, by setting the parameters for a backend connection if the
+;; parameters are null, then the system will try to use reasonable
+;; defaults by looking up environment variables or, failing that,
+;; using hardwired constants
+(setq pghost nil)		; host name of the backend server
+(setq pgport nil)		; port of the backend server
+(setq pgoptions nil)		; special options to start up the backend server
+(setq pgtty nil)		; debugging tty for the backend server
+(setq pgdbname "template1")
+
+;; make a connection to the database
+(setq conn (pq-setdb pghost pgport pgoptions pgtty pgdbname))
+
+;; check to see that the backend connection was successfully made
+(when (= (pq-status conn) pg-connection-bad)
+    (format t "Connection to database '~A' failed.~%" pgdbname)
+    (format t "~A" (pq-error-message conn))
+    (exit-nicely conn))
+
+;; start a transaction block
+(setq res (pq-exec conn "BEGIN"))
+(when (or (null res) (not (= (pq-result-status res) pgres-command-ok)))
+    (format t "BEGIN command failed~%")
+    (pq-clear res)
+    (exit-nicely conn))
+
+;; Should PQclear PGresult whenever it is no longer needed to avoid memory leaks
+(pq-clear res)
+
+;; fetch rows from the pg_database, the system catalog of databases
+(setq res (pq-exec conn "DECLARE mycursor CURSOR FOR select * from pg_database"))
+(when (or (null res) (not (= (pq-result-status res) pgres-command-ok)))
+    (format t "DECLARE CURSOR command failed~%")
+    (pq-clear res)
+    (exit-nicely conn))
+(pq-clear res)
+(setq res (pq-exec conn "FETCH ALL in mycursor"))
+(when (or (null res) (not (= (pq-result-status res) pgres-tuples-ok)))
+    (format t "FETCH ALL command didn't return tuples properly~%")
+    (pq-clear res)
+    (exit-nicely conn))
+
+;; first, print out the attribute names
+(setq nfields (pq-nfields res))
+(dotimes (i nfields)
+    (format t "~15@<~A~>" (pq-fname res i))
+)
+(format t "~%")
+
+;; next, print out the rows
+(setq ntuples (pq-ntuples res))
+(dotimes (i ntuples)
+    (dotimes (j nfields)
+	(format t "~15@<~A~>" (pq-getvalue res i j))
+    )
+    (format t "~%")
+)
+(pq-clear res)
+
+;; close the cursor
+(setq res (pq-exec conn "CLOSE mycursor"))
+(pq-clear res)
+
+;; commit the transaction
+(setq res (pq-exec conn "COMMIT"))
+(pq-clear res)
+
+;; close the connection to the database and cleanup
+(pq-finish conn)
diff --git a/lisp/test/psql-2.lsp b/lisp/test/psql-2.lsp
new file mode 100644
index 0000000..011512c
--- /dev/null
+++ b/lisp/test/psql-2.lsp
@@ -0,0 +1,74 @@
+;; Postgresql C library interface, example program 2, using the xedit
+;; lisp interface
+
+;;  Test of the asynchronous notification interface
+;;
+;; Start this program, then from psql in another window do
+;;   NOTIFY TBL2;
+;;
+;; Or, if you want to get fancy, try this:
+;; Populate a database with the following:
+;;
+;;   CREATE TABLE TBL1 (i int4);
+;;
+;;   CREATE TABLE TBL2 (i int4);
+;;
+;;   CREATE RULE r1 AS ON INSERT TO TBL1 DO
+;;     (INSERT INTO TBL2 values (new.i); NOTIFY TBL2);
+;;
+;; and do
+;;
+;;   INSERT INTO TBL1 values (10);
+(require "psql")
+
+(defun exit-nicely (conn)
+    (pq-finish conn)
+    (quit 1)
+)
+
+;; begin, by setting the parameters for a backend connection if the
+;; parameters are null, then the system will try to use reasonable
+;; defaults by looking up environment variables or, failing that,
+;; using hardwired constants
+(setq pghost nil)		; host name of the backend server
+(setq pgport nil)		; port of the backend server
+(setq pgoptions nil)		; special options to start up the backend server
+(setq pgtty nil)		; debugging tty for the backend server
+(setq pgdbname "test")		; change this to the name of your test database
+				;; XXX Note: getenv not yet implemented in the
+				 ; lisp interpreter
+
+;; make a connection to the database
+(setq conn (pq-setdb pghost pgport pgoptions pgtty pgdbname))
+
+;; check to see that the backend connection was successfully made
+(when (= (pq-status conn) pg-connection-bad)
+    (format t "Connection to database '~A' failed.~%" pgdbname)
+    (format t "~A" (pq-error-message conn))
+    (exit-nicely conn))
+
+(setq res (pq-exec conn "LISTEN TBL2"))
+(when (= (pq-status conn) pg-connection-bad)
+    (format t "LISTEN command failed~%")
+    (format t "~A" (pq-error-message conn))
+    (exit-nicely conn))
+
+;; Should PQclear PGresult whenever it is no longer needed to avoid memory leaks
+(pq-clear res)
+
+(loop
+    ;; wait a little bit between checks; waiting with select()
+    ;; would be more efficient.
+	;; XXX Note: sleep not yet implemented in the lisp interpreter
+
+    ;; collect any asynchronous backend messages
+    (pq-consume-input conn)
+
+    ;; check for asynchronous notify messages
+    (when (setq notifies (pq-notifies conn))
+	(format t "ASYNC NOTIFY of '~A' from backend pid '~D' received~%"
+	 (pg-notify-relname notifies) (pg-notify-be-pid notifies))
+    )
+)
+
+(pq-finish conn)
diff --git a/lisp/test/psql-3.lsp b/lisp/test/psql-3.lsp
new file mode 100644
index 0000000..bb172c9
--- /dev/null
+++ b/lisp/test/psql-3.lsp
@@ -0,0 +1,118 @@
+;; Postgresql C library interface, example program 3, using the xedit
+;; lisp interface
+
+;;  Test the binary cursor interface
+;;
+;; populate a database by doing the following:
+;;
+;; CREATE TABLE test1 (i int4, d real, p polygon);
+;;
+;; INSERT INTO test1 values (1, 3.567, polygon '(3.0, 4.0, 1.0, 2.0)');
+;;
+;; INSERT INTO test1 values (2, 89.05, polygon '(4.0, 3.0, 2.0, 1.0)');
+;;
+;; the expected output is:
+;;
+;; tuple 0: got i = (4 bytes) 1, d = (4 bytes) 3.567000, p = (4
+;; bytes) 2 points   boundbox = (hi=3.000000/4.000000, lo =
+;; 1.000000,2.000000) tuple 1: got i = (4 bytes) 2, d = (4 bytes)
+;; 89.050003, p = (4 bytes) 2 points   boundbox =
+;; (hi=4.000000/3.000000, lo = 2.000000,1.000000)
+
+;;  Output of the lisp code:
+;;
+;; type[0] = 23, size[0] = 4
+;; type[1] = 700, size[1] = 4
+;; type[2] = 604, size[2] = -1
+;; tuple 0: got
+;;  i = (4 bytes) 1
+;;  d = (4 bytes) 3.567
+;;  p = (4 bytes) 2 points boundbox = (hi=3.0/4.0, lo = 1.0/2.0)
+;; tuple 1: got
+;;  i = (4 bytes) 2
+;;  d = (4 bytes) 89.05
+;;  p = (4 bytes) 2 points boundbox = (hi=4.0/3.0, lo = 2.0/1.0)
+
+
+(require "psql")
+
+(defun exit-nicely (conn)
+    (pq-finish conn)
+    (quit 1)
+)
+
+;; begin, by setting the parameters for a backend connection if the
+;; parameters are null, then the system will try to use reasonable
+;; defaults by looking up environment variables or, failing that,
+;; using hardwired constants
+(setq pghost nil)		; host name of the backend server
+(setq pgport nil)		; port of the backend server
+(setq pgoptions nil)		; special options to start up the backend server
+(setq pgtty nil)		; debugging tty for the backend server
+(setq pgdbname "test")		; change this to the name of your test database
+				;; XXX Note: getenv not yet implemented in the
+				 ; lisp interpreter
+
+;; make a connection to the database
+(setq conn (pq-setdb pghost pgport pgoptions pgtty pgdbname))
+
+;; check to see that the backend connection was successfully made
+(when (= (pq-status conn) pg-connection-bad)
+    (format t "Connection to database '~A' failed.~%" pgdbname)
+    (format t "~A" (pq-error-message conn))
+    (exit-nicely conn))
+
+(setq res (pq-exec conn "BEGIN"))
+(when (= (pq-status conn) pg-connection-bad)
+    (format t "BEGIN command failed~%")
+    (pq-clear res)
+    (exit-nicely conn))
+
+;; Should PQclear PGresult whenever it is no longer needed to avoid memory leaks
+(pq-clear res)
+
+(setq res (pq-exec conn "DECLARE mycursor BINARY CURSOR FOR select * from test1"))
+(when (= (pq-status conn) pg-connection-bad)
+    (format t "DECLARE CURSOR command failed~%")
+    (pq-clear res)
+    (exit-nicely conn))
+(pq-clear res)
+
+(setq res (pq-exec conn "FETCH ALL in mycursor"))
+(when (or (null res) (not (= (pq-result-status res) pgres-tuples-ok)))
+    (format t "FETCH ALL command didn't return tuples properly~%")
+    (pq-clear res)
+    (exit-nicely conn))
+
+(setq i-fnum (pq-fnumber res "i"))
+(setq d-fnum (pq-fnumber res "d"))
+(setq p-fnum (pq-fnumber res "p"))
+
+(dotimes (i 3)
+    (format t "type[~D] = ~D, size[~D] = ~D~%"
+     i (pq-ftype res i) i (pq-fsize res i))
+)
+
+(dotimes (i (pq-ntuples res))
+    (setq i-val (pq-getvalue res i i-fnum 'int32))
+    (setq d-val (pq-getvalue res i d-fnum 'float))
+    (setq p-val (pq-getvalue res i p-fnum 'pg-polygon))
+    (format t "tuple ~D: got~%" i)
+    (format t " i = (~D bytes) ~D~%" (pq-getlength res i i-fnum) i-val)
+    (format t " d = (~D bytes) ~D~%" (pq-getlength res i d-fnum) d-val)
+    (format t " p = (~D bytes) ~D points~,8@Tboundbox = (hi=~F/~F, lo = ~F/~F)~%"
+     (pq-getlength res i d-fnum) (pg-polygon-num-points p-val)
+     (pg-point-x (pg-box-high (pg-polygon-boundbox p-val)))
+     (pg-point-y (pg-box-high (pg-polygon-boundbox p-val)))
+     (pg-point-x (pg-box-low (pg-polygon-boundbox p-val)))
+     (pg-point-y (pg-box-low (pg-polygon-boundbox p-val))))
+)
+(pq-clear res)
+
+(setq res (pq-exec conn "CLOSE mycursor"))
+(pq-clear res)
+
+(setq res (pq-exec conn "COMMIT"))
+(pq-clear res)
+
+(pq-finish conn)
diff --git a/lisp/test/regex.lsp b/lisp/test/regex.lsp
new file mode 100644
index 0000000..64ba572
--- /dev/null
+++ b/lisp/test/regex.lsp
@@ -0,0 +1,440 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/test/regex.lsp,v 1.2 2002/12/11 04:44:28 paulo Exp $
+;;
+
+;; Basic regex tests. This file is only for xedit lisp and for it's regex
+;; library. Note that the regex library used by xedit lisp is not mean't
+;; to be fully compatible with most regexes, but to be as fast as possible.
+;; This means that some patterns that looks basic may never be matched,
+;; but it is expected that almost any pattern can be rewritten to be
+;; matched, or in the worst case, it may be required to search in the
+;; regions matched by a previous regex.
+
+(defun re-test (expect &rest arguments &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (apply #'re-exec arguments))
+	    (setq error nil)))
+    (if error
+	(format t "ERROR: (re-exec~{ ~S~}) => ~S~%" arguments error-value)
+	(or (equal result expect)
+	    (format t "(re-exec~{ ~S~}) => should be ~S not ~S~%"
+		arguments expect result))))
+
+;; errors only generated for regex compilation (or incorrect arguments)
+(defun re-error (&rest arguments &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (apply #'re-comp arguments))
+	    (setq error nil)))
+    (or error
+	(format t "ERROR: no error for (re-comp~{ ~S~})" arguments)))
+
+(re-error "")
+(re-error "a**")
+(re-error "[a")
+(re-error "a{")
+(re-error "a(")
+(re-error "a||b")
+(re-error "|b|c")
+(re-error "a|b|")
+
+(setq re (re-comp "abc"))
+(re-test '((0 . 3)) re "abc")
+(re-test '((0 . 3)) re "abc" :notbol t)
+(re-test '((0 . 3)) re "abc" :noteol t)
+(re-test '((0 . 3)) re "abc" :notbol t :noteol t)
+(re-test '((14 . 17)) re "aaaaaaaaaaaaaaabc")
+(re-test '((14 . 17)) re "aaaaaaaaaaaaaaabc" :start 12 :end 17)
+(re-test '((30 . 33)) re "xxxxxxxxxxxxxxaaaaaaaaaaaaaaaaabcxx")
+(re-test '((30 . 33)) re "xxxxxxxxxxxxxxaaaaaaaaaaaaaaaaabcxx" :start 28 :end 34)
+
+(setq re (re-comp "^abc"))
+(re-test '((0 . 3)) re "abc")
+(re-test :nomatch re "xabc")
+(re-test '((1 . 4)) re "xabc" :start 1)
+(re-test :nomatch re "xabc" :start 1 :notbol t)
+
+(setq re (re-comp "abc$"))
+(re-test '((0 . 3)) re "abc")
+(re-test :nomatch re "xabcx")
+(re-test '((1 . 4)) re "xabcx" :end 4)
+(re-test :nomatch re "xabc" :end 4 :noteol t)
+
+(setq re (re-comp "^abc$"))
+(re-test '((0 . 3)) re "abc")
+(re-test :nomatch re "xabcx")
+(re-test '((1 . 4)) re "xabcx" :start 1 :end 4)
+(re-test :nomatch re "xabcx" :start 1 :end 4 :notbol t)
+(re-test :nomatch re "xabcx" :start 1 :end 4 :noteol t)
+(re-test :nomatch re "xabcx" :start 1 :end 4 :notbol t :noteol t)
+(re-test nil re "abc" :count 0)
+
+(setq re (re-comp "abc|bcd|cde"))
+(re-test '((0 . 3)) re "abc")
+(re-test '((1 . 4)) re "aabc")
+(re-test '((3 . 6)) re "xxxbcdef")
+(re-test '((8 . 11)) re "abdzzzcdabcde")
+(re-test '((13 . 16)) re "xxxxabdecdabdcde")
+
+(setq re (re-comp "^abc|bcd$|cde"))
+(re-test '((0 . 3)) re "abcde")
+(re-test '((3 . 6)) re "xabcde")
+(re-test '((1 . 4)) re "xabcde" :start 1)
+(re-test '((3 . 6)) re "xabcde" :start 1 :notbol t)
+(re-test '((2 . 5)) re "xabcd")
+(re-test :nomatch re "xabcd" :noteol t)
+(re-test nil re "xabcd" :count 0)
+(re-test :nomatch re "abcdx" :notbol t)
+
+(setq re (re-comp "a?bc|ab?c|abc?"))
+(re-test '((0 . 3)) re "abc")
+(re-test :nomatch re "xxxb")
+(re-test '((3 . 5)) re "xxxbc")
+(re-test '((5 . 7)) re "sssssab")
+(re-test '((0 . 3)) re "abcd")
+(re-test '((1 . 4)) re "aabcdef")
+(re-test '((1 . 3)) re "aabbccdef")	;; ab matches abc?
+
+(setq re (re-comp "a?bc"))
+(re-test '((2 . 4)) re "acbcd")
+(re-test '((2 . 5)) re "acabcd")
+
+(setq re (re-comp "ab?c"))
+(re-test '((1 . 3)) re "xacc")
+(re-test '((2 . 5)) re "xxabcc")
+
+(setq re (re-comp "abc?"))
+(re-test '((1 . 3)) re "xababc")
+(re-test '((2 . 5)) re "xxabccabc")
+
+(setq re (re-comp "a*bc|ab*c|abc*"))
+(re-test '((0 . 9)) re "aaaaaaabc")
+(re-test '((1 . 10)) re "xaaaaaaabc")
+(re-test '((3 . 12)) re "xyzaaaaaaabc")
+(re-test '((0 . 4)) re "abbc")
+(re-test '((2 . 9)) re "xxabbbbbc")
+(re-test '((0 . 12)) re "abcccccccccc")
+(re-test '((0 . 12)) re "abccccccccccd")
+(re-test '((16 . 29)) re "xxxxxxxaaaaaaaaaabbbbbbbbbbbccccccccccc")
+(re-test '((11 . 13)) re "xxxbbbbbbbbbc")
+(re-test '((8 . 10)) re "aaaaazbxacd")
+
+(setq re (re-comp "a*bc"))
+(re-test '((2 . 4)) re "acbcd")
+(re-test '((2 . 5)) re "acabcd")
+(re-test '((2 . 8)) re "acaaaabcd")
+
+(setq re (re-comp "ab*c"))
+(re-test '((1 . 3)) re "xacc")
+(re-test '((2 . 5)) re "xxabcc")
+(re-test '((3 . 8)) re "xxaabbbcc")
+
+(setq re (re-comp "abc*"))
+(re-test '((1 . 3)) re "xababc")
+(re-test '((2 . 5)) re "xxabcbabccc")
+(re-test '((3 . 7)) re "axxabccabc")
+
+(setq re (re-comp "a+bc|ab+c|abc+"))
+(re-test :nomatch re "xxxbc")
+(re-test '((1 . 6)) re "xaaabc")
+(re-test '((8 . 12)) re "zzzzaaaaabbc")
+(re-test '((7 . 15)) re "zzzzaaaabbbbbbcccc")
+
+(setq re (re-comp "a.c"))
+(re-test '((0 . 3)) re "abc")
+(re-test '((1 . 4)) re "aaac")
+(re-test :nomatch re "xac")
+(re-test '((3 . 6)) re "xaxaac")
+(re-test '((2 . 5)) re "xxabc")
+(re-test '((3 . 6)) re "acxaxc")
+
+(setq re (re-comp "a*c"))
+(re-test '((0 . 1)) re "c")
+(re-test '((5 . 6)) re "xxxxxc")
+(re-test '((8 . 9)) re "xxxxxxxxc")
+(re-test '((7 . 8)) re "xxxxxxxcc")
+(re-test '((0 . 2)) re "ac")
+(re-test '((0 . 5)) re "aaaac")
+(re-test '((1 . 3)) re "xac")
+(re-test '((3 . 6)) re "xxxaac")
+(re-test '((2 . 4)) re "xxac")
+(re-test '((4 . 6)) re "xxxxac")
+
+(setq re (re-comp "a+c"))
+(re-test '((2 . 5)) re "xxaac")
+(re-test '((3 . 8)) re "xxxaaaac")
+(re-test '((6 . 8)) re "xaaaabac")
+(re-test :nomatch re "xxxc")
+(re-test '((4 . 9)) re "xxxxaaaaccc")
+
+(setq re (re-comp "a{4}b"))
+(re-test '((19 . 24)) re "xabxxaabxxxaaabxxxxaaaab")
+(re-test '((4 . 9)) re "aaabaaaab")
+
+(setq re (re-comp "a{4,}b"))
+(re-test '((3 . 8)) re "xxxaaaab")
+(re-test '((8 . 25)) re "zaaabzzzaaaaaaaaaaaaaaaab")
+
+(setq re (re-comp "a{,4}b"))
+(re-test '((0 . 1)) re "b")
+(re-test '((8 . 9)) re "xxxxxxxxb")
+(re-test '((6 . 11)) re "xaaaaaaaaab")
+(re-test '((3 . 5)) re "xxxab")
+(re-test '((6 . 10)) re "aaaaaxaaab")
+
+(setq re (re-comp "a{2,4}b"))
+(re-test :nomatch re "xab")
+(re-test '((1 . 4)) re "xaab")
+(re-test '((1 . 5)) re "xaaab")
+(re-test '((2 . 7)) re "xxaaaab")
+(re-test '((4 . 9)) re "xxxaaaaab")
+
+(setq re (re-comp "foo(bar|baz)fee"))
+(re-test '((9 . 18)) re "feebarbazfoobarfee")
+(re-test '((9 . 18) (12 . 15)) re "feebarbazfoobarfee" :count 2)
+(re-test '((13 . 22)) re "foofooobazfeefoobazfee")
+(re-test '((13 . 22) (16 . 19)) re "foofooobazfeefoobazfee" :count 3)
+
+(setq re (re-comp "foo(bar|baz)fee" :nosub t))
+(re-test '((9 . 18)) re "feebarbazfoobarfee")
+(re-test '((9 . 18)) re "feebarbazfoobarfee" :count 2)
+(re-test '((13 . 22)) re "foofooobazfeefoobazfee")
+(re-test '((13 . 22)) re "foofooobazfeefoobazfee" :count 3)
+
+(setq re (re-comp "f(oo|ee)ba[rz]"))
+(re-test :nomatch re "barfoebaz")
+(re-test '((3 . 9) (4 . 6)) re "bazfoobar" :count 2)
+(re-test '((3 . 9) (4 . 6)) re "barfeebaz" :count 2)
+
+(setq re (re-comp "f(oo|ee)ba[rz]" :nosub t))
+(re-test :nomatch re "barfoebaz")
+(re-test '((3 . 9)) re "bazfoobar" :count 2)
+(re-test '((3 . 9)) re "barfeebaz" :count 2)
+
+(setq re (re-comp "\\<(int|char)\\>"))
+(re-test '((15 . 18)) re "aint character int foo")
+(re-test '((15 . 18) (15 . 18)) re "aint character int foo" :count 2)
+
+(setq re (re-comp "\\<(int|char)\\>" :nosub t))
+(re-test '((15 . 18)) re "aint character int foo" :count 2)
+
+(setq re (re-comp "foo.*bar"))
+(re-test '((11 . 17)) re "barfoblaboofoobarfoobarfoobar")
+
+(setq re (re-comp "foo.+bar"))
+(re-test :nomatch re "foobar")
+(re-test '((6 . 13)) re "fobbarfooxbarfooybar")
+
+(setq re (re-comp "foo.?bar"))
+(re-test '((1 . 7)) re "xfoobar")
+(re-test :nomatch re "xxfooxxbar")
+(re-test '((3 . 10)) re "yyyfootbar")
+
+(setq re (re-comp "a.*b.*c"))
+(re-test '((0 . 3)) re "abc")
+(re-test '((9 . 18)) re "xxxxxxxxxabbbbbbbccaaaaabbbc")
+
+(setq re (re-comp "a.+b.*c"))
+(re-test :nomatch re "xxxabc")
+(re-test '((2 . 7)) re "xxaxbbc")
+
+(setq re (re-comp "a.+b.?c"))
+(re-test '((1 . 5)) re "xaabc")
+(re-test '((2 . 7)) re "xxaabbc")
+
+(setq re (re-comp "(foo.*|bar)fee"))
+(re-test '((3 . 9) (3 . 6)) re "barfoofee" :count 2)
+(re-test '((0 . 9) (0 . 6)) re "foobarfee" :count 2)
+(re-test '((4 . 10) (4 . 7)) re "xxfobarfee" :count 2)
+(re-test '((3 . 17) (3 . 14)) re "barfooooooobarfee" :count 2)
+(re-test '((4 . 10) (4 . 7)) re "xxfobarfeefoobar" :count 2)
+
+(setq re (re-comp "(foo.+|bar)fee"))
+(re-test :nomatch re "barfoofee" :count 2)
+(re-test '((3 . 10) (3 . 7)) re "barfooxfee" :count 2)
+
+(setq re (re-comp "(foo.?|bar)fee"))
+(re-test :nomatch re "foobar" :count 2)
+(re-test '((2 . 8) (2 . 5)) re "bafoofee" :count 2)
+(re-test '((2 . 9) (2 . 6)) re "bafooofeebarfee" :count 4)
+(re-test '((2 . 8) (2 . 5)) re "bafoofeebarfee" :count 2)
+(re-test nil re "bafoofeebarfee" :count 0)
+(re-test '((2 . 8)) re "bafoofeebarfee" :count 1)
+
+(setq re (re-comp "(a|b|c)\\1"))
+(re-test '((0 . 2) (0 . 1)) re "aa" :count 2)
+
+(setq re (re-comp "(a|b|c)(a|b|c)\\1\\2"))
+(re-test '((0 . 4) (0 . 1) (1 . 2)) re "acac" :count 5)
+(re-test '((4 . 8) (4 . 5) (5 . 6)) re "xxxxacac" :count 4)
+(re-test '((24 . 28) (24 . 25) (25 . 26)) re "xxacabacbcacbbacbcaaccabcaca" :count 3)
+(re-test '((4 . 8) (4 . 5) (5 . 6)) re "xyabcccc" :count 3)
+(re-test '((4 . 8) (4 . 5)) re "xyabcccc" :count 2)
+(re-test '((4 . 8)) re "xyabcccc" :count 1)
+(re-test nil re "xyabcccc" :count 0)
+
+(setq re (re-comp "(a*b)\\1"))
+(re-test '((3 . 15) (3 . 9)) re "xxxaaaaabaaaaab" :count 2)
+(re-test '((7 . 9) (7 . 8)) re "abaabaxbb" :count 2)
+
+(setq re (re-comp "(ab+c)\\1"))
+(re-test '((3 . 13) (3 . 8)) re "xaaabbbcabbbc" :count 3)
+
+(setq re (re-comp "(ab?c)\\1"))
+(re-test :nomatch re "abcac" :count 2)
+(re-test '((4 . 8) (4 . 6)) re "acabacac" :count 2)
+(re-test '((5 . 11) (5 . 8)) re "abcacabcabc" :count 2)
+(re-test '((3 . 7) (3 . 5)) re "abcacac" :count 2)
+
+(setq re (re-comp "a(.*)b\\1"))
+(re-test '((3 . 5) (4 . 4)) re "xxxab" :count 2)
+(re-test '((4 . 12) (5 . 8)) re "xxxxazzzbzzz" :count 2)
+
+(setq re (re-comp "abc" :icase t))
+(re-test '((0 . 3)) re "AbC")
+
+(setq re (re-comp "[0-9][a-z]+" :icase t))
+(re-test '((3 . 10)) re "xxx0aaZxYT9")
+
+(setq re (re-comp "a.b" :icase t))
+(re-test '((10 . 13)) re "aaaaaaaaaaaxB")
+
+(setq re (re-comp "a.*z" :icase t))
+(re-test '((3 . 9)) re "xxxAaaaaZ")
+(re-test '((2 . 6)) re "xxaaaZaaa")
+
+(setq re (re-comp "\\<(lambda|defun|defmacro)\\>" :icase t))
+(re-test '((5 . 11)) re "    (lambda")
+(re-test '((5 . 11) (5 . 11)) re "    (lambda" :count 2)
+(re-test :nomatch re "lamda defunn deffmacro")
+
+(setq re (re-comp "\\<(nil|t)\\>" :icase t))
+(re-test '((3 . 6)) re "it Nil")
+(re-test '((3 . 6) (3 . 6)) re "it Nil" :count 6)
+(re-test :nomatch re "nilo")
+
+(setq re (re-comp "\\<(begin|end)\\>" :icase t))
+(re-test '((21 . 24) (21 . 24)) re "beginning the ending EnD" :count 7)
+
+(setq re (re-comp "a.*" :newline t))
+(re-test '((0 . 1)) re "a
+aaa")
+(re-test '((3 . 4)) re "xyza
+aa")
+
+(setq re (re-comp "a.+" :newline t))
+(re-test '((2 . 5)) re "a
+aaa")
+(re-test '((5 . 7)) re "xyza
+aa")
+
+(setq re (re-comp "a.?" :newline t))
+(re-test '((0 . 1)) re "a
+aaa")
+(re-test '((3 . 4)) re "xyza
+aa")
+
+(setq re (re-comp "a.*b.*c" :newline t))
+(re-test '((11 . 14)) re "xxaa
+zyacb
+abc")
+(re-test '((6 . 9)) re "xxxab
+abc
+c")
+
+(setq re (re-comp "a.+b.*c" :newline t))
+(re-test '((6 . 10)) re "ab
+bc
+abbc")
+
+(setq re (re-comp "a.?b.*c" :newline t))
+(re-test '((4 . 8)) re "ab
+cabbc
+cc")
+
+(setq re (re-comp "^foo$" :newline t))
+(re-test '((11 . 14)) re "bar
+foobar
+foo")
+(re-test '((0 . 3)) re "foo
+bar
+foo
+bar")
+(re-test '((8 . 11)) re "foo
+bar
+foo
+bar" :notbol t)
+(re-test '((8 . 11)) re "foo
+bar
+foo" :notbol t)
+(re-test :nomatch re "foo
+bar
+foo" :notbol t :noteol t)
+
+(setq re (re-comp "^\\s*#\\s*(define|include)\\s+.+" :newline t))
+(re-test '((8 . 18)) re "#define
+#include x")
+(re-test '((8 . 18) (9 . 16)) re "#define
+#include x" :count 2)
+
+(setq re (re-comp "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"))
+(re-test '((3 . 259)) re "zzzxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxzzz")
+
+(setq re (re-comp "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~"))
+(re-test '((13 . 333)) re "String here: ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890~/")
+
+(setq re (re-comp "(.*)\\D(\\d+)"))
+(re-test '((0 . 6) (0 . 3) (4 . 6)) re "abcW12" :count 3)
+(re-test '((0 . 6) (0 . 3)) re "abcW12" :count 2)
+(re-test '((0 . 6)) re "abcW12" :count 1)
+(re-test nil re "abcW12" :count 0)
+(re-test '((0 . 6) (0 . 3) (4 . 6)) re "abcW12abcW12" :count 3)
+(re-test '((0 . 6) (0 . 3) (4 . 6)) re "abcW12abcW12a" :count 3)
+
+(setq re (re-comp ".*\\d"))
+(re-test '((0 . 2)) re "a1a1a1aaaaaaa")			; minimal match only
+
+(setq re (re-comp "(.*)\\d"))
+(re-test '((0 . 2) (0 . 1)) re "a1a1a1aaaaaaa" :count 2); minimal match only
+
+(setq re (re-comp ".*(\\d)"))
+(re-test '((0 . 2) (1 . 2)) re "a1a1a1aaaaaaa" :count 2); minimal match only
+
+;; XXX this very simple pattern was entering an infinite loop
+;; actually, this pattern is not supported, just test if is not
+;; crashing (not supported because it is not cheap to match variations
+;; of the pattern)
+(setq re (re-comp "(.*a)?"))
+(re-test '((0 . 1)) re "aaaa")		; expected, minimal match
+(re-test '((0 . 1) (0 . 1)) re "aaaa" :count 2)
diff --git a/lisp/test/stream.lsp b/lisp/test/stream.lsp
new file mode 100644
index 0000000..8af4ff6
--- /dev/null
+++ b/lisp/test/stream.lsp
@@ -0,0 +1,807 @@
+;;
+;; Copyright (c) 2002 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/test/stream.lsp,v 1.4 2002/12/10 03:59:04 paulo Exp $
+;;
+
+;; most format tests from the cltl second edition samples
+
+;; basic io/format/pathname/stream tests
+
+(defun do-format-test (error-test expect arguments
+		    &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (apply #'format nil arguments))
+	    (setq error nil)
+	)
+    )
+    (if error-test
+	(or error
+	    (format t "ERROR: no error for (format nil~{ ~S~}), result was ~S~%"
+		arguments result))
+	(if error
+	    (format t "ERROR: (format nil~{ ~S~}) => ~S~%" arguments error-value)
+	    (or (string= result expect)
+		(format t "(format nil~{ ~S~}) => should be ~S not ~S~%"
+		    arguments expect result)))
+    )
+)
+
+(defun format-test (expect &rest arguments)
+    (do-format-test nil expect arguments))
+
+(defun format-error (&rest arguments)
+    (do-format-test t nil arguments))
+
+
+
+(defun compare-test (test expect function arguments
+		     &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (apply function arguments))
+	    (setq error nil)
+	)
+    )
+    (if error
+	(format t "ERROR: (~S~{ ~S~}) => ~S~%" function arguments error-value)
+	(or (funcall test result expect)
+	    (format t "(~S~{ ~S~}) => should be ~S not ~S~%"
+		function arguments expect result
+	    )
+	)
+    )
+)
+
+(defun compare-eval (test expect form
+		     &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (eval form))
+	    (setq error nil)
+	)
+    )
+    (if error
+	(format t "ERROR: ~S => ~S~%" form error-value)
+	(or (funcall test result expect)
+	    (format t "~S => should be ~S not ~S~%"
+		form expect result
+	    )
+	)
+    )
+)
+
+(defun error-test (function &rest arguments &aux result (error t))
+    (ignore-errors
+	(setq result (apply function arguments))
+	(setq error nil)
+    )
+    (or error
+	(format t "ERROR: no error for (~S~{ ~S~}), result was ~S~%"
+	    function arguments result)
+    )
+)
+
+(defun error-eval (form &aux result (error t))
+    (ignore-errors
+	(setq result (eval form))
+	(setq error nil)
+    )
+    (or error
+	(format t "ERROR: no error for ~S, result was ~S~%" form result)
+    )
+)
+
+(defun eq-test (expect function &rest arguments)
+    (compare-test #'eq expect function arguments))
+
+(defun eql-test (expect function &rest arguments)
+    (compare-test #'eql expect function arguments))
+
+(defun equal-test (expect function &rest arguments)
+    (compare-test #'equal expect function arguments))
+
+(defun equalp-test (expect function &rest arguments)
+    (compare-test #'equalp expect function arguments))
+
+(defun eq-eval (expect form)
+    (compare-eval #'eq expect form))
+
+(defun eql-eval (expect form)
+    (compare-eval #'eql expect form))
+
+(defun equal-eval (expect form)
+    (compare-eval #'equal expect form))
+
+(defun equalp-eval (expect form)
+    (compare-eval #'equalp expect form))
+
+(defun bool-test (expect function &rest arguments
+		  &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (apply function arguments))
+	    (setq error nil)
+	)
+    )
+    (if error
+	(format t "ERROR: (~S~{ ~S~}) => ~S~%" function arguments error-value)
+	(or (eq (null result) (null expect))
+	    (format t "(~S~{ ~S~}) => should be ~A not ~A~%"
+		function arguments expect result
+	    )
+	)
+    )
+)
+
+(defun bool-eval (expect form &aux result (error t) unused error-value)
+    (multiple-value-setq
+	(unused error-value)
+	(ignore-errors
+	    (setq result (eval form))
+	    (setq error nil)
+	)
+    )
+    (if error
+	(format t "ERROR: ~S => ~S~%" form error-value)
+	(or (eq (null result) (null expect))
+	    (format t "~S => should be ~A not ~A~%"
+		form expect result
+	    )
+	)
+    )
+)
+
+
+;; format				- function
+
+;; ~c
+(format-test "A" "~C" #\A)
+(format-test " " "~C" #\Space)
+(format-test "A" "~:C" #\A)
+(format-test "Space" "~:C" #\Space)
+(format-test "#\\A" "~@C" #\A)
+(format-test "#\\Space" "~@C" #\Space)
+(format-test " " "~A" #\Space)
+(let ((*print-escape* t)) (format-test " " "~A" #\Space))
+(format-test "#\\Space" "~S" #\Space)
+(let ((*print-escape* nil)) (format-test "#\\Space" "~S" #\Space))
+
+;; ~%
+(format-test "
+" "~%")
+(format-test "
+
+
+" "~3%")
+
+;; ~&
+(format-test "" "~&")
+(format-test "
+" "~2&")
+
+;; ~|
+(format-test "" "~|")
+
+;; ~~
+(format-test "~~~" "~3~")
+
+;; radix
+(format-test "1101" "~,,' ,4:B" 13)
+(format-test "1 0001" "~,,' ,4:B" 17)
+(format-test "1101 0000 0101" "~14,,' ,4:B" 3333)
+(format-test "1 22" "~3,,,' ,2:R" 17)
+(format-test "6|55|35" "~,,'|,2:D" #xFFFF)
+(format-test "1,000,000" "~,,,3:D" 1000000)
+(format-test "one hundred and twenty-three thousand, four hundred and fifty-six"
+	"~R" 123456)
+(format-test "six hundred and fifty-four thousand, three hundred twenty-first"
+	"~:R" 654321)
+(format-test "MCCXXXIV" "~@R" 1234)
+(format-test "MCCXXXXVIIII" "~@:R" 1249)
+(format-test "3039" "~X" 12345)
+(format-test "30071" "~O" 12345)
+(format-test "9IX" "~36R" 12345)
+(format-test "11000000111001" "~B" 12345)
+(format-test "The answer is 5." "The answer is ~D." 5)
+(format-test "The answer is   5." "The answer is ~3D." 5)
+(format-test "The answer is 005." "The answer is ~3,'0D." 5)
+(format-test "1111 1010 1100 1110" "~,,' ,4:B" #xFACE)
+(format-test "1 1100 1110" "~,,' ,4:B" #x1CE)
+(format-test "1111 1010 1100 1110" "~19,,' ,4:B" #xFACE)
+(format-test "        1 1100 1110" "~19,,' ,4:B" #x1CE)
+
+;; 6.37 and 6.38 are correct
+#+xedit (format-test "6.38" "~4,2F" 6.375d0)
+(format-test "10.0" "~,1F" 9.995d0)
+;; 6.37E+2 and 6.38E+2 are correct
+#+xedit (format-test " 6.38E+2" "~8,2E" 637.5)
+(do*
+    (
+    (n '(3.14159 -3.14159 100.0 1234.0 0.006) (cdr n))
+    (r '("  3.14| 31.42|  3.14|3.1416|3.14|3.14159"
+	 " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159"
+	 "100.00|******|100.00| 100.0|100.00|100.0"
+	 "1234.00|******|??????|1234.0|1234.00|1234.0"
+	 "  0.01|  0.06|  0.01| 0.006|0.01|0.006") (cdr r))
+    (x (car n) (car n))
+    )
+    ((endp n))
+    (format-test (car r)
+	"~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" x x x x x x)
+)
+(do*
+    (
+    (n '(3.14159 -3.14159 1100.0 1.1e13 #+xedit 1.1e120) (cdr n))
+    (r '("  3.14E+0| 31.42$-01|+.003E+03|  3.14E+0"
+	 " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0"
+	 "  1.10E+3| 11.00$+02|+.001E+06|  1.10E+3"
+	 "*********| 11.00$+12|+.001E+16| 1.10E+13"
+	 #+xedit
+	 "*********|??????????|%%%%%%%%%|1.10E+120") (cdr r))
+    (x (car n) (car n))
+    )
+    ((endp n))
+    (format-test (car r)
+	"~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" x x x x)
+)
+(do
+    (
+    (k -5 (1+ k))
+    (r '("Scale factor -5: | 0.000003E+06|"
+	 "Scale factor -4: | 0.000031E+05|"
+	 "Scale factor -3: | 0.000314E+04|"
+	 "Scale factor -2: | 0.003142E+03|"
+	 "Scale factor -1: | 0.031416E+02|"
+	 "Scale factor  0: | 0.314159E+01|"
+	 "Scale factor  1: | 3.141590E+00|"
+	 "Scale factor  2: | 31.41590E-01|"
+	 "Scale factor  3: | 314.1590E-02|"
+	 "Scale factor  4: | 3141.590E-03|"
+	 "Scale factor  5: | 31415.90E-04|"
+	 "Scale factor  6: | 314159.0E-05|"
+	 "Scale factor  7: | 3141590.E-06|") (cdr r))
+    )
+    ((endp r))
+    (format-test (car r) "Scale factor ~2D: | ~12,6,2,VE|" k k 3.14159)
+)
+(do*
+    (
+    (n '(0.0314159 0.314159 3.14159 31.4159 314.159 3141.59 3.14E12
+	 #+xedit 3.14d120) (cdr n))
+    (r '("  3.14E-2|314.2$-04|0.314E-01|  3.14E-2"
+         "  0.31   |0.314    |0.314    | 0.31    "
+         "   3.1   | 3.14    | 3.14    |  3.1    "
+         "   31.   | 31.4    | 31.4    |  31.    "
+         "  3.14E+2| 314.    | 314.    |  3.14E+2"
+         "  3.14E+3|314.2$+01|0.314E+04|  3.14E+3"
+         "*********|314.0$+10|0.314E+13| 3.14E+12"
+         #+xedit "*********|?????????|%%%%%%%%%|3.14E+120") (cdr r))
+    (x (car n) (car n))
+    )
+    ((endp n))
+    (format-test (car r) "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G"
+	x x x x)
+)
+(format-test "  1." "~4,0f" 0.5)
+(format-test "  0." "~4,0f" 0.4)
+
+;; ~p
+(setq n 3)
+(format-test "3 items found.""~D item~:P found." n)
+(format-test "three dogs are here." "~R dog~:[s are~; is~] here." n (= n 1))
+(format-test "three dogs are here." "~R dog~:*~[s are~; is~:;s are~] here." n)
+(format-test "Here are three puppies.""Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n)
+(format-test "7 tries/1 win" "~D tr~:@P/~D win~:P" 7 1)
+(format-test "1 try/0 wins" "~D tr~:@P/~D win~:P" 1 0)
+(format-test "1 try/3 wins" "~D tr~:@P/~D win~:P" 1 3)
+
+;; ~t
+(format-test "        foo" "~8Tfoo")
+#+xedit (format-test  "         foo" "~8,3Tfoo")
+(format-test "         foo" "~8,3@Tfoo")
+(format-test "   foo" "~1,3@Tfoo")
+
+;; ~*
+(format-test "2" "~*~D" 1 2 3 4)
+(format-test "4" "~3*~D" 1 2 3 4)
+(format-test "2" "~3*~2:*~D" 1 2 3 4)
+(format-test "4 3 2 1 2 3 4" "~3@*~D ~2@*~D ~1@*~D ~0@*~D ~D ~D ~D" 1 2 3 4)
+
+;; ~?
+(format-test "<Foo 5> 7" "~? ~D" "<~A ~D>" '("Foo" 5) 7)
+(format-test "<Foo 5> 7" "~? ~D" "<~A ~D>" '("Foo" 5 14) 7)
+(format-test "<Foo 5> 7" "~@? ~D" "<~A ~D>" "Foo" 5 7)
+(format-test "<Foo 5> 14" "~@? ~D" "<~A ~D>" "Foo" 5 14 7)
+
+
+(format-error "~:[abc~:@(def~;ghi~:@(jkl~]mno~)" 1)
+(format-error "~?ghi~)" "abc~@(def")
+
+
+;; ~(...~)
+(format-test "XIV xiv" "~@R ~(~@R~)" 14 14)
+(format-test "Zero errors detected." "~@(~R~) error~:P detected." 0)
+(format-test "One error detected." "~@(~R~) error~:P detected." 1)
+(format-test "Twenty-three errors detected." "~@(~R~) error~:P detected." 23)
+
+;; ~[...~]
+(format-test "Persian Cat" "~[Siamese~;Manx~;Persian~] Cat" 2)
+(format-test " Cat" "~[Siamese~;Manx~;Persian~] Cat" 3)
+(format-test "Siamese Cat" "~[Siamese~;Manx~;Persian~] Cat" 0)
+(setq *print-level* nil *print-length* 5)
+(format-test " print length = 5"
+  "~@[ print level = ~D~]~@[ print length = ~D~]" *print-level* *print-length*)
+(setq foo "Items:~#[ none~; ~S~; ~S and ~S~:;~@{ ~#[~;and ~]~S~^,~}~].")
+(format-test "Items: none." foo)
+(format-test "Items: FOO." foo 'foo)
+(format-test "Items: FOO and BAR." foo 'foo 'bar)
+(format-test "Items: FOO, BAR, and BAZ." foo 'foo 'bar 'baz)
+(format-test "Items: FOO, BAR, BAZ, and QUUX." foo 'foo 'bar 'baz 'quux)
+
+;; ~{...~}
+(format-test "The winners are: FRED HARRY JILL."
+  "The winners are:~{ ~S~}." '(fred harry jill))
+(format-test "Pairs: <A,1> <B,2> <C,3>." "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3))
+(format-test "Pairs: <A,1> <B,2> <C,3>."
+  "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3)))
+(format-test "Pairs: <A,1> <B,2> <C,3>."
+  "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3))
+
+;; ~<...~>
+(format-test "foo    bar" "~10<foo~;bar~>")
+(format-test "  foo  bar" "~10:<foo~;bar~>")
+(format-test "  foo bar " "~10:@<foo~;bar~>")
+(format-test "    foobar" "~10<foobar~>")
+(format-test "    foobar" "~10:<foobar~>")
+(format-test "foobar    " "~10@<foobar~>")
+(format-test "  foobar  " "~10:@<foobar~>")
+
+;; ~^
+(setq donestr "Done.~^  ~D warning~:P.~^  ~D error~:P.")
+(format-test "Done." donestr)
+(format-test "Done.  3 warnings." donestr 3)
+(format-test "Done.  1 warning.  5 errors." donestr 1 5)
+(format-test "/HOT .../HAMBURGER/ICE .../FRENCH ..."
+  "~:{/~S~^ ...~}" '((hot dog) (hamburger) (ice cream) (french fries)))
+(format-test "/HOT .../HAMBURGER .../ICE .../FRENCH"
+  "~:{/~S~:^ ...~}" '((hot dog) (hamburger) (ice cream) (french fries)))
+(format-test "/HOT .../HAMBURGER"
+  "~:{/~S~:#^ ...~}" '((hot dog) (hamburger) (ice cream) (french fries)))
+(setq tellstr "~@(~@[~R~]~^ ~A.~)")
+(format-test "Twenty-three" tellstr 23)
+(format-test " Losers." tellstr nil "losers")
+(format-test "Twenty-three losers." tellstr 23 "losers")
+(format-test "            FOO" "~15<~S~;~^~S~;~^~S~>" 'foo)
+(format-test "FOO         BAR" "~15<~S~;~^~S~;~^~S~>" 'foo 'bar)
+(format-test "FOO   BAR   BAZ" "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz)
+
+
+;; make-pathname			- function
+(equal-test #P"/public/games/chess.db"
+    #'make-pathname :directory '(:absolute "public" "games")
+		    :name "chess" :type "db")
+(equal-test #P"/etc/passwd" #'list* #P"/etc/passwd")
+(setq path (make-pathname :directory '(:absolute "public" "games")
+			  :name "chess" :type "db"))
+(eq-test path #'pathname path)
+(eq-test nil #'pathname-host path)
+(eq-test nil #'pathname-device path)
+(equal-test '(:absolute "public" "games") #'pathname-directory path)
+(equal-test "chess" #'pathname-name path)
+(equal-test "db" #'pathname-type path)
+(eq-test nil #'pathname-version path)
+(equal-test #P"/tmp/foo.txt" #'make-pathname :defaults "/tmp/foo.txt")
+
+#+xedit (equal-test #P"/tmp/foo.txt" #'pathname "///tmp///foo.txt")
+;; XXX changed to remove extra separators
+;; (equal-test #P"///tmp///foo.txt" #'pathname "///tmp///foo.txt")
+
+
+;; merge-pathnames			- function
+(equal-test #P"/tmp/foo.txt" #'merge-pathnames "/tmp/foo" "/tmp/foo.txt")
+(equal-test #P"/tmp/foo.txt" #'merge-pathnames "foo" "/tmp/foo.txt")
+(equal-test #P"/tmp/foo/bar.txt" #'merge-pathnames "foo/bar" "/tmp/foo.txt")
+
+;; namestring				- function
+(setq path (merge-pathnames "foo/bar" "/tmp/foo.txt"))
+(equal-test "/tmp/foo/bar.txt" #'namestring path)
+(equal-test "" #'host-namestring path)
+(equal-test "/tmp/foo/" #'directory-namestring path)
+(equal-test "bar.txt" #'file-namestring path)
+(equal-test "/tmp/foo/bar.txt" #'enough-namestring path)
+(equal-test "foo/bar.txt" #'enough-namestring path "/tmp/")
+(equal-test "bar.txt" #'enough-namestring path "/tmp/foo/")
+(equal-test "foo/bar.txt" #'enough-namestring path "/tmp/foo")
+
+;; parse-namestring			- function
+(equal-eval '(#P"foo" 3) '(multiple-value-list (parse-namestring "foo")))
+(equal-eval '(#P"foo" 0) '(multiple-value-list (parse-namestring #P"foo")))
+
+
+
+;; read					- function
+(setq is (make-string-input-stream " foo "))
+(eq-test t #'streamp is)
+(eq-test t #'input-stream-p is)
+(eq-test nil #'output-stream-p is)
+(eq-test 'foo #'read is)
+(eq-test t #'close is)
+(setq is (make-string-input-stream "xfooy" 1 4))
+(eq-test 'foo #'read is)
+(eq-test t #'close is)
+(setq is (make-string-input-stream ""))
+(eq-test nil #'read is nil)
+(eq-test 'end-of-string #'read is nil 'end-of-string)
+(close is)
+(error-test #'read is)
+(error-test #'read is nil)
+(error-test #'read is nil 'end-of-string)
+(eq-test t #'streamp is)
+(eq-test nil #'input-stream-p is)
+(eq-test nil #'streamp "test")
+(error-test #'input-stream-p "test")
+
+;; read-char				- function
+(setq is (make-string-input-stream "0123"))
+(setq test nil)
+(equal-eval '(#\0 #\1 #\2 #\3)
+  '(do ((c (read-char is) (read-char is nil 'the-end)))
+      ((not (characterp c)) test)
+   (setq test (append test (list c)))))
+(close is)
+(setq is (make-string-input-stream "abc"))
+(eql-test #\a #'read-char is)
+(eql-test #\b #'read-char is)
+(eql-test #\c #'read-char is)
+(error-test #'read-char is)
+(eq-test nil #'read-char is nil)
+(eq-test :end-of-string #'read-char is nil :end-of-string)
+(eq-test t #'close is)
+
+;; read-char-no-hang			- function
+(setq is (make-string-input-stream "0123"))
+(setq test nil)
+(equal-eval '(#\0 #\1 #\2 #\3)
+  '(do ((c (read-char-no-hang is) (read-char-no-hang is nil 'the-end)))
+      ((not (characterp c)) test)
+   (setq test (append test (list c)))))
+(close is)
+(setq is (make-string-input-stream "abc"))
+(eql-test #\a #'read-char-no-hang is)
+(eql-test #\b #'read-char-no-hang is)
+(eql-test #\c #'read-char-no-hang is)
+(error-test #'read-char-no-hang is)
+(eq-test nil #'read-char-no-hang is nil)
+(eq-test :end-of-string #'read-char-no-hang is nil :end-of-string)
+(eq-test t #'close is)
+#+(and xedit unix)
+(progn
+    ;; wait one second for input pooling every 0.1 seconds
+    (defun wait-for-cat ()
+	(let ((time 0.0))
+	    (loop
+		(and (listen is) (return))
+		(sleep 0.1)
+		(when (>= (incf time 0.1) 1.0)
+		    (format t "Cat is sleeping~%")
+		    (return)))))
+    (setq is (make-pipe "/bin/cat" :direction :io))
+    (equal-test "dog" #'write-line "dog" is)
+    (wait-for-cat)
+    (eql-test #\d #'read-char-no-hang is)
+    (eql-test #\o #'read-char-no-hang is)
+    (eql-test #\g #'read-char-no-hang is)
+    (eql-test #\Newline #'read-char-no-hang is)
+    (eq-test nil #'read-char-no-hang is)
+    (eq-test nil #'read-char-no-hang is)
+    (equal-test "mouse" #'write-line "mouse" is)
+    (wait-for-cat)
+    (eql-test #\m #'read-char-no-hang is)
+    (eql-test #\o #'read-char-no-hang is)
+    (eql-test #\u #'read-char-no-hang is)
+    (eql-test #\s #'read-char-no-hang is)
+    (eql-test #\e #'read-char-no-hang is)
+    (eql-test #\Newline #'read-char-no-hang is)
+    (eq-test nil #'read-char-no-hang is)
+    (eq-test t #'close is)
+    (error-test #'read-char-no-hang is)
+    (error-test #'read-char-no-hang is nil)
+    (error-test #'read-char-no-hang is nil t)
+)
+
+;; read-from-string			- function
+(equal-eval '(3 5)
+  '(multiple-value-list (read-from-string " 1 3 5" t nil :start 2)))
+(equal-eval '((a b c) 7)
+  '(multiple-value-list (read-from-string "(a b c)")))
+(error-test #'read-from-string "")
+(eq-test nil #'read-from-string "" nil)
+(eq-test 'end-of-file #'read-from-string "" nil 'end-of-file)
+
+;; read-line				- function
+(setq is (make-string-input-stream "line 1
+line 2"))
+(equal-eval '("line 1" nil) '(multiple-value-list (read-line is)))
+(equal-eval '("line 2" t) '(multiple-value-list (read-line is)))
+(error-test #'read-line is)
+(equal-eval '(nil t) '(multiple-value-list (read-line is nil)))
+(equal-eval '(end-of-string t)
+  '(multiple-value-list (read-line is nil 'end-of-string)))
+
+
+;; write				- function
+;; XXX several write options still missing
+(setq os (make-string-output-stream))
+(equal-test '(1 2 3 4) #'write '(1 2 3 4) :stream os)
+(equal-test "(1 2 3 4)" #'get-output-stream-string os)
+(eq-test t #'streamp os)
+(eq-test t #'output-stream-p os)
+(eq-test nil #'input-stream-p os)
+(equal-test '(:foo :bar) #'write '(:foo :bar) :case :downcase :stream os)
+(equal-test "(:foo :bar)" #'get-output-stream-string os)
+(equal-test '(:foo :bar) #'write '(:foo :bar) :case :capitalize :stream os)
+(equal-test "(:Foo :Bar)" #'get-output-stream-string os)
+(equal-test '(:foo :bar) #'write '(:foo :bar) :case :upcase :stream os)
+(equal-test "(:FOO :BAR)" #'get-output-stream-string os)
+(equal-test '(foo bar baz) #'write '(foo bar baz) :length 2 :stream os)
+(equal-test "(FOO BAR ...)" #'get-output-stream-string os)
+(equal-test '(foo (bar) baz) #'write '(foo (bar) baz) :level 1 :stream os)
+(equal-test "(FOO # BAZ)" #'get-output-stream-string os)
+(setq circle '#1=(1 #1#))
+(eq-test circle #'write circle :circle t :stream os)
+(equal-test "#1=(1 #1#)" #'get-output-stream-string os)
+(eql-test #\Space #'write #\Space :stream os)
+(equal-test "#\\Space" #'get-output-stream-string os)
+(eql-test #\Space #'write #\Space :escape nil :stream os)
+(equal-test " " #'get-output-stream-string os)
+(eq-test t #'close os)
+(eq-test nil #'output-stream-p os)
+(error-test #'output-stream-p "test")
+(error-test #'write 'foo :stream "bar")
+
+;; fresh-line				- function
+(setq os (make-string-output-stream))
+(equal-test "some text" #'write-string "some text" os)
+(eq-test t #'fresh-line os)
+(eq-test nil #'fresh-line os)
+(equal-test "more text" #'write-string "more text" os)
+(equal-test "some text
+more text" #'get-output-stream-string os)
+(equal-test nil #'fresh-line os)
+(equal-test nil #'fresh-line os)
+(equal-test "" #'get-output-stream-string os)
+(close os)
+(error-test #'fresh-line 1)
+
+;; prin1				- function
+;;  (prin1 object stream) ==
+;;	(write object :stream stream :escape t)
+(setq p-os (make-string-output-stream) w-os (make-string-output-stream))
+(dolist (object (list #\a 1 "string" 2.5d0 '(a . b) '(a b c) #P"foo"
+		     *package* *standard-input* #c(1 2) #(1 2 3)
+		     (make-hash-table)))
+    (eq-test object #'prin1 object p-os)
+    (eq-test object #'write object :stream w-os :escape t)
+    (equal-test (get-output-stream-string p-os)
+	#'get-output-stream-string w-os))
+(close p-os)
+(close w-os)
+(error-test #'prin1 1 1)
+
+;; princ				- function
+;;  (princ object stream) ==
+;;	(write object :stream stream :escape nil :readably nil)
+;; XXX readably not yet implemented
+(setq p-os (make-string-output-stream) w-os (make-string-output-stream))
+(dolist (object (list #\a 1 "string" 2.5d0 '(a . b) '(a b c) #P"foo"
+		     *package* *standard-input* #c(1 2) #(1 2 3)
+		     (make-hash-table)))
+    (eq-test object #'princ object p-os)
+    (eq-test object #'write object :stream w-os :escape nil)
+    (equal-test (get-output-stream-string p-os)
+	#'get-output-stream-string w-os))
+(close p-os)
+(close w-os)
+(error-test #'princ 1 1)
+
+;; print				- function
+;;  (print object stream) ==
+;;	(progn
+;;	    (terpri stream)
+;;	    (write object :stream stream :escape t)
+;;	    (write-char #\Space stream))
+(setq p-os (make-string-output-stream) w-os (make-string-output-stream))
+(dolist (object (list #\a 1 "string" 2.5d0 '(a . b) '(a b c) #P"foo"
+		     *package* *standard-input* #c(1 2) #(1 2 3)
+		     (make-hash-table)))
+    (eq-test object #'print object p-os)
+    (progn
+	(eq-test nil #'terpri w-os)
+	(eq-test object #'write object :stream w-os :escape t)
+	(eql-test #\Space #'write-char #\Space w-os))
+    (equal-test (get-output-stream-string p-os)
+	#'get-output-stream-string w-os))
+(close p-os)
+(close w-os)
+(error-test #'print 1 1)
+
+;; terpri				- function
+(setq os (make-string-output-stream))
+(equal-test "some text" #'write-string "some text" os)
+(eq-test nil #'terpri os)
+(eq-test nil #'terpri os)
+(equal-test "more text" #'write-string "more text" os)
+(equal-test "some text
+
+more text" #'get-output-stream-string os)
+(equal-test nil #'terpri os)
+(equal-test nil #'terpri os)
+(equal-test "
+
+" #'get-output-stream-string os)
+(close os)
+(error-test #'terpri 1)
+
+;; write-char				- function
+(equal-eval "a b"
+    '(with-output-to-string (s) 
+	(write-char #\a s)
+	(write-char #\Space s)
+	(write-char #\b s)))
+(error-test #'write-char 1)
+
+;; write-line				- function
+(setq os (make-string-output-stream))
+(equal-test "text" #'write-line "text" os)
+(equal-test "text
+" #'get-output-stream-string os)
+(eql-test #\< #'write-char #\< os)
+(equal-test "text" #'write-line "text" os :start 1 :end 3)
+(eql-test #\> #'write-char #\> os)
+(equal-test "<ex
+>" #'get-output-stream-string os)
+(error-test #'write-line 1)
+(close os)
+
+;; write-string				- function
+(setq os (make-string-output-stream))
+(equal-test "text" #'write-string "text" os)
+(equal-test "text" #'get-output-stream-string os)
+(eql-test #\< #'write-char #\< os)
+(equal-test "text" #'write-string "text" os :start 1 :end 3)
+(eql-test #\> #'write-char #\> os)
+(equal-test "<ex>" #'get-output-stream-string os)
+(error-test #'write-string #\a)
+(close os)
+
+
+;; open					- function
+(setq name #P"delete-me.text")
+(bool-eval t '(setq file (open name :direction :output)))
+(equal-test "some text" #'write-line "some text" file)
+(close file)
+(equal-test "delete-me.text" #'file-namestring (truename name))
+(setq file (open name :direction :output :if-exists :rename))
+(equal-test "other text" #'write-line "other text" file)
+(close file)
+(equal-test "delete-me.text" #'file-namestring (truename name))
+;; Clisp returns the pathname if the file exists
+#+xedit (eq-test t #'delete-file name)
+#+clisp (bool-test t #'delete-file name)
+(setq backup
+	#+xedit "delete-me.text~"
+	#+clisp "delete-me.text%"
+	#+cmu "delete-me.text.BAK")
+(bool-test t #'delete-file backup)
+(eq-test nil #'delete-file name)
+(eq-test nil #'directory name)
+(eq-test nil #'directory backup)
+;; test append
+(with-open-file (s name :direction :output :if-exists :error)
+    (write-line "line 1" s))
+(with-open-file (s name :direction :output :if-exists :append)
+    (write-line "line 2" s))
+(with-open-file (s name :direction :input)
+    (equal-test "line 1" #'read-line s)
+    (equal-test "line 2" #'read-line s)
+    (eq-test 'eof #'read-line s nil 'eof)
+)
+(bool-test t #'delete-file name)
+;; test overwrite
+(with-open-file (s name :direction :output :if-exists :error)
+    (write-line "overwrite-me" s))
+(with-open-file (s name :direction :output :if-exists :overwrite)
+    (write-line "some-text" s))
+(with-open-file (s name :direction :input)
+    (equal-test "some-text" #'read-line s)
+    (eq-test 'eof #'read-line s nil 'eof))
+;; test check for file existence
+(eq-test nil #'open name :direction :output :if-exists nil)
+(error-test #'open name :direction :output :if-exists :error)
+(bool-test t #'delete-file name)
+;; test check for no file existence
+(eq-test nil #'open name :direction :output :if-does-not-exist nil)
+(error-test #'open name :direction :output :if-does-not-exist :error)
+#+xedit	;; test io -- not sure if this is the expected behaviour
+(progn
+    (with-open-file (s name :direction :io)
+	(write-line "foo" s)
+	(write-line "bar" s))
+    (with-open-file (s name :direction :io :if-exists :append)
+	(equal-test "foo" #'read-line s)
+	(equal-test "bar" #'read-line s)
+	(eq-test 'eof #'read-line s nil 'eof)
+	(write-line "baz" s))
+    (with-open-file (s name :direction :io :if-exists :append)
+	(equal-test "foo" #'read-line s)
+	(equal-test "bar" #'read-line s)
+	(equal-test "baz" #'read-line s)
+	(eq-test 'eof #'read-line s nil 'eof))
+    (bool-test t #'delete-file name)
+)
+
+;; delete-file				- function
+(eq-eval nil
+    '(with-open-file (s "delete-me.text" :direction :output :if-exists :error)))
+(eq-test t #'pathnamep (setq p (probe-file "delete-me.text")))
+(bool-test t #'delete-file p)
+(eq-test nil #'probe-file "delete-me.text")
+(bool-eval t
+    '(with-open-file (s "delete-me.text" :direction :output :if-exists :error)
+       (delete-file s)))
+(bool-test nil #'probe-file "delete-me.text")
+
+;; rename-file				- function
+(setq name "foo.bar")
+(bool-eval t '(setq file (open name :direction :output :if-exists :error)))
+(eq-test t #'close file)
+(setq result (multiple-value-list (rename-file name "bar.foo")))
+(eql-test 3 #'length result)
+(eq-test t #'pathnamep (first result))
+(eq-test t #'pathnamep (second result))
+(eq-test t #'pathnamep (third result))
+(equal-test (third result) #'truename "bar.foo")
+(eq-test nil #'directory name)
+(eq-test nil #'directory (second result))
+(equal-test (list (third result)) #'directory (third result))
+(error-test #'truename name)
+(error-test #'truename (second result))
+(eq-test nil #'probe-file name)
+(bool-test t #'probe-file (first result))
+(eq-test nil #'probe-file (second result))
+(bool-test t #'probe-file (third result))
+(bool-test t #'delete-file "bar.foo")
+(eq-test nil #'delete-file (third result))
+(eq-test nil #'delete-file (second result))
diff --git a/lisp/test/widgets.lsp b/lisp/test/widgets.lsp
new file mode 100644
index 0000000..be68788
--- /dev/null
+++ b/lisp/test/widgets.lsp
@@ -0,0 +1,71 @@
+;;
+;; Copyright (c) 2001 by The XFree86 Project, Inc.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the "Software"),
+;; to deal in the Software without restriction, including without limitation
+;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;; and/or sell copies of the Software, and to permit persons to whom the
+;; Software is furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;  
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+;; THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+;; OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+;;
+;; Except as contained in this notice, the name of the XFree86 Project shall
+;; not be used in advertising or otherwise to promote the sale, use or other
+;; dealings in this Software without prior written authorization from the
+;; XFree86 Project.
+;;
+;; Author: Paulo César Pereira de Andrade
+;;
+;;
+;; $XFree86: xc/programs/xedit/lisp/test/widgets.lsp,v 1.3 2002/11/08 08:01:01 paulo Exp $
+;;
+(require "xaw")
+(require "xt")
+
+(defun quit-callback (widget user call) (quit))
+
+(setq toplevel
+    (xt-app-initialize 'appcontext "Widgets"
+	'(("title" . "Widgets (without customization)"))))
+
+(setq vpane
+    (xt-create-managed-widget "vpane" paned-widget-class toplevel))
+(setq form
+    (xt-create-managed-widget "form" form-widget-class vpane))
+(xt-create-managed-widget "command" command-widget-class form
+    '(("label" . "Command Widget")))
+(xt-create-managed-widget "label" label-widget-class form
+    '(("label" . "Label Widget") ("fromVert" . "command")))
+(xt-create-managed-widget "button" menu-button-widget-class form
+    '(("label" . "MenuButton Widget") ("fromVert" . "label")))
+
+(setq popup
+    (xt-create-managed-widget "menu" simple-menu-widget-class toplevel))
+(xt-create-managed-widget "smebsb" sme-bsb-object-class popup
+    '(("label" . "SmeBSB Object")))
+(xt-create-managed-widget "smeline" sme-line-object-class popup)
+(xt-create-managed-widget "smebsb2" sme-bsb-object-class popup
+    '(("label" . "SmeBSB Object two")))
+
+(xt-create-managed-widget "toggle" toggle-widget-class form
+    '(("label" . "Toggle Widget") ("fromVert" . "button")))
+(xt-create-managed-widget "repeater" repeater-widget-class form
+    '(("label" . "Repeater Widget") ("fromVert" . "toggle")))
+
+(setq quit
+    (xt-create-managed-widget "quit" command-widget-class vpane
+	'(("label" . "Quit"))))
+(xt-add-callback quit "callback" 'quit-callback)
+
+(xt-realize-widget toplevel)
+(xt-app-main-loop appcontext)
diff --git a/lisp/time.c b/lisp/time.c
new file mode 100644
index 0000000..3c21d00
--- /dev/null
+++ b/lisp/time.c
@@ -0,0 +1,138 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/time.c,v 1.7 2002/11/08 08:00:57 paulo Exp $ */
+
+#include "time.h"
+#include "bytecode.h"
+
+/*
+ * Implementation
+*/
+LispObj *
+Lisp_Time(LispBuiltin *builtin)
+/*
+ time form
+ */
+{
+    struct itimerval real, virt, prof;
+    unsigned long count;
+    long sec, usec;
+    LispObj *result;
+#define MONTH	60 * 60 * 31
+
+    LispObj *form;
+
+    form = ARGUMENT(0);
+
+    real.it_value.tv_sec =
+	virt.it_value.tv_sec =
+	prof.it_value.tv_sec =
+	real.it_interval.tv_sec =
+	virt.it_interval.tv_sec =
+	prof.it_interval.tv_sec = MONTH;
+    real.it_value.tv_usec =
+	virt.it_value.tv_usec =
+	prof.it_value.tv_usec =
+	real.it_interval.tv_usec =
+	virt.it_interval.tv_usec =
+	prof.it_interval.tv_usec = 0;
+
+    setitimer(ITIMER_REAL, &real, NULL);
+    setitimer(ITIMER_VIRTUAL, &virt, NULL);
+    setitimer(ITIMER_PROF, &prof, NULL);
+
+    getitimer(ITIMER_REAL, &real);
+    getitimer(ITIMER_VIRTUAL, &virt);
+    getitimer(ITIMER_PROF, &prof);
+
+    lisp__data.gc.gctime = 0;
+    lisp__data.gc.timebits = 1;
+
+    count = lisp__data.gc.count;
+
+#if 0
+    form = CONS(form, NIL);
+    COD = CONS(form, COD);
+    result = LispExecuteBytecode(LispCompileForm(form));
+#else
+    result = EVAL(form);
+#endif
+
+    getitimer(ITIMER_REAL, &real);
+    getitimer(ITIMER_VIRTUAL, &virt);
+    getitimer(ITIMER_PROF, &prof);
+
+    sec = real.it_interval.tv_sec - real.it_value.tv_sec;
+    usec = real.it_interval.tv_usec - real.it_value.tv_usec;
+    if (usec < 0) {
+	--sec;
+	usec += 1000000;
+    }
+    LispMessage("Real time   : %g sec", sec + usec / 1000000.0);
+
+    sec = virt.it_interval.tv_sec - virt.it_value.tv_sec;
+    usec = virt.it_interval.tv_usec - virt.it_value.tv_usec + 10000;
+    if (usec < 0) {
+	--sec;
+	usec += 1000000;
+    }
+    LispMessage("Virtual time: %g sec", sec + usec / 1000000.0);
+
+    sec = prof.it_interval.tv_sec - prof.it_value.tv_sec;
+    usec = prof.it_interval.tv_usec - prof.it_value.tv_usec + 10000;
+    if (usec < 0) {
+	--sec;
+	usec += 1000000;
+    }
+    LispMessage("Profile time: %g sec", sec + usec / 1000000.0);
+
+    real.it_value.tv_sec =
+	virt.it_value.tv_sec =
+	prof.it_value.tv_sec =
+	real.it_interval.tv_sec =
+	virt.it_interval.tv_sec =
+	prof.it_interval.tv_sec =
+	real.it_value.tv_usec =
+	virt.it_value.tv_usec =
+	prof.it_value.tv_usec =
+	real.it_interval.tv_usec =
+	virt.it_interval.tv_usec =
+	prof.it_interval.tv_usec = 0;
+
+    setitimer(ITIMER_REAL, &real, NULL);
+    setitimer(ITIMER_VIRTUAL, &virt, NULL);
+    setitimer(ITIMER_PROF, &prof, NULL);
+
+    LispMessage("GC: %ld times, %g sec",
+		lisp__data.gc.count - count, lisp__data.gc.gctime / 1000000.0);
+    lisp__data.gc.timebits = 0;
+
+    return (result);
+}
diff --git a/lisp/time.h b/lisp/time.h
new file mode 100644
index 0000000..3d07916
--- /dev/null
+++ b/lisp/time.h
@@ -0,0 +1,39 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/time.h,v 1.3 2002/11/08 08:00:57 paulo Exp $ */
+
+#ifndef Lisp_time_h
+#define Lisp_time_h
+
+#include "private.h"
+
+LispObj *Lisp_Time(LispBuiltin*);
+
+#endif /* Lisp_time_h */
diff --git a/lisp/write.c b/lisp/write.c
new file mode 100644
index 0000000..4952119
--- /dev/null
+++ b/lisp/write.c
@@ -0,0 +1,2411 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/write.c,v 1.30 2002/12/04 18:43:19 paulo Exp $ */
+
+#include "write.h"
+#include "hash.h"
+#include <math.h>
+#include <ctype.h>
+
+#define	FLOAT_PREC	17
+
+#define UPCASE		0
+#define DOWNCASE	1
+#define CAPITALIZE	2
+
+#define INCDEPTH()							\
+    if (++info->depth > MAX_STACK_DEPTH / 2)				\
+	LispDestroy("stack overflow")
+#define DECDEPTH()	--info->depth
+
+/*
+ * Types
+ */
+typedef struct _circle_info {
+    long circle_nth;		/* nth circular list */
+    LispObj *object;		/* the circular object */
+} circle_info;
+
+typedef struct _write_info {
+    long depth;
+    long level;			/* current level */
+    long length;		/* current length */
+    long print_level;		/* *print-level* when started printing */
+    long print_length;		/* *print-length* when started printing */
+
+    int print_escape;
+    int print_case;
+
+    long circle_count;
+    /* used while building circle info */
+    LispObj **objects;
+    long num_objects;
+    /* the circular lists */
+    circle_info *circles;
+    long num_circles;
+} write_info;
+
+/*
+ * Prototypes
+ */
+static void check_stream(LispObj*, LispFile**, LispString**, int);
+static void parse_double(char*, int*, double, int);
+static int float_string_inc(char*, int);
+static void format_integer(char*, long, int);
+static int LispWriteCPointer(LispObj*, void*);
+static int LispWriteCString(LispObj*, char*, long, write_info*);
+static int LispDoFormatExponentialFloat(LispObj*, LispObj*,
+					int, int, int*, int, int,
+					int, int, int, int);
+
+static int LispWriteInteger(LispObj*, LispObj*);
+static int LispWriteCharacter(LispObj*, LispObj*, write_info*);
+static int LispWriteString(LispObj*, LispObj*, write_info*);
+static int LispWriteFloat(LispObj*, LispObj*);
+static int LispWriteAtom(LispObj*, LispObj*, write_info*);
+static int LispDoWriteAtom(LispObj*, char*, int, int);
+static int LispWriteList(LispObj*, LispObj*, write_info*, int);
+static int LispWriteArray(LispObj*, LispObj*, write_info*);
+static int LispWriteStruct(LispObj*, LispObj*, write_info*);
+static int LispDoWriteObject(LispObj*, LispObj*, write_info*, int);
+static void LispBuildCircle(LispObj*, write_info*);
+static void LispDoBuildCircle(LispObj*, write_info*);
+static long LispCheckCircle(LispObj*, write_info*);
+static int LispPrintCircle(LispObj*, LispObj*, long, int*, write_info*);
+static int LispWriteAlist(LispObj*, LispArgList*, write_info*);
+
+/*
+ * Initialization
+ */
+LispObj *Oprint_level, *Oprint_length, *Oprint_circle,
+	*Oprint_escape, *Oprint_case;
+LispObj *Kupcase, *Kdowncase, *Kcapitalize;
+
+/*
+ * Implementation
+ */
+void
+LispWriteInit(void)
+{
+    Oprint_level	= STATIC_ATOM("*PRINT-LEVEL*");
+    LispProclaimSpecial(Oprint_level, NIL, NIL);
+    LispExportSymbol(Oprint_level);
+
+    Oprint_length	= STATIC_ATOM("*PRINT-LENGTH*");
+    LispProclaimSpecial(Oprint_length, NIL, NIL);
+    LispExportSymbol(Oprint_length);
+
+    Oprint_circle	= STATIC_ATOM("*PRINT-CIRCLE*");
+    LispProclaimSpecial(Oprint_circle, T, NIL);
+    LispExportSymbol(Oprint_circle);
+
+    Oprint_escape	= STATIC_ATOM("*PRINT-ESCAPE*");
+    LispProclaimSpecial(Oprint_escape, T, NIL);
+    LispExportSymbol(Oprint_escape);
+
+    Kupcase		= KEYWORD("UPCASE");
+    Kdowncase		= KEYWORD("DOWNCASE");
+    Kcapitalize		= KEYWORD("CAPITALIZE");
+    Oprint_case		= STATIC_ATOM("*PRINT-CASE*");
+    LispProclaimSpecial(Oprint_case, Kupcase, NIL);
+    LispExportSymbol(Oprint_case);
+}
+
+LispObj *
+Lisp_FreshLine(LispBuiltin *builtin)
+/*
+ fresh-line &optional output-stream
+ */
+{
+    LispObj *output_stream;
+
+    output_stream = ARGUMENT(0);
+
+    if (output_stream == UNSPEC)
+	output_stream = NIL;
+    else if (output_stream != NIL) {
+	CHECK_STREAM(output_stream);
+    }
+    if (LispGetColumn(output_stream)) {
+	LispWriteChar(output_stream, '\n');
+	if (output_stream == NIL ||
+	    (output_stream->data.stream.type == LispStreamStandard &&
+	     output_stream->data.stream.source.file == Stdout))
+	    LispFflush(Stdout);
+	return (T);
+    }
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Prin1(LispBuiltin *builtin)
+/*
+ prin1 object &optional output-stream
+ */
+{
+    LispObj *object, *output_stream;
+
+    output_stream = ARGUMENT(1);
+    object = ARGUMENT(0);
+
+    if (output_stream == UNSPEC)
+	output_stream = NIL;
+    LispPrint(object, output_stream, 0);
+
+    return (object);
+}
+
+LispObj *
+Lisp_Princ(LispBuiltin *builtin)
+/*
+ princ object &optional output-stream
+ */
+{
+    int head;
+    LispObj *object, *output_stream;
+
+    output_stream = ARGUMENT(1);
+    object = ARGUMENT(0);
+
+    if (output_stream == UNSPEC)
+	output_stream = NIL;
+    head = lisp__data.env.length;
+    LispAddVar(Oprint_escape, NIL);
+    ++lisp__data.env.head;
+    LispPrint(object, output_stream, 0);
+    lisp__data.env.head = lisp__data.env.length = head;
+
+    return (object);
+}
+
+LispObj *
+Lisp_Print(LispBuiltin *builtin)
+/*
+ print object &optional output-stream
+ */
+{
+    LispObj *object, *output_stream;
+
+    output_stream = ARGUMENT(1);
+    object = ARGUMENT(0);
+
+    if (output_stream == UNSPEC)
+	output_stream = NIL;
+    LispWriteChar(output_stream, '\n');
+    LispPrint(object, output_stream, 0);
+    LispWriteChar(output_stream, ' ');
+
+    return (object);
+}
+
+LispObj *
+Lisp_Terpri(LispBuiltin *builtin)
+/*
+ terpri &optional output-stream
+ */
+{
+    LispObj *output_stream;
+
+    output_stream = ARGUMENT(0);
+
+    if (output_stream == UNSPEC)
+	output_stream = NIL;
+    else if (output_stream != NIL) {
+	CHECK_STREAM(output_stream);
+    }
+    LispWriteChar(output_stream, '\n');
+    if (output_stream == NIL ||
+	(output_stream->data.stream.type == LispStreamStandard &&
+	 output_stream->data.stream.source.file == Stdout))
+	LispFflush(Stdout);
+
+    return (NIL);
+}
+
+LispObj *
+Lisp_Write(LispBuiltin *builtin)
+/*
+ write object &key case circle escape length level lines pretty readably right-margin stream
+ */
+{
+    int head = lisp__data.env.length;
+
+    LispObj *object, *ocase, *circle, *escape, *length, *level,
+	    *lines, *pretty, *readably, *right_margin, *stream;
+
+    stream = ARGUMENT(10);
+    right_margin = ARGUMENT(9);		/* yet unused */
+    readably = ARGUMENT(8);		/* yet unused */
+    pretty = ARGUMENT(7);		/* yet unused */
+    lines = ARGUMENT(6);		/* yet unused */
+    level = ARGUMENT(5);
+    length = ARGUMENT(4);
+    escape = ARGUMENT(3);
+    circle = ARGUMENT(2);
+    ocase = ARGUMENT(1);
+    object = ARGUMENT(0);
+
+    if (stream == UNSPEC)
+	stream = NIL;
+    else if (stream != NIL) {
+	CHECK_STREAM(stream);
+    }
+
+    /* prepare the printer environment */
+    if (circle != UNSPEC)
+	LispAddVar(Oprint_circle, circle);
+    if (length != UNSPEC)
+	LispAddVar(Oprint_length, length);
+    if (level != UNSPEC)
+	LispAddVar(Oprint_level, level);
+    if (ocase != UNSPEC)
+	LispAddVar(Oprint_case, ocase);
+    if (escape != UNSPEC)
+	LispAddVar(Oprint_escape, escape);
+
+    lisp__data.env.head = lisp__data.env.length;
+
+    (void)LispWriteObject(stream, object);
+
+    lisp__data.env.head = lisp__data.env.length = head;
+
+    return (object);
+}
+
+LispObj *
+Lisp_WriteChar(LispBuiltin *builtin)
+/*
+ write-char character &optional output-stream
+ */
+{
+    int ch;
+
+    LispObj *character, *output_stream;
+
+    output_stream = ARGUMENT(1);
+    character = ARGUMENT(0);
+
+    if (output_stream == UNSPEC)
+	output_stream = NIL;
+    CHECK_SCHAR(character);
+    ch = SCHAR_VALUE(character);
+
+    LispWriteChar(output_stream, ch);
+
+    return (character);
+}
+
+LispObj *
+Lisp_WriteLine(LispBuiltin *builtin)
+/*
+ write-line string &optional output-stream &key start end
+ */
+{
+    return (LispWriteString_(builtin, 1));
+}
+
+LispObj *
+Lisp_WriteString(LispBuiltin *builtin)
+/*
+ write-string string &optional output-stream &key start end
+ */
+{
+    return (LispWriteString_(builtin, 0));
+}
+
+
+int
+LispWriteObject(LispObj *stream, LispObj *object)
+{
+    write_info info;
+    int bytes;
+    LispObj *level, *length, *circle, *oescape, *ocase;
+
+    /* current state */
+    info.depth = info.level = info.length = 0;
+
+    /* maximum level to descend */
+    level = LispGetVar(Oprint_level);
+    if (level && INDEXP(level))
+	info.print_level = FIXNUM_VALUE(level);
+    else
+	info.print_level = -1;
+
+    /* maximum list length */
+    length = LispGetVar(Oprint_length);
+    if (length && INDEXP(length))
+	info.print_length = FIXNUM_VALUE(length);
+    else
+	info.print_length = -1;
+
+    /* detect circular/shared objects? */
+    circle = LispGetVar(Oprint_circle);
+    info.circle_count = 0;
+    info.objects = NULL;
+    info.num_objects = 0;
+    info.circles = NULL;
+    info.num_circles = 0;
+    if (circle && circle != NIL) {
+	LispBuildCircle(object, &info);
+	/* free this data now */
+	if (info.num_objects) {
+	    LispFree(info.objects);
+	    info.num_objects = 0;
+	}
+    }
+
+    /* escape characters and strings? */
+    oescape = LispGetVar(Oprint_escape);
+    if (oescape != NULL)
+	info.print_escape = oescape == NIL;
+    else
+	info.print_escape = -1;
+
+    /* don't use the default case printing? */
+    ocase = LispGetVar(Oprint_case);
+    if (ocase == Kdowncase)
+	info.print_case = DOWNCASE;
+    else if (ocase == Kcapitalize)
+	info.print_case = CAPITALIZE;
+    else
+	info.print_case = UPCASE;
+
+    bytes = LispDoWriteObject(stream, object, &info, 1);
+    if (circle && circle != NIL && info.num_circles)
+	LispFree(info.circles);
+
+    return (bytes);
+}
+
+static void
+LispBuildCircle(LispObj *object, write_info *info)
+{
+    LispObj *list;
+
+    switch (OBJECT_TYPE(object)) {
+	case LispCons_t:
+	    LispDoBuildCircle(object, info);
+	    break;
+	case LispArray_t:
+	    /* Currently arrays are implemented as lists, but only
+	     * the elements could/should be circular */
+	    if (LispCheckCircle(object, info) >= 0)
+		return;
+	    LispDoBuildCircle(object, info);
+	    for (list = object->data.array.list;
+		 CONSP(list); list = CDR(list))
+		LispBuildCircle(CAR(list), info);
+	    break;
+	case LispStruct_t:
+	    /* Like arrays, structs are currently implemented as lists,
+	     * but only the elements could/should be circular */
+	    if (LispCheckCircle(object, info) >= 0)
+		return;
+	    LispDoBuildCircle(object, info);
+	    for (list = object->data.struc.fields;
+		 CONSP(list); list = CDR(list))
+		LispBuildCircle(CAR(list), info);
+	    break;
+	case LispQuote_t:
+	case LispBackquote_t:
+	case LispFunctionQuote_t:
+	    LispDoBuildCircle(object, info);
+	    LispBuildCircle(object->data.quote, info);
+	    break;
+	case LispComma_t:
+	    LispDoBuildCircle(object, info);
+	    LispBuildCircle(object->data.comma.eval, info);
+	    break;
+	case LispLambda_t:
+	    /* Circularity in a function body should fail elsewhere... */
+	    if (LispCheckCircle(object, info) >= 0)
+		return;
+	    LispDoBuildCircle(object, info);
+	    LispBuildCircle(object->data.lambda.code, info);
+	    break;
+	default:
+	    break;
+    }
+}
+
+static void
+LispDoBuildCircle(LispObj *object, write_info *info)
+{
+    long i;
+
+    if (LispCheckCircle(object, info) >= 0)
+	return;
+
+    for (i = 0; i < info->num_objects; i++)
+	if (info->objects[i] == object) {
+	    /* circularity found */
+	    info->circles = LispRealloc(info->circles, sizeof(circle_info) *
+					(info->num_circles + 1));
+	    info->circles[info->num_circles].circle_nth = 0;
+	    info->circles[info->num_circles].object = object;
+	    ++info->num_circles;
+	    return;
+	}
+
+    /* object pointer not yet recorded */
+    if ((i % 16) == 0)
+	info->objects = LispRealloc(info->objects, sizeof(LispObj*) *
+				    (info->num_objects + 16));
+    info->objects[info->num_objects++] = object;
+
+    if (CONSP(object)) {
+	if (CONSP(CAR(object)))
+	    LispDoBuildCircle(CAR(object), info);
+	else
+	    LispBuildCircle(CAR(object), info);
+	if (CONSP(CDR(object)))
+	    LispDoBuildCircle(CDR(object), info);
+	else
+	    LispBuildCircle(CDR(object), info);
+    }
+}
+
+static long
+LispCheckCircle(LispObj *object, write_info *info)
+{
+    long i;
+
+    for (i = 0; i < info->num_circles; i++)
+	if (info->circles[i].object == object)
+	    return (i);
+
+    return (-1);
+}
+
+static int
+LispPrintCircle(LispObj *stream, LispObj *object, long circle,
+		int *length, write_info *info)
+{
+    char stk[32];
+
+    if (!info->circles[circle].circle_nth) {
+	sprintf(stk, "#%ld=", ++info->circle_count);
+	*length += LispWriteStr(stream, stk, strlen(stk));
+	info->circles[circle].circle_nth = info->circle_count;
+
+	return (1);
+    }
+    sprintf(stk, "#%ld#", info->circles[circle].circle_nth);
+    *length += LispWriteStr(stream, stk, strlen(stk));
+
+    return (0);
+}
+
+static int
+LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info)
+{
+    char *name;
+    int i, length = 0, need_space = 0;
+
+#define WRITE_ATOM(object)						\
+    name = ATOMID(object);						\
+    length += LispDoWriteAtom(stream, name, strlen(name),		\
+			      info->print_case)
+#define WRITE_STRING(string)						\
+    length += LispDoWriteAtom(stream, string, strlen(string),		\
+			      info->print_case)
+#define WRITE_OBJECT(object)						\
+    length += LispDoWriteObject(stream, object, info, 1)
+#define WRITE_OPAREN()							\
+    length += LispWriteChar(stream, '(')
+#define WRITE_SPACE()							\
+    length += LispWriteChar(stream, ' ')
+#define WRITE_CPAREN()							\
+    length += LispWriteChar(stream, ')')
+
+    WRITE_OPAREN();
+    for (i = 0; i < alist->normals.num_symbols; i++) {
+	WRITE_ATOM(alist->normals.symbols[i]);
+	if (i + 1 < alist->normals.num_symbols)
+	    WRITE_SPACE();
+	else
+	    need_space = 1;
+    }
+    if (alist->optionals.num_symbols) {
+	if (need_space)
+	    WRITE_SPACE();
+	WRITE_STRING(Soptional);
+	WRITE_SPACE();
+	for (i = 0; i < alist->optionals.num_symbols; i++) {
+	    WRITE_OPAREN();
+	    WRITE_ATOM(alist->optionals.symbols[i]);
+	    WRITE_SPACE();
+	    WRITE_OBJECT(alist->optionals.defaults[i]);
+	    if (alist->optionals.sforms[i]) {
+		WRITE_SPACE();
+		WRITE_ATOM(alist->optionals.sforms[i]);
+	    }
+	    WRITE_CPAREN();
+	    if (i + 1 < alist->optionals.num_symbols)
+		WRITE_SPACE();
+	}
+	need_space = 1;
+    }
+    if (alist->keys.num_symbols) {
+	if (need_space)
+	    WRITE_SPACE();
+	length += LispDoWriteAtom(stream, Skey, 4, info->print_case);
+	WRITE_SPACE();
+	for (i = 0; i < alist->keys.num_symbols; i++) {
+	    WRITE_OPAREN();
+	    if (alist->keys.keys[i]) {
+		WRITE_OPAREN();
+		WRITE_ATOM(alist->keys.keys[i]);
+		WRITE_SPACE();
+	    }
+	    WRITE_ATOM(alist->keys.symbols[i]);
+	    if (alist->keys.keys[i])
+		WRITE_CPAREN();
+	    WRITE_SPACE();
+	    WRITE_OBJECT(alist->keys.defaults[i]);
+	    if (alist->keys.sforms[i]) {
+		WRITE_SPACE();
+		WRITE_ATOM(alist->keys.sforms[i]);
+	    }
+	    WRITE_CPAREN();
+	    if (i + 1 < alist->keys.num_symbols)
+		WRITE_SPACE();
+	}
+	need_space = 1;
+    }
+    if (alist->rest) {
+	if (need_space)
+	    WRITE_SPACE();
+	WRITE_STRING(Srest);
+	WRITE_SPACE();
+	WRITE_ATOM(alist->rest);
+	need_space = 1;
+    }
+    if (alist->auxs.num_symbols) {
+	if (need_space)
+	    WRITE_SPACE();
+	WRITE_STRING(Saux);
+	WRITE_SPACE();
+	for (i = 0; i < alist->auxs.num_symbols; i++) {
+	    WRITE_OPAREN();
+	    WRITE_ATOM(alist->auxs.symbols[i]);
+	    WRITE_SPACE();
+	    WRITE_OBJECT(alist->auxs.initials[i]);
+	    WRITE_CPAREN();
+	    if (i + 1 < alist->auxs.num_symbols)
+		WRITE_SPACE();
+	}
+    }
+    WRITE_CPAREN();
+
+#undef WRITE_ATOM
+#undef WRITE_STRING
+#undef WRITE_OBJECT
+#undef WRITE_OPAREN
+#undef WRITE_SPACE
+#undef WRITE_CPAREN
+
+    return (length);
+}
+
+static void
+check_stream(LispObj *stream,
+	     LispFile **file, LispString **string, int check_writable)
+{
+    /* NIL is UNIX stdout, *STANDARD-OUTPUT* may not be UNIX stdout */
+    if (stream == NIL) {
+	*file = Stdout;
+	*string = NULL;
+    }
+    else {
+	if (!STREAMP(stream))
+	    LispDestroy("%s is not a stream", STROBJ(stream));
+	if (check_writable && !stream->data.stream.writable)
+	    LispDestroy("%s is not writable", STROBJ(stream));
+	else if (stream->data.stream.type == LispStreamString) {
+	    *string = SSTREAMP(stream);
+	    *file = NULL;
+	}
+	else {
+	    if (stream->data.stream.type == LispStreamPipe)
+		*file = OPSTREAMP(stream);
+	    else
+		*file = stream->data.stream.source.file;
+	    *string = NULL;
+	}
+    }
+}
+
+/* Assumes buffer has enough storage, 64 bytes should be more than enough */
+static void
+parse_double(char *buffer, int *exponent, double value, int d)
+{
+    char stk[64], fmt[32], *ptr, *fract = NULL;
+    int positive = value >= 0.0;
+
+parse_double_again:
+    if (d >= 8) {
+	double dcheck;
+	int icheck, count;
+
+	/* this should to do the correct rounding */
+	for (count = 2;  count >= 0; count--) {
+	    icheck = d <= 0 ? 0 : d > FLOAT_PREC ? FLOAT_PREC - count : d - count;
+	    sprintf(fmt, "%%.%de", icheck);
+	    sprintf(stk, fmt, value);
+	    if (count) {
+		/* if the value read back is the same formatted */
+		sscanf(stk, "%lf", &dcheck);
+		if (dcheck == value)
+		    break;
+	    }
+	}
+    }
+    else {
+	sprintf(fmt, "%%.%de", d <= 0 ? 0 : d > FLOAT_PREC ? FLOAT_PREC : d);
+	sprintf(stk, fmt, value);
+    }
+
+    /* this "should" never fail */
+    ptr = strchr(stk, 'e');
+    if (ptr) {
+	*ptr++ = '\0';
+	*exponent = atoi(ptr);
+    }
+    else
+	*exponent = 0;
+
+    /* find start of number representation */
+    for (ptr = stk; *ptr && !isdigit(*ptr); ptr++)
+	;
+
+    /* check if did not trim any significant digit,
+     * this may happen because '%.e' puts only one digit before the '.' */
+    if (d > 0 && d < FLOAT_PREC && fabs(value) >= 10.0 &&
+	strlen(ptr) - 1 - !positive <= *exponent) {
+	d += *exponent - (strlen(ptr) - 1 - !positive) + 1;
+	goto parse_double_again;
+    }
+
+    /* this "should" never fail */
+    fract = strchr(ptr, '.');
+    if (fract)
+	*fract++ = '\0';
+
+    /* store number representation in buffer */
+    *buffer = positive ? '+' : '-';
+    strcpy(buffer + 1, ptr);
+    if (fract)
+	strcpy(buffer + strlen(buffer), fract);
+}
+
+static void
+format_integer(char *buffer, long value, int radix)
+{
+    if (radix == 10)
+	sprintf(buffer, "%ld", value);
+    else if (radix == 16)
+	sprintf(buffer, "%lx", value);
+    else if (radix == 8)
+	sprintf(buffer, "%lo", value);
+    else {
+	/* use bignum routine to convert number to string */
+	mpi integer;
+
+	mpi_init(&integer);
+	mpi_seti(&integer, value);
+	mpi_getstr(buffer, &integer, radix);
+	mpi_clear(&integer);
+    }
+}
+
+static int
+LispWriteCPointer(LispObj *stream, void *data)
+{
+    char stk[32];
+
+#ifdef LONG64
+    sprintf(stk, "0x%016lx", (long)data);
+#else
+    sprintf(stk, "0x%08lx", (long)data);
+#endif
+
+    return (LispWriteStr(stream, stk, strlen(stk)));
+}
+
+static int
+LispWriteCString(LispObj *stream, char *string, long length, write_info *info)
+{
+    int result;
+
+    if (!info->print_escape) {
+	char *base, *ptr, *end;
+
+	result = LispWriteChar(stream, '"');
+	for (base = ptr = string, end = string + length; ptr < end; ptr++) {
+	    if (*ptr == '\\' || *ptr == '"') {
+		result += LispWriteStr(stream, base, ptr - base);
+		result += LispWriteChar(stream, '\\');
+		result += LispWriteChar(stream, *ptr);
+		base = ptr + 1;
+	    }
+	}
+	result += LispWriteStr(stream, base, end - base);
+	result += LispWriteChar(stream, '"');
+    }
+    else
+	result = LispWriteStr(stream, string, length);
+
+    return (result);
+}
+
+static int
+LispWriteList(LispObj *stream, LispObj *object, write_info *info, int paren)
+{
+    int length = 0;
+    long circle = 0;
+
+    INCDEPTH();
+    if (info->print_level < 0 || info->level <= info->print_level) {
+	LispObj *car, *cdr;
+	long print_length = info->length;
+
+	if (info->circles && (circle = LispCheckCircle(object, info)) >= 0) {
+	    if (!paren) {
+		length += LispWriteStr(stream, ". ", 2);
+		paren = 1;
+	    }
+	    if (LispPrintCircle(stream, object, circle, &length, info) == 0) {
+		DECDEPTH();
+
+		return (length);
+	    }
+	}
+
+	car = CAR(object);
+	cdr = CDR(object);
+
+	if (cdr == NIL) {
+	    if (paren)
+		length += LispWriteChar(stream, '(');
+	    if (info->print_length < 0 || info->length < info->print_length) {
+		info->length = 0;
+		length += LispDoWriteObject(stream, car, info, 1);
+		info->length = print_length + 1;
+	    }
+	    else
+		length += LispWriteStr(stream, "...", 3);
+	    if (paren)
+		length += LispWriteChar(stream, ')');
+	}
+	else {
+	    if (paren)
+		length += LispWriteChar(stream, '(');
+	    if (info->print_length < 0 || info->length < info->print_length) {
+		info->length = 0;
+		length += LispDoWriteObject(stream, car, info, 1);
+		info->length = print_length + 1;
+		if (!CONSP(cdr)) {
+		    length += LispWriteStr(stream, " . ", 3);
+		    info->length = 0;
+		    length += LispDoWriteObject(stream, cdr, info, 0);
+		}
+		else {
+		    length += LispWriteChar(stream, ' ');
+		    if (info->print_length < 0 ||
+			info->length < info->print_length)
+			length += LispWriteList(stream, cdr, info, 0);
+		    else
+			length += LispWriteStr(stream, "...", 3);
+		}
+	    }
+	    else
+		length += LispWriteStr(stream, "...", 3);
+	    if (paren)
+		length += LispWriteChar(stream, ')');
+	}
+	info->length = print_length;
+    }
+    else
+	length += LispWriteChar(stream, '#');
+    DECDEPTH();
+
+    return (length);
+}
+
+static int
+LispDoWriteObject(LispObj *stream, LispObj *object, write_info *info, int paren)
+{
+    long print_level;
+    int length = 0;
+    char stk[64], *string = NULL;
+
+write_again:
+    switch (OBJECT_TYPE(object)) {
+	case LispNil_t:
+	    if (object == NIL)
+		string = Snil;
+	    else if (object == T)
+		string = St;
+	    else if (object == DOT)
+		string = "#<DOT>";
+	    else if (object == UNSPEC)
+		string = "#<UNSPEC>";
+	    else if (object == UNBOUND)
+		string = "#<UNBOUND>";
+	    else
+		string = "#<ERROR>";
+	    length += LispDoWriteAtom(stream, string, strlen(string),
+				      info->print_case);
+	    break;
+	case LispOpaque_t: {
+	    char *desc = LispIntToOpaqueType(object->data.opaque.type);
+
+	    length += LispWriteChar(stream, '#');
+	    length += LispWriteCPointer(stream, object->data.opaque.data);
+	    length += LispWriteStr(stream, desc, strlen(desc));
+	}   break;
+	case LispAtom_t:
+	    length += LispWriteAtom(stream, object, info);
+	    break;
+	case LispFunction_t:
+	    if (object->data.atom->a_function) {
+		object = object->data.atom->property->fun.function;
+		goto write_lambda;
+	    }
+	    length += LispWriteStr(stream, "#<", 2);
+	    if (object->data.atom->a_compiled)
+		LispDoWriteAtom(stream, "COMPILED", 8, info->print_case);
+	    else if (object->data.atom->a_builtin)
+		LispDoWriteAtom(stream, "BUILTIN", 7, info->print_case);
+	    /* XXX the function does not exist anymore */
+	    /* FIXME not sure if I want this fixed... */
+	    else
+		LispDoWriteAtom(stream, "UNBOUND", 7, info->print_case);
+	    LispDoWriteAtom(stream, "-FUNCTION", 9, info->print_case);
+	    length += LispWriteChar(stream, ' ');
+	    length += LispWriteAtom(stream, object->data.atom->object, info);
+	    length += LispWriteChar(stream, '>');
+	    break;
+	case LispString_t:
+	    length += LispWriteString(stream, object, info);
+	    break;
+	case LispSChar_t:
+	    length += LispWriteCharacter(stream, object, info);
+	    break;
+	case LispDFloat_t:
+	    length += LispWriteFloat(stream, object);
+	    break;
+	case LispFixnum_t:
+	case LispInteger_t:
+	case LispBignum_t:
+	    length += LispWriteInteger(stream, object);
+	    break;
+	case LispRatio_t:
+	    format_integer(stk, object->data.ratio.numerator, 10);
+	    length += LispWriteStr(stream, stk, strlen(stk));
+	    length += LispWriteChar(stream, '/');
+	    format_integer(stk, object->data.ratio.denominator, 10);
+	    length += LispWriteStr(stream, stk, strlen(stk));
+	    break;
+	case LispBigratio_t: {
+	    int sz;
+	    char *ptr;
+
+	    sz = mpi_getsize(mpr_num(object->data.mp.ratio), 10) + 1 +
+		 mpi_getsize(mpr_den(object->data.mp.ratio), 10) + 1 +
+		 (mpi_sgn(mpr_num(object->data.mp.ratio)) < 0);
+	    if (sz > sizeof(stk))
+		ptr = LispMalloc(sz);
+	    else
+		ptr = stk;
+	    mpr_getstr(ptr, object->data.mp.ratio, 10);
+	    length += LispWriteStr(stream, ptr, sz - 1);
+	    if (ptr != stk)
+		LispFree(ptr);
+	}   break;
+	case LispComplex_t:
+	    length += LispWriteStr(stream, "#C(", 3);
+	    length += LispDoWriteObject(stream,
+					object->data.complex.real, info, 0);
+	    length += LispWriteChar(stream, ' ');
+	    length += LispDoWriteObject(stream,
+					object->data.complex.imag, info, 0);
+	    length += LispWriteChar(stream, ')');
+	    break;
+	case LispCons_t:
+	    print_level = info->level;
+	    ++info->level;
+	    length += LispWriteList(stream, object, info, paren);
+	    info->level = print_level;
+	    break;
+	case LispQuote_t:
+	    length += LispWriteChar(stream, '\'');
+	    paren = 1;
+	    object = object->data.quote;
+	    goto write_again;
+	case LispBackquote_t:
+	    length += LispWriteChar(stream, '`');
+	    paren = 1;
+	    object = object->data.quote;
+	    goto write_again;
+	case LispComma_t:
+	    if (object->data.comma.atlist)
+		length += LispWriteStr(stream, ",@", 2);
+	    else
+		length += LispWriteChar(stream, ',');
+	    paren = 1;
+	    object = object->data.comma.eval;
+	    goto write_again;
+	    break;
+	case LispFunctionQuote_t:
+	    length += LispWriteStr(stream, "#'", 2);
+	    paren = 1;
+	    object = object->data.quote;
+	    goto write_again;
+	case LispArray_t:
+	    length += LispWriteArray(stream, object, info);
+	    break;
+	case LispStruct_t:
+	    length += LispWriteStruct(stream, object, info);
+	    break;
+	case LispLambda_t:
+	write_lambda:
+	    switch (object->funtype) {
+		case LispLambda:
+		    string = "#<LAMBDA ";
+		    break;
+		case LispFunction:
+		    string = "#<FUNCTION ";
+		    break;
+		case LispMacro:
+		    string = "#<MACRO ";
+		    break;
+		case LispSetf:
+		    string = "#<SETF ";
+		    break;
+	    }
+	    length += LispDoWriteAtom(stream, string, strlen(string),
+				      info->print_case);
+	    if (object->funtype != LispLambda) {
+		length += LispWriteAtom(stream, object->data.lambda.name, info);
+		length += LispWriteChar(stream, ' ');
+		length += LispWriteAlist(stream, object->data.lambda.name
+					 ->data.atom->property->alist, info);
+	    }
+	    else {
+		length += LispDoWriteAtom(stream, Snil, 3, info->print_case);
+		length += LispWriteChar(stream, ' ');
+		length += LispWriteAlist(stream, (LispArgList*)object->
+					 data.lambda.name->data.opaque.data,
+					 info);
+	    }
+	    length += LispWriteChar(stream, ' ');
+	    length += LispDoWriteObject(stream,
+					object->data.lambda.code, info, 0);
+	    length += LispWriteChar(stream, '>');
+	    break;
+	case LispStream_t:
+	    length += LispWriteStr(stream, "#<", 2);
+	    if (object->data.stream.type == LispStreamFile)
+		string = "FILE-STREAM ";
+	    else if (object->data.stream.type == LispStreamString)
+		string = "STRING-STREAM ";
+	    else if (object->data.stream.type == LispStreamStandard)
+		string = "STANDARD-STREAM ";
+	    else if (object->data.stream.type == LispStreamPipe)
+		string = "PIPE-STREAM ";
+	    length += LispDoWriteAtom(stream, string, strlen(string),
+				      info->print_case);
+
+	    if (!object->data.stream.readable && !object->data.stream.writable)
+		length += LispDoWriteAtom(stream, "CLOSED",
+					  6, info->print_case);
+	    else {
+		if (object->data.stream.readable)
+		    length += LispDoWriteAtom(stream, "READ",
+					      4, info->print_case);
+		if (object->data.stream.writable) {
+		    if (object->data.stream.readable)
+			length += LispWriteChar(stream, '-');
+		    length += LispDoWriteAtom(stream, "WRITE",
+					      5, info->print_case);
+		}
+	    }
+	    if (object->data.stream.type != LispStreamString) {
+		length += LispWriteChar(stream, ' ');
+		length += LispDoWriteObject(stream,
+					    object->data.stream.pathname,
+					    info, 1);
+		/* same address/size for pipes */
+		length += LispWriteChar(stream, ' ');
+		length += LispWriteCPointer(stream,
+					    object->data.stream.source.file);
+		if (object->data.stream.readable &&
+		    object->data.stream.type == LispStreamFile &&
+		    !object->data.stream.source.file->binary) {
+		    length += LispWriteStr(stream, " @", 2);
+		    format_integer(stk, object->data.stream.source.file->line, 10);
+		    length += LispWriteStr(stream, stk, strlen(stk));
+		}
+	    }
+	    length += LispWriteChar(stream, '>');
+	    break;
+	case LispPathname_t:
+	    length += LispWriteStr(stream, "#P", 2);
+	    paren = 1;
+	    object = CAR(object->data.quote);
+	    goto write_again;
+	case LispPackage_t:
+	    length += LispDoWriteAtom(stream, "#<PACKAGE ",
+				      10, info->print_case);
+	    length += LispWriteStr(stream,
+				   THESTR(object->data.package.name),
+				   STRLEN(object->data.package.name));
+	    length += LispWriteChar(stream, '>');
+	    break;
+	case LispRegex_t:
+	    length += LispDoWriteAtom(stream, "#<REGEX ",
+				      8, info->print_case);
+	    length += LispDoWriteObject(stream,
+					object->data.regex.pattern, info, 1);
+	    if (object->data.regex.options & RE_NOSPEC)
+		length += LispDoWriteAtom(stream, " :NOSPEC",
+					  8, info->print_case);
+	    if (object->data.regex.options & RE_ICASE)
+		length += LispDoWriteAtom(stream, " :ICASE",
+					  7, info->print_case);
+	    if (object->data.regex.options & RE_NOSUB)
+		length += LispDoWriteAtom(stream, " :NOSUB",
+					  7, info->print_case);
+	    if (object->data.regex.options & RE_NEWLINE)
+		length += LispDoWriteAtom(stream, " :NEWLINE",
+					  9, info->print_case);
+	    length += LispWriteChar(stream, '>');
+	    break;
+	case LispBytecode_t:
+	    length += LispDoWriteAtom(stream, "#<BYTECODE ",
+				      11, info->print_case);
+	    length += LispWriteCPointer(stream,
+					object->data.bytecode.bytecode);
+	    length += LispWriteChar(stream, '>');
+	    break;
+	case LispHashTable_t:
+	    length += LispDoWriteAtom(stream, "#<HASH-TABLE ",
+				      13, info->print_case);
+	    length += LispWriteAtom(stream, object->data.hash.test, info);
+	    snprintf(stk, sizeof(stk), " %g %g",
+		     object->data.hash.table->rehash_size,
+		     object->data.hash.table->rehash_threshold);
+	    length += LispWriteStr(stream, stk, strlen(stk));
+	    snprintf(stk, sizeof(stk), " %ld/%ld>",
+		     object->data.hash.table->count,
+		     object->data.hash.table->num_entries);
+	    length += LispWriteStr(stream, stk, strlen(stk));
+	    break;
+    }
+
+    return (length);
+}
+
+/* return current column number in stream */
+int
+LispGetColumn(LispObj *stream)
+{
+    LispFile *file;
+    LispString *string;
+
+    check_stream(stream, &file, &string, 0);
+    if (file != NULL)
+	return (file->column);
+    return (string->column);
+}
+
+/* write a character to stream */
+int
+LispWriteChar(LispObj *stream, int character)
+{
+    LispFile *file;
+    LispString *string;
+
+    check_stream(stream, &file, &string, 1);
+    if (file != NULL)
+	return (LispFputc(file, character));
+
+    return (LispSputc(string, character));
+}
+
+/* write a character count times to stream */
+int
+LispWriteChars(LispObj *stream, int character, int count)
+{
+    int length = 0;
+
+    if (count > 0) {
+	char stk[64];
+	LispFile *file;
+	LispString *string;
+
+	check_stream(stream, &file, &string, 1);
+	if (count >= sizeof(stk)) {
+	    memset(stk, character, sizeof(stk));
+	    for (; count >= sizeof(stk); count -= sizeof(stk)) {
+		if (file != NULL)
+		    length += LispFwrite(file, stk, sizeof(stk));
+		else
+		    length += LispSwrite(string, stk, sizeof(stk));
+	    }
+	}
+	else
+	    memset(stk, character, count);
+
+	if (count) {
+	    if (file != NULL)
+		length += LispFwrite(file, stk, count);
+	    else
+		length += LispSwrite(string, stk, count);
+	}
+    }
+
+    return (length);
+}
+
+/* write a string to stream */
+int
+LispWriteStr(LispObj *stream, char *buffer, long length)
+{
+    LispFile *file;
+    LispString *string;
+
+    check_stream(stream, &file, &string, 1);
+    if (file != NULL)
+	return (LispFwrite(file, buffer, length));
+    return (LispSwrite(string, buffer, length));
+}
+
+static int
+LispDoWriteAtom(LispObj *stream, char *string, int length, int print_case)
+{
+    int bytes = 0, cap = 0;
+    char buffer[128], *ptr;
+
+    switch (print_case) {
+	case DOWNCASE:
+	    for (ptr = buffer; length > 0; length--, string++) {
+		if (isupper(*string))
+		    *ptr = tolower(*string);
+		else
+		    *ptr = *string;
+		++ptr;
+		if (ptr - buffer >= sizeof(buffer)) {
+		    bytes += LispWriteStr(stream, buffer, ptr - buffer);
+		    ptr = buffer;
+		}
+	    }
+	    if (ptr > buffer)
+		bytes += LispWriteStr(stream, buffer, ptr - buffer);
+	    break;
+	case CAPITALIZE:
+	    for (ptr = buffer; length > 0; length--, string++) {
+		if (isalnum(*string)) {
+		    if (cap && isupper(*string))
+			*ptr = tolower(*string);
+		    else
+			*ptr = *string;
+		    cap = 1;
+		}
+		else {
+		    *ptr = *string;
+		    cap = 0;
+		}
+		++ptr;
+		if (ptr - buffer >= sizeof(buffer)) {
+		    bytes += LispWriteStr(stream, buffer, ptr - buffer);
+		    ptr = buffer;
+		}
+	    }
+	    if (ptr > buffer)
+		bytes += LispWriteStr(stream, buffer, ptr - buffer);
+	    break;
+	default:
+	    /* Strings are already stored upcase/quoted */
+	    bytes += LispWriteStr(stream, string, length);
+	    break;
+    }
+
+    return (bytes);
+}
+
+static int
+LispWriteAtom(LispObj *stream, LispObj *object, write_info *info)
+{
+    int length = 0;
+    LispAtom *atom = object->data.atom;
+    Atom_id id = atom->string;
+
+    if (atom->package != PACKAGE) {
+	if (atom->package == lisp__data.keyword)
+	    length += LispWriteChar(stream, ':');
+	else if (atom->package == NULL)
+	    length += LispWriteStr(stream, "#:", 2);
+	else {
+	    /* Check if the symbol is visible */
+	    int i, visible = 0;
+
+	    if (atom->ext) {
+		for (i = lisp__data.pack->use.length - 1; i >= 0; i--) {
+		    if (lisp__data.pack->use.pairs[i] == atom->package) {
+			visible = 1;
+			break;
+		    }
+		}
+	    }
+
+	    if (!visible) {
+		/* XXX this assumes that package names are always "readable" */
+		length +=
+		    LispDoWriteAtom(stream,
+				    THESTR(atom->package->data.package.name),
+				    STRLEN(atom->package->data.package.name),
+				    info->print_case);
+		length += LispWriteChar(stream, ':');
+		if (!atom->ext)
+		    length += LispWriteChar(stream, ':');
+	    }
+	}
+    }
+    if (atom->unreadable)
+	length += LispWriteChar(stream, '|');
+    length += LispDoWriteAtom(stream, id, strlen(id),
+			      atom->unreadable ? UPCASE : info->print_case);
+    if (atom->unreadable)
+	length += LispWriteChar(stream, '|');
+
+    return (length);
+}
+
+static int
+LispWriteInteger(LispObj *stream, LispObj *object)
+{
+    return (LispFormatInteger(stream, object, 10, 0, 0, 0, 0, 0, 0));
+}
+
+static int
+LispWriteCharacter(LispObj *stream, LispObj *object, write_info *info)
+{
+    return (LispFormatCharacter(stream, object, !info->print_escape, 0));
+}
+
+static int
+LispWriteString(LispObj *stream, LispObj *object, write_info *info)
+{
+    return (LispWriteCString(stream, THESTR(object), STRLEN(object), info));
+}
+
+static int
+LispWriteFloat(LispObj *stream, LispObj *object)
+{
+    double value = DFLOAT_VALUE(object);
+
+    if (value == 0.0 || (fabs(value) < 1.0E7 && fabs(value) > 1.0E-4))
+	return (LispFormatFixedFloat(stream, object, 0, 0, NULL, 0, 0, 0));
+
+    return (LispDoFormatExponentialFloat(stream, object, 0, 0, NULL,
+					 0, 1, 0, ' ', 'E', 0));
+}
+
+static int
+LispWriteArray(LispObj *stream, LispObj *object, write_info *info)
+{
+    int length = 0;
+    long print_level = info->level, circle;
+
+    if (info->circles && (circle = LispCheckCircle(object, info)) >= 0 &&
+	LispPrintCircle(stream, object, circle, &length, info) == 0)
+	return (length);
+
+    if (object->data.array.rank == 0) {
+	length += LispWriteStr(stream, "#0A", 3);
+	length += LispDoWriteObject(stream, object->data.array.list, info, 1);
+	return (length);
+    }
+
+    INCDEPTH();
+    ++info->level;
+    if (info->print_level < 0 || info->level <= info->print_level) {
+	if (object->data.array.rank == 1)
+	    length += LispWriteStr(stream, "#(", 2);
+	else {
+	    char stk[32];
+
+	    format_integer(stk, object->data.array.rank, 10);
+	    length += LispWriteChar(stream, '#');
+	    length += LispWriteStr(stream, stk, strlen(stk));
+	    length += LispWriteStr(stream, "A(", 2);
+	}
+
+	if (!object->data.array.zero) {
+	    long print_length = info->length, local_length = 0;
+
+	    if (object->data.array.rank == 1) {
+		LispObj *ary;
+		long count;
+
+		for (ary = object->data.array.dim, count = 1;
+		     ary != NIL; ary = CDR(ary))
+		    count *= FIXNUM_VALUE(CAR(ary));
+		for (ary = object->data.array.list; count > 0;
+		     ary = CDR(ary), count--) {
+		    if (info->print_length < 0 ||
+			++local_length <= info->print_length) {
+			info->length = 0;
+			length += LispDoWriteObject(stream, CAR(ary), info, 1);
+		    }
+		    else {
+			length += LispWriteStr(stream, "...", 3);
+			break;
+		    }
+		    if (count - 1 > 0)
+			length += LispWriteChar(stream, ' ');
+		}
+	    }
+	    else {
+		LispObj *ary;
+		int i, k, rank, *dims, *loop;
+
+		rank = object->data.array.rank;
+		dims = LispMalloc(sizeof(int) * rank);
+		loop = LispCalloc(1, sizeof(int) * (rank - 1));
+
+		/* fill dim */
+		for (i = 0, ary = object->data.array.dim; ary != NIL;
+		     i++, ary = CDR(ary))
+		    dims[i] = FIXNUM_VALUE(CAR(ary));
+
+		i = 0;
+		ary = object->data.array.list;
+		while (loop[0] < dims[0]) {
+		    if (info->print_length < 0 ||
+			local_length < info->print_length) {
+			for (; i < rank - 1; i++)
+			    length += LispWriteChar(stream, '(');
+			--i;
+			for (;;) {
+			    ++loop[i];
+			    if (i && loop[i] >= dims[i])
+				loop[i] = 0;
+			    else
+				break;
+			    --i;
+			}
+			for (k = 0; k < dims[rank - 1] - 1;
+			     k++, ary = CDR(ary)) {
+			    if (info->print_length < 0 ||
+				k < info->print_length) {
+				++local_length;
+				info->length = 0;
+				length += LispDoWriteObject(stream,
+							    CAR(ary), info, 1);
+				length += LispWriteChar(stream, ' ');
+			    }
+			}
+			if (info->print_length < 0 || k < info->print_length) {
+			    ++local_length;
+			    info->length = 0;
+			    length += LispDoWriteObject(stream,
+							CAR(ary), info, 0);
+			}
+			else
+			    length += LispWriteStr(stream,  "...", 3);
+			for (k = rank - 1; k > i; k--)
+			    length += LispWriteChar(stream, ')');
+			if (loop[0] < dims[0])
+			    length += LispWriteChar(stream,  ' ');
+			ary = CDR(ary);
+		    }
+		    else {
+			++local_length;
+			length += LispWriteStr(stream,	"...)", 4);
+			for (; local_length < dims[0] - 1; local_length++)
+			    length += LispWriteStr(stream,  " ...)", 5);
+			if (local_length <= dims[0])
+			    length += LispWriteStr(stream,  " ...", 4);
+			break;
+		    }
+		}
+		LispFree(dims);
+		LispFree(loop);
+	    }
+	    info->length = print_length;
+	}
+	length += LispWriteChar(stream, ')');
+    }
+    else
+	length += LispWriteChar(stream, '#');
+    info->level = print_level;
+    DECDEPTH();
+
+    return (length);
+}
+
+static int
+LispWriteStruct(LispObj *stream, LispObj *object, write_info *info)
+{
+    int length;
+    long circle;
+    LispObj *symbol;
+    LispObj *def = object->data.struc.def;
+    LispObj *field = object->data.struc.fields;
+
+    if (info->circles && (circle = LispCheckCircle(object, info)) >= 0 &&
+	LispPrintCircle(stream, object, circle, &length, info) == 0)
+	return (length);
+
+    INCDEPTH();
+    length = LispWriteStr(stream, "#S(", 3);
+    symbol = SYMBOLP(CAR(def)) ? CAR(def) : CAAR(def);
+    length += LispWriteAtom(stream, symbol, info);
+    def = CDR(def);
+    for (; def != NIL; def = CDR(def), field = CDR(field)) {
+	length += LispWriteChar(stream, ' ');
+	symbol = SYMBOLP(CAR(def)) ? CAR(def) : CAAR(def);
+	length += LispWriteAtom(stream, symbol, info);
+	length += LispWriteChar(stream, ' ');
+	length += LispDoWriteObject(stream, CAR(field), info, 1);
+    }
+    length += LispWriteChar(stream, ')');
+    DECDEPTH();
+
+    return (length);
+}
+
+int
+LispFormatInteger(LispObj *stream, LispObj *object, int radix,
+		  int atsign, int collon, int mincol,
+		  int padchar, int commachar, int commainterval)
+{
+    char stk[128], *str = stk;
+    int i, length, sign, intervals;
+
+    if (LONGINTP(object))
+	format_integer(stk, LONGINT_VALUE(object), radix);
+    else {
+	if (mpi_getsize(object->data.mp.integer, radix) >= sizeof(stk))
+	    str = mpi_getstr(NULL, object->data.mp.integer, radix);
+	else
+	    mpi_getstr(str, object->data.mp.integer, radix);
+    }
+
+    sign = *str == '-';
+    length = strlen(str);
+
+    /* if collon, update length for the number of commachars to be printed */
+    if (collon && commainterval > 0 && commachar) {
+	intervals = length / commainterval;
+	length += intervals;
+    }
+    else
+	intervals = 0;
+
+    /* if sign must be printed, and number is positive */
+    if (atsign && !sign)
+	++length;
+
+    /* if need padding */
+    if (padchar && mincol > length)
+	LispWriteChars(stream, padchar, mincol - length);
+
+    /* if need to print number sign */
+    if (sign || atsign)
+	LispWriteChar(stream, sign ? '-' : '+');
+
+    /* if need to print commas to separate groups of numbers */
+    if (intervals) {
+	int j;
+	char *ptr;
+
+	i = (length - atsign) - intervals;
+	j = i % commainterval;
+	/* make the loop below easier */
+	if (j == 0)
+	    j = commainterval;
+	i -= j;
+	ptr = str + sign;
+	for (; j > 0; j--, ptr++)
+	    LispWriteChar(stream, *ptr);
+	for (; i > 0; i -= commainterval) {
+	    LispWriteChar(stream, commachar);
+	    for (j = 0; j < commainterval; j++, ptr++)
+		LispWriteChar(stream, *ptr);
+	}
+    }
+    /* else, just print the string */
+    else
+	LispWriteStr(stream, str + sign, length - sign);
+
+    /* if number required more than sizeof(stk) bytes */
+    if (str != stk)
+	LispFree(str);
+
+    return (length);
+}
+
+int
+LispFormatRomanInteger(LispObj *stream, long value, int new_roman)
+{
+    char stk[32];
+    int length;
+
+    length = 0;
+    while (value > 1000) {
+	stk[length++] = 'M';
+	value -= 1000;
+    }
+    if (new_roman) {
+	if (value >= 900) {
+	    strcpy(stk + length, "CM");
+	    length += 2,
+	    value -= 900;
+	}
+	else if (value < 500 && value >= 400) {
+	    strcpy(stk + length, "CD");
+	    length += 2;
+	    value -= 400;
+	}
+    }
+    if (value >= 500) {
+	stk[length++] = 'D';
+	value -= 500;
+    }
+    while (value >= 100) {
+	stk[length++] = 'C';
+	value -= 100;
+    }
+    if (new_roman) {
+	if (value >= 90) {
+	    strcpy(stk + length, "XC");
+	    length += 2,
+	    value -= 90;
+	}
+	else if (value < 50 && value >= 40) {
+	    strcpy(stk + length, "XL");
+	    length += 2;
+	    value -= 40;
+	}
+    }
+    if (value >= 50) {
+	stk[length++] = 'L';
+	value -= 50;
+    }
+    while (value >= 10) {
+	stk[length++] = 'X';
+	value -= 10;
+    }
+    if (new_roman) {
+	if (value == 9) {
+	    strcpy(stk + length, "IX");
+	    length += 2,
+	    value -= 9;
+	}
+	else if (value == 4) {
+	    strcpy(stk + length, "IV");
+	    length += 2;
+	    value -= 4;
+	}
+    }
+    if (value >= 5) {
+	stk[length++] = 'V';
+	value -= 5;
+    }
+    while (value) {
+	stk[length++] = 'I';
+	--value;
+    }
+
+    stk[length] = '\0';
+
+    return (LispWriteStr(stream, stk, length));
+}
+
+int
+LispFormatEnglishInteger(LispObj *stream, long number, int ordinal)
+{
+    static char *ds[] = {
+	"",	      "one",	   "two",	 "three",      "four",
+	"five",       "six",	   "seven",	 "eight",      "nine",
+	"ten",	      "eleven",    "twelve",	 "thirteen",   "fourteen",
+	"fifteen",    "sixteen",   "seventeen",  "eighteen",   "nineteen"
+    };
+    static char *dsth[] = {
+	"",	      "first",	   "second",	  "third",	"fourth",
+	"fifth",      "sixth",	   "seventh",	  "eighth",	"ninth",
+	"tenth",      "eleventh",  "twelfth",	  "thirteenth", "fourteenth",
+	 "fifteenth", "sixteenth", "seventeenth", "eighteenth", "nineteenth"
+    };
+    static char *hs[] = {
+	"",	      "",	   "twenty",	  "thirty",	"forty",
+	"fifty",      "sixty",	   "seventy",	  "eighty",	"ninety"
+    };
+    static char *hsth[] = {
+	"",	      "",	   "twentieth",   "thirtieth",	"fortieth",
+       "fiftieth",    "sixtieth",  "seventieth",  "eightieth",	"ninetieth"
+    };
+    static char *ts[] = {
+	"",	      "thousand",   "million"
+    };
+    static char *tsth[] = {
+	"",	     "thousandth", "millionth"
+    };
+    char stk[256];
+    int length, sign;
+
+    sign = number < 0;
+    if (sign)
+	number = -number;
+    length = 0;
+
+#define SIGNLEN		6	/* strlen("minus ") */
+    if (sign) {
+	strcpy(stk, "minus ");
+	length += SIGNLEN;
+    }
+    else if (number == 0) {
+	if (ordinal) {
+	    strcpy(stk, "zeroth");
+	    length += 6;	/* strlen("zeroth") */
+	}
+	else {
+	    strcpy(stk, "zero");
+	    length += 4;	/* strlen("zero") */
+	}
+    }
+    for (;;) {
+	int count, temp;
+	char *t, *h, *d;
+	long value = number;
+
+	for (count = 0; value >= 1000; value /= 1000, count++)
+	    ;
+
+	t = ds[value / 100];
+	if (ordinal && !count && (value % 10) == 0)
+	    h = hsth[(value % 100) / 10];
+	else
+	    h = hs[(value % 100) / 10];
+
+	if (ordinal && !count)
+	    d = *h ? dsth[value % 10] : dsth[value % 20];
+	else
+	    d = *h ? ds[value % 10] : ds[value % 20];
+
+	if (((!sign && length) || length > SIGNLEN) && (*t || *h || *d)) {
+	    if (!ordinal || count || *h || *t) {
+		strcpy(stk + length, ", ");
+		length += 2;
+	    }
+	    else {
+		strcpy(stk + length, " ");
+		++length;
+	    }
+	}
+
+	if (*t) {
+	    if (ordinal && !count && (value % 100) == 0)
+		temp = sprintf(stk + length, "%s hundredth", t);
+	    else
+		temp = sprintf(stk + length, "%s hundred", t);
+	    length += temp;
+	}
+
+	if (*h) {
+	    if (*t) {
+		if (ordinal && !count) {
+		    strcpy(stk + length, " ");
+		    ++length;
+		}
+		else {
+		    strcpy(stk + length, " and ");
+		    length += 5;	/* strlen(" and ") */
+		}
+	    }
+	    strcpy(stk + length, h);
+	    length += strlen(h);
+	}
+
+	if (*d) {
+	    if (*h) {
+		strcpy(stk + length, "-");
+		++length;
+	    }
+	    else if (*t) {
+		if (ordinal && !count) {
+		    strcpy(stk + length, " ");
+		    ++length;
+		}
+		else {
+		    strcpy(stk + length, " and ");
+		    length += 5;	/* strlen(" and ") */
+		}
+	    }
+	    strcpy(stk + length, d);
+	    length += strlen(d);
+	}
+
+	if (!count)
+	    break;
+	else
+	    temp = count;
+
+	if (count > 1) {
+	    value *= 1000;
+	    while (--count)
+		value *= 1000;
+	    number -= value;
+	}
+	else
+	    number %= 1000;
+
+	if (ordinal && number == 0 && !*t && !*h)
+	    temp = sprintf(stk + length, " %s", tsth[temp]);
+	else
+	    temp = sprintf(stk + length, " %s", ts[temp]);
+	length += temp;
+
+	if (!number)
+	    break;
+    }
+
+    return (LispWriteStr(stream, stk, length));
+}
+
+int
+LispFormatCharacter(LispObj *stream, LispObj *object,
+		    int atsign, int collon)
+{
+    int length = 0;
+    int ch = SCHAR_VALUE(object);
+
+    if (atsign && !collon)
+	length += LispWriteStr(stream, "#\\", 2);
+    if ((atsign || collon) && (ch <= ' ' || ch == 0177)) {
+	char *name = LispChars[ch].names[0];
+
+	length += LispWriteStr(stream, name, strlen(name));
+    }
+    else
+	length += LispWriteChar(stream, ch);
+
+    return (length);
+}
+
+/* returns 1 if string size must grow, done inplace */
+static int
+float_string_inc(char *buffer, int offset)
+{
+    int i;
+
+    for (i = offset; i >= 0; i--) {
+	if (buffer[i] == '9')
+	    buffer[i] = '0';
+	else if (buffer[i] != '.') {
+	    ++buffer[i];
+	    break;
+	}
+    }
+    if (i < 0) {
+	int length = strlen(buffer);
+
+	/* string size must change */
+	memmove(buffer + 1, buffer, length + 1);
+	buffer[0] = '1';
+
+	return (1);
+    }
+
+    return (0);
+}
+
+int
+LispFormatFixedFloat(LispObj *stream, LispObj *object,
+		     int atsign, int w, int *pd, int k, int overflowchar,
+		     int padchar)
+{
+    char buffer[512], stk[64];
+    int sign, exponent, length, offset, d = pd ? *pd : FLOAT_PREC, again;
+    double value = DFLOAT_VALUE(object);
+
+    if (value == 0.0) {
+	exponent = k = 0;
+	strcpy(stk, "+0");
+    }
+    else
+	/* calculate format parameters, adjusting scale factor */
+	parse_double(stk, &exponent, value, d + 1 + k);
+
+    /* make sure k won't cause overflow */
+    if (k > 128)
+	k = 128;
+    else if (k < -128)
+	k = -128;
+
+    /* make sure d won't cause overflow */
+    if (d > 128)
+	d = 128;
+    else if (d < -128)
+	d = -128;
+
+    /* adjust scale factor, exponent is used as an index in stk */
+    exponent += k + 1;
+
+    /* how many bytes in float representation */
+    length = strlen(stk) - 1;
+
+    /* need to print a sign? */
+    sign = atsign || (stk[0] == '-');
+
+    /* format number, cannot overflow, as control variables were checked */
+    offset = 0;
+    if (sign)
+	buffer[offset++] = stk[0];
+    if (exponent > 0) {
+	if (exponent > length) {
+	    memcpy(buffer + offset, stk + 1, length);
+	    memset(buffer + offset + length, '0', exponent - length);
+	}
+	else
+	    memcpy(buffer + offset, stk + 1, exponent);
+	offset += exponent;
+	buffer[offset++] = '.';
+	if (length > exponent) {
+	    memcpy(buffer + offset, stk + 1 + exponent, length - exponent);
+	    offset += length - exponent;
+	}
+	else
+	    buffer[offset++] = '0';
+    }
+    else {
+	buffer[offset++] = '0';
+	buffer[offset++] = '.';
+	while (exponent < 0) {
+	    buffer[offset++] = '0';
+	    exponent++;
+	}
+	memcpy(buffer + offset, stk + 1, length);
+	offset += length;
+    }
+    buffer[offset] = '\0';
+
+    again = 0;
+fixed_float_check_again:
+    /* make sure only d digits are printed after decimal point */
+    if (d > 0) {
+	char *dptr = strchr(buffer, '.');
+
+	length = strlen(dptr) - 1;
+	/* check if need to remove excess digits */
+	if (length > d) {
+	    int digit;
+
+	    offset = (dptr - buffer) + 1 + d;
+	    digit = buffer[offset];
+
+	    /* remove extra digits */
+	    buffer[offset] = '\0';
+
+	    /* check if need to round */
+	    if (!again && offset > 1 && isdigit(digit) && digit >= '5' &&
+		isdigit(buffer[offset - 1]) &&
+		float_string_inc(buffer, offset - 1))
+		++offset;
+	}
+	/* check if need to add extra zero digits to fill space */
+	else if (length < d) {
+	    offset += d - length;
+	    for (++length; length <= d; length++)
+		dptr[length] = '0';
+	    dptr[length] = '\0';
+	}
+    }
+    else {
+	/* no digits after decimal point */
+	int digit, inc = 0;
+	char *dptr = strchr(buffer, '.') + 1;
+
+	digit = *dptr;
+	if (!again && digit >= '5' && dptr >= buffer + 2 && isdigit(dptr[-2]))
+	    inc = float_string_inc(buffer, dptr - buffer - 2);
+
+	offset = (dptr - buffer) + inc;
+	buffer[offset] = '\0';
+    }
+
+    /* if d was not specified, remove any extra zeros */
+    if (pd == NULL) {
+	while (offset > 2 && buffer[offset - 2] != '.' &&
+	       buffer[offset - 1] == '0')
+	    --offset;
+	buffer[offset] = '\0';
+    }
+
+    if (w > 0 && offset > w) {
+	/* first check if can remove extra fractional digits */
+	if (pd == NULL) {
+	    char *ptr = strchr(buffer, '.') + 1;
+
+	    if (ptr - buffer < w) {
+		d = w - (ptr - buffer);
+		goto fixed_float_check_again;
+	    }
+	}
+
+	/* remove leading "zero" to save space */
+ 	if ((!sign && buffer[0] == '0') || (sign && buffer[1] == '0')) {
+	    /* ending nul also copied */
+	    memmove(buffer + sign, buffer + sign + 1, offset);
+	    --offset;
+	}
+	/* remove leading '+' to "save" space */
+	if (offset > w && buffer[0] == '+') {
+	    /* ending nul also copied */
+	    memmove(buffer, buffer + 1, offset);
+	    --offset;
+	}
+    }
+
+    /* if cannot represent number in given width */
+    if (overflowchar && offset > w) {
+	again = 1;
+	goto fixed_float_overflow;
+    }
+
+    length = 0;
+    /* print padding if required */
+    if (w > offset)
+	length += LispWriteChars(stream, padchar, w - offset);
+
+    /* print float number representation */
+    return (LispWriteStr(stream, buffer, offset) + length);
+
+fixed_float_overflow:
+    return (LispWriteChars(stream, overflowchar, w));
+}
+
+int
+LispFormatExponentialFloat(LispObj *stream, LispObj *object,
+			   int atsign, int w, int *pd, int e, int k,
+			   int overflowchar, int padchar, int exponentchar)
+{
+    return (LispDoFormatExponentialFloat(stream, object, atsign, w,
+					 pd, e, k, overflowchar, padchar,
+					 exponentchar, 1));
+}
+
+int
+LispDoFormatExponentialFloat(LispObj *stream, LispObj *object,
+			     int atsign, int w, int *pd, int e, int k,
+			     int overflowchar, int padchar, int exponentchar,
+			     int format)
+{
+    char buffer[512], stk[64];
+    int sign, exponent, length, offset, d = pd ? *pd : FLOAT_PREC;
+    double value = DFLOAT_VALUE(object);
+
+    if (value == 0.0) {
+	exponent = 0;
+	k = 1;
+	strcpy(stk, "+0");
+    }
+    else
+	/* calculate format parameters, adjusting scale factor */
+	parse_double(stk, &exponent, value, d + k - 1);
+
+    /* set e to a value that won't overflow */
+    if (e > 16)
+	e = 16;
+
+    /* set k to a value that won't overflow */
+    if (k > 128)
+	k = 128;
+    else if (k < -128)
+	k = -128;
+
+    /* set d to a value that won't overflow */
+    if (d > 128)
+	d = 128;
+    else if (d < -128)
+	d = -128;
+
+    /* how many bytes in float representation */
+    length = strlen(stk) - 1;
+
+    /* need to print a sign? */
+    sign = atsign || (stk[0] == '-');
+
+    /* adjust number of digits after decimal point */
+    if (k > 0)
+	d -= k - 1;
+
+    /* adjust exponent, based on scale factor */
+    exponent -= k - 1;
+
+    /* format number, cannot overflow, as control variables were checked */
+    offset = 0;
+    if (sign)
+	buffer[offset++] = stk[0];
+    if (k > 0) {
+	if (k > length) {
+	    memcpy(buffer + offset, stk + 1, length);
+	    offset += length;
+	}
+	else {
+	    memcpy(buffer + offset, stk + 1, k);
+	    offset += k;
+	}
+	buffer[offset++] = '.';
+	if (length > k) {
+	    memcpy(buffer + offset, stk + 1 + k, length - k);
+	    offset += length - k;
+	}
+ 	else
+	    buffer[offset++] = '0';
+    }
+    else {
+	int tmp = k;
+
+	buffer[offset++] = '0';
+	buffer[offset++] = '.';
+	while (tmp < 0) {
+	    buffer[offset++] = '0';
+	    tmp++;
+	}
+	memcpy(buffer + offset, stk + 1, length);
+	offset += length;
+    }
+
+    /* if format, then always add a sign to exponent */
+    buffer[offset++] = exponentchar;
+    if (format || exponent < 0)
+	buffer[offset++] = exponent < 0 ? '-' : '+';
+
+    /* XXX destroy stk contents */
+    sprintf(stk, "%%0%dd", e);
+    /* format scale factor*/
+    length = sprintf(buffer + offset, stk,
+		     exponent < 0 ? -exponent : exponent);
+    /* check for overflow in exponent */
+    if (length > e && overflowchar)
+	goto exponential_float_overflow;
+    offset += length;
+
+    /* make sure only d digits are printed after decimal point */
+    if (d > 0) {
+	int currd;
+	char *dptr = strchr(buffer, '.'),
+	     *eptr = strchr(dptr, exponentchar);
+
+	currd = eptr - dptr - 1;
+	length = strlen(eptr);
+
+	/* check if need to remove excess digits */
+	if (currd > d) {
+	    int digit, dpos;
+
+	    dpos = offset = (dptr - buffer) + 1 + d;
+	    digit = buffer[offset];
+
+	    memmove(buffer + offset, eptr, length + 1);
+	    /* also copy ending nul character */
+
+	    /* adjust offset to length of total string */
+	    offset += length;
+
+	    /* check if need to round */
+	    if (dpos > 1 && isdigit(digit) && digit >= '5' &&
+		isdigit(buffer[dpos - 1]) &&
+		float_string_inc(buffer, dpos - 1))
+		++offset;
+	}
+	/* check if need to add extra zero digits to fill space */
+	else if (pd && currd < d) {
+	    memmove(eptr + d - currd, eptr, length + 1);
+	    /* also copy ending nul character */
+
+	    offset += d - currd;
+	    for (++currd; currd <= d; currd++)
+		dptr[currd] = '0';
+	}
+	/* check if need to remove zeros */
+	else if (pd == NULL) {
+	    int zeros = 1;
+
+	    while (eptr[-zeros] == '0')
+		++zeros;
+	    if (eptr[-zeros] == '.')
+		--zeros;
+	    if (zeros > 1) {
+		memmove(eptr - zeros + 1, eptr, length + 1);
+		offset -= zeros - 1;
+	    }
+	}
+    }
+    else {
+	/* no digits after decimal point */
+	int digit, inc = 0;
+	char *dptr = strchr(buffer, '.'),
+	     *eptr = strchr(dptr, exponentchar);
+
+	digit = dptr[1];
+
+	offset = (dptr - buffer) + 1;
+	length = strlen(eptr);
+	memmove(buffer + offset, eptr, length + 1);
+	/* also copy ending nul character */
+
+ 	if (digit >= '5' && dptr >= buffer + 2 &&
+	    isdigit(dptr[-2]))
+	    inc = float_string_inc(buffer, dptr - buffer - 2);
+
+	/* adjust offset to length of total string */
+	offset += length + inc;
+    }
+
+    if (w > 0 && offset > w) {
+	/* remove leading "zero" to save space */
+	if ((!sign && buffer[0] == '0') || (sign && buffer[1] == '0')) {
+	    /* ending nul also copied */
+	    memmove(buffer + sign, buffer + sign + 1, offset);
+	    --offset;
+	}
+	/* remove leading '+' to "save" space */
+	if (offset > w && buffer[0] == '+') {
+	    /* ending nul also copied */
+	    memmove(buffer, buffer + 1, offset);
+	    --offset;
+	}
+    }
+
+    /* if cannot represent number in given width */
+    if (overflowchar && offset > w)
+	goto exponential_float_overflow;
+
+    length = 0;
+    /* print padding if required */
+    if (w > offset)
+	length += LispWriteChars(stream, padchar, w - offset);
+
+    /* print float number representation */
+    return (LispWriteStr(stream, buffer, offset) + length);
+
+exponential_float_overflow:
+    return (LispWriteChars(stream, overflowchar, w));
+}
+
+int
+LispFormatGeneralFloat(LispObj *stream, LispObj *object,
+		       int atsign, int w, int *pd, int e, int k,
+		       int overflowchar, int padchar, int exponentchar)
+{
+    char stk[64];
+    int length, exponent, n, dd, ee, ww, d = pd ? *pd : FLOAT_PREC;
+    double value = DFLOAT_VALUE(object);
+
+    if (value == 0.0) {
+	exponent = 0;
+	n = 0;
+	d = 1;
+	strcpy(stk, "+0");
+    }
+    else {
+	/* calculate format parameters, adjusting scale factor */
+	parse_double(stk, &exponent, value, d + k - 1);
+	n = exponent + 1;
+    }
+
+    /* Let ee equal e+2, or 4 if e is omitted. */
+    if (e)
+	ee = e + 2;
+    else
+	ee = 4;
+
+    /* Let ww equal w-ee, or nil if w is omitted. */
+    if (w)
+	ww = w - ee;
+    else
+	ww = 0;
+
+    dd = d - n;
+    if (d >= dd && dd >= 0) {
+	length = LispFormatFixedFloat(stream, object, atsign, ww,
+				      &dd, 0, overflowchar, padchar);
+
+	/* ~ee@T */
+	length += LispWriteChars(stream, padchar, ee);
+    }
+    else
+	length = LispFormatExponentialFloat(stream, object, atsign,
+					    w, pd, e, k, overflowchar,
+					    padchar, exponentchar);
+
+    return (length);
+}
+
+int
+LispFormatDollarFloat(LispObj *stream, LispObj *object,
+		      int atsign, int collon, int d, int n, int w, int padchar)
+{
+    char buffer[512], stk[64];
+    int sign, exponent, length, offset;
+    double value = DFLOAT_VALUE(object);
+
+    if (value == 0.0) {
+	exponent = 0;
+	strcpy(stk, "+0");
+    }
+    else
+	/* calculate format parameters, adjusting scale factor */
+	parse_double(stk, &exponent, value, d == 0 ? FLOAT_PREC : d + 1);
+
+    /* set d to a "sane" value */
+    if (d > 128)
+	d = 128;
+
+    /* set n to a "sane" value */
+    if (n > 128)
+	n = 128;
+
+    /* use exponent as index in stk */
+    ++exponent;
+
+    /* don't put sign in buffer,
+     * if collon specified, must go before padding */
+    sign = atsign || (stk[0] == '-');
+
+    offset = 0;
+
+    /* pad with zeros if required */
+    if (exponent > 0)
+	n -= exponent;
+    while (n > 0) {
+	buffer[offset++] = '0';
+	n--;
+    }
+
+    /* how many bytes in float representation */
+    length = strlen(stk) - 1;
+
+    if (exponent > 0) {
+	if (exponent > length) {
+	    memcpy(buffer + offset, stk + 1, length);
+	    memset(buffer + offset + length, '0', exponent - length);
+	}
+	else
+	    memcpy(buffer + offset, stk + 1, exponent);
+	offset += exponent;
+	buffer[offset++] = '.';
+	if (length > exponent) {
+	    memcpy(buffer + offset, stk + 1 + exponent, length - exponent);
+	    offset += length - exponent;
+	}
+	else
+	    buffer[offset++] = '0';
+    }
+    else {
+	if (n > 0)
+	    buffer[offset++] = '0';
+	buffer[offset++] = '.';
+	while (exponent < 0) {
+	    buffer[offset++] = '0';
+	    exponent++;
+	}
+	memcpy(buffer + offset, stk + 1, length);
+	offset += length;
+    }
+    buffer[offset] = '\0';
+
+    /* make sure only d digits are printed after decimal point */
+    if (d > 0) {
+	char *dptr = strchr(buffer, '.');
+
+	length = strlen(dptr) - 1;
+	/* check if need to remove excess digits */
+	if (length > d) {
+	    int digit;
+
+	    offset = (dptr - buffer) + 1 + d;
+	    digit = buffer[offset];
+
+	    /* remove extra digits */
+	    buffer[offset] = '\0';
+
+	    /* check if need to round */
+	    if (offset > 1 && isdigit(digit) && digit >= '5' &&
+		isdigit(buffer[offset - 1]) &&
+		float_string_inc(buffer, offset - 1))
+		++offset;
+	}
+	/* check if need to add extra zero digits to fill space */
+	else if (length < d) {
+	    offset += d - length;
+	    for (++length; length <= d; length++)
+		dptr[length] = '0';
+	    dptr[length] = '\0';
+	}
+    }
+    else {
+	/* no digits after decimal point */
+	int digit, inc = 0;
+	char *dptr = strchr(buffer, '.') + 1;
+
+	digit = *dptr;
+	if (digit >= '5' && dptr >= buffer + 2 && isdigit(dptr[-2]))
+	    inc = float_string_inc(buffer, dptr - buffer - 2);
+
+	offset = (dptr - buffer) + inc;
+	buffer[offset] = '\0';
+    }
+
+    length = 0;
+    if (sign) {
+	++offset;
+	if (atsign && collon)
+	    length += LispWriteChar(stream, value >= 0.0 ? '+' : '-');
+    }
+
+    /* print padding if required */
+    if (w > offset)
+	length += LispWriteChars(stream, padchar, w - offset);
+
+    if (atsign && !collon)
+	length += LispWriteChar(stream, value >= 0.0 ? '+' : '-');
+
+    /* print float number representation */
+    return (LispWriteStr(stream, buffer, offset) + length);
+}
diff --git a/lisp/write.h b/lisp/write.h
new file mode 100644
index 0000000..994a374
--- /dev/null
+++ b/lisp/write.h
@@ -0,0 +1,80 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/write.h,v 1.9 2002/12/04 05:27:59 paulo Exp $ */
+
+#ifndef Lisp_write_h
+#define Lisp_write_h
+
+#include "io.h"
+
+/*
+ * Prototypes
+ */
+void LispWriteInit(void);
+
+LispObj *Lisp_FreshLine(LispBuiltin*);
+LispObj *Lisp_Prin1(LispBuiltin*);
+LispObj *Lisp_Princ(LispBuiltin*);
+LispObj *Lisp_Print(LispBuiltin*);
+LispObj *Lisp_Terpri(LispBuiltin*);
+LispObj *Lisp_Write(LispBuiltin*);
+LispObj *Lisp_WriteChar(LispBuiltin*);
+LispObj *Lisp_WriteLine(LispBuiltin*);
+LispObj *Lisp_WriteString(LispBuiltin*);
+
+int LispGetColumn(LispObj*);
+
+int LispWriteChar(LispObj*, int);
+int LispWriteChars(LispObj*, int, int);
+int LispWriteStr(LispObj*, char*, long);
+
+	/* write any lisp object to stream */
+int LispWriteObject(LispObj*, LispObj*);
+
+/* formatted output */
+	/* object must be an integer */
+int LispFormatInteger(LispObj*, LispObj*, int, int, int, int, int, int, int);
+	/* must be in range 1 to 3999 for new roman, 1 to 4999 for old roman */
+int LispFormatRomanInteger(LispObj*, long, int);
+	/* must be in range -9999999 to 9999999 */
+int LispFormatEnglishInteger(LispObj*, long, int);
+	/* object must be a character */
+int LispFormatCharacter(LispObj*, LispObj*, int, int);
+	/* object must be a float */
+int LispFormatFixedFloat(LispObj*, LispObj*, int, int, int*, int, int, int);
+	/* object must be a float */
+int LispFormatExponentialFloat(LispObj*, LispObj*,
+			       int, int, int*, int, int, int, int, int);
+	/* object must be a float */
+int LispFormatGeneralFloat(LispObj*, LispObj*, int,
+			   int, int*, int, int, int, int, int);
+int LispFormatDollarFloat(LispObj*, LispObj*, int, int, int, int, int, int);
+
+#endif /* Lisp_write_h */
diff --git a/lisp/xedit.c b/lisp/xedit.c
new file mode 100644
index 0000000..9ef7f8f
--- /dev/null
+++ b/lisp/xedit.c
@@ -0,0 +1,1636 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/xedit.c,v 1.24 2003/01/13 03:57:59 paulo Exp $ */
+
+#include "../xedit.h"
+#include <X11/Xaw/TextSrcP.h>	/* Needs some private definitions */
+#include <X11/Xaw/TextSinkP.h>	/* Also needs private definitions... */
+#include <X11/Xmu/Xmu.h>
+#define XEDIT_LISP_PRIVATE
+#include "xedit.h"
+#include <signal.h>
+
+/* Initialize to enter lisp */
+#define LISP_SETUP()						\
+    int lisp__running = lisp__data.running
+
+/* XXX Maybe should use ualarm or better, setitimer, but one
+ *     second seens good enough to check for interrupts */
+
+#define	ENABLE_SIGALRM()					\
+    old_sigalrm = signal(SIGALRM, SigalrmHandler);		\
+    alarm(1)
+
+#define DISABLE_SIGALRM()					\
+    alarm(0);							\
+    signal(SIGALRM, old_sigalrm)
+
+/* Enter lisp */
+#define LISP_ENTER()						\
+    if (!lisp__running) {					\
+	lisp__data.running = 1;					\
+	XFlush(XtDisplay(textwindow));				\
+	ENABLE_SIGALRM();					\
+	if (sigsetjmp(lisp__data.jmp, 1) != 0) {		\
+	    DISABLE_SIGALRM();					\
+	    lisp__data.running = 0;				\
+	    return;						\
+	}							\
+    }
+
+/* Leave lisp */
+#define LISP_LEAVE()						\
+    if (!lisp__running) {					\
+	DISABLE_SIGALRM();					\
+	LispTopLevel();						\
+	lisp__data.running = 0;					\
+    }
+
+/*
+ * Types
+ */
+typedef struct {
+    XawTextPosition left, right;
+    XrmQuark property;
+} EntityInfo;
+
+/*
+ * Prototypes
+ */
+static Bool ControlGPredicate(Display*, XEvent*, XPointer);
+static ssize_t WriteToStdout(int, const void*, size_t);
+static ssize_t WriteToStderr(int, const void*, size_t);
+static ssize_t WrapWrite(Widget, const void*, size_t);
+static void XeditUpdateModeInfos(void);
+static void XeditPrint(Widget, LispObj*, int);
+static void XeditInteractiveCallback(Widget, XtPointer, XtPointer);
+static void XeditIndentationCallback(Widget, XtPointer, XtPointer);
+static LispObj *XeditCharAt(LispBuiltin*, int);
+static LispObj *XeditSearch(LispBuiltin*, XawTextScanDirection);
+
+/*
+ * Initialization
+ */
+#ifdef SIGNALRETURNSINT
+static int (*old_sigalrm)(int);
+#else
+static void (*old_sigalrm)(int);
+#endif
+
+EditModeInfo *mode_infos;
+Cardinal num_mode_infos;
+
+static LispObj *Oauto_modes, *Oauto_mode, *Osyntax_highlight, *Osyntable_indent;
+
+/* Just to make calling interactive reparse easier */
+static LispObj interactive_arguments[4];
+
+static LispObj *justify_modes[4];
+static LispObj *wrap_modes[3];
+static LispObj *scan_types[5];
+static LispObj *scan_directions[2];
+static LispObj execute_stream;
+static LispString execute_string;
+static LispObj result_stream;
+static LispString result_string;
+static XawTextPropertyList **property_lists;
+static Cardinal num_property_lists;
+
+/* Some hacks to (at lest try to) avoid problems reentering Xlib while
+ * testing for user interrupts */
+static volatile int disable_timeout, request_timeout;
+
+extern int pagesize;
+
+static LispBuiltin xeditbuiltins[] = {
+    {LispFunction, Xedit_AddEntity, "add-entity offset length identifier"},
+    {LispFunction, Xedit_AutoFill, "auto-fill &optional value"},
+    {LispFunction, Xedit_Background, "background &optional color"},
+    {LispFunction, Xedit_CharAfter, "char-after &optional offset"},
+    {LispFunction, Xedit_CharBefore, "char-before &optional offset"},
+    {LispFunction, Xedit_ClearEntities, "clear-entities left right"},
+    {LispFunction, Xedit_ConvertPropertyList, "convert-property-list name definition"},
+    {LispFunction, Xedit_Font, "font &optional font"},
+    {LispFunction, Xedit_Foreground, "foreground &optional color"},
+    {LispFunction, Xedit_GotoChar, "goto-char offset"},
+    {LispFunction, Xedit_HorizontalScrollbar, "horizontal-scrollbar &optional state"},
+    {LispFunction, Xedit_Insert, "insert text"},
+    {LispFunction, Xedit_Justification, "justification &optional value"},
+    {LispFunction, Xedit_LeftColumn, "left-column &optional left"},
+    {LispFunction, Xedit_Point, "point"},
+    {LispFunction, Xedit_PointMax, "point-max"},
+    {LispFunction, Xedit_PointMin, "point-min"},
+    {LispFunction, Xedit_PropertyList, "property-list &optional value"},
+    {LispFunction, Xedit_ReadText, "read-text offset length"},
+    {LispFunction, Xedit_ReplaceText, "replace-text left right text"},
+    {LispFunction, Xedit_RightColumn, "right-column &optional right"},
+    {LispFunction, Xedit_Scan, "scan offset type direction &key count include"},
+    {LispFunction, Xedit_SearchBackward, "search-backward string &optional offset ignore-case"},
+    {LispFunction, Xedit_SearchForward, "search-forward string &optional offset ignore-case"},
+    {LispFunction, Xedit_VerticalScrollbar, "vertical-scrollbar &optional state"},
+    {LispFunction, Xedit_WrapMode, "wrap-mode &optional value"},
+
+	/* This should be available from elsewhere at some time... */
+    {LispFunction, Xedit_XrmStringToQuark, "xrm-string-to-quark string"},
+};
+
+/*
+ * Implementation
+ */
+/*ARGUSED*/
+static Bool
+ControlGPredicate(Display *display, XEvent *event, XPointer arguments)
+{
+    char buffer[2];
+
+    return ((event->type == KeyPress || event->type == KeyRelease) &&
+	    (event->xkey.state & ControlMask) &&
+	    XLookupString(&(event->xkey), buffer, sizeof(buffer), NULL, NULL) &&
+	    buffer[0] == '\a');
+}
+
+/*ARGSUSED*/
+static
+#ifdef SIGNALRETURNSINT
+int
+#else
+void
+#endif
+SigalrmHandler(int signum)
+{
+    XEvent event;
+
+    if (disable_timeout) {
+	request_timeout = 1;
+	return;
+    }
+
+    /* Check if user pressed C-g */
+    if (XCheckIfEvent(XtDisplay(textwindow), &event, ControlGPredicate, NULL)) {
+	XPutBackEvent(XtDisplay(textwindow), &event);
+	alarm(0);
+	/* Tell a signal was received, print message for SIGINT */
+	LispSignal(SIGINT);
+    }
+    else
+	alarm(1);
+#ifdef SIGNALRETURNSINT
+    return (0);
+#endif
+}
+
+static ssize_t
+WrapWrite(Widget output, const void *buffer, size_t nbytes)
+{
+    XawTextBlock block;
+    XawTextPosition position;
+
+    disable_timeout = 1;
+    position = XawTextGetInsertionPoint(output);
+    block.firstPos = 0;
+    block.format = FMT8BIT;
+    block.length = nbytes;
+    block.ptr = (String)buffer;
+    XawTextReplace(output, position, position, &block);
+    XawTextSetInsertionPoint(output, position + block.length);
+    disable_timeout = 0;
+
+    if (request_timeout) {
+	XFlush(XtDisplay(output));
+	request_timeout = 0;
+	SigalrmHandler(SIGALRM);
+    }
+
+    return ((ssize_t)nbytes);
+}
+
+static ssize_t
+WriteToStdout(int fd, const void *buffer, size_t nbytes)
+{
+    return (WrapWrite(textwindow, buffer, nbytes));
+}
+
+static ssize_t
+WriteToStderr(int fd, const void *buffer, size_t nbytes)
+{
+    return (WrapWrite(messwidget, buffer, nbytes));
+}
+
+void
+LispXeditInitialize(void)
+{
+    int i;
+    char *string;
+    LispObj *xedit, *list, *savepackage;
+
+    LispSetFileWrite(Stdout, WriteToStdout);
+    LispSetFileWrite(Stderr, WriteToStderr);
+
+    justify_modes[0]	= KEYWORD("LEFT");
+    justify_modes[1]	= KEYWORD("RIGHT");
+    justify_modes[2]	= KEYWORD("CENTER");
+    justify_modes[3]	= KEYWORD("FULL");
+
+    wrap_modes[0]	= KEYWORD("NEVER");
+    wrap_modes[1]	= KEYWORD("LINE");
+    wrap_modes[2]	= KEYWORD("WORD");
+
+    scan_types[0]	= KEYWORD("POSITIONS");
+    scan_types[1]	= KEYWORD("WHITE-SPACE");
+    scan_types[2]	= KEYWORD("EOL");
+    scan_types[3]	= KEYWORD("PARAGRAPH");
+    scan_types[4]	= KEYWORD("ALL");
+    scan_types[5]	= KEYWORD("ALPHA-NUMERIC");
+
+    scan_directions[0]	= justify_modes[0];
+    scan_directions[1]	= justify_modes[1];
+
+    /* Remember value of current package */
+    savepackage = PACKAGE;
+
+    /* Create the XEDIT package */
+    xedit = LispNewPackage(STRING("XEDIT"), NIL);
+
+    /* Update list of packages */
+    PACK = CONS(xedit, PACK);
+
+    /* Temporarily switch to the XEDIT package */
+    lisp__data.pack = lisp__data.savepack = xedit->data.package.package;
+    PACKAGE = xedit;
+
+    /* Add XEDIT builtin functions */
+    for (i = 0; i < sizeof(xeditbuiltins) / sizeof(xeditbuiltins[0]); i++)
+	LispAddBuiltinFunction(&xeditbuiltins[i]);
+
+    /* Create these objects in the xedit package */
+    Oauto_modes		= STATIC_ATOM("*AUTO-MODES*");
+    Oauto_mode		= STATIC_ATOM("AUTO-MODE");
+    Osyntax_highlight	= STATIC_ATOM("SYNTAX-HIGHLIGHT");
+    Osyntable_indent	= STATIC_ATOM("SYNTABLE-INDENT");
+
+    /*  Import symbols from the LISP and EXT packages */
+    for (list = PACK; CONSP(list); list = CDR(list)) {
+	string = THESTR(CAR(list)->data.package.name);
+	if (strcmp(string, "LISP") == 0 || strcmp(string, "EXT") == 0)
+	    LispUsePackage(CAR(list));
+    }
+
+    /* Restore previous package */
+    lisp__data.pack = savepackage->data.package.package;
+    PACKAGE = savepackage;
+
+    /* Initialize helper static objects used when executing expressions */
+    execute_stream.type = LispStream_t;
+    execute_stream.data.stream.source.string = &execute_string;
+    execute_stream.data.stream.pathname = NIL;
+    execute_stream.data.stream.type = LispStreamString;
+    execute_stream.data.stream.readable = 1;
+    execute_stream.data.stream.writable = 0;
+    execute_string.output = 0;
+    result_stream.type = LispStream_t;
+    result_stream.data.stream.source.string = &result_string;
+    result_stream.data.stream.pathname = NIL;
+    result_stream.data.stream.type = LispStreamString;
+    result_stream.data.stream.readable = 0;
+    result_stream.data.stream.writable = 1;
+    result_string.string = XtMalloc(pagesize);
+    result_string.space = pagesize;
+
+    /* Initialize interactive edition function arguments */
+    /* first argument is syntax table */
+    interactive_arguments[0].type = LispCons_t;
+    interactive_arguments[0].data.cons.cdr = &interactive_arguments[1];
+    /* second argument is where to start reparsing */
+    interactive_arguments[1].type = LispCons_t;
+    interactive_arguments[1].data.cons.cdr = &interactive_arguments[2];
+    /* third argument is where to stop reparsing */
+    interactive_arguments[2].type = LispCons_t;
+    interactive_arguments[2].data.cons.cdr = &interactive_arguments[3];
+    /* fourth argument is interactive flag */
+    interactive_arguments[3].type = LispCons_t;
+    interactive_arguments[3].data.cons.car = T;
+    interactive_arguments[3].data.cons.cdr = NIL;
+
+    /* Load extra functions and data type definitions */
+    EXECUTE("(require \"xedit\")");
+
+
+    /*
+     *	This assumes that the *auto-modes* variable is a list where every
+     * item has the format:
+     *	    (regexp string-desc load-file-desc . symbol-name)
+     *	Minimal error checking is done.
+     */
+
+    if (Oauto_modes->data.atom->a_object) {
+	LispObj *desc, *modes = Oauto_modes->data.atom->property->value;
+
+	for (; CONSP(modes); modes = CDR(modes)) {
+	    list = CAR(modes);
+
+	    desc = NIL;
+	    for (i = 0; i < 3 && CONSP(list); i++, list = CDR(list)) {
+		if (i == 1)
+		    desc = CAR(list);
+	    }
+	    if (i == 3 && STRINGP(desc)) {
+		mode_infos = (EditModeInfo*)
+		    XtRealloc((XtPointer)mode_infos, sizeof(EditModeInfo) *
+			      (num_mode_infos + 1));
+		mode_infos[num_mode_infos].desc = XtNewString(THESTR(desc));
+		mode_infos[num_mode_infos].symbol = list;
+		mode_infos[num_mode_infos].syntax = NULL;
+		++num_mode_infos;
+	    }
+	}
+    }
+}
+
+static void
+XeditUpdateModeInfos(void)
+{
+    int i;
+
+    for (i = 0; i < num_mode_infos; i++) {
+	if (mode_infos[i].symbol &&
+	    mode_infos[i].syntax == NULL &&
+	    XSYMBOLP(mode_infos[i].symbol) &&
+	    mode_infos[i].symbol->data.atom->a_object)
+	    mode_infos[i].syntax =
+		mode_infos[i].symbol->data.atom->property->value;
+    }
+}
+
+void
+XeditLispExecute(Widget output, XawTextPosition left, XawTextPosition right)
+{
+    GC_ENTER();
+    LISP_SETUP();
+    int alloced, return_count;
+    XawTextBlock block;
+    XawTextPosition position;
+    char *string, *ptr;
+    LispObj *result, *code, *_cod, *returns;
+
+    LISP_ENTER();
+
+    position = left;
+    XawTextSourceRead(XawTextGetSource(textwindow), left, &block, right - left);
+    if (block.length < right - left) {
+	alloced = 1;
+	string = ptr = LispMalloc(right - left);
+	memcpy(ptr, block.ptr, block.length);
+	position = left + block.length;
+	ptr += block.length;
+	for (; position < right;) {
+	    XawTextSourceRead(XawTextGetSource(textwindow),
+			      position, &block, right - position);
+	    memcpy(ptr, block.ptr, block.length);
+	    position += block.length;
+	    ptr += block.length;
+	}
+    }
+    else {
+	alloced = 0;
+	string = block.ptr;
+    }
+
+    execute_string.string = string;
+    execute_string.length = right - left;
+    execute_string.input = 0;
+    LispPushInput(&execute_stream);
+    _cod = COD;
+    result = NIL;
+    if ((code = LispRead()) != NULL)
+	result = EVAL(code);
+    COD = _cod;
+    LispPopInput(&execute_stream);
+
+    returns = NIL;
+    if (RETURN_COUNT > 0) {
+	GC_PROTECT(result);
+	returns = _cod = CONS(RETURN(0), NIL);
+	GC_PROTECT(returns);
+	for (return_count = 1; return_count < RETURN_COUNT; return_count++) {
+	    RPLACD(_cod, CONS(RETURN(return_count), NIL));
+	    _cod = CDR(_cod);
+	}
+    }
+    LispFflush(Stdout);
+    LispUpdateResults(code, result);
+    if (RETURN_COUNT >= 0) {
+	XeditPrint(output, result, 1);
+	for (; CONSP(returns); returns = CDR(returns))
+	    XeditPrint(output, CAR(returns), 0);
+    }
+
+    if (alloced)
+	LispFree(string);
+    GC_LEAVE();
+
+    LISP_LEAVE();
+}
+
+static void
+XeditPrint(Widget output, LispObj *object, int newline)
+{
+    XawTextBlock block;
+    XawTextPosition position;
+
+    result_string.length = result_string.output = 0;
+    if (newline) {
+	position = XawTextGetInsertionPoint(output);
+	if (position != XawTextSourceScan(XawTextGetSource(output),
+					  position, XawstEOL,
+					  XawsdLeft, 1, False))
+	    LispSputc(&result_string, '\n');
+    }
+    LispWriteObject(&result_stream, object);
+    LispSputc(&result_string, '\n');
+
+    position = XawTextGetInsertionPoint(output);
+    block.firstPos = 0;
+    block.format = FMT8BIT;
+    block.length = result_string.length;
+    block.ptr = result_string.string;
+    XawTextReplace(output, position, position, &block);
+    XawTextSetInsertionPoint(output, position + block.length);
+}
+
+/*
+ *  This function is defined here to avoid exporting all the lisp interfaces
+ * to the core xedit code.
+ */
+void
+XeditLispSetEditMode(xedit_flist_item *item, LispObj *symbol)
+{
+    GC_ENTER();
+    LISP_SETUP();
+    LispObj *syntax, *name;
+
+    item->xldata = (XeditLispData*)XtCalloc(1, sizeof(XeditLispData));
+
+    LISP_ENTER();
+
+    /* Create an object that represents the buffer filename.
+     * Note that the entire path is passed to the auto-mode
+     * function, so that directory names may be also be used
+     * when determining a file type. */
+    name = STRING(item->filename);
+    GC_PROTECT(name);
+
+    /*  Call the AUTO-MODE function to check if there is a
+     * syntax definition for the file being loaded */
+    if (symbol == NULL)
+	syntax = APPLY1(Oauto_mode, name);
+    else
+	syntax = APPLY2(Oauto_mode, name, symbol);
+
+    /* Don't need the name object anymore */
+    GC_LEAVE();
+
+    if (syntax != NIL) {
+	Arg arg[1];
+	LispObj arguments;
+	XawTextPropertyList *property_list;
+
+	item->xldata->syntax = syntax;
+
+	/* Apply the syntax highlight to the current buffer */
+	arguments.type = LispCons_t;
+	arguments.data.cons.car = syntax;
+	arguments.data.cons.cdr = NIL;
+	LispFuncall(Osyntax_highlight, &arguments, 1);
+
+	/*  The previous call added the property list to the widget,
+	 * remember it when switching sources. */
+	XtSetArg(arg[0], XawNtextProperties, &property_list);
+	XtGetValues(XawTextGetSink(textwindow), arg, 1);
+	item->properties = property_list;
+
+	/* Add callback for interactive changes */
+	XtAddCallback(item->source, XtNpropertyCallback,
+		      XeditInteractiveCallback, item->xldata);
+
+	/* Update information as a new file may have been loaded */
+	XeditUpdateModeInfos();
+    }
+    else
+	item->properties = NULL;
+
+    LISP_LEAVE();
+}
+
+void
+XeditLispUnsetEditMode(xedit_flist_item *item)
+{
+    if (item->xldata) {
+	XtRemoveCallback(item->source, XtNpropertyCallback,
+			 XeditInteractiveCallback, item->xldata);
+	XtFree((XtPointer)item->xldata);
+	item->xldata = NULL;
+    }
+}
+
+#define MAX_INFOS	32
+/*
+ *  This callback tries to do it's best in generating correct output while
+ * also doing minimal work/redrawing of the screen. It probably will fail
+ * for some syntax-definitions, or will just not properly repaint the
+ * screen. In the later case, just press Ctrl+L.
+ *  There isn't yet any command to force reparsing of some regions, and if
+ * the parser becomes confused, you may need to go to a line, press a space
+ * and undo, just to force it to reparse the line, and possibly some extra
+ * lines until the parser thinks the display is in sync.
+ *  Sometimes it will repaint a lot more of text than what is being requested
+ * by this callback, this should be fixed at some time, as for certain cases
+ * it is also required some redesign in the Xaw interface.
+ */
+static void
+XeditInteractiveCallback(Widget w, XtPointer client_data, XtPointer call_data)
+{
+    LISP_SETUP();
+    XeditLispData *data = (XeditLispData*)client_data;
+    LispObj *syntax = data->syntax;
+    XawTextPropertyInfo *info = (XawTextPropertyInfo*)call_data;
+    LispObj *result, *syntable;
+    XawTextAnchor *anchor;
+    XawTextEntity *entity;
+    XawTextPosition first, last, left, right, begin, next, tmp, position;
+    int i, j, indent;
+    TextSrcObject src = (TextSrcObject)w;
+    EntityInfo oinfo[MAX_INFOS], ninfo[MAX_INFOS];
+    XrmQuark props[MAX_INFOS];
+    int num_oinfo, num_ninfo, num_props;
+    XmuScanline *clip, *oclip, *nclip;
+    XmuSegment segment, *seg;
+
+    if (data->disable_highlight)
+	return;
+
+    LISP_ENTER();
+
+    first = XawTextSourceScan(w, 0, XawstAll, XawsdLeft, 1, True);
+    last = XawTextSourceScan(w, 0, XawstAll, XawsdRight, 1, True);
+
+    left = info->left;
+    right = left + info->block->length;
+
+    /* For now, only call the indent hook if a single character was typed */
+    indent = (info->right == left) && (right == left + 1);
+
+    /* Always reparse full lines */
+    left = begin = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 1, False);
+    right = next = XawTextSourceScan(w, right, XawstEOL, XawsdRight, 1, False);
+
+
+    /*  Check properties in the modified text. If a complex nested syntax
+     * table was parsed, the newline has it's default property, so, while
+     * the newline has a property, backup a line to make sure everything is
+     * properly parsed.
+     *  Maybe should limit the number of backuped lines, but if the parsing
+     * becomes noticeable slow, better to rethink the syntax definition. */
+    while (left > first) {
+	position = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 1, True);
+	if (XawTextSourceAnchorAndEntity(w, position, &anchor, &entity))
+	    left = XawTextSourceScan(w, left, XawstEOL, XawsdLeft, 2, False);
+	else
+	    break;
+    }
+
+    /*	While the newline after the right position has a "hidden" property,
+     * keep incrementing a line to be reparsed. */
+    while (right < last) {
+	if (XawTextSourceAnchorAndEntity(w, right, &anchor, &entity))
+	    right = XawTextSourceScan(w, right, XawstEOL, XawsdRight, 2, False);
+	else
+	    break;
+    }
+
+#ifndef MAX
+#define MAX(a, b)	((a) > (b) ? (a) : (b))
+#endif
+
+#ifndef MIN
+#define MIN(a, b)	((a) < (b) ? (a) : (b))
+#endif
+
+#define STORE_STATE(count, info, from, to)				\
+    (count) = 0;							\
+    if ((anchor = XawTextSourceFindAnchor(w, (from))) != NULL) {	\
+	entity = anchor->entities;					\
+	/* Find first entity in the region to parse */			\
+	while (entity &&						\
+	       anchor->position + entity->offset + entity->length <=	\
+	       (from))							\
+	    entity = entity->next;					\
+	/* Loop storing information */					\
+	while (entity &&						\
+	    (position = anchor->position + entity->offset) < (to)) {	\
+	    (info)[(count)].left = MAX(position, (from));		\
+	    position += entity->length;					\
+	    (info)[(count)].right = MIN(position, (to));		\
+	    (info)[(count)].property = entity->property;		\
+	    /* If the changes are so complex, user need press Ctrl+L */	\
+	    if (++(count) >= MAX_INFOS)					\
+		break;							\
+	    if ((entity = entity->next) == NULL &&			\
+		(anchor = XawTextSourceNextAnchor(w, anchor)) != NULL)	\
+		entity = anchor->entities;				\
+	}								\
+    }
+
+    /* Remember old state */
+    STORE_STATE(num_oinfo, oinfo, begin, right);
+
+    /* Reparse the lines in the modified/edited range of text */
+    interactive_arguments[0].data.cons.car = syntax;
+    interactive_arguments[1].data.cons.car = FIXNUM(left);
+    interactive_arguments[2].data.cons.car = FIXNUM(right);
+    result = APPLY(Osyntax_highlight, &interactive_arguments[0]);
+    /* Indent table is the second return value */
+    if (RETURN_COUNT)
+	syntable = RETURN(0);
+    else
+	syntable = NIL;
+
+    /* This normally is the same value as right, but the parser may have
+     * continued when the syntax table stack did not finish. */
+    if (FIXNUMP(result))
+	right = FIXNUM_VALUE(result);
+
+    LISP_LEAVE();
+
+    /* Check what have changed */
+    STORE_STATE(num_ninfo, ninfo, begin, right);
+
+    /* Initialize to redraw everything. */
+    clip = XmuNewScanline(0, begin, right);
+
+#define CLIP_MASK(mask, from, to)					\
+    if ((from) < (to)) {						\
+	segment.x1 = (from);						\
+	segment.x2 = (to);						\
+	XmuScanlineOrSegment((mask), &segment);				\
+    }
+
+    oclip = XmuNewScanline(0, 0, 0);
+    nclip = XmuNewScanline(0, 0, 0);
+
+#define CLIP_DEFAULT(mask, from, info, num_info)			\
+    for (tmp = (from), i = 0; i < (num_info); i++) {			\
+	CLIP_MASK((mask), tmp, (info)[i].left);				\
+	tmp = (info)[i].right;						\
+    }
+
+    /* First generate masks of regions with the default property */
+    CLIP_DEFAULT(oclip, begin, oinfo, num_oinfo);
+    CLIP_DEFAULT(nclip, begin, ninfo, num_ninfo);
+
+    /* Store unchanged region in oclip */
+    XmuScanlineAnd(oclip, nclip);
+
+    /* Don't need to redraw the region in oclip */
+    XmuScanlineXor(clip, oclip);
+
+#define LIST_PROPERTIES(prop, num_prop, info, num_info)			\
+    (num_prop) = 0;							\
+    for (i = 0; i < (num_info); i++) {					\
+	for (j = 0; j < (num_prop); j++)				\
+	    if ((prop)[j] == (info)[i].property)			\
+		break;							\
+	if (j == (num_prop))						\
+	    (prop)[(num_prop)++] = (info)[i].property;			\
+    }
+
+    /* Prepare to generate masks of regions of text with defined properties */
+    LIST_PROPERTIES(props, num_props, oinfo, num_oinfo);
+
+#define CLIP_PROPERTY(mask, prop, info, num_info)			\
+    for (j = 0; j < (num_info); j++) {					\
+	if ((info)[j].property == (prop)) {				\
+	    CLIP_MASK((mask), (info)[j].left, (info)[j].right);		\
+	}								\
+    }
+
+    /* Only care about the old properties, new ones need to be redrawn */
+    for (i = 0; i < num_props; i++) {
+	XrmQuark property = props[i];
+
+	/* Reset oclip and nclip */
+	XmuScanlineXor(oclip, oclip);
+	XmuScanlineXor(nclip, nclip);
+
+	/* Generate masks */
+	CLIP_PROPERTY(oclip, property, oinfo, num_oinfo);
+	CLIP_PROPERTY(nclip, property, ninfo, num_ninfo);
+
+	/* Store unchanged region in oclip */
+	XmuScanlineAnd(oclip, nclip);
+
+	/* Don't need to redraw the region in oclip */
+	XmuScanlineXor(clip, oclip);
+	XmuOptimizeScanline(clip);
+    }
+
+    XmuDestroyScanline(oclip);
+    XmuDestroyScanline(nclip);
+
+    /* Tell Xaw that need update some regions */
+    for (seg = clip->segment; seg; seg = seg->next) {
+	for (i = 0; i < src->textSrc.num_text; i++)
+	    /* This really should have an exported interface... */
+	    _XawTextNeedsUpdating((TextWidget)(src->textSrc.text[i]),
+				  seg->x1, seg->x2 + (seg->x2 > next));
+    }
+    XmuDestroyScanline(clip);
+
+    data->syntable = syntable;
+    /* XXX check lisp__running to know if at the toplevel parsing state */
+    if (indent && syntable != NIL && !lisp__running &&
+	/* Doing an undo, probably will need an exported interface for this
+	 * case. Should not change the text now. */
+	(!src->textSrc.enable_undo || !src->textSrc.undo_state))
+	XtAddCallback(textwindow, XtNpositionCallback,
+		      XeditIndentationCallback, data);
+}
+
+/*
+ * This callback is called if the syntax table where the cursor is located
+ * defines an indentation function.
+ */
+static void
+XeditIndentationCallback(Widget w, XtPointer client_data, XtPointer call_data)
+{
+    LISP_SETUP();
+    LispObj *indentp;
+    XeditLispData *data = (XeditLispData*)client_data;
+
+    data->disable_highlight = True;
+    XtRemoveCallback(w, XtNpositionCallback, XeditIndentationCallback, data);
+
+    LISP_ENTER();
+
+    /* Get pointer to indentation function */
+    indentp = APPLY1(Osyntable_indent, data->syntable);
+
+    /* Execute indentation function */
+    if (indentp != NIL)
+	APPLY2(indentp, data->syntax, data->syntable);
+
+    data->disable_highlight = False;
+
+    LISP_LEAVE();
+}
+
+/************************************************************************
+ * Builtin functions
+ ************************************************************************/
+LispObj *
+Xedit_AddEntity(LispBuiltin *builtin)
+/*
+ add-entity offset length identifier
+ */
+{
+    LispObj *offset, *length, *identifier;
+
+    identifier = ARGUMENT(2);
+    length = ARGUMENT(1);
+    offset = ARGUMENT(0);
+
+    CHECK_INDEX(offset);
+    CHECK_INDEX(length);
+    CHECK_LONGINT(identifier);
+
+    return (XawTextSourceAddEntity(XawTextGetSource(textwindow), 0, 0, NULL,
+				   FIXNUM_VALUE(offset), FIXNUM_VALUE(length),
+				   LONGINT_VALUE(identifier)) ? T : NIL);
+}
+
+LispObj *
+Xedit_AutoFill(LispBuiltin *builtin)
+/*
+ auto-fill &optional value
+ */
+{
+    Arg arg[1];
+    Boolean state;
+
+    LispObj *value;
+
+    value = ARGUMENT(0);
+
+    if (value != UNSPEC) {
+	XtSetArg(arg[0], XtNautoFill, value == NIL ? False : True);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	XtSetArg(arg[0], XtNautoFill, &state);
+	XtGetValues(textwindow, arg, 1);
+	value = state ? T : NIL;
+    }
+
+    return (value);
+}
+
+LispObj *
+Xedit_Background(LispBuiltin *builtin)
+/*
+ background &optional color
+ */
+{
+    Pixel pixel;
+    Arg arg[1];
+    XrmValue from, to;
+
+    LispObj *color;
+
+    color = ARGUMENT(0);
+
+    if (color != UNSPEC) {
+	CHECK_STRING(color);
+
+	from.size = STRLEN(color);
+	from.addr = (XtPointer)THESTR(color);
+	to.size = sizeof(Pixel);
+	to.addr = (XtPointer)&pixel;
+
+	if (!XtConvertAndStore(XawTextGetSink(textwindow),
+			       XtRString, &from, XtRPixel, &to))
+	    LispDestroy("cannot convert %s to Pixel", STROBJ(color));
+
+	XtSetArg(arg[0], XtNbackground, pixel);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	from.size = sizeof(Pixel);
+	from.addr = (XtPointer)&pixel;
+	to.size = 0;
+	to.addr = NULL;
+
+	XtSetArg(arg[0], XtNbackground, &pixel);
+	XtGetValues(XawTextGetSink(textwindow), arg, 1);
+	/* This cannot fail */
+	XtConvertAndStore(textwindow, XtRPixel, &from, XtRString, &to);
+
+	color = STRING(to.addr);
+    }
+
+    return (color);
+}
+
+static LispObj *
+XeditCharAt(LispBuiltin *builtin, int before)
+{
+    Widget source = XawTextGetSource(textwindow);
+    XawTextPosition first, point, last;
+    XawTextBlock block;
+
+    LispObj *offset;
+
+    offset = ARGUMENT(0);
+    if (offset != UNSPEC) {
+	CHECK_INDEX(offset);
+    }
+
+    first = XawTextSourceScan(source, 0, XawstAll, XawsdLeft, 1, True);
+    if (FIXNUMP(offset))
+	point = FIXNUM_VALUE(offset);
+    else
+	point = XawTextGetInsertionPoint(textwindow);
+    if (before && point > first) {
+	XawTextPosition position =
+	    XawTextSourceScan(source, point, XawstPositions, XawsdLeft, 1, True);
+
+	if (position < point)
+	    point = position;
+	else
+	    return (NIL);
+    }
+    last = XawTextSourceScan(source, 0, XawstAll, XawsdRight, 1, True);
+
+    if (point < first || point > last)
+	return (NIL);
+
+    XawTextSourceRead(source, point, &block, 1);
+
+    return (block.length ? SCHAR(*(unsigned char*)block.ptr) : NIL);
+}
+
+LispObj *
+Xedit_CharAfter(LispBuiltin *builtin)
+/*
+ char-after &optional offset
+ */
+{
+    return (XeditCharAt(builtin, 0));
+}
+
+LispObj *
+Xedit_CharBefore(LispBuiltin *builtin)
+/*
+ char-before &optional offset
+ */
+{
+    return (XeditCharAt(builtin, 1));
+}
+
+LispObj *
+Xedit_ClearEntities(LispBuiltin *builtin)
+/*
+ clear-entities left right
+ */
+{
+    LispObj *left, *right;
+
+    right = ARGUMENT(1);
+    left = ARGUMENT(0);
+
+    CHECK_INDEX(left);
+    CHECK_INDEX(right);
+
+    XawTextSourceClearEntities(XawTextGetSource(textwindow),
+			       FIXNUM_VALUE(left), FIXNUM_VALUE(right));
+
+    return (T);
+}
+
+LispObj *
+Xedit_ConvertPropertyList(LispBuiltin *builtin)
+/*
+ convert-property-list name definition
+ */
+{
+    LispObj *result;
+    XawTextPropertyList *property_list;
+
+    LispObj *name, *definition;
+
+    definition = ARGUMENT(1);
+    name = ARGUMENT(0);
+
+    CHECK_STRING(name);
+    CHECK_STRING(definition);
+
+    result = NIL;
+    property_list = XawTextSinkConvertPropertyList(THESTR(name),
+						   THESTR(definition),
+						   topwindow->core.screen,
+						   topwindow->core.colormap,
+						   topwindow->core.depth);
+
+    if (property_list) {
+	Cardinal i;
+
+	for (i = 0; i < num_property_lists; i++)
+	    /* Check if a new property list was created */
+	    if (property_lists[i]->identifier == property_list->identifier)
+		break;
+
+	/* Remember this pointer when asked back for it */
+	if (i == num_property_lists) {
+	    property_lists = (XawTextPropertyList**)
+		XtRealloc((XtPointer)property_lists,
+			  sizeof(XawTextPropertyList) *
+			  (num_property_lists + 1));
+	    property_lists[num_property_lists++] = property_list;
+	}
+	result = INTEGER(property_list->identifier);
+    }
+
+    return (result);
+}
+
+LispObj *
+Xedit_Font(LispBuiltin *builtin)
+/*
+ font &optional font
+ */
+{
+    XFontStruct *font_struct;
+    Arg arg[1];
+    XrmValue from, to;
+
+    LispObj *font;
+
+    font = ARGUMENT(0);
+
+    if (font != UNSPEC) {
+	CHECK_STRING(font);
+
+	from.size = STRLEN(font);
+	from.addr = (XtPointer)THESTR(font);
+	to.size = sizeof(XFontStruct*);
+	to.addr = (XtPointer)&font_struct;
+
+	if (!XtConvertAndStore(textwindow, XtRString, &from, XtRFontStruct, &to))
+	    LispDestroy("cannot convert %s to FontStruct", STROBJ(font));
+
+	XtSetArg(arg[0], XtNfont, font_struct);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	from.size = sizeof(XFontStruct*);
+	from.addr = (XtPointer)&font_struct;
+	to.size = 0;
+	to.addr = NULL;
+
+	XtSetArg(arg[0], XtNfont, &font_struct);
+	XtGetValues(XawTextGetSink(textwindow), arg, 1);
+	/* This cannot fail */
+	XtConvertAndStore(textwindow, XtRFontStruct, &from, XtRString, &to);
+
+	font = STRING(to.addr);
+    }
+
+    return (font);
+}
+
+LispObj *
+Xedit_Foreground(LispBuiltin *builtin)
+/*
+ foreground &optional color
+ */
+{
+    Pixel pixel;
+    Arg arg[1];
+    XrmValue from, to;
+
+    LispObj *color;
+
+    color = ARGUMENT(0);
+
+    if (color != UNSPEC) {
+	CHECK_STRING(color);
+
+	from.size = STRLEN(color);
+	from.addr = (XtPointer)THESTR(color);
+	to.size = sizeof(Pixel);
+	to.addr = (XtPointer)&pixel;
+
+	if (!XtConvertAndStore(XawTextGetSink(textwindow),
+			       XtRString, &from, XtRPixel, &to))
+	    LispDestroy("cannot convert %s to Pixel", STROBJ(color));
+
+	XtSetArg(arg[0], XtNforeground, pixel);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	from.size = sizeof(Pixel);
+	from.addr = (XtPointer)&pixel;
+	to.size = 0;
+	to.addr = NULL;
+
+	XtSetArg(arg[0], XtNforeground, &pixel);
+	XtGetValues(XawTextGetSink(textwindow), arg, 1);
+	/* This cannot fail */
+	XtConvertAndStore(textwindow, XtRPixel, &from, XtRString, &to);
+
+	color = STRING(to.addr);
+    }
+
+    return (color);
+}
+
+LispObj *
+Xedit_GotoChar(LispBuiltin *builtin)
+/*
+ goto-char offset
+ */
+{
+    LispObj *offset;
+    XawTextPosition point;
+
+    offset = ARGUMENT(0);
+
+    CHECK_INDEX(offset);
+    XawTextSetInsertionPoint(textwindow, FIXNUM_VALUE(offset));
+    point = XawTextGetInsertionPoint(textwindow);
+    if (point != FIXNUM_VALUE(offset))
+	offset = FIXNUM(point);
+
+    return (offset);
+}
+
+LispObj *
+Xedit_HorizontalScrollbar(LispBuiltin *builtin)
+/*
+ horizontal-scrollbar &optional state
+ */
+{
+    Arg arg[1];
+    XawTextScrollMode scroll;
+
+    LispObj *state;
+
+    state = ARGUMENT(0);
+
+    if (state != UNSPEC) {
+	scroll = state == NIL ? XawtextScrollNever : XawtextScrollAlways;
+	XtSetArg(arg[0], XtNscrollHorizontal, scroll);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	XtSetArg(arg[0], XtNscrollHorizontal, &scroll);
+	XtGetValues(textwindow, arg, 1);
+	state = scroll == XawtextScrollAlways ? T : NIL;
+    }
+
+    return (state);
+}
+
+LispObj *
+Xedit_Insert(LispBuiltin *builtin)
+/*
+ insert text
+ */
+{
+    XawTextPosition point = XawTextGetInsertionPoint(textwindow);
+    XawTextBlock block;
+
+    LispObj *text;
+
+    text = ARGUMENT(0);
+
+    CHECK_STRING(text);
+    
+    block.firstPos = 0;
+    block.format = FMT8BIT;
+    block.length = STRLEN(text);
+    block.ptr = THESTR(text);
+    XawTextReplace(textwindow, point, point, &block);
+    XawTextSetInsertionPoint(textwindow, point + block.length);
+
+    return (text);
+}
+
+LispObj *
+Xedit_Justification(LispBuiltin *builtin)
+/*
+ justification &optional value
+ */
+{
+    int i;
+    Arg arg[1];
+    XawTextJustifyMode justify;
+
+    LispObj *value;
+
+    value = ARGUMENT(0);
+
+    if (value != UNSPEC) {
+	for (i = 0; i < 4; i++)
+	    if (value == justify_modes[i])
+		break;
+	if (i >= 4)
+	    LispDestroy("%s: argument must be "
+			":LEFT, :RIGHT, :CENTER, or :FULL, not %s",
+			STRFUN(builtin), STROBJ(value));
+	XtSetArg(arg[0], XtNjustifyMode, (XawTextJustifyMode)i);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	XtSetArg(arg[0], XtNjustifyMode, &justify);
+	XtGetValues(textwindow, arg, 1);
+	i = (int)justify;
+	if (i <= 0 || i >= 4)
+	    i = 0;
+	value = justify_modes[i];
+    }
+
+    return (value);
+}
+
+LispObj *
+Xedit_LeftColumn(LispBuiltin *builtin)
+/*
+ left-column &optional left
+ */
+{
+    short left;
+    Arg arg[1];
+
+    LispObj *oleft;
+
+    oleft = ARGUMENT(0);
+
+    if (oleft != UNSPEC) {
+	CHECK_INDEX(oleft);
+	if (FIXNUM_VALUE(oleft) >= 32767)
+	    left = 32767;
+	else
+	    left = FIXNUM_VALUE(oleft);
+
+	XtSetArg(arg[0], XtNleftColumn, left);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	XtSetArg(arg[0], XtNleftColumn, &left);
+	XtGetValues(textwindow, arg, 1);
+
+	oleft = FIXNUM((long)left);
+    }
+
+    return (oleft);
+}
+
+LispObj *
+Xedit_Point(LispBuiltin *builtin)
+/*
+ point
+ */
+{
+    return (FIXNUM(XawTextGetInsertionPoint(textwindow)));
+}
+
+LispObj *
+Xedit_PointMax(LispBuiltin *builtin)
+/*
+ point-max
+ */
+{
+    return (FIXNUM(XawTextSourceScan(XawTextGetSource(textwindow), 0,
+				     XawstAll, XawsdRight, 1, True)));
+}
+
+LispObj *
+Xedit_PointMin(LispBuiltin *builtin)
+/*
+ point-min
+ */
+{
+    return (FIXNUM(XawTextSourceScan(XawTextGetSource(textwindow), 0,
+				     XawstAll, XawsdLeft, 1, True)));
+}
+
+LispObj *
+Xedit_PropertyList(LispBuiltin *builtin)
+/*
+ property-list &optional value
+ */
+{
+    Arg arg[1];
+    XawTextPropertyList *property_list;
+
+    LispObj *value;
+
+    value = ARGUMENT(0);
+
+    if (value != UNSPEC) {
+	Cardinal i;
+	XrmQuark quark;
+
+	CHECK_LONGINT(value);
+	property_list = NULL;
+	quark = LONGINT_VALUE(value);
+	for (i = 0; i < num_property_lists; i++)
+	    if (property_lists[i]->identifier == quark) {
+		property_list = property_lists[i];
+		break;
+	    }
+
+	if (property_list) {
+	    XtSetArg(arg[0], XawNtextProperties, property_list);
+	    XtSetValues(XawTextGetSink(textwindow), arg, 1);
+	}
+	else
+	    /* Maybe should generate an error here */
+	    value = NIL;
+    }
+    else {
+	XtSetArg(arg[0], XawNtextProperties, &property_list);
+	XtGetValues(XawTextGetSink(textwindow), arg, 1);
+	if (property_list)
+	    value = INTEGER(property_list->identifier);
+    }
+
+    return (value);
+}
+
+LispObj *
+Xedit_ReadText(LispBuiltin *builtin)
+/*
+ read-text offset length
+ */
+{
+    XawTextPosition last = XawTextSourceScan(XawTextGetSource(textwindow), 0,
+					     XawstAll, XawsdRight, 1, True);
+    XawTextPosition from, to, len;
+    XawTextBlock block;
+    char *string, *ptr;
+
+    LispObj *offset, *length;
+
+    length = ARGUMENT(1);
+    offset = ARGUMENT(0);
+
+    CHECK_INDEX(offset);
+    CHECK_INDEX(length);
+
+    from = FIXNUM_VALUE(offset);
+    to = from + FIXNUM_VALUE(length);
+    if (from > last)
+	from = last;
+    if (to > last)
+	to = last;
+
+    if (from == to)
+	return (STRING(""));
+
+    len = to - from;
+    string = LispMalloc(len);
+
+    for (ptr = string; from < to;) {
+	XawTextSourceRead(XawTextGetSource(textwindow), from, &block, to - from);
+	memcpy(ptr, block.ptr, block.length);
+	ptr += block.length;
+	from += block.length;
+    }
+
+    return (LSTRING2(string, len));
+}
+
+LispObj *
+Xedit_ReplaceText(LispBuiltin *builtin)
+/*
+ replace-text left right text
+ */
+{
+    XawTextPosition last = XawTextSourceScan(XawTextGetSource(textwindow), 0,
+					     XawstAll, XawsdRight, 1, True);
+    XawTextPosition left, right;
+    XawTextBlock block;
+
+    LispObj *oleft, *oright, *text;
+
+    text = ARGUMENT(2);
+    oright = ARGUMENT(1);
+    oleft = ARGUMENT(0);
+
+    CHECK_INDEX(oleft);
+    CHECK_INDEX(oright);
+    CHECK_STRING(text);
+
+    left = FIXNUM_VALUE(oleft);
+    right = FIXNUM_VALUE(oright);
+    if (left > last)
+	left = last;
+    if (left > right)
+	right = left;
+    else if (right > last)
+	right = last;
+
+    block.firstPos = 0;
+    block.format = FMT8BIT;
+    block.length = STRLEN(text);
+    block.ptr = THESTR(text);
+    XawTextReplace(textwindow, left, right, &block);
+
+    return (text);
+}
+
+LispObj *
+Xedit_RightColumn(LispBuiltin *builtin)
+/*
+ right-column &optional right
+ */
+{
+    short right;
+    Arg arg[1];
+
+    LispObj *oright;
+
+    oright = ARGUMENT(0);
+
+    if (oright != UNSPEC) {
+	CHECK_INDEX(oright);
+	if (FIXNUM_VALUE(oright) >= 32767)
+	    right = 32767;
+	else
+	    right = FIXNUM_VALUE(oright);
+
+	XtSetArg(arg[0], XtNrightColumn, right);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	XtSetArg(arg[0], XtNrightColumn, &right);
+	XtGetValues(textwindow, arg, 1);
+
+	oright = FIXNUM(right);
+    }
+
+    return (oright);
+}
+
+LispObj *
+Xedit_Scan(LispBuiltin *builtin)
+/*
+ scan offset type direction &key count include
+ */
+{
+    int i;
+    XawTextPosition offset;
+    XawTextScanType type;
+    XawTextScanDirection direction;
+    int count;
+
+    LispObj *ooffset, *otype, *odirection, *ocount, *include;
+
+    include = ARGUMENT(4);
+    if (include == UNSPEC)
+	include = NIL;
+    ocount = ARGUMENT(3);
+    odirection = ARGUMENT(2);
+    otype = ARGUMENT(1);
+    ooffset = ARGUMENT(0);
+
+    CHECK_INDEX(ooffset);
+    offset = FIXNUM_VALUE(ooffset);
+
+    for (i = 0; i < 2; i++)
+	if (odirection == scan_directions[i])
+	    break;
+    if (i >= 2)
+	LispDestroy("%s: direction must be "
+		    ":LEFT or :RIGHT, not %s",
+		    STRFUN(builtin), STROBJ(odirection));
+    direction = (XawTextScanDirection)i;
+
+    for (i = 0; i < 5; i++)
+	if (otype == scan_types[i])
+	    break;
+    if (i >= 5)
+	LispDestroy("%s: direction must be "
+		    ":POSITIONS, :WHITE-SPACE, :EOL, "
+		    ":PARAGRAPH, :ALL, or :ALPHA-NUMERIC, not %s",
+		    STRFUN(builtin), STROBJ(otype));
+    type = (XawTextScanType)i;
+
+    if (ocount == UNSPEC)
+	count = 1;
+    else {
+	CHECK_INDEX(ocount);
+	count = FIXNUM_VALUE(ocount);
+    }
+
+    offset = XawTextSourceScan(XawTextGetSource(textwindow),
+			       offset, type, direction, count,
+			       include != NIL);
+
+    return (FIXNUM(offset));
+}
+
+static LispObj *
+XeditSearch(LispBuiltin *builtin, XawTextScanDirection direction)
+{
+    XawTextBlock block;
+    XawTextPosition position;
+
+    LispObj *string, *offset, *ignore_case;
+
+    ignore_case = ARGUMENT(2);
+    offset = ARGUMENT(1);
+    string = ARGUMENT(0);
+
+    CHECK_STRING(string);
+    if (offset != UNSPEC) {
+	CHECK_INDEX(offset);
+	position = FIXNUM_VALUE(offset);
+    }
+    else
+	position = XawTextGetInsertionPoint(textwindow);
+
+    block.firstPos = (ignore_case != UNSPEC && ignore_case != NIL) ? 1 : 0;
+    block.format = FMT8BIT;
+    block.length = STRLEN(string);
+    block.ptr = THESTR(string);
+    position = XawTextSourceSearch(XawTextGetSource(textwindow),
+				   position, direction, &block);
+
+    return (position != XawTextSearchError ? FIXNUM(position) : NIL);
+}
+
+
+LispObj *
+Xedit_SearchBackward(LispBuiltin *builtin)
+/*
+ search-backward string &optional offset ignore-case
+ */
+{
+    return (XeditSearch(builtin, XawsdLeft));
+}
+
+LispObj *
+Xedit_SearchForward(LispBuiltin *builtin)
+/*
+ search-forward string &optional offset ignore-case
+ */
+{
+    return (XeditSearch(builtin, XawsdRight));
+}
+
+LispObj *
+Xedit_VerticalScrollbar(LispBuiltin *builtin)
+/*
+ vertical-scrollbar &optional state
+ */
+{
+    Arg arg[1];
+    XawTextScrollMode scroll;
+
+    LispObj *state;
+
+    state = ARGUMENT(0);
+
+    if (state != UNSPEC) {
+	scroll = state == NIL ? XawtextScrollNever : XawtextScrollAlways;
+	XtSetArg(arg[0], XtNscrollVertical, scroll);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	XtSetArg(arg[0], XtNscrollVertical, &scroll);
+	XtGetValues(textwindow, arg, 1);
+	state = scroll == XawtextScrollAlways ? T : NIL;
+    }
+
+    return (state);
+}
+
+LispObj *
+Xedit_WrapMode(LispBuiltin *builtin)
+/*
+ wrap-mode &optional value
+ */
+{
+    int i;
+    Arg arg[1];
+    XawTextWrapMode wrap;
+
+    LispObj *value;
+
+    value = ARGUMENT(0);
+
+    if (value != UNSPEC) {
+	for (i = 0; i < 3; i++)
+	    if (value == wrap_modes[i])
+		break;
+	if (i >= 3)
+	    LispDestroy("%s: argument must be "
+			":NEVER, :LINE, or :WORD, not %s",
+			STRFUN(builtin), STROBJ(value));
+	XtSetArg(arg[0], XtNwrap, (XawTextWrapMode)i);
+	XtSetValues(textwindow, arg, 1);
+    }
+    else {
+	XtSetArg(arg[0], XtNwrap, &wrap);
+	XtGetValues(textwindow, arg, 1);
+	i = (int)wrap;
+	if (i <= 0 || i >= 3)
+	    i = 0;
+	value = wrap_modes[i];
+    }
+
+    return (value);
+}
+
+LispObj *
+Xedit_XrmStringToQuark(LispBuiltin *builtin)
+/*
+ xrm-string-to-quark string
+ */
+{
+    LispObj *string;
+
+    string = ARGUMENT(0);
+
+    CHECK_STRING(string);
+
+    return (INTEGER(XrmStringToQuark(THESTR(string))));
+}
diff --git a/lisp/xedit.h b/lisp/xedit.h
new file mode 100644
index 0000000..0beff56
--- /dev/null
+++ b/lisp/xedit.h
@@ -0,0 +1,94 @@
+/*
+ * Copyright (c) 2002 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/xedit.h,v 1.5 2002/11/10 23:22:00 paulo Exp $ */
+
+#ifndef Lisp_xedit_h
+#define Lisp_xedit_h
+
+#ifdef XEDIT_LISP_PRIVATE
+#include "private.h"
+#include "io.h"
+#include "read.h"
+#include "write.h"
+
+LispObj *Xedit_AddEntity(LispBuiltin*);
+LispObj *Xedit_AutoFill(LispBuiltin*);
+LispObj *Xedit_Background(LispBuiltin*);
+LispObj *Xedit_CharAfter(LispBuiltin*);
+LispObj *Xedit_CharBefore(LispBuiltin*);
+LispObj *Xedit_ClearEntities(LispBuiltin*);
+LispObj *Xedit_ConvertPropertyList(LispBuiltin*);
+LispObj *Xedit_Font(LispBuiltin*);
+LispObj *Xedit_Foreground(LispBuiltin*);
+LispObj *Xedit_GotoChar(LispBuiltin*);
+LispObj *Xedit_HorizontalScrollbar(LispBuiltin*);
+LispObj *Xedit_Insert(LispBuiltin*);
+LispObj *Xedit_Justification(LispBuiltin*);
+LispObj *Xedit_LeftColumn(LispBuiltin*);
+LispObj *Xedit_Point(LispBuiltin*);
+LispObj *Xedit_PointMax(LispBuiltin*);
+LispObj *Xedit_PointMin(LispBuiltin*);
+LispObj *Xedit_PropertyList(LispBuiltin*);
+LispObj *Xedit_ReadText(LispBuiltin*);
+LispObj *Xedit_ReplaceText(LispBuiltin*);
+LispObj *Xedit_RightColumn(LispBuiltin*);
+LispObj *Xedit_Scan(LispBuiltin*);
+LispObj *Xedit_SearchBackward(LispBuiltin*);
+LispObj *Xedit_SearchForward(LispBuiltin*);
+LispObj *Xedit_VerticalScrollbar(LispBuiltin*);
+LispObj *Xedit_WrapMode(LispBuiltin*);
+LispObj *Xedit_XrmStringToQuark(LispBuiltin*);
+#else
+#define LispObj void
+#endif /* XEDIT_LISP_PRIVATE */
+
+typedef struct _EditModeInfo {
+    char *desc;			/* Mode description */
+    Widget sme;			/* Menu entry */
+    LispObj *symbol;		/* Symbol holding syntax data */
+    LispObj *syntax;		/* The syntax definition */
+} EditModeInfo;
+
+/* Typedef'ed to XeditLispData in ../xedit.h */
+struct _XeditLispData {
+    LispObj *syntax;		/* Syntax definition */
+    LispObj *syntable;		/* Syntax-table the cursor is located */
+    int disable_highlight;	/* Working in the buffer */
+};
+
+void LispXeditInitialize(void);
+void XeditLispExecute(Widget, XawTextPosition, XawTextPosition);
+void XeditLispSetEditMode(xedit_flist_item*, LispObj*);
+void XeditLispUnsetEditMode(xedit_flist_item*);
+
+extern EditModeInfo *mode_infos;
+extern Cardinal num_mode_infos;
+
+#endif /* Lisp_xedit_h */