[CM] S7 C function arguments corrupted in loop

chohag at jtan.com chohag at jtan.com
Sun Sep 1 09:45:31 PDT 2024


After a few rounds of golf I have arrived at this minimal demonstration
of a problem where the arguments that a C function receives are not
the arguments it is given.

Originally the *wtf* let also declared an integer to look up but
this was removed by the golf. If it were still there then only the
*wtf* let and the final (map) would be necessary to see the problem
occur. Everything else is here to demonstrate the problem not
occurring.

I have tested with today's s7 tarball.

(require cload.scm)

; This is broken:
(define *wtf* (let ()
        (c-define `(
                        (C-function ("anything" _anything "..." 2))
                        (in-C "static s7_pointer
                        _anything (s7_scheme *sc, s7_pointer args)
                        {
                                printf(\"%s\", s7_object_to_c_string(sc, args));
                                return s7_nil(sc);
                        }"))
                "" () "" "" "libs7crash")
        (curlet)))

; This is for demonstration:
(define *other*
        (let ((one 1))
                (define (anything . AB)
                        (format #t "~A" AB)
                        ())
                (curlet)))


; Works fine if looping with for-each
(for-each (lambda (N)
        ((*wtf* 'anything)
                "any string"
                (logior 42 (*other* 'one))))
        '(ok fail))
(newline)
; -> ("any string" 43)("any string" 43)


; Works fine if not calling a C function
(map (lambda (N)
        ((*other* 'anything)
                "any string"
                (logior 42 (*other* 'one))))
        '(ok fail))
(newline)
; -> ("any string" 43)("any string" 43)


; This combination fails:
;   call a C function found in a let
;   have one of its arguments be a simple call to logior (or some others)
;   have one of logior's arguments be looked up in a (any) let.
;   loop at least twice
;
; The first argument to the C function will be replaced by the first
; argument to logior on the second and subsequent loop iterations
(map (lambda (N)
        ((*wtf* 'anything)
                "any string"
                (logior 42 (*other* 'one))))
        '(ok fail))
(newline)
; -> ("any string" 43)(42 43)

Matthew




More information about the Cmdist mailing list