From 7d5dbf4a19ec6bbd36784f5d7307629b69dda873 Mon Sep 17 00:00:00 2001 From: Paulo Cesar Pereira de Andrade Date: Wed, 12 Mar 2008 21:52:30 -0300 Subject: Add a generic hash table interface to replace the other implementations. --- lisp/bytecode.c | 85 +++++++++++----------- lisp/compile.c | 12 ++-- lisp/core.c | 20 +++--- lisp/format.c | 2 +- lisp/helper.c | 12 ++-- lisp/internal.h | 14 ++-- lisp/lisp.c | 220 ++++++++++++++++++++++++++------------------------------ lisp/math.c | 2 +- lisp/package.c | 98 +++++++++++-------------- lisp/private.h | 25 +++---- lisp/read.c | 20 ++---- lisp/stream.c | 10 +-- lisp/struct.c | 30 ++++---- lisp/write.c | 28 ++++---- 14 files changed, 267 insertions(+), 311 deletions(-) (limited to 'lisp') 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 : "#" +#define XSTRING(key) key ? key->value : "#" 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 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 = "#"; 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, '|'); -- cgit v1.2.3