FFI in chez scheme

(load-shared-object "kernel32.dll")

(define GetCurrentDirectoryW
  (foreign-procedure "GetCurrentDirectoryW" (unsigned-32 (* wchar)) unsigned-32))
   

(define (foreign-wchar-buffer->string buf)
  (with-output-to-string
    (lambda ()
      (let loop ((i 0))
        (let ((ch (ftype-ref wchar () buf i)))
          (when (not (char=? ch #\nul))
                (write-char ch)
                (loop (+ i 1))))))))


(define (get-current-directory)
  (let* ((bufferlen 1024)
         (lpBuffer (make-ftype-pointer wchar (foreign-alloc (* bufferlen (ftype-sizeof wchar)))))
         (retval   (GetCurrentDirectoryW bufferlen lpBuffer))
         (dirname  (foreign-wchar-buffer->string lpBuffer)))
    (foreign-free (ftype-pointer-address lpBuffer))
    (values retval dirname)))