summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am2
-rw-r--r--hash.c322
-rw-r--r--hook.c59
-rw-r--r--ispell.c192
-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
-rw-r--r--util.h80
19 files changed, 778 insertions, 455 deletions
diff --git a/Makefile.am b/Makefile.am
index 7da5d92..cc57781 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -108,6 +108,7 @@ xedit_LDADD = -L. -lre -llisp -lmp $(PKGDEPS_LIBS) -lm
xedit_SOURCES = \
commands.c \
+ hash.c \
hook.c \
ispell.c \
lisp.c \
@@ -139,6 +140,7 @@ endif
lisp_lsp_CFLAGS = -I$(top_srcdir)/lisp/re -I$(top_srcdir)/lisp/mp -DLISP -DLISPDIR=\"@LISPDIR@\" -D_BSD_SOURCE
lisp_lsp_LDADD = -L. -llisp -lre -lmp -lm
lisp_lsp_SOURCES = \
+ hash.c \
lisp/lsp.c
if NEED_REALPATH
diff --git a/hash.c b/hash.c
new file mode 100644
index 0000000..4f3e14a
--- /dev/null
+++ b/hash.c
@@ -0,0 +1,322 @@
+/*
+ * Copyright (c) 2007,2008 Paulo Cesar Pereira de Andrade
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice (including the next
+ * paragraph) shall be included in all copies or substantial portions of the
+ * Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+ * DEALINGS IN THE SOFTWARE.
+ *
+ * Author: Paulo Cesar Pereira de Andrade
+ */
+
+#include "util.h"
+#include <stdlib.h>
+#include <string.h>
+
+/*
+ * This is a very simplified and adapted version of the hash tables I am
+ * using in a personal project. It was added to try to have a single hash
+ * table implementation in xedit. The lisp (for user code) version was not
+ * converted, but the following hastables have been converted:
+ * ispell.c - list of replace and ignore words
+ * hook.c - list of auto replace words
+ * internal lisp data structures:
+ * atoms
+ * strings
+ * packages
+ * opaque types
+ * also, all code traversing hash tables is now using
+ * hash_iter_first() and hash_iter_next()
+ * conversion isn't as good as I originally wanted, code is using hash_check
+ * instead of hash_get, but this is due to the code not having a basic
+ * { void *data; int length; } object to store string like objects
+ *
+ * Also, this hash table implementation was added mainly for the tags
+ * support.
+ */
+
+/*
+ * Prototypes
+ */
+static int hash_equal(hash_table *hash, hash_key *left, hash_key *right);
+static unsigned int hash_data(char *value, unsigned int length);
+static unsigned int hash_value(hash_key *key);
+
+
+/*
+ * Implementation
+ */
+static int
+hash_equal(hash_table *hash, hash_key *left, hash_key *right)
+{
+ if (left->length == right->length) {
+ if (left == right)
+ return (1);
+ if (hash->compare)
+ return (hash->compare(left, right));
+ return (memcmp(left->value, right->value, left->length) == 0);
+ }
+
+ return (0);
+}
+
+static unsigned int
+hash_data(char *value, unsigned int length)
+{
+ char *ptr;
+ unsigned int i, key;
+
+ for (i = key = 0, ptr = value; i < length; i++)
+ key = (key << (key & 1)) ^ ptr[i];
+
+ return (key);
+}
+
+static unsigned int
+hash_value(hash_key *key)
+{
+ return (hash_data(key->value, key->length));
+}
+
+hash_table *
+hash_new(unsigned int length, hash_compare compare)
+{
+ hash_table *hash;
+
+ hash = calloc(1, sizeof(hash_table));
+ if (hash) {
+ hash->entries = calloc(length, sizeof(hash_entry *));
+ if (hash->entries) {
+ hash->length = length;
+ hash->compare = compare;
+ hash->iter.offset = -1;
+ }
+ else {
+ free(hash);
+ hash = (hash_table *)0;
+ }
+ }
+
+ return (hash);
+}
+
+hash_entry *
+hash_put(hash_table *hash, hash_entry *entry)
+{
+ unsigned int key;
+ hash_entry *prev, *ptr;
+
+ /* Offset in hash table vector for this entry */
+ key = hash_value(entry->key) % hash->length;
+
+ /* We hope this is nil for most calls */
+ ptr = hash->entries[key];
+
+ /* Check if clashed with another entry */
+ for (prev = ptr; ptr; prev = ptr, ptr = ptr->next) {
+ /* Replace current entry */
+ if (hash_equal(hash, entry->key, ptr->key)) {
+ /* If not trying to readd same value */
+ if (entry != ptr) {
+ if (ptr == prev)
+ hash->entries[key] = entry;
+ else
+ prev->next = entry;
+ entry->next = ptr->next;
+ /* Finished */
+ }
+ else
+ ptr = (hash_entry *)0;
+ goto hash_put_done;
+ }
+ }
+
+ /* Add new entry */
+ if (prev == (hash_entry *)0)
+ /* If no entry in offset */
+ hash->entries[key] = entry;
+ else
+ /* Add to end of clashing list */
+ prev->next = entry;
+ entry->next = (hash_entry *)0;
+
+ /* Increase sum of entries counter*/
+ ++hash->count;
+
+hash_put_done:
+ /* ptr will be nil if no entry was replaced, of tried to add
+ * again an entry already in the hash table */
+ return (ptr);
+}
+
+hash_entry *
+hash_get(hash_table *hash, hash_key *name)
+{
+ unsigned int key;
+ hash_entry *entry;
+
+ key = hash_value(name) % hash->length;
+ for (entry = hash->entries[key]; entry; entry = entry->next) {
+ if (hash_equal(hash, name, entry->key)) {
+
+ return (entry);
+ }
+ }
+
+ return ((hash_entry *)0);
+}
+
+hash_entry *
+hash_check(hash_table *hash, char *name, unsigned int length)
+{
+ unsigned int key;
+ hash_entry *entry;
+
+ key = hash_data(name, length) % hash->length;
+ for (entry = hash->entries[key]; entry; entry = entry->next) {
+ if (length == entry->key->length &&
+ memcmp(name, entry->key->value, length) == 0) {
+
+ return (entry);
+ }
+ }
+
+ return ((hash_entry *)0);
+}
+
+hash_entry *
+hash_rem_no_free(hash_table *hash, hash_entry *entry)
+{
+ unsigned int key;
+ hash_entry *ptr, *prev;
+
+ key = hash_value(entry->key) % hash->length;
+ for (ptr = prev = hash->entries[key]; ptr; prev = ptr, ptr = ptr->next) {
+ if (ptr == entry) {
+ --hash->count;
+ if (ptr == prev)
+ hash->entries[key] = ptr->next;
+ else
+ prev->next = ptr->next;
+ break;
+ }
+ }
+
+ if (ptr && ptr == hash->iter.entry)
+ hash->iter.entry = ptr->next;
+
+ /* If entry wasn't in hash table ptr will be nil */
+ return (ptr);
+}
+
+void
+hash_rem(hash_table *hash, hash_entry *entry)
+{
+ entry = hash_rem_no_free(hash, entry);
+ if (entry) {
+ free(entry->key->value);
+ free(entry->key);
+ free(entry);
+ }
+}
+
+void
+hash_rehash(hash_table *hash, unsigned int length)
+{
+ unsigned int i, key;
+ hash_entry *entry, *next, **entries;
+
+ entries = (hash_entry **)calloc(length, sizeof(hash_entry *));
+ if (entries) {
+ /* Populate the new table, note that clashes are now in reverse order */
+ for (i = 0; i < hash->length; i++) {
+ for (entry = hash->entries[i]; entry; entry = next) {
+ next = entry->next;
+ key = hash_value(entry->key) % length;
+ entry->next = entries[key];
+ entries[key] = entry;
+ }
+ }
+
+ /* Finish updating hash table */
+ free(hash->entries);
+ hash->entries = entries;
+ hash->length = length;
+ }
+ hash->iter.offset = -1;
+}
+
+hash_entry *
+hash_iter_first(hash_table *hash)
+{
+ hash->iter.offset = 0;
+ hash->iter.entry = (hash_entry *)0;
+
+ return (hash_iter_next(hash));
+}
+
+hash_entry *
+hash_iter_next(hash_table *hash)
+{
+ if (hash->iter.offset >= 0) {
+ if (hash->iter.entry) {
+ if ((hash->iter.entry = hash->iter.entry->next))
+ return (hash->iter.entry);
+ ++hash->iter.offset;
+ }
+ for (; hash->iter.offset < hash->length; hash->iter.offset++) {
+ if ((hash->iter.entry = hash->entries[hash->iter.offset]))
+ return (hash->iter.entry);
+ }
+ hash->iter.entry = (hash_entry *)0;
+ hash->iter.offset = -1;
+ }
+
+ return ((hash_entry *)0);
+}
+
+void
+hash_clr(hash_table *hash)
+{
+ unsigned int i;
+ hash_entry *entry, *next;
+
+ /* Extra data should be free'd with the iterator */
+ for (i = 0; i < hash->length; i++) {
+ entry = hash->entries[i];
+ if (entry) {
+ for (next = entry; entry; entry = next) {
+ next = entry->next;
+ free(entry->key->value);
+ free(entry->key);
+ free(entry);
+ }
+ hash->entries[i] = (hash_entry *)0;
+ }
+ }
+
+ hash->count = 0;
+ hash->iter.offset = -1;
+}
+
+void
+hash_del(hash_table *hash)
+{
+ hash_clr(hash);
+ free(hash->entries);
+ free(hash);
+}
diff --git a/hook.c b/hook.c
index 13a8b94..913ccc3 100644
--- a/hook.c
+++ b/hook.c
@@ -39,6 +39,7 @@
#include "xedit.h"
#include "re.h"
+#include "util.h"
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
@@ -46,11 +47,11 @@
/*
* Types
*/
-typedef struct _ReplaceList {
- char *word;
+typedef struct _ReplaceEntry {
+ hash_key *word;
+ struct _ReplaceEntry *next;
char *replace;
- struct _ReplaceList *next;
-} ReplaceList;
+} ReplaceEntry;
typedef enum {
SubstituteDisabled,
@@ -108,7 +109,7 @@ static void SubstituteCallback(Widget, XtPointer, XtPointer);
* Initialization
*/
#define STRTBLSZ 11
-static ReplaceList *replace_list[STRTBLSZ];
+static hash_table *replace_hash;
static EditInfo einfo;
extern Widget scratch;
@@ -191,6 +192,8 @@ StartAutoReplace(void)
if (!replace || !*replace)
return (False);
+ replace_hash = hash_new(STRTBLSZ, NULL);
+
left = XtMalloc(llen = 256);
right = XtMalloc(rlen = 256);
while (*replace) {
@@ -247,34 +250,26 @@ StartAutoReplace(void)
static char *
ReplacedWord(char *word, char *replace)
{
- ReplaceList *list;
- int ii = 0;
- char *pp = word;
-
- while (*pp)
- ii = (ii << 1) ^ *pp++;
- if (ii < 0)
- ii = -ii;
- ii %= STRTBLSZ;
- for (list = replace_list[ii]; list; list = list->next)
- if (strcmp(list->word, word) == 0) {
- if (replace) {
- XtFree(list->replace);
- list->replace = XtNewString(replace);
- }
- return (list->replace);
- }
-
- if (!replace)
- return (NULL);
-
- list = XtNew(ReplaceList);
- list->word = XtNewString(word);
- list->replace = XtNewString(replace);
- list->next = replace_list[ii];
- replace_list[ii] = list;
+ int length;
+ ReplaceEntry *entry;
+
+ length = strlen(word);
+ entry = (ReplaceEntry *)hash_check(replace_hash, word, length);
+ if (entry == NULL && replace != NULL) {
+ entry = XtNew(ReplaceEntry);
+ entry->word = XtNew(hash_key);
+ entry->word->value = XtNewString(word);
+ entry->word->length = length;
+ entry->next = NULL;
+ entry->replace = XtNewString(replace);
+ hash_put(replace_hash, (hash_entry *)entry);
+ }
+ else if (replace) {
+ XtFree(entry->replace);
+ entry->replace = XtNewString(replace);
+ }
- return (list->replace);
+ return (entry ? entry->replace : NULL);
}
static void
diff --git a/ispell.c b/ispell.c
index 1e7d38a..db2f5a1 100644
--- a/ispell.c
+++ b/ispell.c
@@ -31,6 +31,7 @@
/* $XFree86: xc/programs/xedit/ispell.c,v 1.19 2002/10/19 20:04:20 herrb Exp $ */
#include "xedit.h"
+#include "util.h"
#include <stdlib.h>
#include <unistd.h>
#include <fcntl.h>
@@ -133,17 +134,20 @@ struct _ispell {
struct _ispell_format *format_info;
};
-typedef struct _ReplaceList {
- char *word;
- char *replace;
- struct _ReplaceList *next;
-} ReplaceList;
+typedef struct _ReplaceEntry ReplaceEntry;
+struct _ReplaceEntry {
+ hash_key *word;
+ ReplaceEntry*next;
+ char *replace;
+};
+
+typedef struct _IgnoreEntry IgnoreEntry;
+struct _IgnoreEntry {
+ hash_key *word;
+ IgnoreEntry *next;
+ int add;
+};
-typedef struct _IgnoreList {
- char *word;
- int add;
- struct _IgnoreList *next;
-} IgnoreList;
/*
* Prototypes
@@ -194,8 +198,8 @@ static struct _ispell ispell;
#define RSTRTBLSZ 23
#define ISTRTBLSZ 71
-static ReplaceList *replace_list[RSTRTBLSZ];
-static IgnoreList *ignore_list[ISTRTBLSZ];
+static hash_table *replace_hash;
+static hash_table *ignore_hash;
#ifndef XtCStatus
#define XtCStatus "Status"
@@ -441,71 +445,59 @@ IspellCheckUndo(void)
static char *
IspellReplacedWord(char *word, char *replace)
{
- ReplaceList *list;
- int ii = 0;
- char *pp = word;
-
- while (*pp)
- ii = (ii << 1) ^ *pp++;
- if (ii < 0)
- ii = -ii;
- ii %= RSTRTBLSZ;
- for (list = replace_list[ii]; list; list = list->next)
- if (strcmp(list->word, word) == 0) {
- if (replace) {
- XtFree(list->replace);
- list->replace = XtNewString(replace);
- }
- return (list->replace);
- }
-
- if (!replace)
- return (NULL);
+ int word_len;
+ hash_key *word_key;
+ ReplaceEntry *entry;
+
+ word_len = strlen(word);
+ entry = (ReplaceEntry *)hash_check(replace_hash, word, word_len);
+ if (entry == NULL) {
+ word_key = XtNew(hash_key);
+ word_key->value = XtNewString(word);
+ word_key->length = word_len;
+ entry = XtNew(ReplaceEntry);
+ entry->word = word_key;
+ entry->replace = NULL;
+ entry->next = NULL;
+ hash_put(replace_hash, (hash_entry *)entry);
+ }
- list = XtNew(ReplaceList);
- list->word = XtNewString(word);
- list->replace = XtNewString(replace);
- list->next = replace_list[ii];
- replace_list[ii] = list;
+ if (replace) {
+ XtFree(entry->replace);
+ entry->replace = XtNewString(replace);
+ }
- return (list->replace);
+ return (entry->replace);
}
static Bool
IspellDoIgnoredWord(char *word, int cmd, int add)
{
- IgnoreList *list, *prev;
- int ii = 0;
- char *pp = word;
-
- while (*pp)
- ii = (ii << 1) ^ *pp++;
- if (ii < 0)
- ii = -ii;
- ii %= ISTRTBLSZ;
- for (prev = list = ignore_list[ii]; list; prev = list, list = list->next)
- if (strcmp(list->word, word) == 0) {
- if (cmd == REMOVE) {
- XtFree(list->word);
- prev->next = list->next;
- XtFree((char*)list);
- if (prev == list)
- ignore_list[ii] = NULL;
- return (True);
- }
- return (cmd == CHECK);
- }
+ int word_len;
+ hash_key *word_key;
+ IgnoreEntry *entry;
+
+ word_len = strlen(word);
+ entry = (IgnoreEntry *)hash_check(ignore_hash, word, word_len);
+ if (entry == NULL) {
+ if (cmd != ADD)
+ return (False);
- if (cmd != ADD)
- return (False);
+ word_key = XtNew(hash_key);
+ word_key->value = XtNewString(word);
+ word_key->length = word_len;
+ entry = XtNew(IgnoreEntry);
+ entry->word = word_key;
+ entry->add = add;
+ entry->next = NULL;
+ hash_put(ignore_hash, (hash_entry *)entry);
- list = XtNew(IgnoreList);
- list->word = XtNewString(word);
- list->add = add;
- list->next = ignore_list[ii];
- ignore_list[ii] = list;
+ return (True);
+ }
+ else if (cmd == REMOVE)
+ hash_rem(ignore_hash, (hash_entry *)entry);
- return (True);
+ return (cmd == CHECK);
}
static Bool
@@ -1378,39 +1370,26 @@ IspellEndProcess(Bool killit, Bool killundo)
ispell.source = NULL;
if (ispell.pid) {
- IgnoreList *il, *pil, *nil;
- int i;
+ IgnoreEntry *ientry;
+ ReplaceEntry *rentry;
/* insert added words in private dictionary */
- for (i = 0; i < ISTRTBLSZ; i++) {
- pil = il = ignore_list[i];
- while (il) {
- if (il->add) {
- nil = il->next;
- if (il == pil)
- ignore_list[i] = nil;
- else
- pil->next = nil;
- if (il->add == UNCAP)
- write(ispell.ofd[1], "&", 1);
- else
- write(ispell.ofd[1], "*", 1);
- write(ispell.ofd[1], il->word, strlen(il->word));
- write(ispell.ofd[1], "\n", 1);
- XtFree(il->word);
- XtFree((char*)il);
- il = nil;
- }
+ for (ientry = (IgnoreEntry *)hash_iter_first(ignore_hash);
+ ientry;
+ ientry = (IgnoreEntry *)hash_iter_next(ignore_hash)) {
+ if (ientry->add) {
+ if (ientry->add == UNCAP)
+ write(ispell.ofd[1], "&", 1);
else
- il = il->next;
- pil = il;
+ write(ispell.ofd[1], "*", 1);
+ write(ispell.ofd[1], ientry->word->value, ientry->word->length);
+ write(ispell.ofd[1], "\n", 1);
}
}
write(ispell.ofd[1], "#\n", 2); /* save dictionary */
+ hash_clr(ignore_hash);
if (killit) {
- ReplaceList *rl, *prl;
-
XtRemoveInput(ispell.id);
close(ispell.ofd[0]);
@@ -1430,27 +1409,13 @@ IspellEndProcess(Bool killit, Bool killundo)
XtFree(ispell.buf);
ispell.buf = NULL;
- for (i = 0; i < RSTRTBLSZ; i++) {
- prl = rl = replace_list[i];
- while (prl) {
- rl = rl->next;
- XtFree(prl->word);
- XtFree(prl->replace);
- XtFree((char*)prl);
- prl = rl;
- }
- replace_list[i] = NULL;
- }
- for (i = 0; i < ISTRTBLSZ; i++) {
- pil = il = ignore_list[i];
- while (pil) {
- il = il->next;
- XtFree(pil->word);
- XtFree((char*)pil);
- pil = il;
- }
- ignore_list[i] = NULL;
+ /* forget about replace matches */
+ for (rentry = (ReplaceEntry *)hash_iter_first(replace_hash);
+ rentry;
+ rentry = (ReplaceEntry *)hash_iter_next(replace_hash)) {
+ XtFree(rentry->replace);
}
+ hash_clr(replace_hash);
}
if (killundo)
@@ -2033,6 +1998,9 @@ InitIspell(void)
if (ispell.shell)
return (False);
+ replace_hash = hash_new(RSTRTBLSZ, NULL);
+ ignore_hash = hash_new(ISTRTBLSZ, NULL);
+
ispell.shell = XtCreatePopupShell("ispell", transientShellWidgetClass,
topwindow, NULL, 0);
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, '|');
diff --git a/util.h b/util.h
new file mode 100644
index 0000000..9717589
--- /dev/null
+++ b/util.h
@@ -0,0 +1,80 @@
+/*
+ * Copyright (c) 2007,2008 Paulo Cesar Pereira de Andrade
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice (including the next
+ * paragraph) shall be included in all copies or substantial portions of the
+ * Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+ * DEALINGS IN THE SOFTWARE.
+ *
+ * Author: Paulo Cesar Pereira de Andrade
+ */
+
+/* Generic hash table */
+
+#ifndef _util_h
+#define _util_h
+
+/*
+ * Types
+ */
+typedef struct _hash_key hash_key;
+typedef struct _hash_entry hash_entry;
+typedef struct _hash_table hash_table;
+typedef int (*hash_compare)(hash_key *left, hash_key *right);
+
+struct _hash_key {
+ char *value;
+ unsigned int length;
+};
+
+struct _hash_entry {
+ hash_key *key;
+ hash_entry *next;
+};
+
+struct _hash_table {
+ hash_entry **entries;
+ unsigned int count; /* length of entries */
+ unsigned int length; /* sum of entries */
+ hash_compare compare;
+
+ struct {
+ int offset;
+ hash_entry *entry;
+ } iter;
+};
+
+/*
+ * Prototypes
+ */
+hash_table *hash_new(unsigned int length, hash_compare compare);
+hash_entry *hash_put(hash_table *hash, hash_entry *entry);
+hash_entry *hash_get(hash_table *hash, hash_key *name);
+hash_entry * hash_check(hash_table *hash, char *name, unsigned int length);
+void hash_rem(hash_table *hash, hash_entry *entry);
+/* Removes from hash table but doesn't release any memory */
+hash_entry *hash_rem_no_free(hash_table *hash, hash_entry *entry);
+void hash_rehash(hash_table *hash, unsigned int length);
+hash_entry *hash_iter_first(hash_table *hash);
+hash_entry *hash_iter_next(hash_table *hash);
+
+/* Frees all data. When casting to another type, use the
+ * iterator to free extra data */
+void hash_clr(hash_table *hash);
+void hash_del(hash_table *hash);
+
+#endif /* _util_h */
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 17:58:35 +0000