[foo-cvs] foo/elkfoo/src Makefile.am,1.7,1.8 pointer.m,1.5,1.6 tell.m,1.11,1.12

[Martin R. <ru...@us...>]

Update of /cvsroot/foo/foo/elkfoo/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28479/src

Modified Files:
	Makefile.am pointer.m tell.m 
Log Message:
cleaned up ObjC message passing stuff

Index: pointer.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/pointer.m,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** pointer.m	8 Aug 2004 18:18:36 -0000	1.5
--- pointer.m	9 Aug 2004 01:42:05 -0000	1.6
***************
*** 59,97 ****
  SchemeObject Null_Pointer;
  
- static char *type_names[] = {	/* corresponds to #defines in pointer.h */
- 	    "DUMMY",		/* 0 */
- 	    "char",		/* 1 */
- 	    "short",		/* 2 */
- 	    "int",		/* 3 */
- 	    "long",		/* 4 */
- 	    "uchar",		/* 5 */
- 	    "ushort",		/* 6 */
- 	    "uint",		/* 7 */
- 	    "ulong",		/* 8 */
- 	    "float",		/* 9 */
- 	    "double",		/* 10 */
- 	    "void*",		/* 11 */
- 	    "char*",		/* 12 */
- 	    "short*",		/* 13 */
- 	    "int*",		/* 14 */
- 	    "long*",		/* 15 */
- 	    "uchar*",		/* 16 */
- 	    "ushort*",		/* 17 */
- 	    "uint*",		/* 18 */
- 	    "ulong*",		/* 19 */
- 	    "float*",		/* 20 */
- 	    "double*",		/* 21 */
- 	    "id",		/* 22 */
- 	    "class",		/* 23 */
- 	    "sel",		/* 24 */
- 	    "struct*",		/* 25 */
- 	    "union*",		/* 26 */
- 	    "array*",		/* 27 */
- 	    "undefined",	/* 28 */
- 	    "char**",		/* 29 */
- 	    "undefined*",	/* 30 */
- };
- 
- 
  static SchemeObject
  P_Pointerp(SchemeObject x)
--- 59,62 ----
***************
*** 105,109 ****
  {
    Check_Type(x, T_Pointer);
!   return POINTER_T(x)->pointer == (void *)0 ? True : False;
  }
  
--- 70,74 ----
  {
    Check_Type(x, T_Pointer);
!   return POINTER_T(x)->pointer == NULL ? True : False;
  }
  
***************
*** 113,118 ****
  {
    Check_Type(ptr, T_Pointer);
!   return Make_String(type_names[POINTER_T(ptr)->type.data],
! 		     strlen(type_names[POINTER_T(ptr)->type.data]));
  }
  
--- 78,83 ----
  {
    Check_Type(ptr, T_Pointer);
!   return Make_String(elkfoo_type_names[POINTER_T(ptr)->type.data],
! 		     strlen(elkfoo_type_names[POINTER_T(ptr)->type.data]));
  }
  
***************
*** 143,147 ****
  		SchemeObject type)
  {
-   //    SchemeObject pointer;
    int i;
  
--- 108,111 ----
***************
*** 156,164 ****
    for (i = C_pointers; i < C_last; i++)
      {
!       if (strlen(type_names[i]) != STRING(type)->size)
  	{
  	  continue;
  	}
!       if (strcmp(STRING(type)->data, type_names[i]) == 0)
  	{
  	  break;
--- 120,128 ----
    for (i = C_pointers; i < C_last; i++)
      {
!       if (strlen(elkfoo_type_names[i]) != STRING(type)->size)
  	{
  	  continue;
  	}
!       if (strcmp(STRING(type)->data, elkfoo_type_names[i]) == 0)
  	{
  	  break;
***************
*** 174,221 ****
  
  
- static SchemeObject
- Reference_Address (int p,
- 		   int t,
- 		   SchemeObject b)
- {
-   switch (t)
-     {
-     case C_CHAR:
-     case C_UNSIGNED_CHAR:
-       return Make_String((char *)p, strlen((char *)p));
- 
-     case C_SHORT:
-       return Make_Integer(*((short *)p));
- 
-     case C_INT:
-       return Make_Integer(*((int *)p));
- 
-     case C_LONG:
-       return Make_Integer(*((long *)p));
- 
-     case C_UNSIGNED_SHORT:
-       return Make_Unsigned(*((unsigned short *)p));
- 
-     case C_UNSIGNED_INT:
-       return Make_Unsigned(*((unsigned int *)p));
- 
-     case C_UNSIGNED_LONG:
-       return Make_Unsigned(*((unsigned long *)p));
- 
-     case C_FLOAT:
-       return Make_Reduced_Flonum(*((float *)p));
- 
-     case C_DOUBLE:
-       return Make_Reduced_Flonum(*((double *)p));
- 
-     case C_CHARPTR:
-       return Make_String(*((char **)p), strlen((*(char **)p)));
- 
-     default:
-       return Null;
-     }
- }
- 
- 
  static int
  Get_String_List_Items (char **p,
--- 138,141 ----
***************
*** 284,297 ****
    if (items == 1)
      {
!       result = Reference_Address(addr, type, pointer);
      }
    else
      {
        if (type == C_CHARPTR)
! 	items = Get_String_List_Items((char **)addr, items);
        result = Make_Vector(items, Null);
        for (i = 0; i < items; i++)
  	{
! 	  VECTOR(result)->data[i] = Reference_Address(addr, type, pointer);
  	  switch (type)
  	    {
--- 204,222 ----
    if (items == 1)
      {
!       result = A_Get_Object_From_Buffer(addr, type);
      }
    else
      {
        if (type == C_CHARPTR)
! 	{
! 	  items = Get_String_List_Items((char **)addr, items);
! 	}
! 
        result = Make_Vector(items, Null);
+ 
        for (i = 0; i < items; i++)
  	{
! 	  VECTOR(result)->data[i] = A_Get_Object_From_Buffer(addr, type);
! 
  	  switch (type)
  	    {
***************
*** 372,385 ****
  
  static int
! Pointer_Print(SchemeObject x,
! 	      SchemeObject port,
! 	      int raw,
! 	      int depth,
! 	      int length)
  {
    int type;
    GC_Node2;
  
!   GC_Link2(port, x);
    type = POINTER_T(x)->type.data;
    if (type < C_base || type > C_last)
--- 297,311 ----
  
  static int
! Pointer_Print (SchemeObject x,
! 	       SchemeObject port,
! 	       int raw,
! 	       int depth,
! 	       int length)
  {
    int type;
    GC_Node2;
  
!   GC_Link2(x, port);
! 
    type = POINTER_T(x)->type.data;
    if (type < C_base || type > C_last)
***************
*** 395,399 ****
        // FIXME: THIS MIGHT GET BETTER USING HIGHLEVEL CALLS
  
!       Printf(port, "#[pointer <%s>", type_names[type]);
        if (type == C_ID)
  	{
--- 321,325 ----
        // FIXME: THIS MIGHT GET BETTER USING HIGHLEVEL CALLS
  
!       Printf(port, "#[pointer <%s>", elkfoo_type_names[type]);
        if (type == C_ID)
  	{
***************
*** 432,442 ****
  			  Pointer_Equal, Pointer_Equal, Pointer_Print, NOFUNC);
    Null_Pointer = A_Make_Pointer(0, C_VOID);
!   Define_Primitive(P_Pointerp, "pointer?", 1, 1, EVAL);
!   Define_Primitive(P_Null_Pointerp, "null-pointer?", 1, 1, EVAL);
!   Define_Primitive(P_Make_Pointer, "make-pointer", 2, 2, EVAL);
!   Define_Primitive(P_Pointer_Type, "pointer-type", 1, 1, EVAL);
!   Define_Primitive(P_Pointer_Addr, "pointer-addr", 1, 1, EVAL);
!   Define_Primitive(P_Pointer_Ref, "pointer-ref", 1, 3, VARARGS);
!   Define_Primitive(P_Pointer_Set, "pointer-set!", 2, 2, EVAL);
  
    P_Provide(Intern("pointer"));
--- 358,369 ----
  			  Pointer_Equal, Pointer_Equal, Pointer_Print, NOFUNC);
    Null_Pointer = A_Make_Pointer(0, C_VOID);
! 
!   Define_Primitive(P_Pointerp,		"pointer?",		1, 1, EVAL);
!   Define_Primitive(P_Null_Pointerp,	"null-pointer?",	1, 1, EVAL);
!   Define_Primitive(P_Make_Pointer,	"make-pointer",		2, 2, EVAL);
!   Define_Primitive(P_Pointer_Type,	"pointer-type",		1, 1, EVAL);
!   Define_Primitive(P_Pointer_Addr,	"pointer-addr",		1, 1, EVAL);
!   Define_Primitive(P_Pointer_Ref,	"pointer-ref",		1, 3, VARARGS);
!   Define_Primitive(P_Pointer_Set,	"pointer-set!",		2, 2, EVAL);
  
    P_Provide(Intern("pointer"));

Index: Makefile.am
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/Makefile.am,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Makefile.am	6 Aug 2004 05:59:07 -0000	1.7
--- Makefile.am	9 Aug 2004 01:42:05 -0000	1.8
***************
*** 29,32 ****
--- 29,33 ----
  	task.m \
  	tell.m \
+ 	types.m \
  	misc.c \
  	fractone.c \

Index: tell.m
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/src/tell.m,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** tell.m	8 Aug 2004 18:18:37 -0000	1.11
--- tell.m	9 Aug 2004 01:42:05 -0000	1.12
***************
*** 60,156 ****
  #include "elkfoo.h"
  
- #define SKIP_BODY(p, c) while (*p != c) if (!*p) goto format_error; else p++;
- 
- static int
- Convert_Type (const char *type)
- {
-   int t;
- 
-   switch (*type++)
-     {
-     case '\0':		return 0;
-     case _C_ID:		return C_ID;
-     case _C_CLASS:	return C_CLASS;
-     case _C_SEL:	return C_SEL;
-     case _C_CHR:	return C_char;
-     case _C_UCHR:	return C_unsigned_char;
-     case _C_SHT:	return C_short;
-     case _C_USHT:	return C_unsigned_short;
-     case _C_INT:	return C_int;
-     case _C_UINT:	return C_unsigned_int;
-     case _C_LNG:	return C_long;
-     case _C_ULNG:	return C_unsigned_long;
-     case _C_FLT:	return C_float;
-     case _C_DBL:	return C_double;
-     case _C_VOID:	return C_VOID;
-     case _C_UNDEF:	return C_undef;
-     case _C_CHARPTR:	return C_CHAR;
-     case _C_STRUCT_B:	goto dont_accept;
- 
-     case _C_PTR:
-       switch (*type++)
- 	{
- 	case '\0':		goto format_error;
- 	case _C_CHR:		return C_CHAR;
- 	case _C_UCHR:		return C_UNSIGNED_CHAR;
- 	case _C_SHT:		return C_SHORT;
- 	case _C_USHT:		return C_UNSIGNED_SHORT;
- 	case _C_INT:		return C_INT;
- 	case _C_UINT:		return C_UNSIGNED_INT;
- 	case _C_LNG:		return C_LONG;
- 	case _C_ULNG:		return C_UNSIGNED_LONG;
- 	case _C_FLT:		return C_FLOAT;
- 	case _C_DBL:		return C_DOUBLE;
- 	case _C_VOID:		return C_VOID;
- 	case _C_UNDEF:		return C_UNDEF;
- 	case _C_CHARPTR:	return C_CHARPTR;
- 
- 	case _C_ARY_B:
- 	  SKIP_BODY(type, _C_ARY_E);
- 	  type++;
- 	  return C_ARRAY;
- 
- 	case _C_UNION_B:
- 	  SKIP_BODY(type, _C_UNION_E);
- 	  type++;
- 	  return C_UNION;
- 
- 	case _C_STRUCT_B:
- 	  SKIP_BODY(type, _C_STRUCT_E);
- 	  type++;
- 	  return C_STRUCT;
- 
- 	case _C_ARY_E:
- 	case _C_UNION_E:
- 	case _C_STRUCT_E:
- 	  goto dont_accept;
- 
- 	default:
- 	  goto format_error;
- 	}
- 	/* NOTREACHED */
-     case _C_ARY_B:
-     case _C_UNION_B:
-       goto dont_accept;
- 
-     case _C_ARY_E:
-     case _C_UNION_E:
-     case _C_STRUCT_E:
- 
-     default:
-       goto format_error;
-     }
-     /* NOTREACHED */
- 
-  format_error:
-   Primitive_Error("format error in objc method_types string detected");
- 
-  dont_accept:
-   Primitive_Error("argument or return type of method not supported");
-   /*NOTREACHED*/
- 
-   return 0; /* to avoid compiler warning */
- }
- 
  
  static SchemeObject
--- 60,63 ----
***************
*** 158,162 ****
  	SchemeObject *argv)
  {
!   SchemeObject receiver, selector, result;
    NSString *name;
    SEL sel;
--- 65,69 ----
  	SchemeObject *argv)
  {
!   SchemeObject receiver, selector, ret;
    NSString *name;
    SEL sel;
***************
*** 164,169 ****
    NSInvocation *invoc;
    NSMethodSignature *sign;
!   int offset, size, i, rettype, retsize, t;
!   char retval[16];
  
    receiver = argv[0];
--- 71,77 ----
    NSInvocation *invoc;
    NSMethodSignature *sign;
!   int i, retsize;
!   elkfoo_type_t rettype;
!   char valbuf[16];
  
    receiver = argv[0];
***************
*** 177,181 ****
      case T_String:
        name = [NSString stringWithCString: Get_String(receiver)];
-       AUTORELEASE(name);
  
        if ((obj = NSClassFromString(name)) == nil)
--- 85,88 ----
***************
*** 210,214 ****
      case T_String:
        name = [NSString stringWithCString: Get_String(selector)];
-       AUTORELEASE(name);
  
        if ((sel = NSSelectorFromString(name)) == 0)
--- 117,120 ----
***************
*** 258,435 ****
      }
  
-   rettype = Convert_Type([sign methodReturnType]);
-   retsize = [sign methodReturnLength];
- 
- #define SET_OBJC_ARG [invoc setArgument: &value atIndex: i + 2]; break
- 
    for (i = 0; i < argc; i++)
      {
!       const char *type = [sign getArgumentTypeAtIndex: i + 2];
! 
!       switch (t = Convert_Type(type))
  	{
! 	case C_char:
! 	  {
! 	    char value = Get_Integer(argv[i]);
! 	    SET_OBJC_ARG;
! 	  }
! 	case C_short:
! 	  {
! 	    short value = Get_Integer(argv[i]);
! 	    SET_OBJC_ARG;
! 	  }
! 	case C_int:
! 	  {
! 	    int value = Get_Integer(argv[i]);
! 	    SET_OBJC_ARG;
! 	  }
! 	case C_long:
! 	  {
! 	    long value = Get_Integer(argv[i]);
! 	    SET_OBJC_ARG;
! 	  }
! 	case C_unsigned_char:
! 	  {
! 	    unsigned char value = Get_Integer(argv[i]);
! 	    SET_OBJC_ARG;
! 	  }
! 	case C_unsigned_short:
! 	  {
! 	    unsigned short value = Get_Integer(argv[i]);
! 	    SET_OBJC_ARG;
! 	  }
! 	case C_unsigned_int:
! 	  {
! 	    unsigned int value = Get_Integer(argv[i]);
! 	    SET_OBJC_ARG;
! 	  }
! 	case C_unsigned_long:
! 	  {
! 	    unsigned long value = Get_Integer(argv[i]);
! 	    SET_OBJC_ARG;
! 	  }
! 	case C_float:
! 	  {
! 	    float value = Get_Double(argv[i]);
! 	    SET_OBJC_ARG;
! 	    break;
! 	  }
! 	case C_double:
! 	  {
! 	    double value = Get_Double(argv[i]);
! 	    SET_OBJC_ARG;
! 	    break;
! 	  }
! 	case C_CHAR:
! 	  {
! 	    char *value;
! 	    value = Get_String(argv[i]);
! 	    SET_OBJC_ARG;
! 	    break;
! 	  }
! 	case C_VOID:
! 	case C_SHORT:
! 	case C_INT:
! 	case C_LONG:
! 	case C_UNSIGNED_CHAR:
! 	case C_UNSIGNED_SHORT:
! 	case C_UNSIGNED_INT:
! 	case C_UNSIGNED_LONG:
! 	case C_FLOAT:
! 	case C_DOUBLE:
! 	case C_ID:
! 	case C_CLASS:
! 	case C_SEL:
! 	case C_STRUCT:
! 	case C_UNION:
! 	case C_ARRAY:
! 	case C_CHARPTR:
! 	case C_UNDEF:
! 	  Check_Type(argv[i], T_Pointer);
! 	  if (POINTER_T(argv[i])->pointer != (void *)0 &&
! 	      POINTER_T(argv[i])->type.data != t)
! 	    {
! 	      Primitive_Error("pointer type mismatch: ~s", argv[i]);
! 	    }
! 	  [invoc setArgument: POINTER_T(argv[i])->pointer atIndex: i + 2];
! 	  break;
! 
! 	default:
! 	  Primitive_Error("internal error when pushing args");
  	}
      }
  
    // fire
    [invoc invoke];
!   [invoc getReturnValue: retval];
  
    RELEASE(invoc);
  
!   switch (rettype)
!     {
!     case C_char:
!       return Make_Integer(*retval);
!     case C_short:
!       return Make_Integer(*(short *)retval);
!     case C_int:
!       return Make_Integer(*(int *)retval);
!     case C_long:
!       return Make_Integer(*(long *)retval);
!     case C_unsigned_char:
!       return Make_Unsigned(*retval);
!     case C_unsigned_short:
!       return Make_Unsigned(*(short *)retval);
!     case C_unsigned_int:
!       return Make_Unsigned(*(int *)retval);
!     case C_unsigned_long:
!       return Make_Unsigned(*(long *)retval);
!     case C_float:
!       return Make_Reduced_Flonum(*(float *)retval);
!     case C_double:
!       return Make_Reduced_Flonum(*(double *)retval);
!     case C_undef:
!       return Make_Reduced_Flonum(*(int *)retval);
!     case C_CHAR:
!       if (retval == NULL)
! 	{
! 	  return False;
! 	}
!       else
! 	{
! 	  return Make_String(*(char **)retval, strlen(*(char **)retval));
! 	}
!     case C_VOID:
!     case C_SHORT:
!     case C_INT:
!     case C_LONG:
!     case C_UNSIGNED_CHAR:
!     case C_UNSIGNED_SHORT:
!     case C_UNSIGNED_INT:
!     case C_UNSIGNED_LONG:
!     case C_FLOAT:
!     case C_DOUBLE:
!     case C_ID:
!     case C_CLASS:
!     case C_SEL:
!     case C_STRUCT:
!     case C_UNION:
!     case C_ARRAY:
!     case C_CHARPTR:
!     case C_UNDEF:
!       if ((void *)retval == NULL)
! 	{
! 	  return Null_Pointer;
! 	}
!       else
! 	{
! 	  return A_Make_Pointer(*(void **)retval, rettype);
! 	}
  
!     default:
        Primitive_Error("internal error with return");
      }
  
!   /* NOTREACHED */
!   return Null_Pointer; /* avoid warning */
  }
  
--- 164,195 ----
      }
  
    for (i = 0; i < argc; i++)
      {
!       elkfoo_type_t etype = A_Map_ObjC_Type([sign getArgumentTypeAtIndex: i + 2]);
!       if (A_Get_Buffer_From_Object(valbuf, argv[i], etype))
  	{
! 	  Primitive_Error("pointer type mismatch or internal error while pushing objc arguments");
  	}
+ 
+       [invoc setArgument: valbuf atIndex: i + 2];
      }
  
+   rettype = A_Map_ObjC_Type([sign methodReturnType]);
+   retsize = [sign methodReturnLength];
+ 
    // fire
    [invoc invoke];
!   [invoc getReturnValue: valbuf];
  
    RELEASE(invoc);
  
!   ret = A_Get_Object_From_Buffer(valbuf, rettype);
  
!   if (Nullp(ret))
!     {
        Primitive_Error("internal error with return");
      }
  
!   return ret;
  }
  
***************
*** 444,448 ****
    id obj;
    char types[256];
!   int i;
      
    switch (TYPE(receiver))
--- 204,208 ----
    id obj;
    char types[256];
!   int i, n;
      
    switch (TYPE(receiver))
***************
*** 453,457 ****
      case T_String:
        name = [NSString stringWithCString: Get_String(receiver)];
-       AUTORELEASE(name);
  
        if ((obj = NSClassFromString(name)) == nil)
--- 213,216 ----
***************
*** 486,490 ****
      case T_String:
        name = [NSString stringWithCString: Get_String(selector)];
-       AUTORELEASE(name);
  
        if ((sel = NSSelectorFromString(name)) == 0)
--- 245,248 ----
***************
*** 504,513 ****
  
    *types = 0;
  
!   for (i = 2; i < [signature numberOfArguments]; ++i)
      {
        strcat(types, [signature getArgumentTypeAtIndex: i]);
  
!       if (strlen(types) > 220)
  	{
  	  strcat(types, "!!truncated");
--- 262,273 ----
  
    *types = 0;
+   n = [signature numberOfArguments];
  
!   for (i = 2; i < n; ++i)
      {
+       strcat(types, ":");
        strcat(types, [signature getArgumentTypeAtIndex: i]);
  
!       if (strlen(types) > 200)
  	{
  	  strcat(types, "!!truncated");
***************
*** 516,519 ****
--- 276,282 ----
      }
  
+   strcat(types, " returns: ");
+   strcat(types, [signature methodReturnType]);
+ 
    return Make_String(types, strlen(types));
  }
***************
*** 534,538 ****
      case T_String:
        name = [NSString stringWithCString: Get_String(selector)];
-       AUTORELEASE(name);
  
        if ((sel = NSSelectorFromString(name)) == 0)
--- 297,300 ----