compile time protocol support seems to be complete now. fortunatly, protocols had never been written out so the corrections to the protocol related stuctures do not need a progs version bump. runtime protocol support hasn't been fully tested yet.

+load runtime support seems to be working. This is an imperfect revision of history.
2024-11-10 15:22:04 +00:00 · 2004-11-11 00:34:00 +00:00 · 2004-11-11 00:34:00 +00:00 · 64cc8c60d2
commit 64cc8c60d2
parent 7dfd9ab502
14 changed files with 614 additions and 157 deletions
--- a/include/QF/pr_obj.h
+++ b/include/QF/pr_obj.h
@ -106,8 +106,8 @@ typedef struct pr_protocol_s {
 	pointer_t   class_pointer;		// pr_class_t
 	string_t    protocol_name;
 	pointer_t   protocol_list;		// pr_protocol_list_t
-	pointer_t   instance_methods;	// pr_method_list_t
-	pointer_t   class_methods;		// pr_method_list_t
+	pointer_t   instance_methods;	// pr_method_description_list_t
+	pointer_t   class_methods;		// pr_method_description_list_t
 } pr_protocol_t;

 typedef struct pr_category_s {
@ -121,7 +121,7 @@ typedef struct pr_category_s {
 typedef struct pr_protocol_list_s {
 	pointer_t   next;
 	int         count;
-	pointer_t   list[1];
+	pointer_t   list[1];			// pr_protocol_t
 } pr_protocol_list_t;

 typedef struct pr_method_list_s {
@ -135,6 +135,15 @@ typedef struct pr_method_list_s {
 } pr_method_list_t;
 typedef struct pr_method_s pr_method_t;

+typedef struct pr_method_description_list_s {
+	int         count;
+	struct pr_method_description_s {
+		pointer_t   name;			// pr_sel_t
+		string_t    types;
+	} list[1];
+} pr_method_description_list_t;
+typedef struct pr_method_description_s pr_method_description_t;
+
 typedef struct pr_ivar_list_s {
 	int         ivar_count;
 	struct pr_ivar_s {
@ -158,8 +167,11 @@ typedef struct pr_symtab_s {
 	pointer_t   refs;				// pr_sel_t
 	int         cls_def_cnt;
 	int         cat_def_cnt;
-	pointer_t   defs[1];			// variable array of class pointers then
-									// category pointers
+	pointer_t   defs[1];			// variable array of cls_def_cnt class
+									// pointers then cat_def_cnt category
+									// pointers followed by a null terminated
+									// array of pr_static_instances (not yet
+									// implemented in qfcc)
 } pr_symtab_t;

 typedef struct pr_module_s {
--- a/include/QF/progs.h
+++ b/include/QF/progs.h
@ -1228,8 +1228,12 @@ struct progs_s {
 	string_t   *selector_names;
 	struct hashtab_s *selector_hash;
 	struct hashtab_s *classes;
-	struct hashtab_s *categories;
-	struct hashtab_s *protocols;
+	struct hashtab_s *load_methods;
+	void       *unresolved_classes;
+	void       *unclaimed_categories;
+	void       *unclaimed_proto_list;
+	void       *module_list;
+	void       *class_tree_list;
 	//@}

 	/// debug info
--- a/libs/ruamoko/rua_obj.c
+++ b/libs/ruamoko/rua_obj.c
@ -51,11 +51,237 @@ static __attribute__ ((unused)) const char rcsid[] =
 #include "compat.h"
 #include "rua_internal.h"

-static void
-{
+typedef struct obj_list {
+	struct obj_list *next;
+	void       *data;
+} obj_list;

-	} else {
+static obj_list *obj_list_free_list;
+
+static obj_list *
+obj_list_new (void)
+{
+	int         i;
+	obj_list   *l;
+
+	if (!obj_list_free_list) {
+		obj_list_free_list = calloc (128, sizeof (obj_list));
+		for (i = 0; i < 127; i++)
+			obj_list_free_list[i].next = &obj_list_free_list[i + 1];
 	}
+	l = obj_list_free_list;
+	obj_list_free_list = l->next;
+	l->next = 0;
+	return l;
+}
+
+static void
+obj_list_free (obj_list *l)
+{
+	obj_list   *e;
+
+	if (!l)
+		return;
+
+	for (e = l; e->next; e = e->next)
+		;
+	e->next = obj_list_free_list;
+	obj_list_free_list = l;
+}
+
+static inline obj_list *
+list_cons (void *data, obj_list *next)
+{
+	obj_list   *l = obj_list_new ();
+	l->data = data;
+	l->next = next;
+	return l;
+}
+
+static inline void
+list_remove (obj_list **list)
+{
+	if ((*list)->next) {
+		obj_list   *l = *list;
+		*list = (*list)->next;
+		l->next = 0;
+		obj_list_free (l);
+	} else {
+		obj_list_free (*list);
+		*list = 0;
+	}
+}
+
+typedef struct class_tree {
+	pr_class_t *class;
+	obj_list   *subclasses;
+} class_tree;
+
+class_tree *class_tree_free_list;
+
+static class_tree *
+class_tree_new (void)
+{
+	int         i;
+	class_tree *t;
+
+	if (!class_tree_free_list) {
+		class_tree_free_list = calloc (128, sizeof (class_tree));
+		for (i = 0; i < 127; i++) {
+			class_tree *x = &class_tree_free_list[i];
+			x->subclasses = (obj_list *) (x + 1);
+		}
+	}
+	t = class_tree_free_list;
+	class_tree_free_list = (class_tree *) t->subclasses;
+	t->subclasses = 0;
+	return t;
+}
+
+static int
+class_is_subclass_of_class (progs_t *pr, pr_class_t *class,
+							pr_class_t *superclass)
+{
+	while (class) {
+		if (class == superclass)
+			return 1;
+		if (!class->super_class)
+			break;
+		class = Hash_Find (pr->classes, PR_GetString (pr, class->super_class));
+	}
+	return 0;
+}
+
+static class_tree *
+create_tree_of_subclasses_inherited_from (progs_t *pr, pr_class_t *bottom,
+										  pr_class_t *upper)
+{
+	const char *super_class = PR_GetString (pr, bottom->super_class);
+	pr_class_t *superclass;
+	class_tree *tree, *prev;
+	
+	superclass = bottom->super_class ? Hash_Find (pr->classes, super_class)
+									 : 0;
+	tree = prev = class_tree_new ();
+	prev->class = bottom;
+	while (superclass != upper) {
+		tree = class_tree_new ();
+		tree->class = superclass;
+		tree->subclasses = list_cons (prev, tree->subclasses);
+		super_class = PR_GetString (pr, superclass->super_class);
+		superclass = (superclass->super_class ? Hash_Find (pr->classes,
+														   super_class)
+											  : 0);
+		prev = tree;
+	}
+	return tree;
+}
+
+static class_tree *
+_obj_tree_insert_class (progs_t *pr, class_tree *tree, pr_class_t *class)
+{
+	obj_list   *subclasses;
+	class_tree *new_tree;
+
+	if (!tree)
+		return create_tree_of_subclasses_inherited_from (pr, class, 0);
+	if (class == tree->class)
+		return tree;
+	if ((class->super_class ? Hash_Find (pr->classes,
+										 PR_GetString (pr,
+											 		   class->super_class))
+							: 0) == tree->class) {
+		obj_list   *list = tree->subclasses;
+		class_tree *node;
+
+		while (list) {
+			if (((class_tree *) list->data)->class == class)
+				return tree;
+			list = list->next;
+		}
+		node = class_tree_new ();
+		node->class = class;
+		tree->subclasses = list_cons (node, tree->subclasses);
+		return tree;
+	}
+	if (!class_is_subclass_of_class (pr, class, tree->class))
+		return 0;
+	for (subclasses = tree->subclasses; subclasses;
+		 subclasses = subclasses->next) {
+		pr_class_t *aclass = ((class_tree *)subclasses->data)->class;
+		if (class_is_subclass_of_class (pr, class, aclass)) {
+			subclasses->data = _obj_tree_insert_class (pr, subclasses->data,
+													   class);
+			return tree;
+		}
+	}
+	new_tree = create_tree_of_subclasses_inherited_from (pr, class,
+														 tree->class);
+	tree->subclasses = list_cons (new_tree, tree->subclasses);
+	return tree;
+}
+
+static void
+obj_tree_insert_class (progs_t *pr, pr_class_t *class)
+{
+	obj_list   *list_node;
+	class_tree *tree;
+
+	list_node = pr->class_tree_list;
+	while (list_node) {
+		tree = _obj_tree_insert_class (pr, list_node->data, class);
+		if (tree) {
+			list_node->data = tree;
+			break;
+		} else {
+			list_node = list_node->next;
+		}
+	}
+	if (!list_node) {
+		tree = _obj_tree_insert_class (pr, 0, class);
+		pr->class_tree_list = list_cons (tree, pr->class_tree_list);
+	}
+}
+
+static void
+obj_create_classes_tree (progs_t *pr, pr_module_t *module)
+{
+	pr_symtab_t *symtab = &G_STRUCT (pr, pr_symtab_t, module->symtab);
+	int         i;
+
+	for (i = 0; i < symtab->cls_def_cnt; i++) {
+		pr_class_t *class = &G_STRUCT (pr, pr_class_t, symtab->defs[i]);
+		obj_tree_insert_class (pr, class);
+	}
+}
+
+static void
+obj_destroy_class_tree_node (progs_t *pr, class_tree *tree, int level)
+{
+	tree->subclasses = (obj_list *) class_tree_free_list;
+	class_tree_free_list = tree;
+}
+
+static void
+obj_preorder_traverse (progs_t *pr, class_tree *tree, int level,
+					   void (*func) (progs_t *, class_tree *, int))
+{
+	obj_list   *node;
+
+	func (pr, tree, level);
+	for (node = tree->subclasses; node; node = node->next)
+		obj_preorder_traverse (pr, node->data, level + 1, func);
+}
+
+static void
+obj_postorder_traverse (progs_t *pr, class_tree *tree, int level,
+						void (*func) (progs_t *, class_tree *, int))
+{
+	obj_list   *node;
+
+	for (node = tree->subclasses; node; node = node->next)
+		obj_postorder_traverse (pr, node->data, level + 1, func);
+	func (pr, tree, level);
 }

 static const char *
@ -72,27 +298,15 @@ class_get_key (void *c, void *pr)
 }

 static unsigned long
-category_get_hash (void *_c, void *_pr)
+load_methods_get_hash (void *m, void *pr)
 {
-	progs_t    *pr = (progs_t *) _pr;
-	pr_category_t *cat = (pr_category_t *) _c;
-	const char *category_name = PR_GetString (pr, cat->category_name);
-	const char *class_name = PR_GetString (pr, cat->class_name);
-
-	return Hash_String (category_name) ^ Hash_String (class_name);
+	return (unsigned long) m;
 }

 static int
-category_compare (void *_c1, void *_c2, void *_pr)
+load_methods_compare (void *m1, void *m2, void *pr)
 {
-	progs_t    *pr = (progs_t *) _pr;
-	pr_category_t *c1 = (pr_category_t *) _c1;
-	pr_category_t *c2 = (pr_category_t *) _c2;
-	const char *cat1 = PR_GetString (pr, c1->category_name);
-	const char *cat2 = PR_GetString (pr, c2->category_name);
-	const char *cls1 = PR_GetString (pr, c1->class_name);
-	const char *cls2 = PR_GetString (pr, c2->class_name);
-	return strcmp (cat1, cat2) == 0 && strcmp (cls1, cls2) == 0;
+	return m1 == m2;
 }

 static inline int
@ -506,7 +720,15 @@ obj_msg_lookup (progs_t *pr, pr_id_t *receiver, pr_sel_t *op)
 	if (!receiver)
 		return 0;
 	class = &G_STRUCT (pr, pr_class_t, receiver->class_pointer);
-	return obj_find_message (pr, class, op);
+	if (PR_CLS_ISCLASS (class)) {
+		if (!PR_CLS_ISINITIALIZED (class))
+			obj_send_initialize (pr, class);
+	} else if (PR_CLS_ISMETA (class)
+			   && PR_CLS_ISCLASS ((pr_class_t *) receiver)) {
+		if (!PR_CLS_ISINITIALIZED ((pr_class_t *) receiver))
+			obj_send_initialize (pr, (pr_class_t *) receiver);
+	}
+	return get_imp (pr, class, op);
 }

 static func_t
@ -535,6 +757,93 @@ obj_verror (progs_t *pr, pr_id_t *object, int code, const char *fmt, int count,
 	PR_RunError (pr, "%s", dstr->str);
 }

+static void
+rua___obj_exec_class (progs_t *pr)
+{
+	pr_module_t *module = &P_STRUCT (pr, pr_module_t, 0);
+	pr_symtab_t *symtab;
+	pr_sel_t   *sel;
+	pointer_t  *ptr;
+	int         i;
+	obj_list  **cell;
+
+	if (!module)
+		return;
+	symtab = &G_STRUCT (pr, pr_symtab_t, module->symtab);
+	if (!symtab)
+		return;
+
+	pr->module_list = list_cons (module, pr->module_list);
+
+	sel = &G_STRUCT (pr, pr_sel_t, symtab->refs);
+	for (i = 0; i < symtab->sel_ref_cnt; i++) {
+		const char *name, *types;
+		name = PR_GetString (pr, sel->sel_id);
+		types = PR_GetString (pr, sel->sel_types);
+		sel_register_typed_name (pr, name, types, sel);
+		sel++;
+	}
+
+	ptr = symtab->defs;
+	for (i = 0; i < symtab->cls_def_cnt; i++, ptr++) {
+		pr_class_t *class = &G_STRUCT (pr, pr_class_t, *ptr);
+		pr_class_t *meta = &G_STRUCT (pr, pr_class_t, class->class_pointer);
+		const char *super_class = PR_GetString (pr, class->super_class);
+
+		class->subclass_list = 0;
+
+		Hash_Add (pr->classes, class);
+
+		obj_register_selectors_from_class (pr, class);
+		obj_register_selectors_from_class (pr, meta);
+
+		if (class->protocols) {
+			pr_protocol_list_t *protocol_list;
+			protocol_list = &G_STRUCT (pr, pr_protocol_list_t,
+									   class->protocols);
+			obj_init_protocols (pr, protocol_list);
+		}
+
+		if (class->super_class && !Hash_Find (pr->classes, super_class))
+			pr->unresolved_classes = list_cons (class, pr->unresolved_classes);
+	}
+
+	for (i = 0; i < symtab->cat_def_cnt; i++, ptr++) {
+		pr_category_t *category = &G_STRUCT (pr, pr_category_t, *ptr);
+		const char *class_name = PR_GetString (pr, category->class_name);
+		pr_class_t *class = Hash_Find (pr->classes, class_name);
+
+		if (class) {
+			finish_category (pr, category, class);
+		} else {
+			pr->unclaimed_categories = list_cons (category,
+												  pr->unclaimed_categories);
+		}
+	}
+
+	for (cell = (obj_list **) &pr->unclaimed_categories; *cell; ) {
+		pr_category_t *category = (*cell)->data;
+		const char *class_name = PR_GetString (pr, category->class_name);
+		pr_class_t *class = Hash_Find (pr->classes, class_name);
+
+		if (class) {
+			list_remove (cell);
+			finish_category (pr, category, class);
+		} else {
+			cell = &(*cell)->next;
+		}
+	}
+
+	if (pr->unclaimed_proto_list && Hash_Find (pr->classes, "Protocol")) {
+		for (cell = (obj_list **) &pr->unclaimed_proto_list; *cell; ) {
+			obj_init_protocols (pr, (*cell)->data);
+			list_remove (cell);
+		}
+	}
+
+	obj_send_load (pr);
+}
+
 static void
 rua_obj_error (progs_t *pr)
 {
@ -948,10 +1257,10 @@ rua_method_get_imp (progs_t *pr)
 static void
 rua_get_imp (progs_t *pr)
 {
-	//pr_class_t *class = &P_STRUCT (pr, pr_class_t, 0);
-	//pr_sel_t   *sel = &P_STRUCT (pr, pr_sel_t, 1);
-	//XXX
-	PR_RunError (pr, "%s, not implemented", __FUNCTION__);
+	pr_class_t *class = &P_STRUCT (pr, pr_class_t, 0);
+	pr_sel_t   *sel = &P_STRUCT (pr, pr_sel_t, 1);
+
+	R_INT (pr) = get_imp (pr, class, sel);
 }

 //====================================================================
@ -1039,20 +1348,8 @@ static void
 rua_object_get_class_name (progs_t *pr)
 {
 	pr_id_t    *object = &P_STRUCT (pr, pr_id_t, 0);
-	pr_class_t *class;

-	if (object) {
-		class = &G_STRUCT (pr, pr_class_t, object->class_pointer);
-		if (PR_CLS_ISCLASS (class)) {
-			R_INT (pr) = class->name;
-			return;
-		}
-		if (PR_CLS_ISMETA (class)) {
-			R_INT (pr) = ((pr_class_t *)object)->name;
-			return;
-		}
-	}
-	RETURN_STRING (pr, "Nil");
+	R_STRING (pr) = object_get_class_name (pr, object);
 }

 static void
@ -1189,7 +1486,6 @@ static int
 rua_init_finish (progs_t *pr)
 {
 	pr_class_t **class_list, **class;
-	pr_category_t **category_list, **category;

 	class_list = (pr_class_t **) Hash_GetList (pr->classes);
 	if (*class_list) {
@ -1206,12 +1502,6 @@ rua_init_finish (progs_t *pr)
 	}
 	free (class_list);

-	category_list = (pr_category_t **) Hash_GetList (pr->categories);
-	if (*category_list) {
-		for (category = category_list; *category; category++)
-			finish_category (pr, *category);
-	}
-	free (category_list);
 	return 1;
 }

@ -1237,15 +1527,22 @@ rua_init_runtime (progs_t *pr)
 	else
 		Hash_FlushTable (pr->classes);

-	if (!pr->categories) {
-		pr->categories = Hash_NewTable (1021, 0, 0, pr);
-		Hash_SetHashCompare (pr->categories,
-							 category_get_hash, category_compare);
+	if (!pr->load_methods) {
+		pr->load_methods = Hash_NewTable (1021, 0, 0, pr);
+		Hash_SetHashCompare (pr->load_methods, load_methods_get_hash,
+							 load_methods_compare);
 	} else {
-		Hash_FlushTable (pr->categories);
+		Hash_FlushTable (pr->load_methods);
 	}

-	pr->fields.this = ED_GetFieldIndex (pr, ".this");
+	pr->unresolved_classes = 0;
+	pr->unclaimed_categories = 0;
+	pr->unclaimed_proto_list = 0;
+	pr->module_list = 0;
+	pr->class_tree_list = 0;
+
+	if ((def = PR_FindField (pr, ".this")))
+		pr->fields.this = def->ofs;

 	PR_AddLoadFinishFunc (pr, rua_init_finish);
 	return 1;
--- a/ruamoko/include/Object.h
+++ b/ruamoko/include/Object.h
@ -62,6 +62,8 @@ typedef enum {
@extern BOOL (id object) object_is_instance;
@extern BOOL (id object) object_is_meta_class;

+@class Protocol;
+
@protocol Object
 - (Class) class;
 - (Class) superclass;
--- a/ruamoko/include/Protocol.h
+++ b/ruamoko/include/Protocol.h
@ -0,0 +1,25 @@
+#ifndef __ruamoko_Protocol_h
+#define __ruamoko_Protocol_h
+
+#include "Object.h"
+
+struct obj_method_description {
+	string name;
+	string types;
+};
+
+@interface Protocol : Object
+{
+@private
+	string protocol_name;
+	struct obj_protocol_list [] protocol_list;
+	struct obj_method_description_list [] instance_methods, class_methods;
+}
+
+- (string) name;
+- (BOOL) conformsTo: (Protocol)aProtocolObject;
+- (struct obj_method_description []) descriptionForInstanceMethod: (SEL)aSel;
+- (struct obj_method_description []) descriptionForClassMethod: (SEL)aSel;
+@end
+
+#endif//__ruamoko_Protocol_h
--- a/ruamoko/lib/Protocol.r
+++ b/ruamoko/lib/Protocol.r
@ -0,0 +1,84 @@
+#include "Protocol.h"
+
+struct obj_protocol_list {
+	struct obj_protocol_list [] next;
+	integer count;
+	Protocol [1] list;
+};
+
+struct obj_method_description_list {
+	integer count;
+	struct obj_method_description [1] list;
+};
+
+@implementation Protocol
+- (string) name
+{
+	return protocol_name;
+}
+
+- (BOOL) conformsTo: (Protocol)aProtocolObject
+{
+	local integer i;
+	local struct obj_protocol_list [] proto_list;
+
+	if (aProtocolObject.protocol_name == protocol_name)
+		return YES;
+
+	for (proto_list = protocol_list; proto_list;
+		 proto_list = proto_list.next) {
+		for (i = 0; i < proto_list.count; i++) {
+			if ([proto_list.list[i] conformsTo: aProtocolObject])
+				return YES;
+		}
+	}
+	return NO;
+}
+
+- (struct obj_method_description []) descriptionForInstanceMethod: (SEL)aSel
+{
+	local integer i;
+	local struct obj_protocol_list [] proto_list;
+	local string name = sel_get_name (aSel);
+	local struct obj_method_description [] result;
+
+	for (i = 0; i < instance_methods.count; i++) {
+		if (instance_methods.list[i].name == name)
+			return &instance_methods.list[i];
+	}
+
+	for (proto_list = protocol_list; proto_list;
+		 proto_list = proto_list.next) {
+		for (i = 0; i < proto_list.count; i++) {
+			if ((result = [proto_list.list[i]
+						   descriptionForInstanceMethod: aSel]))
+				return result;
+		}
+	}
+	return NIL;
+}
+
+- (struct obj_method_description []) descriptionForClassMethod: (SEL)aSel
+{
+	local integer i;
+	local struct obj_protocol_list [] proto_list;
+	local string name = sel_get_name (aSel);
+	local struct obj_method_description [] result;
+
+	for (i = 0; i < class_methods.count; i++) {
+		if (class_methods.list[i].name == name)
+			return &class_methods.list[i];
+	}
+
+	for (proto_list = protocol_list; proto_list;
+		 proto_list = proto_list.next) {
+		for (i = 0; i < proto_list.count; i++) {
+			if ((result = [proto_list.list[i]
+						   descriptionForClassMethod: aSel]))
+				return result;
+		}
+	}
+	return NIL;
+}
+
+@end
--- a/tools/qfcc/include/class.h
+++ b/tools/qfcc/include/class.h
@ -64,6 +64,17 @@ typedef struct category_s {
 	class_type_t class_type;
 } category_t;

+typedef struct protocol_s {
+	const char *name;
+	struct methodlist_s *methods;
+	struct protocollist_s *protocols;
+} protocol_t;
+
+typedef struct protocollist_s {
+	int         count;
+	protocol_t **list;
+} protocollist_t;
+
 extern class_t  class_id;
 extern class_t  class_Class;
 extern class_t  class_Protocol;
@ -78,14 +89,14 @@ struct def_s *class_def (class_type_t *class_type, int external);
 void class_init (void);
 class_t *get_class (const char *name, int create);
 void class_add_methods (class_t *class, struct methodlist_s *methods);
-void class_add_protocol_methods (class_t *class, struct expr_s *protocols);
+void class_add_protocols (class_t *class, protocollist_t *protocols);
 struct struct_s *class_new_ivars (class_t *class);
 void class_add_ivars (class_t *class, struct struct_s *ivars);
 void class_check_ivars (class_t *class, struct struct_s *ivars);
 void class_begin (class_type_t *class_type);
 void class_finish (class_type_t *class_type);
 int class_access (class_type_t *current_class, class_t *class);
-struct struct_field_s *class_find_ivar (class_t *class, int protected,
+struct struct_field_s *class_find_ivar (class_t *class, int vis,
 										const char *name);
 struct expr_s *class_ivar_expr (class_type_t *class_type, const char *name);
 struct method_s *class_find_method (class_type_t *class_type,
@ -96,30 +107,17 @@ struct def_s *class_pointer_def (class_t *class_type);
 category_t *get_category (const char *class_name, const char *category_name,
 						  int create);
 void category_add_methods (category_t *category, struct methodlist_s *methods);
-void category_add_protocol_methods (category_t *category,
-									struct expr_s *protocols);
+void category_add_protocols (category_t *category, protocollist_t *protocols);
 void class_finish_module (void);

 void class_to_struct (class_t *class, struct struct_s *strct);

-typedef struct protocol_s {
-	const char *name;
-	struct methodlist_s *methods;
-	struct protocollist_s *protocols;
-} protocol_t;
-
-typedef struct protocollist_s {
-	int         count;
-	protocol_t **list;
-} protocollist_t;
-
 protocol_t *get_protocol (const char *name, int create);
 void protocol_add_methods (protocol_t *protocol, struct methodlist_s *methods);
-void protocol_add_protocol_methods (protocol_t *protocol,
-									struct expr_s *protocols);
+void protocol_add_protocols (protocol_t *protocol, protocollist_t *protocols);
 struct def_s *protocol_def (protocol_t *protocol);
-protocollist_t *new_protocollist (void);
-void add_protocol (protocollist_t *protocollist, protocol_t *protocol);
+protocollist_t *new_protocol_list (void);
+protocollist_t *add_protocol (protocollist_t *protocollist, const char *name);

 struct def_s *emit_protocol (protocol_t *protocol);
 struct def_s *emit_protocol_list (protocollist_t *protocols, const char *name);
--- a/tools/qfcc/source/class.c
+++ b/tools/qfcc/source/class.c
@ -171,31 +171,24 @@ class_add_methods (class_t *class, methodlist_t *methods)
 }

 void
-class_add_protocol_methods (class_t *class, expr_t *protocols)
+class_add_protocols (class_t *class, protocollist_t *protocols)
 {
-	expr_t     *e;
+	int         i;
 	protocol_t *p;
+	methodlist_t *methods;

-	if (!protocol_hash)
-		protocol_hash = Hash_NewTable (1021, protocol_get_key, 0, 0);
+	if (!protocols)
+		return;

-	if (!class->methods)
-		class->methods = new_methodlist ();
+	methods = class->methods;

-	for (e = protocols; e; e = e->next) {
-		methodlist_t *methods = class->methods;
-		method_t   **m = methods->tail;
-
-		if (!(p = get_protocol (e->e.string_val, 0))) {
-			error (e, "undefined protocol `%s'", e->e.string_val);
-			continue;
-		}
+	for (i = 0; i < protocols->count; i++) {
+		p = protocols->list[i];
 		copy_methods (methods, p->methods);
-		while (*m) {
-			(*m)->params->type = class->type;
-			m = &(*m)->next;
-		}
+		if (p->protocols)
+			class_add_protocols (class, p->protocols);
 	}
+	class->protocols = protocols;
 }

 void
@ -239,8 +232,6 @@ class_begin (class_type_t *class_type)
 		meta->instance_size = type_size (type_Class.aux_type);
 		EMIT_DEF (meta->ivars,
 				  emit_struct (type_Class.aux_type->s.class->ivars, "Class"));
-		EMIT_DEF (meta->protocols,
-				  emit_protocol_list (class->protocols, class->name));

 		class->def->initialized = class->def->constant = 1;
 		class->def->nosave = 1;
@ -254,7 +245,8 @@ class_begin (class_type_t *class_type)
 		}
 		EMIT_STRING (cls->name, class->name);
 		cls->info = _PR_CLS_CLASS;
-		cls->protocols = meta->protocols;
+		EMIT_DEF (cls->protocols,
+				  emit_protocol_list (class->protocols, class->name));
 	}
 }

@ -313,16 +305,15 @@ class_finish (class_type_t *class_type)
 		pr_category_t *pr_category;
 		category_t *category = class_type->c.category;
 		class_t    *class = category->class;
+		char       *name;

+		name = nva ("%s_%s", class->name, category->name);
 		pr_category = &G_STRUCT (pr_category_t, category->def->ofs);
 		EMIT_DEF (pr_category->instance_methods,
-				emit_methods (category->methods, va ("%s_%s",
-						class->name,
-						category->name), 1));
+				emit_methods (category->methods, name, 1));
 		EMIT_DEF (pr_category->class_methods,
-				emit_methods (category->methods, va ("%s_%s",
-						class->name,
-						category->name), 0));
+				emit_methods (category->methods, name, 0));
+		free (name);
 		emit_class_ref (class->name);
 		emit_category_name (class->name, category->name);
 	} else {
@ -609,32 +600,24 @@ category_add_methods (category_t *category, methodlist_t *methods)
 }

 void
-category_add_protocol_methods (category_t *category, expr_t *protocols)
+category_add_protocols (category_t *category, protocollist_t *protocols)
 {
-	expr_t     *e;
+	int         i;
 	protocol_t *p;
-	type_t     *type;
+	methodlist_t *methods;

-	if (!protocol_hash)
-		protocol_hash = Hash_NewTable (1021, protocol_get_key, 0, 0);
-	if (!category->methods)
-		category->methods = new_methodlist ();
-	type = category->class->type;
+	if (!protocols)
+		return;

-	for (e = protocols; e; e = e->next) {
-		methodlist_t *methods = category->methods;
-		method_t   **m = methods->tail;
+	methods = category->methods;

-		if (!(p = get_protocol (e->e.string_val, 0))) {
-			error (e, "undefined protocol `%s'", e->e.string_val);
-			continue;
-		}
+	for (i = 0; i < protocols->count; i++) {
+		p = protocols->list[i];
 		copy_methods (methods, p->methods);
-		while (*m) {
-			(*m)->params->type = type;
-			m = &(*m)->next;
-		}
+		if (p->protocols)
+			category_add_protocols (category, p->protocols);
 	}
+	category->protocols = protocols;
 }

 def_t *
@ -752,8 +735,10 @@ class_finish_module (void)
 	build_function (init_func);
 	init_expr = new_block_expr ();
 	append_expr (init_expr,
-			function_expr (new_def_expr (exec_class_def),
-				address_expr (new_def_expr (module_def), 0, 0)));
+			build_function_call (new_def_expr (exec_class_def),
+								 exec_class_def->type,
+								 address_expr (new_def_expr (module_def),
+									 		   0, 0)));
 	emit_function (init_func, init_expr);
 	finish_function (init_func);
 }
@ -774,6 +759,7 @@ get_protocol (const char *name, int create)

 	p = calloc (sizeof (protocol_t), 1);
 	p->name = name;
+	p->methods = new_methodlist ();
 	if (name)
 		Hash_Add (protocol_hash, p);
 	return p;
@ -784,29 +770,15 @@ protocol_add_methods (protocol_t *protocol, methodlist_t *methods)
 {
 	if (!methods)
 		return;
-	if (!protocol->methods)
-		protocol->methods = new_methodlist ();
 	*protocol->methods->tail = methods->head;
 	protocol->methods->tail = methods->tail;
 	free (methods);
 }

 void
-protocol_add_protocol_methods (protocol_t *protocol, expr_t *protocols)
+protocol_add_protocols (protocol_t *protocol, protocollist_t *protocols)
 {
-	expr_t     *e;
-	protocol_t *p;
-
-	if (!protocol->methods)
-		protocol->methods = new_methodlist ();
-
-	for (e = protocols; e; e = e->next) {
-		if (!(p = get_protocol (e->e.string_val, 0))) {
-			error (e, "undefined protocol `%s'", e->e.string_val);
-			continue;
-		}
-		copy_methods (protocol->methods, p->methods);
-	}
+	protocol->protocols = protocols;
 }

 def_t *
@ -816,7 +788,7 @@ protocol_def (protocol_t *protocol)
 }

 protocollist_t *
-new_protocollist (void)
+new_protocol_list (void)
 {
 	protocollist_t *protocollist = malloc (sizeof (protocollist_t));

@ -825,6 +797,22 @@ new_protocollist (void)
 	return protocollist;
 }

+protocollist_t *
+add_protocol (protocollist_t *protocollist, const char *name)
+{
+	protocol_t *protocol = get_protocol (name, 0);
+
+	if (!protocol) {
+		error (0, "undefined protocol `%s'", name);
+		return protocollist;
+	}
+	protocollist->count++;
+	protocollist->list = realloc (protocollist->list,
+								  sizeof (protocol_t) * protocollist->count);
+	protocollist->list[protocollist->count - 1] = protocol;
+	return protocollist;
+}
+
 def_t *
 emit_protocol (protocol_t *protocol)
 {
@ -841,11 +829,12 @@ emit_protocol (protocol_t *protocol)
 	EMIT_STRING (proto->protocol_name, protocol->name);
 	EMIT_DEF (proto->protocol_list,
 			  emit_protocol_list (protocol->protocols,
-								  va ("PROTOCOLo_%s", protocol->name)));
+								  va ("PROTOCOL_%s", protocol->name)));
 	EMIT_DEF (proto->instance_methods,
-			  emit_methods (protocol->methods, protocol->name, 1));
+			  emit_method_descriptions (protocol->methods, protocol->name, 1));
 	EMIT_DEF (proto->class_methods,
-			  emit_methods (protocol->methods, protocol->name, 0));
+			  emit_method_descriptions (protocol->methods, protocol->name, 0));
+	emit_class_ref ("Protocol");
 	return proto_def;
 }

--- a/tools/qfcc/source/modules.c
+++ b/tools/qfcc/source/modules.c
@ -92,6 +92,31 @@ dump_selector (progs_t *pr, pr_sel_t *sel)
 		printf ("          %s\n", sel_types);
 }

+static void
+dump_protocol (progs_t *pr, pr_protocol_t *proto)
+{
+	const char *protocol_name = "<invalid string>";
+	printf ("                %d\n", proto->class_pointer);
+	if (PR_StringValid (pr, proto->protocol_name))
+		protocol_name = PR_GetString (pr, proto->protocol_name);
+	printf ("                <%s>\n", protocol_name);
+}
+
+static void
+dump_protocol_list (progs_t *pr, pr_protocol_list_t *list)
+{
+	int         i;
+	printf ("            %d\n", list->next);
+	printf ("            %d\n", list->count);
+	for (i = 0; i < list->count; i++) {
+		if (list->list[i] <= 0 || list->list[i] >= pr->globals_size) {
+			printf ("invalid pointer\n");
+			break;
+		}
+		dump_protocol (pr, &G_STRUCT (pr, pr_protocol_t, list->list[i]));
+	}
+}
+
 static void
 dump_class (progs_t *pr, pr_class_t *class)
 {
@ -113,6 +138,10 @@ dump_class (progs_t *pr, pr_class_t *class)
 			class->info, class->instance_size);
 	dump_methods (pr, &G_STRUCT (pr, pr_method_list_t, class->methods), 0);
 	dump_methods (pr, &G_STRUCT (pr, pr_method_list_t, meta->methods), 1);
+	printf ("        %d\n", class->protocols);
+	if (class->protocols)
+		dump_protocol_list (pr, &G_STRUCT (pr, pr_protocol_list_t,
+										   class->protocols));
 }

 static void
@ -133,6 +162,10 @@ dump_category (progs_t *pr, pr_category_t *category)
 	dump_methods (pr,
 				  &G_STRUCT (pr, pr_method_list_t, category->class_methods),
 				  1);
+	printf ("        %d\n", category->protocols);
+	if (category->protocols)
+		dump_protocol_list (pr, &G_STRUCT (pr, pr_protocol_list_t,
+										   category->protocols));
 }

 static void
--- a/tools/qfcc/source/qc-lex.l
+++ b/tools/qfcc/source/qc-lex.l
@ -298,7 +298,7 @@ static keyword_t keywords[] = {
 	{"function",	TYPE,	&type_function,		0, PROG_VERSION},
 	{"id",			TYPE,	&type_id,			0, PROG_VERSION},
 	{"Class",		TYPE,	&type_Class,		0, PROG_VERSION},
-	{"Protocol",	TYPE,	&type_Protocol,		0, PROG_VERSION},
+//	{"Protocol",	TYPE,	&type_Protocol,		0, PROG_VERSION},
 	{"Method",		TYPE,	&type_Method,		0, PROG_VERSION},
 	{"Super",		TYPE,	&type_Super,		0, PROG_VERSION},
 	{"SEL",			TYPE,	&type_SEL,			0, PROG_VERSION},
--- a/tools/qfcc/source/qc-parse.y
+++ b/tools/qfcc/source/qc-parse.y
@ -117,6 +117,7 @@ expr_t *argv_expr (void);
 	struct category_s *category;
 	struct class_type_s	*class_type;
 	struct protocol_s *protocol;
+	struct protocollist_s *protocol_list;
 	struct keywordarg_s *keywordarg;
 	struct methodlist_s *methodlist;
 	struct struct_s *strct;
@ -175,7 +176,7 @@ expr_t *argv_expr (void);
 %type	<param>	optparmlist unaryselector keyworddecl keywordselector
 %type	<method> methodproto methoddecl
 %type	<expr>	obj_expr identifier_list obj_messageexpr obj_string receiver
-%type	<expr>	protocolrefs protocol_list
+%type	<protocol_list>	protocolrefs protocol_list
 %type	<keywordarg> messageargs keywordarg keywordarglist selectorarg
 %type	<keywordarg> keywordnamelist keywordname
 %type	<class> class_name new_class_name class_with_super new_class_with_super
@ -1242,29 +1243,29 @@ protocol_name

 classdef
 	: INTERFACE new_class_name
-	  protocolrefs						{ class_add_protocol_methods ($2, $3);}
+	  protocolrefs						{ class_add_protocols ($2, $3);}
 	  '{'								{ $$ = $2; }
 	  ivar_decl_list '}'				{ class_add_ivars ($2, $7); $$ = $2; }
 	  methodprotolist					{ class_add_methods ($2, $10); }
 	  END								{ current_class = 0; }
 	| INTERFACE new_class_name
-	  protocolrefs					{ class_add_protocol_methods ($2, $3); }
+	  protocolrefs					{ class_add_protocols ($2, $3); }
 					{ class_add_ivars ($2, class_new_ivars ($2)); $$ = $2; }
 	  methodprotolist					{ class_add_methods ($2, $6); }
 	  END								{ current_class = 0; }
 	| INTERFACE new_class_with_super
-	  protocolrefs						{ class_add_protocol_methods ($2, $3);}
+	  protocolrefs						{ class_add_protocols ($2, $3);}
 	  '{'								{ $$ = $2; }
 	  ivar_decl_list '}'				{ class_add_ivars ($2, $7); $$ = $2; }
 	  methodprotolist					{ class_add_methods ($2, $10); }
 	  END								{ current_class = 0; }
 	| INTERFACE new_class_with_super
-	  protocolrefs					{ class_add_protocol_methods ($2, $3); }
+	  protocolrefs						{ class_add_protocols ($2, $3); }
 					{ class_add_ivars ($2, class_new_ivars ($2)); $$ = $2; }
 	  methodprotolist					{ class_add_methods ($2, $6); }
 	  END								{ current_class = 0; }
 	| INTERFACE new_category_name
-	  protocolrefs	{ category_add_protocol_methods ($2, $3); $$ = $2->class;}
+	  protocolrefs		{ category_add_protocols ($2, $3); $$ = $2->class;}
 	  methodprotolist					{ category_add_methods ($2, $5); }
 	  END								{ current_class = 0; }
 	| IMPLEMENTATION class_name			{ class_begin (&$2->class_type); }
@ -1280,14 +1281,15 @@ classdef

 protocoldef
 	: PROTOCOL protocol_name 
-	  protocolrefs	{ protocol_add_protocol_methods ($2, $3); $<class>$ = 0; }
+	  protocolrefs			{ protocol_add_protocols ($2, $3); $<class>$ = 0; }
 	  methodprotolist			{ protocol_add_methods ($2, $5); }
 	  END
 	;

 protocolrefs
 	: /* emtpy */				{ $$ = 0; }
-	| LT protocol_list GT		{ $$ = $2->e.block.head; }
+	| LT 						{ $$ = new_protocol_list (); }
+	  protocol_list GT			{ $$ = $3; }
 	;

 protocol_list
@ -1297,8 +1299,7 @@ protocol_list
 		}
 	| protocol_list ',' identifier
 		{
-			append_expr ($1, new_name_expr ($3));
-			$$ = $1;
+			$$ = add_protocol ($1, $3);
 		}
 	;

--- a/tools/qfcc/source/type.c
+++ b/tools/qfcc/source/type.c
@ -804,6 +804,7 @@ chain_initial_types (void)
 	chain_type (&type_Class);
 	chain_type (&type_Protocol);
 	chain_type (&type_id);
+	chain_type (&type_method_description);
 	chain_type (type_category);
 	chain_type (type_ivar);

--- a/tools/qwaq/progs.src.in
+++ b/tools/qwaq/progs.src.in
@ -2,6 +2,11 @@ qwaq.dat

@srcdir@/defs.qc

+@top_srcdir@/ruamoko/lib/plist.r
+@top_srcdir@/ruamoko/lib/qfile.r
+@top_srcdir@/ruamoko/lib/script.r
+@top_srcdir@/ruamoko/lib/string.r
@top_srcdir@/ruamoko/lib/Object.r
+@top_srcdir@/ruamoko/lib/Protocol.r -D__ruamoko_Object_h
@srcdir@/test.r
@srcdir@/main.qc
--- a/tools/qwaq/test.r
+++ b/tools/qwaq/test.r
@ -8,6 +8,12 @@

@implementation Foo

+load
+{
+	print ("+load\n");
+	return self;
+}
+
 +alloc
 {
 	print ("+alloc\n");