~ chicken-core (chicken-5) 49ded4ba4369a43e90ac347cb924883466437194

commit 49ded4ba4369a43e90ac347cb924883466437194
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Oct 11 10:00:14 2010 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Oct 11 10:00:14 2010 -0400

    csc -c++: pass -Wno-write-strings if g++ is used

diff --git a/c-backend.scm b/c-backend.scm
index 2a33a9b6..f12bc7b6 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -1089,7 +1089,7 @@
 		  byte unsigned-byte)
 	    ns]
 	   [(float double c-pointer unsigned-integer unsigned-integer32 long integer integer32 unsigned-long 
-		   nonnull-c-pointer number integer64 c-string-list c-string-list*)
+		   nonnull-c-pointer number unsigned-integer64 integer64 c-string-list c-string-list*)
 	    (string-append ns "+3") ]
 	   [(c-string c-string* unsigned-c-string unsigned-c-string unsigned-c-string*)
 	    (string-append ns "+2+(" var "==NULL?1:C_bytestowords(C_strlen(" var ")))") ]
@@ -1158,6 +1158,7 @@
       [(int integer bool) (str "int")]
       [(int32 integer32) (str "C_s32")]
       [(integer64) (str "C_s64")]
+      [(unsigned-integer64) (str "C_u64")]
       [(short) (str "short")]
       [(long) (str "long")]
       [(unsigned-short) (str "unsigned short")]
@@ -1255,6 +1256,7 @@
       ((double number float) "C_c_double(")
       ((integer integer32) "C_num_to_int(")
       ((integer64) "C_num_to_int64(")
+      ((unsigned-integer64) "C_num_to_uint64(")
       ((long) "C_num_to_long(")
       ((unsigned-integer unsigned-integer32) "C_num_to_unsigned_int(")
       ;; pointer and nonnull-pointer are DEPRECATED
diff --git a/chicken.h b/chicken.h
index 0237412d..b3260397 100644
--- a/chicken.h
+++ b/chicken.h
@@ -349,7 +349,7 @@ typedef unsigned __int64   uint64_t;
 
 #define C_TIMER_INTERRUPTS
 
-/* For the easy FFI: */
+/* For the `bind' (and the obsolete `easyffi'): */
 
 #define ___fixnum           int
 #define ___number           double
@@ -358,6 +358,7 @@ typedef unsigned __int64   uint64_t;
 #define ___scheme_value     C_word
 #define ___scheme_pointer   void *
 #define ___byte_vector      unsigned char *
+#define ___pointer_vector   void **
 #define ___symbol           char *
 #define ___safe
 #define ___declare(x, y)
@@ -525,8 +526,10 @@ typedef unsigned __int64   uint64_t;
 
 #if defined(_MSC_VER) || defined (__MINGW32__)
 # define C_s64                    __int64
+# define C_u64                    unsigned __int64
 #else
 # define C_s64                    int64_t
+# define C_u64                    uint64_t
 #endif
 
 #define C_char                    char
@@ -1966,6 +1969,13 @@ C_inline C_s64 C_num_to_int64(C_word x)
 }
 
 
+C_inline C_u64 C_num_to_uint64(C_word x)
+{
+  if(x & C_FIXNUM_BIT) return (C_u64)C_unfix(x);
+  else return (C_u64)C_flonum_magnitude(x);
+}
+
+
 C_inline C_uword C_num_to_unsigned_int(C_word x)
 {
   if(x & C_FIXNUM_BIT) return C_unfix(x);
diff --git a/csc.scm b/csc.scm
index df1611e2..526eeb4c 100644
--- a/csc.scm
+++ b/csc.scm
@@ -828,7 +828,7 @@ EOF
   (unless keep-files (for-each $delete-file generated-scheme-files)) )
 
 
-;;; Compile all C  and .rc files:
+;;; Compile all C/C++  and .rc files:
 
 (define (run-compilation)
   (let ((ofiles '()))
@@ -842,6 +842,9 @@ EOF
 		 (quotewrap f)
 		 (string-append compile-output-flag (quotewrap fo)) 
 		 compile-only-flag
+		 (if (and cpp-mode (string=? "g++" c++-compiler))
+		     "-Wno-write-strings"
+		     "")
 		 (compiler-options) ) ) )
 	 (set! generated-object-files (cons fo generated-object-files))
 	 (set! ofiles (cons fo ofiles))))
diff --git a/support.scm b/support.scm
index ed972706..4c7520b5 100644
--- a/support.scm
+++ b/support.scm
@@ -959,8 +959,9 @@
 		  `(##sys#foreign-struct-wrapper-argument 
 		    ',(##sys#slot (assq t tmap) 1)
 		    ,param) ) ]
-	     [(integer long integer32) (if unsafe param `(##sys#foreign-integer-argument ,param))]
-	     [(unsigned-integer unsigned-integer32 unsigned-long)
+	     [(integer long integer32 integer64)
+	      (if unsafe param `(##sys#foreign-integer-argument ,param))]
+	     [(unsigned-integer unsigned-integer32 unsigned-long unsigned-integer64)
 	      (if unsafe
 		  param
 		  `(##sys#foreign-unsigned-integer-argument ,param) ) ]
@@ -1061,7 +1062,7 @@
 	(words->bytes 3) )
        ((unsigned-integer long integer unsigned-long integer32 unsigned-integer32)
 	(words->bytes 4) )
-       ((float double number integer64) 
+       ((float double number integer64 unsigned-integer64) 
 	(words->bytes 4) )		; possibly 8-byte aligned 64-bit double
        (else
 	(cond [(and (symbol? t) (##sys#hash-table-ref foreign-type-table t))