hyung-hwan/qse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

interim commit

Browse Source
This commit is contained in:
hyung-hwan 2011-06-17 07:51:05 +00:00
parent 2adaa58e7d
commit c7b3ece237
6 changed files with 262 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

223
qse/lib/stx/boot.c
View File

@ -6,8 +6,8 @@
#include <qse/cmn/str.h> #include <qse/cmn/str.h>
static int make_intrinsic_classes (qse_stx_t* stx); static int make_intrinsic_classes (qse_stx_t* stx);
#if 0
static qse_word_t __make_classvar_dict ( static qse_word_t __make_classvar_dic (
qse_stx_t* stx, qse_word_t class, const qse_char_t* names); qse_stx_t* stx, qse_word_t class, const qse_char_t* names);
static void __filein_kernel (qse_stx_t* stx); static void __filein_kernel (qse_stx_t* stx);
@ -20,7 +20,6 @@ static void __set_subclasses (
qse_stx_t* stx, qse_word_t* array, const qse_char_t* str); qse_stx_t* stx, qse_word_t* array, const qse_char_t* str);
static void __set_metaclass_subclasses ( static void __set_metaclass_subclasses (
qse_stx_t* stx, qse_word_t* array, const qse_char_t* str); qse_stx_t* stx, qse_word_t* array, const qse_char_t* str);
#endif
struct class_info_t struct class_info_t
{ {
@ -284,7 +283,7 @@ qse_word_t QSE_INLINE new_string (qse_stx_t* stx, const qse_char_t* str)
qse_word_t x; qse_word_t x;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_string)); QSE_ASSERT (REFISIDX(stx,stx->ref.class_string));
QSE_ASSERT (stx->ref.class_string != stx->ref.nil); QSE_ASSERT (!ISNIL(stx,stx->ref.class_string));
x = qse_stx_alloccharobj (stx, str, qse_strlen(str)); x = qse_stx_alloccharobj (stx, str, qse_strlen(str));
if (x != stx->ref.nil) OBJCLASS(stx,x) = stx->ref.class_string; if (x != stx->ref.nil) OBJCLASS(stx,x) = stx->ref.class_string;
@ -295,89 +294,98 @@ qse_word_t QSE_INLINE new_string (qse_stx_t* stx, const qse_char_t* str)
static int make_intrinsic_classes (qse_stx_t* stx) static int make_intrinsic_classes (qse_stx_t* stx)
{ {
class_info_t* p; class_info_t* p;
qse_word_t class, superclass, array; qse_word_t n;
qse_stx_class_t* class_obj, * superclass_obj;
qse_word_t metaclass;
qse_stx_metaclass_t* metaclass_obj;
qse_word_t n, nfields;
QSE_ASSERT (stx->class_array != stx->ref.nil); QSE_ASSERT (!ISNIL(stx,stx->ref.class_array));
for (p = class_info; p->name != QSE_NULL; p++) for (p = class_info; p->name != QSE_NULL; p++)
{ {
class = qse_stx_findclass(stx, p->name); qse_word_t classref;
if (class == stx->ref.nil) qse_stx_class_t* classptr;
qse_word_t nfixed;
classref = qse_stx_findclass(stx, p->name);
if (ISNIL(stx,classref))
{ {
class = qse_stx_newclass (stx, p->name); classref = qse_stx_newclass (stx, p->name);
if (class == stx->ref.nil) return stx->ref.nil; if (ISNIL(stx,classref)) return NIL(stx);
} }
QSE_ASSERT (class != stx->ref.nil); classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
class_obj = (qse_stx_class_t*)PTRBYREF(stx,class);
if (p->superclass) if (p->superclass)
{ {
class_obj->superclass = qse_stx_findclass(stx,p->superclass); classptr->superclass = qse_stx_findclass(stx,p->superclass);
QSE_ASSERT (class_obj->superclass != stx->ref.nil); QSE_ASSERT (!ISNIL(stx,classptr->superclass));
} }
nfields = 0; nfixed = 0;
/* resolve the number of fixed fields in the superclass chain */
if (p->superclass) if (p->superclass)
{ {
qse_word_t meta; qse_word_t superref;
qse_stx_metaclass_t* meta_obj; qse_stx_class_t* superptr;
superclass = qse_stx_findclass (stx, p->superclass); qse_word_t metaref;
QSE_ASSERT (superclass != stx->ref.nil); qse_stx_metaclass_t* metaptr;
meta = class_obj->h._class; superref = qse_stx_findclass (stx, p->superclass);
meta_obj = (qse_stx_metaclass_t*)PTRBYREF(stx,meta); QSE_ASSERT (!ISNIL(stx,superref));
meta_obj->superclass = OBJCLASS(stx,superclass);
meta_obj->instance_class = class;
while (superclass != stx->ref.nil) metaref = OBJCLASS(stx,classref);
metaptr = (qse_stx_metaclass_t*)PTRBYREF(stx,metaref);
metaptr->superclass = OBJCLASS(stx,superref);
metaptr->instance_class = classref;
do
{ {
superclass_obj = (qse_stx_class_t*) superptr = (qse_stx_class_t*)PTRBYREF(stx,superref);
QSE_STX_OBJPTR(stx,superclass); nfixed += SPEC_GETFIXED(REFTOINT(stx,superptr->spec));
nfields += superref = superptr->superclass;
QSE_STX_FROMSMALLINT(superclass_obj->spec) >>
QSE_STX_SPEC_INDEXABLE_BITS;
superclass = superclass_obj->superclass;
} }
while (!ISNIL(stx,superref));
} }
/* add the number of instance variables to the number of
* fixed fields */
if (p->instance_variables) if (p->instance_variables)
{ {
nfields += __count_names (p->instance_variables); nfixed += __count_names (p->instance_variables);
class_obj->variables = classptr->variables =
new_string (stx, p->instance_variables); new_string (stx, p->instance_variables);
if (class_obj->variables == stx->ref.nil) return -1; if (ISNIL(stx,classptr->variables)) return -1;
} }
QSE_ASSERT (nfields <= 0 || (nfields > 0 && QSE_ASSERT (
(p->spec == SPEC_FIXED_WORD || nfixed <= 0 ||
p->spec == SPEC_VARIABLE_WORD))); (nfixed > 0 && (p->spec == SPEC_FIXED_WORD ||
p->spec == SPEC_VARIABLE_WORD)));
class_obj->spec = MAKE_SPEC (nfields, p->spec); classptr->spec = SPEC_MAKE (nfixed, p->spec);
} }
for (p = class_info; p->name != QSE_NULL; p++) for (p = class_info; p->name != QSE_NULL; p++)
{ {
class = qse_stx_lookup_class(stx, p->name); qse_word_t classref;
QSE_ASSERT (class != stx->ref.nil); qse_stx_class_t* classptr;
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class); classref = qse_stx_findclass (stx, p->name);
QSE_ASSERT (!ISNIL(stx,classref));
classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
if (p->class_variables != QSE_NULL) if (p->class_variables != QSE_NULL)
{ {
class_obj->class_variables = classptr->class_variables =
__make_classvar_dict(stx, class, p->class_variables); __make_classvar_dic(stx, classref, p->class_variables);
if (ISNIL(stx,classptr->class_variables)) return NIL(stx);
} }
/* /*
TODO: TODO:
if (p->pool_dictionaries != QSE_NULL) { if (p->pool_dictionaries != QSE_NULL) {
class_obj->pool_dictionaries = classptr->pool_dictionaries =
__make_pool_dictionary(stx, class, p->pool_dictionaries); __make_pool_dictionary(stx, class, p->pool_dictionaries);
} }
*/ */
@ -386,28 +394,44 @@ static int make_intrinsic_classes (qse_stx_t* stx)
/* fill subclasses */ /* fill subclasses */
for (p = class_info; p->name != QSE_NULL; p++) for (p = class_info; p->name != QSE_NULL; p++)
{ {
n = __count_subclasses (p->name); qse_word_t classref;
array = qse_stx_new_array (stx, n); qse_stx_class_t* classptr;
__set_subclasses (stx, QSE_STX_DATA(stx,array), p->name); qse_word_t array;
class = qse_stx_lookup_class(stx, p->name); n = __count_subclasses (p->name);
QSE_ASSERT (class != stx->ref.nil); array = qse_stx_newarray (stx, n);
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class); if (ISNIL(stx,array)) return NIL(stx);
class_obj->subclasses = array;
__set_subclasses (stx, &WORDAT(stx,array,0), p->name);
classref = qse_stx_findclass (stx, p->name);
QSE_ASSERT (!ISNIL(stx,classref));
classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
classptr->subclasses = array;
} }
/* fill subclasses for metaclasses */ /* fill subclasses for metaclasses */
for (p = class_info; p->name != QSE_NULL; p++) for (p = class_info; p->name != QSE_NULL; p++)
{ {
qse_word_t classref;
qse_stx_class_t* classptr;
qse_word_t metaref;
qse_stx_metaclass_t* metaptr;
qse_word_t array;
n = __count_subclasses (p->name); n = __count_subclasses (p->name);
array = qse_stx_new_array (stx, n); array = qse_stx_new_array (stx, n);
__set_metaclass_subclasses (stx, QSE_STX_DATA(stx,array), p->name); __set_metaclass_subclasses (stx, &WORDAT(stx,array,0), p->name);
class = qse_stx_lookup_class(stx, p->name); classref = qse_stx_findclass (stx, p->name);
QSE_ASSERT (class != stx->ref.nil); QSE_ASSERT (!ISNIL(stx,classref));
metaclass = QSE_STX_CLASS(stx,class);
metaclass_obj = (qse_stx_metaclass_t*)QSE_STX_OBJPTR(stx, metaclass); metaref = OBJCLASS(stx,classref);
metaclass_obj->subclasses = array; metaptr = (qse_stx_metaclass_t*)PTRBYREF(stx,metaref);
metaptr->subclasses = array;
} }
return 0; return 0;
@ -418,7 +442,8 @@ static qse_word_t __count_names (const qse_char_t* str)
qse_word_t n = 0; qse_word_t n = 0;
const qse_char_t* p = str; const qse_char_t* p = str;
do { do
{
while (*p == QSE_T(' ') || while (*p == QSE_T(' ') ||
*p == QSE_T('\t')) p++; *p == QSE_T('\t')) p++;
if (*p == QSE_T('\0')) break; if (*p == QSE_T('\0')) break;
@ -427,7 +452,8 @@ static qse_word_t __count_names (const qse_char_t* str)
while (*p != QSE_T(' ') && while (*p != QSE_T(' ') &&
*p != QSE_T('\t') && *p != QSE_T('\t') &&
*p != QSE_T('\0')) p++; *p != QSE_T('\0')) p++;
} while (1); }
while (1);
return n; return n;
} }
@ -439,7 +465,8 @@ static void __set_names (
const qse_char_t* p = str; const qse_char_t* p = str;
const qse_char_t* name; const qse_char_t* name;
do { do
{
while (*p == QSE_T(' ') || while (*p == QSE_T(' ') ||
*p == QSE_T('\t')) p++; *p == QSE_T('\t')) p++;
if (*p == QSE_T('\0')) break; if (*p == QSE_T('\0')) break;
@ -449,8 +476,9 @@ static void __set_names (
*p != QSE_T('\t') && *p != QSE_T('\t') &&
*p != QSE_T('\0')) p++; *p != QSE_T('\0')) p++;
array[n++] = qse_stx_new_symbolx (stx, name, p - name); array[n++] = qse_stx_newsymbolx (stx, name, p - name);
} while (1); }
while (1);
} }
static qse_word_t __count_subclasses (const qse_char_t* str) static qse_word_t __count_subclasses (const qse_char_t* str)
@ -458,7 +486,8 @@ static qse_word_t __count_subclasses (const qse_char_t* str)
class_info_t* p; class_info_t* p;
qse_word_t n = 0; qse_word_t n = 0;
for (p = class_info; p->name != QSE_NULL; p++) { for (p = class_info; p->name != QSE_NULL; p++)
{
if (p->superclass == QSE_NULL) continue; if (p->superclass == QSE_NULL) continue;
if (qse_strcmp (str, p->superclass) == 0) n++; if (qse_strcmp (str, p->superclass) == 0) n++;
} }
@ -472,11 +501,12 @@ static void __set_subclasses (
class_info_t* p; class_info_t* p;
qse_word_t n = 0, class; qse_word_t n = 0, class;
for (p = class_info; p->name != QSE_NULL; p++) { for (p = class_info; p->name != QSE_NULL; p++)
{
if (p->superclass == QSE_NULL) continue; if (p->superclass == QSE_NULL) continue;
if (qse_strcmp (str, p->superclass) != 0) continue; if (qse_strcmp (str, p->superclass) != 0) continue;
class = qse_stx_lookup_class (stx, p->name); class = qse_stx_findclass (stx, p->name);
QSE_ASSERT (class != stx->ref.nil); QSE_ASSERT (!ISNIL(stx,class));
array[n++] = class; array[n++] = class;
} }
} }
@ -487,27 +517,31 @@ static void __set_metaclass_subclasses (
class_info_t* p; class_info_t* p;
qse_word_t n = 0, class; qse_word_t n = 0, class;
for (p = class_info; p->name != QSE_NULL; p++) { for (p = class_info; p->name != QSE_NULL; p++)
{
if (p->superclass == QSE_NULL) continue; if (p->superclass == QSE_NULL) continue;
if (qse_strcmp (str, p->superclass) != 0) continue; if (qse_strcmp (str, p->superclass) != 0) continue;
class = qse_stx_lookup_class (stx, p->name); class = qse_stx_findclass (stx, p->name);
QSE_ASSERT (class != stx->ref.nil); QSE_ASSERT (!ISNIL(stx,class));
array[n++] = QSE_STX_CLASS(stx,class); array[n++] = OBJCLASS(stx,class);
} }
} }
static qse_word_t __make_classvar_dict ( static qse_word_t __make_classvar_dic (
qse_stx_t* stx, qse_word_t class, const qse_char_t* names) qse_stx_t* stx, qse_word_t class, const qse_char_t* names)
{ {
qse_word_t dict, symbol; qse_word_t dic, symbol, assoc;
const qse_char_t* p = names; const qse_char_t* p = names;
const qse_char_t* name; const qse_char_t* name;
dict = qse_stx_instantiate ( /* TODO: how to implement temporary GC prevention....???? */
stx, stx->class_systemdictionary, dic = qse_stx_instantiate (
stx, stx->ref.class_systemdictionary,
QSE_NULL, QSE_NULL, __count_names(names)); QSE_NULL, QSE_NULL, __count_names(names));
if (ISNIL(stx,dic)) return NIL(stx);
do { do
{
while (*p == QSE_T(' ') || while (*p == QSE_T(' ') ||
*p == QSE_T('\t')) p++; *p == QSE_T('\t')) p++;
if (*p == QSE_T('\0')) break; if (*p == QSE_T('\0')) break;
@ -517,11 +551,15 @@ static qse_word_t __make_classvar_dict (
*p != QSE_T('\t') && *p != QSE_T('\t') &&
*p != QSE_T('\0')) p++; *p != QSE_T('\0')) p++;
symbol = qse_stx_new_symbolx (stx, name, p - name); symbol = qse_stx_newsymbolx (stx, name, p - name);
qse_stx_dict_put (stx, dict, symbol, stx->ref.nil); if (ISNIL(stx,symbol)) return NIL(stx);
} while (1);
return dict; assoc =qse_stx_putdic (stx, dic, symbol, stx->ref.nil);
if (ISNIL(stx,assoc)) return NIL(stx);
}
while (1);
return dic;
} }
static void __filein_kernel (qse_stx_t* stx) static void __filein_kernel (qse_stx_t* stx)
@ -532,7 +570,6 @@ static void __filein_kernel (qse_stx_t* stx)
/* TODO: */ /* TODO: */
} }
} }
#endif
static int sketch_nil (qse_stx_t* stx) static int sketch_nil (qse_stx_t* stx)
{ {
@ -608,22 +645,22 @@ static int sketch_key_objects (qse_stx_t* stx)
WORDAT(stx,stx->ref.sysdic,QSE_STX_DIC_TALLY) = INTTOREF(stx,0); WORDAT(stx,stx->ref.sysdic,QSE_STX_DIC_TALLY) = INTTOREF(stx,0);
/* Symbol */ /* Symbol */
ALLOC_WORDOBJ_TO (stx, stx->ref.class_symbol, QSE_STX_CLASS_NFLDS, 0); ALLOC_WORDOBJ_TO (stx, stx->ref.class_symbol, QSE_STX_CLASS_SIZE, 0);
/* Metaclass */ /* Metaclass */
ALLOC_WORDOBJ_TO (stx, stx->ref.class_metaclass, QSE_STX_CLASS_NFLDS, 0); ALLOC_WORDOBJ_TO (stx, stx->ref.class_metaclass, QSE_STX_CLASS_SIZE, 0);
/* Association */ /* Association */
ALLOC_WORDOBJ_TO (stx, stx->ref.class_association, QSE_STX_CLASS_NFLDS, 0); ALLOC_WORDOBJ_TO (stx, stx->ref.class_association, QSE_STX_CLASS_SIZE, 0);
/* Metaclass is a class so it has the same structure /* Metaclass is a class so it has the same structure
* as a normal class. "Metaclass class" is an instance of * as a normal class. "Metaclass class" is an instance of
* Metaclass. */ * Metaclass. */
/* Symbol class */ /* Symbol class */
ALLOC_WORDOBJ_TO (stx, class_SymbolMeta, QSE_STX_METACLASS_NFLDS, 0); ALLOC_WORDOBJ_TO (stx, class_SymbolMeta, QSE_STX_METACLASS_SIZE, 0);
/* Metaclass class */ /* Metaclass class */
ALLOC_WORDOBJ_TO (stx, class_MetaclassMeta, QSE_STX_METACLASS_NFLDS, 0); ALLOC_WORDOBJ_TO (stx, class_MetaclassMeta, QSE_STX_METACLASS_SIZE, 0);
/* Association class */ /* Association class */
ALLOC_WORDOBJ_TO (stx, class_AssociationMeta, QSE_STX_METACLASS_NFLDS, 0); ALLOC_WORDOBJ_TO (stx, class_AssociationMeta, QSE_STX_METACLASS_SIZE, 0);
/* (Symbol class) setClass: Metaclass */ /* (Symbol class) setClass: Metaclass */
QSE_STX_OBJCLASS(stx,class_SymbolMeta) = stx->ref.class_metaclass; QSE_STX_OBJCLASS(stx,class_SymbolMeta) = stx->ref.class_metaclass;
@ -641,13 +678,13 @@ static int sketch_key_objects (qse_stx_t* stx)
/* (Symbol class) setSpec: CLASS_SIZE */ /* (Symbol class) setSpec: CLASS_SIZE */
WORDAT(stx,class_SymbolMeta,QSE_STX_CLASS_SPEC) = WORDAT(stx,class_SymbolMeta,QSE_STX_CLASS_SPEC) =
INTTOREF (stx, MAKE_SPEC(QSE_STX_CLASS_NFLDS,SPEC_FIXED_WORD)); INTTOREF (stx, SPEC_MAKE(QSE_STX_CLASS_SIZE,SPEC_FIXED_WORD));
/* (Metaclass class) setSpec: CLASS_SIZE */ /* (Metaclass class) setSpec: CLASS_SIZE */
WORDAT(stx,class_MetaclassMeta,QSE_STX_CLASS_SPEC) = WORDAT(stx,class_MetaclassMeta,QSE_STX_CLASS_SPEC) =
INTTOREF (stx, MAKE_SPEC(QSE_STX_CLASS_NFLDS,SPEC_FIXED_WORD)); INTTOREF (stx, SPEC_MAKE(QSE_STX_CLASS_SIZE,SPEC_FIXED_WORD));
/* (Association class) setSpec: CLASS_SIZE */ /* (Association class) setSpec: CLASS_SIZE */
WORDAT(stx,class_AssociationMeta,QSE_STX_CLASS_SPEC) = WORDAT(stx,class_AssociationMeta,QSE_STX_CLASS_SPEC) =
INTTOREF (stx, MAKE_SPEC(QSE_STX_CLASS_NFLDS,SPEC_FIXED_WORD)); INTTOREF (stx, SPEC_MAKE(QSE_STX_CLASS_SIZE,SPEC_FIXED_WORD));
/* specs for class_metaclass, class_association, /* specs for class_metaclass, class_association,
* class_symbol are set later in make_builtin_classes */ * class_symbol are set later in make_builtin_classes */

28
qse/lib/stx/cls.c
View File

@ -4,32 +4,6 @@
#include "stx.h" #include "stx.h"
struct qse_stx_class_t
{
qse_stx_objhdr_t h;
qse_word_t spec; /* indexable: 2, nfields: the rest */
qse_word_t methods;
qse_word_t superclass;
qse_word_t subclasses;
qse_word_t name;
qse_word_t variables;
qse_word_t class_variables;
qse_word_t pool_dictonaries;
};
struct qse_stx_metaclass_t
{
qse_stx_objhdr_t h;
qse_word_t spec;
qse_word_t methods;
qse_word_t superclass;
qse_word_t subclasses;
qse_word_t instance_class;
};
typedef struct qse_stx_class_t qse_stx_class_t;
typedef struct qse_stx_metaclass_t qse_stx_metaclass_t;
qse_word_t qse_stx_newclass (qse_stx_t* stx, const qse_char_t* name) qse_word_t qse_stx_newclass (qse_stx_t* stx, const qse_char_t* name)
{ {
qse_word_t meta, class; qse_word_t meta, class;
@ -45,7 +19,7 @@ qse_word_t qse_stx_newclass (qse_stx_t* stx, const qse_char_t* name)
/* the spec of the metaclass must be the spec of its /* the spec of the metaclass must be the spec of its
* instance. so the QSE_STX_CLASS_SIZE is set */ * instance. so the QSE_STX_CLASS_SIZE is set */
WORDAT(stx,meta,QSE_STX_METACLASS_SPEC) = WORDAT(stx,meta,QSE_STX_METACLASS_SPEC) =
INTTOREF(stx,MAKE_SPEC(QSE_STX_CLASS_SIZE,SPEC_FIXED_WORD)); INTTOREF(stx,SPEC_MAKE(QSE_STX_CLASS_SIZE,SPEC_FIXED_WORD));
/* the spec of the class is set later in __create_builtin_classes */ /* the spec of the class is set later in __create_builtin_classes */
class = qse_stx_allocwordobj ( class = qse_stx_allocwordobj (

32
qse/lib/stx/cls.h
View File

@ -5,6 +5,32 @@
#ifndef _QSE_LIB_STX_CLS_H_ #ifndef _QSE_LIB_STX_CLS_H_
#define _QSE_LIB_STX_CLS_H_ #define _QSE_LIB_STX_CLS_H_
struct qse_stx_class_t
{
qse_stx_objhdr_t h;
qse_word_t spec; /* indexable: 2, nfields: the rest */
qse_word_t methods;
qse_word_t superclass;
qse_word_t subclasses;
qse_word_t name;
qse_word_t variables;
qse_word_t class_variables;
qse_word_t pool_dictonaries;
};
struct qse_stx_metaclass_t
{
qse_stx_objhdr_t h;
qse_word_t spec;
qse_word_t methods;
qse_word_t superclass;
qse_word_t subclasses;
qse_word_t instance_class;
};
typedef struct qse_stx_class_t qse_stx_class_t;
typedef struct qse_stx_metaclass_t qse_stx_metaclass_t;
#define QSE_STX_CLASS_SIZE 8 #define QSE_STX_CLASS_SIZE 8
#define QSE_STX_CLASS_SPEC 0 #define QSE_STX_CLASS_SPEC 0
#define QSE_STX_CLASS_METHODS 1 #define QSE_STX_CLASS_METHODS 1
@ -30,8 +56,10 @@
#define SPEC_VARIABLE_BYTE 0x02 #define SPEC_VARIABLE_BYTE 0x02
#define SPEC_VARIABLE_CHAR 0x03 #define SPEC_VARIABLE_CHAR 0x03
#define MAKE_SPEC(nflds,variable) \ #define SPEC_MAKE(fixed,variable) \
(((nflds) << SPEC_VARIABLE_BITS) | (variable)) (((fixed) << SPEC_VARIABLE_BITS) | (variable))
#define SPEC_GETFIXED(spec) ((spec) >> SPEC_VARIABLE_BITS)
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {

112
qse/lib/stx/dic.c
View File

@ -40,52 +40,78 @@ static qse_word_t new_assoc (
OBJCLASS(stx,x) = stx->ref.class_association; OBJCLASS(stx,x) = stx->ref.class_association;
WORDAT(stx,x,QSE_STX_ASSOC_KEY) = key; WORDAT(stx,x,QSE_STX_ASSOC_KEY) = key;
WORDAT(stx,x,QSE_STX_ASSOC_VALUE) = value; WORDAT(stx,x,QSE_STX_ASSOC_VALUE) = value;
return x; return x;
} }
static qse_word_t expand (qse_stx_t* stx, qse_word_t dic) static qse_word_t expand (qse_stx_t* stx, qse_word_t dic)
{ {
qse_word_t newref, size, index, assoc; qse_word_t oldcapa, newdic, newcapa;
qse_stx_dic_t* oldptr, * newptr;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_systemdictionary));
QSE_ASSERT (stx->ref.class_systemdictionary != stx->ref.nil);
QSE_ASSERTX (
REFISIDX(stx,dic),
"The reference is not an object index"
);
/* WARNING: /* WARNING:
* if this assertion fails, adjust the initial size of the * if this assertion fails, adjust the initial size of the
* system dicionary. i don't want this function to be called * system dicionary. i don't want this function to be called
* during the bootstrapping. * during the bootstrapping.
*/ */
QSE_ASSERT (stx->ref.class_systemdictionary != stx->ref.nil);
QSE_ASSERT (REFISIDX(stx,dic));
QSE_ASSERT (OBJCLASS(stx,dic) == stx->ref.class_systemdictionary); QSE_ASSERT (OBJCLASS(stx,dic) == stx->ref.class_systemdictionary);
size = OBJSIZE(stx,dic); /* get the current capacity excluding the tally field */
newref = qse_stx_instantiate (stx, oldcapa = OBJSIZE(stx,dic) - 1;
OBJCLASS(stx,dic), QSE_NULL, QSE_NULL, (size - 1) * 2);
if (newref == stx->ref.nil) return stx->ref.nil; /* instantiate a new dictionary with its capacity doubled.
WORDAT(stx,newref,QSE_STX_DIC_TALLY) = INTTOREF (stx, 0); * 1 fixed slot for the tally field is encoded is the class part.
* so 'newcapa' specifies the number of slots to hold associations */
newcapa = oldcapa * 2;
newdic = qse_stx_instantiate (
stx, OBJCLASS(stx,dic),
QSE_NULL, QSE_NULL, newcapa
);
if (newdic == stx->ref.nil) return stx->ref.nil;
for (index = 1; index < size; index++) /* get object pointers for easier access without using macros */
oldptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
newptr = (qse_stx_dic_t*)PTRBYREF(stx,newdic);
newptr->tally = INTTOREF(stx,0);
QSE_ASSERT (newcapa == OBJSIZE(stx,newdic)-1);
/* reorganize the dictionary */
while (oldcapa > 0)
{ {
assoc = WORDAT(stx,dic,index); qse_word_t assoc;
if (assoc == stx->ref.nil) continue;
if (qse_stx_putdic (stx, newref, assoc = oldptr->slot[--oldcapa];
WORDAT(stx,assoc,QSE_STX_ASSOC_KEY), if (assoc != stx->ref.nil)
WORDAT(stx,assoc,QSE_STX_ASSOC_VALUE)) == stx->ref.nil)
{ {
return stx->ref.nil; qse_word_t index;
index = qse_stx_hashobj (stx, WORDAT(stx,assoc,QSE_STX_ASSOC_KEY)) % newcapa;
while (newptr->slot[index] != stx->ref.nil)
index = (index + 1) % newcapa;
newptr->slot[index] = assoc;
} }
} }
newptr->tally = oldptr->tally;
/* TODO: explore if dic can be immediately destroyed. */ /* TODO: explore if dic can be immediately destroyed. */
qse_stx_swapmem (stx, REFTOIDX(stx,dic), REFTOIDX(stx,newref)); qse_stx_swapmem (stx, REFTOIDX(stx,dic), REFTOIDX(stx,newdic));
return dic; return dic;
} }
static qse_word_t find_slot ( static qse_word_t find_basic_index (
qse_stx_t* stx, qse_word_t dic, qse_word_t key) qse_stx_t* stx, qse_word_t dic, qse_word_t key)
{ {
qse_word_t capa, hash; qse_word_t capa, index;
qse_stx_dic_t* dicptr; qse_stx_dic_t* dicptr;
/* ensure that dic is a system dictionary */ /* ensure that dic is a system dictionary */
@ -100,7 +126,7 @@ static qse_word_t find_slot (
QSE_ASSERT (OBJTYPE(stx,key) == CHAROBJ); QSE_ASSERT (OBJTYPE(stx,key) == CHAROBJ);
capa = OBJSIZE(stx,dic) - 1; /* exclude the tally field */ capa = OBJSIZE(stx,dic) - 1; /* exclude the tally field */
hash = qse_stx_hashobj (stx, key) % capa; index = qse_stx_hashobj (stx, key) % capa;
dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic); dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
@ -108,33 +134,35 @@ static qse_word_t find_slot (
{ {
qse_word_t assoc, sym; qse_word_t assoc, sym;
assoc = dicptr->slot[hash]; assoc = dicptr->slot[index];
if (assoc == stx->ref.nil) break; /* not found */ if (assoc == stx->ref.nil) break; /* not found */
sym = WORDAT (stx, assoc, QSE_STX_ASSOC_KEY); sym = WORDAT (stx, assoc, QSE_STX_ASSOC_KEY);
/* make sure that the key is a symbol */
QSE_ASSERT (REFISIDX(stx,sym)); QSE_ASSERT (REFISIDX(stx,sym));
QSE_ASSERT (OBJCLASS(stx,sym) == stx->ref.class_symbol); QSE_ASSERT (OBJCLASS(stx,sym) == stx->ref.class_symbol);
QSE_ASSERT (OBJTYPE(stx,sym) == CHAROBJ); QSE_ASSERT (OBJTYPE(stx,sym) == CHAROBJ);
/* check if the key matches */
if (qse_strxncmp( if (qse_strxncmp(
&CHARAT(stx,key,0), OBJSIZE(stx,key), &CHARAT(stx,key,0), OBJSIZE(stx,key),
&CHARAT(stx,sym,0), OBJSIZE(stx,sym)) == 0) break; &CHARAT(stx,sym,0), OBJSIZE(stx,sym)) == 0) break;
hash = (hash + 1) % capa; index = (index + 1) % capa;
} }
while (1); while (1);
/* Include the tally back when returning the association index. /* Include the tally back when returning the association index.
* you can access the association with WORDAT() by using this index. */ * you can access the association with WORDAT() by using this index. */
return hash + 1; return index + 1;
} }
/* look up a system dictionary by a null-terminated string */ /* look up a system dictionary by a null-terminated string */
qse_word_t qse_stx_lookupdic ( qse_word_t qse_stx_lookupdic (
qse_stx_t* stx, qse_word_t dic, const qse_char_t* skey) qse_stx_t* stx, qse_word_t dic, const qse_char_t* skey)
{ {
qse_word_t capa, hash; qse_word_t capa, index;
qse_stx_dic_t* dicptr; qse_stx_dic_t* dicptr;
QSE_ASSERT (REFISIDX(stx,dic)); QSE_ASSERT (REFISIDX(stx,dic));
@ -143,7 +171,7 @@ qse_word_t qse_stx_lookupdic (
OBJCLASS(stx,dic) == stx->ref.class_systemdictionary); OBJCLASS(stx,dic) == stx->ref.class_systemdictionary);
capa = OBJSIZE(stx,dic) - 1; /* exclude the tally field */ capa = OBJSIZE(stx,dic) - 1; /* exclude the tally field */
hash = qse_stx_hashstr (stx, skey) % capa; index = qse_stx_hashstr (stx, skey) % capa;
dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic); dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
@ -151,7 +179,7 @@ qse_word_t qse_stx_lookupdic (
{ {
qse_word_t assoc, keyref; qse_word_t assoc, keyref;
assoc = dicptr->slot[hash]; assoc = dicptr->slot[index];
if (assoc == stx->ref.nil) break; /* not found */ if (assoc == stx->ref.nil) break; /* not found */
keyref = WORDAT(stx,assoc,QSE_STX_ASSOC_KEY); keyref = WORDAT(stx,assoc,QSE_STX_ASSOC_KEY);
@ -164,22 +192,23 @@ qse_word_t qse_stx_lookupdic (
&CHARAT(stx,keyref,0), OBJSIZE(stx,keyref), &CHARAT(stx,keyref,0), OBJSIZE(stx,keyref),
skey) == 0) break; skey) == 0) break;
hash = (hash + 1) % capa; index = (index + 1) % capa;
} }
while (1); while (1);
return dicptr->slot[hash]; return dicptr->slot[index];
} }
qse_word_t qse_stx_getdic (qse_stx_t* stx, qse_word_t dic, qse_word_t key) qse_word_t qse_stx_getdic (qse_stx_t* stx, qse_word_t dic, qse_word_t key)
{ {
return WORDAT (stx, dic, find_slot (stx, dic, key)); /* returns the association for the key. nil if it is not found */
return WORDAT (stx, dic, find_basic_index (stx, dic, key));
} }
qse_word_t qse_stx_putdic ( qse_word_t qse_stx_putdic (
qse_stx_t* stx, qse_word_t dic, qse_word_t key, qse_word_t value) qse_stx_t* stx, qse_word_t dic, qse_word_t key, qse_word_t value)
{ {
qse_word_t slot, capa, tally, assoc; qse_word_t index, capa, tally, assoc;
qse_stx_dic_t* dicptr; qse_stx_dic_t* dicptr;
/* the dicionary must have at least one slot excluding tally */ /* the dicionary must have at least one slot excluding tally */
@ -188,10 +217,11 @@ qse_word_t qse_stx_putdic (
capa = OBJSIZE(stx,dic) - 1; capa = OBJSIZE(stx,dic) - 1;
dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic); dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
tally = REFTOINT(stx,WORDAT(stx,dic,QSE_STX_DIC_TALLY)); tally = REFTOINT(stx,dicptr->tally);
index = find_basic_index (stx, dic, key) - 1;
assoc = dicptr->slot[index];
slot = find_slot (stx, dic, key); /*assoc = WORDAT(stx,dic,slot);*/
assoc = WORDAT(stx,dic,slot);
if (assoc == stx->ref.nil) if (assoc == stx->ref.nil)
{ {
@ -207,15 +237,23 @@ qse_word_t qse_stx_putdic (
*/ */
if (expand (stx, dic) == stx->ref.nil) return stx->ref.nil; if (expand (stx, dic) == stx->ref.nil) return stx->ref.nil;
/* refresh tally */ capa = OBJSIZE(stx,dic) - 1;
tally = REFTOINT(stx,WORDAT(stx,dic,QSE_STX_DIC_TALLY)); dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
/* tally must remain the same after expansion */
QSE_ASSERT (tally == REFTOINT(stx,dicptr->tally));
/* find the key in the expanded dictionary again */
index = find_basic_index (stx, dic, key) - 1;
/* the basic index returned must point to nil meaning
* the key is not found */
QSE_ASSERT (dicptr->slot[index] == stx->ref.nil);
} }
assoc = new_assoc (stx, key, value); assoc = new_assoc (stx, key, value);
if (assoc == stx->ref.nil) return stx->ref.nil; if (assoc == stx->ref.nil) return stx->ref.nil;
WORDAT(stx,dic,slot) = assoc; dicptr->slot[index] = assoc;
WORDAT(stx,dic,QSE_STX_DIC_TALLY) = INTTOREF(stx,tally + 1); dicptr->tally = INTTOREF(stx,tally+1);
} }
else else
{ {

19
qse/lib/stx/stx.h
View File

@ -18,14 +18,6 @@ typedef struct qse_stx_byteobj_t qse_stx_byteobj_t;
typedef struct qse_stx_charobj_t qse_stx_charobj_t; typedef struct qse_stx_charobj_t qse_stx_charobj_t;
typedef struct qse_stx_wordobj_t qse_stx_wordobj_t; typedef struct qse_stx_wordobj_t qse_stx_wordobj_t;
#include "hash.h"
#include "mem.h"
#include "obj.h"
#include "sym.h"
#include "dic.h"
#include "cls.h"
#include "boot.h"
enum qse_stx_objtype_t enum qse_stx_objtype_t
{ {
QSE_STX_BYTEOBJ = 0, QSE_STX_BYTEOBJ = 0,
@ -63,6 +55,14 @@ word fixed
qse_word_t _backref; qse_word_t _backref;
}; };
#include "hash.h"
#include "mem.h"
#include "obj.h"
#include "sym.h"
#include "dic.h"
#include "cls.h"
#include "boot.h"
struct qse_stx_object_t struct qse_stx_object_t
{ {
qse_stx_objhdr_t h; qse_stx_objhdr_t h;
@ -209,6 +209,9 @@ struct qse_stx_t
#define SYMTAB_INIT_CAPA 256 #define SYMTAB_INIT_CAPA 256
#define SYSDIC_INIT_CAPA 256 #define SYSDIC_INIT_CAPA 256
#define ISNIL(stx,obj) ((obj) == (stx)->ref.nil)
#define NIL(stx) ((stx)->ref.nil)
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif

25
qse/lib/stx/sym.c
View File

@ -22,6 +22,9 @@ static qse_word_t expand (qse_stx_t* stx, qse_word_t tabref)
qse_word_t newtab; qse_word_t newtab;
qse_stx_symtab_t* oldptr, * newptr; qse_stx_symtab_t* oldptr, * newptr;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_systemsymboltable));
QSE_ASSERT (!ISNIL(stx,stx->ref.class_systemsymboltable));
QSE_ASSERTX ( QSE_ASSERTX (
REFISIDX(stx,tabref), REFISIDX(stx,tabref),
"The reference is not an object index" "The reference is not an object index"
@ -43,21 +46,24 @@ static qse_word_t expand (qse_stx_t* stx, qse_word_t tabref)
/* instantiate a new symbol table with its capacity doubled. */ /* instantiate a new symbol table with its capacity doubled. */
newcapa = oldcapa * 2; newcapa = oldcapa * 2;
newtab = qse_stx_instantiate ( newtab = qse_stx_instantiate (
stx, OBJCLASS(stx,tabref), stx, OBJCLASS(stx,tabref),
QSE_NULL, QSE_NULL, newcapa + 1 QSE_NULL, QSE_NULL, newcapa
); );
if (newtab == stx->ref.nil) return stx->ref.nil; if (ISNIL(stx,newtab)) return NIL(stx);
oldptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref); oldptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref);
newptr = (qse_stx_symtab_t*)PTRBYREF(stx,newtab); newptr = (qse_stx_symtab_t*)PTRBYREF(stx,newtab);
newptr->tally = INTTOREF (stx, 0); newptr->tally = INTTOREF (stx, 0);
QSE_ASSERT (newcapa == OBJSIZE(stx,newtab) - 1);
/* reorganize the symbol table */
while (oldcapa > 0) while (oldcapa > 0)
{ {
qse_word_t symbol; qse_word_t symbol;
symbol = oldptr->slot[--oldcapa]; symbol = oldptr->slot[--oldcapa];
if (symbol != stx->ref.nil) if (!ISNIL(stx,symbol))
{ {
qse_word_t index; qse_word_t index;
@ -72,15 +78,14 @@ static qse_word_t expand (qse_stx_t* stx, qse_word_t tabref)
qse_stx_hashstr (stx, &CHARAT(stx,symbol,0))); qse_stx_hashstr (stx, &CHARAT(stx,symbol,0)));
index = qse_stx_hashobj (stx, symbol) % newcapa; index = qse_stx_hashobj (stx, symbol) % newcapa;
while (newptr->slot[index] != stx->ref.nil) while (!ISNIL(stx,newptr->slot[index]))
index = (index + 1) % newcapa; index = (index + 1) % newcapa;
newptr->slot[index] = symbol; newptr->slot[index] = symbol;
} }
} }
qse_stx_swapmem (stx, REFTOIDX(stx,tabref), REFTOIDX(stx,newtab));
newptr->tally = oldptr->tally; newptr->tally = oldptr->tally;
qse_stx_swapmem (stx, REFTOIDX(stx,tabref), REFTOIDX(stx,newtab));
return tabref; return tabref;
} }
@ -105,7 +110,7 @@ static qse_word_t new_symbol (
{ {
/*symref = WORDAT (stx, tabref, index + 1);*/ /*symref = WORDAT (stx, tabref, index + 1);*/
symref = tabptr->slot[index]; symref = tabptr->slot[index];
if (symref == stx->ref.nil) break; /* not found */ if (ISNIL(stx,symref)) break; /* not found */
QSE_ASSERT (REFISIDX(stx,symref)); QSE_ASSERT (REFISIDX(stx,symref));
QSE_ASSERT (OBJCLASS(stx,symref) == stx->ref.class_symbol); QSE_ASSERT (OBJCLASS(stx,symref) == stx->ref.class_symbol);
@ -130,7 +135,7 @@ static qse_word_t new_symbol (
* make sure that it has at least one free slot left * make sure that it has at least one free slot left
* after having added a new symbol. this is to help * after having added a new symbol. this is to help
* traversal end at a nil slot if no entry is found. */ * traversal end at a nil slot if no entry is found. */
if (expand (stx, tabref) == stx->ref.nil) return stx->ref.nil; if (ISNIL (stx, expand (stx, tabref))) return NIL(stx);
/* refresh the object pointer */ /* refresh the object pointer */
tabptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref); tabptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref);
@ -144,7 +149,7 @@ static qse_word_t new_symbol (
} }
symref = qse_stx_alloccharobj (stx, name, qse_strlen(name)); symref = qse_stx_alloccharobj (stx, name, qse_strlen(name));
if (symref != stx->ref.nil) if (!ISNIL(stx,symref))
{ {
OBJCLASS(stx,symref) = stx->ref.class_symbol; OBJCLASS(stx,symref) = stx->ref.class_symbol;
tabptr->tally = INTTOREF (stx, tally + 1); tabptr->tally = INTTOREF (stx, tally + 1);