Comment 2 for bug 334623

Revision history for this message
Andreas Rottmann (rotty) wrote :

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

;;---<snip>---

(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))

;;---<snap>---

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.