Hi,

Attached is a patch to derive a _send family from the libid __send
object, which adds a new member: argument_count.  In idc-generated
files, this member is automatically set to the number of arguments
(not including the receiver) using the _send_argc(NUM) macro before
calling _send or _super.  This family is local to a given idc
compilation unit, so that in the grand scheme it will be easier to
move to per-calling-site send object layouts.

In doing so, I noticed that idc's send objects can be constructed by
looking up _libid->import("__send") (which Jolt does implicitly in
function/objects/_object.st), so there's no reason to have the
_libid->send_vtable entry I introduced in
message-send-descriptors.patch... I've removed it.

The work on the function/* end of things was a lot simpler since the
foundations for dynamic send objects were already put in place by the
message-send-descriptors.patch, and there were only two places to
update with argument_count information: the send syntax first defined
in boot.k, then overridden in object.k.

Please do use this patch as an example of how to exploit the send
object in both the idc compiler and jolt-burg runtimes.  I think it's
not that difficult a read for a unidiff of ~700 lines.

There's also one embarrassing mistake I fixed here that I introduced
with message-send-descriptors.patch: _object>>doesNotUnderstand: would
recursively blow the stack if it was called by object/stage2/idc1.  To
fix it, see the "STAGE1" comment in object/st80/_object.st.

-- 
Michael FIG <[EMAIL PROTECTED]> //\
   http://michael.fig.org/    \//

Add #argument_count to the idc-generated send structure.

diff -r 231417544182 function/examples/libjolt/jolt.h
--- a/function/examples/libjolt/jolt.h	Thu Dec 06 06:27:52 2007 -0600
+++ b/function/examples/libjolt/jolt.h	Thu Dec 06 06:28:57 2007 -0600
@@ -58,9 +58,10 @@ static struct __libid *_libid= 0;
 static struct __libid *_libid= 0;
 
 #define _send_out_decl()						\
-	struct { oop _vtable; struct __send send; } _send_out_struct	\
-	  __attribute__ ((unused))= { _libid->send_vtable }
+	struct { oop _vtable; struct __send send; oop argument_count; } \
+	  _send_out_struct __attribute__ ((unused))= { _send_out_vtable }
 #define _send_out (&_send_out_struct.send)
+#define _send_argc(ARGC) do { _send_out_struct.argument_count= (oop)(ARGC << 1 | 1); } while (0)
 
 
 #define _send(MSG, RCV, ARG...) ({		\
@@ -79,6 +80,20 @@ static struct __libid *_libid= 0;
   (*_m)(_send_out, ##ARG);			\
 })
 
+
+static oop _send_out_vtable= 0;
+static oop _send_out__argument_count(struct __send *send)
+{
+  struct { struct __send send; oop argument_count; } *_self = (void *)send->state;
+  return _self->argument_count;
+}
+
+
+struct t__object
+{
+  oop _vtable[0];
+};
+
 extern oop __id__init__libjolt(void);
 static void *__libjolt_ref= __id__init__libjolt;
 
@@ -87,12 +102,19 @@ oop __id__init__(struct __libid *__libid
   if (_libid) return;
   if (!(_libid= __libid)) { fprintf(stderr, "init _libid %p\n", __libid);  abort(); }
 
+  /* Set up the flavour of _send_out object we use for this file. */
+  oop _send_out_proto= _libid->proto(_libid->import("__send"));
+  _libid->method(_send_out_proto, _libid->intern("argument_count"), (_imp_t)_send_out__argument_count);
+  _send_out_vtable= _send_out_proto->_vtable[-1];
+
   _send_out_decl();
+  _send_argc(2);
   _send(_libid->intern("_import:"), 
         _libid->_object, 
         "libjolt", 
         "__id__init__libjolt");
 
+  _send_argc(0);
   return _send(_libid->intern("initialise"), 
                _libid->import("Jolt"));
 }
diff -r 231417544182 function/jolt-burg/boot.k
--- a/function/jolt-burg/boot.k	Thu Dec 06 06:27:52 2007 -0600
+++ b/function/jolt-burg/boot.k	Thu Dec 06 06:28:57 2007 -0600
@@ -109,52 +109,55 @@
 
 ;; Allocate and free _send_out structures on the heap until we can do
 ;; stack allocations.
-(define malloc-send
+(define _send			(import "_send"))
+(define new-send
   (lambda ()
-    (let ((_send_out_struct (malloc (* 5 sizeof-long))))
+    (let ((_send_out_struct (malloc
+			     (* 6 sizeof-long)))) ;; [_send sizeof]
       (let ((_send_out (+ _send_out_struct sizeof-long)))
-	(set-long@ _send_out (- 0 1) (long@ _libid 35)) ;; send_vtable
+	(set-long@ _send_out (- 0 1)
+		   (long@ _send (- 0 1))) ;; [_send _vtable]
 	_send_out))))
-(define free-send
+(define delete-send
   (lambda (_send_out)
     (let ((_send_out_struct (- _send_out sizeof-long)))
       (free _send_out_struct))))
 
 (define _bind
-  (lambda (_send_out selector receiver)
-    ;; _send_out->receiver = receiver
+  (lambda (_send_out selector receiver argument_count)
+    ;; [_send_out receiver: receiver]
     (set-long@ _send_out 0 receiver)
-    ;; _send_out->selector = selector
+    ;; [_send_out selector: selector]
     (set-long@ _send_out 2 selector)
-    ;; _libid->bind(_send_out, _send_out->receiver)
+    ;; [_send_out argument_count: argument_count]
+    (set-long@ _send_out 4 argument_count)
+    ;; { _libid->bind(_send_out, _send_out->receiver) }
     ((long@ _libid 32) _send_out (long@ _send_out 0))))
 
 (define Array			(import "Array"))
 
-(syntax send ; (send selector receiver args...) ->
-	; (let ((__send_out (malloc-send selector receiver)))
-	;   (let ((__ret ((_bind _send_out) _send_out args...)))
-	;     (free-send __send_out)
-	;     __ret)
+(syntax send ; (send selector receiver args...)
   (lambda (form compiler)
-    (let ((_send_out (malloc-send)))
-      (let ((call   ((_bind _send_out 'copyDropFirst form) _send_out 0))
-	    (params ((_bind _send_out 'new: Array) _send_out '3))
+    (let ((_send_out (new-send)))
+      (let ((call   ((_bind _send_out 'copyDropFirst form '0) _send_out))
+	    (size   ((_bind _send_out 'size form '0) _send_out))
+	    (params ((_bind _send_out 'new: Array '1) _send_out '4))
 	    (tmp 0))
-	((_bind _send_out 'at:put: call) _send_out '0 '__f)
-	((_bind _send_out 'at:put: call) _send_out '1 '__so)
-	(set tmp ((_bind _send_out 'at: form) _send_out '1)) ;; selector
-	((_bind _send_out 'at:put: params) _send_out '0 tmp)
-	(set tmp ((_bind _send_out 'at: form) _send_out '2)) ;; receiver
-	((_bind _send_out 'at:put: params) _send_out '1 tmp)
-	((_bind _send_out 'at:put: params) _send_out '2 call)
-      (let ((send '(let ((__so (malloc-send)))
-		     (let ((__f (_bind __so : 0 : 1)))
-		       (let ((__ret : 2))
-			 (free-send __so)
+	((_bind _send_out 'at:put: call '2) _send_out '0 '__f)
+	((_bind _send_out 'at:put: call '2) _send_out '1 '__so)
+	(set tmp ((_bind _send_out 'at: form '1) _send_out '1)) ;; selector
+	((_bind _send_out 'at:put: params '2) _send_out '0 tmp)
+	(set tmp ((_bind _send_out 'at: form '1) _send_out '2)) ;; receiver
+	((_bind _send_out 'at:put: params '2) _send_out '1 tmp)
+	((_bind _send_out 'at:put: params '2) _send_out '2 (- size (<< 3 1))) ;; argument_count
+	((_bind _send_out 'at:put: params '2) _send_out '3 call)
+      (let ((send '(let ((__so (new-send)))
+		     (let ((__f (_bind __so : 0 : 1 : 2)))
+		       (let ((__ret : 3))
+			 (delete-send __so)
 			 __ret)))))
-	(let ((ret ((_bind _send_out 'withParameters: send) _send_out params)))
-	  (free-send _send_out)
+	(let ((ret ((_bind _send_out 'withParameters: send '1) _send_out params)))
+	  (delete-send _send_out)
 	  ret))))))
 
 (define CokeScanner		(import "CokeScanner"))
diff -r 231417544182 function/jolt-burg/object.k
--- a/function/jolt-burg/object.k	Thu Dec 06 06:27:52 2007 -0600
+++ b/function/jolt-burg/object.k	Thu Dec 06 06:28:57 2007 -0600
@@ -24,14 +24,15 @@
 ;; Unfortunately, we still cannot allocate _send_out on the stack.
 (syntax send ; (send selector receiver args...)
   (lambda (node compiler)
-    (or [[node size] >= '3] [compiler errorSyntax: node])
-    (let ((selector [node second])
-	  (receiver [node third]))
-      `(let ((__so (malloc-send)))
-	 (let ((__f (_bind __so ,selector ,receiver)))
-	   (let ((__ret (__f __so ,@[node copyFrom: '3])))
-	     (free-send __so)
-	     __ret))))))
+    (let ((argument_count [[node size] - '3]))
+      (or [argument_count >= '0] [compiler errorSyntax: node])
+      (let ((selector [node second])
+	    (receiver [node third]))
+	`(let ((__so (new-send)))
+	   (let ((__f (_bind __so ,selector ,receiver ',argument_count)))
+	     (let ((__ret (__f __so ,@[node copyFrom: '3])))
+	       (delete-send __so)
+	       __ret)))))))
 
 ;; define a new object type
 
diff -r 231417544182 function/objects/_object.st
--- a/function/objects/_object.st	Thu Dec 06 06:27:52 2007 -0600
+++ b/function/objects/_object.st	Thu Dec 06 06:28:57 2007 -0600
@@ -72,7 +72,7 @@ __send selector			[ ^selector ]
 __send selector			[ ^selector ]
 __send selector: aSelector	[ selector := aSelector ]
 __send _closure	 		[ ^_closure ]
-
+__send argument_count		{ _return (oop)-1; }
 
 _selector size_: _stringSize value_: _stringValue
 {
@@ -86,6 +86,10 @@ _selector _stringValue
 [
     ^_elements
 ]
+
+"Improved message send object that tracks more useful metadata."
+_send : __send ( argument_count )
+_send argument_count		[ ^argument_count ]
 
 "Compiler support: state vectors for free variables."
 
diff -r 231417544182 object/examples/Makefile
--- a/object/examples/Makefile	Thu Dec 06 06:27:52 2007 -0600
+++ b/object/examples/Makefile	Thu Dec 06 06:28:57 2007 -0600
@@ -1,5 +1,5 @@ SUBDIRS	= avl dispatch echo forward hw i
 SUBDIRS	= avl dispatch echo forward hw ignore interp libs1 libs2 libs3 parse \
-	prototype reflect serialise slots sqvm system this traits typename weak x11
+	prototype reflect serialise slots sqvm system this traits typename varargs weak x11
 
 all : .FORCE
 	test ! -f ../stage2/clean-examples || $(MAKE) clean
diff -r 231417544182 object/examples/varargs/varargs.st
--- a/object/examples/varargs/varargs.st	Thu Dec 06 06:27:52 2007 -0600
+++ b/object/examples/varargs/varargs.st	Thu Dec 06 06:28:57 2007 -0600
@@ -2,24 +2,31 @@
 
 Object foo: a ...
 [
+   | i |
    'Object.foo:' putln.
    a println.
-   ... println.
+   i := 0.
+   [i := i + 1. i < (send argument_count)] whileTrue: [... println].
 ]
 
 [
+    Object foo: 1 : 2 : 3 : 4.
     Object foo: 42 : 666.
 ]
 
 
 Object sum ...
 [
-    | sum next |
+    | sum i |
     sum := 0.
-    [next := ...] whileTrue: [sum := sum + next].
+    i := 0.
+    [i := i + 1. i <= (send argument_count)] whileTrue: [sum := sum + ...].
     ^sum
 ]
 
 [
-    (Object sum : 1 : 2 : 3 : 4 : nil) println.
+    'sums:' putln.
+    (Object sum) println.
+    (Object sum : 99) println.
+    (Object sum : 1 : 2 : 3 : 4) println.
 ]
diff -r 231417544182 object/id/id.h
--- a/object/id/id.h	Thu Dec 06 06:27:52 2007 -0600
+++ b/object/id/id.h	Thu Dec 06 06:28:57 2007 -0600
@@ -97,8 +97,8 @@ struct __libid
 
   _imp_t	 (*bind)(struct __send *send, oop receiver);	/* 32 */
   struct __closure *find_next_fragment;				/* 33 */
-  oop		   send_vtable;					/* 34 */
 
+  void		  *unused34;
   void		  *unused35;
 
   oop		 (*nlreturn)(oop nlr, oop result);	/* 36 */
diff -r 231417544182 object/id/libid.c
--- a/object/id/libid.c	Thu Dec 06 06:27:52 2007 -0600
+++ b/object/id/libid.c	Thu Dec 06 06:28:57 2007 -0600
@@ -61,9 +61,11 @@ void		  *_libid_dlsym(id_dl_t handle, co
 void		  *_libid_dlsym(id_dl_t handle, const char *symbol);
 int		   _libid_dlclose(id_dl_t handle);
 
+static oop _send_out_vtable= 0;
+
 #define _send_out_decl()						\
 	struct { oop _vtable; struct __send send; } _send_out_struct=	\
-	  { __send_vtable }
+	  { _send_out_vtable }
 #define _send_out (&_send_out_struct.send)
 #define _send(MSG, RCV, ARG...) ({			\
       _send_out->selector= (MSG);			\
@@ -130,9 +132,6 @@ static oop _assoc= 0;
 /* t__closure is just __closure */
 static oop _closure_vtable= 0;
 static oop _closure= 0;
-
-static oop __send_vtable= 0;
-static oop __send= 0;
 
 struct t__vector
 {
@@ -592,7 +591,7 @@ static char *nameOf(oop object)
       else if (vtable == _closure ->_vtable[-1]) name= "(_closure)";
       else if (vtable == _assoc   ->_vtable[-1]) name= "(_assoc)";
       else if (vtable == _vtable  ->_vtable[-1]) name= "(_vtable)";
-      else if (vtable == __send   ->_vtable[-1]) name= "(__send)";
+      else if (vtable == _send_out_vtable)       name= "(__send)";
       else if (vtable == _libid_tag_vtable)	 name= "(SmallInteger)";
       else if (vtable == _libid_nil_vtable)	 name= "(UndefinedObject)";
       else					 sprintf(buf, "(%p,%p)", object, vtable);
@@ -1033,7 +1032,8 @@ struct __libid *_libid_init(int *argcp, 
   _selector= call(_object___delegated, _object);  _selector_vtable= _selector->_vtable[-1];
   _closure=  call(_object___delegated, _object);  _closure_vtable=  _closure->_vtable[-1];
 
-  __send=    call(_object___delegated, _object);  __send_vtable=    __send->_vtable[-1];
+  oop __send= call(_object___delegated, _object);
+  _send_out_vtable= __send->_vtable[-1];
 
 # define check(type)						\
   dprintf("type %s %p\n", #type, type);				\
@@ -1112,7 +1112,6 @@ struct __libid *_libid_init(int *argcp, 
 
   _libid.bind		= _libid_bind;
   _libid.find_next_fragment= 0; /* Turn off prototypes by default. */
-  _libid.send_vtable	= __send_vtable;
 
   _libid.nlreturn	= _libid_nlreturn;
   _libid.nlresult	= _libid_nlresult;
diff -r 231417544182 object/idc/CCodeGenerator.st
--- a/object/idc/CCodeGenerator.st	Thu Dec 06 06:27:52 2007 -0600
+++ b/object/idc/CCodeGenerator.st	Thu Dec 06 06:28:57 2007 -0600
@@ -110,9 +110,10 @@ static struct __libid *_libid= 0;
 #define _return			_leave(); return
 
 #define _send_out_decl()						\\
-	struct { oop _vtable; struct __send send; } _send_out_struct	\\
-	  __attribute__ ((unused))= { _libid->send_vtable }
+	struct { oop _vtable; struct __send send; oop argument_count; } \\
+	  _send_out_struct __attribute__ ((unused))= { _send_out_vtable }
 #define _send_out (&_send_out_struct.send)
+#define _send_argc(ARGC) do { _send_out_struct.argument_count= (oop)(ARGC << 1 | 1); } while (0)
 
 ', self sendText, '
 
@@ -123,6 +124,13 @@ static struct __libid *_libid= 0;
   _send_out->state= _send_out->receiver;	\\
   (*_m)(_send_out, ##ARG);			\\
 })
+
+static oop _send_out_vtable= 0;
+static oop _send_out__argument_count(struct __send *send)
+{
+  struct { struct __send send; oop argument_count; } *_self = (void *)send->state;
+  return _self->argument_count;
+}
 ']
 
 CCodeGenerator sendText
@@ -152,18 +160,18 @@ struct __entry
   struct __closure *closure;
 };
 
-/* FIXME: Inline cache is currently incompatible with _libid->using_prototypes
+/* FIXME: Inline cache is currently incompatible with _libid->find_next_fragment
    because we assume that receiver and state are the same. */
-#define _send(MSG, RCV, ARG...) ({										\\
-  static struct __entry _e;											\\
-  _send_out->selector= (MSG);											\\
-  _send_out->receiver= (RCV);											\\
-  register oop _v= _send_out->receiver ?									\\
-      (((unsigned)_send_out->receiver & 1) ? *_libid->tag_vtable : ((oop *)_send_out->receiver)[-1]) :		\\
-	 *_libid->nil_vtable;											\\
-  if (_v == _e.vtable) { _send_out->state= _send_out->receiver; _send_out->closure= _e.closure; }		\\
-  else { _e.vtable= _v; _libid->bind(_send_out, _send_out->receiver); _e.closure= send_out->closure; }		\\
-  (_send_out->closure->method)(_send_out, ##ARG);								\\
+#define _send(MSG, RCV, ARG...) ({									\\
+  static struct __entry _e;										\\
+  _send_out->selector= (MSG);										\\
+  _send_out->receiver= (RCV);										\\
+  register oop _v= _send_out->receiver ?								\\
+      (((unsigned)_send_out->receiver & 1) ? *_libid->tag_vtable : ((oop *)_send_out->receiver)[-1]) :	\\
+	 *_libid->nil_vtable;										\\
+  if (_v == _e.vtable) { _send_out->state= _send_out->receiver; _send_out->closure= _e.closure; }	\\
+  else { _e.vtable= _v; _libid->bind(_send_out, _send_out->receiver); _e.closure= send_out->closure; }	\\
+  (_send_out->closure->method)(_send_out, ##ARG);							\\
 })
 ']
 
@@ -173,8 +181,7 @@ void __id__init__', (outputType == #obje
 void __id__init__', (outputType == #object ifTrue: [encoder mangleSelector: (fileName withoutSuffix: '.st')] ifFalse: ['']), '(struct __libid *__libid)
 {
   if (_libid) return;
-  if (!(_libid= __libid)) { fprintf(stderr, "init _libid %p\\n", __libid);  abort(); }
-  _send_out_decl();',
+  if (!(_libid= __libid)) { fprintf(stderr, "init _libid %p\\n", __libid);  abort(); }',
   (outputType == #program ifTrue: [''] ifFalse: ['
 # define GC_add_roots _libid->gc_addRoots
   GC_INIT();']), '
@@ -183,6 +190,13 @@ void __id__init__', (outputType == #obje
     for (s= _Selectors;  s->name;  ++s)
       *s->addr= _libid->intern(s->name);
   }
+
+  /* Set up the flavour of _send_out object we use for this file. */
+  oop _send_out_proto= _libid->proto(_libid->import("__send"));
+  _libid->method(_send_out_proto, _libid->intern("argument_count"), (_imp_t)_send_out__argument_count);
+  _send_out_vtable= (oop)_send_out_proto->_vtable[-1];
+
+  _send_out_decl();
   _enter("__id__init__", "<initialisation>", "', fileName escaped, '");
 ']
 
@@ -226,6 +240,8 @@ CCodeGenerator comment: aString	[ output
 
 "writing specific types of information, with a type-specific prefix"
 
+CCodeGenerator genArgc: argc	[ self gen: '  _send_argc('; print: argc; genl: ');' ]
+
 CCodeGenerator genSelector: aSelector
 [
     output
@@ -286,6 +302,8 @@ CCodeGenerator genPrimitive: code in: mt
 [
     self genl: ' {'.
     mtype isNil ifFalse: [self gen:  '# define _self (('; genStruct: mtype name; genl: ' *)send->state)'].
+    "Mark the argument count as unsupported unless they set it somehow themselves."
+    self genl: '  _send_argc(-1);'.
     self genl: code.
     mtype isNil ifFalse: [self genl: '# undef _self'].
     self genl: ' }'.
@@ -313,6 +331,7 @@ CCodeGenerator initialiseInteger: tag co
 CCodeGenerator initialiseInteger: tag constructor: constructor with: anInteger
 [
     self
+        genArgc: 1;
 	gen: '  '; genLiteral: tag; gen: '= _send(';
 	genSelector: constructor value; gen: ', ';
 	genVariable: constructor key; gen: ', ';
@@ -322,6 +341,7 @@ CCodeGenerator initialiseLargeInteger: t
 CCodeGenerator initialiseLargeInteger: tag constructor: constructor with: anInteger
 [
     self
+        genArgc: 1;
 	gen: '  '; genLiteral: tag; gen: '= _send(';
 	genSelector: constructor value; gen: ', ';
 	genVariable: constructor key; gen: ', ';
@@ -345,6 +365,7 @@ CCodeGenerator initialiseFloat: tag cons
 CCodeGenerator initialiseFloat: tag constructor: constructor with: aString
 [
     self
+        genArgc: 1;
 	gen: '  '; genLiteral: tag; gen: '= _send(';
 	genSelector: constructor value; gen: ', ';
 	genVariable: constructor key; gen: ', &d_';
@@ -354,6 +375,7 @@ CCodeGenerator initialiseCharacter: tag 
 CCodeGenerator initialiseCharacter: tag constructor: constructor with: aCharacter
 [
     self
+        genArgc: 1;
 	gen: '  '; genLiteral: tag; gen: '= _send(';
 	genSelector: constructor value; gen: ', ';
 	genVariable: constructor key; gen: ', ';
@@ -363,6 +385,7 @@ CCodeGenerator initialiseString: tag con
 CCodeGenerator initialiseString: tag constructor: constructor with: aString
 [
     self
+        genArgc: 2;
 	gen: '  '; genLiteral: tag; gen: '= _send(';
 	genSelector: constructor value;	gen: ', ';
 	genVariable: constructor key;   gen: ', ';
@@ -389,6 +412,7 @@ CCodeGenerator initialiseByteArray: tag 
 CCodeGenerator initialiseByteArray: tag constructor: constructor with: aByteArray
 [
     self
+        genArgc: 2;
 	gen: '  '; genLiteral: tag; gen: '= _send(';
 	genSelector: constructor value;	gen: ', ';
 	genVariable: constructor key;   gen: ', ';
@@ -417,6 +441,7 @@ CCodeGenerator initialiseWordArray: tag 
 CCodeGenerator initialiseWordArray: tag constructor: constructor with: aWordArray
 [
     self
+        genArgc: 2;
 	gen: '  '; genLiteral: tag; gen: '= _send(';
 	genSelector: constructor value;	gen: ', ';
 	genVariable: constructor key;   gen: ', ';
@@ -439,6 +464,7 @@ CCodeGenerator initialiseArray: tag cons
 CCodeGenerator initialiseArray: tag constructor: constructor with: anArray
 [
     self
+        genArgc: 2;
 	gen: '  '; genLiteral: tag; gen: '= _send(';
 	genSelector: constructor value;	gen: ', ';
 	genVariable: constructor key;   gen: ', ';
@@ -452,6 +478,7 @@ CCodeGenerator initialiseBlock: blockTag
 CCodeGenerator initialiseBlock: blockTag function: functionTag arity: arity constructor: constructor
 [
     self
+        genArgc: 2;
 	gen: '  '; genLiteral: blockTag; gen: '= _send(';
 	genSelector: constructor value; gen: ', ';
 	genVariable: constructor key;   gen: ', ';
@@ -475,6 +502,7 @@ CCodeGenerator makeBlock:   tag
 	       location:    location
 [
     self
+        genArgc: 5;
 	gen: '  '; genLocation: location; gen: '= _send('; genSelector: constructor value;
 	gen: ', '; genVariable: constructor key;
 	gen: ', '; gen: '(oop)'; genBlock: functionTag;			"function"
@@ -610,6 +638,7 @@ CCodeGenerator genNonLocalReturn: node
 
 CCodeGenerator send: selector to: receiver withArguments: arguments forValue: valueFlag supered: superedType
 [
+    self genArgc: arguments size.
     self gen: '  '.
     valueFlag ifTrue: [self genLocation: receiver location; gen: '='].
     superedType isNil
@@ -624,6 +653,7 @@ CCodeGenerator import: name
 CCodeGenerator import: name
 [
     self
+        genArgc: 2;
 	gen: '  ';
 	gen: '_send('; genSelector: '_import:'; gen: ', ';
 	gen: '_libid->_object'; gen: ', "';
@@ -742,6 +772,7 @@ CCodeGenerator createStateVector: size i
 CCodeGenerator createStateVector: size inScope: scopeTag constructor: constructor
 [
     self
+        genArgc: 1;
 	gen: '  '; gen: 'oop _state'; print: scopeTag; gen: '= _send(';
 	genSelector: constructor value; gen: ', ';
 	genVariable: constructor key; gen: ', ';
@@ -753,8 +784,15 @@ CCodeGenerator genState: scopeTag at: of
 
 CCodeGenerator declareVariadic: arg
 [
+    | prior |
+    prior := arg name.
     self gen: '  '; genl: 'va_list ap;'.
-    self gen: '  va_start(ap, '; genVariable: arg name; genl: ');'.
+    self gen: '  va_start(ap, '.
+    "The self and _self virtual arguments are subsumed by the send argument."
+    (prior = 'self' or: [prior = '_self'])
+      ifTrue: [self gen: 'send']
+      ifFalse: [self genVariable: prior].
+    self genl: ');'.
 ]
 
 CCodeGenerator endVariadic
@@ -764,9 +802,9 @@ CCodeGenerator endVariadic
 
 CCodeGenerator sendPreamble: blockNode
 [
-    self gen: '  '; genl: '_send_out_decl();'.
-    self genl: '# define v_send ((oop)send)'.
-    self genl: '# define v__self (send->state)'.
+    self genl: '  _send_out_decl();';
+         genl: '# define v_send ((oop)send)';
+         genl: '# define v__self (send->state)'
 ]
 
 CCodeGenerator sendPostamble: blockNode
@@ -855,24 +893,32 @@ CCodeGenerator checkTags: check with: lh
     self gen: ')'.
 ]
 
+CCodeGenerator genElseBinary: aLocation selector: aSelector in: receiver with: argument
+[
+    self
+        gen:  '  '; genl: '} else {';
+        genArgc: 1;
+        gen:  '    '; genLocation: aLocation;
+          gen: '= _send('; genSelector: aSelector; gen: ', '; genLocation: receiver; gen: ', '; genLocation: argument; genl: ');';
+        genl: '  }'
+]
+
 CCodeGenerator tagged: rcv add: arg location: loc checking: tagCheck
 [
 "
     self
 	gen: '  '; gen: 'if '; checkTags: tagCheck with: rcv with: arg; genl: ' {';
 	gen: '  '; gen: '  '; genLocation: loc; gen: '= (oop)(((int)'; genLocation: rcv; gen: ' + (int)'; genLocation: arg; genl: ') - 1);';
-	gen: '  '; gen: '} else '; genLocation: loc;
-	gen: '= _send('; genSelector: '+'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'.
+        genElseBinary: loc selector: '+' in: rcv with: arg.
 "
     self
 	genl: '  {';
 	gen:  '    int _l= (int)'; genLocation: rcv; genl: ' >> 1;';
 	gen:  '    int _r= (int)'; genLocation: arg; genl: ' >> 1;';
 	genl: '    int _s= _l + _r;';
-	gen:  '    if ('; checkTags: tagCheck with: rcv with: arg; gen: ' && ((_s ^ (_s << 1)) >= 0))';
+	gen:  '    if ('; checkTags: tagCheck with: rcv with: arg; gen: ' && ((_s ^ (_s << 1)) >= 0)) {';
 	gen:       '  '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
-	gen:  '  else '; genLocation: loc; gen: '= ';
-	gen:       '_send('; genSelector: '+'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');';
+        genElseBinary: loc selector: '+' in: rcv with: arg;
 	genl: '  }'
 ]
 
@@ -882,18 +928,16 @@ CCodeGenerator tagged: rcv sub: arg loca
     self
 	gen: '  '; gen: 'if '; checkTags: tagCheck with: rcv with: arg; genl: ' {';
 	gen: '  '; gen: '  '; genLocation: loc; gen: '= (oop)(((int)'; genLocation: rcv; gen: ' - (int)'; genLocation: arg; genl: ') + 1);';
-	gen: '  '; gen: '} else '; genLocation: loc;
-	gen: '= _send('; genSelector: '-'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'.
+        genElseBinary: loc selector: '-' in: rcv with: arg.
 "
     self
 	genl: '  {';
 	gen:  '    int _l= (int)'; genLocation: rcv; genl: ' >> 1;';
 	gen:  '    int _r= (int)'; genLocation: arg; genl: ' >> 1;';
 	genl: '    int _s= (_l - _r);';
-	gen:  '    if ('; checkTags: tagCheck with: rcv with: arg; gen: ' && ((_s ^ (_s << 1)) >= 0))';
+	gen:  '    if ('; checkTags: tagCheck with: rcv with: arg; gen: ' && ((_s ^ (_s << 1)) >= 0)) {';
 	gen:       '  '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
-	gen:  '  else '; genLocation: loc; gen: '= ';
-	gen:       '_send('; genSelector: '-'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');';
+        genElseBinary: loc selector: '-' in: rcv with: arg;
 	genl: '  }'
 ]
 
@@ -904,8 +948,7 @@ CCodeGenerator tagged: rcv op: operator 
 	gen: '  '; gen: 'if '; checkTags: tagCheck with: rcv with: arg; genl: ' {';
 	gen: '  '; gen: '  '; genLocation: loc; gen: '= (oop)(((((int)'; genLocation: rcv; gen:  '>> 1) ';
 	gen:                                   operator; gen: ' ((int)'; genLocation: arg; genl: '>> 1)) << 1) | 1);';
-	gen: '  '; gen: '} else '; genLocation: loc;
-	gen: '= _send('; genSelector: sel; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'.
+        genElseBinary: loc selector: sel in: rcv with: arg.
 ]
 
 CCodeGenerator tagged: rcv mul: arg location: loc checking: tagCheck
@@ -920,10 +963,9 @@ CCodeGenerator tagged: rcv mul: arg loca
 	genl: '    int _s= (_l * _r);';
 	gen:  '    if ('; checkTags: tagCheck with: rcv with: arg;
 	gen:         ' && ((_r == 0) || (_s / _r == _l))';
-	gen:         ' && ((_s ^ (_s << 1)) >= 0))';
+	gen:         ' && ((_s ^ (_s << 1)) >= 0)) {';
 	gen:       '  '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
-	gen:  '  else '; genLocation: loc; gen: '= ';
-	gen:       '_send('; genSelector: '*'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');';
+        genElseBinary: loc selector: '*' in: rcv with: arg;
 	genl: '  }'
 ]
 
@@ -933,6 +975,7 @@ CCodeGenerator tagged: rcv div: arg loca
     self tagged: rcv op: '/' selector: '//' with: arg location: loc checking: tagCheck
 "
     self
+        genArgc: 1;
 	gen:  '  '; genLocation: loc; gen: '= ';
 	gen:  '_send('; genSelector: '//'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'
 ]
@@ -943,6 +986,7 @@ CCodeGenerator tagged: rcv mod: arg loca
     self tagged: rcv op: '%' selector: '\\\\' with: arg location: loc checking: tagCheck
 "
     self
+        genArgc: 1;
 	gen: '  '; genLocation: loc; gen: '= ';
 	gen: '_send('; genSelector: '\\\\'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'
 ]
@@ -954,8 +998,7 @@ CCodeGenerator tagged: rcv and: arg loca
 	gen:                ' && ('; genLocation: rcv; gen: ' > 0)';
 	gen:                ' && ('; genLocation: arg; genl: ' > 0)) {';
 	gen: '  '; gen: '  '; genLocation: loc; gen: '= (oop)((int)'; genLocation: rcv; gen: ' & (int)'; genLocation: arg; genl: ');';
-	gen: '  '; gen: '} else '; genLocation: loc;
-	gen: '= _send('; genSelector: 'bitAnd:'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'.
+        genElseBinary: loc selector: 'bitAnd:' in: rcv with: arg.
 ]
 
 CCodeGenerator tagged: rcv or: arg location: loc checking: tagCheck
@@ -965,8 +1008,7 @@ CCodeGenerator tagged: rcv or: arg locat
 	gen:                ' && ('; genLocation: rcv; gen: ' > 0)';
 	gen:                ' && ('; genLocation: arg; genl: ' > 0)) {';
 	gen: '  '; gen: '  '; genLocation: loc; gen: '= (oop)((int)'; genLocation: rcv; gen: ' | (int)'; genLocation: arg; genl: ');';
-	gen: '  '; gen: '} else '; genLocation: loc;
-	gen: '= _send('; genSelector: 'bitOr:'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'.
+        genElseBinary: loc selector: 'bitOr:' in: rcv with: arg.
 ]
 
 CCodeGenerator tagged: rcv xor: arg location: loc checking: tagCheck
@@ -976,8 +1018,7 @@ CCodeGenerator tagged: rcv xor: arg loca
 	gen:                ' && ('; genLocation: rcv; gen: ' > 0)';
 	gen:                ' && ('; genLocation: arg; genl: ' > 0)) {';
 	gen: '  '; gen: '  '; genLocation: loc; gen: '= (oop)(((int)'; genLocation: rcv; gen: ' ^ (int)'; genLocation: arg; genl: ') | 1);';
-	gen: '  '; gen: '} else '; genLocation: loc;
-	gen: '= _send('; genSelector: 'bitXor:'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'.
+        genElseBinary: loc selector: 'bitXor:' in: rcv with: arg.
 ]
 
 CCodeGenerator tagged: rcv shift: arg location: loc checking: tagCheck
@@ -991,16 +1032,15 @@ CCodeGenerator tagged: rcv shift: arg lo
 	gen:                   ' && (_l == (_s >> _r))';
 	gen:                   ' && ((_s ^ (_s << 1)) >= 0) )';
 	gen:              ' || ((_r < 0) && (_r >= -31)) )';
-	gen:         ') '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
-	gen:  ' else '; genLocation: loc; gen: '= ';
-	gen:       '_send('; genSelector: 'bitShift:'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');';
+	gen:         ') { '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
+        genElseBinary: loc selector: 'bitShift:' in: rcv with: arg;
 	genl: '  }'
 ]
 
 CCodeGenerator tagged: rcv left: arg location: loc checking: tagCheck
 [
     self
-	genl: '{';
+	genl: '  {';
 	gen:  '    int _l= (int)'; genLocation: rcv; gen: ' >> 1,';
 	gen:         ' _r= (int)'; genLocation: arg; gen: ' >> 1,';
 	genl:        ' _s= (_l << _r);';
@@ -1008,9 +1048,8 @@ CCodeGenerator tagged: rcv left: arg loc
 	gen:         ' && (_r >= 0) && (_r <= 31)';
 	gen:         ' && (_l == (_s >> _r))';
 	gen:         ' && ((_s ^ (_s << 1)) >= 0)';
-	gen:         ') '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
-	gen:  ' else '; genLocation: loc; gen: '= ';
-	gen:       '_send('; genSelector: '<<'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');';
+	gen:         ') { '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
+        genElseBinary: loc selector: '<<' in: rcv with: arg;
 	genl: '  }'
 ]
 
@@ -1023,9 +1062,8 @@ CCodeGenerator tagged: rcv right: arg lo
 	genl:        ' _s= (_l >> _r);';
 	gen:  '    if ('; checkTags: tagCheck with: rcv with: arg;
 	gen:         ' && (_r >= 0) && (_r <= 31)';
-	gen:         ') '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
-	gen:  ' else '; genLocation: loc; gen: '= ';
-	gen:       '_send('; genSelector: '>>'; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');';
+	gen:         ') { '; genLocation: loc; gen: '= (oop)(_s << 1 | 1);';
+        genElseBinary: loc selector: '>>' in: rcv with: arg;
 	genl: '  }'
 ]
 
@@ -1036,8 +1074,7 @@ CCodeGenerator tagged: rcv rel: operator
 	gen: '  '; gen: '  '; genLocation: loc; gen: '= (((int)'; genLocation: rcv; gen: ' ';
 	gen:                             operator; gen: ' (int)'; genLocation: arg;
 	gen:              ') ? '; genVariable: 'true'; gen: ' : '; genVariable: 'false'; genl: ');';
-	gen: '  '; gen: '} else '; genLocation: loc;
-	gen: '= _send('; genSelector: sel; gen: ', '; genLocation: rcv; gen: ', '; genLocation: arg; genl: ');'.
+        genElseBinary: loc selector: sel in: rcv with: arg.
 ]
 
 CCodeGenerator tagged: rcv lt: arg location: loc checking: tagCheck
diff -r 231417544182 object/st80/_object.st
--- a/object/st80/_object.st	Thu Dec 06 06:27:52 2007 -0600
+++ b/object/st80/_object.st	Thu Dec 06 06:28:57 2007 -0600
@@ -66,9 +66,13 @@ _object _typeName: _cName doesNotUnderst
   abort();
 }
 
+"STAGE1: Bare selectors are passed to #doesNotUnderstand:"
+_selector selector		[ ^self ]
+
 __send selector			[ ^selector ]
 __send selector: aSelector	[ selector := aSelector ]
 __send _closure			[ ^_closure ]
+__send argument_count		{ _return (oop)-1; }
 
 _selector size_: _stringSize value_: _stringValue
 {
_______________________________________________
fonc mailing list
fonc@vpri.org
http://vpri.org/mailman/listinfo/fonc

Reply via email to