"My" is the struct I've been showing in my other email, defined inside a C-declare and wrapped by c-define-type. From gambit's point of viewI it is a scheme-object like everything else, I suppose.
Here is the code. For whatever reason "new-My" doesn't trigger the bug in my simple use case, even if it returns an object. I was wrong about a detail: that bug is also present in linux. Doesn't crash, but corrupts the contents of the structure (!).
;; START
(c-declare #<<c-declare-end typedef struct My { int r; } My;
static ___SCMOBJ ___release_My( void* ptr ) { ___EXT(___release_rc)( ptr ); return ___FIX(___NO_ERR); }
// workaround to c-lambda bug (gambit mailing list 2015-12-14 My indirect_star_to_My(My *ptr) { return *ptr; } c-declare-end )
(begin (c-define-type My (struct "My")) (c-define-type My* (pointer My (My*))) (c-define-type My*/nonnull (nonnull-pointer My (My*))) (c-define-type My*/release-rc (nonnull-pointer My (My*) "___release_My")))
(define alloc-My (c-lambda () My*/release-rc "___result_voidstar = ___EXT(___alloc_rc)( sizeof( struct My ));")) (define *->My (c-lambda (My*/nonnull) My "indirect_star_to_My")) (define My-r (c-lambda (My*/nonnull) int "___result = ___arg1->r;")) (define My-r-set! (c-lambda (My*/nonnull int) void "___arg1->r = ___arg2;")) (define My->* (c-lambda (My) My*/nonnull "___result_voidstar = &___arg1;"))
;; this one returns My, as a foreign object (struct), not as a foreign object (pointer) ;; doesn't segfault, at least in my use case. why? (define new-My (c-lambda () My "___result_voidstar = ___EXT(___alloc_rc)(sizeof(struct My));"))
(define (evil) (let* ((xoxo (new-My)) (xoxop (My->* xoxo))) (My-r-set! xoxop #xff) (let loop ((c 1)) (begin (if (= 0 (remainder c 1000000)) (begin (display c) (display "-") (display (My-r xoxop)) (newline))) (loop (+ 1 c)))))) (evil)
;; END
Il giorno 15/dic/2015, alle ore 19:25, Adam adam.mlmb@gmail.com ha scritto:
Paolo, wait, what is your definition of your My type here - "scheme-object"?
2015-12-15 3:46 GMT+08:00 Paolo Carlesi pcarlesi@gmail.com: Thank you for the workaround!
What is the best way to generate a foreign c-type object ?
This seems to me the best approach (sorry if it's obvious to everybody but me):
(define make-My (c-lambda () My "___result_voidstar = ___EXT(___alloc_rc)(sizeof(struct My));")) (define My->* (c-lambda (My) My*/nonnull "___result_voidstar = &___arg1;"))
has the advantage of not wasting time / space creating a new foreign object and a copy, like *->My below does. It also doesn't trigger the c-lambda bug, not that I have verified carefully yet. Members can easily be set up with a syntax like (My-x-set! (My->* xoxo) #xdeadbeef) . Is this approach correct?
Thanks Again
Paolo
Il giorno 14/dic/2015, alle ore 18:02, Marc Feeley feeley@iro.umontreal.ca ha scritto:
There appears to be a bug in the FFI when using a c-lambda with inline code that returns a foreign object. So for now you will have to define a C function that does the work and use the name of that function in the c-lambda. In other words:
(c-declare #<<c-declare-end
My indirect_My_star(My *ptr) { return *ptr; }
c-declare-end )
(define *->My (c-lambda (My*/nonnull) My "indirect_My_star"))
Marc
On Dec 14, 2015, at 4:55 AM, Paolo Carlesi pcarlesi@gmail.com wrote:
Hello,
I'm experiencing regular segfaults on OSX 10.9.5, with the sample code shown below. Tested with Gambit 4.8.1 + GCC 4.9 and with packaged Gambit 4.7.3 + LLVM. No issue at all on Linux, GCC 4.8, with both Gambit 4.2.8 and Gambit 4.8.2. Of course I may be doing something silly.
A simple struct, "My" is generated inside a c procedure, then passed multiple times to another c-lambda procedure (*->My). It's a simplified model of the code produced by a FFI SDL2 Library I'm using. The doc says that the foreign object (xoxo in the example) should not be released while the scheme code is still referencing it. I am seeing the refcount going wildly in the negative, one for each call to *->My The only way -- clumsy -- I have found to avoid this is to increment the reference count with ___addref_rc ( not shown here ).
What's wrong here? Thanks!
LLDB output:
Process 48149 launched: '/Users/paolo/scheme/spazz/fromlin' (x86_64) Process 48149 stopped
- thread #1: tid = 0x40e3c9, 0x000000010000770c fromlin`___release_rc + 28, queue = 'com.apple.main-thread', stop reason = EXC_BAD_ACCESS (code=EXC_I386_GPFLT) frame #0: 0x000000010000770c fromlin`___release_rc + 28
fromlin`___release_rc + 28: -> 0x10000770c: movq %rax, (%rdx) 0x10000770f: movq %rdx, 0x8(%rax) 0x100007713: jmp 0x100010240 ; ___free_mem 0x100007718: nopl (%rax,%rax)
stack trace:
(lldb) bt
- thread #1: tid = 0x40e3c9, 0x000000010000770c fromlin`___release_rc + 28, queue = 'com.apple.main-thread', stop reason = EXC_BAD_ACCESS (code=EXC_I386_GPFLT)
- frame #0: 0x000000010000770c fromlin`___release_rc + 28 frame #1: 0x0000000100002579 fromlin`___release_fn0 + 9 frame #2: 0x0000000100009009 fromlin`___garbage_collect + 3497 frame #3: 0x00000001000091bf fromlin`___alloc_scmobj + 255 frame #4: 0x000000010000d4eb fromlin`___POINTER_to_SCMOBJ + 43 frame #5: 0x000000010000d5e4 fromlin`___STRUCT_to_SCMOBJ + 20 frame #6: 0x0000000100002112 fromlin`___H__20_fromlin + 3378 frame #7: 0x0000000100004aa4 fromlin`___call + 372 frame #8: 0x0000000100004bc6 fromlin`___setup_pstate + 262 frame #9: 0x00000001000063be fromlin`___setup + 3950
(lldb)
;; SAMPLE CODE
(c-declare #<<c-declare-end
typedef struct My { int r; } My;
c-declare-end )
(begin (c-define-type My (struct "My")) (c-define-type My* (pointer My (My*))) (c-define-type My*/nonnull (nonnull-pointer My (My*))) (c-define-type My*/release-rc (nonnull-pointer My (My*) "___release_My")))
(begin (c-declare #<<c-declare-end static ___SCMOBJ ___release_My( void* ptr ) { ___EXT(___release_rc)( ptr ); return ___FIX(___NO_ERR); } c-declare-end )
(define alloc-My (c-lambda () My*/release-rc "___result_voidstar = ___EXT(___alloc_rc)( sizeof( struct My ));")) (define *->My (c-lambda (My*/nonnull) My "___result_voidstar = (My*)___arg1;")) (define My-r (c-lambda (My*/nonnull) unsigned-int8 "___result = ___arg1->r;")) (define My-r-set! (c-lambda (My*/nonnull unsigned-int8) void "___arg1->r = ___arg2;")))
(define (evil) (let ((xoxo (alloc-My))) (My-r-set! xoxo #xff) (let loop ((c 1)) (begin (if (= 0 (remainder c 10000)) (begin (display c) (newline))) (*->My xoxo) (loop (+ 1 c))))))
(evil)
;;END CODE
Gambit-list mailing list Gambit-list@iro.umontreal.ca https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list
Gambit-list mailing list Gambit-list@iro.umontreal.ca https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list