summaryrefslogtreecommitdiff
path: root/programs
diff options
context:
space:
mode:
Diffstat (limited to 'programs')
-rw-r--r--programs/xedit/lisp/core.c138
-rw-r--r--programs/xedit/lisp/core.h4
-rw-r--r--programs/xedit/lisp/internal.h14
-rw-r--r--programs/xedit/lisp/io.c102
-rw-r--r--programs/xedit/lisp/io.h11
-rw-r--r--programs/xedit/lisp/lisp.c75
-rw-r--r--programs/xedit/lisp/math.c7
-rw-r--r--programs/xedit/lisp/mathimp.c6
-rw-r--r--programs/xedit/lisp/mp/mp.c96
-rw-r--r--programs/xedit/lisp/mp/mp.h17
-rw-r--r--programs/xedit/lisp/mp/mpi.c4
-rw-r--r--programs/xedit/lisp/read.c225
-rw-r--r--programs/xedit/lisp/test/math.lsp106
-rw-r--r--programs/xedit/lisp/write.c75
-rw-r--r--programs/xedit/lisp/write.h12
-rw-r--r--programs/xedit/lisp/xedit.c5
16 files changed, 624 insertions, 273 deletions
diff --git a/programs/xedit/lisp/core.c b/programs/xedit/lisp/core.c
index 46af931a8..190e30116 100644
--- a/programs/xedit/lisp/core.c
+++ b/programs/xedit/lisp/core.c
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/core.c,v 1.57 2002/11/13 04:35:45 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/core.c,v 1.58 2002/11/15 07:01:28 paulo Exp $ */
#include "io.h"
#include "core.h"
@@ -222,37 +222,51 @@ Lisp_Append(LispBuiltin *builtin)
*/
{
GC_ENTER();
+ LispObj *result, *cons, *list;
- LispObj *result, *cons, *list, *lists;
+ LispObj *lists;
lists = ARGUMENT(0);
- result = cons = NIL;
- for (; CONSP(lists); lists = CDR(lists)) {
+ /* 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);
- if (result == NIL) {
- result = cons = CONS(CAR(list), CDR(list));
- GC_PROTECT(result);
- }
- else {
- if (CONSP(CDR(cons))) {
- LispObj *obj = CDR(cons);
-
- while (CONSP(CDR(obj))) {
- RPLACD(cons, CONS(CAR(obj), CDR(obj)));
- cons = CDR(cons);
- obj = CDR(obj);
- }
- RPLACD(cons, CONS(CADR(cons), list));
- }
- else
- RPLACD(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);
@@ -587,9 +601,7 @@ Lisp_Butlast(LispBuiltin *builtin)
ocount = ARGUMENT(1);
list = ARGUMENT(0);
- if (list == NIL)
- return (NIL);
- CHECK_CONS(list);
+ CHECK_LIST(list);
if (ocount == NIL)
count = 1;
else {
@@ -616,6 +628,41 @@ Lisp_Butlast(LispBuiltin *builtin)
}
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 == NIL)
+ 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
@@ -1595,6 +1642,49 @@ Lisp_If(LispBuiltin *builtin)
}
LispObj *
+Lisp_IgnoreErrors(LispBuiltin *builtin)
+/*
+ ignore-erros &rest body
+ */
+{
+ LispObj *result, **presult, **pbody;
+ int jumped, *pjumped;
+ LispBlock *block;
+
+ LispObj *body;
+
+ body = ARGUMENT(0);
+
+ RETURN_COUNT = 0;
+
+ 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;
+
+ /* No condition system (yet?!), just return T, and for now, let
+ * LispDestroy print the error message */
+ if (lisp__data.destroyed) {
+ lisp__data.destroyed = 0;
+ result = NIL;
+ RETURN_COUNT = 1;
+ RETURN(0) = T;
+ }
+
+ return (result);
+}
+
+LispObj *
Lisp_Intersection(LispBuiltin *builtin)
/*
intersection list1 list2 &key test test-not key
diff --git a/programs/xedit/lisp/core.h b/programs/xedit/lisp/core.h
index 9fc58909c..1fd2792da 100644
--- a/programs/xedit/lisp/core.h
+++ b/programs/xedit/lisp/core.h
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/core.h,v 1.26 2002/11/08 08:00:56 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/core.h,v 1.27 2002/11/13 04:35:46 paulo Exp $ */
#ifndef Lisp_core_h
#define Lisp_core_h
@@ -49,6 +49,7 @@ LispObj *Lisp_Atom(LispBuiltin*);
LispObj *Lisp_Block(LispBuiltin*);
LispObj *Lisp_Boundp(LispBuiltin*);
LispObj *Lisp_Butlast(LispBuiltin*);
+LispObj *Lisp_Nbutlast(LispBuiltin*);
LispObj *Lisp_Car(LispBuiltin*);
LispObj *Lisp_Case(LispBuiltin*);
LispObj *Lisp_Catch(LispBuiltin*);
@@ -95,6 +96,7 @@ LispObj *Lisp_Get(LispBuiltin*);
LispObj *Lisp_Getenv(LispBuiltin*);
LispObj *Lisp_Go(LispBuiltin*);
LispObj *Lisp_If(LispBuiltin*);
+LispObj *Lisp_IgnoreErrors(LispBuiltin*);
LispObj *Lisp_Intersection(LispBuiltin*);
LispObj *Lisp_Keywordp(LispBuiltin*);
LispObj *Lisp_Lambda(LispBuiltin*);
diff --git a/programs/xedit/lisp/internal.h b/programs/xedit/lisp/internal.h
index 2fa63e43a..821a07cfe 100644
--- a/programs/xedit/lisp/internal.h
+++ b/programs/xedit/lisp/internal.h
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/internal.h,v 1.39 2002/11/15 07:01:29 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/internal.h,v 1.40 2002/11/15 17:20:06 tsi Exp $ */
#ifndef Lisp_internal_h
#define Lisp_internal_h
@@ -43,8 +43,9 @@
*/
typedef struct _LispMac LispMac;
-#define STREAM_READ 1
-#define STREAM_WRITE 2
+#define STREAM_READ 0x01
+#define STREAM_WRITE 0x02
+#define STREAM_BINARY 0x20
#define RPLACA(cons, object) (CAR(cons) = object)
#define RPLACD(cons, object) (CDR(cons) = object)
@@ -693,9 +694,9 @@ LispAtom *LispGetAtom(char*);
* itself. The argument string should never change. */
LispAtom *LispGetPermAtom(char*);
-void *LispMalloc(unsigned);
-void *LispCalloc(unsigned, unsigned);
-void *LispRealloc(void*, unsigned);
+void *LispMalloc(size_t);
+void *LispCalloc(size_t, size_t);
+void *LispRealloc(void*, size_t);
char *LispStrdup(char*);
void LispFree(void*);
/* LispMused means memory is now safe from LispDestroy, and should not be
@@ -716,6 +717,7 @@ void LispDestroy(char *fmt, ...) PRINTF_FORMAT;
void LispContinuable(char *fmt, ...) PRINTF_FORMAT;
void LispMessage(char *fmt, ...) PRINTF_FORMAT;
void LispWarning(char *fmt, ...) PRINTF_FORMAT;
+#undef PRINTF_FORMAT
LispObj *LispSetVariable(LispObj*, LispObj*, char*, int);
diff --git a/programs/xedit/lisp/io.c b/programs/xedit/lisp/io.c
index 8ca0ced24..02f1df416 100644
--- a/programs/xedit/lisp/io.c
+++ b/programs/xedit/lisp/io.c
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/io.c,v 1.10 2002/11/08 08:00:56 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/io.c,v 1.11 2002/11/10 16:29:05 paulo Exp $ */
#include "io.h"
#include <errno.h>
@@ -42,10 +42,12 @@
#define APPEND_BIT 0x04
#define BUFFERED_BIT 0x08
#define UNBUFFERED_BIT 0x10
+#define BINARY_BIT 0x20
/*
* Prototypes
*/
+static int calculate_line(void*, int);
static int calculate_column(void*, int, int);
/*
@@ -63,7 +65,7 @@ LispGet(void)
LispUngetInfo *unget = lisp__data.unget[lisp__data.iunget];
if (unget->offset)
- ch = unget->buffer[--unget->offset];
+ ch = ((unsigned char*)unget->buffer)[--unget->offset];
else if (SINPUT->data.stream.readable) {
LispFile *file = NULL;
@@ -156,6 +158,19 @@ LispPopInput(LispObj *stream)
* Low level functions
*/
static int
+calculate_line(void *data, int size)
+{
+ int line = 0;
+ char *str, *ptr;
+
+ for (str = (char*)data, ptr = (char*)data + size; str < ptr; str++)
+ if (*ptr == '\n')
+ ++line;
+
+ return (line);
+}
+
+static int
calculate_column(void *data, int size, int column)
{
char *str, *ptr;
@@ -199,6 +214,8 @@ LispFdopen(int descriptor, int mode)
if (file->buffer == NULL)
file->buffered = 0;
}
+ file->line = 1;
+ file->binary = (mode & BINARY_BIT) != 0;
}
return (file);
@@ -275,6 +292,9 @@ LispFungetc(LispFile *file, int ch)
if (file->readable) {
file->available = 1;
file->unget = ch;
+ /* this should never happen */
+ if (ch == '\n' && !file->binary)
+ --file->line;
}
return (ch);
@@ -302,7 +322,7 @@ LispFgetc(LispFile *file)
}
else {
if (file->offset < file->length)
- ch = file->buffer[file->offset++];
+ ch = ((unsigned char*)file->buffer)[file->offset++];
else {
int length = read(file->descriptor,
file->buffer, pagesize);
@@ -313,7 +333,7 @@ LispFgetc(LispFile *file)
file->length = 0;
file->offset = 0;
if (file->length)
- ch = file->buffer[file->offset++];
+ ch = ((unsigned char*)file->buffer)[file->offset++];
else
ch = EOF;
}
@@ -327,6 +347,9 @@ LispFgetc(LispFile *file)
else
ch = EOF;
+ if (ch == '\n' && !file->binary)
+ ++file->line;
+
return (ch);
}
@@ -344,11 +367,13 @@ LispFputc(LispFile *file, int ch)
else if (write(file->descriptor, &c, 1) != 1)
ch = EOF;
- /* update column number */
- if (ch == '\n')
- file->column = 0;
- else
- ++file->column;
+ if (!file->binary) {
+ /* update column number */
+ if (ch == '\n')
+ file->column = 0;
+ else
+ ++file->column;
+ }
}
return (ch);
@@ -357,10 +382,16 @@ LispFputc(LispFile *file, int ch)
int
LispSgetc(LispString *string)
{
+ int ch;
+
if (string->input >= string->length)
return (EOF); /* EOF reading from string */
- return (string->string[string->input++]);
+ ch = ((unsigned char*)string->string)[string->input++];
+ if (ch == '\n' && !string->binary)
+ ++string->line;
+
+ return (ch);
}
int
@@ -384,10 +415,12 @@ LispSputc(LispString *string, int ch)
string->length = string->output;
/* update column number */
- if (ch == '\n')
- string->column = 0;
- else
- ++string->column;
+ if (!string->binary) {
+ if (ch == '\n')
+ string->column = 0;
+ else
+ ++string->column;
+ }
return (ch);
}
@@ -406,6 +439,7 @@ LispFgets(LispFile *file, char *string, int size)
if ((ch = LispFgetc(file)) == EOF)
break;
string[offset++] = ch;
+ /* line number is calculated in LispFgetc */
if (ch == '\n')
break;
}
@@ -445,18 +479,26 @@ LispFread(LispFile *file, void *data, int size)
if (file->available) {
*buffer++ = file->unget;
file->available = 0;
- if (--size == 0)
+ if (--size == 0) {
+ if (file->unget == '\n' && !file->binary)
+ ++file->line;
+
return (1);
+ }
length = 1;
}
if (file->buffered) {
+ void *base_data = (char*)data - length;
+
if (file->writable) {
LispFflush(file);
bytes = read(file->descriptor, buffer, size);
if (bytes < 0)
bytes = 0;
+ if (!file->binary)
+ file->line += calculate_line(base_data, length + bytes);
return (length + bytes);
}
@@ -481,12 +523,17 @@ LispFread(LispFile *file, void *data, int size)
length += bytes;
}
+ if (!file->binary)
+ file->line += calculate_line(base_data, length);
+
return (length);
}
bytes = read(file->descriptor, buffer, size);
if (bytes < 0)
bytes = 0;
+ if (!file->binary)
+ file->line += calculate_line(buffer - length, length + bytes);
return (length + bytes);
}
@@ -497,7 +544,8 @@ LispFwrite(LispFile *file, void *data, int size)
if (!file->writable || size < 0)
return (EOF);
- file->column = calculate_column(data, size, file->column);
+ if (!file->binary)
+ file->column = calculate_column(data, size, file->column);
if (file->buffered) {
int length, bytes;
@@ -595,7 +643,8 @@ LispSwrite(LispString *string, void *data, int size)
if (string->length < string->output)
string->length = string->output;
- string->column = calculate_column(data, size, string->column);
+ if (!string->binary)
+ string->column = calculate_column(data, size, string->column);
return (size);
}
@@ -603,12 +652,29 @@ LispSwrite(LispString *string, void *data, int size)
char *
LispGetSstring(LispString *string, int *length)
{
- if (string->string == NULL) {
+ if (string->string == NULL || string->length <= 0) {
*length = 0;
return ("");
}
*length = string->length;
+ if (string->string[string->length -1] != '\0') {
+ if (string->length < string->space)
+ string->string[string->length] = '\0';
+ else if (string->fixed && string->space)
+ string->string[string->space - 1] = '\0';
+ else {
+ char *tmp = realloc(string->string, string->space + pagesize);
+
+ if (tmp == NULL)
+ string->string[string->space - 1] = '\0';
+ else {
+ string->string = tmp;
+ string->space += pagesize;
+ string->string[string->length] = '\0';
+ }
+ }
+ }
return (string->string);
}
diff --git a/programs/xedit/lisp/io.h b/programs/xedit/lisp/io.h
index 7d9530024..772522360 100644
--- a/programs/xedit/lisp/io.h
+++ b/programs/xedit/lisp/io.h
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/io.h,v 1.4 2002/11/08 08:00:56 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/io.h,v 1.5 2002/11/10 16:29:05 paulo Exp $ */
#ifndef Lisp_io_h
#define Lisp_io_h
@@ -40,14 +40,15 @@
#define FILE_APPEND 0x06 /* append mode, write bit also set */
#define FILE_BUFFERED 0x08 /* force buffered mode */
#define FILE_UNBUFFERED 0x10 /* force unbuffered mode */
+#define FILE_BINARY 0x20
/*
* Types
*/
struct _LispFile {
char *buffer;
+ int line; /* input line number */
int column; /* output column number */
- int escape; /* when set, print unquoted objects, (princ) */
int descriptor;
int length; /* number of bytes used */
int offset; /* read/write offset */
@@ -58,17 +59,19 @@ struct _LispFile {
int buffered : 1;
int available : 1; /* unget field holds a char */
int nonblock : 1; /* in nonblock mode */
+ int binary : 1; /* if set, don't calculate column/line-number */
};
struct _LispString {
char *string;
+ int line; /* input line number */
int column; /* output column number */
- int escape; /* when set, print unquoted objects, (princ) */
- int fixed; /* if set, don't try to reallocate string */
int space; /* number of bytes alocated */
int length; /* number of bytes used */
int input; /* input offset, for read operations */
int output; /* output offset, for write operations */
+ int fixed : 1; /* if set, don't try to reallocate string */
+ int binary : 1; /* if set, don't calculate column/line-number */
};
/*
diff --git a/programs/xedit/lisp/lisp.c b/programs/xedit/lisp/lisp.c
index 06c4cb302..b3dfdf7cc 100644
--- a/programs/xedit/lisp/lisp.c
+++ b/programs/xedit/lisp/lisp.c
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/lisp.c,v 1.70 2002/11/15 07:01:29 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/lisp.c,v 1.71 2002/11/17 07:51:28 paulo Exp $ */
#include <stdlib.h>
#include <string.h>
@@ -230,6 +230,7 @@ static LispBuiltin lispbuiltins[] = {
{LispMacro, Lisp_Block, "block name &rest body", 0, 0, Com_Block},
{LispFunction, Lisp_Boundp, "boundp symbol"},
{LispFunction, Lisp_Butlast, "butlast list &optional count"},
+ {LispFunction, Lisp_Nbutlast, "nbutlast list &optional count"},
{LispFunction, Lisp_Car, "car list", 0, 0, Com_C_r},
{LispFunction, Lisp_Car, "first list", 0, 0, Com_C_r},
{LispMacro, Lisp_Case, "case keyform &rest body"},
@@ -361,6 +362,7 @@ static LispBuiltin lispbuiltins[] = {
{LispFunction, Lisp_HashTableTest, "hash-table-test hash-table"},
{LispFunction, Lisp_HostNamestring, "host-namestring pathname"},
{LispMacro, Lisp_If, "if test then &optional else", 0, 0, Com_If},
+ {LispMacro, Lisp_IgnoreErrors, "ignore-errors &rest body", 1},
{LispFunction, Lisp_Imagpart, "imagpart number"},
{LispMacro, Lisp_InPackage, "in-package name"},
{LispMacro, Lisp_Incf, "incf place &optional delta"},
@@ -778,12 +780,15 @@ LispTopLevel(void)
lisp__data.unget = info;
lisp__data.unget[0] = unget;
lisp__data.iunget = 0;
+ lisp__data.eof = 0;
}
for (count = 0; lisp__data.mem.level;) {
--lisp__data.mem.level;
- if (lisp__data.mem.mem[lisp__data.mem.level])
+ if (lisp__data.mem.mem[lisp__data.mem.level]) {
++count;
+ printf("LEAK: %p\n", lisp__data.mem.mem[lisp__data.mem.level]);
+ }
}
lisp__data.mem.index = 0;
if (count)
@@ -1113,7 +1118,7 @@ LispMused(void *pointer)
}
void *
-LispMalloc(unsigned size)
+LispMalloc(size_t size)
{
void *pointer;
@@ -1129,7 +1134,7 @@ LispMalloc(unsigned size)
}
void *
-LispCalloc(unsigned nmemb, unsigned size)
+LispCalloc(size_t nmemb, size_t size)
{
void *pointer;
@@ -1145,7 +1150,7 @@ LispCalloc(unsigned nmemb, unsigned size)
}
void *
-LispRealloc(void *pointer, unsigned size)
+LispRealloc(void *pointer, size_t size)
{
void *ptr;
int i;
@@ -2119,12 +2124,16 @@ LispAllocSeg(LispObjSeg *seg, int cellcount)
unsigned int i;
LispObj **list, *obj;
+ DISABLE_INTERRUPTS();
while (seg->nfree < cellcount) {
- if ((obj = (LispObj*)calloc(1, sizeof(LispObj) * segsize)) == NULL)
+ if ((obj = (LispObj*)calloc(1, sizeof(LispObj) * segsize)) == NULL) {
+ ENABLE_INTERRUPTS();
LispDestroy("out of memory");
+ }
if ((list = (LispObj**)realloc(seg->objects,
sizeof(LispObj*) * (seg->nsegs + 1))) == NULL) {
free(obj);
+ ENABLE_INTERRUPTS();
LispDestroy("out of memory");
}
seg->objects = list;
@@ -2147,6 +2156,7 @@ LispAllocSeg(LispObjSeg *seg, int cellcount)
LispMessage("gc: %d cell(s) allocated at %d segment(s)",
seg->nobjs, seg->nsegs);
#endif
+ ENABLE_INTERRUPTS();
}
static INLINE void
@@ -2918,6 +2928,7 @@ LispNewBignum(mpi *bignum)
integer->type = LispBignum_t;
integer->data.mp.integer = bignum;
+ LispMused(bignum->digs);
return (integer);
}
@@ -2929,6 +2940,8 @@ LispNewBigratio(mpr *bigratio)
ratio->type = LispBigratio_t;
ratio->data.mp.ratio = bigratio;
+ LispMused(mpr_num(bigratio)->digs);
+ LispMused(mpr_den(bigratio)->digs);
return (ratio);
}
@@ -3859,6 +3872,7 @@ LispMoreEnvironment(void)
Atom_id *names;
LispObj **values;
+ DISABLE_INTERRUPTS();
names = realloc(lisp__data.env.names,
(lisp__data.env.space + 256) * sizeof(Atom_id));
if (names != NULL) {
@@ -3868,54 +3882,65 @@ LispMoreEnvironment(void)
lisp__data.env.names = names;
lisp__data.env.values = values;
lisp__data.env.space += 256;
-
+ ENABLE_INTERRUPTS();
return;
}
else
free(names);
}
+ ENABLE_INTERRUPTS();
LispDestroy("out of memory");
}
void
LispMoreStack(void)
{
- LispObj **values = realloc(lisp__data.stack.values,
- (lisp__data.stack.space + 256) *
- sizeof(LispObj*));
+ LispObj **values;
- if (values == NULL)
+ DISABLE_INTERRUPTS();
+ values = realloc(lisp__data.stack.values,
+ (lisp__data.stack.space + 256) * sizeof(LispObj*));
+ if (values == NULL) {
+ ENABLE_INTERRUPTS();
LispDestroy("out of memory");
-
+ }
lisp__data.stack.values = values;
lisp__data.stack.space += 256;
+ ENABLE_INTERRUPTS();
}
void
LispMoreGlobals(LispPackage *pack)
{
- LispObj **pairs = realloc(pack->glb.pairs,
- (pack->glb.space + 256) * sizeof(LispObj*));
+ LispObj **pairs;
- if (pairs == NULL)
+ DISABLE_INTERRUPTS();
+ pairs = realloc(pack->glb.pairs,
+ (pack->glb.space + 256) * sizeof(LispObj*));
+ if (pairs == NULL) {
+ ENABLE_INTERRUPTS();
LispDestroy("out of memory");
-
+ }
pack->glb.pairs = pairs;
pack->glb.space += 256;
+ ENABLE_INTERRUPTS();
}
void
LispMoreProtects(void)
{
- LispObj **objects = realloc(lisp__data.protect.objects,
- (lisp__data.protect.space + 256) *
- sizeof(LispObj*));
+ LispObj **objects;
- if (objects == NULL)
+ DISABLE_INTERRUPTS();
+ objects = realloc(lisp__data.protect.objects,
+ (lisp__data.protect.space + 256) * sizeof(LispObj*));
+ if (objects == NULL) {
+ ENABLE_INTERRUPTS();
LispDestroy("out of memory");
-
+ }
lisp__data.protect.objects = objects;
lisp__data.protect.space += 256;
+ ENABLE_INTERRUPTS();
}
static int
@@ -4608,8 +4633,7 @@ LispEval(LispObj *object)
result = LispEvalBackquote(object->data.quote, 1);
break;
case LispComma_t:
- result = LispEvalBackquote(object->data.quote, 0);
- break;
+ LispDestroy("EVAL: comma outside of backquote");
default:
result = object;
break;
@@ -4869,10 +4893,9 @@ LispMachine(void)
}
}
LispTopLevel();
- if (lisp__data.eof)
- break;
- continue;
}
+ if (lisp__data.eof)
+ break;
}
signal(SIGINT, lisp__data.sigint);
diff --git a/programs/xedit/lisp/math.c b/programs/xedit/lisp/math.c
index b7081ab88..15887589e 100644
--- a/programs/xedit/lisp/math.c
+++ b/programs/xedit/lisp/math.c
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/math.c,v 1.17 2002/11/10 16:29:05 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/math.c,v 1.18 2002/11/17 07:51:28 paulo Exp $ */
#include "math.h"
#include "private.h"
@@ -57,6 +57,11 @@ LispMathInit(void)
{
LispObj *object, *result;
+ mp_set_malloc(LispMalloc);
+ mp_set_calloc(LispCalloc);
+ mp_set_realloc(LispRealloc);
+ mp_set_free(LispFree);
+
number_init();
obj_zero = FIXNUM(0);
obj_one = FIXNUM(1);
diff --git a/programs/xedit/lisp/mathimp.c b/programs/xedit/lisp/mathimp.c
index 90c4e2be4..2e8e9e7db 100644
--- a/programs/xedit/lisp/mathimp.c
+++ b/programs/xedit/lisp/mathimp.c
@@ -27,12 +27,8 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/mathimp.c,v 1.10 2002/11/10 16:29:05 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/mathimp.c,v 1.11 2002/11/17 07:51:29 paulo Exp $ */
-/*
- * FIXME: code in the mp library must use LispXalloc functions, to reclaim
- * memory in case of errors.
- */
/*
* Defines
diff --git a/programs/xedit/lisp/mp/mp.c b/programs/xedit/lisp/mp/mp.c
index 10f38a54e..6aa7ce1ab 100644
--- a/programs/xedit/lisp/mp/mp.c
+++ b/programs/xedit/lisp/mp/mp.c
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86$ */
+/* $XFree86: xc/programs/xedit/lisp/mp/mp.c,v 1.2 2002/11/08 08:01:00 paulo Exp $ */
#include "mp.h"
@@ -52,20 +52,40 @@
/* out of memory handler */
static void mp_outmem(void);
+ /* memory allocation fallback functions */
+static void *_mp_malloc(size_t);
+static void *_mp_calloc(size_t, size_t);
+static void *_mp_realloc(void*, size_t);
+static void _mp_free(void*);
+
+/*
+ * Initialization
+ */
+static mp_malloc_fun __mp_malloc = _mp_malloc;
+static mp_calloc_fun __mp_calloc = _mp_calloc;
+static mp_realloc_fun __mp_realloc = _mp_realloc;
+static mp_free_fun __mp_free = _mp_free;
+
/*
* Implementation
*/
-void
+static void
mp_outmem(void)
{
fprintf(stderr, "out of memory in MP library.\n");
exit(1);
}
+static void *
+_mp_malloc(size_t size)
+{
+ return (malloc(size));
+}
+
void *
-mp_malloc(unsigned long size)
+mp_malloc(size_t size)
{
- void *pointer = malloc(size);
+ void *pointer = (*__mp_malloc)(size);
if (pointer == NULL)
mp_outmem();
@@ -73,10 +93,26 @@ mp_malloc(unsigned long size)
return (pointer);
}
+mp_malloc_fun
+mp_set_malloc(mp_malloc_fun fun)
+{
+ mp_malloc_fun old = __mp_malloc;
+
+ __mp_malloc = fun;
+
+ return (old);
+}
+
+static void *
+_mp_calloc(size_t nmemb, size_t size)
+{
+ return (calloc(nmemb, size));
+}
+
void *
-mp_calloc(unsigned long nmemb, unsigned long size)
+mp_calloc(size_t nmemb, size_t size)
{
- void *pointer = calloc(nmemb, size);
+ void *pointer = (*__mp_calloc)(nmemb, size);
if (pointer == NULL)
mp_outmem();
@@ -84,10 +120,26 @@ mp_calloc(unsigned long nmemb, unsigned long size)
return (pointer);
}
+mp_calloc_fun
+mp_set_calloc(mp_calloc_fun fun)
+{
+ mp_calloc_fun old = __mp_calloc;
+
+ __mp_calloc = fun;
+
+ return (old);
+}
+
+static void *
+_mp_realloc(void *old, size_t size)
+{
+ return (realloc(old, size));
+}
+
void *
-mp_realloc(void *old, unsigned long size)
+mp_realloc(void *old, size_t size)
{
- void *pointer = realloc(old, size);
+ void *pointer = (*__mp_realloc)(old, size);
if (pointer == NULL)
mp_outmem();
@@ -95,10 +147,36 @@ mp_realloc(void *old, unsigned long size)
return (pointer);
}
+mp_realloc_fun
+mp_set_realloc(mp_realloc_fun fun)
+{
+ mp_realloc_fun old = __mp_realloc;
+
+ __mp_realloc = fun;
+
+ return (old);
+}
+
+static void
+_mp_free(void *pointer)
+{
+ free(pointer);
+}
+
void
mp_free(void *pointer)
{
- free(pointer);
+ (*__mp_free)(pointer);
+}
+
+mp_free_fun
+mp_set_free(mp_free_fun fun)
+{
+ mp_free_fun old = __mp_free;
+
+ __mp_free = fun;
+
+ return (old);
}
long
diff --git a/programs/xedit/lisp/mp/mp.h b/programs/xedit/lisp/mp/mp.h
index 008bd96f1..ce3e3b8ba 100644
--- a/programs/xedit/lisp/mp/mp.h
+++ b/programs/xedit/lisp/mp/mp.h
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/mp/mp.h,v 1.2 2002/01/31 04:33:29 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/mp/mp.h,v 1.4 2002/11/08 08:01:00 paulo Exp $ */
#include <stdio.h>
#include <math.h>
@@ -121,15 +121,24 @@ typedef struct _mpr {
mpi den;
} mpr;
+typedef void *(*mp_malloc_fun)(size_t);
+typedef void *(*mp_calloc_fun)(size_t, size_t);
+typedef void *(*mp_realloc_fun)(void*, size_t);
+typedef void (*mp_free_fun)(void*);
+
/*
* Prototypes
*/
/* GENERIC FUNCTIONS */
/* memory allocation wrappers */
-void *mp_malloc(unsigned long size);
-void *mp_calloc(unsigned long nmemb, unsigned long size);
-void *mp_realloc(void *pointer, unsigned long size);
+void *mp_malloc(size_t size);
+void *mp_calloc(size_t nmemb, size_t size);
+void *mp_realloc(void *pointer, size_t size);
void mp_free(void *pointer);
+mp_malloc_fun mp_set_malloc(mp_malloc_fun);
+mp_calloc_fun mp_set_calloc(mp_calloc_fun);
+mp_realloc_fun mp_set_realloc(mp_realloc_fun);
+mp_free_fun mp_set_free(mp_free_fun);
/* adds op1 and op2, stores result in rop
* rop must pointer to at least len1 + len2 + 1 elements
diff --git a/programs/xedit/lisp/mp/mpi.c b/programs/xedit/lisp/mp/mpi.c
index ea00f04ff..6f60a39c0 100644
--- a/programs/xedit/lisp/mp/mpi.c
+++ b/programs/xedit/lisp/mp/mpi.c
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/mp/mpi.c,v 1.10 2002/10/06 17:11:49 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/mp/mpi.c,v 1.11 2002/11/17 07:51:29 paulo Exp $ */
#include "mp.h"
@@ -107,7 +107,7 @@ mpi_seti(mpi *rop, long si)
}
if (rop->alloc < size) {
- rop->digs = realloc(rop->digs, sizeof(BNS) * size);
+ rop->digs = mp_realloc(rop->digs, sizeof(BNS) * size);
rop->alloc = size;
}
rop->size = size;
diff --git a/programs/xedit/lisp/read.c b/programs/xedit/lisp/read.c
index 16907b14a..4fa26e696 100644
--- a/programs/xedit/lisp/read.c
+++ b/programs/xedit/lisp/read.c
@@ -27,12 +27,14 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/read.c,v 1.27 2002/11/17 07:51:29 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/read.c,v 1.28 2002/11/19 15:35:39 tsi Exp $ */
#include <errno.h>
#include "read.h"
#include "package.h"
+#include "write.h"
#include <fcntl.h>
+#include <stdarg.h>
/* This should be visible only in read.c, but if an error is generated,
* the current code in write.c will print it as #<ERROR> */
@@ -46,6 +48,20 @@
#define READLABEL_VALUE(object) \
((long)(object) >> LABEL_BIT_COUNT)
+#define READ_ENTER() \
+ LispObj *read__stream = SINPUT; \
+ int read__line = LispGetLine(read__stream)
+#define READ_ERROR0(format) \
+ LispReadError(read__stream, read__line, format)
+#define READ_ERROR1(format, arg1) \
+ LispReadError(read__stream, read__line, format, arg1)
+#define READ_ERROR2(format, arg1, arg2) \
+ LispReadError(read__stream, read__line, format, arg1, arg2)
+
+#define READ_ERROR_EOF() READ_ERROR0("unexpected end of input")
+#define READ_ERROR_FIXNUM() READ_ERROR0("number is not a fixnum")
+#define READ_ERROR_INVARG() READ_ERROR0("invalid argument")
+
/*
* Types
*/
@@ -80,6 +96,14 @@ typedef struct _read_info {
*/
static LispObj *LispReadChar(LispBuiltin*, int);
+static int LispGetLine(LispObj*);
+#ifdef __GNUC__
+#define PRINTF_FORMAT __attribute__ ((format (printf, 3, 4)))
+#else
+#define PRINTF_FORMAT /**/
+#endif
+static void LispReadError(LispObj*, int, char*, ...);
+#undef PRINTF_FORMAT
static void LispReadFixCircle(LispObj*, read_info*);
static LispObj *LispReadLabelCircle(LispObj*, read_info*);
static int LispReadCheckCircle(LispObj*, read_info*);
@@ -90,8 +114,8 @@ static LispObj *LispReadQuote(read_info*);
static LispObj *LispReadBackquote(read_info*);
static LispObj *LispReadCommaquote(read_info*);
static LispObj *LispReadObject(int, read_info*);
-static LispObj *LispParseAtom(char*, char*, int, int);
-static LispObj *LispParseNumber(char*, int);
+static LispObj *LispParseAtom(char*, char*, int, int, LispObj*, int);
+static LispObj *LispParseNumber(char*, int, LispObj*, int);
static int StringInRadix(char*, int, int);
static int AtomSeparator(int, int, int);
static LispObj *LispReadVector(read_info*);
@@ -423,6 +447,8 @@ Lisp_ReadLine(LispBuiltin *builtin)
;
if (ptr == end)
status = T;
+ else if (!SSTREAMP(input_stream)->binary)
+ ++SSTREAMP(input_stream)->line;
length = ptr - start;
string = LispMalloc(length + 1);
memcpy(string, start, length);
@@ -517,6 +543,65 @@ LispRead(void)
return (result);
}
+static int
+LispGetLine(LispObj *stream)
+{
+ int line = -1;
+
+ if (STREAMP(stream)) {
+ switch (stream->data.stream.type) {
+ case LispStreamStandard:
+ case LispStreamFile:
+ if (!FSTREAMP(stream)->binary)
+ line = FSTREAMP(stream)->line;
+ break;
+ case LispStreamPipe:
+ if (!IPSTREAMP(stream)->binary)
+ line = IPSTREAMP(stream)->line;
+ break;
+ case LispStreamString:
+ if (!SSTREAMP(stream)->binary)
+ line = SSTREAMP(stream)->line;
+ break;
+ default:
+ break;
+ }
+ }
+ else if (stream == NIL && !Stdin->binary)
+ line = Stdin->line;
+
+ return (line);
+}
+
+static void
+LispReadError(LispObj *stream, int line, char *fmt, ...)
+{
+ char string[128], *buffer_string;
+ LispObj *buffer = LSTRINGSTREAM("", STREAM_READ | STREAM_WRITE, 1);
+ int length;
+ va_list ap;
+
+ va_start(ap, fmt);
+ vsnprintf(string, sizeof(string), fmt, ap);
+ va_end(ap);
+
+ LispFwrite(Stderr, "*** Reading ", 12);
+ LispWriteObject(buffer, stream);
+ buffer_string = LispGetSstring(SSTREAMP(buffer), &length);
+ LispFwrite(Stderr, buffer_string, length);
+ LispFwrite(Stderr, " at line ", 9);
+ if (line < 0)
+ LispFwrite(Stderr, "?\n", 2);
+ else {
+ char str[32];
+
+ sprintf(str, "%d\n", line);
+ LispFputs(Stderr, str);
+ }
+
+ LispDestroy("READ: %s", string);
+}
+
static void
LispReadFixCircle(LispObj *object, read_info *info)
{
@@ -674,6 +759,7 @@ LispDoRead(read_info *info)
static LispObj *
LispReadMacro(read_info *info)
{
+ READ_ENTER();
LispObj *result = NULL;
int ch = LispGet();
@@ -735,7 +821,7 @@ LispReadMacro(read_info *info)
result = LispReadMacroArg(info);
}
else if (!info->discard)
- LispDestroy("READ: undefined dispatch macro character #%c", ch);
+ READ_ERROR1("undefined dispatch macro character #%c", ch);
break;
}
@@ -745,6 +831,7 @@ LispReadMacro(read_info *info)
static LispObj *
LispReadMacroArg(read_info *info)
{
+ READ_ENTER();
LispObj *result = NIL;
long i, integer;
int ch;
@@ -754,7 +841,7 @@ LispReadMacroArg(read_info *info)
;
if (ch == EOF)
- LispDestroy("READ: unexpected end of input");
+ READ_ERROR_EOF();
/* if ch is not a number the argument was zero */
if (isdigit(ch)) {
@@ -767,14 +854,14 @@ LispReadMacroArg(read_info *info)
if (!isdigit(ch))
break;
if (len + 1 >= sizeof(stk))
- LispDestroy("READ: number is not a fixnum");
+ READ_ERROR_FIXNUM();
stk[len++] = ch;
}
stk[len] = '\0';
integer = strtol(stk, &str, 10);
/* number is positive because sign is not processed here */
if (*str || errno == ERANGE || integer > MOST_POSITIVE_FIXNUM)
- LispDestroy("READ: number is not a fixnum");
+ READ_ERROR_FIXNUM();
}
else
integer = 0;
@@ -788,7 +875,7 @@ LispReadMacroArg(read_info *info)
if ((ch = LispSkipWhiteSpace()) != '(') {
if (info->discard)
return (ch == EOF ? NULL : NIL);
- LispDestroy("READ: bad array specification");
+ READ_ERROR0("bad array specification");
}
result = LispReadVector(info);
}
@@ -801,14 +888,14 @@ LispReadMacroArg(read_info *info)
break;
case '=':
if (integer > MAX_LABEL_VALUE)
- LispDestroy("READ: number is not a fixnum");
+ READ_ERROR_FIXNUM();
if (!info->discard) {
long num_objects = info->num_objects;
/* check for duplicated label */
for (i = 0; i < info->num_objects; i++) {
if (info->objects[i].label == integer)
- LispDestroy("READ: label #%ld# defined more than once",
+ READ_ERROR1("label #%ld# defined more than once",
integer);
}
info->objects = LispRealloc(info->objects,
@@ -821,7 +908,7 @@ LispReadMacroArg(read_info *info)
++info->num_objects;
result = LispDoRead(info);
if (READLABELP(result) && READLABEL_VALUE(result) == integer)
- LispDestroy("incorrect syntax #%ld= #%ld#",
+ READ_ERROR2("incorrect syntax #%ld= #%ld#",
integer, integer);
/* any reference to it now is not shared/circular */
info->objects[num_objects].object = result;
@@ -831,7 +918,7 @@ LispReadMacroArg(read_info *info)
break;
case '#':
if (integer > MAX_LABEL_VALUE)
- LispDestroy("READ: number is not a fixnum");
+ READ_ERROR_FIXNUM();
if (!info->discard) {
/* search object */
for (i = 0; i < info->num_objects; i++) {
@@ -846,12 +933,12 @@ LispReadMacroArg(read_info *info)
}
}
if (i == info->num_objects)
- LispDestroy("READ: undefined label #%ld#", integer);
+ READ_ERROR1("undefined label #%ld#", integer);
}
break;
default:
if (!info->discard)
- LispDestroy("READ: undefined dispatch macro character #%c", ch);
+ READ_ERROR1("undefined dispatch macro character #%c", ch);
break;
}
@@ -883,6 +970,7 @@ LispSkipWhiteSpace(void)
static LispObj *
LispReadList(read_info *info)
{
+ READ_ENTER();
GC_ENTER();
LispObj *result, *cons, *object;
int dot = 0;
@@ -897,7 +985,7 @@ LispReadList(read_info *info)
}
if (object == DOT)
- LispDestroy("READ: illegal start of dotted list");
+ READ_ERROR0("illegal start of dotted list");
result = cons = CONS(object, NIL);
@@ -906,20 +994,20 @@ LispReadList(read_info *info)
while ((object = LispDoRead(info)) != EOLIST) {
if (object == NULL)
- LispDestroy("READ: unexpected end of input");
+ READ_ERROR_EOF();
if (object == DOT) {
if (info->nodot == info->level)
- LispDestroy("READ: dotted list not allowed");
+ READ_ERROR0("dotted list not allowed");
/* this is a dotted list */
if (dot)
- LispDestroy("READ: more than one . in list");
+ READ_ERROR0("more than one . in list");
dot = 1;
}
else {
if (dot) {
/* only one object after a dot */
if (++dot > 2)
- LispDestroy("READ: more than one object after . in list");
+ READ_ERROR0("more than one object after . in list");
RPLACD(cons, object);
}
else {
@@ -931,7 +1019,7 @@ LispReadList(read_info *info)
/* this will happen if last list element was a dot */
if (dot == 1)
- LispDestroy("READ: illegal end of dotted list");
+ READ_ERROR0("illegal end of dotted list");
--info->level;
GC_LEAVE();
@@ -942,10 +1030,11 @@ LispReadList(read_info *info)
static LispObj *
LispReadQuote(read_info *info)
{
+ READ_ENTER();
LispObj *quote = LispDoRead(info), *result;
if (INVALIDP(quote))
- LispDestroy("READ: illegal quoted object");
+ READ_ERROR_INVARG();
result = QUOTE(quote);
@@ -955,10 +1044,11 @@ LispReadQuote(read_info *info)
static LispObj *
LispReadBackquote(read_info *info)
{
+ READ_ENTER();
LispObj *backquote = LispDoRead(info), *result;
if (INVALIDP(backquote))
- LispDestroy("READ: illegal back-quoted object");
+ READ_ERROR_INVARG();
result = BACKQUOTE(backquote);
@@ -968,11 +1058,12 @@ LispReadBackquote(read_info *info)
static LispObj *
LispReadCommaquote(read_info *info)
{
+ READ_ENTER();
LispObj *comma, *result;
int atlist = LispGet();
if (atlist == EOF)
- LispDestroy("READ: unexpected end of input");
+ READ_ERROR_EOF();
else if (atlist != '@' && atlist != '.')
LispUnget(atlist);
@@ -982,7 +1073,7 @@ LispReadCommaquote(read_info *info)
comma = LispDoRead(info);
}
if (INVALIDP(comma))
- LispDestroy("READ: illegal comma-quoted object");
+ READ_ERROR_INVARG();
result = COMMA(comma, atlist == '@' || atlist == '.');
@@ -996,6 +1087,7 @@ LispReadCommaquote(read_info *info)
static LispObj *
LispReadObject(int unintern, read_info *info)
{
+ READ_ENTER();
LispObj *object;
char stk[128], *string, *package, *symbol;
int ch, length, backslash, size, quote, unreadable, collon;
@@ -1007,7 +1099,7 @@ LispReadObject(int unintern, read_info *info)
ch = LispGet();
if (unintern && (ch == ':' || ch == '"'))
- LispDestroy("READ: syntax error after #:");
+ READ_ERROR0("syntax error after #:");
else if (ch == '"' || ch == '|')
quote = ch;
else if (ch == '\\') {
@@ -1069,7 +1161,7 @@ LispReadObject(int unintern, read_info *info)
symbol = string + length + 1;
}
else
- LispDestroy("READ: too many collons");
+ READ_ERROR0("too many collons");
}
}
@@ -1100,7 +1192,7 @@ LispReadObject(int unintern, read_info *info)
if (unintern) {
if (length == 0)
- LispDestroy("READ: syntax error after #:");
+ READ_ERROR0("syntax error after #:");
object = UNINTERNED_ATOM(string);
}
@@ -1119,7 +1211,8 @@ LispReadObject(int unintern, read_info *info)
if (collon > 1)
symbol[-2] = '\0';
object = LispParseAtom(package, symbol,
- collon == 2, unreadable || length == 0);
+ collon == 2, unreadable || length == 0,
+ read__stream, read__line);
}
/* Check some common symbols */
@@ -1139,7 +1232,7 @@ LispReadObject(int unintern, read_info *info)
else if (isdigit(string[0]) || string[0] == '.' ||
((string[0] == '-' || string[0] == '+') && string[1]))
/* Looks like a number */
- object = LispParseNumber(string, 10);
+ object = LispParseNumber(string, 10, read__stream, read__line);
else
/* A normal atom */
@@ -1152,7 +1245,8 @@ LispReadObject(int unintern, read_info *info)
}
static LispObj *
-LispParseAtom(char *package, char *symbol, int intern, int unreadable)
+LispParseAtom(char *package, char *symbol, int intern, int unreadable,
+ LispObj *read__stream, int read__line)
{
LispObj *object = NULL, *thepackage = NULL;
LispPackage *pack = NULL;
@@ -1168,7 +1262,7 @@ LispParseAtom(char *package, char *symbol, int intern, int unreadable)
thepackage = LispFindPackageFromString(package);
if (thepackage == NIL)
- LispDestroy("READ: the package %s is not available", package);
+ READ_ERROR1("the package %s is not available", package);
pack = thepackage->data.package.package;
}
@@ -1228,15 +1322,14 @@ LispParseAtom(char *package, char *symbol, int intern, int unreadable)
/* No object found */
if (object == NULL || object->data.atom->ext == 0)
- LispDestroy("READ: no extern symbol %s in package %s",
- symbol, package);
+ READ_ERROR2("no extern symbol %s in package %s", symbol, package);
}
return (object);
}
static LispObj *
-LispParseNumber(char *str, int radix)
+LispParseNumber(char *str, int radix, LispObj *read__stream, int read__line)
{
int len;
long integer;
@@ -1246,6 +1339,9 @@ LispParseNumber(char *str, int radix)
mpi *bignum;
mpr *bigratio;
+ if (radix < 2 || radix > 36)
+ READ_ERROR1("radix %d is not in the range 2 to 36", radix);
+
if (*str == '\0')
return (NULL);
@@ -1319,7 +1415,7 @@ LispParseNumber(char *str, int radix)
dfloat = strtod(str, NULL);
if (!finite(dfloat))
- LispDestroy("READ: floating point overflow");
+ READ_ERROR0("floating point overflow");
return (DFLOAT(dfloat));
}
@@ -1364,7 +1460,7 @@ LispParseNumber(char *str, int radix)
errno = 0;
denominator = strtol(ratio, NULL, radix);
if (denominator == 0)
- LispDestroy("divide by zero");
+ READ_ERROR0("divide by zero");
if (bignum == NULL) {
if (integer == MINSLONG ||
@@ -1491,6 +1587,7 @@ LispReadVector(read_info *info)
static LispObj *
LispReadFunction(read_info *info)
{
+ READ_ENTER();
int nodot = info->nodot;
LispObj *function;
@@ -1502,15 +1599,15 @@ LispReadFunction(read_info *info)
return (function);
if (INVALIDP(function))
- LispDestroy("READ: illegal function object");
+ READ_ERROR_INVARG();
else if (CONSP(function)) {
if (CAR(function) != Olambda)
- LispDestroy("READ: %s is not a valid lambda", STROBJ(function));
+ READ_ERROR_INVARG();
return (EVAL(function));
}
else if (!SYMBOLP(function))
- LispDestroy("READ: %s cannot name a function", STROBJ(function));
+ READ_ERROR_INVARG();
return (QUOTE(function));
}
@@ -1518,6 +1615,7 @@ LispReadFunction(read_info *info)
static LispObj *
LispReadRational(int radix, read_info *info)
{
+ READ_ENTER();
LispObj *number;
int ch, len, size;
char stk[128], *str;
@@ -1541,7 +1639,7 @@ LispReadRational(int radix, read_info *info)
if (str != stk)
LispFree(str);
if (!info->discard)
- LispDestroy("READ: bad character %c for rational number", ch);
+ READ_ERROR1("bad character %c for rational number", ch);
}
if (len + 1 >= size) {
if (str == stk) {
@@ -1566,12 +1664,12 @@ LispReadRational(int radix, read_info *info)
str[len] = '\0';
- number = LispParseNumber(str, radix);
+ number = LispParseNumber(str, radix, read__stream, read__line);
if (str != stk)
LispFree(str);
if (!RATIONALP(number))
- LispDestroy("READ: bad rational number specification");
+ READ_ERROR0("bad rational number specification");
return (number);
}
@@ -1579,6 +1677,7 @@ LispReadRational(int radix, read_info *info)
static LispObj *
LispReadCharacter(read_info *info)
{
+ READ_ENTER();
long c;
int ch, len;
char stk[64];
@@ -1626,7 +1725,7 @@ LispReadCharacter(read_info *info)
if (!found) {
if (info->discard)
return (NIL);
- LispDestroy("READ: unkwnown character %s", stk);
+ READ_ERROR1("unkwnown character %s", stk);
}
}
else
@@ -1638,6 +1737,7 @@ LispReadCharacter(read_info *info)
static void
LispSkipComment(void)
{
+ READ_ENTER();
int ch, comm = 1;
for (;;) {
@@ -1654,13 +1754,14 @@ LispSkipComment(void)
return;
}
if (ch == EOF)
- LispDestroy("READ: unexpected end of input");
+ READ_ERROR_EOF();
}
}
static LispObj *
LispReadEval(read_info *info)
{
+ READ_ENTER();
int nodot = info->nodot;
LispObj *code;
@@ -1672,7 +1773,7 @@ LispReadEval(read_info *info)
return (code);
if (INVALIDP(code))
- LispDestroy("READ: invalid eval code");
+ READ_ERROR_INVARG();
return (EVAL(code));
}
@@ -1680,6 +1781,7 @@ LispReadEval(read_info *info)
static LispObj *
LispReadComplex(read_info *info)
{
+ READ_ENTER();
GC_ENTER();
int nodot = info->nodot;
LispObj *number, *arguments;
@@ -1693,7 +1795,7 @@ LispReadComplex(read_info *info)
return (arguments);
if (INVALIDP(arguments) || !CONSP(arguments))
- LispDestroy("READ: invalid complex-number specification");
+ READ_ERROR_INVARG();
GC_PROTECT(arguments);
number = APPLY(Ocomplex, arguments);
@@ -1705,6 +1807,7 @@ LispReadComplex(read_info *info)
static LispObj *
LispReadPathname(read_info *info)
{
+ READ_ENTER();
GC_ENTER();
int nodot = info->nodot;
LispObj *path, *arguments;
@@ -1718,7 +1821,7 @@ LispReadPathname(read_info *info)
return (arguments);
if (INVALIDP(arguments))
- LispDestroy("READ: invalid pathname specification");
+ READ_ERROR_INVARG();
GC_PROTECT(arguments);
path = APPLY1(Oparse_namestring, arguments);
@@ -1730,6 +1833,7 @@ LispReadPathname(read_info *info)
static LispObj *
LispReadStruct(read_info *info)
{
+ READ_ENTER();
GC_ENTER();
int len, nodot = info->nodot;
char stk[128], *str;
@@ -1744,7 +1848,7 @@ LispReadStruct(read_info *info)
return (fields);
if (INVALIDP(fields) || !CONSP(fields) || !SYMBOLP(CAR(fields)))
- LispDestroy("READ: invalid structure specification");
+ READ_ERROR_INVARG();
GC_PROTECT(fields);
@@ -1769,6 +1873,7 @@ LispReadStruct(read_info *info)
static LispObj *
LispReadArray(long dimensions, read_info *info)
{
+ READ_ENTER();
GC_ENTER();
long count;
int nodot = info->nodot;
@@ -1783,7 +1888,7 @@ LispReadArray(long dimensions, read_info *info)
return (data);
if (INVALIDP(data))
- LispDestroy("READ: invalid array specification");
+ READ_ERROR_INVARG();
initial = Kinitial_contents;
@@ -1796,7 +1901,7 @@ LispReadArray(long dimensions, read_info *info)
LispObj *item;
if (!CONSP(array))
- LispDestroy("READ: bad array for given dimension");
+ READ_ERROR0("bad array for given dimension");
item = array;
array = CAR(array);
@@ -1825,6 +1930,7 @@ LispReadArray(long dimensions, read_info *info)
static LispObj *
LispReadFeature(int with, read_info *info)
{
+ READ_ENTER();
LispObj *status;
LispObj *feature = LispDoRead(info);
@@ -1833,11 +1939,11 @@ LispReadFeature(int with, read_info *info)
return (feature);
if (INVALIDP(feature))
- LispDestroy("READ: invalid feature specification");
+ READ_ERROR_INVARG();
/* paranoia check, features must be a list, possibly empty */
if (!CONSP(FEATURES) && FEATURES != NIL)
- LispDestroy("READ: %s is not a list", STROBJ(FEATURES));
+ READ_ERROR1("%s is not a list", STROBJ(FEATURES));
status = LispEvalFeature(feature);
@@ -1872,6 +1978,7 @@ LispReadFeature(int with, read_info *info)
static LispObj *
LispEvalFeature(LispObj *feature)
{
+ READ_ENTER();
Atom_id test;
LispObj *object;
@@ -1879,11 +1986,9 @@ LispEvalFeature(LispObj *feature)
LispObj *function = CAR(feature), *arguments = CDR(feature);
if (!SYMBOLP(function))
- LispDestroy("READ: bad feature test function %s",
- STROBJ(function));
+ READ_ERROR1("bad feature test function %s", STROBJ(function));
if (!CONSP(arguments))
- LispDestroy("READ: bad feature test arguments %s",
- STROBJ(arguments));
+ READ_ERROR1("bad feature test arguments %s", STROBJ(arguments));
test = ATOMID(function);
if (test == Sand) {
for (; CONSP(arguments); arguments = CDR(arguments)) {
@@ -1901,25 +2006,25 @@ LispEvalFeature(LispObj *feature)
}
else if (test == Snot) {
if (CONSP(CDR(arguments)))
- LispDestroy("READ: too many arguments to NOT");
+ READ_ERROR0("too many arguments to NOT");
return (LispEvalFeature(CAR(arguments)) == NIL ? T : NIL);
}
else
- LispDestroy("READ: unimplemented feature test function %s", test);
+ READ_ERROR1("unimplemented feature test function %s", test);
}
if (KEYWORDP(feature))
feature = feature->data.quote;
else if (!SYMBOLP(feature))
- LispDestroy("READ: bad feature specification %s", STROBJ(feature));
+ READ_ERROR1("bad feature specification %s", STROBJ(feature));
test = ATOMID(feature);
for (object = FEATURES; CONSP(object); object = CDR(object)) {
/* paranoia check, elements in the feature list must ge keywords */
if (!KEYWORDP(CAR(object)))
- LispDestroy("READ: %s is not a keyword", STROBJ(CAR(object)));
+ READ_ERROR1("%s is not a keyword", STROBJ(CAR(object)));
if (ATOMID(CAR(object)) == test)
return (T);
}
diff --git a/programs/xedit/lisp/test/math.lsp b/programs/xedit/lisp/test/math.lsp
index 3e0cdbe91..865b5a146 100644
--- a/programs/xedit/lisp/test/math.lsp
+++ b/programs/xedit/lisp/test/math.lsp
@@ -27,7 +27,7 @@
;; Author: Paulo César Pereira de Andrade
;;
;;
-;; $XFree86$
+;; $XFree86: xc/programs/xedit/lisp/test/math.lsp,v 1.1 2002/11/17 07:51:30 paulo Exp $
;;
;; basic math tests
@@ -41,81 +41,83 @@
;; floating point results may differ from implementation to implementation (?!)
(defun test (expect function &rest arguments &aux result (error t))
- (unwind-protect
- (setq result (apply function arguments) error nil)
- (if error
- (format t "ERROR: (~A~{ ~A~})~%" function arguments)
- ;; Use eql to make sure result and expect have the same type
- (or (eql result expect)
+ (ignore-errors
+ (setq result (apply function arguments))
+ (setq error nil)
+ )
+ (if error
+ (format t "ERROR: (~A~{ ~A~})~%" function arguments)
+ ;; Use eql to make sure result and expect have the same type
+ (or (eql result expect)
#-xedit ;; hack...
- (or
- (and
- (floatp result)
- (floatp expect)
- (< (abs (- (abs result) (abs expect)))
- 0.00000000000001d0)
- )
- (format t "(~A~{ ~A~}) => should be ~A not ~A~%"
- function arguments expect result
- )
+ (or
+ (and
+ (floatp result)
+ (floatp expect)
+ (< (abs (- (abs result) (abs expect)))
+ 0.00000000000001d0)
)
-#+xedit (format t "(~A~{ ~A~}) => should be ~A not ~A~%"
+ (format t "(~A~{ ~A~}) => should be ~A not ~A~%"
function arguments expect result
)
)
+#+xedit (format t "(~A~{ ~A~}) => should be ~A not ~A~%"
+ function arguments expect result
+ )
)
)
)
(defun div-test (quotient remainder function &rest arguments
&aux quo rem (error t))
- (unwind-protect
+ (ignore-errors
(multiple-value-setq (quo rem) (apply function arguments))
(setq error nil)
- (if error
- (format t "ERROR: (~A~{ ~A~})~%" function arguments)
- (or (and (eql quotient quo) (eql remainder rem))
+ )
+ (if error
+ (format t "ERROR: (~A~{ ~A~})~%" function arguments)
+ (or (and (eql quotient quo) (eql remainder rem))
#-xedit ;; hack
+ (or
(or
- (or
- (eq quotient quo)
- (and
- (floatp quotient)
- (floatp quo)
- (< (abs (- (abs quotient) (abs quo)))
- 0.00000000000001d0)
- )
- )
- (or
- (eq remainder rem)
- (and
- (floatp remainder)
- (floatp rem)
- (< (abs (- (abs remainder) (abs rem)))
- 0.00000000000001d0)
- )
+ (eq quotient quo)
+ (and
+ (floatp quotient)
+ (floatp quo)
+ (< (abs (- (abs quotient) (abs quo)))
+ 0.00000000000001d0)
)
- (format t "(~A~{ ~A~}) => should be ~A; ~A not ~A; ~A~%"
- function arguments quotient remainder quo rem
+ )
+ (or
+ (eq remainder rem)
+ (and
+ (floatp remainder)
+ (floatp rem)
+ (< (abs (- (abs remainder) (abs rem)))
+ 0.00000000000001d0)
)
)
-#+xedit (format t "(~A~{ ~A~}) => should be ~A; ~A not ~A; ~A~%"
+ (format t "(~A~{ ~A~}) => should be ~A; ~A not ~A; ~A~%"
function arguments quotient remainder quo rem
)
)
+#+xedit (format t "(~A~{ ~A~}) => should be ~A; ~A not ~A; ~A~%"
+ function arguments quotient remainder quo rem
+ )
)
)
)
(defun bool-test (expect function &rest arguments &aux result (error t))
- (unwind-protect
- (setq result (apply function arguments) error nil)
- (if error
- (format t "ERROR: (~A~{ ~A~})~%" function arguments)
- (or (eq result expect)
- (format t "(~A~{ ~A~}) => should be ~A not ~A~%"
- function arguments expect result
- )
+ (ignore-errors
+ (setq result (apply function arguments))
+ (setq error nil)
+ )
+ (if error
+ (format t "ERROR: (~A~{ ~A~})~%" function arguments)
+ (or (eq result expect)
+ (format t "(~A~{ ~A~}) => should be ~A not ~A~%"
+ function arguments expect result
)
)
)
@@ -475,8 +477,8 @@
#'/ #c(-1.3d0 4312412654633) #c(3/2 7/15))
(test #c(0.003674737027278924d0 -257.6948748113586d0)
#'/ #c(1.5d0 -432412) #c(1678 -567/31313))
-(test t #'= #c(1 2d0) #c(1 2))
-(test nil #'/= #c(1 2) #c(1d0 2d0))
+(bool-test t #'= #c(1 2d0) #c(1 2))
+(bool-test nil #'/= #c(1 2) #c(1d0 2d0))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; abs
diff --git a/programs/xedit/lisp/write.c b/programs/xedit/lisp/write.c
index a54d163c4..99fe46d2f 100644
--- a/programs/xedit/lisp/write.c
+++ b/programs/xedit/lisp/write.c
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/write.c,v 1.22 2002/11/15 07:27:46 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/write.c,v 1.23 2002/11/17 07:51:29 paulo Exp $ */
#include "write.h"
#include "hash.h"
@@ -84,11 +84,15 @@ static void check_stream(LispObj*, LispFile**, LispString**, int);
static void parse_double(char*, int*, double, int);
static void format_integer(char*, long, int);
static int LispWriteCPointer(LispObj*, void*);
-static int LispWriteCString(LispObj*, char*, long);
+static int LispWriteCString(LispObj*, char*, long, write_info*);
static int LispDoFormatExponentialFloat(LispObj*, LispObj*,
int, int, int*, int, int,
int, int, int, int);
+static int LispWriteInteger(LispObj*, LispObj*);
+static int LispWriteCharacter(LispObj*, LispObj*, write_info*);
+static int LispWriteString(LispObj*, LispObj*, write_info*);
+static int LispWriteFloat(LispObj*, LispObj*);
static int LispWriteAtom(LispObj*, LispObj*, write_info*);
static int LispDoWriteAtom(LispObj*, char*, int, int);
static int LispWriteList(LispObj*, LispObj*, write_info*, int);
@@ -252,7 +256,7 @@ int
LispWriteObject(LispObj *stream, LispObj *object)
{
write_info info;
- int bytes, escape;
+ int bytes;
LispObj *level, *length, *circle, *oescape, *ocase;
/* current state */
@@ -304,11 +308,7 @@ LispWriteObject(LispObj *stream, LispObj *object)
else
info.print_case = UPCASE;
- escape = LispGetEscape(stream);
- if (info.print_escape >= 0)
- LispSetEscape(stream, info.print_escape);
bytes = LispDoWriteObject(stream, object, &info, 1);
- LispSetEscape(stream, escape);
if (circle && circle != NIL && info.num_circles)
LispFree(info.circles);
@@ -559,11 +559,11 @@ LispWriteCPointer(LispObj *stream, void *data)
}
static int
-LispWriteCString(LispObj *stream, char *string, long length)
+LispWriteCString(LispObj *stream, char *string, long length, write_info *info)
{
int result;
- if (!LispGetEscape(stream)) {
+ if (!info->print_escape) {
char *base, *ptr, *end;
result = LispWriteChar(stream, '"');
@@ -692,10 +692,10 @@ write_again:
length += LispWriteAtom(stream, object, info);
break;
case LispString_t:
- length += LispWriteString(stream, object);
+ length += LispWriteString(stream, object, info);
break;
case LispSChar_t:
- length += LispWriteCharacter(stream, object);
+ length += LispWriteCharacter(stream, object, info);
break;
case LispDFloat_t:
length += LispWriteFloat(stream, object);
@@ -825,7 +825,7 @@ write_again:
int size;
char *string = LispGetSstring(SSTREAMP(object), &size);
- length += LispWriteCString(stream, string, size);
+ length += LispWriteCString(stream, string, size, info);
}
else {
length += LispDoWriteObject(stream,
@@ -835,6 +835,13 @@ write_again:
length += LispWriteChar(stream, ' ');
length += LispWriteCPointer(stream,
object->data.stream.source.file);
+ if (object->data.stream.readable &&
+ object->data.stream.type == LispStreamFile &&
+ !object->data.stream.source.file->binary) {
+ length += LispWriteStr(stream, " @", 2);
+ format_integer(stk, object->data.stream.source.file->line, 10);
+ length += LispWriteStr(stream, stk, strlen(stk));
+ }
}
length += LispWriteChar(stream, '>');
break;
@@ -908,31 +915,6 @@ LispGetColumn(LispObj *stream)
return (string->column);
}
-int
-LispGetEscape(LispObj *stream)
-{
- LispFile *file;
- LispString *string;
-
- check_stream(stream, &file, &string, 0);
- if (file != NULL)
- return (file->escape);
- return (string->escape);
-}
-
-void
-LispSetEscape(LispObj *stream, int escape)
-{
- LispFile *file;
- LispString *string;
-
- check_stream(stream, &file, &string, 0);
- if (file != NULL)
- file->escape = escape;
- else
- string->escape = escape;
-}
-
/* write a character to stream */
int
LispWriteChar(LispObj *stream, int character)
@@ -1096,26 +1078,25 @@ LispWriteAtom(LispObj *stream, LispObj *object, write_info *info)
return (length);
}
-int
+static int
LispWriteInteger(LispObj *stream, LispObj *object)
{
return (LispFormatInteger(stream, object, 10, 0, 0, 0, 0, 0, 0));
}
-int
-LispWriteCharacter(LispObj *stream, LispObj *object)
+static int
+LispWriteCharacter(LispObj *stream, LispObj *object, write_info *info)
{
- return (LispFormatCharacter(stream, object, 1,
- LispGetEscape(stream)));
+ return (LispFormatCharacter(stream, object, 1, info->print_escape));
}
-int
-LispWriteString(LispObj *stream, LispObj *object)
+static int
+LispWriteString(LispObj *stream, LispObj *object, write_info *info)
{
- return (LispWriteCString(stream, THESTR(object), STRLEN(object)));
+ return (LispWriteCString(stream, THESTR(object), STRLEN(object), info));
}
-int
+static int
LispWriteFloat(LispObj *stream, LispObj *object)
{
double value = DFLOAT_VALUE(object);
@@ -1358,7 +1339,7 @@ LispFormatInteger(LispObj *stream, LispObj *object, int radix,
/* if number required more than sizeof(stk) bytes */
if (str != stk)
- free(str);
+ LispFree(str);
return (length);
}
diff --git a/programs/xedit/lisp/write.h b/programs/xedit/lisp/write.h
index eab3f3228..3a1f003f4 100644
--- a/programs/xedit/lisp/write.h
+++ b/programs/xedit/lisp/write.h
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/write.h,v 1.6 2002/11/12 06:05:08 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/write.h,v 1.7 2002/11/13 04:35:47 paulo Exp $ */
#ifndef Lisp_write_h
#define Lisp_write_h
@@ -45,21 +45,11 @@ LispObj *Lisp_Print(LispBuiltin*);
LispObj *Lisp_Write(LispBuiltin*);
int LispGetColumn(LispObj*);
-int LispGetEscape(LispObj*);
-void LispSetEscape(LispObj*, int);
int LispWriteChar(LispObj*, int);
int LispWriteChars(LispObj*, int, int);
int LispWriteStr(LispObj*, char*, long);
- /* object must be an integer */
-int LispWriteInteger(LispObj*, LispObj*);
- /* object must be a character */
-int LispWriteCharacter(LispObj*, LispObj*);
- /* object must be a string */
-int LispWriteString(LispObj*, LispObj*);
- /* object must be a float */
-int LispWriteFloat(LispObj*, LispObj*);
/* write any lisp object to stream */
int LispWriteObject(LispObj*, LispObj*);
diff --git a/programs/xedit/lisp/xedit.c b/programs/xedit/lisp/xedit.c
index b31dfd518..059df55bd 100644
--- a/programs/xedit/lisp/xedit.c
+++ b/programs/xedit/lisp/xedit.c
@@ -27,7 +27,7 @@
* Author: Paulo César Pereira de Andrade
*/
-/* $XFree86: xc/programs/xedit/lisp/xedit.c,v 1.14 2002/11/15 07:01:31 paulo Exp $ */
+/* $XFree86: xc/programs/xedit/lisp/xedit.c,v 1.15 2002/11/17 07:51:29 paulo Exp $ */
#include "../xedit.h"
#include <X11/Xaw/TextSrcP.h> /* Needs some private definitions */
@@ -572,8 +572,7 @@ XeditInteractiveCallback(Widget w, XtPointer client_data, XtPointer call_data)
/* While the newline after the right position has a "hidden" property,
* keep incrementing a line to be reparsed. */
while (right < last) {
- position = XawTextSourceScan(w, right, XawstEOL, XawsdRight, 1, True);
- if (XawTextSourceAnchorAndEntity(w, position, &anchor, &entity))
+ if (XawTextSourceAnchorAndEntity(w, right, &anchor, &entity))
right = XawTextSourceScan(w, right, XawstEOL, XawsdRight, 2, False);
else
break;
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-20 22:22:43 +0000