Commit 117bc2fd authored by Erick's avatar Erick

Fix incompatibilties in FFI introduced in 1.0

parent dcac8ef2
......@@ -21,61 +21,69 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 14-Bun-2007 09:24 (eg)
;;;; Last file update: 22-Jun-2010 09:36 (eg)
;;;; Last file update: 21-Aug-2010 14:16 (eg)
;;;;
(define make-external-function #f)
(define make-callback #f)
(define make-external-function
(let ((table '((:void 0)
(:char 1)
` (:short 2)
(:ushort 3)
(:int 4)
(:uint 5)
(:long 6)
(:ulong 7)
(:lonlong 8)
(:ulonlong 9)
(:float 10)
(:double 11)
(:boolean 12)
(:pointer 13)
(:string 14)
(:int8 15)
(:int16 16)
(:int32 17)
(:int64 18)
(:obj 19))))
(let ((table '((:void 0)
(:char 1)
(:short 2)
(:ushort 3)
(:int 4)
(:uint 5)
(:long 6)
(:ulong 7)
(:lonlong 8)
(:ulonlong 9)
(:float 10)
(:double 11)
(:boolean 12)
(:pointer 13)
(:string 14)
(:int8 15)
(:int16 16)
(:int32 17)
(:int64 18)
(:obj 19))))
(define (arg-type->number k argument?)
(let ((info (assoc k table)))
(if info
(let ((r (cadr info)))
(if (and (zero? r) argument?)
(error 'define-external "parameter of type :void are forbidden")
(cadr info)))
(error 'define-external "bad type name ~S" k))))
(define (arg-type->number k argument?)
(let ((info (assoc k table)))
(if info
(let ((r (cadr info)))
(if (and (zero? r) argument?)
(error 'define-external "parameter of type :void are forbidden")
(cadr info)))
(error 'define-external "bad type name ~S" k))))
(define (parse-parameters lst)
(map (lambda (x)
(cond
((keyword? x)
(arg-type->number x #t))
((pair? x)
(if (and (symbol? (car x)) (keyword? (cadr x)) (null? (cddr x)))
(arg-type->number (cadr x) #t)
(error 'make-external-function
"bad parameter description: ~S" x)))
(else
(error 'make-external-function "bad parameter description: ~S" x))))
lst))
(define (parse-parameters lst)
(map (lambda (x)
(cond
((keyword? x)
(arg-type->number x #t))
((pair? x)
(if (and (symbol? (car x)) (keyword? (caar x)) (null? (cddr x)))
(arg-type->number (cadr x) #t)
(error 'make-external-function
"bad parameter description: ~S" x)))
(else
(error 'make-external-function "bad parameter description: ~S" x))))
lst))
;;; make-external-function lambda
;; make-external-function
(set! make-external-function
(lambda (entry-name parameters return-type lib-name)
(%make-ext-func entry-name
(parse-parameters parameters)
(arg-type->number return-type #f)
lib-name))))
lib-name)))
;; make-callback
(set! make-callback
(lambda (proc types data)
(%make-callback proc (parse-parameters types) data))))
......
;;;;
;;;; extract.stk -- Implementation of stklos-pkg extract option
;;;;
;;;; Copyright 2007-2008 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;; Copyright 2007-2010 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 15-Jan-2007 12:10 (eg)
;;;; Last file update: 10-Apr-2008 12:08 (eg)
;;;; Last file update: 21-Aug-2010 15:18 (eg)
;;;;
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 26-Dec-2006 16:23 (eg)
;;;; Last file update: 8-Aug-2010 09:07 (eg)
;;;; Last file update: 20-Aug-2010 17:45 (eg)
;;;;
......@@ -37,7 +37,8 @@
(let ((dir (expand-file-name d)))
(ensure-directories-exist dir)
(stklos-pkg-servers-directory (make-path dir "servers"))
(stklos-pkg-cache-directory (make-path dir "cache"))))))
(stklos-pkg-cache-directory (make-path dir "cache"))
dir))))
(define stklos-pkg-system-directory
(make-parameter (make-path (%library-prefix) "lib" "stklos" "pkg")))
......
This diff is collapsed.
This diff is collapsed.
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@essi.fr]
* Creation date: 14-Jun-2007 09:19 (eg)
* Last file update: 5-Aug-2010 18:05 (eg)
* Last file update: 21-Aug-2010 14:10 (eg)
*/
#include <stklos.h>
......@@ -395,7 +395,7 @@ SCM STk_call_ext_function(SCM fct, int argc, SCM *argv)
/* ======================================================================
* make-callback ...
* ====================================================================== */
DEFINE_PRIMITIVE("make-callback", make_callback, subr3,
DEFINE_PRIMITIVE("%make-callback", make_callback, subr3,
(SCM proc, SCM types, SCM data))
{
SCM z;
......
......@@ -21,7 +21,7 @@
#
# Author: Erick Gallesio [eg@unice.fr]
# Creation date: 27-Jul-2000 12:21 (eg)
# Last file update: 5-Aug-2010 23:56 (eg)
# Last file update: 20-Aug-2010 16:52 (eg)
#
......@@ -102,7 +102,7 @@ case $os in
i*86) machine=ix86;;
esac
OS=LINUX
SH_COMP_FLAGS='-fpic'
SH_COMP_FLAGS='-fpic -nostdlib'
SH_LOAD_FLAGS='-shared -o'
SH_LOADER='ld'
SH_SUFFIX='so'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment