summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/bytecode.c85
-rw-r--r--lisp/compile.c12
-rw-r--r--lisp/core.c20
-rw-r--r--lisp/format.c2
-rw-r--r--lisp/helper.c12
-rw-r--r--lisp/internal.h14
-rw-r--r--lisp/lisp.c220
-rw-r--r--lisp/math.c2
-rw-r--r--lisp/package.c98
-rw-r--r--lisp/private.h25
-rw-r--r--lisp/read.c20
-rw-r--r--lisp/stream.c10
-rw-r--r--lisp/struct.c30
-rw-r--r--lisp/write.c28
14 files changed, 267 insertions, 311 deletions
diff --git a/lisp/bytecode.c b/lisp/bytecode.c
index 3e824d2..8353a13 100644
--- a/lisp/bytecode.c
+++ b/lisp/bytecode.c
@@ -627,8 +627,8 @@ Lisp_Disassemble(LispBuiltin *builtin)
for (i = 0; i < alist->normals.num_symbols; i++) {
LispWriteChar(NIL, i ? ',' : ':');
LispWriteChar(NIL, ' ');
- LispWriteStr(NIL, ATOMID(alist->normals.symbols[i]),
- strlen(ATOMID(alist->normals.symbols[i])));
+ LispWriteStr(NIL, ATOMID(alist->normals.symbols[i])->value,
+ ATOMID(alist->normals.symbols[i])->length);
}
LispWriteChar(NIL, '\n');
@@ -639,8 +639,8 @@ Lisp_Disassemble(LispBuiltin *builtin)
for (i = 0; i < alist->optionals.num_symbols; i++) {
LispWriteChar(NIL, i ? ',' : ':');
LispWriteChar(NIL, ' ');
- LispWriteStr(NIL, ATOMID(alist->optionals.symbols[i]),
- strlen(ATOMID(alist->optionals.symbols[i])));
+ LispWriteStr(NIL, ATOMID(alist->optionals.symbols[i])->value,
+ ATOMID(alist->optionals.symbols[i])->length);
}
LispWriteChar(NIL, '\n');
@@ -657,8 +657,8 @@ Lisp_Disassemble(LispBuiltin *builtin)
if (alist->rest) {
LispWriteStr(NIL, "Rest argument: ", 15);
- LispWriteStr(NIL, ATOMID(alist->rest),
- strlen(ATOMID(alist->rest)));
+ LispWriteStr(NIL, ATOMID(alist->rest)->value,
+ ATOMID(alist->rest)->length);
LispWriteChar(NIL, '\n');
}
else
@@ -666,6 +666,7 @@ Lisp_Disassemble(LispBuiltin *builtin)
}
if (bytecode) {
+ Atom_id id;
char *ptr;
int *offsets[4];
int i, done, j, sym0, sym1, con0, con1, bui0, byt0, strd, strf;
@@ -724,11 +725,11 @@ Lisp_Disassemble(LispBuiltin *builtin)
* and called as XSTRING(atom->object)
* it would also print the package name were the symbol was first defined,
* but for local variables, only the symbol string is important. */
-#define XSTRING(string) string ? string : "#<UNBOUND>"
+#define XSTRING(key) key ? key->value : "#<UNBOUND>"
for (i = 0; i < num_symbols; i++) {
sprintf(buffer, "Symbol %d = %s\n",
- i, XSTRING(symbols[i]->string));
+ i, XSTRING(symbols[i]->key));
LispWriteStr(NIL, buffer, strlen(buffer));
}
for (i = 0; i < num_builtins; i++) {
@@ -756,24 +757,24 @@ Lisp_Disassemble(LispBuiltin *builtin)
for (i = 0; i < alist->normals.num_symbols; i++, j++) {
sprintf(buffer, "%d = ", j);
LispWriteStr(NIL, buffer, strlen(buffer));
- ptr = alist->normals.symbols[i]->data.atom->string;
- LispWriteStr(NIL, ptr, strlen(ptr));
+ id = alist->normals.symbols[i]->data.atom->key;
+ LispWriteStr(NIL, id->value, id->length);
LispWriteChar(NIL, '\n');
}
for (i = 0; i < alist->optionals.num_symbols; i++, j++) {
sprintf(buffer, "%d = ", j);
LispWriteStr(NIL, buffer, strlen(buffer));
- ptr = alist->optionals.symbols[i]->data.atom->string;
- LispWriteStr(NIL, ptr, strlen(ptr));
+ id = alist->optionals.symbols[i]->data.atom->key;
+ LispWriteStr(NIL, id->value, id->length);
LispWriteChar(NIL, '\n');
if (alist->optionals.sforms[i]) {
sprintf(buffer, "%d = ", j);
len1 = strlen(buffer);
LispWriteStr(NIL, buffer, len1);
- ptr = alist->optionals.sforms[i]->data.atom->string;
- len2 = strlen(ptr);
- LispWriteStr(NIL, ptr, len2);
+ id = alist->optionals.sforms[i]->data.atom->key;
+ len2 = id->length;
+ LispWriteStr(NIL, id->value, len2);
LispWriteChars(NIL, ' ', 28 - (len1 + len2));
LispWriteStr(NIL, "; sform\n", 9);
j++;
@@ -785,24 +786,24 @@ Lisp_Disassemble(LispBuiltin *builtin)
len1 = strlen(buffer);
LispWriteStr(NIL, buffer, len1);
if (alist->keys.keys[i]) {
- ptr = alist->keys.keys[i]->data.atom->string;
- len2 = strlen(ptr);
- LispWriteStr(NIL, ptr, strlen(ptr));
+ id = alist->keys.keys[i]->data.atom->key;
+ len2 = id->length;
+ LispWriteStr(NIL, id->value, id->length);
LispWriteChars(NIL, ' ', 28 - (len1 + len2));
LispWriteStr(NIL, "; special key", 14);
}
else {
- ptr = alist->keys.symbols[i]->data.atom->string;
- LispWriteStr(NIL, ptr, strlen(ptr));
+ id = alist->keys.symbols[i]->data.atom->key;
+ LispWriteStr(NIL, id->value, id->length);
}
LispWriteChar(NIL, '\n');
if (alist->keys.sforms[i]) {
sprintf(buffer, "%d = ", j);
len1 = strlen(buffer);
LispWriteStr(NIL, buffer, len1);
- ptr = alist->keys.sforms[i]->data.atom->string;
- len2 = strlen(ptr);
- LispWriteStr(NIL, ptr, len2);
+ id = alist->keys.sforms[i]->data.atom->key;
+ len2 = id->length;
+ LispWriteStr(NIL, id->value, len2);
LispWriteChars(NIL, ' ', 28 - (len1 + len2));
LispWriteStr(NIL, "; sform\n", 9);
j++;
@@ -813,9 +814,9 @@ Lisp_Disassemble(LispBuiltin *builtin)
sprintf(buffer, "%d = ", j);
len1 = strlen(buffer);
LispWriteStr(NIL, buffer, len1);
- ptr = alist->rest->data.atom->string;
- len2 = strlen(ptr);
- LispWriteStr(NIL, ptr, len2);
+ id = alist->rest->data.atom->key;
+ len2 = id->length;
+ LispWriteStr(NIL, id->value, len2);
LispWriteChar(NIL, '\n');
j++;
}
@@ -824,9 +825,9 @@ Lisp_Disassemble(LispBuiltin *builtin)
sprintf(buffer, "%d = ", j);
len1 = strlen(buffer);
LispWriteStr(NIL, buffer, len1);
- ptr = alist->auxs.symbols[i]->data.atom->string;
- len2 = strlen(ptr);
- LispWriteStr(NIL, ptr, len2);
+ id = alist->auxs.symbols[i]->data.atom->key;
+ len2 = id->length;
+ LispWriteStr(NIL, id->value, len2);
LispWriteChars(NIL, ' ', 28 - (len1 + len2));
LispWriteStr(NIL, "; aux\n", 7);
}
@@ -1116,7 +1117,7 @@ integer:
for (; strf >= 0; strf--)
fields = CDR(fields);
strcpy(ptr, " "); ptr += 2;
- strcpy(ptr, CAR(fields)->data.atom->string);
+ strcpy(ptr, CAR(fields)->data.atom->key->value);
ptr += strlen(ptr);
}
if (strd >= 0) {
@@ -1154,11 +1155,11 @@ integer:
/* Symbols */
if (sym0 >= 0) {
strcpy(ptr, " "); ptr += 2;
- strcpy(ptr, XSTRING(symbols[sym0]->string));
+ strcpy(ptr, XSTRING(symbols[sym0]->key));
ptr += strlen(ptr);
if (sym1 >= 0) {
strcpy(ptr, " "); ptr += 2;
- strcpy(ptr, XSTRING(symbols[sym1]->string));
+ strcpy(ptr, XSTRING(symbols[sym1]->key));
ptr += strlen(ptr);
}
}
@@ -1658,7 +1659,7 @@ LinkWarnUnused(LispCom *com, CodeBlock *block)
if (!(block->variables.flags[i] & (VARIABLE_USED | VARIABLE_ARGUMENT))) {
++com->warnings;
LispWarning("the variable %s is unused",
- block->variables.symbols[i]->string);
+ block->variables.symbols[i]->key->value);
}
}
@@ -3274,7 +3275,7 @@ let_argument:
* atom->constant field. */
atom = symbols[*stream++];
atom->offset = lisp__data.env.length;
- lisp__data.env.names[lisp__data.env.length] = atom->string;
+ lisp__data.env.names[lisp__data.env.length] = atom->key;
lisp__data.env.values[lisp__data.env.length++] = reg0;
NEXT_OPCODE();
@@ -3282,7 +3283,7 @@ OPCODE_LABEL(XBC_LETX):
letx_argument:
atom = symbols[*stream++];
atom->offset = lisp__data.env.length;
- lisp__data.env.names[lisp__data.env.length] = atom->string;
+ lisp__data.env.names[lisp__data.env.length] = atom->key;
lisp__data.env.values[lisp__data.env.length++] = reg0;
lisp__data.env.head++;
NEXT_OPCODE();
@@ -3290,14 +3291,14 @@ letx_argument:
OPCODE_LABEL(XBC_LET_NIL):
atom = symbols[*stream++];
atom->offset = lisp__data.env.length;
- lisp__data.env.names[lisp__data.env.length] = atom->string;
+ lisp__data.env.names[lisp__data.env.length] = atom->key;
lisp__data.env.values[lisp__data.env.length++] = NIL;
NEXT_OPCODE();
OPCODE_LABEL(XBC_LETX_NIL):
atom = symbols[*stream++];
atom->offset = lisp__data.env.length;
- lisp__data.env.names[lisp__data.env.length] = atom->string;
+ lisp__data.env.names[lisp__data.env.length] = atom->key;
lisp__data.env.values[lisp__data.env.length++] = NIL;
lisp__data.env.head++;
NEXT_OPCODE();
@@ -3445,7 +3446,7 @@ OPCODE_LABEL(XBC_SETSYM):
/* atom->dyn and atom->constant are exclusive, no
* need to check if variable declared as constant. */
if (atom->offset < lisp__data.env.head &&
- lisp__data.env.names[atom->offset] == atom->string)
+ lisp__data.env.names[atom->offset] == atom->key)
lisp__data.env.values[atom->offset] = reg0;
else {
if (atom->watch)
@@ -3468,7 +3469,7 @@ OPCODE_LABEL(XBC_SETSYM):
LispPackage *pack;
LispWarning("the variable %s was not declared",
- atom->string);
+ atom->key->value);
LispSetAtomObjectProperty(atom, reg0);
pack = atom->package->data.package.package;
if (pack->glb.length >= pack->glb.space)
@@ -3482,7 +3483,7 @@ OPCODE_LABEL(XBC_SETSYM):
atom = symbols[*stream++]; \
if (atom->dyn) { \
if (atom->offset < lisp__data.env.head && \
- lisp__data.env.names[atom->offset] == atom->string) \
+ lisp__data.env.names[atom->offset] == atom->key) \
reg0 = lisp__data.env.values[atom->offset]; \
else { \
reg0 = atom->property->value; \
@@ -3631,12 +3632,12 @@ OPCODE_LABEL(XBC_STRUCT):
offset = *stream++;
reg1 = constants[*stream++];
if (!STRUCTP(reg0) || reg0->data.struc.def != reg1) {
- char *name = ATOMID(CAR(reg1));
+ char *name = ATOMID(CAR(reg1))->value;
for (reg1 = CDR(reg1); offset; offset--)
reg1 = CDR(reg1);
LispDestroy("%s-%s: %s is not a %s",
- name, ATOMID(CAR(reg1)), STROBJ(reg0), name);
+ name, ATOMID(CAR(reg1))->value, STROBJ(reg0), name);
}
for (reg0 = reg0->data.struc.fields; offset; offset--)
reg0 = CDR(reg0);
diff --git a/lisp/compile.c b/lisp/compile.c
index 6058c67..829baea 100644
--- a/lisp/compile.c
+++ b/lisp/compile.c
@@ -1175,7 +1175,7 @@ ComAddVariable(LispCom *com, LispObj *symbol, LispObj *value)
{
LispAtom *atom = symbol->data.atom;
- if (atom && atom->string && !com->macro) {
+ if (atom && atom->key && !com->macro) {
int i, length = com->block->variables.length;
i = BuildTablePointer(atom, (void***)&com->block->variables.symbols,
@@ -1216,7 +1216,7 @@ ComGetVariable(LispCom *com, LispObj *symbol)
}
offset = name->offset;
- id = name->string;
+ id = name->key;
base = lisp__data.env.lex;
i = lisp__data.env.head - 1;
@@ -1238,7 +1238,7 @@ ComGetVariable(LispCom *com, LispObj *symbol)
if (!name->a_object) {
++com->warnings;
LispWarning("variable %s is neither declared nor bound",
- name->string);
+ name->key->value);
}
/* Not found, resolve <symbol> at run time */
@@ -1645,7 +1645,7 @@ rest_label:
constantp = 0;
}
- string = builtin ? ATOMID(name) : NULL;
+ string = builtin ? ATOMID(name)->value : NULL;
/* XXX FIXME should have a flag indicating if function call
* change the &REST arguments even if it is a constant list
* (or if the returned value may be changed). */
@@ -1845,7 +1845,7 @@ ComFuncall(LispCom *com, LispObj *function, LispObj *arguments, int eval)
LispObj *definition = atom->property->structure.definition;
if (!CONSP(arguments) || CONSP(CDR(arguments)))
- LispDestroy("%s: too %s arguments", atom->string,
+ LispDestroy("%s: too %s arguments", atom->key->value,
CONSP(arguments) ? "many" : "few");
ComEval(com, CAR(arguments));
@@ -1870,7 +1870,7 @@ ComFuncall(LispCom *com, LispObj *function, LispObj *arguments, int eval)
else {
/* Not yet defined function/macro. */
++com->warnings;
- LispWarning("call to undefined function %s", atom->string);
+ LispWarning("call to undefined function %s", atom->key->value);
com_Funcall(com, function, arguments);
}
break;
diff --git a/lisp/core.c b/lisp/core.c
index 684081a..9077dc5 100644
--- a/lisp/core.c
+++ b/lisp/core.c
@@ -1070,7 +1070,7 @@ Lisp_Defmacro(LispBuiltin *builtin)
name = ARGUMENT(0);
CHECK_SYMBOL(name);
- alist = LispCheckArguments(LispMacro, lambda_list, ATOMID(name), 0);
+ alist = LispCheckArguments(LispMacro, lambda_list, ATOMID(name)->value, 0);
if (CONSP(body) && STRINGP(CAR(body))) {
LispAddDocumentation(name, CAR(body), LispDocFunction);
@@ -1086,7 +1086,8 @@ Lisp_Defmacro(LispBuiltin *builtin)
}
/* redefining these may cause surprises if bytecode
* compiled functions references them */
- LispWarning("%s: %s is being redefined", STRFUN(builtin), ATOMID(name));
+ LispWarning("%s: %s is being redefined", STRFUN(builtin),
+ ATOMID(name)->value);
LispRemAtomBuiltinProperty(name->data.atom);
}
@@ -1112,7 +1113,7 @@ Lisp_Defun(LispBuiltin *builtin)
name = ARGUMENT(0);
CHECK_SYMBOL(name);
- alist = LispCheckArguments(LispFunction, lambda_list, ATOMID(name), 0);
+ alist = LispCheckArguments(LispFunction, lambda_list, ATOMID(name)->value, 0);
if (CONSP(body) && STRINGP(CAR(body))) {
LispAddDocumentation(name, CAR(body), LispDocFunction);
@@ -1128,7 +1129,8 @@ Lisp_Defun(LispBuiltin *builtin)
}
/* redefining these may cause surprises if bytecode
* compiled functions references them */
- LispWarning("%s: %s is being redefined", STRFUN(builtin), ATOMID(name));
+ LispWarning("%s: %s is being redefined", STRFUN(builtin),
+ ATOMID(name)->value);
LispRemAtomBuiltinProperty(name->data.atom);
}
@@ -1166,7 +1168,7 @@ Lisp_Defsetf(LispBuiltin *builtin)
return (function);
}
- alist = LispCheckArguments(LispSetf, lambda_list, ATOMID(function), 0);
+ alist = LispCheckArguments(LispSetf, lambda_list, ATOMID(function)->value, 0);
store = CAR(body);
if (!CONSP(store))
@@ -2050,7 +2052,7 @@ Lisp_Lambda(LispBuiltin *builtin)
body = ARGUMENT(1);
lambda_list = ARGUMENT(0);
- alist = LispCheckArguments(LispLambda, lambda_list, Snil, 0);
+ alist = LispCheckArguments(LispLambda, lambda_list, Snil->value, 0);
name = OPAQUE(alist, LispArgList_t);
lambda_list = LispListProtectedArguments(alist);
@@ -2675,7 +2677,7 @@ Lisp_MakeArray(LispBuiltin *builtin)
type = LispOpaque_t;
else
LispDestroy("%s: unsupported element type %s",
- STRFUN(builtin), ATOMID(element_type));
+ STRFUN(builtin), ATOMID(element_type)->value);
}
}
@@ -3942,7 +3944,7 @@ Lisp_Proclaim(LispBuiltin *builtin)
object = CAR(arguments);
CHECK_SYMBOL(object);
- operation = ATOMID(object);
+ operation = ATOMID(object)->value;
if (strcmp(operation, "SPECIAL") == 0) {
for (arguments = CDR(arguments); CONSP(arguments);
arguments = CDR(arguments)) {
@@ -4988,7 +4990,7 @@ LispDeleteRemoveXSubstitute(LispBuiltin *builtin,
}
/* Skip initial removed elements, if any */
- for (i = 0; objects[i] == NULL && i < xlength; i++)
+ for (i = 0; i < xlength && objects[i] == NULL; i++)
;
for (i = 0; i < xlength; i++, object = CDR(object)) {
diff --git a/lisp/format.c b/lisp/format.c
index abbb49d..ab85565 100644
--- a/lisp/format.c
+++ b/lisp/format.c
@@ -556,7 +556,7 @@ format_ascii(LispObj *stream, LispObj *object, FmtArgs *args)
if (collon)
LispWriteStr(stream, "()", 2);
else
- LispWriteStr(stream, Snil, 3);
+ LispWriteStr(stream, Snil->value, 3);
}
else {
/* if string is not NIL, atsign was specified
diff --git a/lisp/helper.c b/lisp/helper.c
index 100ed2e..be3ee7b 100644
--- a/lisp/helper.c
+++ b/lisp/helper.c
@@ -343,8 +343,8 @@ LispCharacterCoerce(LispBuiltin *builtin, LispObj *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 (SYMBOLP(object) && ATOMID(object)->value[1] == '\0')
+ return (SCHAR(ATOMID(object)->value[0]));
else if (INDEXP(object)) {
int c = FIXNUM_VALUE(object);
@@ -374,9 +374,9 @@ LispStringCoerce(LispBuiltin *builtin, LispObj *object)
return (LSTRING(string, 1));
}
else if (object == NIL)
- return (LSTRING(Snil, 3));
+ return (LSTRING(Snil->value, 3));
else if (object == T)
- return (LSTRING(St, 1));
+ return (LSTRING(St->value, 1));
else
LispDestroy("%s: cannot convert %s to string",
STRFUN(builtin), STROBJ(object));
@@ -442,7 +442,7 @@ LispCoerce(LispBuiltin *builtin,
type = LispPathname_t;
else
LispDestroy("%s: invalid type specification %s",
- STRFUN(builtin), ATOMID(result_type));
+ STRFUN(builtin), ATOMID(result_type)->value);
}
if (OBJECT_TYPE(object) == LispOpaque_t) {
@@ -559,7 +559,7 @@ LispCoerce(LispBuiltin *builtin,
coerce_fail:
LispDestroy("%s: cannot convert %s to %s",
- STRFUN(builtin), STROBJ(object), ATOMID(result_type));
+ STRFUN(builtin), STROBJ(object), ATOMID(result_type)->value);
/* NOTREACHED */
return (NIL);
}
diff --git a/lisp/internal.h b/lisp/internal.h
index b00db3e..2ca4991 100644
--- a/lisp/internal.h
+++ b/lisp/internal.h
@@ -39,6 +39,8 @@
#include "mp.h"
#include "re.h"
+#include "util.h"
+
/*
* Defines
*/
@@ -110,14 +112,14 @@ typedef struct _LispMac LispMac;
#define UPROTECT(key, list) LispUProtect(key, list)
/* create a new unique static atom string */
-#define GETATOMID(string) LispGetAtomString(string, 1)
+#define GETATOMID(string) LispGetAtomKey(string, 1)
#define GCDisable() ++gcpro
#define GCEnable() --gcpro
/* pointer to something unique to all atoms with the same print representation */
-#define ATOMID(object) (object)->data.atom->string
+#define ATOMID(object) (object)->data.atom->key
@@ -432,7 +434,7 @@ typedef struct _LispMac LispMac;
#define LispFileno(file) ((file)->descriptor)
-#define STRFUN(builtin) ATOMID(builtin->symbol)
+#define STRFUN(builtin) ATOMID(builtin->symbol)->value
#define STROBJ(obj) LispStrObj(obj)
/* fetch builtin function/macro argument value
@@ -457,9 +459,9 @@ typedef struct _LispMac LispMac;
#define ERROR_CHECK_SPECIAL_FORM(atom) \
- if (atom->property->fun.builtin->compile) \
+ if ((atom)->property->fun.builtin->compile) \
LispDestroy("%s: the special form %s cannot be redefined", \
- STRFUN(builtin), atom->string)
+ STRFUN(builtin), (atom)->key->value)
@@ -489,7 +491,7 @@ typedef struct _LispHashTable LispHashTable;
/* Bytecode compiler data */
typedef struct _LispCom LispCom;
-typedef char *Atom_id;
+typedef hash_key *Atom_id;
typedef enum _LispType {
/* objects encoded in the LispObj pointer */
diff --git a/lisp/lisp.c b/lisp/lisp.c
index 87bf2cf..720c7df 100644
--- a/lisp/lisp.c
+++ b/lisp/lisp.c
@@ -935,22 +935,20 @@ Lisp__GC(LispObj *car, LispObj *cdr)
/* Traverse atom list, protecting properties, and function/structure
* definitions if lisp__data.gc.immutablebits set */
- for (i = 0; i < STRTBLSZ; i++) {
- atom = pack->atoms[i];
- while (atom) {
- if (atom->property != NOPROPERTY) {
- if (atom->a_property)
- LispMark(atom->property->properties);
- if (lisp__data.gc.immutablebits) {
- if (atom->a_function || atom->a_compiled)
- LispProt(atom->property->fun.function);
- if (atom->a_defsetf)
- LispProt(atom->property->setf);
- if (atom->a_defstruct)
- LispProt(atom->property->structure.definition);
- }
+ for (atom = (LispAtom *)hash_iter_first(pack->atoms);
+ atom;
+ atom = (LispAtom *)hash_iter_next(pack->atoms)) {
+ if (atom->property != NOPROPERTY) {
+ if (atom->a_property)
+ LispMark(atom->property->properties);
+ if (lisp__data.gc.immutablebits) {
+ if (atom->a_function || atom->a_compiled)
+ LispProt(atom->property->fun.function);
+ if (atom->a_defsetf)
+ LispProt(atom->property->setf);
+ if (atom->a_defstruct)
+ LispProt(atom->property->structure.definition);
}
- atom = atom->next;
}
}
}
@@ -1285,97 +1283,88 @@ LispSetVariable(LispObj *var, LispObj *val, char *fname, int eval)
int
LispRegisterOpaqueType(char *desc)
{
+ int length;
LispOpaque *opaque;
- int ii = STRHASH(desc);
- for (opaque = lisp__data.opqs[ii]; opaque; opaque = opaque->next)
- if (strcmp(opaque->desc, desc) == 0)
- return (opaque->type);
- opaque = (LispOpaque*)LispMalloc(sizeof(LispOpaque));
- opaque->desc = LispStrdup(desc);
- opaque->next = lisp__data.opqs[ii];
- lisp__data.opqs[ii] = opaque;
- LispMused(opaque->desc);
- LispMused(opaque);
+ length = strlen(desc);
+ opaque = (LispOpaque *)hash_check(lisp__data.opqs, desc, length);
+
+ if (opaque == NULL) {
+ opaque = (LispOpaque*)LispMalloc(sizeof(LispOpaque));
+ opaque->desc = (hash_key*)LispCalloc(1, sizeof(hash_key));
+ opaque->desc->value = LispStrdup(desc);
+ opaque->desc->length = length;
+ hash_put(lisp__data.opqs, (hash_entry *)opaque);
+ LispMused(opaque->desc->value);
+ LispMused(opaque->desc);
+ LispMused(opaque);
+ opaque->type = ++lisp__data.opaque;
+ }
- return (opaque->type = ++lisp__data.opaque);
+ return (opaque->type);
}
char *
LispIntToOpaqueType(int type)
{
- int i;
LispOpaque *opaque;
if (type) {
- for (i = 0; i < STRTBLSZ; i++) {
- opaque = lisp__data.opqs[i];
- while (opaque) {
- if (opaque->type == type)
- return (opaque->desc);
- opaque = opaque->next;
- }
+ for (opaque = (LispOpaque *)hash_iter_first(lisp__data.opqs);
+ opaque;
+ opaque = (LispOpaque *)hash_iter_next(lisp__data.opqs)) {
+ if (opaque->type == type)
+ return (opaque->desc->value);
}
LispDestroy("Opaque type %d not registered", type);
}
- return (Snil);
-}
-
-int
-LispDoHashString(char *string)
-{
- char *pp;
- int ii, count;
-
- for (pp = string, ii = count = 0; *pp && count < 32; pp++, count++)
- ii = (ii << 1) ^ *pp;
- if (ii < 0)
- ii = -ii;
-
- return (ii % STRTBLSZ);
+ return (Snil->value);
}
-char *
-LispGetAtomString(char *string, int perm)
+hash_key *
+LispGetAtomKey(char *string, int perm)
{
- LispStringHash *entry;
- int ii = STRHASH(string);
-
- for (entry = lisp__data.strings[ii]; entry != NULL; entry = entry->next)
- if (strcmp(entry->string, string) == 0)
- return (entry->string);
-
- entry = (LispStringHash*)LispCalloc(1, sizeof(LispStringHash));
- if (perm)
- entry->string = string;
- else
- entry->string = LispStrdup(string);
- LispMused(entry);
- if (!perm)
- LispMused(entry->string);
- entry->next = lisp__data.strings[ii];
- lisp__data.strings[ii] = entry;
+ int length;
+ hash_entry *entry;
+
+ length = strlen(string);
+ entry = hash_check(lisp__data.strings, string, length);
+ if (entry == NULL) {
+ entry = LispCalloc(1, sizeof(hash_entry));
+ entry->key = LispCalloc(1, sizeof(hash_key));
+ if (perm)
+ entry->key->value = string;
+ else
+ entry->key->value = LispStrdup(string);
+ entry->key->length = length;
+
+ hash_put(lisp__data.strings, entry);
+ if (!perm)
+ LispMused(entry->key->value);
+ LispMused(entry->key);
+ LispMused(entry);
+ }
- return (entry->string);
+ return (entry->key);
}
LispAtom *
LispDoGetAtom(char *str, int perm)
{
+ int length;
LispAtom *atom;
- int ii = STRHASH(str);
- for (atom = lisp__data.pack->atoms[ii]; atom; atom = atom->next)
- if (strcmp(atom->string, str) == 0)
- return (atom);
+ length = strlen(str);
+ atom = (LispAtom *)hash_check(lisp__data.pack->atoms, str, length);
- atom = (LispAtom*)LispCalloc(1, sizeof(LispAtom));
- atom->string = LispGetAtomString(str, perm);
- LispMused(atom);
- atom->next = lisp__data.pack->atoms[ii];
- lisp__data.pack->atoms[ii] = atom;
- atom->property = NOPROPERTY;
+ if (atom == NULL) {
+ atom = (LispAtom*)LispCalloc(1, sizeof(LispAtom));
+ atom->key = LispGetAtomKey(str, perm);
+ hash_put(lisp__data.pack->atoms, (hash_entry *)atom);
+ atom->property = NOPROPERTY;
+ LispMused(atom);
+ }
return (atom);
}
@@ -1464,7 +1453,7 @@ LispSetAtomObjectProperty(LispAtom *atom, LispObj *object)
if (atom->object == lisp__data.package) {
if (!PACKAGEP(object))
LispDestroy("Symbol %s must be a package, not %s",
- ATOMID(lisp__data.package), STROBJ(object));
+ ATOMID(lisp__data.package)->value, STROBJ(object));
lisp__data.pack = object->data.package.package;
}
}
@@ -1752,7 +1741,7 @@ LispCheckKeyword(LispObj *keyword)
if (KEYWORDP(keyword))
return (keyword);
- return (KEYWORD(ATOMID(keyword)));
+ return (KEYWORD(ATOMID(keyword)->value));
}
void
@@ -1904,7 +1893,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin)
if (list != NIL)
LispDestroy("%s %s: %s cannot be a %s argument list",
fnames[type], name, STROBJ(list), types[type]);
- alist->description = GETATOMID("");
+ alist->description = GETATOMID("")->value;
return (alist);
}
@@ -2048,14 +2037,14 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin)
else {
Atom_id atom = ATOMID(spec);
- if (atom[0] == '&') {
+ if (atom->value[0] == '&') {
if (atom == Srest) {
if (rest || aux || CDR(list) == NIL || !SYMBOLP(CADR(list))
/* only &aux allowed after &rest */
|| (CDDR(list) != NIL && !SYMBOLP(CAR(CDDR(list))) &&
ATOMID(CAR(CDDR(list))) != Saux))
LispDestroy("%s %s: syntax error parsing %s",
- fnames[type], name, ATOMID(spec));
+ fnames[type], name, ATOMID(spec)->value);
if (key)
LispDestroy("%s %s: %s not allowed after %s",
fnames[type], name, keys[IREST], keys[IKEY]);
@@ -2066,7 +2055,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin)
else if (atom == Skey) {
if (rest || aux)
LispDestroy("%s %s: %s not allowed after %s",
- fnames[type], name, ATOMID(spec),
+ fnames[type], name, ATOMID(spec)->value,
rest ? keys[IREST] : keys[IAUX]);
key = 1;
continue;
@@ -2075,7 +2064,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin)
else if (atom == Soptional) {
if (rest || optional || aux || key)
LispDestroy("%s %s: %s not allowed after %s",
- fnames[type], name, ATOMID(spec),
+ fnames[type], name, ATOMID(spec)->value,
rest ? keys[IREST] :
optional ?
keys[IOPTIONAL] :
@@ -2088,7 +2077,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin)
/* &AUX must be the last keyword parameter */
if (aux)
LispDestroy("%s %s: syntax error parsing %s",
- fnames[type], name, ATOMID(spec));
+ fnames[type], name, ATOMID(spec)->value);
else if (builtin)
LispDestroy("builtin function cannot have &AUX arguments");
aux = 1;
@@ -2099,7 +2088,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin)
* argument names starting with the '&' character */
else
LispDestroy("%s %s: %s not allowed/implemented",
- fnames[type], name, ATOMID(spec));
+ fnames[type], name, ATOMID(spec)->value);
}
/* Add argument to alist */
@@ -2170,7 +2159,7 @@ LispCheckArguments(LispFunType type, LispObj *list, char *name, int builtin)
fnames[type], name, STROBJ(list), types[type]);
*desc = '\0';
- alist->description = LispGetAtomString(description, 0);
+ alist->description = LispGetAtomKey(description, 0)->value;
return (alist);
}
@@ -2214,7 +2203,7 @@ LispAddBuiltinFunction(LispBuiltin *builtin)
LispPopInput(&stream);
atom = name->data.atom;
- alist = LispCheckArguments(builtin->type, CDR(list), atom->string, 1);
+ alist = LispCheckArguments(builtin->type, CDR(list), atom->key->value, 1);
builtin->symbol = CAR(list);
LispSetAtomBuiltinProperty(atom, builtin, alist);
LispUseArgList(alist);
@@ -2758,8 +2747,8 @@ LispSymbolName(LispObj *symbol)
--atomseg.nfree;
name->type = LispString_t;
- THESTR(name) = atom->string;
- STRLEN(name) = strlen(atom->string);
+ THESTR(name) = atom->key->value;
+ STRLEN(name) = atom->key->length;
name->data.string.writable = 0;
atom->name = name;
@@ -3156,6 +3145,8 @@ LispNewPackage(LispObj *name, LispObj *nicknames)
package->data.package.nicknames = nicknames;
package->data.package.package = pack;
+ package->data.package.package->atoms = hash_new(STRTBLSZ, NULL);
+
LispMused(pack);
return (package);
@@ -3185,30 +3176,18 @@ LispSymbolFunction(LispObj *symbol)
static INLINE LispObj *
LispGetVarPack(LispObj *symbol)
{
- int ii;
- char *string;
LispAtom *atom;
- string = ATOMID(symbol);
- ii = STRHASH(string);
-
- atom = lisp__data.pack->atoms[ii];
- while (atom) {
- if (strcmp(atom->string, string) == 0)
- return (atom->object);
+ atom = (LispAtom *)hash_get(lisp__data.pack->atoms,
+ symbol->data.atom->key);
- atom = atom->next;
- }
-
- /* Symbol not found, just import it */
- return (NULL);
+ return (atom ? atom->object : NULL);
}
/* package must be of type LispPackage_t */
void
LispUsePackage(LispObj *package)
{
- unsigned i;
LispAtom *atom;
LispPackage *pack;
LispObj **pentry, **eentry;
@@ -3242,13 +3221,11 @@ LispUsePackage(LispObj *package)
pack = package->data.package.package;
/* Traverse atom list, searching for extern symbols */
- for (i = 0; i < STRTBLSZ; i++) {
- atom = pack->atoms[i];
- while (atom) {
- if (atom->ext)
- LispImportSymbol(atom->object);
- atom = atom->next;
- }
+ for (atom = (LispAtom *)hash_iter_first(pack->atoms);
+ atom;
+ atom = (LispAtom *)hash_iter_next(pack->atoms)) {
+ if (atom->ext)
+ LispImportSymbol(atom->object);
}
}
@@ -3272,7 +3249,7 @@ LispImportSymbol(LispObj *symbol)
}
/* Create copy of atom in current package */
- atom = LispDoGetAtom(ATOMID(symbol), 0);
+ atom = LispDoGetAtom(ATOMID(symbol)->value, 0);
/* Need to create a copy because if anything new is atached to the
* property, the current package is the owner, not the previous one. */
@@ -3285,7 +3262,7 @@ LispImportSymbol(LispObj *symbol)
/* Symbol already exists in the current package,
* but does not reference the same variable */
LispContinuable("Symbol %s already defined in package %s. Redefine?",
- ATOMID(symbol), THESTR(PACKAGE->data.package.name));
+ ATOMID(symbol)->value, THESTR(PACKAGE->data.package.name));
atom = current->data.atom;
@@ -3375,7 +3352,7 @@ LispGetVar(LispObj *atom)
* binding if it is not -1, and if no binding is found, because the
* lexical scope was left, reset offset to -1. */
offset = name->offset;
- id = name->string;
+ id = name->key;
base = lisp__data.env.lex;
i = lisp__data.env.head - 1;
@@ -3496,7 +3473,7 @@ LispDoAddVar(LispObj *symbol, LispObj *value)
atom->offset = lisp__data.env.length;
lisp__data.env.values[lisp__data.env.length] = value;
- lisp__data.env.names[lisp__data.env.length++] = atom->string;
+ lisp__data.env.names[lisp__data.env.length++] = atom->key;
}
LispObj *
@@ -3509,7 +3486,7 @@ LispSetVar(LispObj *atom, LispObj *obj)
name = atom->data.atom;
offset = name->offset;
- id = name->string;
+ id = name->key;
base = lisp__data.env.lex;
i = lisp__data.env.head - 1;
@@ -5192,6 +5169,9 @@ LispBegin(void)
pagesize = LispGetPageSize();
segsize = pagesize / sizeof(LispObj);
+ lisp__data.strings = hash_new(STRTBLSZ, NULL);
+ lisp__data.opqs = hash_new(STRTBLSZ, NULL);
+
/* Initialize memory management */
lisp__data.mem.mem = (void**)calloc(lisp__data.mem.space = 16,
sizeof(void*));
@@ -5275,7 +5255,7 @@ LispBegin(void)
/* Create the KEYWORD package */
Skeyword = GETATOMID("KEYWORD");
- object = LispNewPackage(STRING(Skeyword),
+ object = LispNewPackage(STRING(Skeyword->value),
CONS(STRING(""), NIL));
/* Update list of packages */
diff --git a/lisp/math.c b/lisp/math.c
index f9b6952..bdca034 100644
--- a/lisp/math.c
+++ b/lisp/math.c
@@ -71,7 +71,7 @@ LispMathInit(void)
obj_one = FIXNUM(1);
Oequal_ = STATIC_ATOM("=");
- Ocomplex = STATIC_ATOM(Scomplex);
+ Ocomplex = STATIC_ATOM(Scomplex->value);
Oshort_float = STATIC_ATOM("SHORT-FLOAT");
LispExportSymbol(Oshort_float);
Osingle_float = STATIC_ATOM("SINGLE-FLOAT");
diff --git a/lisp/package.c b/lisp/package.c
index 6ba23c9..8b941ec 100644
--- a/lisp/package.c
+++ b/lisp/package.c
@@ -87,7 +87,7 @@ LispFindPackage(LispObj *name)
return (name);
if (SYMBOLP(name))
- string = ATOMID(name);
+ string = ATOMID(name)->value;
else if (STRINGP(name))
string = THESTR(name);
else
@@ -169,22 +169,18 @@ LispDoExport(LispBuiltin *builtin,
if (package == PACKAGE)
symbol->data.atom->ext = export ? 1 : 0;
else {
- int i;
- char *string;
+ Atom_id string;
LispAtom *atom;
LispPackage *pack;
string = ATOMID(symbol);
pack = package->data.package.package;
- i = STRHASH(string);
- atom = pack->atoms[i];
- while (atom) {
- if (strcmp(atom->string, string) == 0) {
- atom->ext = export ? 1 : 0;
- return;
- }
+ atom = (LispAtom *)hash_check(pack->atoms,
+ string->value, string->length);
- atom = atom->next;
+ if (atom) {
+ atom->ext = export ? 1 : 0;
+ return;
}
LispDestroy("%s: the symbol %s is not available in package %s",
@@ -203,9 +199,9 @@ LispDoImport(LispBuiltin *builtin, LispObj *symbol)
static LispObj *
LispReallyDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols)
{
- int i, head = lisp__data.env.length;
+ int head = lisp__data.env.length;
LispPackage *pack = NULL;
- LispAtom *atom, *next_atom;
+ LispAtom *atom;
LispObj *variable, *package = NULL, *list, *code, *result_form;
LispObj *init, *body;
@@ -251,21 +247,17 @@ LispReallyDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols)
}
/* Traverse the symbol list, executing body */
- for (i = 0; i < STRTBLSZ; i++) {
- atom = pack->atoms[i];
- while (atom) {
+ for (atom = (LispAtom *)hash_iter_first(pack->atoms);
+ atom;
+ atom = (LispAtom *)hash_iter_next(pack->atoms)) {
/* Save pointer to next atom. If variable is removed,
* predicatable result is only guaranteed if the bound
* variable is removed. */
- next_atom = atom->next;
-
- if (LispDoSymbol(package, atom, only_externs, all_symbols)) {
- LispSetVar(variable, atom->object);
- for (code = body; CONSP(code); code = CDR(code))
- EVAL(CAR(code));
- }
- atom = next_atom;
+ if (LispDoSymbol(package, atom, only_externs, all_symbols)) {
+ LispSetVar(variable, atom->object);
+ for (code = body; CONSP(code); code = CDR(code))
+ EVAL(CAR(code));
}
}
@@ -306,7 +298,6 @@ LispDoSymbols(LispBuiltin *builtin, int only_externs, int all_symbols)
LispObj *
LispFindSymbol(LispBuiltin *builtin, int intern)
{
- int i;
char *ptr;
LispAtom *atom;
LispObj *symbol;
@@ -342,15 +333,9 @@ LispFindSymbol(LispBuiltin *builtin, int intern)
return (symbol);
}
- i = STRHASH(ptr);
- atom = pack->atoms[i];
- while (atom) {
- if (strcmp(atom->string, ptr) == 0) {
- symbol = atom->object;
- break;
- }
- atom = atom->next;
- }
+ atom = (LispAtom *)hash_check(pack->atoms, ptr, strlen(ptr));
+ if (atom)
+ symbol = atom->object;
if (symbol == NULL || symbol->data.atom->package == NULL) {
RETURN(0) = NIL;
@@ -436,46 +421,45 @@ Lisp_FindAllSymbols(LispBuiltin *builtin)
LispAtom *atom;
LispPackage *pack;
LispObj *list, *package, *result;
- int i;
+ int length = 0;
LispObj *string_or_symbol;
string_or_symbol = ARGUMENT(0);
- if (STRINGP(string_or_symbol))
+ if (STRINGP(string_or_symbol)) {
string = THESTR(string_or_symbol);
- else if (SYMBOLP(string_or_symbol))
- string = ATOMID(string_or_symbol);
+ length = STRLEN(string_or_symbol);
+ }
+ else if (SYMBOLP(string_or_symbol)) {
+ string = ATOMID(string_or_symbol)->value;
+ length = ATOMID(string_or_symbol)->length;
+ }
else
LispDestroy("%s: %s is not a string or symbol",
STRFUN(builtin), STROBJ(string_or_symbol));
result = NIL;
- i = STRHASH(string);
/* Traverse all packages, searching for symbols matching specified string */
for (list = PACK; CONSP(list); list = CDR(list)) {
package = CAR(list);
pack = package->data.package.package;
- atom = pack->atoms[i];
- while (atom) {
- if (strcmp(atom->string, string) == 0 &&
- LispDoSymbol(package, atom, 0, 1)) {
- /* Return only one pointer to a matching symbol */
+ atom = (LispAtom *)hash_check(pack->atoms, string, length);
+ if (atom && LispDoSymbol(package, atom, 0, 1)) {
+ /* Return only one pointer to a matching symbol */
- if (result == NIL) {
- result = CONS(atom->object, NIL);
- GC_PROTECT(result);
- }
- else {
- /* Put symbols defined first in the
- * beginning of the result list */
- RPLACD(result, CONS(CAR(result), CDR(result)));
- RPLACA(result, atom->object);
- }
+ if (result == NIL) {
+ result = CONS(atom->object, NIL);
+ GC_PROTECT(result);
+ }
+ else {
+ /* Put symbols defined first in the
+ * beginning of the result list */
+ RPLACD(result, CONS(CAR(result), CDR(result)));
+ RPLACA(result, atom->object);
}
- atom = atom->next;
}
}
GC_LEAVE();
@@ -651,7 +635,7 @@ Lisp_MakePackage(LispBuiltin *builtin)
/* Error checks done, package_name is either a symbol or string */
if (!XSTRINGP(package_name))
- package_name = STRING(ATOMID(package_name));
+ package_name = STRING(ATOMID(package_name)->value);
GC_PROTECT(package_name);
@@ -667,7 +651,7 @@ Lisp_MakePackage(LispBuiltin *builtin)
/* Store all nicknames as strings */
package = CAR(list);
if (!XSTRINGP(package))
- package = STRING(ATOMID(package));
+ package = STRING(ATOMID(package)->value);
if (nicks == NIL) {
nicks = cons = CONS(package, NIL);
GC_PROTECT(nicks);
diff --git a/lisp/private.h b/lisp/private.h
index 08d3bec..ef44ab2 100644
--- a/lisp/private.h
+++ b/lisp/private.h
@@ -192,6 +192,9 @@ struct _LispProperty {
};
struct _LispAtom {
+ hash_key *key;
+ struct _LispAtom *next;
+
/* hint: dynamically binded variable */
unsigned int dyn : 1;
@@ -222,14 +225,12 @@ struct _LispAtom {
/* Symbol value is constant, cannot be changed */
unsigned int constant : 1;
- char *string;
LispObj *object; /* backpointer to object ATOM */
int offset; /* in the environment list */
LispObj *package; /* package home of symbol */
LispObj *function; /* symbol function */
LispObj *name; /* symbol string */
LispProperty *property;
- struct _LispAtom *next;
LispObj *documentation[5];
};
@@ -243,20 +244,13 @@ struct _LispObjList {
struct _LispPackage {
LispObjList glb; /* global symbols in package */
LispObjList use; /* inherited packages */
- LispAtom *atoms[STRTBLSZ]; /* atoms in this package */
+ hash_table *atoms; /* atoms in this package */
};
struct _LispOpaque {
- int type;
- char *desc;
+ hash_key *desc;
LispOpaque *next;
-};
-
-/* These strings are never released, they are used to avoid
- * the need of strcmp() on two symbol names, just compare pointers */
-struct _LispStringHash {
- char *string;
- LispStringHash *next;
+ int type;
};
typedef enum _LispBlockType {
@@ -357,8 +351,8 @@ struct _LispMac {
int average; /* of cells freed after gc calls */
} gc;
- LispStringHash *strings[STRTBLSZ];
- LispOpaque *opqs[STRTBLSZ];
+ hash_table *strings;
+ hash_table *opqs;
int opaque;
LispObj *standard_input, *input, *input_list;
@@ -452,6 +446,7 @@ void LispExportSymbol(LispObj*);
void LispImportSymbol(LispObj*);
/* always returns the same string */
+hash_key *LispGetAtomKey(char*, int);
char *LispGetAtomString(char*, int);
/* destructive fast reverse, note that don't receive a LispMac* argument */
@@ -474,8 +469,6 @@ void LispBlockUnwind(LispBlock*);
void LispUpdateResults(LispObj*, LispObj*);
void LispTopLevel(void);
-#define STRHASH(string) LispDoHashString(string)
-int LispDoHashString(char*);
LispAtom *LispDoGetAtom(char *str, int);
/* get value from atom's property list */
LispObj *LispGetAtomProperty(LispAtom*, LispObj*);
diff --git a/lisp/read.c b/lisp/read.c
index 3c5df3e..283f473 100644
--- a/lisp/read.c
+++ b/lisp/read.c
@@ -1322,7 +1322,7 @@ LispParseAtom(char *package, char *symbol, int intern, int unreadable,
/* Get the object pointer */
if (pack == lisp__data.key)
- object = KEYWORD(LispDoGetAtom(symbol, 0)->string);
+ object = KEYWORD(LispDoGetAtom(symbol, 0)->key->value);
else
object = ATOM(symbol);
if (unreadable)
@@ -1336,19 +1336,11 @@ LispParseAtom(char *package, char *symbol, int intern, int unreadable,
else {
/* Symbol must exist (and be extern) in the specified package */
- int i;
LispAtom *atom;
- i = STRHASH(symbol);
- atom = pack->atoms[i];
- while (atom) {
- if (strcmp(atom->string, symbol) == 0) {
- object = atom->object;
- break;
- }
-
- atom = atom->next;
- }
+ atom = (LispAtom *)hash_check(pack->atoms, symbol, strlen(symbol));
+ if (atom)
+ object = atom->object;
/* No object found */
if (object == NULL || object->data.atom->ext == 0)
@@ -1875,13 +1867,13 @@ LispReadStruct(read_info *info)
GC_PROTECT(fields);
- len = strlen(ATOMID(CAR(fields)));
+ len = ATOMID(CAR(fields))->length;
/* MAKE- */
if (len + 6 > sizeof(stk))
str = LispMalloc(len + 6);
else
str = stk;
- sprintf(str, "MAKE-%s", ATOMID(CAR(fields)));
+ sprintf(str, "MAKE-%s", ATOMID(CAR(fields))->value);
RPLACA(fields, ATOM(str));
if (str != stk)
LispFree(str);
diff --git a/lisp/stream.c b/lisp/stream.c
index a43e711..aad89cf 100644
--- a/lisp/stream.c
+++ b/lisp/stream.c
@@ -303,7 +303,7 @@ Lisp_Open(LispBuiltin *builtin)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
- STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
+ STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
}
if (if_exists != UNSPEC) {
@@ -360,7 +360,7 @@ Lisp_Open(LispBuiltin *builtin)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
- STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
+ STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(external_format));
}
/* string representation of pathname */
@@ -600,7 +600,7 @@ Lisp_MakeStringOutputStream(LispBuiltin *builtin)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
- STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
+ STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
}
return (LSTRINGSTREAM("", STREAM_WRITE, 1));
@@ -695,7 +695,7 @@ Lisp_MakePipe(LispBuiltin *builtin)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
- STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
+ STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(element_type));
}
if (external_format != UNSPEC) {
@@ -707,7 +707,7 @@ Lisp_MakePipe(LispBuiltin *builtin)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
- STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
+ STRFUN(builtin), Sdefault->value, Scharacter->value, STROBJ(external_format));
}
string = THESTR(command_line);
diff --git a/lisp/struct.c b/lisp/struct.c
index 7fbb486..b6ecf14 100644
--- a/lisp/struct.c
+++ b/lisp/struct.c
@@ -55,7 +55,7 @@ Lisp_Defstruct(LispBuiltin *builtin)
int intern;
LispAtom *atom;
int i, size, length, slength;
- char *name, *strname, *sname;
+ char *name, *strname;
LispObj *list, *cons, *object, *definition, *documentation;
LispObj *oname, *description;
@@ -65,8 +65,8 @@ Lisp_Defstruct(LispBuiltin *builtin)
CHECK_SYMBOL(oname);
- strname = ATOMID(oname);
- length = strlen(strname);
+ strname = ATOMID(oname)->value;
+ length = ATOMID(oname)->length;
/* MAKE- */
size = length + 6;
@@ -101,13 +101,13 @@ Lisp_Defstruct(LispBuiltin *builtin)
cons = object;
object = CAR(object);
}
- if (!SYMBOLP(object) || strcmp(ATOMID(object), "P") == 0)
+ if (!SYMBOLP(object) || strcmp(ATOMID(object)->value, "P") == 0)
/* p is invalid as a field name due to `type'-p */
LispDestroy("%s: %s cannot be a field for %s",
- STRFUN(builtin), STROBJ(object), ATOMID(oname));
+ STRFUN(builtin), STROBJ(object), ATOMID(oname)->value);
if (!KEYWORDP(object))
- CAR(cons) = KEYWORD(ATOMID(object));
+ CAR(cons) = KEYWORD(ATOMID(object)->value);
/* check for repeated field names */
for (object = description; object != list; object = CDR(object)) {
@@ -143,16 +143,18 @@ Lisp_Defstruct(LispBuiltin *builtin)
LispExportSymbol(object);
for (i = 0, list = description; CONSP(list); i++, list = CDR(list)) {
+ Atom_id id;
+
if (CONSP(CAR(list)))
- sname = ATOMID(CAR(CAR(list)));
+ id = ATOMID(CAR(CAR(list)));
else
- sname = ATOMID(CAR(list));
- slength = strlen(sname);
+ id = ATOMID(CAR(list));
+ slength = id->length;
if (length + slength + 2 > size) {
size = length + slength + 2;
name = LispRealloc(name, size);
}
- sprintf(name, "%s-%s", strname, sname);
+ sprintf(name, "%s-%s", strname, id->value);
atom = (object = ATOM(name))->data.atom;
LispSetAtomStructProperty(atom, definition, i);
if (!intern)
@@ -202,7 +204,7 @@ Lisp_XeditMakeStruct(LispBuiltin *builtin)
CHECK_KEYWORD(CAR(list));
if (!CONSP(CDR(list)))
LispDestroy("%s: values must be provided as pairs",
- ATOMID(struc));
+ ATOMID(struc)->value);
nfld++;
list = CDR(list);
}
@@ -272,8 +274,8 @@ Lisp_XeditMakeStruct(LispBuiltin *builtin)
}
if (!CONSP(object))
LispDestroy("%s: %s is not a field for %s",
- ATOMID(struc), STROBJ(CAR(list)),
- ATOMID(CAR(definition)));
+ ATOMID(struc)->value, STROBJ(CAR(list)),
+ ATOMID(CAR(definition))->value);
list = CDR(list);
}
}
@@ -316,7 +318,7 @@ LispStructAccessOrStore(LispBuiltin *builtin, int store)
/* check if the object is of the required type */
if (!STRUCTP(struc) || struc->data.struc.def != definition)
LispDestroy("%s: %s is not a %s",
- ATOMID(name), STROBJ(struc), ATOMID(CAR(definition)));
+ ATOMID(name)->value, STROBJ(struc), ATOMID(CAR(definition))->value);
for (list = struc->data.struc.fields; offset; list = CDR(list), offset--)
;
diff --git a/lisp/write.c b/lisp/write.c
index c5d7f24..6c7d979 100644
--- a/lisp/write.c
+++ b/lisp/write.c
@@ -522,15 +522,15 @@ LispPrintCircle(LispObj *stream, LispObj *object, long circle,
static int
LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info)
{
- char *name;
+ Atom_id name;
int i, length = 0, need_space = 0;
#define WRITE_ATOM(object) \
name = ATOMID(object); \
- length += LispDoWriteAtom(stream, name, strlen(name), \
+ length += LispDoWriteAtom(stream, name->value, name->length, \
info->print_case)
-#define WRITE_STRING(string) \
- length += LispDoWriteAtom(stream, string, strlen(string), \
+#define WRITE_ATOMID(atomid) \
+ length += LispDoWriteAtom(stream, atomid->value, atomid->length, \
info->print_case)
#define WRITE_OBJECT(object) \
length += LispDoWriteObject(stream, object, info, 1)
@@ -552,7 +552,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info)
if (alist->optionals.num_symbols) {
if (need_space)
WRITE_SPACE();
- WRITE_STRING(Soptional);
+ WRITE_ATOMID(Soptional);
WRITE_SPACE();
for (i = 0; i < alist->optionals.num_symbols; i++) {
WRITE_OPAREN();
@@ -572,7 +572,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info)
if (alist->keys.num_symbols) {
if (need_space)
WRITE_SPACE();
- length += LispDoWriteAtom(stream, Skey, 4, info->print_case);
+ length += LispDoWriteAtom(stream, Skey->value, 4, info->print_case);
WRITE_SPACE();
for (i = 0; i < alist->keys.num_symbols; i++) {
WRITE_OPAREN();
@@ -599,7 +599,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info)
if (alist->rest) {
if (need_space)
WRITE_SPACE();
- WRITE_STRING(Srest);
+ WRITE_ATOMID(Srest);
WRITE_SPACE();
WRITE_ATOM(alist->rest);
need_space = 1;
@@ -607,7 +607,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info)
if (alist->auxs.num_symbols) {
if (need_space)
WRITE_SPACE();
- WRITE_STRING(Saux);
+ WRITE_ATOMID(Saux);
WRITE_SPACE();
for (i = 0; i < alist->auxs.num_symbols; i++) {
WRITE_OPAREN();
@@ -622,7 +622,7 @@ LispWriteAlist(LispObj *stream, LispArgList *alist, write_info *info)
WRITE_CPAREN();
#undef WRITE_ATOM
-#undef WRITE_STRING
+#undef WRITE_ATOMID
#undef WRITE_OBJECT
#undef WRITE_OPAREN
#undef WRITE_SPACE
@@ -867,9 +867,9 @@ write_again:
switch (OBJECT_TYPE(object)) {
case LispNil_t:
if (object == NIL)
- string = Snil;
+ string = Snil->value;
else if (object == T)
- string = St;
+ string = St->value;
else if (object == DOT)
string = "#<DOT>";
else if (object == UNSPEC)
@@ -1017,7 +1017,7 @@ write_again:
->data.atom->property->alist, info);
}
else {
- length += LispDoWriteAtom(stream, Snil, 3, info->print_case);
+ length += LispDoWriteAtom(stream, "NIL", 3, info->print_case);
length += LispWriteChar(stream, ' ');
length += LispWriteAlist(stream, (LispArgList*)object->
data.lambda.name->data.opaque.data,
@@ -1264,7 +1264,7 @@ LispWriteAtom(LispObj *stream, LispObj *object, write_info *info)
{
int length = 0;
LispAtom *atom = object->data.atom;
- Atom_id id = atom->string;
+ Atom_id id = atom->key;
if (atom->package != PACKAGE) {
if (atom->package == lisp__data.keyword)
@@ -1299,7 +1299,7 @@ LispWriteAtom(LispObj *stream, LispObj *object, write_info *info)
}
if (atom->unreadable)
length += LispWriteChar(stream, '|');
- length += LispDoWriteAtom(stream, id, strlen(id),
+ length += LispDoWriteAtom(stream, id->value, id->length,
atom->unreadable ? UPCASE : info->print_case);
if (atom->unreadable)
length += LispWriteChar(stream, '|');
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 18:21:38 +0000