Initial revision

1 files changed, 7040 insertions, 0 deletions

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