Initial revision

1 files changed, 2225 insertions, 0 deletions

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);
+}