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

*** empty log message ***

Browse Source
This commit is contained in:
hyung-hwan 2005-05-25 16:44:05 +00:00
parent 0d2505aee8
commit f7eceec648
6 changed files with 108 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
ase/stx/bootstrp.c
View File

@ -1,5 +1,5 @@
/*
* $Id: bootstrp.c,v 1.6 2005-05-24 03:29:43 bacon Exp $
* $Id: bootstrp.c,v 1.7 2005-05-25 16:44:05 bacon Exp $
*/
#include <xp/stx/bootstrp.h>
@ -47,7 +47,7 @@ static class_info_t class_info[] =
{
XP_STX_TEXT("Behavior"),
XP_STX_TEXT("Object"),
XP_STX_TEXT("name instanceSize methods superclass intsanceVariables classVariables poolDictionaries"),
XP_STX_TEXT("spec methods superclass"),
XP_NULL,
XP_NULL,
0
@ -55,7 +55,7 @@ static class_info_t class_info[] =
{
XP_STX_TEXT("Class"),
XP_STX_TEXT("Behavior"),
XP_NULL,
XP_STX_TEXT("name variables classVariables poolDictionaries"),
XP_NULL,
XP_NULL,
0
@ -63,7 +63,7 @@ static class_info_t class_info[] =
{
XP_STX_TEXT("Metaclass"),
XP_STX_TEXT("Behavior"),
XP_NULL,
XP_STX_TEXT("instanceClass"),
XP_NULL,
XP_NULL,
0
@ -188,17 +188,25 @@ xp_stx_word_t xp_stx_new_array (xp_stx_t* stx, xp_stx_word_t size)
int xp_stx_bootstrap (xp_stx_t* stx)
{
xp_stx_word_t symbol_Smalltalk;
xp_stx_word_t class_Object, class_Class;
xp_stx_word_t tmp;
xp_stx_word_t object_meta;
__create_bootstrapping_objects (stx);
/* array class is precreated for easier instansition
/* object, class, and array are precreated for easier instantiation
* of builtin classes */
stx->class_object = xp_stx_new_class (stx, XP_STX_TEXT("Object"));
stx->class_class = xp_stx_new_class (stx, XP_STX_TEXT("Class"));
stx->class_array = xp_stx_new_class (stx, XP_STX_TEXT("Array"));
__create_builtin_classes (stx);
/* (Object class) setSuperclass: Class */
object_meta = XP_STX_CLASS(stx,stx->class_object);
XP_STX_AT(stx,object_meta,XP_STX_METACLASS_SUPERCLASS) = stx->class_class;
/* instance class for Object is set here as it is not
* set in __create_builtin_classes */
XP_STX_AT(stx,object_meta,XP_STX_METACLASS_INSTANCE_CLASS) = stx->class_object;
/* more initialization */
XP_STX_CLASS(stx,stx->symbol_table) =
xp_stx_lookup_class (stx, XP_STX_TEXT("SymbolTable"));
@ -211,12 +219,6 @@ int xp_stx_bootstrap (xp_stx_t* stx)
xp_stx_hash_char_object(stx,symbol_Smalltalk),
symbol_Smalltalk, stx->smalltalk);
/* adjust the class-metaclass cycle */
class_Object = xp_stx_lookup_class (stx, XP_STX_TEXT("Object"));
class_Class = xp_stx_lookup_class (stx, XP_STX_TEXT("Class"));
tmp = XP_STX_CLASS(stx,class_Object);
XP_STX_AT(stx,tmp,XP_STX_CLASS_SUPERCLASS) = class_Class;
/* create #nil, #true, #false */
xp_stx_new_symbol (stx, XP_STX_TEXT("nil"));
xp_stx_new_symbol (stx, XP_STX_TEXT("true"));
@ -269,14 +271,18 @@ static void __create_bootstrapping_objects (xp_stx_t* stx)
stx->class_pairlink = /* Pairlink */
xp_stx_alloc_word_object(stx,XP_STX_CLASS_SIZE);
/* Metaclass is a class so it has the same structure
* as a normal class. "Metaclass class" is an instance of
* Metaclass. */
class_SymlinkMeta = /* Symlink class */
xp_stx_alloc_word_object(stx,XP_STX_CLASS_SIZE);
xp_stx_alloc_word_object(stx,XP_STX_METACLASS_SIZE);
class_SymbolMeta = /* Symbol class */
xp_stx_alloc_word_object(stx,XP_STX_CLASS_SIZE);
xp_stx_alloc_word_object(stx,XP_STX_METACLASS_SIZE);
class_MetaclassMeta = /* Metaclass class */
xp_stx_alloc_word_object(stx,XP_STX_CLASS_SIZE);
xp_stx_alloc_word_object(stx,XP_STX_METACLASS_SIZE);
class_PairlinkMeta = /* Pairlink class */
xp_stx_alloc_word_object(stx,XP_STX_CLASS_SIZE);
xp_stx_alloc_word_object(stx,XP_STX_METACLASS_SIZE);
/* (Symlink class) setClass: Metaclass */
XP_STX_CLASS(stx,class_SymlinkMeta) = stx->class_metaclass;
@ -296,7 +302,7 @@ static void __create_bootstrapping_objects (xp_stx_t* stx)
/* Pairlink setClass: (Pairlink class) */
XP_STX_CLASS(stx,stx->class_pairlink) = class_PairlinkMeta;
/* (Symlink class) setSpec: CLASS_SIZE */
/* (Symlink class) setSpec: XP_STX_CLASS_SIZE */
XP_STX_AT(stx,class_SymlinkMeta,XP_STX_CLASS_SPEC) =
XP_STX_TO_SMALLINT((XP_STX_CLASS_SIZE << 1) | 0x00);
/* (Symbol class) setSpec: CLASS_SIZE */
@ -309,6 +315,10 @@ static void __create_bootstrapping_objects (xp_stx_t* stx)
XP_STX_AT(stx,class_PairlinkMeta,XP_STX_CLASS_SPEC) =
XP_STX_TO_SMALLINT((XP_STX_CLASS_SIZE << 1) | 0x00);
/* specs for class_metaclass, class_pairlink,
* class_symbol, class_symlink are set later in
* __create_builtin_classes */
/* #Symlink */
symbol_Symlink = xp_stx_new_symbol (stx, XP_STX_TEXT("Symlink"));
/* #Symbol */
@ -359,23 +369,29 @@ static void __create_builtin_classes (xp_stx_t* stx)
xp_stx_assert (class != stx->nil);
class_obj = (xp_stx_class_t*)XP_STX_WORD_OBJECT(stx, class);
class_obj->superclass = (p->superclass == XP_NULL)?
stx->nil: xp_stx_lookup_class(stx,p->superclass);
}
for (p = class_info; p->name != XP_NULL; p++) {
spec = 0;
if (p->superclass != XP_NULL) {
xp_stx_word_t meta;
xp_stx_metaclass_t* meta_obj;
superclass = xp_stx_lookup_class(stx,p->superclass);
xp_stx_assert (superclass != stx->nil);
meta = class_obj->header.class;
meta_obj = (xp_stx_metaclass_t*)XP_STX_WORD_OBJECT(stx,meta);
meta_obj->superclass = XP_STX_CLASS(stx,superclass);
meta_obj->instance_class = class;
while (superclass != stx->nil) {
superclass_obj = (xp_stx_class_t*)
XP_STX_WORD_OBJECT(stx,superclass);
spec += XP_STX_FROM_SMALLINT(superclass_obj->spec >> 1);
superclass = superclass_obj->superclass;
}
}
if (p->instance_variables != XP_NULL) {
@ -391,8 +407,14 @@ static void __create_builtin_classes (xp_stx_t* stx)
n = __count_names (p->class_variables);
array = xp_stx_new_array (stx, n);
__set_names (stx, XP_STX_DATA(stx,array), p->class_variables);
class_obj->classvars = array;
class_obj->class_variables = array;
}
/*
TODO:
if (p->pool_dictionaries != XP_NULL) {
}
*/
}
}

32
ase/stx/class.c
View File

@ -1,5 +1,5 @@
/*
* $Id: class.c,v 1.6 2005-05-24 03:29:43 bacon Exp $
* $Id: class.c,v 1.7 2005-05-25 16:44:05 bacon Exp $
*/
#include <xp/stx/class.h>
@ -15,12 +15,14 @@ xp_stx_word_t xp_stx_new_class (xp_stx_t* stx, const xp_stx_char_t* name)
meta = xp_stx_alloc_word_object (stx, XP_STX_METACLASS_SIZE);
XP_STX_CLASS(stx,meta) = stx->class_metaclass;
/* the spec of the metaclass must be the spec of its
* instance. so the XP_STX_CLASS_SIZE is set */
XP_STX_AT(stx,meta,XP_STX_METACLASS_SPEC) =
XP_STX_TO_SMALLINT((XP_STX_METACLASS_SIZE << 1) | 0x00);
XP_STX_TO_SMALLINT((XP_STX_CLASS_SIZE << 1) | 0x00);
/* the spec of the class is set later in __create_builtin_classes */
class = xp_stx_alloc_word_object (stx, XP_STX_CLASS_SIZE);
XP_STX_CLASS(stx,class) = meta;
class_name = xp_stx_new_symbol (stx, name);
XP_STX_AT(stx,class,XP_STX_CLASS_NAME) = class_name;
@ -31,30 +33,6 @@ xp_stx_word_t xp_stx_new_class (xp_stx_t* stx, const xp_stx_char_t* name)
return class;
}
xp_stx_word_t xp_stx_new_metaclass (xp_stx_t* stx, xp_stx_word_t class)
{
meta = xp_stx_alloc_word_object (stx, XP_STX_METACLASS_SIZE);
meta_obj = meta;
if (class == stx->class_class) {
/*
* "Object class superclass" returns "Class"
* whereas "Class subclasses" just returns an empty array
* because "Object class" is not registered as a subclass of
* "Class".
*/
meta_obj->superclass = stx->class_class;
}
else {
meta_obj->superclass = (class, SUPERCLASS)->class;
}
meta_obj->name = class_obj->name;
meta_obj->instance_class = class;
return meta;
}
xp_stx_word_t xp_stx_lookup_class (xp_stx_t* stx, const xp_stx_char_t* name)
{
xp_stx_word_t link, meta, value;

34
ase/stx/class.h
View File

@ -1,5 +1,5 @@
/*
* $Id: class.h,v 1.3 2005-05-24 03:29:43 bacon Exp $
* $Id: class.h,v 1.4 2005-05-25 16:44:05 bacon Exp $
*/
#ifndef _XP_STX_CLASS_H_
@ -9,42 +9,38 @@
/* definitions for common objects */
#define XP_STX_CLASS_SIZE 7
#define XP_STX_CLASS_NAME 0
#define XP_STX_CLASS_SPEC 1
#define XP_STX_CLASS_METHODS 2
#define XP_STX_CLASS_SUPERCLASS 3
#define XP_STX_CLASS_SPEC 0
#define XP_STX_CLASS_METHODS 1
#define XP_STX_CLASS_SUPERCLASS 2
#define XP_STX_CLASS_NAME 3
#define XP_STX_CLASS_VARIABLES 4
#define XP_STX_CLASS_CLASSVARS 5
#define XP_STX_CLASS_POOLDICT 6
#define XP_STX_CLASS_CLASS_VARIABLES 5
#define XP_STX_CLASS_POOL_DICTIONARIES 6
#define XP_STX_METACLASS_SIZE 6
#define XP_STX_METACLASS_NAME 0
#define XP_STX_METACLASS_SPEC 1
#define XP_STX_METACLASS_METHODS 2
#define XP_STX_METACLASS_SUPERCLASS 3
#define XP_STX_METACLASS_VARIABLES 4
#define XP_STX_METACLASS_CLASS 5
#define XP_STX_METACLASS_SIZE 4
#define XP_STX_METACLASS_SPEC 0
#define XP_STX_METACLASS_METHODS 1
#define XP_STX_METACLASS_SUPERCLASS 2
#define XP_STX_METACLASS_INSTANCE_CLASS 3
struct xp_stx_class_t
{
xp_stx_objhdr_t header;
xp_stx_word_t name;
xp_stx_word_t spec; /* indexable: 1, nfields: the rest */
xp_stx_word_t methods;
xp_stx_word_t superclass;
xp_stx_word_t name;
xp_stx_word_t variables;
xp_stx_word_t classvars;
xp_stx_word_t pooldict;
xp_stx_word_t class_variables;
xp_stx_word_t pool_dictonaries;
};
struct xp_stx_metaclass_t
{
xp_stx_objhdr_t header;
xp_stx_word_t name;
xp_stx_word_t spec;
xp_stx_word_t methods;
xp_stx_word_t superclass;
xp_stx_word_t variables;
xp_stx_word_t instance_class;
};

4
ase/stx/stx.c
View File

@ -1,5 +1,5 @@
/*
* $Id: stx.c,v 1.28 2005-05-23 14:43:03 bacon Exp $
* $Id: stx.c,v 1.29 2005-05-25 16:44:05 bacon Exp $
*/
#include <xp/stx/stx.h>
@ -32,6 +32,8 @@ xp_stx_t* xp_stx_open (xp_stx_t* stx, xp_stx_word_t capacity)
stx->class_metaclass = XP_STX_NIL;
stx->class_pairlink = XP_STX_NIL;
stx->class_object = XP_STX_NIL;
stx->class_class = XP_STX_NIL;
stx->class_array = XP_STX_NIL;
stx->__wantabort = xp_false;

4
ase/stx/stx.h
View File

@ -1,5 +1,5 @@
/*
* $Id: stx.h,v 1.21 2005-05-23 14:43:03 bacon Exp $
* $Id: stx.h,v 1.22 2005-05-25 16:44:05 bacon Exp $
*/
#ifndef _XP_STX_STX_H_
@ -81,6 +81,8 @@ struct xp_stx_t
xp_stx_word_t class_metaclass;
xp_stx_word_t class_pairlink;
xp_stx_word_t class_object;
xp_stx_word_t class_class;
xp_stx_word_t class_array;
xp_bool_t __malloced;

35
ase/test/stx/stx.c
View File

@ -22,8 +22,10 @@ void print_symbol_names (xp_stx_t* stx, xp_stx_word_t sym)
void print_symbol_names_2 (xp_stx_t* stx, xp_stx_word_t idx)
{
xp_stx_word_t key = XP_STX_AT(stx,idx,1);
xp_printf (XP_TEXT("%lu [%s]\n"), (unsigned long)key, &XP_STX_CHARAT(stx,key,0));
xp_stx_word_t key = XP_STX_AT(stx,idx,XP_STX_PAIRLINK_KEY);
xp_stx_word_t value = XP_STX_AT(stx,idx,XP_STX_PAIRLINK_VALUE);
xp_printf (XP_TEXT("%lu [%s] %lu\n"),
(unsigned long)key, &XP_STX_CHARAT(stx,key,0), (unsigned long)value);
}
int xp_main (int argc, xp_char_t* argv[])
@ -93,6 +95,35 @@ int xp_main (int argc, xp_char_t* argv[])
}
xp_printf (XP_TEXT("-------------\n"));
{
xp_stx_word_t n, x;
xp_stx_metaclass_t* obj;
xp_stx_class_t* xobj;
n = xp_stx_lookup_class (&stx, XP_STX_TEXT("Array"));
n = XP_STX_CLASS(&stx,n);
xp_printf (XP_TEXT("Class hierarchy for the class Array class\n"));
while (n != stx.nil) {
if (n == stx.class_class) break;
obj = (xp_stx_metaclass_t*)XP_STX_WORD_OBJECT(&stx,n);
x = obj->instance_class;
xobj = (xp_stx_class_t*)XP_STX_WORD_OBJECT(&stx,x);
xp_printf (XP_TEXT("%lu, %s class\n"),
(unsigned long)xobj->name,
XP_STX_DATA(&stx, xobj->name));
n = obj->superclass;
}
while (n != stx.nil) {
xobj = (xp_stx_class_t*)XP_STX_WORD_OBJECT(&stx,n);
xp_printf (XP_TEXT("%lu, %s\n"),
(unsigned long)xobj->name,
XP_STX_DATA(&stx, xobj->name));
n = xobj->superclass;
}
}
xp_printf (XP_TEXT("-------------\n"));
#if 0
{
xp_stx_word_t method_name;