Changeset 11055 in project


Ignore:
Timestamp:
06/20/08 16:16:20 (12 years ago)
Author:
felix winkelmann
Message:

started to port, not finished yet

Location:
release/4/easyffi
Files:
1 added
3 edited
1 moved

Legend:

Unmodified
Added
Removed
  • release/4/easyffi/chicken-wrap.scm

    r6708 r11055  
    88(define-constant +version+ 1.7)
    99
    10 (use srfi-1 utils)
     10(define ##compiler#debugging-chicken '())
    1111
    12 (require 'easyffi)
    13 
    14 (define ##compiler#debugging-chicken '())
     12(require-extension srfi-1 utils easyffi-base)
    1513
    1614(define (usage #!optional (status 0))
     
    3735                   #f)
    3836                  ((string=? "-debug" arg)
    39                    (set! ##compiler#debugging-chicken '(|C|))
     37                   (set! ##compiler#debugging-chicken '(F C))
    4038                   #f)
    4139                  ((member arg '("--help" "-help" "-h"))
  • release/4/easyffi/easyffi-base.scm

    r11054 r11055  
    1 ;;;; easyffi.scm
     1;;;; easyffi-base.scm
    22;
    3 ; Copyright (c) 2000-2006, Felix L. Winkelmann
     3; Copyright (c) 2008, The CHICKEN Team
     4; Copyright (c) 2000-2007, Felix L. Winkelmann
    45; All rights reserved.
    56;
     
    2324; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    2425; POSSIBILITY OF SUCH DAMAGE.
    25 ;
    26 ; Send bugs, suggestions and ideas to:
    27 ;
    28 ; felix@call-with-current-continuation.org
    29 ;
    30 ; Felix L. Winkelmann
    31 ; Unter den Gleichen 1
    32 ; 37130 Gleichen
    33 ; Germany
    3426
    3527
     
    3729  (uses srfi-13 srfi-1 utils regex)
    3830  ;(disable-warning var)
    39   (no-procedure-checks-for-usual-bindings)
    40   (export parse-easy-ffi register-ffi-macro number-type
    41           ffi-include-path-list ffi-dont-include ##compiler#foreign-type-table
    42           foreign-type-declaration check-c-syntax
    43           no-c-syntax-checks ##sys#user-read-hook) )
    44 
    45 (eval-when (compile) (match-error-control #:unspecified))
     31  (no-procedure-checks-for-usual-bindings) )
     32
     33
     34(module easyffi-base (parse-easy-ffi
     35                      register-ffi-macro
     36                      ffi-include-path-list ffi-dont-include
     37                      foreign-type-declaration check-c-syntax
     38                      no-c-syntax-checks)
     39 
     40  (import scheme chicken extras data-structures
     41          ports silex srfi-13 srfi-1 utils regex matchable)
    4642
    4743(include "easyffi.l.scm")
     
    7369
    7470(unless (or (memq #:compiling ##sys#features) (memq #:compiler-extension ##sys#features))
    75   (set! ##compiler#foreign-type-table (make-vector 301 '()))
    76   (set! number-type 'generic) )
     71  (set! ##compiler#foreign-type-table (make-vector 301 '())) )
    7772
    7873(define (lexer-error chr)
     
    141136(define (parse c)
    142137  (when (memq 'C ##compiler#debugging-chicken)
    143     (pp `(CHUNK: ,c)) )
     138    (pp `(CHUNK: ,c) (current-error-port)) )
    144139  (match c
    145140    [() #f]
     
    191186                    (begin
    192187                      (when (memq 'F ##compiler#debugging-chicken)
    193                         (printf "parsing ~a ...~%" fname) )
     188                        (fprintf (current-error-port) "parsing ~a ...~%" fname) )
    194189                      (call-with-input-file fname parse-easy-ffi-rec) )
    195190                    (parsing-error "can not open include file" filename) ) ) ) ]
     
    273268    [`(unsigned fixnum . ,more) (values 'unsigned-int more)]
    274269    [`(unsigned int . ,more)
    275      (values (if (eq? number-type 'fixnum) 'unsigned-int 'unsigned-integer) more)]
     270     (values 'unsigned-integer more)]
    276271    [`(unsigned char . ,more) (values 'unsigned-char more)]
    277272    [`(unsigned short int . ,more) (values 'unsigned-short more)]
     
    297292     (values `(c-pointer ,(string->symbol (string-append "unsigned-" (symbol->string t)))) more) ]
    298293    [`(pointer ,t star . ,more) (values `(c-pointer ,t) more)]
    299     [`(int . ,more) (values (if (eq? number-type 'fixnum) 'int 'integer) more)]
     294    [`(int . ,more) (values 'integer more)]
    300295    [`(char . ,more) (values 'char more)]
    301296    [`(short int . ,more) (values 'short more)]
     
    423418               [('length 'open-paren ('id lvar) 'close-paren . more2)
    424419                (set! more more2)
    425                 (set! lens (alist-cons i lvar lens)) ] )
     420                (set! lens (alist-cons i lvar lens)) ]
     421               [_ #f])
    426422             (let-values ([(type more) (parse-type more io #f)])
    427423               (match more
     
    775771          [_ (rec (cdr ts))] ) ) ) )
    776772
    777 (define emit
    778   (let ((dbg (and (or (memq #:compiling ##sys#features) (memq #:compiler-extension ##sys#features))
    779                   (memq 'F ##compiler#debugging-chicken))))
    780     (lambda (x)
    781       (when dbg (pp x))
    782       (set! processed-output (cons x processed-output) ) ) ) )
     773(define (emit x)
     774  (let ((dbg (memq 'F ##compiler#debugging-chicken)))
     775    (when dbg (pp x (current-error-port)))
     776    (set! processed-output (cons x processed-output) ) ) )
    783777
    784778(define (process-macro-def name type)
     
    13711365
    13721366
    1373 ;;; Macros:
    1374 
    1375 (eval '(begin
    1376 
    1377 (define-macro (foreign-declare . strs)
    1378   (let ((strs (append strs '("\n"))))
    1379     (check-c-syntax (string-concatenate strs) 'foreign-declare)
    1380     (if (every string? strs)
    1381         `(##core#declare '(foreign-declare ,@strs))
    1382         (syntax-error 'foreign-declare "syntax error in declaration" strs) ) ) )
    1383 
    1384 (define-macro (foreign-parse . strs)
    1385   (let ((strs (append strs '("\n"))))
    1386     (if (every string? strs)
    1387         `(begin ,@(parse-easy-ffi (string-concatenate strs)))
    1388         (syntax-error 'foreign-parse "syntax error in declaration" strs) ) ) )
    1389 
    1390 (define-macro (foreign-parse/declare . strs)
    1391   (let ((strs (append strs '("\n"))))
    1392     `(begin
    1393        (##core#declare '(foreign-declare ,@strs))
    1394        (foreign-parse ,@strs)) ) )
    1395 
    1396 (define-macro (foreign-include-path . strs)
    1397   (set! ffi-include-path-list (append strs ffi-include-path-list))
    1398   '(void) )
    1399 
    1400 ))
    1401 
    1402 
    14031367;;; "#> ... <#" syntax:
    14041368
     
    14691433               (write-char c out)
    14701434               (loop) ] ) ) ) ) )
     1435
     1436)
  • release/4/easyffi/easyffi.setup

    r8389 r11055  
    33       ("chicken-wrap" ("chicken-wrap.scm")
    44        (compile -O2 -d0 chicken-wrap.scm) )
    5        ("easyffi.so" ("easyffi.scm" "easyffi.l.scm")
    6         (compile -s -O2 -d0 easyffi.scm) ) )
    7   '("easyffi.so" "chicken-wrap") )
     5       ("easyffi-base.so" ("easyffi-base.scm" "easyffi.l.scm")
     6        (compile -s -O2 easyffi-base.scm -j easyffi-base)
     7        #;(compile -s -O2 -d0 easyffi-base.scm -j easyffi-base) )
     8       ("easyffi-base.import.so" ("easyffi-base.import.scm")
     9        (compile -s -O2 -d0 easyffi-base.import.scm) )
     10       ("easyffi.so" ("easyffi.scm" "easyffi-base.import.so")
     11        ;; load easyffi into compiler to make module available
     12        (compile -s -O2 -d0 -X easyffi-base.import.so
     13                 easyffi.scm -j easyffi) )
     14       ("easyffi.import.so" ("easyffi.import.scm")
     15        (compile -s -O2 -d0 easyffi.import.scm)))
     16  '("easyffi.so" "easyffi-base.so"
     17    "easyffi-base.import.so" "easyffi.import.so"
     18    "chicken-wrap") )
    819
    920(install-extension
    1021 'easyffi
    11  '("easyffi.so")
    12  '((version 1.92)
    13    (syntax)) )
     22 '("easyffi.so" "easyffi.import.so" "easyffi-base.so" "easyffi-base.import.so")
     23 '((version 1.93)))
    1424
    1525(install-program
    1626 'chicken-wrap
    1727 "chicken-wrap"
    18  '((version 1.92)))
     28 '((version 1.93)))
    1929
  • release/4/easyffi/runsilex.scm

    r1382 r11055  
    33; Runs silex and generates easyffi.l.scm
    44
    5 (use silex)
     5(require-extension silex)
    66
    77(lex "easyffi.l" "easyffi.l.scm" 'counters 'none)
Note: See TracChangeset for help on using the changeset viewer.