Initial revision

1 files changed, 1124 insertions, 0 deletions

diff --git a/lisp/helper.c b/lisp/helper.c
new file mode 100644
index 0000000..65749c5
--- /dev/null
+++ b/lisp/helper.c
@@ -0,0 +1,1124 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/helper.c,v 1.47 2002/11/26 04:06:28 paulo Exp $ */
+
+#include "helper.h"
+#include "pathname.h"
+#include "package.h"
+#include "read.h"
+#include "stream.h"
+#include "write.h"
+#include "hash.h"
+#include <ctype.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <math.h>
+#include <sys/stat.h>
+
+/*
+ * Prototypes
+ */
+static LispObj *LispReallyDo(LispBuiltin*, int);
+static LispObj *LispReallyDoListTimes(LispBuiltin*, int);
+
+/* in math.c */
+extern LispObj *LispFloatCoerce(LispBuiltin*, LispObj*);
+
+/*
+ * Implementation
+ */
+LispObj *
+LispObjectCompare(LispObj *left, LispObj *right, int function)
+{
+    LispType ltype, rtype;
+    LispObj *result = left == right ? T : NIL;
+
+    /* If left and right are the same object, or if function is EQ */
+    if (result == T || function == FEQ)
+	return (result);
+
+    ltype = OBJECT_TYPE(left);
+    rtype = OBJECT_TYPE(right);
+
+    /* Equalp requires that numeric objects be compared by value, and
+     * strings or characters comparison be case insenstive */
+    if (function == FEQUALP) {
+	switch (ltype) {
+	    case LispFixnum_t:
+	    case LispInteger_t:
+	    case LispBignum_t:
+	    case LispDFloat_t:
+	    case LispRatio_t:
+	    case LispBigratio_t:
+	    case LispComplex_t:
+		switch (rtype) {
+		    case LispFixnum_t:
+		    case LispInteger_t:
+		    case LispBignum_t:
+		    case LispDFloat_t:
+		    case LispRatio_t:
+		    case LispBigratio_t:
+		    case LispComplex_t:
+			result = APPLY2(Oequal_, left, right);
+			break;
+		    default:
+			break;
+		}
+		goto compare_done;
+	    case LispSChar_t:
+		if (rtype == LispSChar_t &&
+		    toupper(SCHAR_VALUE(left)) == toupper(SCHAR_VALUE(right)))
+		    result = T;
+		goto compare_done;
+	    case LispString_t:
+		if (rtype == LispString_t && STRLEN(left) == STRLEN(right)) {
+		    long i = STRLEN(left);
+		    char *sl = THESTR(left), *sr = THESTR(right);
+
+		    for (--i; i >= 0; i--)
+			if (toupper(sl[i]) != toupper(sr[i]))
+			    break;
+		    if (i < 0)
+			result = T;
+		}
+		goto compare_done;
+	    case LispArray_t:
+		if (rtype == LispArray_t &&
+		    left->data.array.type == right->data.array.type &&
+		    left->data.array.rank == right->data.array.rank &&
+		    LispObjectCompare(left->data.array.dim,
+				      right->data.array.dim,
+				      FEQUAL) != NIL) {
+		    LispObj *llist = left->data.array.list,
+		    	    *rlist = right->data.array.list;
+
+		    for (; CONSP(llist); llist = CDR(llist), rlist = CDR(rlist))
+			if (LispObjectCompare(CAR(llist), CAR(rlist),
+					      FEQUALP) == NIL)
+			    break;
+		    if (!CONSP(llist))
+			result = T;
+		}
+		goto compare_done;
+	    case LispStruct_t:
+		if (rtype == LispStruct_t &&
+		    left->data.struc.def == right->data.struc.def) {
+		    LispObj *lfield = left->data.struc.fields,
+		    	    *rfield = right->data.struc.fields;
+
+		    for (; CONSP(lfield);
+			 lfield = CDR(lfield), rfield = CDR(rfield)) {
+			if (LispObjectCompare(CAR(lfield), CAR(rfield),
+					      FEQUALP) != T)
+			    break;
+		    }
+		    if (!CONSP(lfield))
+			result = T;
+		}
+		goto compare_done;
+	    case LispHashTable_t:
+		if (rtype == LispHashTable_t &&
+		    left->data.hash.table->count ==
+		    right->data.hash.table->count &&
+		    left->data.hash.test == right->data.hash.test) {
+		    unsigned long i;
+		    LispObj *test = left->data.hash.test;
+		    LispHashEntry *lentry = left->data.hash.table->entries,
+				  *llast = lentry +
+					   left->data.hash.table->num_entries,
+				  *rentry = right->data.hash.table->entries;
+
+		    for (; lentry < llast; lentry++, rentry++) {
+			if (lentry->count != rentry->count)
+			    break;
+			for (i = 0; i < lentry->count; i++) {
+			    if (APPLY2(test,
+				       lentry->keys[i],
+				       rentry->keys[i]) == NIL ||
+				LispObjectCompare(lentry->values[i],
+						  rentry->values[i],
+						  FEQUALP) == NIL)
+				break;
+			}
+			if (i < lentry->count)
+			    break;
+		    }
+		    if (lentry == llast)
+			result = T;
+		}
+		goto compare_done;
+	    default:
+		break;
+	}
+    }
+
+    /* Function is EQL or EQUAL, or EQUALP on arguments with the same rules */
+    if (ltype == rtype) {
+	switch (ltype) {
+	    case LispFixnum_t:
+	    case LispSChar_t:
+		if (FIXNUM_VALUE(left) == FIXNUM_VALUE(right))
+		    result = T;
+		break;
+	    case LispInteger_t:
+		if (INT_VALUE(left) == INT_VALUE(right))
+		    result = T;
+		break;
+	    case LispDFloat_t:
+		if (DFLOAT_VALUE(left) == DFLOAT_VALUE(right))
+		    result = T;
+		break;
+	    case LispRatio_t:
+		if (left->data.ratio.numerator ==
+		    right->data.ratio.numerator &&
+		    left->data.ratio.denominator ==
+		    right->data.ratio.denominator)
+		    result = T;
+		break;
+	    case LispComplex_t:
+		if (LispObjectCompare(left->data.complex.real,
+				      right->data.complex.real,
+				      function) == T &&
+		    LispObjectCompare(left->data.complex.imag,
+				      right->data.complex.imag,
+				      function) == T)
+		    result = T;
+		break;
+	    case LispBignum_t:
+		if (mpi_cmp(left->data.mp.integer, right->data.mp.integer) == 0)
+		    result = T;
+		break;
+	    case LispBigratio_t:
+		if (mpr_cmp(left->data.mp.ratio, right->data.mp.ratio) == 0)
+		    result = T;
+		break;
+	    default:
+		break;
+	}
+
+	/* Next types must be the same object for EQL */
+	if (function == FEQL)
+	    goto compare_done;
+
+	switch (ltype) {
+	    case LispString_t:
+		if (STRLEN(left) == STRLEN(right) &&
+		    memcmp(THESTR(left), THESTR(right), STRLEN(left)) == 0)
+		    result = T;
+		break;
+	    case LispCons_t:
+		if (LispObjectCompare(CAR(left), CAR(right), function) == T &&
+		    LispObjectCompare(CDR(left), CDR(right), function) == T)
+		    result = T;
+		break;
+	    case LispQuote_t:
+	    case LispBackquote_t:
+	    case LispPathname_t:
+		result = LispObjectCompare(left->data.pathname,
+					   right->data.pathname, function);
+		break;
+	    case LispLambda_t:
+		result = LispObjectCompare(left->data.lambda.name,
+					   right->data.lambda.name,
+					   function);
+		break;
+	    case LispOpaque_t:
+		if (left->data.opaque.data == right->data.opaque.data)
+		    result = T;
+		break;
+	    case LispRegex_t:
+		/* If the regexs are guaranteed to generate the same matches */
+		if (left->data.regex.options == right->data.regex.options)
+		    result = LispObjectCompare(left->data.regex.pattern,
+					       right->data.regex.pattern,
+					       function);
+		break;
+	    default:
+		break;
+	}
+    }
+
+compare_done:
+    return (result);
+}
+
+void
+LispCheckSequenceStartEnd(LispBuiltin *builtin,
+			  LispObj *sequence, LispObj *start, LispObj *end,
+			  long *pstart, long *pend, long *plength)
+{
+    /* Calculate length of sequence and check it's type */
+    *plength = LispLength(sequence);
+
+    /* Check start argument */
+    if (start == UNSPEC || start == NIL)
+	*pstart = 0;
+    else {
+	CHECK_INDEX(start);
+	*pstart = FIXNUM_VALUE(start);
+    }
+
+    /* Check end argument */
+    if (end == UNSPEC || end == NIL)
+	*pend = *plength;
+    else {
+	CHECK_INDEX(end);
+	*pend = FIXNUM_VALUE(end);
+    }
+
+    /* Check start argument */
+    if (*pstart > *pend)
+	LispDestroy("%s: :START %ld is larger than :END %ld",
+		    STRFUN(builtin), *pstart, *pend);
+
+    /* Check end argument */
+    if (*pend > *plength)
+	LispDestroy("%s: :END %ld is larger then sequence length %ld",
+		    STRFUN(builtin), *pend, *plength);
+}
+
+long
+LispLength(LispObj *sequence)
+{
+    long length;
+
+    if (sequence == NIL)
+	return (0);
+    switch (OBJECT_TYPE(sequence)) {
+	case LispString_t:
+	    length = STRLEN(sequence);
+	    break;
+	case LispArray_t:
+	    if (sequence->data.array.rank != 1)
+		goto not_a_sequence;
+	    sequence = sequence->data.array.list;
+	    /*FALLTROUGH*/
+	case LispCons_t:
+	    for (length = 0;
+		 CONSP(sequence);
+		 length++, sequence = CDR(sequence))
+		;
+	    break;
+	default:
+not_a_sequence:
+	    LispDestroy("LENGTH: %s is not a sequence", STROBJ(sequence));
+	    /*NOTREACHED*/
+	    length = 0;
+    }
+
+    return (length);
+}
+
+LispObj *
+LispCharacterCoerce(LispBuiltin *builtin, LispObj *object)
+{
+    if (SCHARP(object))
+	return (object);
+    else if (STRINGP(object) && STRLEN(object) == 1)
+	return (SCHAR(THESTR(object)[0]));
+    else if (SYMBOLP(object) && ATOMID(object)[1] == '\0')
+	return (SCHAR(ATOMID(object)[0]));
+    else if (INDEXP(object)) {
+	int c = FIXNUM_VALUE(object);
+
+	if (c <= 0xff)
+	    return (SCHAR(c));
+    }
+    else if (object == T)
+	return (SCHAR('T'));
+
+    LispDestroy("%s: cannot convert %s to character",
+		STRFUN(builtin), STROBJ(object));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+LispStringCoerce(LispBuiltin *builtin, LispObj *object)
+{
+    if (STRINGP(object))
+	return (object);
+    else if (SYMBOLP(object))
+	return (LispSymbolName(object));
+    else if (SCHARP(object)) {
+	char string[1];
+
+	string[0] = SCHAR_VALUE(object);
+	return (LSTRING(string, 1));
+    }
+    else if (object == NIL)
+	return (LSTRING(Snil, 3));
+    else if (object == T)
+	return (LSTRING(St, 1));
+    else
+	LispDestroy("%s: cannot convert %s to string",
+		    STRFUN(builtin), STROBJ(object));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+LispCoerce(LispBuiltin *builtin,
+	   LispObj *object, LispObj *result_type)
+{
+    LispObj *result = NIL;
+    LispType type = LispNil_t;
+
+    if (result_type == NIL)
+	/* not even NIL can be converted to NIL? */
+	LispDestroy("%s: cannot convert %s to NIL",
+		    STRFUN(builtin), STROBJ(object));
+
+    else if (result_type == T)
+	/* no conversion */
+	return (object);
+
+    else if (!SYMBOLP(result_type))
+	/* only know about simple types */
+	LispDestroy("%s: bad argument %s",
+		    STRFUN(builtin), STROBJ(result_type));
+
+    else {
+	/* check all known types */
+
+	Atom_id atom = ATOMID(result_type);
+
+	if (atom == Satom) {
+	    if (CONSP(object))
+		goto coerce_fail;
+	    return (object);
+	}
+	/* only convert ATOM to SYMBOL */
+
+	if (atom == Sfloat)
+	    type = LispDFloat_t;
+	else if (atom == Sinteger)
+	    type = LispInteger_t;
+	else if (atom == Scons || atom == Slist) {
+	    if (object == NIL)
+		return (object);
+	    type = LispCons_t;
+	}
+	else if (atom == Sstring)
+	    type = LispString_t;
+	else if (atom == Scharacter)
+	    type = LispSChar_t;
+	else if (atom == Scomplex)
+	    type = LispComplex_t;
+	else if (atom == Svector || atom == Sarray)
+	    type = LispArray_t;
+	else if (atom == Sopaque)
+	    type = LispOpaque_t;
+	else if (atom == Srational)
+	    type = LispRatio_t;
+	else if (atom == Spathname)
+	    type = LispPathname_t;
+	else
+	    LispDestroy("%s: invalid type specification %s",
+			STRFUN(builtin), ATOMID(result_type));
+    }
+
+    if (OBJECT_TYPE(object) == LispOpaque_t) {
+	switch (type) {
+	    case LispAtom_t:
+		result = ATOM(object->data.opaque.data);
+		break;
+	    case LispString_t:
+		result = STRING(object->data.opaque.data);
+		break;
+	    case LispSChar_t:
+		result = SCHAR((unsigned long)object->data.opaque.data);
+		break;
+	    case LispDFloat_t:
+		result = DFLOAT((double)((long)object->data.opaque.data));
+		break;
+	    case LispInteger_t:
+		result = INTEGER(((long)object->data.opaque.data));
+		break;
+	    case LispOpaque_t:
+		result = OPAQUE(object->data.opaque.data, 0);
+		break;
+	    default:
+		goto coerce_fail;
+		break;
+	}
+    }
+
+    else if (OBJECT_TYPE(object) != type) {
+	switch (type) {
+	    case LispInteger_t:
+		if (INTEGERP(object))
+		    result = object;
+		else if (DFLOATP(object)) {
+		    if ((long)DFLOAT_VALUE(object) == DFLOAT_VALUE(object))
+			result = INTEGER((long)DFLOAT_VALUE(object));
+		    else {
+			mpi *integer = LispMalloc(sizeof(mpi));
+
+			mpi_init(integer);
+			mpi_setd(integer, DFLOAT_VALUE(object));
+			if (mpi_getd(integer) != DFLOAT_VALUE(object)) {
+			    mpi_clear(integer);
+			    LispFree(integer);
+			    goto coerce_fail;
+			}
+			result = BIGNUM(integer);
+		    }
+		}
+		else
+		    goto coerce_fail;
+		break;
+	    case LispRatio_t:
+		if (DFLOATP(object)) {
+		    mpr *ratio = LispMalloc(sizeof(mpr));
+
+		    mpr_init(ratio);
+		    mpr_setd(ratio, DFLOAT_VALUE(object));
+		    if (mpr_fiti(ratio)) {
+			result = RATIO(mpi_geti(mpr_num(ratio)),
+				       mpi_geti(mpr_den(ratio)));
+			mpr_clear(ratio);
+			LispFree(ratio);
+		    }
+		    else
+			result = BIGRATIO(ratio);
+		}
+		else if (RATIONALP(object))
+		    result = object;
+		else
+		    goto coerce_fail;
+		break;
+	    case LispDFloat_t:
+		result = LispFloatCoerce(builtin, object);
+	    	break;
+	    case LispComplex_t:
+		if (NUMBERP(object))
+		    result = object;
+		else
+		    goto coerce_fail;
+		break;
+	    case LispString_t:
+		if (object == NIL)
+		    result = STRING("");
+		else
+		    result = LispStringCoerce(builtin, object);
+		break;
+	    case LispSChar_t:
+		result = LispCharacterCoerce(builtin, object);
+		break;
+	    case LispArray_t:
+		if (LISTP(object))
+		    result = VECTOR(object);
+		else
+		    goto coerce_fail;
+		break;
+	    case LispCons_t:
+		if (ARRAYP(object) && object->data.array.rank == 1)
+		    result = object->data.array.list;
+		else
+		    goto coerce_fail;
+		break;
+	    case LispPathname_t:
+		result = APPLY1(Oparse_namestring, object);
+		break;
+	    default:
+		goto coerce_fail;
+	}
+    }
+    else
+	result = object;
+
+    return (result);
+
+coerce_fail:
+    LispDestroy("%s: cannot convert %s to %s",
+		STRFUN(builtin), STROBJ(object), ATOMID(result_type));
+    /* NOTREACHED */
+    return (NIL);
+}
+
+static LispObj *
+LispReallyDo(LispBuiltin *builtin, int refs)
+/*
+ do init test &rest body
+ do* init test &rest body
+ */
+{
+    GC_ENTER();
+    int stack, lex, head;
+    LispObj *list, *symbol, *value, *values, *cons;
+
+    LispObj *init, *test, *body;
+
+    body = ARGUMENT(2);
+    test = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    if (!CONSP(test))
+	LispDestroy("%s: end test condition must be a list, not %s",
+		    STRFUN(builtin), STROBJ(init));
+
+    CHECK_LIST(init);
+
+    /* Save state */
+    stack = lisp__data.stack.length;
+    lex = lisp__data.env.lex;
+    head = lisp__data.env.length;
+
+    values = cons = NIL;
+    for (list = init; CONSP(list); list = CDR(list)) {
+	symbol = CAR(list);
+	if (!SYMBOLP(symbol)) {
+	    CHECK_CONS(symbol);
+	    value = CDR(symbol);
+	    symbol = CAR(symbol);
+	    CHECK_SYMBOL(symbol);
+	    CHECK_CONS(value);
+	    value = EVAL(CAR(value));
+	}
+	else
+	    value = NIL;
+
+	CHECK_CONSTANT(symbol);
+
+	LispAddVar(symbol, value);
+
+	/* Bind variable now */
+	if (refs) {
+	    ++lisp__data.env.head;
+	}
+	else {
+	    if (values == NIL) {
+		values = cons = CONS(NIL, NIL);
+		GC_PROTECT(values);
+	    }
+	    else {
+		RPLACD(cons, CONS(NIL, NIL));
+		cons = CDR(cons);
+	    }
+	}
+    }
+    if (!refs)
+	lisp__data.env.head = lisp__data.env.length;
+
+    for (;;) {
+	if (EVAL(CAR(test)) != NIL)
+	    break;
+
+	/* TODO Run this code in an implicit tagbody */
+	for (list = body; CONSP(list); list = CDR(list))
+	    (void)EVAL(CAR(list));
+
+	/* Error checking already done in the initialization */
+	for (list = init, cons = values; CONSP(list); list = CDR(list)) {
+	    symbol = CAR(list);
+	    if (CONSP(symbol)) {
+		value = CDDR(symbol);
+		symbol = CAR(symbol);
+		if (CONSP(value))
+		    value = EVAL(CAR(value));
+		else
+		    value = NIL;
+	    }
+	    else
+		value = NIL;
+
+	    if (refs)
+		LispSetVar(symbol, value);
+	    else {
+		RPLACA(cons, value);
+		cons = CDR(cons);
+	    }
+	}
+	if (!refs) {
+	    for (list = init, cons = values;
+		 CONSP(list);
+		 list = CDR(list), cons = CDR(cons)) {
+		symbol = CAR(list);
+		if (CONSP(symbol)) {
+		    if (CONSP(CDR(symbol)))
+			LispSetVar(CAR(symbol), CAR(cons));
+		}
+	    }
+	}
+    }
+
+    if (CONSP(CDR(test)))
+	value = EVAL(CADR(test));
+    else
+	value = NIL;
+
+    /* Restore state */
+    lisp__data.stack.length = stack;
+    lisp__data.env.lex = lex;
+    lisp__data.env.head = lisp__data.env.length = head;
+    GC_LEAVE();
+
+    return (value);
+}
+
+LispObj *
+LispDo(LispBuiltin *builtin, int refs)
+/*
+ do init test &rest body
+ do* init test &rest body
+ */
+{
+    int jumped, *pjumped;
+    LispObj *result, **presult;
+    LispBlock *block;
+
+    jumped = 1;
+    result = NIL;
+    presult = &result;
+    pjumped = &jumped;
+    block = LispBeginBlock(NIL, LispBlockTag);
+    if (setjmp(block->jmp) == 0) {
+	result = LispReallyDo(builtin, refs);
+	jumped = 0;
+    }
+    LispEndBlock(block);
+    if (jumped)
+	result = lisp__data.block.block_ret;
+
+    return (result);
+}
+
+static LispObj *
+LispReallyDoListTimes(LispBuiltin *builtin, int times)
+/*
+ dolist init &rest body
+ dotimes init &rest body
+ */
+{
+    GC_ENTER();
+    int head = lisp__data.env.length;
+    long count = 0, end = 0;
+    LispObj *symbol, *value = NIL, *result = NIL, *init, *body, *object;
+
+    body = ARGUMENT(1);
+    init = ARGUMENT(0);
+
+    /* Parse arguments */
+    CHECK_CONS(init);
+    symbol = CAR(init);
+    CHECK_SYMBOL(symbol);
+    init = CDR(init);
+
+    if (init == NIL) {
+	if (times)
+	    LispDestroy("%s: NIL is not a number", STRFUN(builtin));
+    }
+    else {
+	CHECK_CONS(init);
+	value = CAR(init);
+	init = CDR(init);
+	if (init != NIL) {
+	    CHECK_CONS(init);
+	    result = CAR(init);
+	}
+
+	value = EVAL(value);
+
+	if (times) {
+	    CHECK_INDEX(value);
+	    end = FIXNUM_VALUE(value);
+	}
+	else {
+	    CHECK_LIST(value);
+	    /* Protect iteration control from gc */
+	    GC_PROTECT(value);
+	}
+    }
+
+    /* The variable is only bound inside the loop, so it is safe to optimize
+     * it out if there is no code to execute. But the result form may reference
+     * the bound variable. */
+    if (!CONSP(body)) {
+	if (times)
+	    count = end;
+	else
+	    value = NIL;
+    }
+
+    /* Initialize counter */
+    CHECK_CONSTANT(symbol);
+    if (times)
+	LispAddVar(symbol, FIXNUM(count));
+    else
+	LispAddVar(symbol, CONSP(value) ? CAR(value) : value);
+    ++lisp__data.env.head;
+
+    if (!CONSP(body) || (times && count >= end) || (!times && !CONSP(value)))
+	goto loop_done;
+
+    /* Execute iterations */
+    for (;;) {
+	for (object = body; CONSP(object); object = CDR(object))
+	    (void)EVAL(CAR(object));
+
+	/* Update symbols and check exit condition */
+	if (times) {
+	    ++count;
+	    LispSetVar(symbol, FIXNUM(count));
+	    if (count >= end)
+		break;
+	}
+	else {
+	    value = CDR(value);
+	    if (!CONSP(value)) {
+		LispSetVar(symbol, NIL);
+		break;
+	    }
+	    LispSetVar(symbol, CAR(value));
+	}
+    }
+
+loop_done:
+    result = EVAL(result);
+    lisp__data.env.head = lisp__data.env.length = head;
+    GC_LEAVE();
+
+    return (result);
+}
+
+LispObj *
+LispDoListTimes(LispBuiltin *builtin, int times)
+/*
+ dolist init &rest body
+ dotimes init &rest body
+ */
+{
+    int did_jump, *pdid_jump = &did_jump;
+    LispObj *result, **presult = &result;
+    LispBlock *block;
+
+    *presult = NIL;
+    *pdid_jump = 1;
+    block = LispBeginBlock(NIL, LispBlockTag);
+    if (setjmp(block->jmp) == 0) {
+	result = LispReallyDoListTimes(builtin, times);
+	did_jump = 0;
+    }
+    LispEndBlock(block);
+    if (did_jump)
+	result = lisp__data.block.block_ret;
+
+    return (result);
+}
+
+LispObj *
+LispLoadFile(LispObj *filename, int verbose, int print, int ifdoesnotexist)
+{
+    LispObj *stream, *cod, *obj, *result;
+    int ch;
+
+    LispObj *savepackage;
+    LispPackage *savepack;
+
+    if (verbose)
+	LispMessage("; Loading %s", THESTR(filename));
+
+    if (ifdoesnotexist) {
+	GC_ENTER();
+	result = CONS(filename, CONS(Kif_does_not_exist, CONS(Kerror, NIL)));
+	GC_PROTECT(result);
+	stream = APPLY(Oopen, result);
+	GC_LEAVE();
+    }
+    else
+	stream = APPLY1(Oopen, filename);
+
+    if (stream == NIL)
+	return (NIL);
+
+    result = NIL;
+    LispPushInput(stream);
+    ch = LispGet();
+    if (ch != '#')
+	LispUnget(ch);
+    else if ((ch = LispGet()) == '!') {
+	for (;;) {
+	    ch = LispGet();
+	    if (ch == '\n' || ch == EOF)
+		break;
+	}
+    }
+    else {
+	LispUnget(ch);
+	LispUnget('#');
+    }
+
+    /* Save package environment */
+    savepackage = PACKAGE;
+    savepack = lisp__data.pack;
+
+    cod = COD;
+
+    /*CONSTCOND*/
+    while (1) {
+	if ((obj = LispRead()) != NULL) {
+	    result = EVAL(obj);
+	    COD = cod;
+	    if (print) {
+		int i;
+
+		if (RETURN_COUNT >= 0)
+		    LispPrint(result, NIL, 1);
+		for (i = 0; i < RETURN_COUNT; i++)
+		    LispPrint(RETURN(i), NIL, 1);
+	    }
+	}
+	if (lisp__data.eof)
+	    break;
+    }
+    LispPopInput(stream);
+
+    /* Restore package environment */
+    PACKAGE = savepackage;
+    lisp__data.pack = savepack;
+
+    APPLY1(Oclose, stream);
+
+    return (T);
+}
+
+void
+LispGetStringArgs(LispBuiltin *builtin,
+		  char **string1, char **string2,
+		  long *start1, long *end1, long *start2, long *end2)
+{
+    long length1, length2;
+    LispObj *ostring1, *ostring2, *ostart1, *oend1, *ostart2, *oend2;
+
+    oend2 = ARGUMENT(5);
+    ostart2 = ARGUMENT(4);
+    oend1 = ARGUMENT(3);
+    ostart1 = ARGUMENT(2);
+    ostring2 = ARGUMENT(1);
+    ostring1 = ARGUMENT(0);
+
+    CHECK_STRING(ostring1);
+    *string1 = THESTR(ostring1);
+    length1 = STRLEN(ostring1);
+
+    CHECK_STRING(ostring2);
+    *string2 = THESTR(ostring2);
+    length2 = STRLEN(ostring2);
+
+    if (ostart1 == UNSPEC)
+	*start1 = 0;
+    else {
+	CHECK_INDEX(ostart1);
+	*start1 = FIXNUM_VALUE(ostart1);
+    }
+    if (oend1 == UNSPEC)
+	*end1 = length1;
+    else {
+	CHECK_INDEX(oend1);
+	*end1 = FIXNUM_VALUE(oend1);
+    }
+
+    if (ostart2 == UNSPEC)
+	*start2 = 0;
+    else {
+	CHECK_INDEX(ostart2);
+	*start2 = FIXNUM_VALUE(ostart2);
+    }
+
+    if (oend2 == UNSPEC)
+	*end2 = length2;
+    else {
+	CHECK_INDEX(oend2);
+	*end2 = FIXNUM_VALUE(oend2);
+    }
+
+    if (*start1 > *end1)
+	LispDestroy("%s: :START1 %ld larger than :END1 %ld",
+		    STRFUN(builtin), *start1, *end1);
+    if (*start2 > *end2)
+	LispDestroy("%s: :START2 %ld larger than :END2 %ld",
+		    STRFUN(builtin), *start2, *end2);
+    if (*end1 > length1)
+	LispDestroy("%s: :END1 %ld larger than string length %ld",
+		    STRFUN(builtin), *end1, length1);
+    if (*end2 > length2)
+	LispDestroy("%s: :END2 %ld larger than string length %ld",
+		    STRFUN(builtin), *end2, length2);
+}
+
+LispObj *
+LispPathnameField(int field, int string)
+{
+    int offset = field;
+    LispObj *pathname, *result, *object;
+
+    pathname = ARGUMENT(0);
+
+    if (PATHNAMEP(pathname))
+	pathname = APPLY1(Oparse_namestring, pathname);
+
+    result = pathname->data.pathname;
+    while (offset) {
+	result = CDR(result);
+	--offset;
+    }
+    object = result;
+    result = CAR(result);
+
+    if (string) {
+	if (!STRINGP(result)) {
+	    if (result == NIL)
+		result = STRING("");
+	    else if (field == PATH_DIRECTORY) {
+		char *name = THESTR(CAR(pathname->data.pathname)), *ptr;
+
+		ptr = strrchr(name, PATH_SEP);
+		if (ptr) {
+		    int length = ptr - name + 1;
+		    char data[PATH_MAX];
+
+		    if (length > PATH_MAX - 1)
+			length = PATH_MAX - 1;
+		    strncpy(data, name, length);
+		    data[length] = '\0';
+		    result = STRING(data);
+		}
+		else
+		    result = STRING("");
+	    }
+	    else
+		result = Kunspecific;
+	}
+	else if (field == PATH_NAME) {
+	    object = CAR(CDR(object));
+	    if (STRINGP(object)) {
+		int length;
+		char name[PATH_MAX + 1];
+
+		strcpy(name, THESTR(result));
+		length = STRLEN(result);
+		if (length + 1 < sizeof(name)) {
+		    name[length++] = PATH_TYPESEP;
+		    name[length] = '\0';
+		}
+		if (STRLEN(object) + length < sizeof(name))
+		    strcpy(name + length, THESTR(object));
+		/* else LispDestroy ... */
+		result = STRING(name);
+	    }
+	}
+    }
+
+    return (result);
+}
+
+LispObj *
+LispProbeFile(LispBuiltin *builtin, int probe)
+{
+    GC_ENTER();
+    LispObj *result;
+    char *name = NULL, resolved[PATH_MAX + 1];
+    struct stat st;
+
+    LispObj *pathname;
+
+    pathname = ARGUMENT(0);
+
+    if (!POINTERP(pathname))
+	goto bad_pathname;
+
+    if (XSTRINGP(pathname))
+	name = THESTR(pathname);
+    else if (XPATHNAMEP(pathname))
+	name = THESTR(CAR(pathname->data.pathname));
+    else if (STREAMP(pathname) && pathname->data.stream.type == LispStreamFile)
+	name = THESTR(CAR(pathname->data.stream.pathname->data.pathname));
+
+    if (realpath(name, &resolved[0]) == NULL ||
+	stat(resolved, &st)) {
+	if (probe)
+	    return (NIL);
+	LispDestroy("%s: realpath(\"%s\"): %s",
+		    STRFUN(builtin), name, strerror(errno));
+    }
+
+    if (S_ISDIR(st.st_mode)) {
+	int length = strlen(resolved);
+
+	if (!length || resolved[length - 1] != PATH_SEP) {
+	    resolved[length++] = PATH_SEP;
+	    resolved[length] = '\0';
+	}
+    }
+
+    result = STRING(resolved);
+    GC_PROTECT(result);
+    result = APPLY1(Oparse_namestring, result);
+    GC_LEAVE();
+
+    return (result);
+
+bad_pathname:
+    LispDestroy("%s: bad pathname %s", STRFUN(builtin), STROBJ(pathname));
+    /*NOTREACHED*/
+    return (NIL);
+}
+
+LispObj *
+LispWriteString_(LispBuiltin *builtin, int newline)
+/*
+ write-line string &optional output-stream &key start end
+ write-string string &optional output-stream &key start end
+ */
+{
+    char *text;
+    long start, end, length;
+
+    LispObj *string, *output_stream, *ostart, *oend;
+
+    oend = ARGUMENT(3);
+    ostart = ARGUMENT(2);
+    output_stream = ARGUMENT(1);
+    string = ARGUMENT(0);
+
+    CHECK_STRING(string);
+    LispCheckSequenceStartEnd(builtin, string, ostart, oend,
+			      &start, &end, &length);
+    if (output_stream == UNSPEC)
+	output_stream = NIL;
+    text = THESTR(string);
+    if (end > start)
+	LispWriteStr(output_stream, text + start, end - start);
+    if (newline)
+	LispWriteChar(output_stream, '\n');
+
+    return (string);
+}