search

hyln9 / ikarus

Optimizing incremental native-code compiler for R6RS scheme. This is a forked repository.
https://launchpad.net/ikarus
Other
5 stars 0 forks source link

{un,}signed-long-long types missing in the FFI #200

Closed hyln9 closed 10 years ago

hyln9 commented 10 years ago

Currently, there is no support for {un,}signed-long-long in make-c-callout' andmake-c-callback' which means on 32-bit platforms, one cannot create bindings for functions that take 64-bit integer arguments.

Ikarus Scheme version 0.0.4-rc1+, 64-bit (revision 1746, build 2009-02-23) Copyright (c) 2006-2008 Abdulaziz Ghuloum

(import (ikarus foreign)) (make-c-callback 'void '(signed-long-long)) Unhandled exception Condition components:

  1. &assertion
  2. &who: ffi-prep-cif
  3. &message: "invalid type"
  4. &irritants: (signed-long-long)

Launchpad Details: #LP334623 Andreas Rottmann - 2009-02-25 20:00:41 -0500

hyln9 commented 10 years ago

Added in revision 1765. I haven't tested this, so, if you have any tests you want to add, please feel free. :-)

Launchpad Details: #LPC Abdulaziz Ghuloum - 2009-04-10 19:18:30 -0400

hyln9 commented 10 years ago

I just checked in my 32-bit chroot, and it seems it doesn't quite work yet:

;;------

(import (rnrs) (ikarus foreign))

(define memcpy (case-lambda ((p1 offset1 p2 offset2 count) (cond ((and (pointer? p1) (bytevector? p2)) (do ((i offset1 (+ i 1)) (j offset2 (+ j 1))) ((>= (- i offset1) count)) (pointer-set-c-char! p1 i (bytevector-u8-ref p2 j)))) ((and (bytevector? p1) (pointer? p2)) (do ((i offset1 (+ i 1)) (j offset2 (+ j 1))) ((>= (- i offset1) count)) (bytevector-u8-set! p1 i (pointer-ref-c-unsigned-char p2 j)))) (else (error 'memcpy "need pointer and bytevector" p1 p2))) p1) ((p1 p2 count) (memcpy p1 0 p2 0 count))))

(define (string->utf8z-ptr s) (let* ((bytes (string->utf8 s)) (bytes-len (bytevector-length bytes)) (result (malloc (+ bytes-len 1)))) (memcpy result bytes bytes-len) (pointer-set-c-char! result bytes-len 0) result))

(let* ((libc (dlopen)) (strtoll ((make-c-callout 'signed-long-long '(pointer pointer signed-int)) (dlsym libc "strtoll"))) (num-utf8z-ptr (string->utf8z-ptr "-9223372036854775807"))) (display (strtoll num-utf8z-ptr (integer->pointer 0) 10)) (newline) (free num-utf8z-ptr))

;;------

When run on x86-64:

rotty@delenn:~/src/ikarus% ikarus --r6rs-script ./+ffi-llong-test.scm -9223372036854775807

However, on x86-32:

rotty@delenn(lenny-i386):~/src/ikarus% ikarus --r6rs-script ./+ffi-llong-test.scm
-4294967295

This is using Ikarus r1769, FWIW.

Launchpad Details: #LPC Andreas Rottmann - 2009-04-28 09:10:35 -0400

hyln9 commented 10 years ago

Fixed in 1770. Thanks.

Launchpad Details: #LPC Abdulaziz Ghuloum - 2009-04-30 05:28:45 -0400