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

added more code for symbol table, system dictionary, bootstrapping

Browse Source
This commit is contained in:
hyung-hwan
2011-06-15 10:04:31 +00:00
parent 3cc4595018
commit fb46d98bb2
18 changed files with 784 additions and 443 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
qse/lib/stx/Makefile.am
View File

@ -8,6 +8,6 @@ AM_CPPFLAGS = \
lib_LTLIBRARIES = libqsestx.la
libqsestx_la_SOURCES = stx.c err.c hash.c mem.c obj.c sym.c dic.c boot.c
libqsestx_la_SOURCES = stx.c err.c hash.c mem.c obj.c sym.c dic.c cls.c boot.c
libqsestx_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined
libqsestx_la_LIBADD = -lqsecmn

5
qse/lib/stx/Makefile.in
View File

@ -72,7 +72,7 @@ am__installdirs = "$(DESTDIR)$(libdir)"
LTLIBRARIES = $(lib_LTLIBRARIES)
libqsestx_la_DEPENDENCIES =
am_libqsestx_la_OBJECTS = stx.lo err.lo hash.lo mem.lo obj.lo sym.lo \
dic.lo boot.lo
dic.lo cls.lo boot.lo
libqsestx_la_OBJECTS = $(am_libqsestx_la_OBJECTS)
libqsestx_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
@ -239,7 +239,7 @@ AM_CPPFLAGS = \
-I$(includedir)
lib_LTLIBRARIES = libqsestx.la
libqsestx_la_SOURCES = stx.c err.c hash.c mem.c obj.c sym.c dic.c boot.c
libqsestx_la_SOURCES = stx.c err.c hash.c mem.c obj.c sym.c dic.c cls.c boot.c
libqsestx_la_LDFLAGS = -L../cmn -L$(libdir) -version-info 1:0:0 -no-undefined
libqsestx_la_LIBADD = -lqsecmn
all: all-am
@ -317,6 +317,7 @@ distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/boot.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cls.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dic.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/err.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/hash.Plo@am__quote@

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

@ -3,11 +3,9 @@
*/
#include "stx.h"
#include "mem.h"
#include "sym.h"
#include "class.h"
#include <qse/cmn/str.h>
static void 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 (
qse_stx_t* stx, qse_word_t class, const qse_char_t* names);
@ -22,6 +20,7 @@ static void __set_subclasses (
qse_stx_t* stx, qse_word_t* array, const qse_char_t* str);
static void __set_metaclass_subclasses (
qse_stx_t* stx, qse_word_t* array, const qse_char_t* str);
#endif
struct class_info_t
{
@ -213,6 +212,14 @@ static class_info_t class_info[] =
QSE_NULL,
SPEC_VARIABLE_BYTE
},
{
QSE_T("SystemSymbolTable"),
QSE_T("IndexedCollection"),
QSE_T("tally"),
QSE_NULL,
QSE_NULL,
SPEC_VARIABLE_WORD
},
{
QSE_T("Dictionary"),
QSE_T("IndexedCollection"),
@ -221,6 +228,7 @@ static class_info_t class_info[] =
QSE_NULL,
SPEC_VARIABLE_WORD
},
{
QSE_T("SystemDictionary"),
QSE_T("Dictionary"),
@ -271,18 +279,20 @@ static class_info_t class_info[] =
}
};
qse_word_t QSE_INLINE __new_string (qse_stx_t* stx, const qse_char_t* str)
qse_word_t QSE_INLINE new_string (qse_stx_t* stx, const qse_char_t* str)
{
qse_word_t x;
QSE_ASSERT (stx->class_string != stx->nil);
x = qse_stx_alloc_char_object (stx, str);
QSE_STX_CLASS(stx,x) = stx->class_string;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_string));
QSE_ASSERT (stx->ref.class_string != stx->ref.nil);
x = qse_stx_alloccharobj (stx, str, qse_strlen(str));
if (x != stx->ref.nil) OBJCLASS(stx,x) = stx->ref.class_string;
return x;
}
static void make_intrinsic_classes (qse_stx_t* stx)
static int make_intrinsic_classes (qse_stx_t* stx)
{
class_info_t* p;
qse_word_t class, superclass, array;
@ -291,35 +301,42 @@ static void make_intrinsic_classes (qse_stx_t* stx)
qse_stx_metaclass_t* metaclass_obj;
qse_word_t n, nfields;
QSE_ASSERT (stx->class_array != stx->nil);
QSE_ASSERT (stx->class_array != stx->ref.nil);
for (p = class_info; p->name != QSE_NULL; p++)
{
class = qse_stx_lookup_class(stx, p->name);
if (class == stx->nil)
class = qse_stx_findclass(stx, p->name);
if (class == stx->ref.nil)
{
class = qse_stx_newclass (stx, p->name);
if (class == stx->ref.nil) return stx->ref.nil;
}
QSE_ASSERT (class != stx->nil);
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class);
class_obj->superclass = (p->superclass == QSE_NULL)?
stx->nil: qse_stx_lookup_class(stx,p->superclass);
QSE_ASSERT (class != stx->ref.nil);
class_obj = (qse_stx_class_t*)PTRBYREF(stx,class);
if (p->superclass)
{
class_obj->superclass = qse_stx_findclass(stx,p->superclass);
QSE_ASSERT (class_obj->superclass != stx->ref.nil);
}
nfields = 0;
if (p->superclass != QSE_NULL) {
if (p->superclass)
{
qse_word_t meta;
qse_stx_metaclass_t* meta_obj;
superclass = qse_stx_lookup_class(stx,p->superclass);
QSE_ASSERT (superclass != stx->nil);
superclass = qse_stx_findclass (stx, p->superclass);
QSE_ASSERT (superclass != stx->ref.nil);
meta = class_obj->header.class;
meta_obj = (qse_stx_metaclass_t*)QSE_STX_OBJPTR(stx,meta);
meta_obj->superclass = QSE_STX_CLASS(stx,superclass);
meta = class_obj->h._class;
meta_obj = (qse_stx_metaclass_t*)PTRBYREF(stx,meta);
meta_obj->superclass = OBJCLASS(stx,superclass);
meta_obj->instance_class = class;
while (superclass != stx->nil) {
while (superclass != stx->ref.nil)
{
superclass_obj = (qse_stx_class_t*)
QSE_STX_OBJPTR(stx,superclass);
nfields +=
@ -327,13 +344,14 @@ static void make_intrinsic_classes (qse_stx_t* stx)
QSE_STX_SPEC_INDEXABLE_BITS;
superclass = superclass_obj->superclass;
}
}
if (p->instance_variables != QSE_NULL) {
if (p->instance_variables)
{
nfields += __count_names (p->instance_variables);
class_obj->variables =
__new_string (stx, p->instance_variables);
new_string (stx, p->instance_variables);
if (class_obj->variables == stx->ref.nil) return -1;
}
QSE_ASSERT (nfields <= 0 || (nfields > 0 &&
@ -346,7 +364,7 @@ static void make_intrinsic_classes (qse_stx_t* stx)
for (p = class_info; p->name != QSE_NULL; p++)
{
class = qse_stx_lookup_class(stx, p->name);
QSE_ASSERT (class != stx->nil);
QSE_ASSERT (class != stx->ref.nil);
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class);
@ -373,7 +391,7 @@ static void make_intrinsic_classes (qse_stx_t* stx)
__set_subclasses (stx, QSE_STX_DATA(stx,array), p->name);
class = qse_stx_lookup_class(stx, p->name);
QSE_ASSERT (class != stx->nil);
QSE_ASSERT (class != stx->ref.nil);
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class);
class_obj->subclasses = array;
}
@ -386,11 +404,13 @@ static void make_intrinsic_classes (qse_stx_t* stx)
__set_metaclass_subclasses (stx, QSE_STX_DATA(stx,array), p->name);
class = qse_stx_lookup_class(stx, p->name);
QSE_ASSERT (class != stx->nil);
QSE_ASSERT (class != stx->ref.nil);
metaclass = QSE_STX_CLASS(stx,class);
metaclass_obj = (qse_stx_metaclass_t*)QSE_STX_OBJPTR(stx, metaclass);
metaclass_obj->subclasses = array;
}
return 0;
}
static qse_word_t __count_names (const qse_char_t* str)
@ -456,7 +476,7 @@ static void __set_subclasses (
if (p->superclass == QSE_NULL) continue;
if (qse_strcmp (str, p->superclass) != 0) continue;
class = qse_stx_lookup_class (stx, p->name);
QSE_ASSERT (class != stx->nil);
QSE_ASSERT (class != stx->ref.nil);
array[n++] = class;
}
}
@ -471,7 +491,7 @@ static void __set_metaclass_subclasses (
if (p->superclass == QSE_NULL) continue;
if (qse_strcmp (str, p->superclass) != 0) continue;
class = qse_stx_lookup_class (stx, p->name);
QSE_ASSERT (class != stx->nil);
QSE_ASSERT (class != stx->ref.nil);
array[n++] = QSE_STX_CLASS(stx,class);
}
}
@ -484,7 +504,7 @@ static qse_word_t __make_classvar_dict (
const qse_char_t* name;
dict = qse_stx_instantiate (
stx, stx->class_system_dictionary,
stx, stx->class_systemdictionary,
QSE_NULL, QSE_NULL, __count_names(names));
do {
@ -498,7 +518,7 @@ static qse_word_t __make_classvar_dict (
*p != QSE_T('\0')) p++;
symbol = qse_stx_new_symbolx (stx, name, p - name);
qse_stx_dict_put (stx, dict, symbol, stx->nil);
qse_stx_dict_put (stx, dict, symbol, stx->ref.nil);
} while (1);
return dict;
@ -518,7 +538,7 @@ static int sketch_nil (qse_stx_t* stx)
{
qse_stx_objidx_t idx;
qse_word_t ref;
qse_stx_wordobjptr_t ptr;
qse_stx_wordobj_t* ptr;
/* nil contains no member fields. allocate space for
* an object header */
@ -526,7 +546,7 @@ static int sketch_nil (qse_stx_t* stx)
if (idx == QSE_STX_OBJIDX_INVALID) return -1;
ref = IDXTOREF(stx,idx);
ptr = (qse_stx_wordobjptr_t)PTRBYIDX(stx,idx);
ptr = (qse_stx_wordobj_t*)PTRBYIDX(stx,idx);
/* store the nil reference first */
stx->ref.nil = ref;
@ -536,7 +556,7 @@ static int sketch_nil (qse_stx_t* stx)
ptr->h._type = QSE_STX_WORDOBJ;
ptr->h._mark = 0;
ptr->h._refcnt = 0;
ptr->h._size = 0;
ptr->h._size = 0;
ptr->h._class = stx->ref.nil; /* the class is yet to be set */
ptr->h._backref = ref;
@ -548,14 +568,28 @@ static int sketch_nil (qse_stx_t* stx)
if ((var) == (stx)->ref.nil) return -1; \
)
#define ADD_TO_SYSDIC(stx,key,value) QSE_BLOCK (\
if (qse_stx_putdic ((stx), (stx)->ref.sysdic, (key), (value)) == (stx)->ref.nil) return -1; \
)
#define NEW_SYMBOL_TO(stx,var,name) QSE_BLOCK (\
var = qse_stx_newsymbol ((stx), name); \
if (var == (stx)->ref.nil) return -1; \
)
#define NEW_CLASS_TO(stx,var,name) QSE_BLOCK (\
var = qse_stx_newclass ((stx), name); \
if (var == (stx)->ref.nil) return -1; \
)
static int sketch_key_objects (qse_stx_t* stx)
{
qse_word_t class_SymbolMeta;
qse_word_t class_MetaclassMeta;
qse_word_t class_AssociationMeta;
qse_word_t symbol_Symbol;
qse_word_t symbol_Metaclass;
qse_word_t symbol_Association;
qse_word_t symbol_symbol;
qse_word_t symbol_metaclass;
qse_word_t symbol_association;
/* allocate true and false. the class pointer is not correct yet */
ALLOC_WORDOBJ_TO (stx, stx->ref.true, 0, 0);
@ -563,13 +597,13 @@ static int sketch_key_objects (qse_stx_t* stx)
/* create a symbol table partially initialized */
/* TODO: initial symbol table size */
ALLOC_WORDOBJ_TO (stx, stx->ref.symtab, 1, 256);
ALLOC_WORDOBJ_TO (stx, stx->ref.symtab, 1, SYMTAB_INIT_CAPA);
/* set tally to 0. */
WORDAT(stx,stx->ref.symtab,QSE_STX_SYMTAB_TALLY) = INTTOREF(stx,0);
/* global system dictionary */
/* TODO: initial dictionary size */
ALLOC_WORDOBJ_TO (stx, stx->ref.sysdic, 1, 256);
ALLOC_WORDOBJ_TO (stx, stx->ref.sysdic, 1, SYSDIC_INIT_CAPA);
/* set tally to 0 */
WORDAT(stx,stx->ref.sysdic,QSE_STX_DIC_TALLY) = INTTOREF(stx,0);
@ -619,39 +653,49 @@ static int sketch_key_objects (qse_stx_t* stx)
* class_symbol are set later in make_builtin_classes */
/* #Symbol */
symbol_Symbol = qse_stx_newsymbol (
stx, stx->ref.symtab, QSE_T("Symbol"));
NEW_SYMBOL_TO (stx, symbol_symbol, QSE_T("Symbol"));
/* #Metaclass */
symbol_Metaclass = qse_stx_newsymbol (
stx, stx->ref.symtab, QSE_T("Metaclass"));
NEW_SYMBOL_TO (stx, symbol_metaclass, QSE_T("Metaclass"));
/* #Association */
symbol_Association = qse_stx_newsymbol (
stx, stx->ref.symtab, QSE_T("Association"));
NEW_SYMBOL_TO (stx, symbol_association, QSE_T("Association"));
/* Symbol setName: #Symbol */
WORDAT(stx,stx->ref.class_symbol,QSE_STX_CLASS_NAME) = symbol_Symbol;
WORDAT(stx,stx->ref.class_symbol,QSE_STX_CLASS_NAME) = symbol_symbol;
/* Metaclass setName: #Metaclass */
WORDAT(stx,stx->ref.class_metaclass,QSE_STX_CLASS_NAME) = symbol_Metaclass;
WORDAT(stx,stx->ref.class_metaclass,QSE_STX_CLASS_NAME) = symbol_metaclass;
/* Association setName: #Association */
WORDAT(stx,stx->ref.class_association,QSE_STX_CLASS_NAME) = symbol_Association;
WORDAT(stx,stx->ref.class_association,QSE_STX_CLASS_NAME) = symbol_association;
#if 0
/* register class names into the system dictionary */
qse_stx_dict_put (stx,
stx->ref.sysdic, symbol_Symbol, stx->class_symbol);
qse_stx_dict_put (stx,
stx->ref.sysdic, symbol_Metaclass, stx->class_metaclass);
qse_stx_dict_put (stx,
stx->ref.sysdic, symbol_Association, stx->class_association);
#endif
ADD_TO_SYSDIC (stx, symbol_symbol, stx->ref.class_symbol);
ADD_TO_SYSDIC (stx, symbol_metaclass, stx->ref.class_metaclass);
ADD_TO_SYSDIC (stx, symbol_association, stx->ref.class_association);
return 0;
}
int make_key_classes (qse_stx_t* stx)
{
/* object, class, and array are precreated for easier instantiation
* of intrinsic classes */
NEW_CLASS_TO (stx, stx->ref.class_object, QSE_T("Object"));
NEW_CLASS_TO (stx, stx->ref.class_class, QSE_T("Class"));
NEW_CLASS_TO (stx, stx->ref.class_array, QSE_T("Array"));
NEW_CLASS_TO (stx, stx->ref.class_bytearray, QSE_T("ByteArray"));
NEW_CLASS_TO (stx, stx->ref.class_string, QSE_T("String"));
NEW_CLASS_TO (stx, stx->ref.class_character, QSE_T("Character"));
NEW_CLASS_TO (stx, stx->ref.class_context, QSE_T("Context"));
NEW_CLASS_TO (stx, stx->ref.class_systemsymboltable, QSE_T("SystemSymbolTable"));
NEW_CLASS_TO (stx, stx->ref.class_systemdictionary, QSE_T("SystemDictionary"));
NEW_CLASS_TO (stx, stx->ref.class_method, QSE_T("Method"));
NEW_CLASS_TO (stx, stx->ref.class_smallinteger, QSE_T("SmallInteger"));
return 0;
}
int qse_stx_boot (qse_stx_t* stx)
{
qse_word_t symbol_Smalltalk;
qse_word_t symbol_smalltalk;
qse_word_t object_meta;
/* create a partially initialized nil object for bootstrapping */
@ -660,29 +704,13 @@ int qse_stx_boot (qse_stx_t* stx)
/* continue intializing other key objects */
if (sketch_key_objects (stx) <= -1) goto oops;
if (make_key_classes (stx) <= -1) goto oops;
if (make_intrisic_classes (stx) <= -1) goto oops;
return 0;
#if 0
__create_bootstrapping_objects (stx);
/* object, class, and array are precreated for easier instantiation
* of builtin classes */
stx->class_object = qse_stx_newclass (stx, QSE_T("Object"));
stx->class_class = qse_stx_newclass (stx, QSE_T("Class"));
stx->class_array = qse_stx_newclass (stx, QSE_T("Array"));
stx->class_bytearray = qse_stx_newclass (stx, QSE_T("ByteArray"));
stx->class_string = qse_stx_newclass (stx, QSE_T("String"));
stx->class_character = qse_stx_newclass (stx, QSE_T("Character"));
stx->class_context = qse_stx_newclass (stx, QSE_T("Context"));
stx->class_system_dictionary =
qse_stx_newclass (stx, QSE_T("SystemDictionary"));
stx->class_method =
qse_stx_newclass (stx, QSE_T("Method"));
stx->class_smallinteger =
qse_stx_newclass (stx, QSE_T("SmallInteger"));
make_intrisic_classes (stx);
/* (Object class) setSuperclass: Class */
object_meta = QSE_STX_CLASS(stx,stx->class_object);
QSE_STX_WORD_AT(stx,object_meta,QSE_STX_METACLASS_SUPERCLASS) = stx->class_class;
@ -699,25 +727,21 @@ int qse_stx_boot (qse_stx_t* stx)
}
/* more initialization */
QSE_STX_CLASS(stx,stx->sysdic) = stx->class_system_dictionary;
symbol_Smalltalk = qse_stx_new_symbol (stx, QSE_T("Smalltalk"));
qse_stx_dict_put (stx, stx->sysdic, symbol_Smalltalk, stx->sysdic);
OBJCLASS(stx,stx->ref.sysdic) = stx->class_systemdictionary;
NEW_SYMBOL_TO (stx, symbol_smalltalk, QSE_T("Smalltalk"));
ADD_TO_SYSDIC (stx, symbol_smalltalk, stx->ref.sysdic);
/* create #nil, #true, #false */
qse_stx_new_symbol (stx, QSE_T("nil"));
qse_stx_new_symbol (stx, QSE_T("true"));
qse_stx_new_symbol (stx, QSE_T("false"));
NEW_SYMBOL_TO (stx, symbol_nil, QSE_T("nil"));
NEW_SYMBOL_TO (stx, symbol_true, QSE_T("true"));
NEW_SYMBOL_TO (stx, symbol_false, QSE_T("false"));
/* nil setClass: UndefinedObject */
QSE_STX_CLASS(stx,stx->nil) =
qse_stx_lookup_class(stx, QSE_T("UndefinedObject"));
OBJCLASS(stx,stx->ref.nil) = qse_stx_findclass (stx, QSE_T("UndefinedObject"));
/* true setClass: True */
QSE_STX_CLASS(stx,stx->true) =
qse_stx_lookup_class (stx, QSE_T("True"));
OBJCLASS(stx,stx->ref.true) = qse_stx_findclass (stx, QSE_T("True"));
/* fales setClass: False */
QSE_STX_CLASS(stx,stx->false) =
qse_stx_lookup_class (stx, QSE_T("False"));
OBJCLASS(stx,stx->ref.false) = qse_stx_findclass (stx, QSE_T("False"));
__filein_kernel (stx);
return 0;

70
qse/lib/stx/class.c
View File

@ -32,11 +32,11 @@ qse_word_t qse_stx_newclass (qse_stx_t* stx, const qse_char_t* name)
return class;
}
qse_word_t qse_stx_lookup_class (qse_stx_t* stx, const qse_char_t* name)
qse_word_t qse_stx_findclass (qse_stx_t* stx, const qse_char_t* name)
{
qse_word_t assoc, meta, value;
assoc = qse_stx_dict_lookup (stx, stx->smalltalk, name);
assoc = qse_stx_dict_lookup (stx, stx->ref.sysdic, name);
if (assoc == stx->nil)
{
return stx->nil;
@ -44,7 +44,7 @@ qse_word_t qse_stx_lookup_class (qse_stx_t* stx, const qse_char_t* name)
value = QSE_STX_WORD_AT(stx,assoc,QSE_STX_ASSOCIATION_VALUE);
meta = QSE_STX_CLASS(stx,value);
if (QSE_STX_CLASS(stx,meta) != stx->class_metaclass) return stx->nil;
if (QSE_STX_CLASS(stx,meta) != stx->ref.class_metaclass) return stx->nil;
return value;
}
@ -167,3 +167,67 @@ qse_word_t qse_stx_lookup_method (qse_stx_t* stx,
return stx->nil;
}
qse_word_t qse_stx_instantiate (
qse_stx_t* stx, qse_word_t classref, void* data,
const void* variable_data, qse_word_t variable_nflds)
{
qse_stx_class_t* classptr;
qse_word_t spec, nflds, inst;
int variable;
QSE_ASSERT (REFISIDX(stx,classref));
/* don't instantiate a metaclass whose instance must be
created in a different way */
QSE_ASSERT (OBJCLASS(stx,classref) != stx->ref.class_metaclass);
classptr = (qse_stx_class_t*) PTRBYRFF (stx, classref);
/* TODO: maybe delete the following line */
QSE_ASSERT (QSE_STX_CLASS(class) != stx->class_metaclass);
QSE_ASSERT (REFISINT(stx,classptr->spec));
spec = REFTOINT(classptr->spec);
nflds = (spec >> SPEC_VARIABLE_BITS);
variable = spec & SPEC_VARIABLE_MASK;
switch (variable)
{
case SPEC_VARIABLE_BYTE:
/* variable-size byte class */
QSE_ASSERT (nflds == 0 && data == QSE_NULL);
inst = qse_stx_allocbyteobj(
stx, variable_data, variable_nflds);
break;
case SPEC_VARIABLE_CHAR:
/* variable-size char class */
QSE_ASSERT (nflds == 0 && data == QSE_NULL);
inst = qse_stx_alloccharobj (
stx, variable_data, variable_nflds);
break;
case SPEC_VARIABLE_WORD:
/* variable-size class */
inst = qse_stx_allocwordobj (
stx, data, nflds, variable_data, variable_nflds);
break;
case SPEC_FIXED_WORD:
/* fixed size */
QSE_ASSERT (variable_nflds == 0 && variable_data == QSE_NULL);
inst = qse_stx_allocwordobj (
stx, data, nflds, QSE_NULL, 0);
break;
default:
/* this should never happen */
QSE_ASSERTX (0, "this should never happen");
qse_stx_seterror
inst = stx->ref.nil;
}
if (inst != stx->ref.nil) OBJCLASS(stx,inst) = classref;
return inst;
}

20
qse/lib/stx/class.h
View File

@ -66,9 +66,15 @@ typedef struct qse_stx_metaclass_t qse_stx_metaclass_t;
extern "C" {
#endif
qse_word_t qse_stx_new_class (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 qse_stx_lookup_class (qse_stx_t* stx, const qse_char_t* name);
qse_word_t qse_stx_lookupclass (
qse_stx_t* stx,
const qse_char_t* name
);
int qse_stx_get_instance_variable_index (
qse_stx_t* stx, qse_word_t class_index,
@ -79,6 +85,16 @@ qse_word_t qse_stx_lookup_class_variable (
qse_word_t qse_stx_lookup_method (qse_stx_t* stx,
qse_word_t class_index, const qse_char_t* name, qse_bool_t from_super);
qse_word_t qse_stx_instantiate (
qse_stx_t* stx,
qse_word_t classref,
const void* data,
const void* variable_data,
qse_word_t variable_nfields
);
#ifdef __cplusplus
}
#endif

272
qse/lib/stx/cls.c Normal file
View File

@ -0,0 +1,272 @@
/*
* $Id: class.c 118 2008-03-03 11:21:33Z baconevi $
*/
#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 meta, class;
qse_word_t class_name;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_metaclass));
meta = qse_stx_allocwordobj (
stx, QSE_NULL, QSE_STX_METACLASS_SIZE, QSE_NULL, 0);
if (meta == stx->ref.nil) return stx->ref.nil;
OBJCLASS(stx,meta) = stx->ref.class_metaclass;
/* the spec of the metaclass must be the spec of its
* instance. so the QSE_STX_CLASS_SIZE is set */
WORDAT(stx,meta,QSE_STX_METACLASS_SPEC) =
INTTOREF(stx,MAKE_SPEC(QSE_STX_CLASS_SIZE,SPEC_FIXED_WORD));
/* the spec of the class is set later in __create_builtin_classes */
class = qse_stx_allocwordobj (
stx, QSE_NULL, QSE_STX_CLASS_SIZE, QSE_NULL, 0);
OBJCLASS(stx,class) = meta;
class_name = qse_stx_newsymbol (stx, name);
if (class_name == stx->ref.nil) return stx->ref.nil;
WORDAT(stx,class,QSE_STX_CLASS_NAME) = class_name;
return (qse_stx_putdic (stx, stx->ref.sysdic, class_name, class) == stx->ref.nil)? stx->ref.nil: class;
}
qse_word_t qse_stx_findclass (qse_stx_t* stx, const qse_char_t* name)
{
qse_word_t assoc, meta, value;
/* look up the system dictionary for the name given */
assoc = qse_stx_lookupdic (stx, stx->ref.sysdic, name);
if (assoc == stx->ref.nil)
{
/*qse_stx_seterrnum (stx, QSE_STX_ENOCLASS, QSE_NULL);*/
return stx->ref.nil;
}
/* get the value part in the association for the name */
value = WORDAT(stx,assoc,QSE_STX_ASSOC_VALUE);
/* check if its class is Metaclass because the class of
* a class object must be Metaclass. */
meta = OBJCLASS(stx,value);
if (OBJCLASS(stx,meta) != stx->ref.class_metaclass)
{
/*qse_stx_seterrnum (stx, QSE_STX_ENOTCLASS, QSE_NULL);*/
return stx->ref.nil;
}
return value;
}
#if 0
int qse_stx_get_instance_variable_index (
qse_stx_t* stx, qse_word_t class_index,
const qse_char_t* name, qse_word_t* index)
{
qse_word_t index_super = 0;
qse_stx_class_t* class_obj;
qse_stx_char_object_t* string;
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class_index);
qse_assert (class_obj != QSE_NULL);
if (class_obj->superclass != stx->nil) {
if (qse_stx_get_instance_variable_index (
stx, class_obj->superclass, name, &index_super) == 0) {
*index = index_super;
return 0;
}
}
if (class_obj->header.class == stx->class_metaclass) {
/* metaclass */
/* TODO: can a metaclas have instance variables? */
*index = index_super;
}
else {
if (class_obj->variables == stx->nil) *index = 0;
else {
string = QSE_STX_CHAR_OBJECT(stx, class_obj->variables);
if (qse_stx_strword(string->data, name, index) != QSE_NULL) {
*index += index_super;
return 0;
}
}
*index += index_super;
}
return -1;
}
qse_word_t qse_stx_lookup_class_variable (
qse_stx_t* stx, qse_word_t class_index, const qse_char_t* name)
{
qse_stx_class_t* class_obj;
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class_index);
qse_assert (class_obj != QSE_NULL);
if (class_obj->superclass != stx->nil) {
qse_word_t tmp;
tmp = qse_stx_lookup_class_variable (
stx, class_obj->superclass, name);
if (tmp != stx->nil) return tmp;
}
/* TODO: can a metaclas have class variables? */
if (class_obj->header.class != stx->class_metaclass &&
class_obj->class_variables != stx->nil) {
if (qse_stx_dict_lookup(stx,
class_obj->class_variables,name) != stx->nil) return class_index;
}
return stx->nil;
}
qse_word_t qse_stx_lookup_method (qse_stx_t* stx,
qse_word_t class_index, const qse_char_t* name, qse_bool_t from_super)
{
qse_stx_class_t* class_obj;
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class_index);
qse_assert (class_obj != QSE_NULL);
#if 0
if (class_obj->header.class != stx->class_metaclass &&
class_obj->methods != stx->nil) {
qse_word_t assoc;
assoc = qse_stx_dict_lookup(stx, class_obj->methods, name);
if (assoc != stx->nil) {
qse_assert (QSE_STX_CLASS(stx,assoc) == stx->class_association);
return QSE_STX_WORD_AT(stx, assoc, QSE_STX_ASSOCIATION_VALUE);
}
}
if (class_obj->superclass != stx->nil) {
qse_word_t tmp;
tmp = qse_stx_lookup_method (
stx, class_obj->superclass, name);
if (tmp != stx->nil) return tmp;
}
#endif
while (class_index != stx->nil) {
class_obj = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class_index);
qse_assert (class_obj != QSE_NULL);
qse_assert (
class_obj->header.class == stx->class_metaclass ||
QSE_STX_CLASS(stx,class_obj->header.class) == stx->class_metaclass);
if (from_super) {
from_super = qse_false;
}
else if (class_obj->methods != stx->nil) {
qse_word_t assoc;
assoc = qse_stx_dict_lookup(stx, class_obj->methods, name);
if (assoc != stx->nil) {
qse_assert (QSE_STX_CLASS(stx,assoc) == stx->class_association);
return QSE_STX_WORD_AT(stx, assoc, QSE_STX_ASSOCIATION_VALUE);
}
}
class_index = class_obj->superclass;
}
return stx->nil;
}
#endif
qse_word_t qse_stx_instantiate (
qse_stx_t* stx, qse_word_t classref, const void* data,
const void* variable_data, qse_word_t variable_nflds)
{
qse_stx_class_t* classptr;
qse_word_t spec, nflds, inst;
int variable;
QSE_ASSERT (REFISIDX(stx,classref));
/* don't instantiate a metaclass whose instance must be
created in a different way */
QSE_ASSERT (OBJCLASS(stx,classref) != stx->ref.class_metaclass);
classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
QSE_ASSERT (REFISINT(stx,classptr->spec));
spec = REFTOINT(stx,classptr->spec);
nflds = (spec >> SPEC_VARIABLE_BITS);
variable = spec & SPEC_VARIABLE_MASK;
switch (variable)
{
case SPEC_VARIABLE_BYTE:
/* variable-size byte class */
QSE_ASSERT (nflds == 0 && data == QSE_NULL);
inst = qse_stx_allocbyteobj (
stx, variable_data, variable_nflds);
break;
case SPEC_VARIABLE_CHAR:
/* variable-size char class */
QSE_ASSERT (nflds == 0 && data == QSE_NULL);
inst = qse_stx_alloccharobj (
stx, variable_data, variable_nflds);
break;
case SPEC_VARIABLE_WORD:
/* variable-size class */
inst = qse_stx_allocwordobj (
stx, data, nflds, variable_data, variable_nflds);
break;
case SPEC_FIXED_WORD:
/* fixed size */
QSE_ASSERT (variable_nflds == 0 && variable_data == QSE_NULL);
inst = qse_stx_allocwordobj (
stx, data, nflds, QSE_NULL, 0);
break;
default:
/* this should never happen */
QSE_ASSERTX (0, "this should never happen");
qse_stx_seterrnum (stx, QSE_STX_EINTERN, QSE_NULL);
return stx->ref.nil;
}
QSE_ASSERT (inst != stx->ref.nil);
OBJCLASS(stx,inst) = classref;
return inst;
}

75
qse/lib/stx/cls.h Normal file
View File

@ -0,0 +1,75 @@
/*
* $Id$
*/
#ifndef _QSE_LIB_STX_CLS_H_
#define _QSE_LIB_STX_CLS_H_
#define QSE_STX_CLASS_SIZE 8
#define QSE_STX_CLASS_SPEC 0
#define QSE_STX_CLASS_METHODS 1
#define QSE_STX_CLASS_SUPERCLASS 2
#define QSE_STX_CLASS_SUBCLASSES 3
#define QSE_STX_CLASS_NAME 4
#define QSE_STX_CLASS_VARIABLES 5
#define QSE_STX_CLASS_CLASS_VARIABLES 6
#define QSE_STX_CLASS_POOL_DICTIONARIES 7
#define QSE_STX_METACLASS_SIZE 5
#define QSE_STX_METACLASS_SPEC 0
#define QSE_STX_METACLASS_METHODS 1
#define QSE_STX_METACLASS_SUPERCLASS 2
#define QSE_STX_METACLASS_SUBCLASSES 3
#define QSE_STX_METACLASS_INSTANCE_CLASS 4
#define SPEC_VARIABLE_BITS 2
#define SPEC_VARIABLE_MASK 0x03
#define SPEC_FIXED_WORD 0x00
#define SPEC_VARIABLE_WORD 0x01
#define SPEC_VARIABLE_BYTE 0x02
#define SPEC_VARIABLE_CHAR 0x03
#define MAKE_SPEC(nflds,variable) \
(((nflds) << SPEC_VARIABLE_BITS) | (variable))
#ifdef __cplusplus
extern "C" {
#endif
qse_word_t qse_stx_newclass (
qse_stx_t* stx,
const qse_char_t* name
);
qse_word_t qse_stx_findclass (
qse_stx_t* stx,
const qse_char_t* name
);
#if 0
int qse_stx_get_instance_variable_index (
qse_stx_t* stx, qse_word_t class_index,
const qse_char_t* name, qse_word_t* index);
qse_word_t qse_stx_lookup_class_variable (
qse_stx_t* stx, qse_word_t class_index, const qse_char_t* name);
qse_word_t qse_stx_lookup_method (qse_stx_t* stx,
qse_word_t class_index, const qse_char_t* name, qse_bool_t from_super);
#endif
qse_word_t qse_stx_instantiate (
qse_stx_t* stx,
qse_word_t classref,
const void* data,
const void* variable_data,
qse_word_t variable_nfields
);
#ifdef __cplusplus
}
#endif
#endif

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

@ -44,45 +44,40 @@ static qse_word_t new_assoc (
return x;
}
static qse_word_t grow_dic (qse_stx_t* stx, qse_word_t dic)
static qse_word_t expand (qse_stx_t* stx, qse_word_t dic)
{
qse_word_t new, size, index, assoc;
qse_word_t newref, size, index, assoc;
/* WARNING:
* if this assertion fails, adjust the initial size of the
* system dicionary. i don't want this function to be called
* during the bootstrapping.
*/
QSE_ASSERT (stx->ref.class_system_dictionary != stx->ref.nil);
QSE_ASSERT (stx->ref.class_systemdictionary != stx->ref.nil);
QSE_ASSERT (REFISIDX(stx,dic));
QSE_ASSERT (OBJCLASS(stx,dic) == stx->ref.class_system_dictionary);
QSE_ASSERT (OBJCLASS(stx,dic) == stx->ref.class_systemdictionary);
size = OBJSIZE(stx,dic);
new = qse_stx_instantiate (stx,
newref = qse_stx_instantiate (stx,
OBJCLASS(stx,dic), QSE_NULL, QSE_NULL, (size - 1) * 2);
if (new == stx->ref.nil) return stx->ref.nil;
WORDAT(stx,new,QSE_STX_DIC_TALLY) = INTTOREF (stx, 0);
if (newref == stx->ref.nil) return stx->ref.nil;
WORDAT(stx,newref,QSE_STX_DIC_TALLY) = INTTOREF (stx, 0);
for (index = 1; index < size; index++)
{
assoc = WORDAT(stx,dic,index);
if (assoc == stx->ref.nil) continue;
qse_stx_putdic (stx, new,
if (qse_stx_putdic (stx, newref,
WORDAT(stx,assoc,QSE_STX_ASSOC_KEY),
WORDAT(stx,assoc,QSE_STX_ASSOC_VALUE));
WORDAT(stx,assoc,QSE_STX_ASSOC_VALUE)) == stx->ref.nil)
{
return stx->ref.nil;
}
}
/* TODO: explore if dic can be immediately destroyed. */
QSE_ASSERT (QSE_SIZEOF(qse_stx_object_t*) == QSE_SIZEOF(qse_uint_t));
QSE_SWAP (
PTRBYIDX(stx,dic),
PTRBYIDX(stx,new),
qse_stx_object_t*,
qse_uint_t
);
qse_stx_swapmem (stx, REFTOIDX(stx,dic), REFTOIDX(stx,newref));
return dic;
}
@ -97,7 +92,7 @@ static qse_word_t find_slot (
QSE_ASSERT (REFISIDX(stx,dic));
QSE_ASSERT (OBJTYPE(stx,dic) == WORDOBJ);
QSE_ASSERT (dic == stx->ref.sysdic ||
OBJCLASS(stx,key) == stx->ref.class_system_dictionary);
OBJCLASS(stx,key) == stx->ref.class_systemdictionary);
/* ensure that the key is a symbol */
QSE_ASSERT (REFISIDX(stx,key));
@ -145,7 +140,7 @@ qse_word_t qse_stx_lookupdic (
QSE_ASSERT (REFISIDX(stx,dic));
QSE_ASSERT (OBJTYPE(stx,dic) == WORDOBJ);
QSE_ASSERT (dic == stx->ref.sysdic ||
OBJCLASS(stx,dic) == stx->ref.class_system_dictionary);
OBJCLASS(stx,dic) == stx->ref.class_systemdictionary);
capa = OBJSIZE(stx,dic) - 1; /* exclude the tally field */
hash = qse_stx_hashstr (stx, skey) % capa;
@ -210,7 +205,7 @@ qse_word_t qse_stx_putdic (
* - make sure that lookup never enters a infinite loop.
* - the slot's index can be returned when no key is found.
*/
if (grow_dic (stx, dic) == stx->ref.nil) return stx->ref.nil;
if (expand (stx, dic) == stx->ref.nil) return stx->ref.nil;
/* refresh tally */
tally = REFTOINT(stx,WORDAT(stx,dic,QSE_STX_DIC_TALLY));

2
qse/lib/stx/dic.h
View File

@ -9,7 +9,7 @@
#define QSE_STX_ASSOC_KEY 0
#define QSE_STX_ASSOC_VALUE 1
/* The SystemDictionary is a word variable class.
/* The SystemDictionary is a variable word class.
* The info below is for the fixed part only */
#define QSE_STX_DIC_SIZE 1
#define QSE_STX_DIC_TALLY 0

50
qse/lib/stx/hash.c
View File

@ -5,7 +5,7 @@
#include "stx.h"
#include <qse/cmn/str.h>
qse_word_t qse_stx_hashbyte (qse_stx_t* stx, const void* data, qse_word_t len)
qse_word_t qse_stx_hashbytes (qse_stx_t* stx, const void* data, qse_word_t len)
{
qse_word_t h = 0;
qse_byte_t* bp, * be;
@ -38,6 +38,54 @@ qse_word_t qse_stx_hashstrx (qse_stx_t* stx, const qse_char_t* str, qse_word_t l
return qse_stx_hashbytes (stx, str, len * QSE_SIZEOF(*str));
}
qse_word_t qse_stx_hashobj (qse_stx_t* stx, qse_word_t ref)
{
qse_word_t hv;
if (REFISINT(stx, ref))
{
qse_word_t tmp = REFTOINT(stx, ref);
hv = qse_stx_hashbytes (stx, &tmp, QSE_SIZEOF(tmp));
}
else
{
switch (OBJTYPE(stx,ref))
{
case BYTEOBJ:
hv = qse_stx_hashbytes (
stx,
&BYTEAT(stx,ref,0),
OBJSIZE(stx,ref)
);
break;
case CHAROBJ:
/* the additional null is not taken into account */
hv = qse_stx_hashbytes (
stx,
&CHARAT(stx,ref,0),
OBJSIZE(stx,ref) * QSE_SIZEOF(qse_char_t)
);
break;
case WORDOBJ:
hv = qse_stx_hashbytes (
stx,
&WORDAT(stx,ref,0),
OBJSIZE(stx,ref) * QSE_SIZEOF(qse_word_t)
);
break;
default:
QSE_ASSERT (
!"This should never happen"
);
break;
}
}
return hv;
}
#if 0
qse_char_t* qse_stx_strword (

7
qse/lib/stx/hash.h
View File

@ -26,6 +26,13 @@ qse_word_t qse_stx_hashstrx (
qse_word_t len
);
qse_word_t qse_stx_hashobj (
qse_stx_t* stx,
qse_word_t ref
);
#ifdef __cplusplus
}
#endif

27
qse/lib/stx/mem.c
View File

@ -20,7 +20,11 @@ int qse_stx_initmem (qse_stx_t* stx, qse_size_t capa)
stx->mmgr,
capa * QSE_SIZEOF(*stx->mem.slot)
);
if (stx->mem.slot == QSE_NULL) return -1;
if (stx->mem.slot == QSE_NULL)
{
qse_stx_seterrnum (stx, QSE_STX_ENOMEM, QSE_NULL);
return -1;
}
stx->mem.capa = capa;
@ -59,7 +63,13 @@ qse_stx_objidx_t qse_stx_allocmem (qse_stx_t* stx, qse_size_t nbytes)
if (stx->mem.free == QSE_NULL)
{
qse_stx_gcmem (stx);
if (stx->mem.free == QSE_NULL) return QSE_STX_OBJIDX_INVALID;
if (stx->mem.free == QSE_NULL)
{
/* ran out of object table slots */
/* TODO: NEED TO USE a different error code??? */
qse_stx_seterrnum (stx, QSE_STX_ENOMEM, QSE_NULL);
return QSE_STX_OBJIDX_INVALID;
}
}
/* TODO: memory allocation by region.. instead of calling individual QSE_MMGR_ALLOC
@ -73,7 +83,8 @@ qse_stx_objidx_t qse_stx_allocmem (qse_stx_t* stx, qse_size_t nbytes)
objptr = (qse_stx_objptr_t) QSE_MMGR_ALLOC (stx->mmgr, nbytes);
if (objptr == QSE_NULL)
{
QSE_ASSERT (QSE_T("MEMORY ALLOCATION ERROR\n") == QSE_NULL);
/* ran out of object memory */
qse_stx_seterrnum (stx, QSE_STX_ENOMEM, QSE_NULL);
return QSE_STX_OBJIDX_INVALID;
}
}
@ -82,7 +93,7 @@ QSE_ASSERT (QSE_T("MEMORY ALLOCATION ERROR\n") == QSE_NULL);
stx->mem.free = (qse_stx_objptr_t*)*slot;
*slot = objptr;
QSE_MEMSET (objptr, 0, QSE_SIZEOF(nbytes));
QSE_MEMSET (objptr, 0, nbytes);
return (qse_stx_objidx_t)(slot - stx->mem.slot);
}
@ -98,3 +109,11 @@ void qse_stx_freemem (qse_stx_t* stx, qse_stx_objidx_t objidx)
stx->mem.free = &stx->mem.slot[objidx];
}
void qse_stx_swapmem (qse_stx_t* stx, qse_stx_objidx_t idx1, qse_stx_objidx_t idx2)
{
qse_stx_objptr_t tmp;
tmp = stx->mem.slot[idx1];
stx->mem.slot[idx1] = stx->mem.slot[idx2];
stx->mem.slot[idx2] = tmp;
}

6
qse/lib/stx/mem.h
View File

@ -32,6 +32,12 @@ void qse_stx_freemem (
qse_stx_objidx_t objidx
);
void qse_stx_swapmem (
qse_stx_t* stx,
qse_stx_objidx_t idx1,
qse_stx_objidx_t idx2
);
#ifdef __cplusplus
}
#endif

140
qse/lib/stx/obj.c
View File

@ -12,7 +12,7 @@ qse_word_t qse_stx_allocwordobj (
qse_size_t total_bytes;
qse_stx_objidx_t idx;
qse_word_t ref;
qse_stx_wordobjptr_t ptr;
qse_stx_wordobj_t* ptr;
total_nflds = nflds + variable_nflds;
total_bytes =
@ -26,7 +26,7 @@ qse_word_t qse_stx_allocwordobj (
if (idx == QSE_STX_OBJIDX_INVALID) return stx->ref.nil;
ref = IDXTOREF(stx,idx);
ptr = (qse_stx_wordobjptr_t)PTRBYIDX(stx,idx);
ptr = (qse_stx_wordobj_t*)PTRBYIDX(stx,idx);
ptr->h._type = QSE_STX_WORDOBJ;
ptr->h._mark = 0;
@ -71,19 +71,19 @@ qse_word_t qse_stx_allocbyteobj (
{
qse_stx_objidx_t idx;
qse_word_t ref;
qse_stx_byteobjptr_t ptr;
qse_stx_byteobj_t* ptr;
idx = qse_stx_allocmem (
stx, variable_nflds + QSE_SIZEOF(qse_stx_objhdr_t));
if (idx == QSE_STX_OBJIDX_INVALID) return stx->ref.nil;
ref = QSE_STX_IDXTOREF(stx,idx);
ptr = (qse_stx_byteobjptr_t)PTRBYIDX(stx,idx);
ptr = (qse_stx_byteobj_t*)PTRBYIDX(stx,idx);
ptr->h._type = QSE_STX_BYTEOBJ;
ptr->h._mark = 0;
ptr->h._refcnt = 0;
ptr->h._size = variable_nflds;
ptr->h._type = QSE_STX_BYTEOBJ;
ptr->h._mark = 0;
ptr->h._refcnt = 0;
ptr->h._size = variable_nflds;
ptr->h._class = stx->ref.nil;
ptr->h._backref = ref;
@ -114,7 +114,7 @@ qse_word_t qse_stx_alloccharobj (
{
qse_stx_objidx_t idx;
qse_word_t ref;
qse_stx_charobjptr_t ptr;
qse_stx_charobj_t* ptr;
qse_size_t total_bytes;
total_bytes =
@ -125,14 +125,17 @@ qse_word_t qse_stx_alloccharobj (
if (idx == QSE_STX_OBJIDX_INVALID) return stx->ref.nil;
ref = QSE_STX_IDXTOREF(stx,idx);
ptr = (qse_stx_charobjptr_t)PTRBYIDX(stx,idx);
ptr = (qse_stx_charobj_t*)PTRBYIDX(stx,idx);
ptr->h._type = QSE_STX_CHAROBJ;
ptr->h._mark = 0;
ptr->h._refcnt = 0;
ptr->h._size = variable_nflds;
ptr->h._class = stx->ref.nil;
ptr->h._backref = ref;
/* the size for the character object does not include
* the extra 1 byte allocated for an implicit terminating
* '\0' character */
ptr->h._size = variable_nflds;
ptr->h._class = stx->ref.nil;
ptr->h._backref = ref;
if (variable_data)
{
@ -189,118 +192,7 @@ qse_word_t qse_stx_allocn_char_object (qse_stx_t* stx, ...)
}
#endif
qse_word_t qse_stx_hashobj (qse_stx_t* stx, qse_word_t ref)
{
qse_word_t hv;
if (REFISINT(stx, ref))
{
qse_word_t tmp = REFTOINT(stx, ref);
hv = qse_stx_hashbytes (stx, &tmp, QSE_SIZEOF(tmp));
}
else
{
switch (OBJTYPE(stx,ref))
{
case BYTEOBJ:
hv = qse_stx_hashbytes (
stx,
&BYTEAT(stx,ref,0),
OBJSIZE(stx,ref)
);
break;
case CHAROBJ:
/* the additional null is not taken into account */
hv = qse_stx_hashbytes (
stx,
&CHARAT(stx,ref,0),
OBJSIZE(stx,ref) * QSE_SIZEOF(qse_char_t)
);
break;
case WORDOBJ:
hv = qse_stx_hashbytes (
stx,
&WORDAT(stx,ref,0),
OBJSIZE(stx,ref) * QSE_SIZEOF(qse_word_t)
);
break;
default:
QSE_ASSERT (
!"This should never happen"
);
break;
}
}
return hv;
}
#if 0
qse_word_t qse_stx_instantiate (
qse_stx_t* stx, qse_stx_objref_t class, const void* data,
const void* variable_data, qse_word_t variable_nflds)
{
qse_stx_class_t* class_ptr;
qse_word_t spec, nflds, inst;
int indexable;
QSE_ASSERT (class != stx->class_smallinteger);
class_ptr = (qse_stx_class_t*)QSE_STX_OBJPTR(stx, class);
/* don't instantiate a metaclass whose instance must be
created in a different way */
/* TODO: maybe delete the following line */
QSE_ASSERT (QSE_STX_CLASS(class) != stx->class_metaclass);
QSE_ASSERT (QSE_STX_ISSMALLINT(class_obj->spec));
spec = QSE_STX_FROMSMALLINT(class_obj->spec);
nflds = (spec >> QSE_STX_SPEC_INDEXABLE_BITS);
indexable = spec & QSE_STX_SPEC_INDEXABLE_MASK;
switch (indexable)
{
case QSE_STX_SPEC_BYTE_INDEXABLE:
/* variable-size byte class */
QSE_ASSERT (nflds == 0 && data == QSE_NULL);
inst = qse_stx_alloc_byte_object(
stx, variable_data, variable_nflds);
break;
case QSE_STX_SPEC_CHAR_INDEXABLE:
/* variable-size char class */
QSE_ASSERT (nflds == 0 && data == QSE_NULL);
inst = qse_stx_alloc_char_objectx(
stx, variable_data, variable_nflds);
break;
case QSE_STX_SPEC_WORD_INDEXABLE:
/* variable-size class */
inst = qse_stx_alloc_word_object (
stx, data, nflds, variable_data, variable_nflds);
break;
case QSE_STX_SPEC_FIXED:
/* fixed size */
QSE_ASSERT (indexable == QSE_STX_SPEC_NOT_INDEXABLE);
QSE_ASSERT (variable_nflds == 0 && variable_data == QSE_NULL);
inst = qse_stx_alloc_word_object (
stx, data, nflds, QSE_NULL, 0);
break;
default:
/* this should never happen */
QSE_ASSERTX (0, "this should never happen");
inst = QSE_STX_OBJREF_INVALID;
}
if (inst != QSE_STX_OBJREF_INVALID)
QSE_STX_CLASSOF(stx,inst) = class;
return inst;
}
qse_word_t qse_stx_class (qse_stx_t* stx, qse_stx_objref_t obj)
{
return QSE_STX_ISSMALLINT(obj)?

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

@ -29,26 +29,7 @@ qse_word_t qse_stx_alloccharobj (
qse_word_t variable_nflds
);
qse_word_t qse_stx_hashobj (
qse_stx_t* stx,
qse_word_t ref
);
#if 0
qse_word_t qse_stx_alloc_word_object (
qse_stx_t* stx, const qse_word_t* data, qse_word_t nfields,
const qse_word_t* variable_data, qse_word_t variable_nfields);
qse_word_t qse_stx_alloc_byte_object (
qse_stx_t* stx, const qse_byte_t* data, qse_word_t n);
qse_word_t qse_stx_alloc_char_object (
qse_stx_t* stx, const qse_char_t* str);
qse_word_t qse_stx_alloc_char_objectx (
qse_stx_t* stx, const qse_char_t* str, qse_word_t n);
qse_word_t qse_stx_allocn_char_object (qse_stx_t* stx, ...);
qse_word_t qse_stx_instantiate (
qse_stx_t* stx, qse_word_t class_index, const void* data,
const void* variable_data, qse_word_t variable_nfields);

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

@ -12,17 +12,18 @@ typedef qse_word_t qse_stx_objidx_t;
typedef struct qse_stx_objhdr_t qse_stx_objhdr_t; /* object header */
typedef struct qse_stx_object_t qse_stx_object_t; /* abstract object */
typedef struct qse_stx_object_t* qse_stx_objptr_t; /* object pointer */
typedef struct qse_stx_byteobj_t* qse_stx_byteobjptr_t;
typedef struct qse_stx_charobj_t* qse_stx_charobjptr_t;
typedef struct qse_stx_wordobj_t* qse_stx_wordobjptr_t;
typedef struct qse_stx_byteobj_t qse_stx_byteobj_t;
typedef struct qse_stx_charobj_t qse_stx_charobj_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
@ -105,13 +106,6 @@ struct qse_stx_t
qse_stx_objptr_t* free;
} mem;
struct
{
qse_size_t capa;
qse_size_t size;
qse_word_t* slot;
} symtab;
struct
{
qse_word_t nil;
@ -132,7 +126,8 @@ struct qse_stx_t
qse_word_t class_string;
qse_word_t class_character;
qse_word_t class_context;
qse_word_t class_system_dictionary;
qse_word_t class_systemsymboltable;
qse_word_t class_systemdictionary;
qse_word_t class_method;
qse_word_t class_smallinteger;
} ref;
@ -180,11 +175,11 @@ struct qse_stx_t
#define QSE_STX_OBJCLASS(stx,ref) (QSE_STX_PTRBYREF(stx,ref)->h._class)
#define QSE_STX_WORDAT(stx,ref,pos) \
(((qse_stx_wordobjptr_t)QSE_STX_PTRBYREF(stx,ref))->fld[pos])
(((qse_stx_wordobj_t*)QSE_STX_PTRBYREF(stx,ref))->fld[pos])
#define QSE_STX_BYTEAT(stx,ref,pos) \
(((qse_stx_byteobjptr_t)QSE_STX_PTRBYREF(stx,ref))->fld[pos])
(((qse_stx_byteobj_t*)QSE_STX_PTRBYREF(stx,ref))->fld[pos])
#define QSE_STX_CHARAT(stx,ref,pos) \
(((qse_stx_charobjptr_t)QSE_STX_PTRBYREF(stx,ref))->fld[pos])
(((qse_stx_charobj_t*)QSE_STX_PTRBYREF(stx,ref))->fld[pos])
/* REDEFINITION DROPPING PREFIX FOR INTERNAL USE */
#define REFISINT(stx,x) QSE_STX_REFISINT(stx,x)
@ -210,61 +205,14 @@ struct qse_stx_t
#define CHAROBJ QSE_STX_CHAROBJ
#define WORDOBJ QSE_STX_WORDOBJ
#if 0
/* hardcoded object reference */
#define QSE_STX_NIL(stx) QSE_STX_IDXTOREF(stx,0)
#define QSE_STX_TRUE(stx) QSE_STX_IDXTOREF(stx,1)
#define QSE_STX_FALSE(stx) QSE_STX_IDXTOREF(stx,2)
#define QSE_STX_DATA(stx,idx) ((void*)(QSE_STX_OBJPTR(stx,idx) + 1))
#endif
#if 0
#define QSE_STX_WORD_INDEXED (0x00)
#define QSE_STX_BYTE_INDEXED (0x01)
#define QSE_STX_CHAR_INDEXED (0x02)
/* this type has nothing to do with
* the indexability of the object... */
enum qse_stx_objtype_t
{
QSE_STX_OBJTYPE_BYTE,
QSE_STX_OBJTYPE_CHAR,
QSE_STX_OBJTYPE_WORD
};
#define QSE_STX_ISWORDOBJECT(stx,idx) \
(QSE_STX_TYPE(stx,idx) == QSE_STX_WORD_INDEXED)
#define QSE_STX_ISBYTEOBJECT(stx,idx) \
(QSE_STX_TYPE(stx,idx) == QSE_STX_BYTE_INDEXED)
#define QSE_STX_ISCHAROBJECT(stx,idx) \
(QSE_STX_TYPE(stx,idx) == QSE_STX_CHAR_INDEXED)
#define QSE_STX_WORDOBJPTR(stx,idx) \
((qse_stx_word_object_t*)QSE_STX_OBJPTR(stx,idx))
#define QSE_STX_BYTEOBJPTR(stx,idx) \
((qse_stx_byte_object_t*)QSE_STX_OBJPTR(stx,idx))
#define QSE_STX_CHAROBJPTR(stx,idx) \
((qse_stx_char_object_t*)QSE_STX_OBJPTR(stx,idx))
#define QSE_STX_WORD_AT(stx,idx,n) \
(QSE_STX_WORD_OBJECT(stx,idx)->data[n])
#define QSE_STX_BYTE_AT(stx,idx,n) \
(QSE_STX_BYTE_OBJECT(stx,idx)->data[n])
#define QSE_STX_CHAR_AT(stx,idx,n) \
(QSE_STX_CHAR_OBJECT(stx,idx)->data[n])
#endif
/* SOME INTERNAL MACRO DEFINITIONS */
#define SYMTAB_INIT_CAPA 256
#define SYSDIC_INIT_CAPA 256
#ifdef __cplusplus
extern "C" {
#endif
/*
*
*/
#ifdef __cplusplus
}
#endif

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

@ -16,25 +16,95 @@ struct qse_stx_symtab_t
typedef struct qse_stx_symtab_t qse_stx_symtab_t;
qse_word_t qse_stx_newsymbol (
static qse_word_t expand (qse_stx_t* stx, qse_word_t tabref)
{
qse_word_t oldcapa, newcapa;
qse_word_t newtab;
qse_stx_symtab_t* oldptr, * newptr;
QSE_ASSERTX (
REFISIDX(stx,tabref),
"The reference is not an object index"
);
/* This function can handle expansion of an object whose class is
* SystemSymbolTable. During initial bootstrapping, the class of
* the stock symbol table (stx->ref.symtab) may not be set properly.
* You must make sure that expansion is not triggered until its class
* is set. If this assertion fails, you must increase the value of
* SYMTAB_INIT_CAPA.
*/
QSE_ASSERT (OBJCLASS(stx,tabref) == stx->ref.class_systemsymboltable);
/* get the current table capacity being the size of the object
* excluding the tally field. */
oldcapa = OBJSIZE(stx,tabref) - 1;
/* instantiate a new symbol table with its capacity doubled. */
newcapa = oldcapa * 2;
newtab = qse_stx_instantiate (
stx, OBJCLASS(stx,tabref),
QSE_NULL, QSE_NULL, newcapa + 1
);
if (newtab == stx->ref.nil) return stx->ref.nil;
oldptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref);
newptr = (qse_stx_symtab_t*)PTRBYREF(stx,newtab);
newptr->tally = INTTOREF (stx, 0);
while (oldcapa > 0)
{
qse_word_t symbol;
symbol = oldptr->slot[--oldcapa];
if (symbol != stx->ref.nil)
{
qse_word_t index;
QSE_ASSERT (REFISIDX(stx,symbol));
QSE_ASSERT (OBJCLASS(stx,symbol) == stx->ref.class_symbol);
QSE_ASSERT (OBJTYPE(stx,symbol) == CHAROBJ);
/* qse_stx_newsymbol uses qse_stx_hashstr().
* this function uses qse_stx_hashobj().
* both must return the same value */
QSE_ASSERT (qse_stx_hashobj (stx, symbol) ==
qse_stx_hashstr (stx, &CHARAT(stx,symbol,0)));
index = qse_stx_hashobj (stx, symbol) % newcapa;
while (newptr->slot[index] != stx->ref.nil)
index = (index + 1) % newcapa;
newptr->slot[index] = symbol;
}
}
qse_stx_swapmem (stx, REFTOIDX(stx,tabref), REFTOIDX(stx,newtab));
newptr->tally = oldptr->tally;
return tabref;
}
static qse_word_t new_symbol (
qse_stx_t* stx, qse_word_t tabref, const qse_char_t* name)
{
qse_stx_symtab_t* tabptr;
qse_word_t symref;
qse_word_t capa, hash, tally;
qse_word_t capa, hash, index, tally;
/* the table must have at least one slot excluding the tally field */
QSE_ASSERT (OBJSIZE(stx,tabref) > 1);
capa = OBJSIZE(stx,tabref) - 1; /* exclude the tally field */
hash = qse_stx_hashstr (stx, name) % capa;
hash = qse_stx_hashstr (stx, name);
index = hash % capa;
tabptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref);
tally = REFTOINT(stx, tabptr->tally);
do
{
symref = tabptr->slot[hash];
/*symref = WORDAT (stx, tabref, index + 1);*/
symref = tabptr->slot[index];
if (symref == stx->ref.nil) break; /* not found */
QSE_ASSERT (REFISIDX(stx,symref));
@ -46,20 +116,31 @@ qse_word_t qse_stx_newsymbol (
name) == 0) return symref;*/
if (qse_strcmp (&CHARAT(stx,symref,0), name) == 0) return symref;
hash = (hash + 1) % capa;
index = (index + 1) % capa;
}
while (0);
/* symbol is not found. let's create a new symbol */
tally = REFTOINT(stx, tabptr->tally);
/* check if the symbol table is getting full soon */
if (tally + 1 >= capa)
{
/* Enlarge the symbol table before it gets full to make sure that
* it has at least one free slot. */
/* Enlarge the symbol table before it gets full to
* make sure that it has at least one free slot left
* after having added a new symbol. this is to help
* traversal end at a nil slot if no entry is found. */
if (expand (stx, tabref) == stx->ref.nil) return stx->ref.nil;
#if 0
if (grow (stx, tab) <= -1) return -1;
/* refresh tally */
tally = REFTOINT (stx, tabptr->tally);
#endif
/* refresh the object pointer */
tabptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref);
/* refersh capacity and hash index */
capa = OBJSIZE(stx,tabref) - 1; /* exclude the tally field */
index = hash % capa;
/* after expansion, the tally must still be the same */
QSE_ASSERT (tally == REFTOINT (stx, tabptr->tally));
}
symref = qse_stx_alloccharobj (stx, name, qse_strlen(name));
@ -67,105 +148,18 @@ qse_word_t qse_stx_newsymbol (
{
OBJCLASS(stx,symref) = stx->ref.class_symbol;
tabptr->tally = INTTOREF (stx, tally + 1);
tabptr->slot[hash] = symref;
tabptr->slot[index] = symref;
}
return symref;
}
qse_word_t qse_stx_newsymbol (qse_stx_t* stx, const qse_char_t* name)
{
return new_symbol (stx, stx->ref.symtab, name);
}
#if 0
#include "stx.h"
static int __grow_symtab (qse_stx_t* stx)
{
qse_word_t capa, ncapa, i, j;
qse_word_t* nspace;
capa = stx->symtab.capa;
ncapa = capa << 1; /* double the capacity */
/* TODO: allocate symbol table from stx->mem......... */
nspace = (qse_word_t*) QSE_MMGR_ALLOC (
stx->mmgr, ncapa * QSE_SIZEOF(*nspace)
);
if (nspace == QSE_NULL)
{
/* TODO: handle memory error */
qse_stx_seterrnum (stx, QSE_STX_ENOMEM);
return -1;
}
for (i = 0; i < capa; i++)
{
qse_word_t x = stx->symtab.slot[i];
if (x == stx->nil) continue;
j = qse_stx_strxhash (
QSE_STX_DATA(stx,x), QSE_STX_SIZE(stx,x)) % ncapa;
while (1)
{
if (nspace[j] == stx->nil)
{
nspace[j] = x;
break;
}
j = (j % ncapa) + 1;
}
}
stx->symtab.capa = ncapa;
QSE_MMGR_FREE (stx->mmgr, stx->symtab.slot);
stx->symtab.slot = nspace;
return 0;
}
qse_word_t qse_stx_newsym (qse_stx_t* stx, const qse_char_t* name)
{
return qse_stx_newsymwithlen (stx, name, qse_strlen(name));
}
qse_word_t qse_stx_newsymwithlen (qse_stx_t* stx, const qse_char_t* name, qse_word_t len)
{
qse_word_t capa, hash, index, size, x;
capa = stx->symtab.capa;
size = stx->symtab.size;
if (capa <= size + 1)
{
if (__grow_symtab (stx) <= -1)
{
/* TODO: .... */
}
capa = stx->symtab.capa;
}
hash = qse_stx_strxhash(name,len);
index = hash % stx->symtab.capa;
while (1)
{
x = stx->symtab.slot[index];
if (x == stx->nil)
{
/* insert a new item into an empty slot */
x = qse_stx_alloc_char_objectx (stx, name, len);
QSE_STX_CLASS(stx,x) = stx->class_symbol;
stx->symtab.slot[index] = x;
stx->symtab.size++;
break;
}
if (qse_strxncmp (name, len, QSE_STX_DATA(stx,x), QSE_STX_SIZE(stx,x)) == 0) break;
index = (index % stx->symtab.capa) + 1;
}
return x;
}
void qse_stx_traverse_symbol_table (
qse_stx_t* stx, void (*func) (qse_stx_t*,qse_word_t,void*), void* data)
{

3
qse/lib/stx/sym.h
View File

@ -5,7 +5,7 @@
#ifndef _QSE_LIB_STX_SYM_H_
#define _QSE_LIB_STX_SYM_H_
/* The SystemSymbolTable is a word variable class.
/* The SystemSymbolTable is a variable word class.
* The info below is for the fixed part only */
#define QSE_STX_SYMTAB_SIZE 1
#define QSE_STX_SYMTAB_TALLY 0
@ -16,7 +16,6 @@ extern "C" {
qse_word_t qse_stx_newsymbol (
qse_stx_t* stx,
qse_word_t tabref,
const qse_char_t* name
);