written more compiler codes

stix/lib/dic.c

@@ -155,3 +155,38 @@ stix_oop_t stix_getatsysdic (stix_t* stix, stix_oop_t key)
 	STIX_ASSERT (STIX_CLASSOF(stix,key) == stix->_symbol);
 	return find_or_insert (stix, (stix_oop_char_t)key, STIX_NULL);
 }
+
+
+stix_oop_t stix_lookupsysdic (stix_t* stix, const stix_ucs_t* name)
+{
+	/* this is special version of stix_getatsysdic() that performs
+	 * lookup using a plain string specified */
+
+	stix_oow_t index;
+	stix_oop_association_t ass;
+
+	STIX_ASSERT (STIX_CLASSOF(stix,stix->sysdic->tally) == stix->_small_integer);
+	STIX_ASSERT (STIX_CLASSOF(stix,stix->sysdic->bucket) == stix->_array);
+
+	index = stix_hashchars(name->ptr, name->len) % STIX_OBJ_GET_SIZE(stix->sysdic->bucket);
+
+	while (stix->sysdic->bucket->slot[index] != stix->_nil) 
+	{
+		ass = (stix_oop_association_t)stix->sysdic->bucket->slot[index];
+
+		STIX_ASSERT (STIX_CLASSOF(stix,ass) == stix->_association);
+		STIX_ASSERT (STIX_CLASSOF(stix,ass->key) == stix->_symbol);
+
+		if (name->len == STIX_OBJ_GET_SIZE(ass->key) &&
+		    stix_equalchars(name->ptr, ((stix_oop_char_t)ass->key)->slot, name->len)) 
+		{
+			return (stix_oop_t)ass;
+		}
+
+		index = (index + 1) % STIX_OBJ_GET_SIZE(stix->sysdic->bucket);
+	}
+
+	/* when value is STIX_NULL, perform no insertion */
+	stix->errnum = STIX_ENOENT;
+	return STIX_NULL;
+}

stix/lib/gc.c

@@ -89,7 +89,7 @@ wprintf (L">> DISPOSING %d [%S] from the symbol table\n", (int)index, sym->slot)
 	stix->symtab->tally = STIX_OOP_FROM_SMINT(tally);
 }
 
-static stix_oop_t move_one (stix_t* stix, stix_oop_t oop)
+stix_oop_t stix_moveoop (stix_t* stix, stix_oop_t oop)
 {
 #if defined(STIX_SUPPORT_GC_DURING_IGNITION)
 	if (!oop) return oop;
@@ -153,7 +153,7 @@ static stix_uint8_t* scan_new_heap (stix_t* stix, stix_uint8_t* ptr)
 		oop = (stix_oop_t)ptr;
 		nbytes_aligned = STIX_ALIGN (STIX_OBJ_BYTESOF(oop), STIX_SIZEOF(stix_oop_t));
 
-		STIX_OBJ_SET_CLASS (oop, move_one(stix, STIX_OBJ_GET_CLASS(oop)));
+		STIX_OBJ_SET_CLASS (oop, stix_moveoop(stix, STIX_OBJ_GET_CLASS(oop)));
 		if (STIX_OBJ_GET_FLAGS_TYPE(oop) == STIX_OBJ_TYPE_OOP)
 		{
 			stix_obj_oop_t* xtmp;
@@ -162,7 +162,7 @@ static stix_uint8_t* scan_new_heap (stix_t* stix, stix_uint8_t* ptr)
 			for (i = 0; i < oop->_size; i++)
 			{
 				if (STIX_OOP_IS_POINTER(xtmp->slot[i]))
-					xtmp->slot[i] = move_one (stix, xtmp->slot[i]);
+					xtmp->slot[i] = stix_moveoop (stix, xtmp->slot[i]);
 			}
 		}
 
@@ -186,6 +186,7 @@ void stix_gc (stix_t* stix)
 	stix_heap_t* tmp;
 	stix_oop_t old_nil;
 	stix_oow_t i;
+	stix_cb_t* cb;
 
 printf ("STARTING GC curheap base %p ptr %p newheap base %p ptr %p\n",
 	stix->curheap->base, stix->curheap->ptr, stix->newheap->base, stix->newheap->ptr);
@@ -194,31 +195,36 @@ printf ("STARTING GC curheap base %p ptr %p newheap base %p ptr %p\n",
 	old_nil = stix->_nil;
 
 	/* move _nil and the root object table */
-	stix->_nil               = move_one (stix, stix->_nil);
+	stix->_nil               = stix_moveoop (stix, stix->_nil);
-	stix->_true              = move_one (stix, stix->_true);
+	stix->_true              = stix_moveoop (stix, stix->_true);
-	stix->_false             = move_one (stix, stix->_false);
+	stix->_false             = stix_moveoop (stix, stix->_false);
 
 /*printf ("BEFORE GC = %p %p %p %p %p %p %p %p %p %p\n", stix->_array, stix->_class, stix->_nil_object, stix->_object, stix->_symbol, stix->_symbol_set, stix->_system_dictionary, stix->_association, stix->_character, stix->_small_integer);*/
-	stix->_stix              = move_one (stix, stix->_stix);
+	stix->_stix              = stix_moveoop (stix, stix->_stix);
-	stix->_class             = move_one (stix, stix->_class);
+	stix->_class             = stix_moveoop (stix, stix->_class);
-	stix->_nil_object        = move_one (stix, stix->_nil_object);
+	stix->_nil_object        = stix_moveoop (stix, stix->_nil_object);
-	stix->_object            = move_one (stix, stix->_object);
+	stix->_object            = stix_moveoop (stix, stix->_object);
-	stix->_array             = move_one (stix, stix->_array);
+	stix->_array             = stix_moveoop (stix, stix->_array);
-	stix->_symbol            = move_one (stix, stix->_symbol);
+	stix->_symbol            = stix_moveoop (stix, stix->_symbol);
-	stix->_symbol_set        = move_one (stix, stix->_symbol_set);
+	stix->_symbol_set        = stix_moveoop (stix, stix->_symbol_set);
-	stix->_system_dictionary = move_one (stix, stix->_system_dictionary);
+	stix->_system_dictionary = stix_moveoop (stix, stix->_system_dictionary);
-	stix->_association       = move_one (stix, stix->_association);
+	stix->_association       = stix_moveoop (stix, stix->_association);
-	stix->_true_class        = move_one (stix, stix->_true_class);
+	stix->_true_class        = stix_moveoop (stix, stix->_true_class);
-	stix->_false_class       = move_one (stix, stix->_false_class);
+	stix->_false_class       = stix_moveoop (stix, stix->_false_class);
-	stix->_character         = move_one (stix, stix->_character);
+	stix->_character         = stix_moveoop (stix, stix->_character);
-	stix->_small_integer     = move_one (stix, stix->_small_integer);
+	stix->_small_integer     = stix_moveoop (stix, stix->_small_integer);
 
 /*printf ("AFTER GC = %p %p %p %p %p %p %p %p %p %p\n", stix->_array, stix->_class, stix->_nil_object, stix->_object, stix->_symbol, stix->_symbol_set, stix->_system_dictionary, stix->_association, stix->_character, stix->_small_integer);*/
-	stix->sysdic = (stix_oop_set_t) move_one (stix, (stix_oop_t)stix->sysdic);
+	stix->sysdic = (stix_oop_set_t) stix_moveoop (stix, (stix_oop_t)stix->sysdic);
 
 	for (i = 0; i < stix->tmp_count; i++)
 	{
-		*stix->tmp_stack[i] = move_one (stix, *stix->tmp_stack[i]);
+		*stix->tmp_stack[i] = stix_moveoop (stix, *stix->tmp_stack[i]);
+	}
+
+	for (cb = stix->cblist; cb; cb = cb->next)
+	{
+		if (cb->gc) cb->gc (stix);
 	}
 
 	/* scan the new heap to move referenced objects */
@@ -232,7 +238,7 @@ printf ("STARTING GC curheap base %p ptr %p newheap base %p ptr %p\n",
 	compact_symbol_table (stix, old_nil);
 
 	/* move the symbol table itself */
-	stix->symtab = (stix_oop_set_t)move_one (stix, (stix_oop_t)stix->symtab);
+	stix->symtab = (stix_oop_set_t)stix_moveoop (stix, (stix_oop_t)stix->symtab);
 
 	/* scan the new heap again from the end position of
 	 * the previous scan to move referenced objects by 

stix/lib/main.c

@@ -193,6 +193,7 @@ static char* syntax_error_msg[] =
 	"string expected", /* string expected in place of ${1} */
 	"{ expected",
 	"} expected",
+	"( expected",
 	") expected",
 	". expected",
 	"| expected",
@@ -201,8 +202,13 @@ static char* syntax_error_msg[] =
 	"integer expected",
 	"primitive: expected",
 	"wrong class modifier",
+	"undefined class",
+	"duplicate class",
+	"#dcl not allowed",
 	"wrong function name",
-	"duplicate argument name"
+	"duplicate argument name",
+	"duplicate temporary variable name",
+	"duplicate variable name"
 };
 
 int main (int argc, char* argv[])

stix/lib/stix-prv.h

@@ -260,6 +260,7 @@ enum stix_synerrnum_t
 	STIX_SYNERR_STRING,      /* string expected */
 	STIX_SYNERR_LBRACE,      /* { expected */
 	STIX_SYNERR_RBRACE,      /* } expected */
+	STIX_SYNERR_LPAREN,      /* ( expected */
 	STIX_SYNERR_RPAREN,      /* ) expected */
 	STIX_SYNERR_PERIOD,      /* . expected */
 	STIX_SYNERR_VBAR,        /* | expected */
@@ -268,8 +269,13 @@ enum stix_synerrnum_t
 	STIX_SYNERR_INTEGER,     /* integer expected */
 	STIX_SYNERR_PRIMITIVE,   /* primitive: expected */
 	STIX_SYNERR_CLASSMOD,    /* wrong class modifier */
+	STIX_SYNERR_CLASSUNDEF,  /* undefined class */
+	STIX_SYNERR_CLASSDUP,    /* duplicate class */
+	STIX_SYNERR_DCLBANNED,   /* #dcl not allowed */
 	STIX_SYNERR_FUNNAME,     /* wrong function name */
-	STIX_SYNERR_DUPARGNAME  /* duplicate argument name */
+	STIX_SYNERR_ARGNAMEDUP,  /* duplicate argument name */
+	STIX_SYNERR_TMPRNAMEDUP, /* duplicate temporary variable name */
+	STIX_SYNERR_VARNAMEDUP   /* duplicate variable name */
 };
 typedef enum stix_synerrnum_t stix_synerrnum_t;
 
@@ -491,9 +497,31 @@ struct stix_compiler_t
 	stix_ucs_t ilchr_ucs;
 
 
-	/* information about a function begin comipled */
+	/* information about a class being compiled */
 	struct
 	{
+		int flags;
+
+		stix_oop_t self_oop;
+		stix_oop_t super_oop;
+
+		stix_ucs_t name;
+		stix_size_t name_capa;
+
+		stix_ucs_t supername;
+		stix_size_t supername_capa;
+
+		/* instance variable, class variable, class instance variable */
+		stix_ucs_t vars[3]; 
+		stix_size_t vars_capa[3];
+		stix_size_t var_count[3];
+	} _class;
+
+	/* information about a function being comipled */
+	struct
+	{
+		int flags;
+
 		stix_ucs_t name;
 		stix_size_t name_capa;
 
@@ -507,6 +535,8 @@ struct stix_compiler_t
 		/* literals */
 		int literal_count;
 
+		stix_oow_t prim_no; /* primitive number */
+
 		stix_code_t code;
 		stix_size_t code_capa;
 	} fun; 
@@ -579,6 +609,13 @@ void stix_copychars (
 	stix_size_t len
 );
 
+/* ========================================================================= */
+/* gc.c                                                                     */
+/* ========================================================================= */
+stix_oop_t stix_moveoop (
+	stix_t*     stix,
+	stix_oop_t  oop
+);
 
 /* ========================================================================= */
 /* obj.c                                                                     */
@@ -644,6 +681,11 @@ stix_oop_t stix_getatsysdic (
 	stix_oop_t  key
 );
 
+stix_oop_t stix_lookupsysdic (
+	stix_t*           stix,
+	const stix_ucs_t* name
+);
+
 /* ========================================================================= */
 /* utf8.c                                                                    */
 /* ========================================================================= */

stix/lib/stix.h

@@ -418,7 +418,7 @@ typedef enum stix_obj_type_t stix_obj_type_t;
 #define STIX_OBJ_FLAGS_TYPE_BITS   6
 #define STIX_OBJ_FLAGS_UNIT_BITS   5
 #define STIX_OBJ_FLAGS_EXTRA_BITS  1
-#define STIX_OBJ_FLAGS_KERNEL_BITS 1
+#define STIX_OBJ_FLAGS_KERNEL_BITS 2
 #define STIX_OBJ_FLAGS_MOVED_BITS  1
 
 #define STIX_OBJ_GET_FLAGS_TYPE(oop)     STIX_GETBITS(stix_oow_t, (oop)->_flags, (STIX_OBJ_FLAGS_UNIT_BITS + STIX_OBJ_FLAGS_EXTRA_BITS + STIX_OBJ_FLAGS_KERNEL_BITS + STIX_OBJ_FLAGS_MOVED_BITS), STIX_OBJ_FLAGS_TYPE_BITS)
@@ -495,14 +495,14 @@ struct stix_class_t
 	stix_oop_t      superclass;   /* Another class */
 	stix_oop_t      subclasses;   /* Array of subclasses */
 	stix_oop_char_t name;         /* Symbol */
-	stix_oop_char_t instvars;     /* String or Array? */
+	stix_oop_char_t instvars;     /* String */
-	stix_oop_char_t classvars;    /* String or Array? */
+	stix_oop_char_t classvars;    /* String */
 
 	stix_oop_oop_t  instmthds;    /* instance methods, MethodDictionary */
 	stix_oop_oop_t  classmthds;   /* class methods, MethodDictionary */
 
 	/* indexed part afterwards */
-	stix_oop_t      classvar[1];  /* most classes have not class variables. better to be 0 */
+	stix_oop_t      classvar[1];  /* most classes have no class variables. better to be 0 */
 };
 typedef struct stix_class_t stix_class_t;
 typedef struct stix_class_t* stix_oop_class_t;
@@ -555,9 +555,6 @@ struct stix_heap_t
 	stix_uint8_t* ptr;   /* next allocation pointer */
 };
 
-
-
-
 typedef struct stix_t stix_t;
 
 typedef void (*stix_cbimpl_t) (stix_t* stix);
@@ -565,6 +562,7 @@ typedef void (*stix_cbimpl_t) (stix_t* stix);
 typedef struct stix_cb_t stix_cb_t;
 struct stix_cb_t
 {
+	stix_cbimpl_t gc;
 	stix_cbimpl_t fini;
 	stix_cb_t*    prev;
 	stix_cb_t*    next;