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

[kzk at freedesktop.org]

Author: kzk
Date: 2005-07-21 01:19:01 -0700 (Thu, 21 Jul 2005)
New Revision: 998

Modified:
   branches/r5rs/sigscheme/datas.c
   branches/r5rs/sigscheme/sigscheme.h
   branches/r5rs/sigscheme/sigschemetype.h
Log:
* implment getter functions for C-Interface

* sigscheme/sigschemetype.h
  - introduce C_FUNC type
* sigscheme/sigscheme.h
* sigscheme/datas.c
  - (Scm_NewStringCopying): new func
  - (Scm_GetInt, Scm_GetString, Scm_GetCPointer, Scm_GetCFuncPointer): new func



Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c	2005-07-21 07:40:29 UTC (rev 997)
+++ branches/r5rs/sigscheme/datas.c	2005-07-21 08:19:01 UTC (rev 998)
@@ -416,7 +416,7 @@
     /* get size */
     size = end - start;
 
-	printf("gc_mark_stack() size = %p\n", start);
+    printf("gc_mark_stack() size = %p\n", (void*)start);
 
     /* mark stack */
     for (i = 0; i < size; i++) {
@@ -606,6 +606,20 @@
     return obj;
 }
 
+ScmObj Scm_NewStringCopying(char *str)
+{
+    ScmObj obj = SCM_NIL;
+
+    SCM_NEW_OBJ_INTERNAL(obj);
+
+    SCM_SETSTRING(obj);
+    SCM_STRING_STR(obj) = (char *)malloc(sizeof(char) * strlen(str) + 1);
+    strcpy(SCM_STRING_STR(obj), str);
+    SCM_SETSTRING_LEN(obj, SigScm_default_encoding_strlen(str));
+
+    return obj;
+}
+
 ScmObj Scm_NewString_With_StrLen(char *str, int len)
 {
     ScmObj obj = SCM_NIL;
@@ -697,7 +711,7 @@
     return obj;
 }
 
-ScmObj Scm_NewCFuncPointer(void (*func)(void))
+ScmObj Scm_NewCFuncPointer(C_FUNC func)
 {
     ScmObj obj = SCM_NIL;
     SCM_NEW_OBJ_INTERNAL(obj);
@@ -775,3 +789,44 @@
 
     return sym;
 }
+
+int Scm_GetInt(ScmObj num)
+{
+    if (EQ(ScmOp_numberp(num), SCM_FALSE))
+	SigScm_ErrorObj("Scm_GetInt : number required but got ", num);
+
+    return SCM_INT_VALUE(num);
+}
+
+char* Scm_GetString(ScmObj str)
+{
+    char *ret = NULL;
+    switch (SCM_GETTYPE(str)) {
+	case ScmString:
+	    ret = SCM_STRING_STR(str);
+	    break;
+	case ScmSymbol:
+	    ret = SCM_SYMBOL_NAME(str);
+	    break;
+	default:
+	    SigScm_Error("Scm_GetString : cannot get string of not string nor symbol\n");
+    }
+
+    return ret;
+}
+
+void* Scm_GetCPointer(ScmObj c_ptr)
+{
+    if (!SCM_C_POINTERP(c_ptr))
+	SigScm_ErrorObj("Scm_GetCPointer : c_ptr required but got ", c_ptr);
+
+    return SCM_C_POINTER_DATA(c_ptr);
+}
+
+C_FUNC Scm_GetCFuncPointer(ScmObj c_funcptr)
+{
+    if (!SCM_C_FUNCPOINTERP(c_funcptr))
+	SigScm_ErrorObj("Scm_GetCFuncPointer : c_funcptr required but got ", c_funcptr);
+
+    return SCM_C_FUNCPOINTER_FUNC(c_funcptr);
+}

Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h	2005-07-21 07:40:29 UTC (rev 997)
+++ branches/r5rs/sigscheme/sigscheme.h	2005-07-21 08:19:01 UTC (rev 998)
@@ -53,6 +53,8 @@
 /*=======================================
    Struct Declarations
 =======================================*/
+typedef void (*C_FUNC) (void);
+
 #include "sigschemetype.h"
 
 /*=======================================
@@ -118,6 +120,7 @@
 ScmObj Scm_NewSymbol(char *name, ScmObj v_cell);
 ScmObj Scm_NewChar(char *ch);
 ScmObj Scm_NewString(char *str);
+ScmObj Scm_NewStringCopying(char *str);
 ScmObj Scm_NewString_With_StrLen(char *str, int len);
 ScmObj Scm_NewFunc(enum ScmFuncArgNum num_arg, ScmFuncType func);
 ScmObj Scm_NewClosure(ScmObj exp, ScmObj env);
@@ -125,8 +128,12 @@
 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_NewCFuncPointer(C_FUNC func);
 ScmObj Scm_Intern(const char *name);
+int    Scm_GetInt(ScmObj num);
+char*  Scm_GetString(ScmObj str);
+void*  Scm_GetCPointer(ScmObj c_ptr);
+C_FUNC Scm_GetCFuncPointer(ScmObj c_funcptr);
 
 /* eval.c */
 ScmObj ScmOp_eval(ScmObj obj, ScmObj env);

Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h	2005-07-21 07:40:29 UTC (rev 997)
+++ branches/r5rs/sigscheme/sigschemetype.h	2005-07-21 08:19:01 UTC (rev 998)
@@ -194,7 +194,7 @@
         } c_pointer;
 
         struct ScmCFuncPointer {
-            void (*func)(void);            
+            C_FUNC func;            
         } c_func_pointer;
     } obj;
 };