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

revised bootstrapping code

Browse Source
This commit is contained in:
hyung-hwan 2011-06-18 10:17:18 +00:00
parent c7b3ece237
commit 682cfc1949
17 changed files with 491 additions and 955 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
qse/lib/stx/array.c
View File

@ -1,18 +0,0 @@
/*
* $Id: array.c 118 2008-03-03 11:21:33Z baconevi $
*/
#include <qse/stx/array.h>
#include <qse/stx/object.h>
#include <qse/bas/assert.h>
qse_word_t qse_stx_new_array (qse_stx_t* stx, qse_word_t size)
{
qse_word_t x;
qse_assert (stx->class_array != stx->nil);
x = qse_stx_alloc_word_object (stx, QSE_NULL, 0, QSE_NULL, size);
QSE_STX_CLASS(stx,x) = stx->class_array;
return x;
}

21
qse/lib/stx/array.h
View File

@ -1,21 +0,0 @@
/*
* $Id: array.h 118 2008-03-03 11:21:33Z baconevi $
*/
#ifndef _QSE_STX_ARRAY_H_
#define _QSE_STX_ARRAY_H_
#include <qse/stx/stx.h>
#ifdef __cplusplus
extern "C" {
#endif
qse_word_t qse_stx_new_array (qse_stx_t* stx, qse_word_t size);
#ifdef __cplusplus
}
#endif
#endif

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

@ -5,22 +5,6 @@
#include "stx.h"
#include <qse/cmn/str.h>
static int make_intrinsic_classes (qse_stx_t* stx);
static qse_word_t __make_classvar_dic (
qse_stx_t* stx, qse_word_t class, const qse_char_t* names);
static void __filein_kernel (qse_stx_t* stx);
static qse_word_t __count_names (const qse_char_t* str);
static void __set_names (
qse_stx_t* stx, qse_word_t* array, const qse_char_t* str);
static qse_word_t __count_subclasses (const qse_char_t* str);
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);
struct class_info_t
{
const qse_char_t* name;
@ -39,7 +23,7 @@ static class_info_t class_info[] =
QSE_T("Object"),
QSE_NULL,
QSE_NULL,
QSE_NULL,
QSE_T("classvar1 classvar2")/*QSE_NULL TODO: delete this.....*/,
QSE_NULL,
SPEC_FIXED_WORD
},
@ -54,7 +38,7 @@ static class_info_t class_info[] =
{
QSE_T("Behavior"),
QSE_T("Object"),
QSE_T("spec methods superclass"),
QSE_T("spec methods superclass subclasses"),
QSE_NULL,
QSE_NULL,
SPEC_FIXED_WORD
@ -280,164 +264,94 @@ 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 x;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_string));
QSE_ASSERT (!ISNIL(stx,stx->ref.class_string));
x = qse_stx_alloccharobj (stx, str, qse_strlen(str));
if (x != stx->ref.nil) OBJCLASS(stx,x) = stx->ref.class_string;
return x;
return qse_stx_instantiate (
stx, stx->ref.class_string, QSE_NULL, str, qse_strlen(str));
}
static int make_intrinsic_classes (qse_stx_t* stx)
qse_word_t QSE_INLINE new_array (qse_stx_t* stx, qse_word_t capa)
{
class_info_t* p;
qse_word_t n;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_array));
QSE_ASSERT (!ISNIL(stx,stx->ref.class_array));
for (p = class_info; p->name != QSE_NULL; p++)
return qse_stx_instantiate (
stx, stx->ref.class_array, QSE_NULL, QSE_NULL, capa);
}
qse_word_t QSE_INLINE new_systemdictionary (qse_stx_t* stx, qse_word_t capa)
{
qse_word_t classref;
qse_stx_class_t* classptr;
qse_word_t nfixed;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_systemdictionary));
QSE_ASSERT (!ISNIL(stx,stx->ref.class_systemdictionary));
classref = qse_stx_findclass(stx, p->name);
if (ISNIL(stx,classref))
/* the system dictionary uses 1 slot dedicated for nil.
* so we request to allocate 1 more slot than the given */
return qse_stx_instantiate (
stx, stx->ref.class_systemdictionary,
QSE_NULL, QSE_NULL, capa + 1);
}
qse_word_t new_class (qse_stx_t* stx, const qse_char_t* name)
{
classref = qse_stx_newclass (stx, p->name);
if (ISNIL(stx,classref)) return NIL(stx);
qse_word_t meta, class, assoc;
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 (ISNIL(stx,meta)) 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,SPEC_MAKE(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 (ISNIL(stx,class_name)) return stx->ref.nil;
WORDAT(stx,class,QSE_STX_CLASS_NAME) = class_name;
WORDAT(stx,class,QSE_STX_CLASS_SPEC) = stx->ref.nil;
assoc = qse_stx_putdic (stx, stx->ref.sysdic, class_name, class);
return (ISNIL(stx,assoc))? stx->ref.nil: class;
}
classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
if (p->superclass)
qse_word_t find_class (qse_stx_t* stx, const qse_char_t* name)
{
classptr->superclass = qse_stx_findclass(stx,p->superclass);
QSE_ASSERT (!ISNIL(stx,classptr->superclass));
}
qse_word_t assoc, meta, value;
nfixed = 0;
/* resolve the number of fixed fields in the superclass chain */
if (p->superclass)
/* look up the system dictionary for the name given */
assoc = qse_stx_lookupdic (stx, stx->ref.sysdic, name);
if (ISNIL(stx,assoc))
{
qse_word_t superref;
qse_stx_class_t* superptr;
/*qse_stx_seterrnum (stx, QSE_STX_ENOCLASS, QSE_NULL);*/
return stx->ref.nil;
}
qse_word_t metaref;
qse_stx_metaclass_t* metaptr;
/* get the value part in the association for the name */
value = WORDAT(stx,assoc,QSE_STX_ASSOCIATION_VALUE);
superref = qse_stx_findclass (stx, p->superclass);
QSE_ASSERT (!ISNIL(stx,superref));
metaref = OBJCLASS(stx,classref);
metaptr = (qse_stx_metaclass_t*)PTRBYREF(stx,metaref);
metaptr->superclass = OBJCLASS(stx,superref);
metaptr->instance_class = classref;
do
/* 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)
{
superptr = (qse_stx_class_t*)PTRBYREF(stx,superref);
nfixed += SPEC_GETFIXED(REFTOINT(stx,superptr->spec));
superref = superptr->superclass;
}
while (!ISNIL(stx,superref));
/*qse_stx_seterrnum (stx, QSE_STX_ENOTCLASS, QSE_NULL);*/
return stx->ref.nil;
}
/* add the number of instance variables to the number of
* fixed fields */
if (p->instance_variables)
{
nfixed += __count_names (p->instance_variables);
classptr->variables =
new_string (stx, p->instance_variables);
if (ISNIL(stx,classptr->variables)) return -1;
return value;
}
QSE_ASSERT (
nfixed <= 0 ||
(nfixed > 0 && (p->spec == SPEC_FIXED_WORD ||
p->spec == SPEC_VARIABLE_WORD)));
classptr->spec = SPEC_MAKE (nfixed, p->spec);
}
for (p = class_info; p->name != QSE_NULL; p++)
{
qse_word_t classref;
qse_stx_class_t* classptr;
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)
{
classptr->class_variables =
__make_classvar_dic(stx, classref, p->class_variables);
if (ISNIL(stx,classptr->class_variables)) return NIL(stx);
}
/*
TODO:
if (p->pool_dictionaries != QSE_NULL) {
classptr->pool_dictionaries =
__make_pool_dictionary(stx, class, p->pool_dictionaries);
}
*/
}
/* fill subclasses */
for (p = class_info; p->name != QSE_NULL; p++)
{
qse_word_t classref;
qse_stx_class_t* classptr;
qse_word_t array;
n = __count_subclasses (p->name);
array = qse_stx_newarray (stx, n);
if (ISNIL(stx,array)) return NIL(stx);
__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 */
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);
array = qse_stx_new_array (stx, n);
__set_metaclass_subclasses (stx, &WORDAT(stx,array,0), p->name);
classref = qse_stx_findclass (stx, p->name);
QSE_ASSERT (!ISNIL(stx,classref));
metaref = OBJCLASS(stx,classref);
metaptr = (qse_stx_metaclass_t*)PTRBYREF(stx,metaref);
metaptr->subclasses = array;
}
return 0;
}
static qse_word_t __count_names (const qse_char_t* str)
static qse_word_t count_names (const qse_char_t* str)
{
qse_word_t n = 0;
const qse_char_t* p = str;
@ -458,30 +372,7 @@ static qse_word_t __count_names (const qse_char_t* str)
return n;
}
static void __set_names (
qse_stx_t* stx, qse_word_t* array, const qse_char_t* str)
{
qse_word_t n = 0;
const qse_char_t* p = str;
const qse_char_t* name;
do
{
while (*p == QSE_T(' ') ||
*p == QSE_T('\t')) p++;
if (*p == QSE_T('\0')) break;
name = p;
while (*p != QSE_T(' ') &&
*p != QSE_T('\t') &&
*p != QSE_T('\0')) p++;
array[n++] = qse_stx_newsymbolx (stx, name, p - name);
}
while (1);
}
static qse_word_t __count_subclasses (const qse_char_t* str)
static qse_word_t count_subclasses (const qse_char_t* str)
{
class_info_t* p;
qse_word_t n = 0;
@ -495,7 +386,7 @@ static qse_word_t __count_subclasses (const qse_char_t* str)
return n;
}
static void __set_subclasses (
static void set_subclasses (
qse_stx_t* stx, qse_word_t* array, const qse_char_t* str)
{
class_info_t* p;
@ -505,13 +396,13 @@ static void __set_subclasses (
{
if (p->superclass == QSE_NULL) continue;
if (qse_strcmp (str, p->superclass) != 0) continue;
class = qse_stx_findclass (stx, p->name);
class = find_class (stx, p->name);
QSE_ASSERT (!ISNIL(stx,class));
array[n++] = class;
}
}
static void __set_metaclass_subclasses (
static void set_metaclass_subclasses (
qse_stx_t* stx, qse_word_t* array, const qse_char_t* str)
{
class_info_t* p;
@ -521,13 +412,13 @@ static void __set_metaclass_subclasses (
{
if (p->superclass == QSE_NULL) continue;
if (qse_strcmp (str, p->superclass) != 0) continue;
class = qse_stx_findclass (stx, p->name);
class = find_class (stx, p->name);
QSE_ASSERT (!ISNIL(stx,class));
array[n++] = OBJCLASS(stx,class);
}
}
static qse_word_t __make_classvar_dic (
static qse_word_t make_classvar_dic (
qse_stx_t* stx, qse_word_t class, const qse_char_t* names)
{
qse_word_t dic, symbol, assoc;
@ -535,10 +426,8 @@ static qse_word_t __make_classvar_dic (
const qse_char_t* name;
/* TODO: how to implement temporary GC prevention....???? */
dic = qse_stx_instantiate (
stx, stx->ref.class_systemdictionary,
QSE_NULL, QSE_NULL, __count_names(names));
if (ISNIL(stx,dic)) return NIL(stx);
dic = new_systemdictionary (stx, count_names(names));
if (ISNIL(stx,dic)) return stx->ref.nil;
do
{
@ -552,25 +441,16 @@ static qse_word_t __make_classvar_dic (
*p != QSE_T('\0')) p++;
symbol = qse_stx_newsymbolx (stx, name, p - name);
if (ISNIL(stx,symbol)) return NIL(stx);
if (ISNIL(stx,symbol)) return stx->ref.nil;
assoc = qse_stx_putdic (stx, dic, symbol, stx->ref.nil);
if (ISNIL(stx,assoc)) return NIL(stx);
if (ISNIL(stx,assoc)) return stx->ref.nil;
}
while (1);
return dic;
}
static void __filein_kernel (qse_stx_t* stx)
{
class_info_t* p;
for (p = class_info; p->name != QSE_NULL; p++) {
/* TODO: */
}
}
static int sketch_nil (qse_stx_t* stx)
{
qse_stx_objidx_t idx;
@ -597,12 +477,13 @@ static int sketch_nil (qse_stx_t* stx)
ptr->h._class = stx->ref.nil; /* the class is yet to be set */
ptr->h._backref = ref;
return 0;
}
#define ALLOC_WORDOBJ_TO(stx,var,nflds,nvflds) QSE_BLOCK (\
var = qse_stx_allocwordobj ((stx), QSE_NULL, (nflds), QSE_NULL, nvflds); \
if ((var) == (stx)->ref.nil) return -1; \
if (ISNIL(stx,(var))) return -1; \
)
#define ADD_TO_SYSDIC(stx,key,value) QSE_BLOCK (\
@ -611,12 +492,12 @@ static int sketch_nil (qse_stx_t* stx)
#define NEW_SYMBOL_TO(stx,var,name) QSE_BLOCK (\
var = qse_stx_newsymbol ((stx), name); \
if (var == (stx)->ref.nil) return -1; \
if (ISNIL(stx,(var))) return -1; \
)
#define NEW_CLASS_TO(stx,var,name) QSE_BLOCK (\
var = qse_stx_newclass ((stx), name); \
if (var == (stx)->ref.nil) return -1; \
var = new_class ((stx), name); \
if (ISNIL(stx,(var))) return -1; \
)
static int sketch_key_objects (qse_stx_t* stx)
@ -628,21 +509,28 @@ static int sketch_key_objects (qse_stx_t* stx)
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);
ALLOC_WORDOBJ_TO (stx, stx->ref.false, 0, 0);
QSE_ASSERT (REFISIDX(stx,stx->ref.nil));
/* create a symbol table partially initialized */
/* Create a symbol table partially initialized.
* Especially, the class of the symbol table is not set yet.
* It must be corrected later */
/* TODO: initial symbol table size */
ALLOC_WORDOBJ_TO (stx, stx->ref.symtab, 1, SYMTAB_INIT_CAPA);
/* set tally to 0. */
/* Set tally to 0. */
WORDAT(stx,stx->ref.symtab,QSE_STX_SYMTAB_TALLY) = INTTOREF(stx,0);
/* global system dictionary */
/* Create a global system dictionary partially initialized.
* Especially, the class of the system dictionary is not set yet.
* It must be corrected later */
/* TODO: initial dictionary size */
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);
/* Set tally to 0 */
WORDAT(stx,stx->ref.sysdic,QSE_STX_SYSTEMDICTIONARY_TALLY) = INTTOREF(stx,0);
/* Create a few critical class objects needed for maintaining
* the symbol table and the system dictionary. At this point,
* new_class() cannot be used yet. So the process is
* pretty mundane as shown below. */
/* Symbol */
ALLOC_WORDOBJ_TO (stx, stx->ref.class_symbol, QSE_STX_CLASS_SIZE, 0);
@ -663,18 +551,18 @@ static int sketch_key_objects (qse_stx_t* stx)
ALLOC_WORDOBJ_TO (stx, class_AssociationMeta, QSE_STX_METACLASS_SIZE, 0);
/* (Symbol class) setClass: Metaclass */
QSE_STX_OBJCLASS(stx,class_SymbolMeta) = stx->ref.class_metaclass;
OBJCLASS(stx,class_SymbolMeta) = stx->ref.class_metaclass;
/* (Metaclass class) setClass: Metaclass */
QSE_STX_OBJCLASS(stx,class_MetaclassMeta) = stx->ref.class_metaclass;
OBJCLASS(stx,class_MetaclassMeta) = stx->ref.class_metaclass;
/* (Association class) setClass: Metaclass */
QSE_STX_OBJCLASS(stx,class_AssociationMeta) = stx->ref.class_metaclass;
OBJCLASS(stx,class_AssociationMeta) = stx->ref.class_metaclass;
/* Symbol setClass: (Symbol class) */
QSE_STX_OBJCLASS(stx,stx->ref.class_symbol) = class_SymbolMeta;
OBJCLASS(stx,stx->ref.class_symbol) = class_SymbolMeta;
/* Metaclass setClass: (Metaclass class) */
QSE_STX_OBJCLASS(stx,stx->ref.class_metaclass) = class_MetaclassMeta;
OBJCLASS(stx,stx->ref.class_metaclass) = class_MetaclassMeta;
/* Association setClass: (Association class) */
QSE_STX_OBJCLASS(stx,stx->ref.class_association) = class_AssociationMeta;
OBJCLASS(stx,stx->ref.class_association) = class_AssociationMeta;
/* (Symbol class) setSpec: CLASS_SIZE */
WORDAT(stx,class_SymbolMeta,QSE_STX_CLASS_SPEC) =
@ -687,7 +575,7 @@ static int sketch_key_objects (qse_stx_t* stx)
INTTOREF (stx, SPEC_MAKE(QSE_STX_CLASS_SIZE,SPEC_FIXED_WORD));
/* specs for class_metaclass, class_association,
* class_symbol are set later in make_builtin_classes */
* class_symbol are set later in make_intrinsic_classes */
/* #Symbol */
NEW_SYMBOL_TO (stx, symbol_symbol, QSE_T("Symbol"));
@ -703,6 +591,14 @@ static int sketch_key_objects (qse_stx_t* stx)
/* Association setName: #Association */
WORDAT(stx,stx->ref.class_association,QSE_STX_CLASS_NAME) = symbol_association;
/* propagte the spec field in advance */
WORDAT(stx,stx->ref.class_symbol,QSE_STX_CLASS_SPEC) =
INTTOREF (stx, SPEC_MAKE(0,SPEC_VARIABLE_CHAR));
WORDAT(stx,stx->ref.class_metaclass,QSE_STX_CLASS_SPEC) =
INTTOREF (stx, SPEC_MAKE(QSE_STX_METACLASS_SIZE,SPEC_FIXED_WORD));
WORDAT(stx,stx->ref.class_association,QSE_STX_CLASS_SPEC) =
INTTOREF (stx, SPEC_MAKE(QSE_STX_ASSOCIATION_SIZE,SPEC_FIXED_WORD));
/* register class names into the system dictionary */
ADD_TO_SYSDIC (stx, symbol_symbol, stx->ref.class_symbol);
ADD_TO_SYSDIC (stx, symbol_metaclass, stx->ref.class_metaclass);
@ -711,11 +607,12 @@ static int sketch_key_objects (qse_stx_t* stx)
return 0;
}
int make_key_classes (qse_stx_t* stx)
static int make_key_classes (qse_stx_t* stx)
{
/* object, class, and array are precreated for easier instantiation
* of intrinsic classes */
* of intrinsic classes. */
NEW_CLASS_TO (stx, stx->ref.class_object, QSE_T("Object"));
NEW_CLASS_TO (stx, stx->ref.class_undefinedobject, QSE_T("UndefinedObject"));
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"));
@ -726,65 +623,272 @@ int make_key_classes (qse_stx_t* stx)
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"));
/* set the spec field in advance so that new_string() and new_array()
* can call qse_stx_instantiate() from this point onwards */
WORDAT(stx,stx->ref.class_string,QSE_STX_CLASS_SPEC) =
INTTOREF (stx, SPEC_MAKE(0,SPEC_VARIABLE_CHAR));
WORDAT(stx,stx->ref.class_array,QSE_STX_CLASS_SPEC) =
INTTOREF (stx, SPEC_MAKE(0,SPEC_VARIABLE_WORD));
return 0;
}
static void set_class_of_more_key_objects (qse_stx_t* stx)
{
/* nil setClass: UndefinedObject */
OBJCLASS(stx,stx->ref.nil) = stx->ref.class_undefinedobject;
/* sysdic(Smalltalk) setClass: SystemDictionary */
OBJCLASS(stx,stx->ref.sysdic) = stx->ref.class_systemdictionary;
/* symtab setClass: SystemSymbolTable */
OBJCLASS(stx,stx->ref.symtab) = stx->ref.class_systemsymboltable;
}
static int make_intrinsic_classes (qse_stx_t* stx)
{
class_info_t* p;
QSE_ASSERT (!ISNIL(stx,stx->ref.class_array));
for (p = class_info; p->name != QSE_NULL; p++)
{
qse_word_t classref;
qse_stx_class_t* classptr;
qse_word_t nfixed;
qse_word_t spec;
classref = find_class(stx, p->name);
if (ISNIL(stx,classref))
{
classref = new_class (stx, p->name);
if (ISNIL(stx,classref)) return stx->ref.nil;
}
classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
if (p->superclass)
{
classptr->superclass = find_class(stx,p->superclass);
QSE_ASSERT (!ISNIL(stx,classptr->superclass));
}
nfixed = 0;
/* resolve the number of fixed fields in the superclass chain */
if (p->superclass)
{
qse_word_t superref;
qse_stx_class_t* superptr;
qse_word_t metaref;
qse_stx_metaclass_t* metaptr;
superref = find_class (stx, p->superclass);
QSE_ASSERT (!ISNIL(stx,superref));
metaref = OBJCLASS(stx,classref);
metaptr = (qse_stx_metaclass_t*)PTRBYREF(stx,metaref);
metaptr->superclass = OBJCLASS(stx,superref);
metaptr->instance_class = classref;
do
{
superptr = (qse_stx_class_t*)PTRBYREF(stx,superref);
nfixed += SPEC_GETFIXED(REFTOINT(stx,superptr->spec));
superref = superptr->superclass;
}
while (!ISNIL(stx,superref));
}
/* add the number of instance variables to the number of
* fixed fields */
if (p->instance_variables)
{
nfixed += count_names (p->instance_variables);
classptr->variables =
new_string (stx, p->instance_variables);
if (ISNIL(stx,classptr->variables)) return -1;
}
QSE_ASSERT (
nfixed <= 0 ||
(nfixed > 0 && (p->spec == SPEC_FIXED_WORD ||
p->spec == SPEC_VARIABLE_WORD)));
spec = INTTOREF (stx, SPEC_MAKE (nfixed, p->spec));
QSE_ASSERTX (ISNIL(stx,classptr->spec) || classptr->spec == spec,
"If the specfication field is already set before this function, "
"the specification in the class information table must match it. "
"Otherwise, something is very wrong");
classptr->spec = spec;
}
/* make class variable dictionaries and pool dictionaries */
for (p = class_info; p->name; p++)
{
qse_word_t classref;
qse_stx_class_t* classptr;
classref = find_class (stx, p->name);
QSE_ASSERT (!ISNIL(stx,classref));
classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
if (p->class_variables)
{
classptr->class_variables =
make_classvar_dic(stx, classref, p->class_variables);
if (ISNIL(stx,classptr->class_variables)) return stx->ref.nil;
}
/*
TODO:
if (p->pool_dictionaries != QSE_NULL) {
classptr->pool_dictionaries =
__make_pool_dictionary(stx, class, p->pool_dictionaries);
}
*/
}
/* fill subclasses */
for (p = class_info; p->name != QSE_NULL; p++)
{
qse_word_t classref;
qse_stx_class_t* classptr;
qse_word_t array;
qse_word_t n;
n = count_subclasses (p->name);
array = new_array (stx, n);
if (ISNIL(stx,array)) return -1;
set_subclasses (stx, &WORDAT(stx,array,0), p->name);
classref = find_class (stx, p->name);
QSE_ASSERT (!ISNIL(stx,classref));
classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
classptr->subclasses = array;
}
/* fill subclasses for metaclasses */
for (p = class_info; p->name != QSE_NULL; p++)
{
qse_word_t classref;
qse_word_t metaref;
qse_stx_metaclass_t* metaptr;
qse_word_t array;
qse_word_t n;
n = count_subclasses (p->name);
array = new_array (stx, n);
if (ISNIL(stx,array)) return -1;
set_metaclass_subclasses (stx, &WORDAT(stx,array,0), p->name);
classref = find_class (stx, p->name);
QSE_ASSERT (!ISNIL(stx,classref));
metaref = OBJCLASS(stx,classref);
metaptr = (qse_stx_metaclass_t*)PTRBYREF(stx,metaref);
metaptr->subclasses = array;
}
return 0;
}
static void make_metaclass_top_hierarchy (qse_stx_t* stx)
{
qse_word_t metaclass_of_object;
/* make the superclass of Object class to be Class */
/* metaclass_of_object := Object class */
metaclass_of_object = OBJCLASS (stx, stx->ref.class_object);
/* (Object class) setSuperclass: Class */
WORDAT(stx,metaclass_of_object,QSE_STX_METACLASS_SUPERCLASS) = stx->ref.class_class;
/* Set the instance class for Object here as it is not
* set in make_intrisic_classes */
WORDAT(stx,metaclass_of_object,QSE_STX_METACLASS_INSTANCE_CLASS) = stx->ref.class_object;
}
static int make_key_objects_accessible_by_name (qse_stx_t* stx)
{
qse_word_t tmp;
#if 0
/* create #nil, #true, #false */
NEW_SYMBOL_TO (stx, tmp, QSE_T("nil"));
NEW_SYMBOL_TO (stx, tmp, QSE_T("true"));
NEW_SYMBOL_TO (stx, tmp, QSE_T("false"));
#endif
NEW_SYMBOL_TO (stx, tmp, QSE_T("Smalltalk"));
/* Smalltalk at: #Smalltalk put: stx->ref.sysdic */
ADD_TO_SYSDIC (stx, tmp, stx->ref.sysdic);
NEW_SYMBOL_TO (stx, tmp, QSE_T("SymbolTable"));
/* Smalltalk at: #SymbolTable put: stx->ref.sysdic */
ADD_TO_SYSDIC (stx, tmp, stx->ref.symtab);
return 0;
}
static int make_true_and_false (qse_stx_t* stx)
{
stx->ref.true = qse_stx_instantiate (
stx, find_class(stx,QSE_T("True")),
QSE_NULL, QSE_NULL, 0
);
if (ISNIL(stx,stx->ref.true)) return -1;
stx->ref.false = qse_stx_instantiate (
stx, find_class(stx,QSE_T("False")),
QSE_NULL, QSE_NULL, 0
);
if (ISNIL(stx,stx->ref.false)) return -1;
return 0;
}
static void filein_kernel_source (qse_stx_t* stx)
{
class_info_t* p;
for (p = class_info; p->name != QSE_NULL; p++)
{
/* TODO: */
}
}
int qse_stx_boot (qse_stx_t* stx)
{
qse_word_t symbol_smalltalk;
qse_word_t object_meta;
/* create a partially initialized nil object for bootstrapping */
if (sketch_nil (stx) <= -1) goto oops;
/* create nil, true, false references */
if (sketch_nil (stx) <= -1) return -1;
/* continue intializing other key objects */
if (sketch_key_objects (stx) <= -1) goto oops;
if (sketch_key_objects (stx) <= -1) return -1;
if (make_key_classes (stx) <= -1) goto oops;
if (make_key_classes (stx) <= -1) return -1;
if (make_intrisic_classes (stx) <= -1) goto oops;
set_class_of_more_key_objects (stx);
if (make_intrinsic_classes (stx) <= -1) return -1;
make_metaclass_top_hierarchy (stx);
if (make_key_objects_accessible_by_name (stx) <= -1) return -1;
if (make_true_and_false (stx) <= -1) return -1;
return 0;
#if 0
/* (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;
/* instance class for Object is set here as it is not
* set in make_intrisic_classes */
QSE_STX_WORD_AT(stx,object_meta,QSE_STX_METACLASS_INSTANCE_CLASS) = stx->class_object;
/* for some fun here */
{
qse_word_t array;
array = qse_stx_new_array (stx, 1);
QSE_STX_WORD_AT(stx,array,0) = object_meta;
QSE_STX_WORD_AT(stx,stx->class_class,QSE_STX_CLASS_SUBCLASSES) = array;
}
/* more initialization */
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 */
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 */
OBJCLASS(stx,stx->ref.nil) = qse_stx_findclass (stx, QSE_T("UndefinedObject"));
/* true setClass: True */
OBJCLASS(stx,stx->ref.true) = qse_stx_findclass (stx, QSE_T("True"));
/* fales setClass: False */
OBJCLASS(stx,stx->ref.false) = qse_stx_findclass (stx, QSE_T("False"));
__filein_kernel (stx);
return 0;
#endif
oops:
return -1;
}

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

@ -1,66 +1,9 @@
/*
* $Id: class.c 118 2008-03-03 11:21:33Z baconevi $
* $Id$
*/
#include "stx.h"
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,SPEC_MAKE(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,
@ -189,7 +132,6 @@ qse_word_t qse_stx_instantiate (
qse_word_t spec, nflds, inst;
int variable;
QSE_ASSERT (REFISIDX(stx,classref));
/* don't instantiate a metaclass whose instance must be
@ -197,6 +139,7 @@ qse_word_t qse_stx_instantiate (
QSE_ASSERT (OBJCLASS(stx,classref) != stx->ref.class_metaclass);
classptr = (qse_stx_class_t*)PTRBYREF(stx,classref);
qse_printf (QSE_T("instantiating ... %s\n"), ((qse_stx_charobj_t*)PTRBYREF(stx,classptr->name))->fld);
QSE_ASSERT (REFISINT(stx,classptr->spec));
spec = REFTOINT(stx,classptr->spec);

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

@ -56,8 +56,8 @@ typedef struct qse_stx_metaclass_t qse_stx_metaclass_t;
#define SPEC_VARIABLE_BYTE 0x02
#define SPEC_VARIABLE_CHAR 0x03
#define SPEC_MAKE(fixed,variable) \
(((fixed) << SPEC_VARIABLE_BITS) | (variable))
#define SPEC_MAKE(nfixed,variable) \
(((nfixed) << SPEC_VARIABLE_BITS) | (variable))
#define SPEC_GETFIXED(spec) ((spec) >> SPEC_VARIABLE_BITS)

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

@ -10,15 +10,15 @@
* Dictionary, on the contrary, can accept any object as a key.
*/
struct qse_stx_assoc_t
struct qse_stx_association_t
{
qse_stx_objhdr_t h;
qse_word_t key;
qse_word_t value;
};
typedef struct qse_stx_assoc_t qse_stx_assoc_t;
typedef struct qse_stx_association_t qse_stx_association_t;
struct qse_stx_dic_t
struct qse_stx_systemdictionary_t
{
qse_stx_objhdr_t h;
qse_word_t tally;
@ -26,30 +26,46 @@ struct qse_stx_dic_t
/* variable part begins here */
qse_word_t slot[1];
};
typedef struct qse_stx_dic_t qse_stx_dic_t;
typedef struct qse_stx_systemdictionary_t qse_stx_systemdictionary_t;
static qse_word_t new_assoc (
static qse_word_t new_association (
qse_stx_t* stx, qse_word_t key, qse_word_t value)
{
#if 0
qse_word_t x;
x = qse_stx_allocwordobj (
stx, QSE_NULL, QSE_STX_ASSOC_SIZE, QSE_NULL, 0);
if (x == stx->ref.nil) return stx->ref.nil;
stx, QSE_NULL, QSE_STX_ASSOCIATION_SIZE, QSE_NULL, 0);
if (ISNIL(stx,x)) return stx->ref.nil;
OBJCLASS(stx,x) = stx->ref.class_association;
WORDAT(stx,x,QSE_STX_ASSOC_KEY) = key;
WORDAT(stx,x,QSE_STX_ASSOC_VALUE) = value;
WORDAT(stx,x,QSE_STX_ASSOCIATION_KEY) = key;
WORDAT(stx,x,QSE_STX_ASSOCIATION_VALUE) = value;
return x;
#endif
qse_word_t x;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_association));
QSE_ASSERT (!ISNIL(stx,stx->ref.class_association));
x = qse_stx_instantiate (
stx, stx->ref.class_association, QSE_NULL, QSE_NULL, 0);
if (!ISNIL(stx,x))
{
WORDAT(stx,x,QSE_STX_ASSOCIATION_KEY) = key;
WORDAT(stx,x,QSE_STX_ASSOCIATION_VALUE) = value;
}
return x;
}
static qse_word_t expand (qse_stx_t* stx, qse_word_t dic)
{
qse_word_t oldcapa, newdic, newcapa;
qse_stx_dic_t* oldptr, * newptr;
qse_stx_systemdictionary_t* oldptr, * newptr;
QSE_ASSERT (REFISIDX(stx,stx->ref.class_systemdictionary));
QSE_ASSERT (stx->ref.class_systemdictionary != stx->ref.nil);
QSE_ASSERT (!ISNIL(stx,stx->ref.class_systemdictionary));
QSE_ASSERTX (
REFISIDX(stx,dic),
@ -74,11 +90,11 @@ static qse_word_t expand (qse_stx_t* stx, qse_word_t dic)
stx, OBJCLASS(stx,dic),
QSE_NULL, QSE_NULL, newcapa
);
if (newdic == stx->ref.nil) return stx->ref.nil;
if (ISNIL(stx,newdic)) return stx->ref.nil;
/* 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);
oldptr = (qse_stx_systemdictionary_t*)PTRBYREF(stx,dic);
newptr = (qse_stx_systemdictionary_t*)PTRBYREF(stx,newdic);
newptr->tally = INTTOREF(stx,0);
QSE_ASSERT (newcapa == OBJSIZE(stx,newdic)-1);
@ -89,12 +105,12 @@ static qse_word_t expand (qse_stx_t* stx, qse_word_t dic)
qse_word_t assoc;
assoc = oldptr->slot[--oldcapa];
if (assoc != stx->ref.nil)
if (!ISNIL(stx,assoc))
{
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 = qse_stx_hashobj (stx, WORDAT(stx,assoc,QSE_STX_ASSOCIATION_KEY)) % newcapa;
while (!ISNIL(stx,newptr->slot[index]))
index = (index + 1) % newcapa;
newptr->slot[index] = assoc;
}
@ -112,13 +128,13 @@ static qse_word_t find_basic_index (
qse_stx_t* stx, qse_word_t dic, qse_word_t key)
{
qse_word_t capa, index;
qse_stx_dic_t* dicptr;
qse_stx_systemdictionary_t* dicptr;
/* ensure that dic is a system dictionary */
QSE_ASSERT (REFISIDX(stx,dic));
QSE_ASSERT (OBJTYPE(stx,dic) == WORDOBJ);
QSE_ASSERT (dic == stx->ref.sysdic ||
OBJCLASS(stx,key) == stx->ref.class_systemdictionary);
OBJCLASS(stx,dic) == stx->ref.class_systemdictionary);
/* ensure that the key is a symbol */
QSE_ASSERT (REFISIDX(stx,key));
@ -128,16 +144,16 @@ static qse_word_t find_basic_index (
capa = OBJSIZE(stx,dic) - 1; /* exclude the tally field */
index = qse_stx_hashobj (stx, key) % capa;
dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
dicptr = (qse_stx_systemdictionary_t*)PTRBYREF(stx,dic);
do
{
qse_word_t assoc, sym;
assoc = dicptr->slot[index];
if (assoc == stx->ref.nil) break; /* not found */
if (ISNIL(stx,assoc)) break; /* not found */
sym = WORDAT (stx, assoc, QSE_STX_ASSOC_KEY);
sym = WORDAT (stx, assoc, QSE_STX_ASSOCIATION_KEY);
/* make sure that the key is a symbol */
QSE_ASSERT (REFISIDX(stx,sym));
@ -163,7 +179,7 @@ qse_word_t qse_stx_lookupdic (
qse_stx_t* stx, qse_word_t dic, const qse_char_t* skey)
{
qse_word_t capa, index;
qse_stx_dic_t* dicptr;
qse_stx_systemdictionary_t* dicptr;
QSE_ASSERT (REFISIDX(stx,dic));
QSE_ASSERT (OBJTYPE(stx,dic) == WORDOBJ);
@ -173,16 +189,16 @@ qse_word_t qse_stx_lookupdic (
capa = OBJSIZE(stx,dic) - 1; /* exclude the tally field */
index = qse_stx_hashstr (stx, skey) % capa;
dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
dicptr = (qse_stx_systemdictionary_t*)PTRBYREF(stx,dic);
do
{
qse_word_t assoc, keyref;
assoc = dicptr->slot[index];
if (assoc == stx->ref.nil) break; /* not found */
if (ISNIL(stx,assoc)) break; /* not found */
keyref = WORDAT(stx,assoc,QSE_STX_ASSOC_KEY);
keyref = WORDAT(stx,assoc,QSE_STX_ASSOCIATION_KEY);
QSE_ASSERT (REFISIDX(stx,keyref));
QSE_ASSERT (OBJCLASS(stx,keyref) == stx->ref.class_symbol);
@ -209,13 +225,13 @@ qse_word_t qse_stx_putdic (
qse_stx_t* stx, qse_word_t dic, qse_word_t key, qse_word_t value)
{
qse_word_t index, capa, tally, assoc;
qse_stx_dic_t* dicptr;
qse_stx_systemdictionary_t* dicptr;
/* the dicionary must have at least one slot excluding tally */
QSE_ASSERT (OBJSIZE(stx,dic) > 1);
capa = OBJSIZE(stx,dic) - 1;
dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
dicptr = (qse_stx_systemdictionary_t*)PTRBYREF(stx,dic);
tally = REFTOINT(stx,dicptr->tally);
index = find_basic_index (stx, dic, key) - 1;
@ -223,7 +239,7 @@ qse_word_t qse_stx_putdic (
/*assoc = WORDAT(stx,dic,slot);*/
if (assoc == stx->ref.nil)
if (ISNIL(stx,assoc))
{
/* the key is not found */
@ -235,10 +251,10 @@ 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 (expand (stx, dic) == stx->ref.nil) return stx->ref.nil;
if (ISNIL(stx, expand (stx, dic))) return stx->ref.nil;
capa = OBJSIZE(stx,dic) - 1;
dicptr = (qse_stx_dic_t*)PTRBYREF(stx,dic);
dicptr = (qse_stx_systemdictionary_t*)PTRBYREF(stx,dic);
/* tally must remain the same after expansion */
QSE_ASSERT (tally == REFTOINT(stx,dicptr->tally));
@ -246,11 +262,11 @@ qse_word_t qse_stx_putdic (
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);
QSE_ASSERT (ISNIL(stx,dicptr->slot[index]));
}
assoc = new_assoc (stx, key, value);
if (assoc == stx->ref.nil) return stx->ref.nil;
assoc = new_association (stx, key, value);
if (ISNIL(stx,assoc)) return stx->ref.nil;
dicptr->slot[index] = assoc;
dicptr->tally = INTTOREF(stx,tally+1);
@ -258,7 +274,7 @@ qse_word_t qse_stx_putdic (
else
{
/* found the key. change the value */
WORDAT(stx,assoc,QSE_STX_ASSOC_VALUE) = value;
WORDAT(stx,assoc,QSE_STX_ASSOCIATION_VALUE) = value;
}
return assoc;

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

@ -5,14 +5,14 @@
#ifndef _QSE_LIB_STX_DIC_H_
#define _QSE_LIB_STX_DIC_H_
#define QSE_STX_ASSOC_SIZE 2
#define QSE_STX_ASSOC_KEY 0
#define QSE_STX_ASSOC_VALUE 1
#define QSE_STX_ASSOCIATION_SIZE 2
#define QSE_STX_ASSOCIATION_KEY 0
#define QSE_STX_ASSOCIATION_VALUE 1
/* 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
#define QSE_STX_SYSTEMDICTIONARY_SIZE 1
#define QSE_STX_SYSTEMDICTIONARY_TALLY 0
#ifdef __cplusplus
extern "C"

194
qse/lib/stx/dict.c
View File

@ -1,194 +0,0 @@
/*
* $Id: dict.c 118 2008-03-03 11:21:33Z baconevi $
*/
#include <qse/stx/dict.h>
#include <qse/stx/object.h>
#include <qse/stx/misc.h>
/* NOTE:
* The code here implements SystemDictionary whose key is always a symbol.
* Dictionary, on the contrary, can accept any object as a key.
*/
qse_word_t __new_association (
qse_stx_t* stx, qse_word_t key, qse_word_t value)
{
qse_word_t x;
qse_word_t data[2];
data[0] = key;
data[1] = value;
x = qse_stx_alloc_word_object (
stx, data, QSE_STX_ASSOCIATION_SIZE, QSE_NULL, 0);
QSE_STX_CLASS(stx,x) = stx->class_association;
return x;
}
static qse_word_t __dict_find_slot (
qse_stx_t* stx, qse_word_t dict, qse_word_t key)
{
qse_word_t size, hash, index, assoc, symbol;
qse_stx_word_object_t* dict_obj;
qse_assert (!QSE_STX_ISSMALLINT(dict) &&
QSE_STX_ISWORDOBJECT(stx, dict));
qse_assert (dict == stx->smalltalk ||
qse_stx_classof(stx,dict) == stx->class_system_dictionary);
qse_assert (qse_stx_classof(stx,key) == stx->class_symbol);
size = QSE_STX_SIZE(stx,dict);
hash = qse_stx_hash_object(stx, key);
/* consider tally, the only instance variable of a system dictionary */
index = hash % (size - 1) + 1;
dict_obj = QSE_STX_WORD_OBJECT(stx,dict);
while (1) {
assoc = dict_obj->data[index];
if (assoc == stx->nil) break;
symbol = QSE_STX_WORD_AT(stx,assoc,QSE_STX_ASSOCIATION_KEY);
qse_assert (qse_stx_classof(stx,symbol) == stx->class_symbol);
/* NOTE:
* shallow comparison is enough for identity check
* because a symbol can just be a key of a system dictionary
*/
if (qse_strxncmp(
QSE_STX_DATA(stx,key), QSE_STX_SIZE(stx,key),
QSE_STX_DATA(stx,symbol), QSE_STX_SIZE(stx,symbol)) == 0) break;
/* consider tally here too */
index = index % (size - 1) + 1;
}
return index;
}
static void __grow_dict (qse_stx_t* stx, qse_word_t dict)
{
qse_word_t new, size, index, assoc;
/* WARNING:
* if this assertion fails, adjust the initial size of the
* system dictionary. i don't want this function to be called
* during the bootstrapping.
*/
qse_assert (stx->class_system_dictionary != stx->nil);
qse_assert (qse_stx_classof(stx,dict) == stx->class_system_dictionary);
size = QSE_STX_SIZE(stx,dict);
new = qse_stx_instantiate (stx,
QSE_STX_CLASS(stx,dict), QSE_NULL, QSE_NULL, (size - 1) * 2);
QSE_STX_WORD_AT(stx,new,0) = QSE_STX_TO_SMALLINT(0);
for (index = 1; index < size; index++) {
assoc = QSE_STX_WORD_AT(stx,dict,index);
if (assoc == stx->nil) continue;
qse_stx_dict_put (stx, new,
QSE_STX_WORD_AT(stx,assoc,QSE_STX_ASSOCIATION_KEY),
QSE_STX_WORD_AT(stx,assoc,QSE_STX_ASSOCIATION_VALUE));
}
/* TODO: explore if dict can be immediately destroyed. */
qse_assert (qse_sizeof(qse_stx_object_t*) == qse_sizeof(qse_uint_t));
QSE_SWAP (
QSE_STX_OBJPTR(stx,dict),
QSE_STX_OBJPTR(stx,new),
qse_stx_object_t*,
qse_uint_t
);
}
qse_word_t qse_stx_dict_lookup (
qse_stx_t* stx, qse_word_t dict, const qse_char_t* key)
{
qse_word_t size, hash, index, assoc, symbol;
qse_stx_word_object_t* dict_obj;
qse_assert (!QSE_STX_ISSMALLINT(dict) &&
QSE_STX_ISWORDOBJECT(stx, dict));
qse_assert (dict == stx->smalltalk ||
qse_stx_classof(stx,dict) == stx->class_system_dictionary);
size = QSE_STX_SIZE(stx,dict);
hash = qse_stx_hash(key, qse_strlen(key) * qse_sizeof(qse_char_t));
/* consider tally, the only instance variable of a system dictionary */
index = hash % (size - 1) + 1;
dict_obj = QSE_STX_WORD_OBJECT(stx,dict);
while (1)
{
assoc = dict_obj->data[index];
if (assoc == stx->nil) break;
symbol = QSE_STX_WORD_AT(stx,assoc,QSE_STX_ASSOCIATION_KEY);
qse_assert (qse_stx_classof(stx,symbol) == stx->class_symbol);
if (qse_strxcmp (QSE_STX_DATA(stx,symbol),
QSE_STX_SIZE(stx,symbol), key) == 0) break;
/* consider tally here too */
index = index % (size - 1) + 1;
}
return QSE_STX_WORD_AT(stx,dict,index);
}
qse_word_t qse_stx_dict_get (qse_stx_t* stx, qse_word_t dict, qse_word_t key)
{
return QSE_STX_WORD_AT(stx,dict,__dict_find_slot(stx, dict, key));
}
qse_word_t qse_stx_dict_put (
qse_stx_t* stx, qse_word_t dict, qse_word_t key, qse_word_t value)
{
qse_word_t slot, capa, tally, assoc;
/* the dictionary must have at least one slot excluding tally */
qse_assert (QSE_STX_SIZE(stx,dict) > 1);
capa = QSE_STX_SIZE(stx,dict) - 1;
tally = QSE_STX_FROMSMALLINT(QSE_STX_WORD_AT(stx,dict,0));
if (capa <= tally + 1)
{
__grow_dict (stx, dict);
/* refresh tally */
tally = QSE_STX_FROMSMALLINT(QSE_STX_WORD_AT(stx,dict,0));
}
slot = __dict_find_slot (stx, dict, key);
assoc = QSE_STX_WORD_AT(stx,dict,slot);
if (assoc == stx->nil)
{
QSE_STX_WORD_AT(stx,dict,slot) =
__new_association (stx, key, value);
QSE_STX_WORD_AT(stx,dict,0) = QSE_STX_TO_SMALLINT(tally + 1);
}
else QSE_STX_WORD_AT(stx,assoc,QSE_STX_ASSOCIATION_VALUE) = value;
return QSE_STX_WORD_AT(stx,dict,slot);
}
void qse_stx_dict_traverse (
qse_stx_t* stx, qse_word_t dict,
void (*func) (qse_stx_t*,qse_word_t,void*), void* data)
{
qse_word_t index, assoc;
qse_word_t size = QSE_STX_SIZE(stx,dict);
for (index = 1; index < size; index++) {
assoc = QSE_STX_WORD_AT(stx,dict,index);
if (assoc == stx->nil) continue;
func (stx, assoc, data);
}
}

42
qse/lib/stx/dict.h
View File

@ -1,42 +0,0 @@
/*
* $Id: dict.h 118 2008-03-03 11:21:33Z baconevi $
*/
#ifndef _QSE_STX_DICT_H_
#define _QSE_STX_DICT_H_
#include <qse/stx/stx.h>
#define QSE_STX_ASSOCIATION_SIZE 2
#define QSE_STX_ASSOCIATION_KEY 0
#define QSE_STX_ASSOCIATION_VALUE 1
struct qse_stx_association_t
{
qse_stx_objhdr_t header;
qse_word_t key;
qse_word_t value;
};
typedef struct qse_stx_association_t qse_stx_association_t;
#ifdef __cplusplus
extern "C"
#endif
qse_word_t qse_stx_dict_lookup (
qse_stx_t* stx, qse_word_t dict, const qse_char_t* key);
qse_word_t qse_stx_dict_get (
qse_stx_t* stx, qse_word_t dict, qse_word_t key);
qse_word_t qse_stx_dict_put (
qse_stx_t* stx, qse_word_t dict, qse_word_t key, qse_word_t value);
void qse_stx_dict_traverse (
qse_stx_t* stx, qse_word_t dict,
void (*func) (qse_stx_t*,qse_word_t,void*), void* data);
#ifdef __cplusplus
}
#endif
#endif

98
qse/lib/stx/memory.c
View File

@ -1,98 +0,0 @@
/*
* $Id: memory.c 118 2008-03-03 11:21:33Z baconevi $
*/
#include <qse/stx/memory.h>
#include <qse/stx/misc.h>
qse_stx_memory_t* qse_stx_memory_open (
qse_stx_memory_t* mem, qse_word_t capacity)
{
qse_stx_object_t** slots;
qse_word_t n;
qse_assert (capacity > 0);
if (mem == QSE_NULL) {
mem = (qse_stx_memory_t*)qse_malloc(qse_sizeof(qse_stx_memory_t));
if (mem == QSE_NULL) return QSE_NULL;
mem->__dynamic = qse_true;
}
else mem->__dynamic = qse_false;
slots = (qse_stx_object_t**)qse_malloc (
capacity * qse_sizeof(qse_stx_object_t*));
if (slots == QSE_NULL) {
if (mem->__dynamic) qse_free (mem);
mem = QSE_NULL;
}
mem->capacity = capacity;
mem->slots = slots;
/* weave the free slot list */
mem->free = &slots[0];
for (n = 0; n < capacity - 1; n++) {
mem->slots[n] = (qse_stx_object_t*)&mem->slots[n + 1];
}
mem->slots[n] = QSE_NULL;
return mem;
}
void qse_stx_memory_close (qse_stx_memory_t* mem)
{
/* TODO: free all linked objects... */
qse_free (mem->slots);
mem->capacity = 0;
mem->slots = QSE_NULL;
mem->free = QSE_NULL;
if (mem->__dynamic) qse_free (mem);
}
void qse_stx_memory_gc (qse_stx_memory_t* mem)
{
/* TODO: implement this function */
}
qse_word_t qse_stx_memory_alloc (qse_stx_memory_t* mem, qse_word_t nbytes)
{
qse_stx_object_t** slot;
qse_stx_object_t* object;
/* find the free object slot */
if (mem->free == QSE_NULL) {
qse_stx_memory_gc (mem);
if (mem->free == QSE_NULL) return mem->capacity;;
}
object = (qse_stx_object_t*)qse_malloc (nbytes);
if (object == QSE_NULL) {
qse_stx_memory_gc (mem);
object = (qse_stx_object_t*)qse_malloc (nbytes);
/*if (object == QSE_NULL) return mem->capacity;*/
if (object == QSE_NULL) {
qse_assert (QSE_T("MEMORY ALLOCATION ERROR\n") == QSE_NULL);
exit (1);
}
}
slot = mem->free;
mem->free = (qse_stx_object_t**)*slot;
*slot = object;
return (qse_word_t)(slot - mem->slots);
}
void qse_stx_memory_dealloc (qse_stx_memory_t* mem, qse_word_t object_index)
{
/*
* THIS IS PRIMITIVE LOW-LEVEL DEALLOC. THIS WILL NOT
* DEALLOCATE MEMORY ALLOCATED FOR ITS INSTANCE VARIABLES.
*/
qse_free (mem->slots[object_index]);
mem->slots[object_index] = (qse_stx_object_t*)mem->free;
mem->free = &mem->slots[object_index];
}

39
qse/lib/stx/memory.h
View File

@ -1,39 +0,0 @@
/*
* $Id: memory.h 118 2008-03-03 11:21:33Z baconevi $
*/
#ifndef _QSE_STX_MEMORY_H_
#define _QSE_STX_MEMORY_H_
#include <qse/stx/stx.h>
#ifdef __cplusplus
extern "C" {
#endif
qse_stx_memory_t* qse_stx_initmem (
qse_stx_memory_t* mem,
qse_word_t capacity
);
void qse_stx_finimem (
qse_stx_memory_t* mem
);
void qse_stx_gcmem (
qse_stx_memory_t* mem
);
qse_word_t qse_stx_alloc (
qse_stx_memory_t* mem, qse_word_t size
);
void qse_stx_memory_dealloc (
qse_stx_memory_t* mem, qse_word_t object_index
);
#ifdef __cplusplus
}
#endif
#endif

45
qse/lib/stx/parser.c
View File

@ -1008,39 +1008,47 @@ static int __parse_primary_ident (
*is_super = qse_false;
if (qse_strcmp(ident, QSE_T("self")) == 0) {
if (qse_strcmp(ident, QSE_T("self")) == 0)
{
EMIT_CODE (parser, PUSH_RECEIVER);
return 0;
}
else if (qse_strcmp(ident, QSE_T("super")) == 0) {
else if (qse_strcmp(ident, QSE_T("super")) == 0)
{
*is_super = qse_true;
EMIT_CODE (parser, PUSH_RECEIVER);
return 0;
}
else if (qse_strcmp(ident, QSE_T("nil")) == 0) {
else if (qse_strcmp(ident, QSE_T("nil")) == 0)
{
EMIT_CODE (parser, PUSH_NIL);
return 0;
}
else if (qse_strcmp(ident, QSE_T("true")) == 0) {
else if (qse_strcmp(ident, QSE_T("true")) == 0)
{
EMIT_CODE (parser, PUSH_TRUE);
return 0;
}
else if (qse_strcmp(ident, QSE_T("false")) == 0) {
else if (qse_strcmp(ident, QSE_T("false")) == 0)
{
EMIT_CODE (parser, PUSH_FALSE);
return 0;
}
/* Refer to __parse_assignment for identifier lookup */
for (i = 0; i < parser->temporary_count; i++) {
if (qse_strcmp(ident, parser->temporaries[i]) == 0) {
for (i = 0; i < parser->temporary_count; i++)
{
if (qse_strcmp(ident, parser->temporaries[i]) == 0)
{
EMIT_PUSH_TEMPORARY_LOCATION (parser, i);
return 0;
}
}
if (qse_stx_get_instance_variable_index (
stx, parser->method_class, ident, &i) == 0) {
stx, parser->method_class, ident, &i) == 0)
{
EMIT_PUSH_RECEIVER_VARIABLE (parser, i);
return 0;
}
@ -1074,20 +1082,25 @@ static int __parse_block_constructor (qse_stx_parser_t* parser)
* <block argument> ::= ':' identifier
*/
if (parser->token.type == QSE_STX_TOKEN_COLON) {
do {
if (parser->token.type == QSE_STX_TOKEN_COLON)
{
do
{
GET_TOKEN (parser);
if (parser->token.type != QSE_STX_TOKEN_IDENT) {
if (parser->token.type != QSE_STX_TOKEN_IDENT)
{
parser->error_code = QSE_STX_PARSER_ERROR_BLOCK_ARGUMENT_NAME;
return -1;
}
/* TODO : store block arguments */
GET_TOKEN (parser);
} while (parser->token.type == QSE_STX_TOKEN_COLON);
}
while (parser->token.type == QSE_STX_TOKEN_COLON);
if (!__is_vbar_token(&parser->token)) {
if (!__is_vbar_token(&parser->token))
{
parser->error_code = QSE_STX_PARSER_ERROR_BLOCK_ARGUMENT_LIST;
return -1;
}
@ -1099,7 +1112,8 @@ static int __parse_block_constructor (qse_stx_parser_t* parser)
if (__parse_temporaries(parser) == -1) return -1;
if (__parse_block_statements(parser) == -1) return -1;
if (parser->token.type != QSE_STX_TOKEN_RBRACKET) {
if (parser->token.type != QSE_STX_TOKEN_RBRACKET)
{
parser->error_code = QSE_STX_PARSER_ERROR_BLOCK_NOT_CLOSED;
return -1;
}
@ -1123,7 +1137,8 @@ static int __parse_message_continuation (
*/
if (__parse_keyword_message(parser, is_super) == -1) return -1;
while (parser->token.type == QSE_STX_TOKEN_SEMICOLON) {
while (parser->token.type == QSE_STX_TOKEN_SEMICOLON)
{
EMIT_CODE_TEST (parser, QSE_T("DoSpecial(DUP_RECEIVER(CASCADE))"), QSE_T(""));
GET_TOKEN (parser);

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

@ -120,6 +120,7 @@ struct qse_stx_t
qse_word_t class_association;
qse_word_t class_object;
qse_word_t class_undefinedobject;
qse_word_t class_class;
qse_word_t class_array;
qse_word_t class_bytearray;

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

@ -49,7 +49,7 @@ static qse_word_t expand (qse_stx_t* stx, qse_word_t tabref)
stx, OBJCLASS(stx,tabref),
QSE_NULL, QSE_NULL, newcapa
);
if (ISNIL(stx,newtab)) return NIL(stx);
if (ISNIL(stx,newtab)) return stx->ref.nil;
oldptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref);
newptr = (qse_stx_symtab_t*)PTRBYREF(stx,newtab);
@ -91,7 +91,7 @@ static qse_word_t expand (qse_stx_t* stx, qse_word_t tabref)
static qse_word_t new_symbol (
qse_stx_t* stx, qse_word_t tabref, const qse_char_t* name)
qse_stx_t* stx, qse_word_t tabref, const qse_char_t* name, qse_size_t len)
{
qse_stx_symtab_t* tabptr;
qse_word_t symref;
@ -135,7 +135,7 @@ static qse_word_t new_symbol (
* 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 (ISNIL (stx, expand (stx, tabref))) return NIL(stx);
if (ISNIL (stx, expand (stx, tabref))) return stx->ref.nil;
/* refresh the object pointer */
tabptr = (qse_stx_symtab_t*)PTRBYREF(stx,tabref);
@ -148,7 +148,7 @@ static qse_word_t new_symbol (
QSE_ASSERT (tally == REFTOINT (stx, tabptr->tally));
}
symref = qse_stx_alloccharobj (stx, name, qse_strlen(name));
symref = qse_stx_alloccharobj (stx, name, len);
if (!ISNIL(stx,symref))
{
OBJCLASS(stx,symref) = stx->ref.class_symbol;
@ -161,7 +161,12 @@ static qse_word_t new_symbol (
qse_word_t qse_stx_newsymbol (qse_stx_t* stx, const qse_char_t* name)
{
return new_symbol (stx, stx->ref.symtab, name);
return new_symbol (stx, stx->ref.symtab, name, qse_strlen(name));
}
qse_word_t qse_stx_newsymbolx (qse_stx_t* stx, const qse_char_t* name, qse_size_t len)
{
return new_symbol (stx, stx->ref.symtab, name, len);
}
#if 0

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

@ -19,6 +19,12 @@ qse_word_t qse_stx_newsymbol (
const qse_char_t* name
);
qse_word_t qse_stx_newsymbolx (
qse_stx_t* stx,
const qse_char_t* name,
qse_size_t len
);
#ifdef __cplusplus
}
#endif

102
qse/lib/stx/symbol.c
View File

@ -1,102 +0,0 @@
/*
* $Id: symbol.c 118 2008-03-03 11:21:33Z baconevi $
*/
#include <qse/stx/symbol.h>
#include <qse/stx/object.h>
#include <qse/stx/misc.h>
static void __grow_symtab (qse_stx_t* stx)
{
qse_word_t capa, ncapa, i, j;
qse_word_t* nspace;
capa = stx->symtab.capacity;
ncapa = capa << 1;
nspace = (qse_word_t*)qse_malloc(qse_sizeof(qse_word_t) * ncapa);
if (nspace == QSE_NULL)
{
/* TODO: handle memory error */
}
for (i = 0; i < capa; i++)
{
qse_word_t x = stx->symtab.datum[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.capacity = ncapa;
qse_free (stx->symtab.datum);
stx->symtab.datum = nspace;
}
qse_word_t qse_stx_new_symbol (qse_stx_t* stx, const qse_char_t* name)
{
return qse_stx_new_symbolx (stx, name, qse_strlen(name));
}
qse_word_t qse_stx_new_symbolx (
qse_stx_t* stx, const qse_char_t* name, qse_word_t len)
{
qse_word_t capa, hash, index, size, x;
capa = stx->symtab.capacity;
size = stx->symtab.size;
if (capa <= size + 1)
{
__grow_symtab (stx);
capa = stx->symtab.capacity;
}
hash = qse_stx_strxhash(name,len);
index = hash % stx->symtab.capacity;
while (1)
{
x = stx->symtab.datum[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.datum[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.capacity) + 1;
}
return x;
}
void qse_stx_traverse_symbol_table (
qse_stx_t* stx, void (*func) (qse_stx_t*,qse_word_t,void*), void* data)
{
qse_word_t index, x;
for (index = 0; index < stx->symtab.capacity; index++)
{
x = stx->symtab.datum[index];
if (x != stx->nil) func (stx, x, data);
}
}

40
qse/lib/stx/symbol.h
View File

@ -1,40 +0,0 @@
/*
* $Id: symbol.h 118 2008-03-03 11:21:33Z baconevi $
*/
#ifndef _QSE_STX_SYMBOL_H_
#define _QSE_STX_SYMBOL_H_
#include <qse/stx/stx.h>
#define QSE_STX_SYMLINK_SIZE 2
#define QSE_STX_SYMLINK_LINK 0
#define QSE_STX_SYMLINK_SYMBOL 1
struct qse_stx_symlink_t
{
qse_stx_objhdr_t header;
qse_word_t link;
qse_word_t symbol;
};
typedef struct qse_stx_symlink_t qse_stx_symlink_t;
#ifdef __cplusplus
extern "C" {
#endif
qse_word_t qse_stx_new_symbol_link (qse_stx_t* stx, qse_word_t sym);
qse_word_t qse_stx_new_symbol (
qse_stx_t* stx, const qse_char_t* name);
qse_word_t qse_stx_new_symbolx (
qse_stx_t* stx, const qse_char_t* name, qse_word_t len);
void qse_stx_traverse_symbol_table (
qse_stx_t* stx, void (*func) (qse_stx_t*,qse_word_t,void*), void* data);
#ifdef __cplusplus
}
#endif
#endif