function declarations

[mwette]

Some structures include declarations for function pointers. Please consider adding this.

[mwette]

I am working on this now.

[TaylanUB]

I think this is a great idea, but since bytestructures itself doesn't have a concept of functions, I wonder how you intend to add this?

If it's going to be Guile-only, then I suppose we could have a descriptor type that stores information about function signatures (e.g. in a format akin to what Guile's pointer->procedure expects), and use that info to call pointer->procedure when the function pointer in the bytestructure is dereferenced, thus returning a Scheme procedure that wraps the C function.

Or did you have another strategy in mind?

BTW in the file ffi.scm in the root directory of bytestructures, there's a procedure called bs:pointer->proc that wraps Guile's pointer->procedure in such a way that the generated Scheme procedures can accept bytestructure objects as arguments or return them as values. A limitation is that the original C function must work with pointers if structs or unions are involved, i.e. a C function taking or returning a struct by-value (instead of a pointer to it) can't be wrapped.

E.g. if there's a C function that returns a struct { int x; double y; } pointer, you can represent that type with a descriptor like (bs:struct `((x ,int) (y ,double))) then use that descriptor with bs:pointer->proc to get a Scheme procedure that directly returns a bytestructure object with that descriptor.

Maybe this could make our "function pointers" feature a bit nicer.

[mwette]

Right now the descriptor has two fields: one for the return descriptor and one for a list of param descriptors. This part is not guile-specific. Things are not working yet, but here is a test program

(define sqrt-ptr 
  (dynamic-func "sqrt" (dynamic-link)))

(define sqrt-desc
  (bs:pointer (bs:function double (list double))))

(define sqrt-bs 
  (bytestructure sqrt-desc (ffi:pointer-address sqrt-ptr)))

(define sqrt-ftn/bs
  (bytestructure-ref sqrt-bs '*))

[mwette]

I would also like to deal with varargs. So I lied in the prev' post. The parameters are a list of param-spec's. A param spec is one of: descriptor, name-descriptor pair, '.... So I am also thinking about how to use casts for handing varargs.

[mwette]

Example using varargs:

  (define printf-ptr 
    (dynamic-func "printf" (dynamic-link)))

  (define printf-addr
    (ffi:pointer-address printf-ptr))

  (define printf-desc
    (bs:pointer (bs:function int (list (bs:pointer 'void) '...))))

  (define printf/b
    (bytestructure printf-desc printf-addr))

  (define printf-ftn (bytestructure-ref printf/b '*))

  (define argval 4.0)
  (printf-ftn (ffi:string->pointer "sqrt(%f)=%f\n")
	      (bs:cast ffi:double argval)
	      (bs:cast ffi:double (sqrt-ftn/g argval)))

  (let ((arg1 (bytestructure double argval))
	(arg2 (bytestructure double (sqrt-ftn/b argval))))
    (printf-ftn (ffi:string->pointer "sqrt(%f)=%f\n") arg1 arg2))

[mwette]

And this works too:

(printf-ftn (ffi:string->pointer "sqrt(%f)=%f\n")
	      (bs:cast double 4.0)
	      (bs:cast double (sqrt-ftn/g 4.0)))

[mwette]

Note: I have forked scheme-bytestructures, added bytestructures/guile/function.scm and guile-function-test.scm, and modified bytestructures/guile.scm. It is not all perfect, but would you like me to submit a pull request?

[TaylanUB]

Sorry for not answering, I somehow missed this.

Feel free to make a pull request.

[mwette]

I need to go back and review what I had again, and what's in nyacc. If it still looks worth it I will.

[mwette]

I originally wrote this descriptor to use Guile ffi descriptors. I am now converting to use base bytestructure descriptors (in the hope of being fully Guile-independent).

[mwette]

So, I have converted the function descriptor to use bs descriptors. I think the pointer descriptor may need to have a field for custom procedures to dereference. If I declare

(define f*-desc (bs:pointer (bs:function double (list double)))
(define f* (bytestructure f*-desc (dynamic-func ...)))
(define f (bytestructure-ref f* '*))

then the pointer dereferencing needs to convert the bs-desc's to ffi-desc's and call ffi:pointer->procedure

[mwette]

Here is the function specification I currently use. The only use case is (bs:pointer (delay (fh:function ...))). And since the de-reference requires conversion via guile's ffi:pointer->procedure it is currently guile-specific.

;; @deffn {Procedure} fh:function return-desc param-desc-list
;; @deffnx {Syntax} define-fh-function*-type name desc type? make
;; Generate a descriptor for a function pseudo-type, and then the associated
;; function pointer type. 
;; @example
;; (define foo_t*-desc (bs:pointer (delay double (list double))))
;; @end example
;; @end deffn
(define-record-type <function-metadata>
  (make-function-metadata return-descriptor param-descriptor-list attributes)
  function-metadata?
  (return-descriptor function-metadata-return-descriptor)
  (param-descriptor-list function-metadata-param-descriptor-list)
  (attributes function-metadata-attributes))

(define (pointer->procedure/varargs return-ffi pointer param-ffi-list)
  (define (arg->ffi arg)
    (cond
     ((bytestructure? arg)
      (bytestructure-descriptor->ffi-descriptor
       (bytestructure-descriptor arg)))
     ((and (pair? arg) (bytestructure-descriptor? (car arg)))
      (bytestructure-descriptor->ffi-descriptor (car arg)))
     ((pair? arg) (car arg))
     (else (error "can't interpret argument"))))
  (define (arg->val arg)
    (cond
     ((bytestructure? arg) (bytestructure-ref arg))
     ((and (pair? arg) (bytestructure? (cdr arg)))
      (bytestructure-ref (cdr arg)))
     ((pair? arg) (cdr arg))
     (else arg)))
  (define (arg-list->ffi-list param-list arg-list)
    (let iter ((param-l param-list) (argl arg-list))
      (cond
       ((pair? param-l) (cons (car param-l) (iter (cdr param-l) (cdr argl))))
       ((pair? argl) (cons (arg->ffi (car argl)) (iter param-l (cdr argl))))
       (else '()))))
  (lambda args
    (let ((ffi-l (arg-list->ffi-list param-ffi-list args))
	  (arg-l (map arg->val args)))
      (sferr "return=~S  params=~S\n" return-ffi ffi-l)
      (apply (ffi:pointer->procedure return-ffi pointer ffi-l) arg-l))))

;; @deffn {Procedure} fh:function return-desc param-desc-list
;; @deffnx {Syntax} define-fh-function*-type name desc type? make
;; Generate a descriptor for a function pseudo-type, and then the associated
;; function pointer type.   If the last element of @var{param-desc-list} is
;; @code{'...} the function is specified as variadic.
;; @example
;; (define foo_t*-desc (bs:pointer (delay (fh:function double (list double)))))
;; @end example
;; @end deffn
(define (fh:function %return-desc %param-desc-list)
  (define (get-return-ffi syntax?)
    (if syntax?
	#`%return-desc
	%return-desc))
  (define (get-param-ffi-list syntax?)
    (let iter ((params %param-desc-list))
      (cond
       ((null? params) '())
       ((pair? (car params)) (cons (cadar params) (iter (cdr params))))
       ((eq? '... (car params)) '())
       (else (cons (car params) (iter (cdr params)))))))
  (define size (ffi:sizeof '*))
  (define alignment size)
  (define attributes
    (let iter ((param-l %param-desc-list))
      (cond ((null? param-l) '())
	    ((eq? '... (car param-l)) '(varargs))
	    (else (iter (cdr param-l))))))
  (define (getter syntax? bytevector offset) ; assumes zero offset!
    (if (memq 'varargs attributes)
	(if syntax?
	    #`(pointer->procedure/varargs
	       (get-return-ffi #f)
	       (ffi:bytevector->pointer bytevector)
	       (get-param-ffi-list #f))
	    (pointer->procedure/varargs
	     (get-return-ffi #f)
	     (ffi:bytevector->pointer bytevector)
	     (get-param-ffi-list #f)))
	(if syntax?
	    #`(ffi:pointer->procedure
	       #,(get-return-ffi #t)
	       (ffi:bytevector->pointer #,bytevector)
	       #,(get-param-ffi-list #t))
	    (ffi:pointer->procedure
	     (get-return-ffi #f)
	     (ffi:bytevector->pointer bytevector)
	     (get-param-ffi-list #f)))))
  (define meta
    (make-function-metadata %return-desc %param-desc-list attributes))
  (make-bytestructure-descriptor size alignment #f getter #f meta))