[uim-commit] r994 - branches/r5rs/sigscheme

[kzk at freedesktop.org]

Author: kzk
Date: 2005-07-20 23:30:43 -0700 (Wed, 20 Jul 2005)
New Revision: 994

Modified:
   branches/r5rs/sigscheme/datas.c
   branches/r5rs/sigscheme/operations.c
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/sigschemetype.h
Log:
* add ScmCPointer type and ScmCFuncPointer type for C-Programming
  Interface.

* sigscheme/sigscheme.h
* sigscheme/datas.c
  - (Scm_NewCPointer, Scm_NewCFuncPointer): new func
* sigscheme/sigschemetype.h
  - add ScmCPointer type and ScmCFuncPointer type
* sigscheme/operations.c
  - (ScmOp_eqvp, ScmOp_equalp): handle ScmCPointer and ScmCFuncPointer



Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c	2005-07-21 06:17:22 UTC (rev 993)
+++ branches/r5rs/sigscheme/datas.c	2005-07-21 06:30:43 UTC (rev 994)
@@ -637,6 +637,28 @@
     return obj;
 }
 
+ScmObj Scm_NewCPointer(void *data)
+{
+    ScmObj obj = SCM_NIL;
+    SCM_NEW_OBJ_INTERNAL(obj);
+
+    SCM_SETC_POINTER(obj);
+    SCM_SETC_POINTER_DATA(obj, data);
+
+    return obj;
+}
+
+ScmObj Scm_NewCFuncPointer(void (*func)(void))
+{
+    ScmObj obj = SCM_NIL;
+    SCM_NEW_OBJ_INTERNAL(obj);
+
+    SCM_SETC_FUNCPOINTER(obj);
+    SCM_SETC_FUNCPOINTER_FUNC(obj, func);
+
+    return obj;
+}
+
 /*
  * Symbol Name Hash Related Functions
  *

Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c	2005-07-21 06:17:22 UTC (rev 993)
+++ branches/r5rs/sigscheme/operations.c	2005-07-21 06:30:43 UTC (rev 994)
@@ -127,6 +127,12 @@
         case ScmFreeCell:
             SigScm_Error("eqv? : cannnot compare freecell, gc broken?\n");
             break;
+	case ScmCPointer:
+	case ScmCFuncPointer:
+	    if (EQ(obj1, obj2))
+	    {
+		return SCM_TRUE;
+	    }
     }
 
     return SCM_FALSE;
@@ -238,6 +244,18 @@
         case ScmFreeCell:
             SigScm_Error("equal? : cannnot compare freecell, gc broken?\n");
             break;
+	case ScmCPointer:
+	    if (SCM_C_POINTER_DATA(obj1) == SCM_C_POINTER_DATA(obj2))
+	    {
+		return SCM_TRUE;
+	    }
+	    break;
+	case ScmCFuncPointer:
+	    if (SCM_C_FUNCPOINTER_FUNC(obj1) == SCM_C_FUNCPOINTER_FUNC(obj2))
+	    {
+		return SCM_TRUE;
+	    }
+	    break;
     }
 
     return SCM_FALSE;

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-07-21 06:17:22 UTC (rev 993)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-07-21 06:30:43 UTC (rev 994)
@@ -124,6 +124,8 @@
 ScmObj Scm_NewVector(ScmObj *vec, int len);
 ScmObj Scm_NewPort(FILE *file, enum ScmPortType ptype);
 ScmObj Scm_NewContinuation(void);
+ScmObj Scm_NewCPointer(void *data);
+ScmObj Scm_NewCFuncPointer(void (*func)(void));
 ScmObj Scm_Intern(const char *name);
 
 /* eval.c */

Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h	2005-07-21 06:17:22 UTC (rev 993)
+++ branches/r5rs/sigscheme/sigschemetype.h	2005-07-21 06:30:43 UTC (rev 994)
@@ -60,7 +60,10 @@
     ScmPort         = 8,
     ScmContinuation = 9,
     ScmFreeCell     = 10,
-    ScmEtc          = 11
+    ScmEtc          = 11,
+
+    ScmCPointer     = 20,
+    ScmCFuncPointer = 21
 };
 
 /* Function Type by argnuments */
@@ -184,6 +187,14 @@
         struct ScmEtc {
             int type;
         } etc;
+
+        struct ScmCPointer {
+            void *data;            
+        } c_pointer;
+
+        struct ScmCFuncPointer {
+            void (*func)(void);            
+        } c_func_pointer;
     } obj;
 };
 
@@ -307,6 +318,21 @@
     SCM_SETTYPE(a, ScmEtc);\
     SCM_SETETC_TYPE(a, etctype);
 
+/*============================================================================
+  For C-Interface
+============================================================================*/
+#define SCM_C_POINTERP(a) (SCM_GETTYPE(a) == ScmCPointer)
+#define SCM_C_POINTER(a)  (sigassert(SCM_C_POINTERP(a)), a)
+#define SCM_C_POINTER_DATA(a) (SCM_C_POINTER(a)->obj.c_pointer.data)
+#define SCM_SETC_POINTER(a) (SCM_SETTYPE(a, ScmCPointer))
+#define SCM_SETC_POINTER_DATA(a, ptr) (SCM_C_POINTER_DATA(a) = ptr)
+
+#define SCM_C_FUNCPOINTERP(a) (SCM_GETTYPE(a) == ScmCFuncPointer)
+#define SCM_C_FUNCPOINTER(a)  (sigassert(SCM_C_FUNCPOINTERP(a)), a)
+#define SCM_C_FUNCPOINTER_FUNC(a) (SCM_C_POINTER(a)->obj.c_func_pointer.func)
+#define SCM_SETC_FUNCPOINTER(a) (SCM_SETTYPE(a, ScmCFuncPointer))
+#define SCM_SETC_FUNCPOINTER_FUNC(a, funcptr) (SCM_C_FUNCPOINTER_FUNC(a) = funcptr)
+
 extern ScmObj SigScm_nil, SigScm_true, SigScm_false, SigScm_eof;
 extern ScmObj SigScm_quote, SigScm_quasiquote, SigScm_unquote, SigScm_unquote_splicing;
 extern ScmObj SigScm_unbound, SigScm_unspecified, SigScm_undef;