From 439c097ab0c71b617fb0a55de6665b840b10c46b Mon Sep 17 00:00:00 2001 From: retropikzel Date: Fri, 25 Apr 2025 18:01:24 +0300 Subject: [PATCH] Improved portability a lot. Started export renaming. --- ' | 213 ++++++ .gitignore | 1 + Makefile | 18 +- README.md | 174 ++--- documentation/R7RS-PFFI.html | 232 +++--- documentation/R7RS-PFFI.pdf | Bin 72825 -> 73144 bytes retropikzel/pffi.sld | 208 ++++-- retropikzel/pffi/chibi-src/pffi.stub | 28 +- retropikzel/pffi/chibi.scm | 52 +- retropikzel/pffi/chicken.scm | 34 +- retropikzel/pffi/cyclone.scm | 70 +- retropikzel/pffi/gambit.scm | 119 ++-- retropikzel/pffi/gauche-src/gauchelib.scm | 2 - retropikzel/pffi/gauche.scm | 42 +- retropikzel/pffi/gerbil.scm | 32 +- retropikzel/pffi/guile.scm | 43 +- retropikzel/pffi/kawa.scm | 32 +- retropikzel/pffi/larceny.scm | 43 +- retropikzel/pffi/mosh.scm | 46 +- retropikzel/pffi/racket.scm | 42 +- retropikzel/pffi/sagittarius.scm | 106 +-- retropikzel/pffi/shared/array.scm | 12 +- retropikzel/pffi/shared/main.scm | 54 +- retropikzel/pffi/shared/pointer.scm | 152 ++-- retropikzel/pffi/shared/struct.scm | 30 +- retropikzel/pffi/shared/union.scm | 8 - retropikzel/pffi/stklos.scm | 88 +-- retropikzel/pffi/ypsilon.scm | 159 +++-- tests/compliance.scm | 814 +++++++++++----------- 29 files changed, 1390 insertions(+), 1464 deletions(-) create mode 100644 ' delete mode 100644 retropikzel/pffi/shared/union.scm diff --git a/' b/' new file mode 100644 index 0000000..d3d4b11 --- /dev/null +++ b/' @@ -0,0 +1,213 @@ +(define size-of-type + (lambda (type) + (cond ((eq? type 'int8) (size-of-int8_t)) + ((eq? type 'uint8) (size-of-uint8_t)) + ((eq? type 'int16) (size-of-int16_t)) + ((eq? type 'uint16) (size-of-uint16_t)) + ((eq? type 'int32) (size-of-int32_t)) + ((eq? type 'uint32) (size-of-uint32_t)) + ((eq? type 'int64) (size-of-int64_t)) + ((eq? type 'uint64) (size-of-uint64_t)) + ((eq? type 'char) (size-of-char)) + ((eq? type 'unsigned-char) (size-of-char)) + ((eq? type 'short) (size-of-short)) + ((eq? type 'unsigned-short) (size-of-unsigned-short)) + ((eq? type 'int) (size-of-int)) + ((eq? type 'unsigned-int) (size-of-unsigned-int)) + ((eq? type 'long) (size-of-long)) + ((eq? type 'unsigned-long) (size-of-unsigned-long)) + ((eq? type 'float) (size-of-float)) + ((eq? type 'double) (size-of-double)) + ((eq? type 'pointer) (size-of-pointer)) + ((eq? type 'string) (size-of-pointer)) + ((eq? type 'struct) (size-of-pointer)) + ((eq? type 'callback) (size-of-pointer)) + ((eq? type 'void) 0) + (else #f)))) + +(define pffi-shared-object-load + (lambda (path options) + (let ((shared-object (dlopen path RTLD-NOW)) + (maybe-error (dlerror))) + (when (not (pffi-pointer-null? maybe-error)) + (error (pffi-pointer->string maybe-error))) + shared-object))) + +#;(define pffi-pointer-null + (lambda () + (pointer-null))) + +#;(define pffi-pointer-null? + (lambda (pointer) + (not pointer))) ; #f is null on Chibi + +(define pffi-pointer? + (lambda (object) + (or (equal? object #f) ; False can be null pointer + (pointer? object)))) + +(define pffi-pointer-allocate + (lambda (size) + (pointer-allocate size))) + +(define pffi-pointer-address + (lambda (pointer) + (pointer-address pointer))) + +(define pffi-pointer-free + (lambda (pointer) + (pointer-free pointer))) + +(define pffi-pointer-set! + (lambda (pointer type offset value) + (cond ((equal? type 'int8) (pointer-set-c-int8_t! pointer offset value)) + ((equal? type 'uint8) (pointer-set-c-uint8_t! pointer offset value)) + ((equal? type 'int16) (pointer-set-c-int16_t! pointer offset value)) + ((equal? type 'uint16) (pointer-set-c-uint16_t! pointer offset value)) + ((equal? type 'int32) (pointer-set-c-int32_t! pointer offset value)) + ((equal? type 'uint32) (pointer-set-c-uint32_t! pointer offset value)) + ((equal? type 'int64) (pointer-set-c-int64_t! pointer offset value)) + ((equal? type 'uint64) (pointer-set-c-uint64_t! pointer offset value)) + ((equal? type 'char) (pointer-set-c-char! pointer offset (char->integer value))) + ((equal? type 'short) (pointer-set-c-short! pointer offset value)) + ((equal? type 'unsigned-short) (pointer-set-c-unsigned-short! pointer offset value)) + ((equal? type 'int) (pointer-set-c-int! pointer offset value)) + ((equal? type 'unsigned-int) (pointer-set-c-unsigned-int! pointer offset value)) + ((equal? type 'long) (pointer-set-c-long! pointer offset value)) + ((equal? type 'unsigned-long) (pointer-set-c-unsigned-long! pointer offset value)) + ((equal? type 'float) (pointer-set-c-float! pointer offset value)) + ((equal? type 'double) (pointer-set-c-double! pointer offset value)) + ((equal? type 'void) (pointer-set-c-pointer! pointer offset value)) + ((equal? type 'pointer) (pointer-set-c-pointer! pointer offset value))))) + +(define pffi-pointer-get + (lambda (pointer type offset) + (cond ((equal? type 'int8) (pointer-ref-c-int8_t pointer offset)) + ((equal? type 'uint8) (pointer-ref-c-uint8_t pointer offset)) + ((equal? type 'int16) (pointer-ref-c-int16_t pointer offset)) + ((equal? type 'uint16) (pointer-ref-c-uint16_t pointer offset)) + ((equal? type 'int32) (pointer-ref-c-int32_t pointer offset)) + ((equal? type 'uint32) (pointer-ref-c-uint32_t pointer offset)) + ((equal? type 'int64) (pointer-ref-c-int64_t pointer offset)) + ((equal? type 'uint64) (pointer-ref-c-uint64_t pointer offset)) + ((equal? type 'char) (integer->char (pointer-ref-c-char pointer offset))) + ((equal? type 'short) (pointer-ref-c-short pointer offset)) + ((equal? type 'unsigned-short) (pointer-ref-c-unsigned-short pointer offset)) + ((equal? type 'int) (pointer-ref-c-int pointer offset)) + ((equal? type 'unsigned-int) (pointer-ref-c-unsigned-int pointer offset)) + ((equal? type 'long) (pointer-ref-c-long pointer offset)) + ((equal? type 'unsigned-long) (pointer-ref-c-unsigned-long pointer offset)) + ((equal? type 'float) (pointer-ref-c-float pointer offset)) + ((equal? type 'double) (pointer-ref-c-double pointer offset)) + ((equal? type 'void) (pointer-ref-c-pointer pointer offset)) + ((equal? type 'pointer) (pointer-ref-c-pointer pointer offset))))) + +#;(define pffi-string->pointer + (lambda (string-content) + (string-to-pointer string-content))) + +#;(define pffi-pointer->string + (lambda (pointer) + (pointer-to-string pointer))) + +(define pffi-type->native-type + (lambda (type) + (cond ((equal? type 'int8) 'int8_t) + ((equal? type 'uint8) 'uint8_t) + ((equal? type 'int16) 'int16_t) + ((equal? type 'uint16) 'uint16_t) + ((equal? type 'int32) 'int32_t) + ((equal? type 'uint32) 'uint32_t) + ((equal? type 'int64) 'int64_t) + ((equal? type 'uint64) 'uint64_t) + ((equal? type 'char) 'char) + ((equal? type 'unsigned-char) 'char) + ((equal? type 'short) 'short) + ((equal? type 'unsigned-short) 'unsigned-short) + ((equal? type 'int) 'int) + ((equal? type 'unsigned-int) 'unsigned-int) + ((equal? type 'long) 'long) + ((equal? type 'unsigned-long) 'unsigned-long) + ((equal? type 'float) 'float) + ((equal? type 'double) 'double) + ((equal? type 'pointer) '(maybe-null void*)) + ((equal? type 'string) 'string) + ((equal? type 'void) 'void) + ((equal? type 'callback) '(maybe-null void*)) + (else (error "pffi-type->native-type -- No such pffi type" type))))) + +;; pffi-define-function + +(define pffi-type->libffi-type + (lambda (type) + (cond ((equal? type 'int8) (get-ffi-type-int8)) + ((equal? type 'uint8) (get-ffi-type-uint8)) + ((equal? type 'int16) (get-ffi-type-int16)) + ((equal? type 'uint16) (get-ffi-type-uint16)) + ((equal? type 'int32) (get-ffi-type-int32)) + ((equal? type 'uint32) (get-ffi-type-uint32)) + ((equal? type 'int64) (get-ffi-type-int64)) + ((equal? type 'uint64) (get-ffi-type-uint64)) + ((equal? type 'char) (get-ffi-type-char)) + ((equal? type 'unsigned-char) (get-ffi-type-uchar)) + ((equal? type 'bool) (get-ffi-type-int8)) + ((equal? type 'short) (get-ffi-type-short)) + ((equal? type 'unsigned-short) (get-ffi-type-ushort)) + ((equal? type 'int) (get-ffi-type-int)) + ((equal? type 'unsigned-int) (get-ffi-type-uint)) + ((equal? type 'long) (get-ffi-type-long)) + ((equal? type 'unsigned-long) (get-ffi-type-ulong)) + ((equal? type 'float) (get-ffi-type-float)) + ((equal? type 'double) (get-ffi-type-double)) + ((equal? type 'void) (get-ffi-type-void)) + ((equal? type 'pointer) (get-ffi-type-pointer)) + ((equal? type 'callback) (get-ffi-type-pointer))))) + +(define argument->pointer + (lambda (value type) + (cond ((procedure? value) (scheme-procedure-to-pointer value)) + (else (let ((pointer (pffi-pointer-allocate (size-of-type type)))) + (pffi-pointer-set! pointer type 0 value) + pointer))))) + +(define make-c-function + (lambda (shared-object c-name return-type argument-types) + (dlerror) ;; Clean all previous errors + (let ((c-function (dlsym shared-object c-name)) + (maybe-dlerror (dlerror))) + (when (not (pffi-pointer-null? maybe-dlerror)) + (error (pffi-pointer->string maybe-dlerror))) + (lambda arguments + (let ((return-value (pffi-pointer-allocate + (if (equal? return-type 'void) + 0 + (size-of-type return-type))))) + (internal-ffi-call (length argument-types) + (pffi-type->libffi-type return-type) + (map pffi-type->libffi-type argument-types) + c-function + return-value + (map argument->pointer + arguments + argument-types)) + (cond ((not (equal? return-type 'void)) + (pffi-pointer-get return-value return-type 0)))))))) + +(define-syntax pffi-define-function + (syntax-rules () + ((_ scheme-name shared-object c-name return-type argument-types) + (define scheme-name + (make-c-function shared-object + (symbol->string c-name) + return-type + argument-types))))) + +(define make-c-callback + (lambda (return-type argument-types procedure) + (scheme-procedure-to-pointer procedure))) + +(define-syntax pffi-define-callback + (syntax-rules () + ((_ scheme-name return-type argument-types procedure) + (define scheme-name + (make-c-callback return-type 'argument-types procedure))))) diff --git a/.gitignore b/.gitignore index f17fed8..ad79d61 100644 --- a/.gitignore +++ b/.gitignore @@ -44,3 +44,4 @@ tests/retropikzel *.rkt testfile.test tests/testfile.test +snow diff --git a/Makefile b/Makefile index b34c1ba..20c8ba1 100644 --- a/Makefile +++ b/Makefile @@ -4,6 +4,9 @@ DOCKER=docker run -it -v ${PWD}:/workdir DOCKER_INIT=cd /workdir && make clean && VERSION=$(shell grep "version:" README.md | awk '{split\($0,a\); print a[2];}') +snow: + snow-chibi --install-source-dir ./snow install "(r6rs bytevectors)" + # apt-get install pandoc weasyprint docs: mkdir -p documentation @@ -64,13 +67,19 @@ tr7: ypsilon: make -C retropikzel/pffi tr7 -test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so +test-compile-r7rs: tmp/test/libtest.o tmp/test/libtest.so tmp/test/libtest.a make ${COMPILE_R7RS} cp -r retropikzel tmp/test/ cp tests/compliance.scm tmp/test/ cp tests/c-include/libtest.h tmp/test/ - cd tmp/test && COMPILE_R7RS_CHICKEN="-L -ltest -I. -L." compile-r7rs -I . -o compliance compliance.scm - cd tmp/test && LD_LIBRARY_PATH=. ./compliance + cp -r snow/* tmp/test/ + cd tmp/test && \ + COMPILE_R7RS_GAMBIT="-cc-options \"-ltest -I. -L\" -ld-options \"-L.\"" \ + COMPILE_R7RS_CHICKEN="-L -ltest -I. -L." \ + compile-r7rs -I . -o compliance compliance.scm + cd tmp/test && \ + LD_LIBRARY_PATH=. \ + ./compliance test-compile-r7rs-docker: docker build --build-arg COMPILE_R7RS=${COMPILE_R7RS} --tag=r7rs-pffi-test-${COMPILE_R7RS} -f dockerfiles/test . @@ -84,10 +93,11 @@ tmp/test/libtest.so: tests/c-src/libtest.c mkdir -p tmp/test ${CC} -o tmp/test/libtest.so -shared -fPIC tests/c-src/libtest.c -I./include -tmp/test/libtest.a: tmp/test/libtest.o src/libtest.c +tmp/test/libtest.a: tmp/test/libtest.o tests/c-src/libtest.c ar rcs tmp/test/libtest.a tmp/test/libtest.o clean: + @rm -rf retropikzel/pffi/pffi.c @rm -rf retropikzel/pffi/*.o* @rm -rf retropikzel/pffi/*.so @rm -rf retropikzel/pffi/*.meta diff --git a/README.md b/README.md index 4739cb8..15aadb4 100644 --- a/README.md +++ b/README.md @@ -47,19 +47,19 @@ conforming to some specification. - [PFFI\_LOAD\_PATH](#environment-variables-pffi-load-path) - [Procedures and macros](#procedures-and-macros) - [pffi-init](#pffi-init) - - [pffi-size-of](#pffi-size-of) + - [c-size-of](#c-size-of) - [pffi-align-of](#pffi-align-of) - - [pffi-define-library](#pffi-define-library) - - [pffi-pointer-null](#pffi-pointer-null) - - [pffi-pointer-null?](#pffi-pointer-null) - - [pffi-pointer-allocate](#pffi-pointer-allocate) + - [define-c-library](#define-c-library) + - [make-c-null](#make-c-null) + - [c-null?](#is-c-null) + - [make-c-bytevector ](#make-c-bytevector ) - [pffi-pointer-address](#pffi-pointer-address) - - [pffi-pointer?](#pffi-pointer) - - [pffi-pointer-free](#pffi-pointer-free) + - [c-bytevector?](#is-c-bytevector) + - [c-free](#c-free) - [pffi-pointer-set!](#pffi-pointer-set!) - [pffi-pointer-get](#pffi-pointer-get) - - [pffi-string->pointer](#pffi-string->pointer) - - [pffi-pointer->string](#pffi-pointer->string) + - [string->c-bytevector](#string-into-c-bytevector) + - [c-bytevector->sring](#c-bytevector-into-string) - [pffi-struct-make](#pffi-struct-make) - [pffi-struct-pointer](#pffi-struct-pointer) - [pffi-struct-offset-get](#pffi-struct-offset-get) @@ -73,7 +73,7 @@ conforming to some specification. - [pffi-array-set!](#pffi-array-set!) - [pffi-list->array](#pffi-list->array) - [pffi-array->list](#pffi-array->list) - - [pffi-define-function](#pffi-define-function) + - [define-c-procedure](#define-c-procedure) - [pffi-define-callback](#pffi-define-callback) @@ -99,8 +99,7 @@ conforming to some specification. ## Status -Currently the interface of the library is in okay shape. It propably will not change much but no -guarantees are being made just yet. +In alpha. ### Current caveats @@ -111,7 +110,7 @@ guarantees are being made just yet. - Always pass pffi-define-callback procedure as lambda in place - No support for variadic function arguments - Can be partially worked around by defining multiple versions of same - function with different amount of arguments + function with different number of arguments ## Roadmap @@ -123,24 +122,24 @@ For roadmap to 1.0.0 see [issues](https://todo.sr.ht/~retropikzel/r7rs-pffi?sear ## Primitives -| | pffi-init | pffi-size-of | pffi-define-library | pffi-pointer-null | pffi-pointer-null? | pffi-pointer-address | pffi-pointer? | pffi-pointer-set! | pffi-pointer-get | pffi-define | pffi-define-callback | -|--------------|:---------:|:------------:|:-------------------:|:-----------------:|:------------------:|:--------------------:|:-------------:|:-----------------:|:----------------:|:-----------:|:--------------------:| -| Chibi | X | X | X | X | X | X | X | X | X | X | | -| Chicken | X | X | X | X | X | X | X | X | X | X | X | -| Cyclone | X | X | X | X | X | | X | X | X | X | | -| Gambit | X | X | | | | X | | | | | | -| Gauche | X | X | X | X | X | X | X | X | X | X | | -| Gerbil | X | | | | | | | | | | | -| Guile | X | X | X | X | X | X | X | X | X | X | X | -| Kawa | X | X | X | X | X | X | X | X | X | X | X | -| Larceny | X | | | | | | | | | | | -| Mosh | X | X | X | X | X | | X | X | X | X | X | -| Racket | X | X | X | X | X | X | X | X | X | X | X | -| Saggittarius | X | X | X | X | X | X | X | X | X | X | X | -| Skint | X | | | | | | | | | | | -| Stklos | X | X | X | X | X | | X | | | | | -| tr7 | | | | | | | | | | | | -| Ypsilon | X | X | X | X | X | X | X | X | X | X | X | +| | c-size-of | define-c-library | c-bytevector? | pffi-pointer-set! | pffi-pointer-get | define-c-procedure | pffi-define-callback | +|--------------|:------------:|:-------------------:|:-------------:|:-----------------:|:----------------:|:-------------------:|:--------------------:| +| Chibi | X | X | X | X | X | X | | +| Chicken | X | X | X | X | X | X | X | +| Cyclone | X | X | X | X | X | X | | +| Gambit | X | | | | | | | +| Gauche | X | X | X | X | X | X | | +| Gerbil | | | | | | | | +| Guile | X | X | X | X | X | X | X | +| Kawa | X | X | X | X | X | X | X | +| Larceny | | | | | | | | +| Mosh | X | X | X | X | X | X | X | +| Racket | X | X | X | X | X | X | X | +| Saggittarius | X | X | X | X | X | X | X | +| Skint | | | | | | | | +| Stklos | X | X | X | | | | | +| tr7 | | | | | | | | +| Ypsilon | X | X | X | X | X | X | X | ## Built upon @@ -148,8 +147,11 @@ For roadmap to 1.0.0 see [issues](https://todo.sr.ht/~retropikzel/r7rs-pffi?sear These features are built upon the primitives and if primitives are implemented and work, they should work too. -- pffi-pointer-allocate -- pffi-pointer-free +- make-c-bytevector +- make-c-null +- c-null? +- pffi-pointer-address +- c-free - pffi-pointer-\>string - pffi-string-\>pointer - pffi-struct-make @@ -339,10 +341,10 @@ Some of these are procedures and some macros, it might also change implementatio Always call this first, on most implementation it does nothing but some implementations might need initialisation run. -#### pffi-size-of - +#### c-size-of + -**pffi-size-of** object -> number +**c-size-of** object -> number Returns the size of the pffi-struct, pffi-enum or pffi-type. @@ -353,10 +355,10 @@ Returns the size of the pffi-struct, pffi-enum or pffi-type. Returns the align of the type. -#### pffi-define-library - +#### define-c-library + -**pffi-define-library** headers shared-object-name [options] -> object +**define-c-library** headers shared-object-name [options] -> object Load given shared object automatically searching many predefined paths. @@ -377,12 +379,12 @@ keyword. The options are: Example: (cond-expand - (windows (pffi-define-library libc-stdlib + (windows (define-c-library libc-stdlib '("stdlib.h") "ucrtbase" '((additional-versions ("0" "6")) (additiona-paths ("."))))) - (else (pffi-define-library libc-stdlib + (else (define-c-library libc-stdlib (list "stdlib.h") "c" '((additional-versions ("0" "6")) @@ -399,45 +401,57 @@ implementations. - Do pass the options using quote - As '(... and not (list... -#### pffi-pointer-null - +#### make-c-null + -**pffi-pointer-null** -> pointer +**make-c-null** -> pointer Returns a new NULL pointer. -#### pffi-pointer-null? - +#### c-null? + -**pffi-pointer-null?** pointer -> boolean +**c-null?** pointer -> boolean Returns #t if given pointer is null pointer, #f otherwise. -#### pffi-pointer-allocate - +#### make-c-bytevector + -**pffi-pointer-allocate** size -> pointer +(make-c-bytevector *k*) +(make-c-bytevector *k* *fill*) -Returns newly allocated pointer of given size. +Returns a newly allocated C bytevector(pointer) of length k. If byte is given, +then all elements of the C bytevector are initialized to byte, otherwise the +contents of each element are unspecified. #### pffi-pointer-address -**pffi-pointer-address** pointer -> number +**pffi-pointer-address** pointer -> pointer -Returns the address of given pointer as number. +Returns the address of given pointer inside a pointer. This is used when +passing pointers to pointers to foreign procedures. This is similar to the +c's &. One **important difference** is that after you have passed a pointer to +the procedure you must get value from it back to the pointer which address you +are passing. Example: -#### pffi-pointer? + (define input-pointer (make-c-bytevector )) + (define input-pointer-address (pffi-pointer-address input-pointer)) + ( input-pointer-address) + (set! input-pointer (pffi-pointer-get input-pointer-address 'pointer 0)) + +#### c-bytevector? -**pffi-pointer?** object -> boolean +**c-bytevector?** object -> boolean Returns #t if given object is pointer, #f otherwise. -#### pffi-pointer-free - +#### c-free + -**pffi-pointer-free** pointer +**c-free** pointer Frees given pointer. @@ -448,7 +462,7 @@ Frees given pointer. Sets the value on a pointer on given offset. For example: - (define p (pffi-pointer-allocate 128)) + (define p (make-c-bytevector 128)) (pffi-pointer-set! p 'int 64 100) Would set the offset of 64, on pointer p to value 100. @@ -460,22 +474,22 @@ Would set the offset of 64, on pointer p to value 100. Gets the value from a pointer on given offset. For example: - (define p (pffi-pointer-allocate 128)) + (define p (make-c-bytevector 128)) (pffi-pointer-set! p 'int 64 100) (pffi-pointer-get p 'int 64) > 100 -#### pffi-string->pointer - +#### string->c-bytevector + -**pffi-string->pointer** string -> pointer +**string->c-bytevector** string -> pointer Makes pointer out of a given string. -#### pffi-pointer->string - +#### c-bytevector->string + -**pffi-pointer->string** pointer -> string +**c-bytevector->sring** pointer -> string Makes string out of a given pointer. @@ -581,17 +595,17 @@ Converts given list into C array of given type. Converts given C array into list of given type and length. -#### pffi-define-function - +#### define-c-procedure + -**pffi-define-function** scheme-name shared-object c-name return-type argument-types +**define-c-procedure** scheme-name shared-object c-name return-type argument-types Defines a new foreign function to be used from Scheme code. For example: (cond-expand - (windows (pffi-define-library libc-stdlib '("stdlib.h") "ucrtbase" '(""))) - (else (pffi-define-library libc-stdlib '("stdlib.h") "c" '("" "6")))) - (pffi-define-function c-puts libc-stdlib 'puts 'int '(pointer)) + (windows (define-c-library libc-stdlib '("stdlib.h") "ucrtbase" '(""))) + (else (define-c-library libc-stdlib '("stdlib.h") "c" '("" "6")))) + (define-c-procedure c-puts libc-stdlib 'puts 'int '(pointer)) (c-puts "Message brought to you by FFI!") #### pffi-define-callback @@ -603,11 +617,11 @@ Defines a new Sceme function to be used as callback to C code. For example: ; Load the shared library (cond-expand - (windows (pffi-define-library libc-stdlib '("stdlib.h") "ucrtbase" '())) - (else (pffi-define-library '("stdlib.h") "c" '("" "6")))) + (windows (define-c-library libc-stdlib '("stdlib.h") "ucrtbase" '())) + (else (define-c-library '("stdlib.h") "c" '("" "6")))) ; Define C function that takes a callback - (pffi-define-function qsort libc-stdlib 'qsort 'void '(pointer int int callback)) + (define-c-procedure qsort libc-stdlib 'qsort 'void '(pointer int int callback)) ; Define our callback (pffi-define-callback compare @@ -621,17 +635,17 @@ Defines a new Sceme function to be used as callback to C code. For example: ((< a b) -1))))) ; Create new array of ints to be sorted - (define array (pffi-pointer-allocate (* (pffi-size-of 'int) 3))) - (pffi-pointer-set! array 'int (* (pffi-size-of 'int) 0) 3) - (pffi-pointer-set! array 'int (* (pffi-size-of 'int) 1) 2) - (pffi-pointer-set! array 'int (* (pffi-size-of 'int) 2) 1) + (define array (make-c-bytevector (* (c-size-of 'int) 3))) + (pffi-pointer-set! array 'int (* (c-size-of 'int) 0) 3) + (pffi-pointer-set! array 'int (* (c-size-of 'int) 1) 2) + (pffi-pointer-set! array 'int (* (c-size-of 'int) 2) 1) (display array) (newline) ;> (3 2 1) ; Sort the array - (qsort array 3 (pffi-size-of 'int) compare) + (qsort array 3 (c-size-of 'int) compare) (display array) (newline) diff --git a/documentation/R7RS-PFFI.html b/documentation/R7RS-PFFI.html index aeb5c00..9c712d3 100644 --- a/documentation/R7RS-PFFI.html +++ b/documentation/R7RS-PFFI.html @@ -76,23 +76,22 @@ Documentation - 0.6.0
  • Procedures and macros
    • @@ -141,9 +139,7 @@ Documentation - 0.6.0

    Status

    -

    Currently the interface of the library is in okay shape. It - propably will not change much but no guarantees are being made - just yet.

    +

    In alpha.

    Current caveats

      @@ -156,7 +152,7 @@ Documentation - 0.6.0
    • No support for variadic function arguments
      • Can be partially worked around by defining multiple versions - of same function with different amount of arguments
        • + of same function with different number of arguments

    Roadmap

    @@ -167,34 +163,26 @@ Documentation - 0.6.0

    Primitives

    - +
    - - - - + - - - - - + + + + - - - - - - - + + + - + @@ -207,10 +195,6 @@ Documentation - 0.6.0 - - - - @@ -222,10 +206,6 @@ Documentation - 0.6.0 - - - - @@ -234,23 +214,15 @@ Documentation - 0.6.0 - - - - - - - - @@ -263,18 +235,10 @@ Documentation - 0.6.0 - - - - - - - - @@ -292,10 +256,6 @@ Documentation - 0.6.0 - - - - @@ -306,17 +266,9 @@ Documentation - 0.6.0 - - - - - - - - @@ -332,10 +284,6 @@ Documentation - 0.6.0 - - - - @@ -348,10 +296,6 @@ Documentation - 0.6.0 - - - - @@ -362,17 +306,9 @@ Documentation - 0.6.0 - - - - - - - - @@ -386,10 +322,6 @@ Documentation - 0.6.0 - - - - @@ -404,10 +336,6 @@ Documentation - 0.6.0 - - - - @@ -418,10 +346,6 @@ Documentation - 0.6.0 - - - -
    pffi-initpffi-size-ofpffi-define-librarypffi-pointer-nullpffi-pointer-null?pffi-pointer-addresspffi-pointer?c-size-ofdefine-c-libraryc-bytevector? pffi-pointer-set! pffi-pointer-getpffi-definedefine-c-procedure pffi-define-callback
    X X XXXXX
    X X XXXXX
    Cyclone X X XXXX X
    Gambit XX X X X XXXXX
    GerbilX X X XXXXX
    Kawa X X XXXXX
    LarcenyX X X XXXX X X
    X X XXXXX
    Saggittarius X X XXXXX
    SkintX X X XXXX
    Ypsilon X X XXXXX
    @@ -430,8 +354,11 @@ Documentation - 0.6.0

    These features are built upon the primitives and if primitives are implemented and work, they should work too.

      -
    • pffi-pointer-allocate
      • -
    • pffi-pointer-free
      • +
    • make-c-bytevector
      • +
    • make-c-null
      • +
    • c-null?
      • +
    • pffi-pointer-address
      • +
    • c-free
    • pffi-pointer->string
    • pffi-string->pointer
    • pffi-struct-make
      • @@ -619,19 +546,19 @@ make <SCHEME>

      Always call this first, on most implementation it does nothing but some implementations might need initialisation run.

      -

      pffi-size-of

      -

      -

      pffi-size-of object -> number

      +

      c-size-of

      +

      +

      c-size-of object -> number

      Returns the size of the pffi-struct, pffi-enum or pffi-type.

      pffi-align-of

      pffi-align-of type -> number

      Returns the align of the type.

      -

      pffi-define-library

      -

      -

      pffi-define-library headers - shared-object-name [options] -> object

      +

      define-c-library

      +

      +

      define-c-library headers shared-object-name + [options] -> object

      Load given shared object automatically searching many predefined paths.

      Takes as argument a list of C headers, these are for the @@ -656,12 +583,12 @@ make <SCHEME>

    Example:

    (cond-expand
-  (windows (pffi-define-library libc-stdlib
+  (windows (define-c-library libc-stdlib
                                 '("stdlib.h")
                                 "ucrtbase"
                                 '((additional-versions ("0" "6"))
                                   (additiona-paths (".")))))
-  (else (pffi-define-library libc-stdlib
+  (else (define-c-library libc-stdlib
                              (list "stdlib.h")
                              "c"
                              '((additional-versions ("0" "6"))
@@ -681,38 +608,47 @@ make <SCHEME>
  • As ’(… and not (list…
    • -

    pffi-pointer-null

    -

    -

    pffi-pointer-null -> pointer

    +

    make-c-null

    +

    +

    make-c-null -> pointer

    Returns a new NULL pointer.

    -

    pffi-pointer-null?

    -

    -

    pffi-pointer-null? pointer -> boolean

    +

    c-null?

    +

    +

    c-null? pointer -> boolean

    Returns #t if given pointer is null pointer, #f otherwise.

    -

    pffi-pointer-allocate

    -

    -

    pffi-pointer-allocate size -> pointer

    +

    make-c-bytevector

    +

    +

    make-c-bytevector size -> pointer

    Returns newly allocated pointer of given size.

    pffi-pointer-address

    pffi-pointer-address pointer -> - number

    -

    Returns the address of given pointer as number.

    -

    pffi-pointer?

    + pointer

    +

    Returns the address of given pointer inside a pointer. This + is used when passing pointers to pointers to foreign procedures. + This is similar to the c’s &. One important + difference is that after you have passed a pointer to + the procedure you must get value from it back to the pointer + which address you are passing. Example:

    + 
    (define input-pointer (make-c-bytevector <needed size>))
+(define input-pointer-address (pffi-pointer-address input-pointer))
+(<foreign-procedure-that takes &pointer as argument> input-pointer-address)
+(set! input-pointer (pffi-pointer-get input-pointer-address 'pointer 0))
    +

    c-bytevector?

    -

    pffi-pointer? object -> boolean

    +

    c-bytevector? object -> boolean

    Returns #t if given object is pointer, #f otherwise.

    -

    pffi-pointer-free

    -

    -

    pffi-pointer-free pointer

    +

    c-free

    +

    +

    c-free pointer

    Frees given pointer.

    pffi-pointer-set!

    pffi-pointer-set! pointer type offset value

    Sets the value on a pointer on given offset. For example:

    - 
    (define p (pffi-pointer-allocate 128))
+        
    (define p (make-c-bytevector 128))
 (pffi-pointer-set! p 'int 64 100)
    
         
    Would set the offset of 64, on pointer p to value 100.
    
         
    pffi-pointer-get
    
@@ -721,18 +657,18 @@ make <SCHEME>
    object

    Gets the value from a pointer on given offset. For example:

    - 
    (define p (pffi-pointer-allocate 128))
+        
    (define p (make-c-bytevector 128))
 (pffi-pointer-set! p 'int 64 100)
 (pffi-pointer-get p 'int 64)
 > 100
    
-        
    pffi-string->pointer
    
-        
    
-        
    pffi-string->pointer string ->
+        
    string->c-bytevector
    
+        
    
+        
    string->c-bytevector string ->
         pointer
    
         
    Makes pointer out of a given string.
    
-        
    pffi-pointer->string
    
-        
    
-        
    pffi-pointer->string pointer ->
+        
    c-bytevector->string
    
+        
    
+        
    c-bytevector->sring pointer ->
         string
    
         
    Makes string out of a given pointer.
    
         
    pffi-struct-make
    
@@ -804,16 +740,16 @@ make <SCHEME>

    pffi-array->list type list length

    Converts given C array into list of given type and length.

    -

    pffi-define-function

    -

    -

    pffi-define-function scheme-name - shared-object c-name return-type argument-types

    +

    define-c-procedure

    +

    +

    define-c-procedure scheme-name shared-object + c-name return-type argument-types

    Defines a new foreign function to be used from Scheme code. For example:

    (cond-expand
-    (windows (pffi-define-library libc-stdlib '("stdlib.h") "ucrtbase" '("")))
-    (else (pffi-define-library libc-stdlib '("stdlib.h")  "c" '("" "6"))))
-(pffi-define-function c-puts libc-stdlib 'puts 'int '(pointer))
+    (windows (define-c-library libc-stdlib '("stdlib.h") "ucrtbase" '("")))
+    (else (define-c-library libc-stdlib '("stdlib.h")  "c" '("" "6"))))
+(define-c-procedure c-puts libc-stdlib 'puts 'int '(pointer))
 (c-puts "Message brought to you by FFI!")

    pffi-define-callback

    @@ -823,11 +759,11 @@ make <SCHEME> code. For example:

    ; Load the shared library
 (cond-expand
-    (windows (pffi-define-library libc-stdlib '("stdlib.h") "ucrtbase" '()))
-    (else (pffi-define-library '("stdlib.h") "c" '("" "6"))))
+    (windows (define-c-library libc-stdlib '("stdlib.h") "ucrtbase" '()))
+    (else (define-c-library '("stdlib.h") "c" '("" "6"))))
 
 ; Define C function that takes a callback
-(pffi-define-function qsort libc-stdlib 'qsort 'void '(pointer int int callback))
+(define-c-procedure qsort libc-stdlib 'qsort 'void '(pointer int int callback))
 
 ; Define our callback
 (pffi-define-callback compare
@@ -841,17 +777,17 @@ make <SCHEME>
    ((< a b) -1))))) ; Create new array of ints to be sorted -(define array (pffi-pointer-allocate (* (pffi-size-of 'int) 3))) -(pffi-pointer-set! array 'int (* (pffi-size-of 'int) 0) 3) -(pffi-pointer-set! array 'int (* (pffi-size-of 'int) 1) 2) -(pffi-pointer-set! array 'int (* (pffi-size-of 'int) 2) 1) +(define array (make-c-bytevector (* (c-size-of 'int) 3))) +(pffi-pointer-set! array 'int (* (c-size-of 'int) 0) 3) +(pffi-pointer-set! array 'int (* (c-size-of 'int) 1) 2) +(pffi-pointer-set! array 'int (* (c-size-of 'int) 2) 1) (display array) (newline) ;> (3 2 1) ; Sort the array -(qsort array 3 (pffi-size-of 'int) compare) +(qsort array 3 (c-size-of 'int) compare) (display array) (newline) diff --git a/documentation/R7RS-PFFI.pdf b/documentation/R7RS-PFFI.pdf index 2e6fcde1319dc702efdb4c1634bda68a983e5837..2ac5fa0bbb5735f5d2f8e63e0d88c1abdd9782ff 100644 GIT binary patch delta 41965 zcmZ_0bzD_X^EeLDjdV9ibBi0Kq;yNCv~-8SMFa~(;S$o)QUcPgpdc+EppQ^f(Zps{#3Ufc^Ok{%1g54X8iw zP>?@={Xs$fK|%dN0fRtsF{9WJ%pKq#CmAgl7={pqz)=YJCAI|zzpcofAYXfbds|-* zZvhT74ipG;J&jHnED8prz%bPRB8fP=`+A7@_*6M>iU;FFA7>VBtjH{ zghD{zf4%o{4z?HZaJWQ4!Y>J8f`CN9C=?j-uOm1)-*LWr4Z;9h5W+!lQ3wbI#>`^V zV1qE&S+oQQlqd=WLt(C8V*yyjOKWHE;OuTMVk_e6e8=0yJLqaQW)6?`23#B=3J16- z{&)X>V|sdf*xK9qdH*@gB`)UTB{@dt8a1%T)wU>zC>$z|z=U68zXActgTwUx$T2prQ~k0)Z*VVY=Fth8zKdh$7$+$R9nxWQj1~{o$P#1sy3=R2(7> zhg^vVctwv<6Q%t78lZ*@0h|F21|cu?&H_`(&5jF9g}`awG?X0Sy8qgt%fq zfWw9n!K1uF(Zd5>jU=h$d9_^%6a_wcpMFN zz~Fyx@(0b^+vduQQ1DC1^8H^s`VW$bjH|QHl?nr>0FQ~F2*65^C?piaLc|704uEk3 zl%P-m3;uHJzh*oBQGZ}Az$qd)SQI9XL_*-0I3gzOtM$m>fExtC;eR-dxvxNbso#Id z;`#rlUBu_#3j@kT1c!=35m$;SLwvdLrEx$37#IOq$CYtltI%H>2kMe1#NvSO1tX9s z6a)hzp#ktOc>sYz0BL|xuq$ig;J-S><>5tSZ2rkEVhB`R6as~U0PDygx!ez!&jo=4 zKokh^FJE{y-_rx|(to4|XbXTwganI%-~g*2m~3)t3_B^w)pS|{z|+Ez;t)(0IV~oY zl=RBq&=GGNhl-=3KGZcP%;7x1-2yw zToM8dSO>4GOy@hfn0_MxHuB@*ATotZ0y`@JTKYw$1A&~kYnCaK^d-s z_W$~xD@lk#fS?M6AOT1Chm=1d{!h67A9wXfco4uZLJ%MX3WeFAV)!FG0tldK0M{{` z)Q1{@Hvj0`bAq`i$BabS9jsrvIp7-j2G`6u>w3r4>zgd!%OC{ES_`fNXW{uPdU`HKEED>!;+g)T$B^FmacB%){5O( zxQpFUx(EK|5cJ@e7R0JJOCEM7BB~R_$3q~Cw(L0LAQ8vYAsZ2J@YWR2iSdbczO{7J zkzfwee_iC4hLvdAj#3g;z#UfJIA(U~dlpKiA!6Rmi_w3^7!!f7sJukx$?N!5$F_?r zkjLbKL$V8*rsLBtOYKFniiDCo!ka6vos8TXcOwg6@wSUbf*v5&4bIHQ#PGO;Y5tW) zG!s{SN?pRfFif7rU(J%|H?cmHfoqUHm}H|iTTw$SMCS& zqgOpURn-eKhDk%*{4w@06tXE}9Q=lY$clgItn^EY`%3sjFbyzeaK*7HV~h7mLfrH^Ww&<)u{03fS zloI%5W>E#s%h;1fGE&K0@Bt=dT5eO9_MD zTBgtS1H3mxZ2EK>;zX{SPdr!MEXdr8;DxSm)>g=}S`X~vzqDjqXujsEwj-g0>XE&z zaPV}SZ8qI2-Jkjw{EJ157MU_?nRD@8r_nwL_%xe+=}2HiVVNL>xO5L<*|8@_SHh96y`QUIB7TcONIPv{uRcwA zvi>Jc_o}Nyh!h#B$UM&GYi?@$N)qKfl;?|^!=sh)0%n+WsX(Gh3L86jLD!s&XaMY8 z>CZJ3aRY(o;CEp?2-|&GrIDKVXse0prHA!1dDqjEemcNI$3JXDcl8w^`*)8a{mZF~5n}$2(c82}CXZ^;SKm8$1`0)$0*+_=zWtTXfL%9&7-Va~#ubqK+Yz!JUsrA|MY2b>Id z++FKCeV(f;G%ckzbZDMh*ejz&tJ3l4<5`2~0xXlTRu^aX-ZuScA)Q)_jHdczA~*To ze(TqI{2o$!9^y*Ak-)-;DD1kO(%_jS$}>VaVCvtq(N}H^j?nxifSYm}!%f1%{4&|= zo=7Na{%alkX%r1f>?yfb{!p(^-ct`jUmfFfHaUW*CCnK)aj)YRD@_twyO+IuyR*UX z61s2+Z3Lj&cO?0Rv!eZVjAe>Kn%kLIA}@hIBmiKB9{_y+<5fjS*nVIXLd)+GSOu&s zv$+ZYe}0y;`Q`iSLHjP-*#hm%SLv-+70rdyayCK94FIs!1K5Z4s~NH1Ig@T;`_nRr z#`?zxw4!yK_k@}!q?+}PbH3zW7p<*4CrF<8dK%QMo}311u?ViI(arY^J|k#vVR&Da z4p+s-l)4g><@(jE3@I-idsW2|L)82&rg`0vXG46dvSW>)q#CSO(p<8jjjBYsm7gCl2#`2>t9 zat0VnIe-HB+n7yYtd}>&gvv`|)D?^{lnRoVX$37zHZVFUnqY(#B{3(8`WPFO1m=;_ zZH%UpB!*u3Hf9PK3xUy9S&|wkuVLa>)iDI96ktFdBaTtK#Y^=sX^8y0(#LEmt6+L> znE*N7eKCGCkmLU|FEN>nT~s6u-75b?;i@?;HtcknmuzE^JTNBO`8=YrMY311{cdZ) zpyx@6UdG${zS`izCZ9V^176>>a`=eK1BlO~4WBURZ~HekXUb&d5o)!!#k_7^?C5p* zHTPV*u&Ij5`(%G*?QBFfd&sE(ofkzS_YEoClKC?%_+lrmOY8=%(&ukeBM1AvEeR9q zYh2CKyS00ccw1N;IN#^$Yqq6Dx^^9r%cmXXBO?pTy3SC6^{74kYXdUu==1Z1fbUv8 zxlkzcShP)mXs77XJ&rC7)N*pbc|U!O*|pl^7M8l$uWG%&4oxd6=}QCT(I1T?`sccN zaeWi}Bf3*AScYr1xm_|}U}8p>0!Vw^o0mV^y-&KASnfxC9lFisBe^-t~At`sGKoGGA+Q9_(H=yHuRKWY1ibUIJe-ZA=iY?e*S^ z_oeRIMSVyaa71>Ab|na*(JKq|5m{%n0v6pe3H~y&`Z3=7t0Q_OE>21N7Kd7+72vZr zo6NVb7vEA@pL>gxq}=}0<`duP8ngU;;SL2tmXF^isM0=K@Xc|Zoh?7r@5JMcO@v$g z_CZ+g(yW6P23N3cNF-CCjb@y;sC0#wRkmSrDbP4Jy8X*BJjNa)e2@im>yW z{+w?~i1vKk+d1Dse!*zZ!`AN8w8JC&z&E#v$8!1(=>yEP%IfWpjI?_-u!s9EmWLv= zXe8dhh`$wQ^QF42VID69S1ij#RyHKG@pn!PD3MyI8ll#-c3@{M4-t^(ENHus(N=?? zPuKSs);a?D-a?)buC0YwNiH^}`lep{rCosih1X?ydn#1sE2ScOU*cEwm`c@Xy`TTh z^`d3}ksg9M1vQY41a;&=g|+^(`)P(@&YbIf7j7;>(`4>7w4aNfxw<*Jyr zR&T07y4_KA`F+EaBVl*OzvWep-o81%)NIVtT$^v=rga+XH+->z?Yd5;e61G8d@Gr4 z7%f^*?dHNYUA0S;=vr3a7HhW?3iE#ZyIwWxYt@iMTB3qGAoO@ zkLn7O3?bW#`7cx((moE0XIwaQld`D?p!>cZJqd6z2a2Jyo<(z_-S_@s*N%h)ps|ki5Q%?uyHhb zXWu=+O*alFV^u6x!*r5}rIUzd+)?{AWwLtWMYYU1x~Jc$JEL~1aZ{M(2V7Zyy3?t6 zlEGrFGhBa~p%RV7{GPDPztINKF4XF>(zmEsT}EXR)%&a{y0}8}w@wr|wHTzVPusbw zhKHYC{4N}Gt&?b4TkfL+`DZbE>cxJ~w8OKMTh-9dk^cCpp9gO0PoO;IB?+{gRwBvy z>mkL=&7Em*_q63*(6?BHy>FhpD{>-5 z(muN`@hZn-GWlL$;XzBO`=sBk(Bk(qeR24>}!bT=czn`~P6 zf2J?FLcwT;=G!Ipmbw8a!Br$t-isFHYt}d*LmY zg*z=bWh}*swLI$%{LB3NsBB9O@1TPxLMO0?sHUs} zb55?icWIj+?=AfNsY0|NdtP(z-q#_GFWW7Z=npD_w3FRwI{GxuwpAb*p~O?4LTn5BAS8+|c(zO7UAEP_+MBo9$uq%p)DxOR*t18oxzi3oV9OrtG=)G z%1uLsuliyl_=U@7o$sikVLYdYZ1?fC*wlDLrQaEQ)MMjOamEXU!^DSg-*{}TT zaT7teD>cseO;HS8u!u}jo}6CzYMfE=lSfG*GLa9Gp9C%^RH(L{!lSQdDQM{mD*>ZIn0TH#YA_U%5nKEJLY{NeG^ z`QW&1J?Wme>Lw{!=WVYu`Iuj%%g7aSbZm+Ip}yvEmxq6VRe`*i-V!bhny{7SFS948 z$%=1z(Lo=t#l?4o-U^#&F%w`E;_4N~@z^Y6xixluNy?45N2)W2Cpn6XUZzDJKlyPt zA(zl^9F2UlVlB0xq8}``V>(~aIEOvUKkF;-$cZ~swr-PWK;3f;j*>-3#WK+tqjU1) z?pm``nWViD%*aQz>`r{YCK-H3`mw{SFE5p7f30@kYc^eTXfx=ebU3ze>)T*;sa5YL z9tmpxSc`eqp7a8DRKa?N!+HGB+x**AvN z9GpGc*7Rs-Ae9uy#^S%(=Ma5YIT@O(qC?da?dAKf4FAiUPpNP7yz+IWK%Y-)OsJ?$ z9NIi?V!I`s(lhHYC9F$ucHf0d|9W>IW`aRR`D>=QaMfLH45Pz0%NmI97qr7`CrDse)IgLHO4(Z$Ze~7~(kvn$Vanuhzh<*< zJjb$BZLH5(*kf2c6L@0!-7vJk(aN~On&k1u7n&lu0J~LuPi@|KIODydE;G~$o}pe_ zz&fWJOt?T`ko*9=|MCQ@730-s60n}_0#iyEyQZraE-5y2QjZ2zo){#TP7sLsSo=+Y^mHnAeLsX5+BsUCHq2-?-x=uen z_&20`&3(`unMoNfv6<0$HZiQ47`rcdWWv>Ur|p}u2d=gFF*CODGhza)v5xlZ;iHee z0FWIE0Ajp_W%!^AJN)4I5)^U?;sHPkJpk5gZ!Bx+&*)2-H~_;L1Yiul02%`;Rz2jr z2|VlSi^P#SiQg&+KX~!827COGTb+@!^fXiU@ZDILe17j9X0oI@vxW49r~SKaVk*Oq zC)cS&14gXm+KZ`WIfQ@2u3{y=+3#^LA8s6k-)v9h8{XtCW!AyrF<(!dviwjm_*S)( zdG{B=ZcnM&{{}IjL39HDTgHlUv=iUeP^9>H)V&@}*hJ}?d_P=X<0KtTL#A%mecu$U4k%SILl)AQelrjTX(qu2G$T=0m+~B7poM}2np?oC z5EL*A1O@*=jW-8l&dgBkzy-J{2nxGg76MQShF*5hIDkuTpnU?+b+xRq1t+G%9KZ#E zL;WHXbt#)i|NQg~isj{8?=H=~4>dIvF04qI+1-q1su(HM9qLKdW zB4LSj_JrIZhUmdMh4%D{me78xOwfmotkZh7p~C^br6H63P|#}~mzb~2IxjhRN6PfmvaJ7=xbE=JxWPK~epA!WF4lXaOveYe1NK@NtUu@7?%YS8 z=@Z=ls+8sG>VDBJq-OT2x2^HJ;P(;58!;pyH6ko&MYRO1i5(o6w`Mew^xgS4S8y`U z_SZJ2cFrWmlfjvpYjT}zcESsd5Saz>W2wyYAX3|S9+1%@6ecuc+IOMrp-CWr2z%Xj^}We6ROCqR_^pE~iJ+-@2;dDpmT*gHw4 zcz!ikSBY*Ca(H1t884G4#~hhc4|-@B-7i-m)`-maA$7Y83i=tEf*Dy@Jg+((VbZ`@ z8nw$}zFZ%S(+{25_TwTr;&3Ki_XbrHbD*S&f@yRP+$od7c11}JJxRts;~MLt!^Kr~ zgX2G@Tr0Rk`Qb5EQwOo~KJjOx7<;)L{l}2*RER$sErYl412)ogmqnViz`Xp|ayap$ zH?1}DqL~`&iPU$OT0N-gmr^pvBTU=~F$_>>5lNVsEsy4QMf+z0T1s2N^{vgHo6~7V znu`$GrfCNu?BvDXp&`x45#r~OXu(LDn(wb7bZQ^Q=kq2VC7C5Ztug3OEiEEnVfo07 z_d>gZUiFc)TvdcJZN?Mrk2o)X9DXxqOEqobOg3<$aob*9cw(Np!@M8#Q~e_O@B!XZ zI+>H!qNiB!Q?lgx2;cuWX_AJ-tg6E^VUt6cEJ6MFc;ku-yC9f>h?sgBNCQL%~ zl%?Rt^gY!1a(IMa-lg+vKaWU5_kQUK`GIb}FM&2ma@Zp&^mF@B>A^y8l5kJ+o;%zA z7g=J=;?OU!Q&OPBArA1^8!ExlETuK}7A=@Ant91=UT^E{nt1J&0Zrs5~}u6+0R z66n*U>ss)zjy4&*3IY^=ns9$h8Q?pP%P0W2sK2EQ(0jfN0~|;Q=9Rt8Wei|J0G}lQ zE#J$pkidYKML~h@C!qhi38lw~SqNZ!tywU<_Lt=kn;-}#3I_q-tN^YUaORiavH*)- z`c=fGuNLP3qkv8%3X_jka0drnPJUxt=PNZ3^q{BckkbLL$RLiR@azmCEa8bw{}F5*A{_&U4DN+ zczwL%=mE`4&wil}DPjqH7GW7P)~;MwYM#E^uDL&hmw;1vy_UGtF+K)Vx9CT*B z=D8nbv0IUQXmKp=F100p>N`As&5X^@E38QGT2Rk&uGV%}+-Un}Al5ERf~7po`v||g zs4(f~hKv1`6Gg^iU9^*WOOu$}<`9dHwb&x!G3qImz&cH_#C~HlJc&lRCBPAA04k zC0a11ABkCO8km8Ew%-A$nddLNlBMVDjL%p9#CF7Bvy zTG}pN3?0XPlaeuF9fvBRYqUQ?E6L@A2Hippu^eX|K_q9~yXnT1?C8dHu7${uZ|l%Z zXT?t66r~wH0b-He>u;le!nllAS$2EE#!gY$>~DLs?RZ!jAGMHCE3y)n2cFikQRVy! zTbFC?3UOB9m|s^KkH`M%avS3Oj7@_-|M;kBuYx3lm>NO-E#mj-j?&#?@2v(q;LuxPXq?0~ElWc05G&_t~0@jZt-m*;8vN6!b z(|J%#*EywX$}RFNn2S4wWC#;uA!uiou$ECgI$m&VBe*YRl)hvH?U?^;t>|sy^e}#C zuT3pXM>rEN2|rS9Dw4tYX_@Qe`b@r$or(D*VpZ=pd>(r(qc*|tS0m|#NP7bU5>U#l zO}lfxC)kZwJVl00b_N|dm;>cmD9e+{HDVhIFtK87u|I{NZa({Xr|{N{#>y-1+jhEM zuh@h1jGwON@6w=dp!58Y+?Dk`HCm^KYA*?A9*%|b4sgnqz`gvXzD2+y#8$7aKLAC$uN8(7*cuj-u3jO3DQ;O7_9y}bygZd ztChyIYF2xQZz)9)Sh+66Ep#>g=ew#2Q0qPCY0JzJP&WaW;`>k{Yho;SBFL!<-JE^au3H|8( zV$wWwoF!|snvF{Eees0m8!^Q<1g}~Sb~2*rxP;0@6`i#T#)z;3%GWH_d2c>Qj}J3t$@ZvNE4z0g_gErUqIWDm^DY3{LY#6iYAt`TNzbSBfDAO9Kar(?REFLvve zmJ_Ua^|d8hW~=W&xuuSb;|0$xY?jeDuX+gz5w`^T zGe$jZ)!JwiLHq5(KruTYO` zNbxIQ3w&nye|+s^>?E8r^vGzHpvN=t2IVoQijFT%p2#d0_EQ<8rI5D3i~WoH13C&% z@?IYVkK83IbA6f)O@=DmwSIB@i)h;l#3BE9CS`8-V0)7zs*dVnIOfN#;B;9ziZOm0 z`7bl%T0wL9`|l};BcD^|GND_oDA*~`H{#@iY_Gc=Ed5UID1j29LVm4~$K^eHE+I>x zqh|bA)HoH)7S=VG=Ob{@zlQbAT_>1O7nfwLXm0;t`^VgZM^;#5RW9@0?PyLqq2b!3D=#D2JWI7&m=Q6Xk<>2@Vb!IcrryZB1-PvZNPaX*z-jAQ2 zd}o~vq0-GEpw`%DW=yE@l`VwD70 zOsr5g0s(cs|w3 zezkQE99dbJAv396=c`Yc^UzQ8Q;uyQV)pN&`w$r=JRTD6bIM5yA!<@YB{j)$>z2z} zhu`&^C+Cfsgyz3^0~cV*#=oknOBT#L@NUN1zxiP?XjkT&9h8Ztr}JPQU^*cm_v5=! z?ry(RuLzRW_GXjxHi+xa{^Wl9%e-D!LF4tzC1TK)c?jwKfz0qkgPRqp&@dlue$0r- zn@YSV4iPYif}9?+adTJ6sObehLK)T+1j#*9A(CP593woCuuY=9aWqd*rHC|Z;~}k0 z8%-KfRtM<~8@55TS!hyLXOEBYqd>ohoNag^YmZ~k;OuO?)O^Xk4lX5x22>UNv|@=P z+)S;KPiFl*TdgdMPR+kbE;;+{THdn!%w@W!8RXfdF0Ytm=3&yF>LJ***k_o;?BXLe z`88b3cA2Trc3E+0$NbY?I{S7=Z=LzmVtG={6lV&RB%kbF^siX<8v5h<#~;*dvc#u8 z#s9L%5$?O4u;i`CoUG#NEp68L{@dyhWQ*0+Gszg#wh*_`rHXjb04cM-Hl`P10_HO; zCk=Rl9bytK*hp#W}VxHtA>8FZ)L4emcF*z0~` z=gamvh*j|gVmdZA7;WphW(->)yo#jTi_XmCj^HUEsYA}{|bb9%Tl9+0s+z2kknr>ur4 ztI$*HN@{^0D<$WGKVs8lo$lr(YHg$Kjn^SP(UfKT z)Wq6+Em$m&R@9rCB!6=v-kah&Qw%3;U9V&qn2jwH9gS-Y{I=8DQQol;DBDEcNc`q5 zC$n##N(y4}bF_eOWE2dnJmJCkGl#Fm`&lYhmTK{QL?wDGp3O{rYl8UqjQ75LfNA}- zA9s!&x9-K#t?&A#$W0h+;sf>>)9`0@=ym?`t>>P8@%L?W*c?2Px%xClC1@FZF=<1q zw@FmrrNt_w6oKi=)bkTf3ek zNB9vFgcdssq7Z)CJG9`3q~d{Wbl@(QC@JP2tM$n8^PdJQVxu_QG`ogzbsHQB?WZ4m zvM3D>>ZK>;E)x9*g@P@kTSK+deO&unXGuObIwC3OYwz3rT)f@S z?&zQ^>qxoXY3ODd?X(7y5ouCzlSpQsP{MfI-@M=B^h9abGOfZOY9qP>C+Up8GLOSOVbxhM&<9z)^sE>Yss483-w{x0*=XLVX@`i`n5BHDeg=> zrW=P10k4f@S~~7>pkL3WeJyC zxqR%gc9?KAOkje3f#~DP{>_M{oT^v#LW(gj^q<_Bjt%(IfYBC>+P+DpjW53h-m6>Zu4Z_0@|I_c$Ci%Ftw6qasDSZpBGd+?N*oz5 zbR&ynN{i=cE|a5Dy4IWis>)9n%^~Zz&(Xd7%qo$6RdB_^$*pSz`YaOJt_R(MCA22E zswNq2E;9i?)Act4T##WeeZsTc!Z$jZ6I!YgmQ6}B+|sm2?i5p=g zt>AOpUgV2Fal5@je(tQ3C>ePx5sJ&g&;2swC%bI6{Ys4j^V_xSZ6BEeA6rS-+#0OM8sjRfq^+EY8%eV9I>`~96--i=&20M1{CC{y2rM^qFRcWU$ zW#pdAsoB(!%*6gleVBF7^(IBk@YZ1l&g-)r$I)jPA>Y)+E*2U>|*W~r7z-qUTgh7A?J70Jvu^opn^s`1+ z>4Vg%SyP=#x1Z*|(xBc_2;SsDhgOfW=#L)Dyk9Kh3UIgU2)OqN$z2^v4lzp)m4V1T zSw-_hjMWo{ubn|87WdD8_doj19%i$a@$2QMZDS2>SHznT$Bb;C7`6M&e^Z?-RVw%` z?6F>+ApTuWKZ_UfN2-|-0`;gTgTf_{vT?dx9pU99lTw#&J^AmMTcJP%ch>bXm@@|03;jt0Nk zB>wh#BP_M&Kwl{Qz|cvjuSq0gr%#(lWk%1Q+-71k`QOZ@XkJ!O< zpapCPTNNMXZt+Rd-dXscu}v(YBB~w?NuEB9K)k zZsH!(o+%2_X?t77SsW|B87Iv8I0{2?_LAhaY^I(u{Zje;GTQZbcA}U%aRUT-s5i{~ zEKQE(REjfNB=oJCW|W(B8G4?yyz)Y*>BVr0)>pbmIxdr`PyK7FHAeG!JoCbJ%)h=8 zfBc2E)O_Nz<{o2ChQ%GN+OGnwu(iFjxD=|gx_h&yGg>)jx*Ll90xV%T(GzT~2U6X- z+41sYY=u-Gk7gR8@H$J7YkjxaBSGDj2Q7Ak3vg}3P`04g8;G`~x*dA2;ep+YcFBPY z{~k|~H>JZmnXmKWkh(!yP~i|$7qZzXsNStl=Ai+BN85*pfzc6zNa`LxTlA2l-c;!?yTD!o6=$zL)wc&$PFoWl(!@aj;`}b>3B<+ zweg1jo(c_n`Fohy=vI|b)UC3%x<^$C-`MBoHXi#WKib@r^-(o6_+P&Y{8Z`EuU=jp zdtw+uNii{EENB$$pO*@w#*?vMkd&c=MvDZX+e?C0JTMBv>Iu0!a(8iu@3IG{I%nQA zJ-o;lkv#m+plQXxv&uiM>N<|{+j%nm^#R+UPTRFyBF^BhvpJU|4}wmT)f-1Irxurk zaVMdVpU9YswQze#g;TUTy6}8usJ{q9e-GVgwa46-ip~)cZAGtTZVlbMSZX8D;Db+; z)N)fXzF&>VW9$0a!j_U#Wu3D}SXo2gEVq&yJ+31)vWTL2R8f0q^;4p>NVk*_|I=Ht zv!5>Gf{PnaKl|B{(Wv{n@Q*!_Gh0A0t8 zdq18Dt3aoY{d?%ix+V^uKM3>cc<)QdU3D1Yqjil(Y8SR^y}{3+fd`aNo-OEjQpYFG zD{`^n&*vn4Bpb_?v-eB2ZJ41r8V!0sQtESY$LQ{Nh4&@z6PWw`h~Inh=*U&26)jk7 zmac@s(lh5$Cu5)8sC3e{gOkIdI~C|^g*^M>`xF#&k}f=^V2%ynuV31g=j#-z?0D|H z4C#2xr_mYi!M9<+HFix+HwNp$B;ji&>8TED*qrNw1b>7f=QhkGT5-zs8fZIlOUA$RHbdap>ycX1ipgEKY4Z?G1f`F81F} zVXLvNbv$oZ5O$;Sh_s3sCgg>98&wzERs5h2vsAv{%|uAUwcOV{-O>`ecPlN$u4G$l zr1E5UwoW9%8!@}|b&6i9-h8Htyo5}Hwg5i&Vt{t0k1vq?{n&;*er-j}_}F$|$(gUY zLt*U@LSxhO&0A7y1{77rfy+(B_SzZO2kX7!qIbjznUJ(S7XvHCD+#dAGXNwxU63_t!s8ns$H^1P3k=K2lX%&K_1t+dbK}&9Q5e)L>mG@Fb z+@4KIJmL+rgXLMpM3aq(KQ?}z9jBNpDMj@%+w!P0?aQZznPBjB+l5VsP$|6(Sp(*A z*JYik=?|;c`l`z%@ef;Is9rbf=L8kwO{W*?GUo)}XMULdKTI8h(Ty;|249-`-%bq} z@y`ru)Yv3?N|`b&%PL#;g}OlKldoo6yJKYw|5h@tr$`s;`|Nsf8_c90lv&gWs~LY$8y zbJ{XFPxItB1U8G79jkQ=@3~~<&TA#zGtj6QJGEk`cw7I_K8P~>X~KG}6-D`Z@Yzn? zBSegDK!`+0BhF{ylfezvAJ{w>cROy7eA$3*9tX8P-@3-SgYG8zG<`A6%C4;YSPKb% zf~Tn@6LP$;u(c%^_lj!r6XfxaT&6xqOY|M{^U+_XH%8m<2|z87;G#G7^S7P2SubW) zCS~V%p^kh}*78&j&1-p`p7WIv$6sT3@TJrukdC+K^wjqmKKJwb*2cm@U*%{`vqN6R zPlZPvp;;Mex_apQ=gnQzWO*t?)y49HcNq*b;-hd7CMFYNanVVK-10i5yOXA5ul1E| zCms(hh<>J}`TX6bF^!YfX@J|qVt;XExAOi&98Ph5F^U8?GhQ%CSw-KwJC$n3Y`MoPb3WEcm}IZN%qgsugB@!9^Y4N`amp4to`~J za%(`zU6MEX@zd&#Z=bOmK6$Tt_r4bYx~-iN#H;MF%-mwZO83^P&jTQtE{z+?Rb&qwILqd{eT-2ZARXL!7Bv?`QHYi1TNI zdzPnPIhP+sq92;O;CV~j)o=dI6)#WO@WKs*`I<@lW-Yxcvu)BlUh4gB9^CYenqwtO z#&=mSc(d8aa=N`03bD1M#OHp~{t? zo`sO~6lB!cmFn2>9I%j&kZk5RxCB~zDD_ntHfC}+L+K0{( z{LbKLt)#M%M#w>_aT$e|GD~MBpi#}+(X$us*l5**u#P&KdFC@5t)^&;>olX%l(Lv8 zXmN7mot+^1`CCW*Upac}4EMGxYVTuZgH&j*85uciwB#wh}>zW3E`%DmUf!G5NNZ@p??KVMtlm^+0Sju7KY~k?dQCvNS#~$EB8^ zHt*uSGvy^Ti0T;yuh@Kj?}B*p(Mwy>Y~*S3{fp7ZQ)r*=W*35FjBBRti5X3eMA2)` z-oWgd+k?W^W>azfo;#8Y8a)^6cIp9QaoacL8-sgG1lPkNZmKDMeNMvXlO0Vd=GX&K zYUph0#HFU~^Auawxw}$wi-w#}4*sa}puh5=C*E>*T`|OOUAKwTnAv%m%w>u2Xl(nf zdll|Z8+a$*1oRKyQyhC7 zJpTRRlJim$cwupEN#H`aTR;C-nUp{p;w~0@+ z5TTHA3sYOnMtK<7(CaES=ha&DC|kt z;^%)uUb{w}tbVe>65KN==OP(UH`Tu8p7SIfkGDyAirGc@!AL&u4|Q1VWPg1`z{8ui zpPJKf2;F4s0!L`2RUwmd9<;(!WDmc;SO!mI%sS|xjVBufRqAJOmy+&>#DscfI)9V- zJaIokS=*fZ{cYh&8&LaoM{;396-Zqj@qxEFJ4swH{;p_rf?Inu#QSC5^uPBJ$HZ~h(@ec`s5P&qKL_vM~C z>HCSk-)Kye!fKg+A#v6-F@6nwijhDSe{M%Fo^ACW9|SCVda*wfph&+w@p3uig=O^bS*G)!>PQ!sEId~F;scI@YyxlB8 zqZ^!B?kkmo)28?`{`YurkVv5o$Coa@Jva0j0cXu^#{byC<ZmI8J9RRBZ=8AciOF=5>SHgbQpPv&jM#E^jnj`#G(OwpO=rpd-43dMc;8I7O!bA4pFW4XK(^PXGD=N5Zw*o@Rh%<%LI`prCXGuYxp^lM6p#LZ1&7T>~C}j=eNACuhCOc7E;9jQilvG8cjVoP0)x8~+}(n^1$TFs;PMZg z!xv%td_c9I>RzuHuUrlS5G@i2?1`Z zqThiwla3Eqc5f|__Bo*ox`I_RL?U5pjL&Bz$28RGxnxD*Z*PMX~CG9 zV4>Ya>q?%`ByLnuOLV5ZN^vQTAm*jWSl`yk-59kV6_?D(=!Thuq=VX$=s69Z@7=E} zc1(09fKLiFMg0nKc=Ohy)$8f{D6ir1w$J;kZiUjpw-ufu_6t;6Yhh1XY$=^#F+n2| zQW}g3K=opD{XxL{v{77ROiE_)211r^mDEnLdlK_Ew`zyvS>7$Fher_e(EaT7(eP;4 zDTizyPK4|aK9`qcqM3aU52Fv>S}UIjwQ*(E=v$wOniS)N=I-mRawPO}f!8w(7-g z>bHDdTc@EJ&R-GPU}RO6dmmL+lM}&}{~qu5DCq4+uPEc~h^A2TbP4tkyy*d5 zrT_zcOjiG0j+RugpkiECdpH4HMZ-dkb5)66W;XpA9is{r;FOKXs)Tkfz}ebRn2TJt(( zpJBEyMAy#D*N3HW9T zcLduxN{)VlBYvzKdfM$P1-xc`n>g`*nGT=H9kvEQ6<@`dOU8Df3mnhi5ZIajdtqbo zV_OI=GhFisXg-{vRgWU?_$iWsR#Wx?>f(cYuL+RfI%EDRaE>79REEMlV{xEchGhN> zxKx?hhWyhtaCZPJMSbGO`l{PC_h%)a3u=N;$yu8YGi7W))x1|0JSa)9A+ajDUpuB( z#oJg)>8JsN38!al3kPFu*BAS?WuH95C-9J(U3{6yz$=N&p;!XB8ad}B)MTq!`SS|KNx}KRz3p*6 zm9!2=hINVWcRV-IUb`n9RXR+TT2oicJ&TLJFeKc7(7pkdxMY4lqY-zKVFlc?9GUZa z&mOn%2%zAW+xJ$Mn;I*!DJ*@HNM>9NzG3H%-XbZ12v+Y>q=Psbp&@vY>Ve9PH^H#6 z(p9QL-)TO4q#Bz`aa4f8-DRo5NqI`2;hCS-le0wUmX>K$w4zFe67xA4 z0EqFjeu5x7(e^;`Xn5dI4Cps=j4V3K^JYpI#t-@+42&aa@B7O!5IjZ(_!RRF>1C@W z45OI&CkN0;CRX4>GTs}|9`n)|GGJt^BI57Ta>lODr`dqkv1CAuI8o$h{>;CuGO++R zVp)KxagspII3&>Se5*JXAWgg&-!mKrr2Aw4g;fW`D5L-4?f222(3t+~j0*@6PX-)~ z#{pq+NP+MP&jh3*&?jOEC@-KK>jWa?XIRgF!$^%M1hOWe0!I@leq+Okke^4?|ELmJ zfHsNfFN*j?LLf~dGAL-iL>A!PU!TJK1HJ>k%RuL6eqrbRT@mKrq5f47=Kmube>was zYs_rG=|nPMP7=mnJT2(Id0N1+Tudb9-%apa4BCd8LN}D~0OU?V1Ma6hSK|fh^qZdt;x>UQ z4XjN;c*D#I>`9>nnx!IwG|$|v-#|Uk?J`hRfnDhYK*3ZB;BhK4==?K2>o@A{_xZw9 zWMEwiJg^U>aZP*HJp1{FfAnI6E$vx^08~mNN0NS~u)#3CHwN`R5KHK<^#09adyzMT zEeND#$U^&F56}kb z7fuvVHwzo-cc{MyG7Be=IS20zXxPJKkpcU&o`VIUo1p%noBoRRcQ^SRD;F>~iw!h} zK?o;^zYtEq$b2jmmj9UrKs^s7n*}(SP4uG0(D*l9@b3-{O4=u5XV7l&-(&lCTrXs= zzw`U&=uZt<{u2;r@Avm?GN4b+Zxk2w9~2j;|K(!7Vc`a9=a2)hatJ|jfV!XD9~{?n z+O+=!!pih_B+oQ0kn2B@{Lb!QEzR+}8~hUq@MjJg5UBzj$=t@=@n7BYIX`I7e^cIo zqq*3K|Cu3JS%L1kWax(Ue;AhkbmF^B~T#`^MBhIROh{1PGDIc>N8;u@;A8- zXqSxzG|fW>U0-#}W5N9!TJZ;D`HzPeF5N#EK44n`2Jku$2~-gJI}4KB3mNc#)c^1S zU({c}KdaNevta(Fh`bO8|1R?veh%snhY+}u2ihu-|6GJJp9S?V(4yc!>3Wfa#>gMO z=ZlMi7ky(s3;u5x|6(Wp+tD+A?GHimIaxr#f@en`3f=+f_@IDHh0re(&%f|?Z3Pq{ z!A=1S_P?nk|BVNPLxlwW5$qX<3NnfTv@U$kE1-}CgZiuMn^6gXCb0emcc z4g#@A5a|UU_fNntY7j&4HysZcS@wTx-mD@)pmQ+-h_MIthp`9DNW=h=7e9x=Sx-Xb>IW76cOiO#zfAq7@bj7lO6p&{)|U!>D0wcd zU&0AIDT4%Zlp=ywS`dp51P%O)#Rn2SXZ5;70N7XhJdwSu7k>bI%r7?FOP_6omI?rM z%FzFs>!AMz_Pr<&%bpcPWdgvfG6ay~8KC!v3;2?Nyt3y6)Pn@U<%qw%{Eh1ac>ygs z+~v;_>2glsyGn2%9W)H=KiPjlNJ9NVNWQe};EQ~zoFDjA1o|K4%LxAW&_ZGVpP3dk z3LPu>;Q!rkUJAkdYh*pgb5-#i4|F9bkgyO61Yv{(E>^<)HG@L^p(?&a5>WXpi~|Xu z12?Zi1c{zk)PG2p&*pHeo>lZ!{J^^x1t>*tpOKWncX2qtqL-5`Rh+=UYK#{jpvClW zR^&^11gf9Qf2jV;3tVmXLgjt8)%DVM6Y0|~5*{3B_j?7jzE1oo&I0A+?INS4o5F`SA{>H7?+Ut}^c^NmlC zjs57LP>y+*EcLXuvK@c&*MY(N&>?YROPAAQuaug~pR4Rr8M(W|5Tfc(OV##1Qj&H1 zJ?QRImIf39rc7LMHL@2!p&`weY#m1e1D8mB-z6Y* z8qm<+%@uEbopLLERKsIo`Q_6M%v(33Z<~w{tPgy^Sn+q6TJWUVm2>oCO>=ArV3XD!SebfN^ZYj{i> zm7#%8=t;ZTKslcOz5)K{`2TTu0g(SvjnvhuDlGbFP5gM6_O2n*IZh9J@%W9P`x>kX zRG`EjH@E>20?I0MJS2kJl#d+ci7n;nl>G@4A4EA)X?5<8H3U1J6zf{kCx_ab)UiYA zYk>Uq()>v$t}6wfd=sYkk47dO%r%SqR{#{Q0O$xLQz%@2h_&UeyUw@ap*CyVK}n(? zVStL+zZA3R`ban4)+;ZOKMmDkF1Z@r3(@D}}3fV}{9gr+GE(7gY}P{Qtf^ zwQjrxq5Kb<>k(=VPR=& z&(7EaMRaCwY(&7G*m-!Tpsd>w9v_uI&n{bG#(ppK$3IYAszHC(@NPyxSqL^!76VY} zC{!#!GN=ssQ39Afj^B}eD_@p!Tl3>>{YRd+5Pc@S4BRzgm9h_vBxm` z`;;;k)1+uBT?#MADt=IN{ zq>V%0!f;k<$Yr%WSt*V1J`-&IYM?grD9hM%eM~DEd(QHi_{+sHbn`1Z4qB9?L5@N* zjA8&q!!_O zhE13neLGGSlKu6KC=$Un+X`l+i{kfXn zpOZr&xC$~;&NY~skZtTCw;lsW>x-z>xSt|=_I+bCh?~?Obj;i$u_taA(0&yG^eEtq zQUs~mshyJ6Y5)SnOKu%jTKhfv2L0M+9gG!HC2dw`6k-ox4YygQNSFeR<;e0O#_+;d zV$Q{^c|M3oT(mZ-(U$Ysy~EHjR}w8c)fz@bPuP2(B&^4LwPYCQsk03%?d^cMIa4 z_BgSNrG`_09+c%xiuUa$W>0?{XADnWzaTr|W5O?G|C$s_UDuB0z)K5DIfd6AR|qgf zhM~k7SWF4cnVlaHtI*gj)vx1l6Lx=QM`s7tfw6@IQ|UiNOv2|B78Iz&0AT1{hTVM0 zXS1wu za8cHKmw1(S({r+VuqbP}1uzvzV4?Uls0umq#Fe-)KG$nn9S@Tz@6nWO5_UsaeuI9t z`YCp)NP?2l;B{fs46@u~Cm^FzlPDY}TfyXgWe<0LQ4Aa<)we?u6FT$a6Crwp^j}S| zlv&1%1oKp)PI%GVR8rf*`QkmC1}T|t{AI6E%2ZP8zZKC7QBG3jLj%4^aJ(@mf&1K; zFRKX)CeO?v#i=51P_EDd9Xq;Jfu5kyUtscO2fx0wWj14qQL~(=Req^S{#*iRQvGoyiZ&bBv9_#F$FGR1(eDf+@acO&F7@=|dY^KxIklmV9NjlzFU1ER$=yx-BE*%9tDt{LLxqB|UGLVOiXRr%%W6 zGDaz*#^pkL6am)xktUX}OFH6`*9d=6PSeGSpf`7mLH@k2IvW7-aTe`eZ4FNPK{*Ac z>15|Dh@-^K>oRqad|)I~Y|woY{`Fi&^t8#)kZTBO#AJH9d3LF#(I!wal_}*cFbtx} z)cuWfgR$f*L~1fDhrh7~GkqT`ipqzoO_M8H|2qq*-YNzNG1 zC?hA3ln!l(-UN zO7_56wj$2pxTXsx(ob42DRvo>Uy?eg43?ZN74RB`s3PK)b_AYWk8BzNG-la z(V;riEtoQ*Adl+xY=32KQyU%35MyHUEnCJ?8>{{2X><6-HwzwLcgGJd&ByW8G>Yd6 z3r-NZ?Hd*Wa)=JRFl>fnl60YqjC|Rva81aRpJ@wXgsp`bDi5oBdU&{2nA#gohWtk4 z`cS*&;?G_MI&~t`d1&v(pYH)6Ad-9P#J3r?%RgU4yC8e(66h|ByNF`U=1}826t@Rj zKu;sOU>M#79-we+7J}GBEJJ&`MzZcIwYux(7Gg9- zjfMJ8Q9aF1EF7lhOeb`krHxkLCxHD2#8RKP#{ehkVYLr1ZB=(&q!I#Kw9D6L@p+~*x z8EOJX^(Z{qnHIfOg#}s;gkNUI!6_x&P#t`yk&_E(e6{)clkFQ;F8&k3L%(MFC}{7s zM0(t)zij+kZJfl1uu+eU=M&Kyj50+i82hLR4lp0Yl}Ah@SD($mhE8kg*fN6vEVq>5 zW(;NbqRW}p4s;<;fuLQg3<#3L`{fx%3XjnTPEX~JXVvw2QfCbxi`0w=)5qk? z{v3vD*AEbl5RHg9;&hzpj^WkCH8N5C^ode72+I`5VqWX!5*JMJlFBrxPJ4LWQrIJi z5WwKZcHSvNKaW3K1+By!T@44&yXRWXvC&M_;0$d>EiF`^Np zNVUwrG^;o-T0)+Y>6jCOoynHgW{GOTAVV7|%)72FK#{6hvI#D10o`S}ETvVM90L>%0VL8*C^~NoVvfkei0R@;Q-Z@m*@agGWp;rh zArW;wxYwbmVwQK)E>}JDb?1r!(tV0|UFQel_-~->;?7f0C;SegJ+s0~L6(T5hw-+#`3nyMN197^xE)^ckhg%4}4?Wne&pw*}Cqjj_Xi z3}_r6F?a0Nj&15^xeyvr1AA*o==%0xa&Qqv@weL z;!HB>0@6fjj~F5l+3yfi5PbDvHWZ&c@-LX^ND#hUGZc9i#|mA+;hdvskLR1Z#7pFW z`+s{2K0z9On~T)%S!~MmgvJDj@r5RjD?!);O4ZFyFvfS!OWK4?IkU?7Qjp`aNGkD$ zOFWHVu9Of+&Q*H4TTEw%Q#=%bQ1-q1>+Ox*K6g(9pU+_*X-;c8Ro~n3RHx2;<-b$% zc-`vp_~h%nP2ZwTdX&9{!hcRG#shYhRhXcHv|Bx6*RTXj>KaXkA9+bFM5awhB=*zt zjW%Ue2^8y!V4Bxe)+BRAa9HY)(1khgC-F zsnF)HY)m)Xs6>%fR(WG~ucs9!Kk@xK7>C%O3P%?0EwYO!(KYnia$!(Vh%S*>u#mww zsujwhkSDBP@tv;l#Af&DLSf8XV({wDNviyfu%TPtOKw*S9>cs!PA0h?xs444pqD!r zpaaAmt)d7GdPnjF9v46P&bJDt zq;HQ}A9HPwKkolREW-;O>Bw3mLA~sxzao2I`+C1NSB!!j37sTCA;c*!e;jDoUIF1H zD`CbKC5XvO&eD)HV~Z`&7#OHaw`BI<2Y?lT-0*2a!sR?~miBU&>$+tYu3DCfhzMar zL?FGA84r1F;_c$ zdW+zN4Znz?HYv!**bKsdQnvpPPBY_N>??@Q_zg=_I`QkpeOpRg%w4a_yw^v{id5YI zIU`;OeZk4D}p$=sANMI#;gi>8lS!x%*#h$Tw-Q&k2KS;D-g zKXGix5*3FoKy{46r-*YK5|hmsdso1*%G$)JQ+2U^=r64X_(}%-sCGsCxK;s?RS{*@ znUjsr82U(dkbe^+1c7bz?f?09&FLd?y0GF*UOxO7lKh%%LzDp7=L>Q$2`X%nB@)zLUL%x* z{nfp(;VeIZxGAD->6=o*eRC18Rb9bT0&NMGHE|t^hdv?{v2G2I_fq_+wg*BuI5-7Q z$Wxv3Cn_h!dfTlJeOGc%Jg!77^!m_iqGzz;=_hcmJ{XyL30SZCKFpd6}2GZqmSQI5_S0ScdjWDXBoLyLeE-TUUwUD)tisDaUEJF3*r_pDT z1^fnxojyTrLFNUd1sZ_}2yF<*+|k?%&W?_7c45w*Bd2ACvas72r8R1!2I8T(^dIRx zs^QFUbOuuBTP<&r!dUvLvi|+{XgeA_lab`_EoX>p{{{WrC|aTW35>v@VFjQ(FE!R* z9b;Sgx>&5*J#R8hg}V5s@qL8;6aX4=;Kj^!TF+GfluvOU63h|&q;giBj0TFSaMSIz zxkv5CMrwXuk4B5P)p-aD;^4P|{@0LSQG5_2gW;i|p-&K@RSuX^I1{dQJ8Doe9aW=I zeH=;NviXW3v6W~DWlc!{0`m$Tci4UsH&^tGPu zi6^YLx218Ydwbpk>MeYM_z`|mLB3|+!;*?jVQ0nZBIqa1ml9??T5@U&hex{V z;eU-)Z^jKKPfR2SIyoI&8}ZY9sa?faD@w!b@tnc9e0{#^C0?PyC0lS4NP6V$&69%B zMZj&pU>-Q=Wcr0bW2<_9%+-pWfM&-vvGb{9Hw4I$iXvtP_=(~9sVM_z7S6h}Co$m&t0U7IrB!57_4;BXA*$2G8do^c z#YR|@y>|_|0B9olI&T$?x|yf2Tb#U&)b`z_6`BZLPSbK9;Zpr+#zSlXRpU)Sn>y@G z75Cj4EC+^-=O9-EckI_H1X%xD5o0U*Did9S{Z2*mdpacmSF`yTB<-{nGHQmXUTYF% z!HnwBby4(YS6ja9FIrB_qHg4x^d?w)e@uleZ8RDSp>3Xhd0hxFQ&jybQRcZ0_?l2a`>d6p0lSgw2*9LD%~id+vkP(?LUg9Pu8T$@`wgfqvZuqpcky`0uMRdw;W&*{BR<|Hmp zJOo4ns5%s@$g4Der~}>uoTh@LhjMVu5gmHzGK7(B2bG(Y zVQjOi?FCqiYBoa;t*tT*z#A(>A5v3v%MjtY=!Iu%sx50zv-bPlsCRd%&sF3YsZ1mG zy-g$fU92C=N-8RjM0)$_8HOLq>eS+!NoXxaHB_e5uVCj}@=G2~=E1MFFN|9EK*u+raB}{%l2P<`5cv+C53*Q=6|bFcwDlNHtqio0%=N zeeXqM;^m|HxbT&aW4rrNc4s zqmLxHE_mG8A$(P$BTc>3Xw%l1u-DsNP1aw#T?^TNWR4AY>}(@FHMKW$Fd7YZ9M%$M4fc&u%o(rqlbi`_%8#X-%e`r~I_!cG&gp5>E~B(?-Qn&4 zemK({_h>$3b5ZH34H=zxE$kSEQ!}0;sKLDJ1$xK1dj2+dXD$b(aq3H3LvCS1)QowY zHcLyf+TMwa`slax;Au^zx@9ERE%uW-=Gt;2lJ@37uLY^xRg~4K+)O8gT;)wP($vn&3iYn-qY%NugxgYs)mf8 z@CyG@-*K7U4r$)4?ycd9X;HLSgEj5m7wO9nQ8MA5%=yUxRl$b&KIL%yy=f_is{Lfd z?RwA$`WbZ%Kd4Sb@N6PK519~FXmJ3~)2JRe7X}u-RAU(Y%qWk&VJ~meqLX9}1PED6 z!8qh?Qlo@>VJ3_dPi=j38xpM<5$hwQ&VNddQW@IyOf~QZ$NHJk%9dC0&USoDa>7Ks z#oOJ({eyYm$+^o`Il-hQa`e8+Sl@Zzh&?EQ?Wh=iwr!6fpv{)7d$3an3yc{*1P+=ewNPEF-F9@R80M^&_%lp)2ST`_{m zp5>h2#Z~8t!ulS(Ek>20P;R9E9K!ksbA(XY|? z**lx3Mi?aAW`vjkI72g88|55jm<~eh@CX9j@Q6yBQT}xlilk3^R7EL10Z6W3V(peE z5c3_Em0(s8K8?HQcUK~T{(TB`$zD})i$Q64qD2C8a%W@Cd{OF#5%hqKAWwz0DgW0! z`s=auxauhzIg}+?@VKRwtn5`s9YqIPp%E&Cg3be;A8j)VF5;}vNO7vH_m4sv&_{W# zq-wetzsR||Jx<;mubYOM13B<*+1`Z7Af z@>&482uP6vXx}5+1!EQ?9e`lL!`Pf{U?3 zmEauiZmt9?iqE8M@$esnko{2vI~@2@2i3fy_8ERr;YMceB(wv>@FqhMEs5Xc6uGR$ z;`%rUV0+jvY8K_dZ_m$K@L+M;wPcJd@Z9fY%-15~2Q+*#F-jv9P~3rs00u8MxuNpF z?2P5|T4CNHrv`FHGMFSHXoSWY{16STsmD~4>UVZ4`i#C&z5%bS1o6n^&Knl^LwKfH zhprTHt!h8CtKt^$?$p}RgGi2QQBHdB^#BVbN0jW>!ttM;HIG~lLM&Fw4Dj^6K1^#^ z6Gujs=_J!y%EFk5fc84zdsaAzDQKH?LPAc&(JYEZVP#Luakn5c0D)$>f6m=Orm|IRb>q7J6 zG2HDg8cNzKvOxrck$N|PvqHYCbI?{G$}afmYP#fExKv<$?=kDxm6a6GAV<1$aAu&O z*;!Hd3NVo(_S#uQX7~1EAuFqD)~nn59my42Hs9rJv$>DD0Pndmhv`zCdbe1$9%%8$ zMY5zxfZEL@N3gJR6cG*cf^wyo<=I^dhvUk<(H%#7C6k0GB@j^6awVa?2k0hw|90nHWDjPrcz6x z01`1`R0Z}<9a;n4Nh@=8M9J6(^A2|3N{?64oRf|*h^<8pMu93o+&h?cW`?xNuwPSYq2E# zX-^+O17xwumhSjglI8UU+^un_x=SJ`PZjK!N}-}`=goGj$mzBeprE}Tm>8ndfX^y0 zJYdSkNg`lu&)`s|lg}ovnYFzMyKXXcvzN)nu0vQHohv5aXe(VE?LRjDbq7^32rvZk zErJ5~!xJqBQskiZE7QH86lfy@sZa{NUy}Ta)h(vxbCr$ro+!14Y|b59L%1AP!x|&& zQjK#OW<3^P7Mq<4Yc8jX8x?kf;M^-2nZsL%xmq9&9XOAcjdi6#}~*k$H2*i`9~5wjvo@vKlHpQohITX69!lXR#kQ*E|th{)mT0@ zI;nh8;@ns9*ZE@KsQ%TtG2k-{-%4igQEfzS#0NJZK9Go)a)(?_+;!MdGjm?VHDLUG->3+{Gn;*2Qs4;6 z*K0~tTvrop7P|;XEQi&}VkjlX${oVBoK!l)f>;)e9wME4kPvK?_TX(Q=ev62E0fM& z0Rwk@%U2wjYUYF>vJ#fG1%-FxlEb=Jmb<(%#N|1mXNB7J&)l%vv2%(lx2^kcEf0}T zOjWZU61sE2>N;WhIh>vVeYT$aLY*Myo>3x^IwU2S)YaUB^#hj3r4t?Wv)zqu&Zc&% zaRDATY(OKOvQYS@Y*OJNzLH6A8EP4k>;Xr*o#d1J6Nit-mgs8vk7XJj30w4-It-87 zn;Tjy@C>twQJ~`zj5CYt4s?90a3pV;-sxw4L<;}2{Ucp+9IjZvNy#sMnQ=26c{o@w zaeI{f@Qy%)8S==rU}i0}*kGKN2#CfQ=&Ce^_}W6d$9rLmYw z-NS0$2+GUj!bctTU35G>w`ywyK!cHoG5Seo%yy><5UD_e(ta!7a(!>Dfc%Zqmuz6Y z@lE|8n|H>nqv{L*j?1dvX>23JuANL9cs zBp>qD>06cE!_7kJ^j5*oqeSPj^1*P~HtSulJ^G6l>C~0?(_-oAPWDdrD&t`R>j~7H zt#om$Yf{=o2{k4r=hH=5=5yL_*hKc?x}Vx0#YDDsguizJLJYf6o6II9lutI^n|Jpu zRO@c1>b8Dkb!gM-(wZT5B|K`QZ1<zzvs8bB463Ze7ey})+{{7ulLT6 ztj^-=hnxq3Pe1LafK@pU;6r+;XgLluUT3E`KdHvF26V}oY>bI+>LcRV6w_#bZ8G+- zUk~EFRz0;x0BjeARiR72$6OjGbV)E4*4At@LV>of`hmeW&>sG7ecmGpIfH#z?WU{0 z>O1wW7kMFDrh-_h7B+rNEQT?woR$X;PBf!IOQr~oj{IiTUbp{MK5h-1+Kj15tYfXC z?&w)M6b=RsYocN!jHCYYDMmYSnY{0aq}!=(Vu)gh6<|mbO`uoFwCH-KyV7HIGFg1g zC6kGh+=HFJ1Jn7uR8dOZ@#=C0%$7PDNx;O(nXLqxtH|jjXk51nFw7&xD}4zYuKYw- zpQlP}7*SvIeGT-mwhkKl3xGlcc842B?S`M3rVXL}W%NaJVo2Dw?q+a2Sk$LoUVa@2 zt>uAYW59y-H``+4wxbp^RTaG(NK5tLgkD3I_)g&4D48Yl@m^&VX%iI01)$if)UlAe zA;oN{SvecFrt3E%D^?)c>M28lFo`7I5i4IW6bsn=Rp(D47W^@=^}2ACDCH#IY3dnM zj?}DjV_25A((c(vawhtrR93jb%DGbX{AGi?9sr^kY*)D-py!hxu~}{VJgnO&1Uw*iGss^@1IuhN_i!CYM zKAy~t)S8|a9$qbE(*o8eW;*aSLtW*Aq2jyF-7JGgeE9rEt{aA|^T3WIU%74Aa_bV^ zPXm@5$zF{x0=-?m!I694y??jsd&1}6B=WBMeSkozMuvvZw&NrXpJ@ThX_G>A`&bgRQ@RBoT!Vi&_+?@8%@@v*`wltxe5~a;y;uFFk1w;Zckm!xd|QZ(m4*91w}ryFp&d0pIv+ojcEzfyCt=QNv{buB zVtPrRkx+l7x2!ax=5TK6s!4X0Z6f0!hTZaqnMKv#zff~QcG>QO;B}I%C z&;7$_PFOSD3VZ8aV1iFB|EbII-K}%99l{}?<*E3prLpzO7~qdAoUrpMQ^DcK^j6;O z$vG6dQM(zSsBlieYvPVsm<#G5vY0j4O(AOsOV|nq$oC(p1p$Jnbg`?c?*tH9^ zL*whW9c2HrDxhJo^_Nqxk@kh8SHqH6-|*VFGX{XOZ;+tNq*D0QN-Ix<0lQ+d z@|a78NP^4J76mDAP5GlgFV?N^{X0uDc)wBbYnYWbWvS8HS6UEUh$md{0R0Q*uT2p@ z;}X4IfrJ8^31GK*?J1mA1c)0&p342H1mhIS#3}O*i}YbOx*C?+V`gd!`oV_fOUpJf zUtWJ|g}4^rhYPf4EtEA20p^q}v{&PYMn#KKCSAl)hLc#@i5g`$a1DLM*Q2kbTn$@5 z4<<_IK;dmGLXOGeIYDEb3%aNB&-~HnWQJsvDttF8TUgj6Iz&{7%HE!+a&iI{lEL6D z`^K8mQbq9b@eCjF;W6(mmsG6bkNuIc^Bw*c&o2yy0PM>(Ax~IuXh4Wyj!bkY&znuW zUktyFC#D_Gr~^>)ws%A>u&Lz7N>4XkE{tz0dTC(JH_LX8Ec-<~xgj@U?aR4{mKeQ- z?`z&un}357;U=n={-kr}kuQbw?I=!w?tzM)zL;+)&6(+NscN$d5lGITG<~gFxV&Z_ z1dg*w1Te}}*RWvY-AgXgE>@H(BXgmcR#el_fGU$AMtD%swP2uTj@yGi^1J5q{@N2G zto51!?6YZfN59~kA7owjZ-YM47cMJWPk;`Cpn}>hN6-G zr6p^45KA(tnpd0YR)1N-Tq(bX*u(TIOy$?0b!Go(ywa{Oi2OX;!RWSir(m)z9T~la=ZcasUiI3UFNdf119oh z-?0XO6j_Oh02`M4(I-SEqSEqy=K}PoVI|#n!y+>z)pc|X;Q=uXY>MzYb7+Y2g3%AI z&UEL&$*rl~_*bdL0!0?3*Rvx9yfJ~VuGntjTEkNOMdCWrdBSN0Lwod-Ysnj+jbGX3 zs}!NpQE74#P}oNZ%1HGYU>vu(@h_-OoWW!O_8>IP^Ot?YEKY2FrV?XPS0&dqpV)271!AAwC254oVnegWe|2WX5>zmbF6P@c&3f;tPC7C5_PCi}e^E9+Qg`7Qs9__1U z+YpHJ+6Js6HL`L}H3AB)RKUW<$;7gGz%&*j$J{=4PF}WwCfiJskmZp*BDW-*&{6K- zL}?^kJ`xKT9Kv9~I(imMxu+*nIx=4$z2W)w2H90NBwD!WPm))EgIUwg0`%Jr9A znjXYRHMB~o8=EsIhUfe`F^$L$dYC4y-)6W{u`@urxiF_n2iNR4$n9QWR*ez&(+0Y& zO-V%jP~>fF2}w1r+WuaCm!N{jo`rhjq7mmOml|$7Tv^dbh#F&lTpVIwHX=nSxUu|G zqxJP*{SbegG;LTq8zy$amd1u4+pT=+(hM<_lrQl$AEAac9i)HOxum?vP1_JNU1)V%=G=pgdtY&tpbBpq2X-p_!tDnU&Qk zl+%t(fm4rT&mi|SVT{{w&;Y*g3&CRf`Ita83)x8HevOFB_J;Ge5vB2aWpLMzJpEw9 z8@>@tzKE=!p5y}~#M7DtAAT%7%!^EXx?c(~O+Dmtn?DRxS$bWv!tow3_Bln!4!)q8 zC5&*@+edq0p9_xa2}3tHuSiy2omN*DdY_@E-o<|qSSyCA@`mZ;@@oD5(ff#`dayav znpO^PGxf`)ooa_JR3UMX`VV163EN6a`88bmlrs|rCv_d$ss1GOCJfBC1f6fJCxr!_ zg;fNmL`{J82G|uW3E;GV$P{8r7P}J`B=%2tL!6_Wcn28LqP33rD8c0KLgsx5AxykS zt2S0NPC~o1n@wz>FD$@3K7MHRW8Jj~J$19@7x`vaxRd0<<$U?;(2>i<<_Hnu4x(Lu zcEymjGQt|$)6w~;yzM%HRQ#CRWg9#K;7zk2&~c4g`ykc z*4>ErrtLda% zZPRL>tuwAh+c|DU4XdV-B4)(}E87{ZMlz*M=S>WH>|%=IOqw-(yvg2q2XtpfCG!v4 z(-6%a<7K6?C+yU#faKTG%x9A>OjiimrPuxXZ|&=xEg(KDx#P8a**higX+MB-OMm<< z`YScy2WboJtiRtiqi}3BZp47oF9njock9o!&h~V_0E)cHR3SM>^Fkjf;+hRYO=F{+&GK4r^ zNUZ-y#+&?Kji#^4?Y^4>#iB44!ptLSjwBb#Oig>YVQZ@)jV5^rop!m4l?qF_y$_~P zGj^@B#+8E052?(_@0W?R_4nXc8(%Ni-%0GlNA7(umpC?o;Pq&rd5(+4o50)rusY$}dssz+H(@d`I4!yg4p z^+Z$RG&kwkVhKHAZs0J_qH&+rgQft&&r#FCQuWJ0ARy2^P9x%o;oODgroWB_QT*Xl z*4mT9UlwOolS^<{vc$3~%NJGW@fT2j>XJjHW`j27Xsw}p)A&A?b6_0rr*Uqz z>O;Ix*A%1Aa$$M{1%*cxok{Nq2hr)_=M@1yM)VEHXFW-P)Vh zsU>4C@BcqzJRg4PQjT?9o9#`0urYg>s+DS_0`7#snX9XIpVaP}j zQov)!P83qsq{+Zf8~fHD*f20{oSkGZJa9D(CvpHPZ2gBHH7V)>?Z`Hgur^v&nt`p9 zTE1`@4O_}GTjIT6q2y0?%e z!=I6!L)nic0piI+|=Ifw}-8texssyox&!$%C5RkB#P;58~gvYbuCaiZClt%N`I=G zgsT|kk!RO_tiAWY(}NB<5^@ryx~M2`qErl9=pOIaFWV`P$RqqW)TJDfbaBef<4_)l z(m6PXb{m+Lk##F`PQ<4A?>5jZk)U0-2k(bA^d3h`HwR>(q@ZF<5dP%yTv?nV$KJLX-t(EcHKbHOLTdT;ORV6M@ zAEH$Uttzh;ho=^O9Pi{9ddhk2yT_HB)5Iqyvtol61pmJ5aChGRN_q9wwAa7673Ds1 zIdG(MXk){``1z5SN1Z=AXW{zZ&VUCSJs%! za69SsKQC#g*`2t3W#^7RJ2xdavFMRw;x_MHqf@F~*Ob@)(0}on+i$$f%cu98_MiRl zC;nKPnwKzi>+vwL{@}=uC3KfdAKc*Zq+m(X1AgB$gP3!eXg_fz4wnF7d^Asky^RW%%Y60TACQ(kU9HR!Hwj? zfd^7vjqZGPw|}B9bd6s=RPy_B_pJGyupXiJ{l}&MaOC4O*V^=wr5B7=KE51b`Qb&? zg!oQ(_x^YI5v-LB{IR>~5bC9er|Xtuzqvf}9~exJd+>L$A~K+|;*$Tpo)ZSXI+#6b zLFilTG)XhnboHO|srx|=wT7ODVon?@OgYDMGnaiSxKV!F>EFe7(#w772Cb5Cm%;^s zBPLaUU%7qO_Jhu1O|?x(*qvXUN5nKlR!LcB{}E`{dzZ$dveYX z$P!)-Uh!SEPeCWS#-Yl<^-hD45dA@_xY#Mv&HbJAO{Za2O^F9WR3j(ZI_8@uP12n6 z>K8o6DdXPsf~?*NzQ-N+{#c=Px5>ld-1JGy&-ea)i;H>o)U)?u0^^qq_L+HX==^Z^ zu2o|iUdn3A54lYqiHkz&Vr{xV?NQ)SzmYea8aXX|tM{N--|(&XecnuQ4_L3Qvwyfn zdVLSh&{1O=4~^D@TUOZT6erKDb9k8de1Um^;nTRA$-Ux!Rt-MfZ}G<6eZ5zug*bl5 zrc-aND_#=4bVEYlb=h5$#|I5TwM)~7sT%w{rN zlgw6|J&H1`sjW=OnYY;DZkfTd$*(`nsMHz{leUK276;vZkhIY^%B$24SN< z|8wM(?cR+!PRSa#^=T!ynv5Er&zekMU$*d0Tw=6mwSDQ6`Kdir9`kmoQdDEFTp1ai#Ail>4UNN6pzXhm8Hz83vl5PoCx>b17Fl zXNux^-A_i!Cl>^zj>>9EyS5Zkadp)c*VxHZ%#f-4H&fI*!?Z3}HzK!|(KLM)5HDXd zL?fZ)x%`JAveJ}%?xymZyCiI7I5bJcngi8e4Agwa_WB&dZlHt`n{_d~e8dC=X;y#f zrg>Lmm+%028LKg42L)5)bt=?H9*s~x1Nbl-q5hg{wU!AdP_GUMav?%{j744H5Ru9Z zG(e3A(eefa@3J?2wv-PUB6~#XU{Q!^MkOyYMBPl=U@3~Oi^}A>{QLaP#nf^SAChl=w5qQ$an#Y#VBOZ zF;^*5Q#{o5&>yE}_-4JbnFTD6l4%QMB@sx}YJor^Qo5=s`gaqdlP)1+b+vdD?)D_v$UG3v&iV~DcXo{hgprI5~%X0PRLJcsz`$-f9ZGUyI z+$)p_A}JGz{h;AeS_UKn)OyjsAG9kb?gs|M5;2e$m77V^(2H3)4q71-D`v|%8MRdTMEKDGqed?*^e>lPLP^e!mOAlqCUoIme?jNs@oN}r63H4GNll640%Hi z45kFgk*5L-rvhTd+*iD*Yygej^+Pq!KzvlnSgflRt{2jIi4|C70O5h^#AJ*K zkAMXe?B{ugQ(BPcMItOix@zXzB!JUyejc7E2{3Ayu0#zF2E;fKLXAAs7TFrWlh$}! QG(-gyR1F$5ZiGXR3a1QBomR~YXSmxcfi7ZgUpz!+CNhD%xrxa62p;HMM; z4IvaJ2!()<2+TJ;Vc-Mx4JZgI2!kUaf9AoAax&vxQifkjf^o+eyL^%&!Gb6x0tLTR zqbUHxi~BDS3IgFPP(1?1E2*J?HlQ%DFeZ*b5gUeKOQR-*LImM(Fc=QK!p`Bng?Fi2 z7zRWPjDZDVNEjG$xm>2099|}jA>nlZPZN)d5Qc(ZvIfIEA`}8XQIJp*fRTbo6rk!s z!aKm1Tmou3h_E0O1Qv$t zs1qw;gDz)fgb5=BLH}ZxmD|nzfvwjS4hln2K+OPy3W5L};VX_=x!oT)*m_B;bOg-j zD{8cazz5KkK~s~mV55M=W@r4%jg76HqnoXOowu9y14s8OZ$Vu$zyk)B1Pns`%h|4Y z{|oKnXys|?d8H2|3NQ~ErhoYV55^qb9Ir$~UXtSiBY@?AAwj6WZgNG=#nJ15fQ040 zbbBQ^6b=%EfKe#GG~be5DT5t~0zM%TFa-QR=zF+3x;^-_q$tp(i4lQ8f>1c}Qe}cS zm@jGZB4B`PBf%iy|6G8-hyoH`4?G>+?5~yqf~g{;Aq4PYU>FFAalXLep_uWsDB=5L? z1KNMV{bL~zK*4kz!Z0Wp@t^Dd4>>n)7ni>b06xqOf(Rmop+J=RznT)b1Qh`N1qPg& z2n56FyQllL&BBxe@F>P{3ZQ&aR8d!2w){3a2Qhf zKP3AL{olYqaNvRo1JEca81kPM13-IQKlqpHT?H><7z_wrVC1DM4+2VnTv`$-phYMc z4gy_mG?;gH=`SN8;QE)55Qr;q5csbXVg&EfU@XXS0X$$@P81T@Igl{Ke;WDUS^x3S ztN2I+LkdEHbr%-Kw2(9YiJ9y`%!DA}fI0kIKyw#&OB-_!%LfjZin#J5A^;BvhENm| zBS7JN71D>&Z(y1!m@bvd0f7qx77y%Q|FGcc?qmxHeQBvzcJe2lGaw*>AP@?I_#6H_ zErD(Bue$;}6EhIeK`<~1^4D)XZS8D5fj#ZYZ~+RMc+`wQlz|CDAi{rF&lBL()zagV z&p&%o1Emzk_a?=kNJs#%g#tVqQ+PA-PcUPIpadZZIIti85%+<=2e4sYS?8skG)yRA zL1AIIFzD~NucModyYHU>|7VW@bclihwp&6KhmEQcq26aeBj7M%2?=6A<+hft#C{pA zM!n_Vpj2~H`rimV0+~4<%U*x%Kr^yKF2F`JF=5)8OZzr-VRdHL1EXx>)6~J&sxO3i zQZbwvcL%O{9Q5wXv!obmn%B%H-aiQXd zO#`|*S%x_hdFA8Qp{YHRqiK#1I`79y3=}9eo5l|G9=76Va{1YF4z->BWnMdEuLAvT z*{52N2Nz|6gTlFY-qkY~J&)FSRiFJ-;DcQs($RT0>5j zkbW;Kl1^7Lql$@@&$vv=;W=`E2ogkDsV~N;hwBJ`oMVa3_Z#oTG_7`Z^DPGTB?N>Sr8>Bs{oQ zkJs2v0y8GQAUeH?cMI_?C_g&_>@|iyDc-XUX>m-@YYbI-{{l}if$VK~(DtGlE*A;T zqIYA8;x}vc6N*rdxX0JOmXetP3>Q1FC`^7KB@ld1y{JHhA$JYE^E3$SwNLPwL0BJp z)&726a4Gb}jQaQEcxK4Z{+$G}yAl2-+x(tndpIMdaxFx?FJ&67PL@V;3MJ-C{rB01 z5uEp8;J1`w5l~&zoZ}vhRK; z@mlQji5bT_k2T2wjvs%0NapVL&V?lzt&*yu*^<#25F zMTron)m%h^yUbjdLsvmK*S(WeGIDhA`PM07LDl4T)EUzgHXq5df@L^er2JXw1U~zG zEoNkNB2QQ?%Fi4#<{jh1a&C58485PR>VDCd6224VLjA*GDQ1v;GGRkwX1$ikOPxkE z^9{Y(Gc~&;KIwz_7jyP0>}$SBuyQ=R>QN6C(1SZh7?_}A=l_C_cGgJh7qCQ)!Rsk;ps>$54W5CQ7+e@ z!EKWYqIciwHOSZe7KkDzEFe9L-picJaLGI<PSSlIISu z6em6M3W`HFqu*<`aaVyk!5uB=Z2F4^TWAt#b2AFLu=>hVE;ybo8Z$6viK>TpFTE&y zD5 z>{!a|S)-@jYfG?5|4^OKw{E;q+&tAJrS;vDuBo@%Zi74WH_YxL*Gw;FP7-QeSi zGUO4j>9ymolR?#Wi8WCcq7UTw+nL#Zj4Bsdn%tHcVXQy6-RoTA_d#;W-U3^WiL9h- zH|E{~8_g^XqW>CES!k|2#ntW+JkwQA6>F4c82Wwu!%Q}nJ(c)fVta9FK4kj6AuSxayx5% zs(kIr6j^>RqPL&nz2k+>LUb(Os6Ws_IMyz{^Z#iJ*OFdyc1KAf?vRirB zv^8UJCG2Z(I7Ud{0^@^JxJ>b&DBv^;#bj7BW5{{&F*%a>m`&u$WeS1-l4Tei^BKj7 z`67;oiBllJ5Q!KOL4h0=4kX}UjEl(S2q`8-M2{SNd7!#Hk-&i?6p%P#&@vntepx~c ztEfH^aGHXkgn^_86C!$rLikT|jHwg-%mkcofP)c`nX>}NOF`g7Bn(gi4zq$tAkU;= zp}Au0i#Q2pSWJ=W&*#e&7C2`Ez`%JH#R`X^1W{lR=8+8B<)pZmSv1B%ToFSnu7^1n z7sb33*TE!8h+&WtB=|rI1Os%SEO8rD);~P9bj=THpI+gg!nUU*F=V zGnY8`3fT9clzXYK@*F*Yyi;q=oORE4dm-rf>t@5#oq=A?t*-&U&S9%#o^E0-gTE$s zYeE`uo`-IGm^vRbPdcwdOdvmhKU@ClI>B9F^tgV&01y98raSudq*Gl|u!F{ympHk^ z!fU8Q@T6I0N~g_k%Jm}z}2#-3vGlm{^#cbaUBER$n&<06z(Q-5;B_h?cD z9pbX1o9x`JXvVgw#$Gav9yFUTC-s^WM(4HkjiLB%Z%jE@5!#$muQLrIUR|p>J&EXl zSCb)++t>b;Crh>6W+F{zW=v7xj_*bso^Oo3lVpYREB?G)bgjbcXnLfz@v?|M!g@tH zx$@O|!2Nz*Q#tvbgrfHao+~x;l$1L2^*hP7@AfPmRaA-dN09v;ZbPY*3~^ENAMT}d zrvzl9P$Hp6|2h)Z@@CyKlU$Q4ksI zvcY-q2t{`P>(fWc1G7|`pYh$AqE!Ysgj7`d2m%!EAP1Ja?l#zzg?yvxudnu`=g-u7 z_rZeWGj~sI`16u72B!7IXqjj$Jz8rQRqp|jat_UfY};LD1?RN@YK@!nqB#9Rgs%e> z@KgeZ8wur~pkD~!;qiP3vT)?-cy>)_A``ctKawi^QC%Tyv=Ab++`b8;DwUllycyg! z7=|q4%(1*iYGvxQjCWsjINU7ZQP-Tbx{bnpTJLwGQ+5S<6m9am@Qpewzl?sFqR&>X zde`c&eF@7lB7;f8^J7D}-xQqbk%d~pCz@#k$t@r_H_@=6hAgE*gr`GYZP**jAltEW zH&t;E4e^Fi&Z+YKZ%VXk&I02a*yn?zwG5?GuQ&oNp=F08@S)xpS!Dj3s^^d0g_}G-D>8QG;lSaJ!~HcAb7<$(Z1TzWUx>!5el)iadCDVXkD#~J}8mZCzu_*QN2<~ zi_jM$Q$<$|g_M{Zp<9<@iZx={y&GSB=M=b&OdYtbLU-WlvuUZKHsyNjnekvX!w;K6 zi7(a-V^S}<2K?2eaM1NlQg=nGrQa&0-p9;<-cFKcQ4FIYxhbCSaj!9e9)*^xvgT0SBy{*c zufz=X(6}B~Vj|L?9h8)bj(*m}_T}FCqZ3*KFYfiRxvw}3FkWNWwTtU+Ny`UaQh1DF zfLO+L0|eh)Ghi8XONw9CvuNsqe^$$F@u9r2FQTwyh*VHu$w4boHGgk7dG6j{%;5We z@LoqQnHO~BHg;?yO2OJ~XcU?51+@cX$EJ!YSl=EVP3;9FV5)s;_CQteNV(5++NUAX zU_^!PyJocGM702Db8jG+sx+T5_&pR5DHafkBZp!fVCa8eiQklGQ9(alM~glRW)WiX z@>bUU9>O>GL8g3QG?fn*y4c4Q+XPmy{@+*fktksF({|FT5Q_7gRzWTfX}zB7bV>*+dd5oQcH?v#v3AqD?kM*OoviUn#7QBA zzlVOxRQD&S;Mf&2_1`*EK(FmPbAP_oenw1uRD7d7qGPV9?ZVj7cduOAPw%yMW9x4m zFIt1A#6a`lZ}|fFDD=ru6niZ;N>`)KZ+D7S9dNRY(RO??#HJo}W7&%`y%ZE}Muy zu2?d8@wLyk@z>W2=I7&p$iunvLcA_hVQ!9W9Rwv#m;pI_}>-RH>yDrW2#rR6qTg+dU+@ z;;Nm`%hU0_6iMxKjUVEgO@a2|(b)_BMH>9muiH`_5P{cuO2NzYe>q@$rF#QsDCKPOg^p z+Vgaj@Gl8GvA#2kadP7wl-K?;8a6Cj)A6&hmTjR?lqH3GK9?#GU3zf*fZ082D#Ye< zG@Dtt#(>`~X-v5}T?N1#@1ft}qnC*nM}Dx+5bc6ZT80XF?vaWlr`TZ34n zdva2Yh5@$4Im<@$t82d?p~>Wq>)ND7`6T--NE`dfA|Y+6chG<(IN-U6_S)97H_K}I}qV-0t z33+KrK>>GH%s0$SLY^SxhsrL{>u}fDsC# zakI4?5d1lWOb#wLa%Bd=cRzj^$<--R6Z~YQd(EC&J=WQY7)=Ahu=U<&-{FWV<|vC) zn&Lq^+i3+wd@#->)POQ5M$Oc0Ve-x;Ag@9k%r^!H7Y;_Ktpzoq*~@|}Kl6qoi^T7_ z8RWF4ZD>GV_&{)b^d0#5yRC6&Q`hdBvY)gND%qtyDd}OBSEF(!Dk6nZ6Y(Bs?RIN7 z{Hp&B*$%dRhn5!45q|k7^_|{>m$y9zIn9R2nj4BM&10j)52D;P=03=2)f*M9xRrsx_LuZC{^T8lM52>Kdp)#o5&%27pT ze7+?EyAFOrLur7GktoP2+DN%A%r!<+_uY4!b17>zGNH;d@lLb-h~k|U$30M1x?CM} z`@8O8{~9EH{ck)E0FQ+ zS$U}6`;$diNYH!>YDAv2B`UYIq)TY$0q)tXU zyA-28Qb`y7V8o-)7adI6--eE??26SOBcQs(+`m?JMVQ}<8L|3gKEmov3u)|qmqzq6j zP@rcH2O}^0v>>3r_s=021`-4+0uTg7(@-44Wx#|vF+gE@^+|}}NT8bof+C@qd3^=U zqyYz}%}@jrXmA5x7z%Wx;FxCyDwqUAe#~Pd6bl3fR3H$4hy#}ZkSL%z4`qb_oe7li zKg6|-Ko}8Y02XMBp`bvC0|L}AK!PBkRRgqnAV8-Jg}Cg~Uot{(%!c_5zyggjp!fWT zF7OkDx@^e-Xh6gIUrY}h3t>7<09c@}54tR!00LfhG=Sy}Q27wPY%u>rci5N~^V)=p}0=pw9>75IDjp6sF&l5zV7Xn`6K#^)!c(wN))1 zOODyje#(EHM)B9kLIt;Gz1YtIzfq}lACd}t{*#@ZDE9Smv*IPZ0?Buw#B2ffr=8kI zug3c@_p-&Te{zsbaiq@U>gX9Sz4Bd4nwlY4;NWIqlm8(p>9hSt5^QtVoyX8P=;W-b zc{*(Dyhkz{yBF;e1odXZ(xi~3jj|`1Q(yl;MU-)kWn^)J+wJjZ)ls~X4}l}QPE-hK zw<0=LZW)mPG%T8ttwDqT-SlGnjJF1k*mSg6JR9rOcGjC0=H{&zzqe+YUE3MoEVPX> z+(hP1P8K>V+DH5L>nqwb)aaE*f}ef)DbwEkA`L6L@0t;spe*)Veospg`hZ zwq~o_7d|QwLisehx=xpst+{90Xut8WlH+b7x%*O#xn*4|te)lrV@wcCVd*9gn`2G8g zQfK|Oi9#GRKL5g05adP@WTFB7{OKKbibOn^XZB3^b#T$0?r$%!!rxfn@j)0L@0zWA z0Ke-b?xdqGq@w8m9oQTgc(mf3Z?a-vKkFj%Rvu+|YYxrLlp;nMR}I2fW6TR_mz>l! zdKVq%Y}sWb->JkuN@^3^p^3|xZ6UhFrH zEliy(?iCa(yc=|MItfxeSN|TdvEN?{4Q%r;dZs4+Gj{3rbti>HeIJcLGM_K4aas%+x+( zFnw%`=9zx+?O}i+)oU|e`|y?&vD-R)VhW++39%(*g-T|8DCF=y*V$giZI)-0om8Rz zL-ArL#1_};RFl^ARF&_^up7$*d{oMcJH6H>1i~J-3^82KJsEzJRg+j1%a{E4jOM4X z=6in;ux26^c@V&|W>fk&f=rG6&XizkwdPNbd-~SatzOzRuZ+Y~+{+`wp`0^%6b#PN z=i8r3d4)VX*r$IH*07uZUIJ(ay))UW7qZyl_GypmGE8)-Mlz#uqEUw5{%_Prg0G@J z67)~hzXn{g0uD2mk1BQ{jF8QB7NE?0c_|7BVg&(JWdsBY0q#A3p~65!g~K2qj3w7i z%#IN+CfNpr4ZS+{0M~B*>)6w3FdO$7P7-{ie@yUtO?ocGf+dtj4t{s+nl|U%QG#KY z+v+^ezg;|11UqUbi#7YF-SXS4>YDvZq4X@>_Sad_SUZ;TWAfIplRfWWaHX$hs%Tre z{X(%Kb>SK!Ejo{xzG+9HmPCnT!(P_B*wI($lhf7pr33UReJ#O@0dLxccGU_Ru5V|{ zJr!#MzmFa2@syn{bsxN2p`KdbJ}_)u!Jp5#Ef;^snl0KQ$vZ$IIMYo0;n~J`q;HMq z{<_HdsgZJUJf&6iyrScH-NZWKhHuD&%pB~qtcra|$s~@TpP9$GeWKxHP2X_V>#RI$ zv{VxnRmQGaa%=g9qW!2s^?mV_I&OkTWgMCDC*L*nCIgMdu6MJQWR)WNpU1|?Yg7N~?tt6;Ilq8xz#)y$9<4gVY`sU8zp8P)6zho=&>Vi+$#9VV~KNJY$SNanld}*VrlPK5gZ@VN>jRnXc#DKYus{=3ig1dvvl& zzQkWcBJ87Opzh!I63)z;_Hq0!H~{c!Wl0<5 zDS1Dw?sVxUmw(86@1~^I(Cm^ixtrcK_QB;y<6plN#RWd`5JO}E`kEGXw zIdRCY5f--~MsmnfvA?@d)oHE;amKA_xTVxELvNM1^2UsA1{k}F^oQ-axQA4rHH{D> zv^weOAqR(QG3rzP3XZy?^d$aRXXThL0^9YCe+L;X5ZZ=g&cb28^}-h zom#eo8ky9`Z#k6@npi(mP??^J3H!Xd7qoorP~;7dvM4nx>D|5i&FLEdU~te%-lGqF zosT}0n26}Uopwe}jnU-D-?N#&nbELjXJKgYt}EAps=h(90PC$HbA7}hEdvs5rBW&4 zbtDp&%M#3fL_b>0@|$bUZ`th5K41XUr}RT+~nywYF2`S_h*XmEtB) zeeWX}_x>#r%MF2L{VgP=mtM#lwBx1*w9e0;$#|vqR#f5Y`sRvHNKds9Q81HjU+bO> z>L$HPBs}d0OYu4*uZ9v{l!?D;PIky~1$S^lv%nYY+`S@^3#gaM`DV6jK=kKM3z_mj zIu{3jvM|!LZ3~YE(k-j1X))ibPcF^0hMy%Qv8|_r%>E;`68$X{0rzq)Q)(df{rc4X z8WR2|HiG|uVq+AgH%_QOp%K*_mg99*AjxAXs@V`LygPP5pxl?Bc2X@`5Lg6=?V6P#2+MVmrGj<`1^{J4~J@C2@1$sY^?oBbh z=hkpC+KjK|IxO*Y(lERmt2^Uad+X`Jc;}Jq?LF3%oP=a}#@##eiz0dPtw+xOgc0oF zlfQbuD~IUt-}kC)8nDa&*^=!cnR;wHa!97)^tN?nGhIHH^G>ETNwHqzps%BbpV`A{ znq>Shpg&ieauf45#LB-f+6SVf$fqSnf3kO*qgNK+Ro@AA+*%liO@He%KA)Gui99oKC;sB$ff57w5G%Ad=6S0R)TG&NNB`z`+)@nO~JlAKE zV-`$r+Iaq=XSkyXrLg&GC-~ZSJw19;-jb}AF#Vf9?Hl7y`z8X4#+0o*A@^^TBwJD| z?Kzp(yL>uOe|*kMgQ+I#On6+^E_kT>a0_$#iE?p*IpTgzPQs(m*;@aP;lgz$g30v} zchLzUc{(k6Lo}n(tbE!r5-utFf|BZZx0;M^jT-kqz0G^e)_E3LPD7J@x#QM#;W^y!*^sBG`LNwyc@Yo z)I#K5W$9Ud{q9v5+@$|X!`755r%|<`>-b4jS1S+KT-;gCi;7(3WR{`1sZcy}hL;&t zPKuV?3aF#Z$j6C~vN`wZ`@P1@CD4w;>Tw#MGD?|pD^VDfw56Ap*W-?r(p9YRO{EbE z;ul^898~Z-stVjLL&cYXPPYI+g41^D@_Pe%#6oB9sx^?N7g)|87FYir2QdpC)R@vp zmCML?6#$V}0T3qq-!<_;!#~Mkc10@7OFhK*Yy3ai95f%`6bMwxU84%#K|=hM9~E4X z=_D(qRonIiD%tsd$*dCC_f%xotQP4zI8iD@zvHElJ{V#?9gY+t;1T<9kfNY-=L8-c ziW2dV{%-kp^iO)257+c7MCVoaRIGNMcD5VZjm%4HH5~6Aj(;uEmS&bbKcY(u6PI9M z$Vr^Mrt<(hf+D3edmUmlNZsO(Gql}JauZhA(GkCjE*BaO7gSKR6L3Whn?B0pmo@YccdIsmD-xn z7d?>+3*i1jB`_s)#6EK@Vt0nsn6D+fjm?y0(bX&-{fcY`M~FZ!sKMf%xdnFn?JjU?G4WjW8pSU3DfxbLSe1b#cjFcq7*@iZsJA5 z6M5QF3{l;ks>Y&2=*LF#)7ngiP^LJkVEQhba>&Qr@;X#LJc+u5P&H6ub6n=BMXeC=cS1r(u4B&z>8d@!k=5#b%T? zRbp&`!}C@ghkvxVvlC;aOH(S3ar9iov?qgi{r9&dE;;`9&0U336Yx=bV|;(7$zYb8*e@tzs0Hqo<*IXXTL=;C z&Po>}3{!VwLx*X3m0s(9o|{~8YB&H=@X9*$eqiyEJ9bLl`?r?3O_uaL!?z@pN9$%o z=A~z$Ij?(Mr?U>XYXhyGaHZ=xvGKXtFo8XL-lRxmaApSwt<8#A#ojDmq)>zXxMPl7 zy$PZDp|=t~XR`ENxhCfNhb4YQ9wJLu?Wu7+D~PLd)B7nK$erxww&OEUJioY@7`IlIYS9Nrg zK8}S)TVLnSXU$KPw>e90g#J={8jzFsB;w3L?xUjy>ve+cz57=C49Y`BZ+d-|7}%K) zjT%g58|E{;d3AC<`xeK1mrqsPTRb~Tu&2TiQzCCDxQLw1EEJwt+vNA}+og({#{8P_ z!{fkNMi1Z|L|Z9s)awOhP>Dp){V3Ueyyz9cIlZ|C=H4Qv;P|FfU{LX1w4hv~Z|%H9 z>PcKCcbPf?33Zp|mmbP^)>uL*1zKZ%+bZW(QT&S7v{3x7EwT4ZVMV1li>I(*%VLYx z${{&n{X-J#F{{ikR_Wm~wH~_H&Dq8uzm$E$GKlv4*{6+;SKc9~O_e}}zv!E);JUf@UymOuW4A5G+ak z);T~AM3hw~9a3-3{+P@EDvF5@f2n{(ndlRd?dLy1-xS@H8xeabM3HUIe8XHLUio!t z$nG+KoBxWCdrGtMQ{Dqmv$iam`{Rc9?(G6*Tdo3BKHV*~9Zq~-1Nlr`NY1bnHv~di zzI;WzJPj8&*&7gyUEY^$TwlER&%Qtc+ynn7KSuq@kCDLk;DLSFF};IELP7siIv8}D z6(+grm})CU|H6s56}?%xRZ04x@|q0UtA>M*G7U!r^1Yt?7o6qV4Irl3gn?&NlJSXE z_^A2ZGk^KzV2|XDm8yW(cTqTdDjfJ^ubRbYBHGC&CYY%|l3l#sFb&Vt;50qWX_2yi zHIEk8(?>|Q&pkZX$}jVc{5}E+APQ{}uJ%hP@O zGmEh)&*Z2n(~HG6O=&)|IlxzY&DlHl3$^GA>U+FvOy6q zx7bRowVPW+Ba$4YJ&CbZJ|#gg7R^6zOD>_4A)WH5fbq25(C@K(IfkdQIV@8R+3pfF zxRjU|k|TW-Q9i^k5#v;xO6Q-_UsRH5iz)YGLB9|6sZl7Nx!ek{mscDwq_F4djqTt&jUVhe*HN7ek;I{4LiH}SSBkuJK`OZ&z$L>jq86*lijXJd&v}C>{WD&(Y>STnOu`M^%GF3k7gD>)DKz5!0#A zAv^to``SS`MpZt{>spIt(wrsKS`Xf%2~Ti|nxQ+*>MSYp4Ee3sRKg2Y-t%#&R+q1H zj5t1hs#<;b{l^B`l~Iy``yY@M8U%(jjGiCriq}`Txej>hCrSzXO-`L0Y%~oYfCR}j z&6(f65hibL9Jh>+nGE1swzu45kL^T%ik%iENosK%FN^hy#^#C_w>Q*P2WEsw>lNNXhDm6WV39dfX*Wwxnl7%(w= zI?bjR#VD6KQW4dpx*Vo+c#k-;pJNd9*kBu9`EZNe(e*)^6El?imUJ$P6uN$^@nKiC zVeh*~F64uDg>niJ@5QpFv9OiCx~!Sv)x9?)WFOxgQP4=?3aJ%&;bT&TaJ>Q5lC_Wg zR_jjuD`-Yn-B5<=mLa{e=-abR%Q*x-ZRNsf^tWx#3{2aOn)P0+#kIz%0F}4BQ;!-d zJu0Wr$>BXql3Sx6_AqS0H-WA~ZlpfoZI?a=zRJji;s5P(69$8q<+>}M)0KUa$Zb&- znIkny`n>)v6_Lil7gZlm<&dInvc!bKDzRjHF^pl3VP|u_9ERo9GfA_xIwr|SXI8jf zOf8)cFA7hKfv!VxHYccAsejpGHta@UTI0Ov63}$0*&gM!Vx&7oyARKuZaHi9c5^(b z>*{J4o-4t=Jdy^6_eFIR7*AryXyU#D$vu%diew_nt9!{r=Uz40WAKpw<9vohOQ;`7m1_=#nRp$3{y?*IS5!YZE6?7HOH=*&1uw|Bh#I(mOvb11&|jeVohfQxWpCI2tU z&Hw}O4!iND4WcizKSJaNRzH$1jJQ+*Vz-!GA$j)ez>Auost!G=U+KUtfpDqP!ymyl zPrZ-W>{iT-4?yFtyzle0N5~=NeXXVf|FMq45<983h?mlC1fk#Z z;Z>B_eZ>pEq+v>KvZ_ZHpOS_H(vVO_=*4QEJK zA=>5)?i73i*4!Q4eaoIcnq4`TeGA_1DfLQwv`lMN`t9hKFc~RBcvbaaS-DO!Z!N;&MK2)s|}yI%5>`t*P{xp%Jg#UqTp{BKzu$CoqBF276CI=MdyXCkuO7& zgz~-JKKC1S#WqdMzL}3XDSitp^3)pg6TT=Ctt%Iw`UJs!CoMQ~yz>(M|(CIbHn zq=$``{TOs@1NhT|ZZoLEOXc0(lO#BH-h4p~Y<`Uio~e+k8dDwY0s1`1j=_)Ie<;Y& zos%SIEH}`o%9Pcx61s)l`c@SZ;Y_Y7GIly~-c)7bJgTx}D9*fj=<>L_*n0l^Jt#XD zZdCTXb^)a{!+3b(m>z8D@fS|d-tlv)+;OOhj5j()L=RkkYgBt)t|{G&8&hUuQdmRQK9?}f&-nqMw_f)Wa5fTXgD1Z1uN-7u^p7B6GiV1fAQZ z{MJm5yTGa%9Y$V76yRURJy4fww zyBEtn)VyJ^?q2XSMNTRaSKa4GU-U8Gw8;iKc&+kyvx@CEY`aR6LOQy@5 zj*M;xxy-ks-kX`T1D&b4O?$MN_c?*@8daRquO23P6Y|LBs_399Os+?w?(pJwt)s1=Pa=rU8-+T zWkkLfom65yv^*0u#Qe#2U~sB-(RKt4<2WMRD!*kC-4dvmPRrxut#u!#KjAsU0p$9p zWFKiB7nd=6?u+2(0u6z^kL3k2bg6Gv?`@&U6_ujyErlwXJ8*RMXH`GYtOrf4S>&M~ zrESTv^lb)BXc5I?SYM1gRC9TTcTlH0lSP&r$4-*In^APab6U#ck&{(&2+iA^POL4~OqmQHX5`@?)Omd{fal(f2TW^+}kTqt1HWT|heTI_c~hUYXYCu9{1zPOlr0wH~+^C)no*74A}R`Eg`0 z{crlabodw49D0b|`zHo4qkLQoLb^I=2Ns>PybVukA_p_NU4o1yqTTu)A8A$O?D^i| z{*H$%_R=cay_fzw=-wbUcQCGqtMz;T<2kg}1nli>XNc_z^S~plSBlfSJGOquOPf9B zSr3^spGEHPta4!SrDmOfbG&vp>gX+au7<^e?B3+Xw*!-3?y~C=Cc8)LgXT+L9r2zP zgp=vMytd^lgHDKtx{|t+vt&t}{oI}MoluoB?T#5%d#iZgQY>zr>4GN)X6MxUh*KYu zB$6wO+raw%hlp*V^^j545-D|GMp$zDEF@`3MzEoqbKU}OXX=S@tolOTA%0UUpeJzd zN0OQI1XItmCW-O4!bS#5cYTAsz4VB*xE(e3ZU@fFh@*?1TIo=UZkFgrg+6-yU3Zk- zK_e*ise0b;;=WkH+%Z(w@Dgce!~BeXYL96*X;wI`=MQ~O-jh%8$5xW2*SBU?#xa8F zLKxiI9yVd=nqA6yr|73?h3Zf7WxNbIS|;hlc^DxaJOxP;13J3*hdJj~_QVGux}b#) zsLi>jO*^_jjZe*MC`W|ie!pN>AF)=t_X6_BF6BdqJ8^<#*w}QMk+@&@+)IfJ4yfKl zyWQ&aP%TZvymvvH%aQXyZKi8K0YlPVTP4$tup!E4POWbXChz&Z`?yK^t?Ne;*(CST zuN;Q{82n`I>z{@PLMW4S(x;up_7Z*ywAa3F@8KvzYb(77ug@mo`D!KFKBoR^RBbqQ ze^zWuYd^-?|6bMa4~{rfsIM6d`=|52XcQC9?Us$PJMpWQAeo-Yt{gv3@lsUKVNOrE zs|-(s?=`W=!#WKl7_~OFgW2p?f81Qs|GsTl=MXNhUnQdNGcawjE5H8PSiQ>4#*T|~ zBA~Z)7;Px<%cG7mhgnk3p4ad`Y`L#8V1AXpH#yy|{gN^fQ~71bsc?H=6dmoe z7UrVKt<&`8p3;+FBb1|YPdzoBo3u@q+-Ei}`|ugv|8gtXmBR<2*5ZK0ef|@>${c5cSwa z`gV|Q%zL9Sdh0XIIS~~I#MsP>=7DjRsL83sjo%A*tXE==JpAN})0+6^3MH<8es`ab zOlPC&hr*5U+^6p1B0pFkPm#(8Kqe1N(v?|FljQSj#EDk)aSBI=Vn43f7Z-ke!?R!e zeh@91B%fa4p)R)rjm^HXJ7;=!Mj(qPSA3OxAg+>+%L=mx#wq?!d;$MY`Y~rXdlg?6 zDn`f>S3Hm{SW^ELU$$mm6jM3;y0{z3p_Rw!wCvp?NG@cfLe-n*Wrs|GJxG_7#JV7+ z(IFfaoy~0f@q5~FS!w^-K&se>jXk1I^ijkldoe@w6)lqz$AYOj!e}ko?`;xW5?jBM z#lv=!4L&cfY^=`B0f!oii@?DwB^H({RV-n73Rzm4ZvP`ubU>Li_V!Ov?*GTvTZYBa zG!5G!3GVLh?iSo#g1fs0cQy$STo-pIxVr~;4K9Ho!QJg$xROim<9oh8doXl$RdscB z?d(j?IsKX%)6%##SWOQJ%gcmE{11*##*k%;8E$~KiDbnL0_+w(OZXi|*y>Mx*PjFr z?;QFPHuq8)2gfY$PY(2#AALzMN|aj=zyQFd6e*T&qY~FIW++F80*{wFvsdU!;dFhQ zJ`t@gCRZft&J{lshYNTkUGl~S3OrZ@!qeW)GU?A0um|!A9L3G#-jupXQAWpYMi0FE zlAc2{`vqd?Q`)RzPt`z4x`Rorq~yYm=l!@q4leo3FWceCEI9dhR!7s;&!J$^UT6wI~c}Gn|)YTXtpi2&fGBZu?0wMT;Lrvq{&r~-bjYETR zYU36M`TM=D$F7IF4BDs9CAHk<@CQLUi9BliXoPf+O4ZJXn(|>t;ZDD%$AdplBHbtm zbU0Vi$ zHRmyw8M$^W9=x#L&uU1L`y(tMzMZ7}cHeKIK)*B%0_)c3hDHaKuPTJPgyVJm5 zgEgj*a+&QV;KWtU&Ye7vAM^nCIi&l&I49n1;4J#Vb4u_?;1^Lj5C3G{IAg61J_SAY zUbrvU+Jrw(rGakrmZ#gNhV6*ym-TTnlM{CC|0;|xX#aPDXvVyqJ6dTc4SGBr6h_7eHuB#19 zg@*XSETBH1=G=v3*{-57D3;RQsthnl&XV0UnsSI!wiCyJYOmW(USgi78M>TBqPEM*LQS- zcJta*YLSgP2vW!&`c2jkA>QG>6?xRuRYKW2@8PwcM@t~v4kI;bqum_h5Z-W6eApB; z|EJF|H#q3(os#8M{xlld5adeA!_+}}R@h^Z?w=w*RejZL86w>F_8&=qvv#sa_!Y3C zYpr!Q%nY%nCF|J(H&$laySj7-(egOuHI0=R^P$uA^GMl2okHYX4z`~CL*$X@H_`c} z!{yPof+2i4H~YCdb;&KXl8`7Dvx4JKRJX9wu+eAh)%SCb#C$c(*W;X4(MqR(t{VSy z(HOLM7Q`n3J%ug0~8nFd7Kb1FisBnnV_Ns!>DKo0;D(-fv`)!oOm*z zb{rj$JzkLE8N&i<6}NPB0yQ!{!%RSjvWCw`EHAXP|8%8FAOrTrD}it_*$FH_*#t2l zej*a+h#`>$IGrFx_<~9Mr^gH23Zzfo)csjICvZKH3}}!j&ijnL`Ip%jD%&5kFEAuf z;~$UzM+rAjBZ&+Mk%aTimWg?b0KBe)0}`b|zJ68@YVl4&d7;kKqaXk`%aBo+{$~_S ztU$+P79d12#fz94Bmz(&83lNl{5*~)P)lwy`b*1bG9k$4|3>e>zA&=@>r=>p%qh|2dfegk0^v+-bl4l^l2>gM{{T4WT5dhC*0hYZ8U_k%P6?#$Nnfa{X zD2)J^nu!MF%tU-q@(&E|SqO#Ye^LbG6K)n6up$!^1QG%vub}>5>wqU!7{Il3g4duO z@ckeOfh;VL1PIy02Ooq9B#&cO>a*>`fOb~xzn1DxBSVVvH{XK-=sr6U&VPygW z^T>d&^N61N{R1!*%)>-_W<-HZ|Mm;CiMK5W59v?&``w)d2$fF`Y{OB zV*MXl-Cx#OfF%W-D1QiM|5`H7t}_44F?*Rgny<*9i<7)xSwI>gfExuUFTgzppkN^c zuP2|7@Yw}$pl>M@(hDW-?>-=29%$h}{Kbj`p44Fhb&Huz#f#h@ttWSP=CO7VqEoKy1~g;o6A*GkQ>v|Ha0879MyJUMT(J69(w}4TS20_zTtd zqR*i0S)W7MiwN#tXpz5BB>z$mdI$#`4Fr|^4Xpze3{2qFOJAsRPT)#4G|FFn|I_8U z#QXv6z0|&-@|S>?^8;5A!GSX6Fd&COfr0*;X7}O~Va2mgOcnepd22SB1@f^h$c{>9`3W!zsJycbdF%4e%8zcUZ|8 zQwa%7szd|{fkyBz65ex0y`WwHn^FE%d_dYNRFL@dSpFtzf~=wgA*-KtVpsD5J61m(H78IJ^cTqF^IG{0?|gBKw&qy{U(Iuvv7ZsFrClFkPvK_zt?I9@#^0wU zAl}~Z4HnECY{1tI+<^by-aXLu(uh^9*WYU$&dmDEw89vc6Ggnz`)L}5l$>4oE!hR@ zCdKCv)}SxtTS6O1$jO!zl7kXkYZ@MmjF7O$)k@93%(s}cr^%|6%@&M($y>Ze7mkL1 zxbJwiJ&l5RU%Gp1K3Be1EA6$H3)bbe+exs1kFUnT)ILKwOiTnTsLCBq5fZVdrC)j) zEnWYT_jw1Odn;WumYm9D;_iAdcJhiVd{@eHo;pH)dtUF=VwcJ)6DRpBn7EPT=0Tei zCKa~dOgtTAVhdPDyYW_P?72|e*_Gnr>^Ww-6ym-A#{?+GsNDzFYD`A>ce4)2-wPuz z00H2aHL(g3c#%Z+3Sdou*tDwYwL3mV{Kl5d0P1*iQrOSteuY#22L58G6KkcYDr>P6Kn3d`K7Bj4gz|) z5)H4@Ze;JSp`*AAtWk{yz^3p1fE}{3IV+QD{!>VNdLz-cF*|Hov9aS%JO(70j4O3`g>H zTQuksm!yAzAqSU%ChWVkj`p-}?Y<7EfqzFhT`vXoHZtNla3=<9Ovcei>#;x|vQ%#21+H6WVAJ?b!%+p+EH2<%Un6H_ z4U-q@MR6F@tg)%Sdxwoo*Mntmi0@EgLG=N?P}CUu(JdLRW1kGObL^ww-oo~txP1#r zl~c<04nIF|D`+#~iX&IfG$CVNTdPCvjQ54e0SB@LQ1-o(7jR=PM(3%DUzJub*NU%a zDo>l_NZWb1^*NjGdz!jog@fl)IXR_$Y6~&pE(gOhl6;aM$L=tyCaD~-sSYulu*wF6 zuCf?jGk(4xce%ga+$}`EBjdejB^hg}m3#jIizg2X!;lTI&5-nA9lC(^-2d^FTFUoT zBUZ@hDhOjtC4G{Xwd7t5fC6!2nY_;D$GMw_Wc%{U)_r!hhMe1r)&T20gzqiwYSGED zB2TI{+~emHb!Qo&*t9Tee2bIK_vNa9xTQm>QHmRi`LB?wa53Ca_YWPsI=j2}&=fgP zkG^SA(*E8~Y&-*4Ug>h(ehnp1etKhw+&5e5`raoO#Ychb+6j#7dt8vL#}}26l`cp4 zW-j~q>$kfH-uTz4G&QyC6Yn$v-7c?C=`frXE-f?Jt;-9*pfXobe=y5u9Z=;e^UaCz7BgSYWAc zCpN0tma5jL8LJZHszVJp1IUVle`?4~JL<@Di3uzRR|z?2PZ*HXUS@^VFSEV%GikI{ zYb4q~Ya+yXd~{hK%2`GCv@!PrxJ}hGsH&?OUSmM>FAVXU@XQmqvTQ2ha-!$u)n`NP?3(q2 zQ&Cv+EW%Fs{lF1>Xf<^^I}BccZ|wVN+bJD~AHFcJbK&KmlJ;DnRp1 z(95)Nr7X*6a@^djjxKQ1EPUC!SoRm=a$%J0I-A$Uoew zZ(TiB9oCk@y6M;~1rpD-A$i4bUp*Q;eW@B&V0e6B;u)1MH^-zj*uC5}#~hJF40pet z%Q}0)Vhh6ms=>qg6Oa^(j7-|b@3>R2MwT%n-j>;;GVZ?)y({gJBkzT$FLOF>7q#Rl40_o+8>{{yX#NAPiIa1Xe2FM z`5Bx2yH|3GoBHhdy=A--@rcq83WNgJ-umV%-UX?EP640cHsd~rx2|>iTI0ZoNc^$iol-^@y6%cq~_!cO9 z{+1c-nm#p7fb_8ezafkxKxhOV{>{=Hbd?&J*c2=qDMObn5pdqbZt<&HiYvwrjoycA zUT%K7*Zdv6ce41ZYMLH}4!biNjXpNAc0$3Ex53##9C;Q;ogZJ7@!(RM#~k_?B3-ey z&3_iLIkfc%OzIz+7z*RqVdMGMmUN|RCtoo6*|uke0?;LpIAN^dpl*HIvpQ@RA6L1V zxNh5G6rkELqV+R5qa|)@_Rh5zZWclP5WC4lnY^h)>0{-hT8mSK4m}N)fQ#=f&B%AP zVR_!OB+q!1s8TNLp~d0s@%!w7!ZGCCH@v8j?rAd>^c}6+i7fMW8N5B80yc|UOW>ZO zPz&Y`&H*0`hfqc|oKc2MNCPC;Q~BN2-+mCQRSGIC9%oB!HDv@W5Pi+dk>x^HDd6)=kcySf%m)it*v$ zgE>D3pufz>r%bEyGkY%I82tDGJ}la1zNbF|UdxvRQp;m)c@z-G) zZkJ?6_!Zvx#zT(_^&=E)_n)j%mISmm-`DlDXC7GziT0blKmJ_Wdwr-ugj~eK7kPyLs7>A4iMZ^`teH zXpP^X4tyKAmOLe>?1p+e2e|P$G3ff!5^Em?ICPrX_iTjZn`7c&_l;3!(#nkFUHJ~Y z_3;wx*9U%8PVhm%E!9|Ur}&KQi(h^_dB0{X`^F|kX4R(|ae!dU2Bm(8+gr{8@uZ6! z5NVd4SZLa;KtscXE~3$u`QEq>s=RJdX|+LfDeniFtKj>D*a(^A_o|AHQ5EhpG;zY$ zhbN=)3k;6*(CB%%ro%{uH*hN<$s7Wuf-sihZZ}~_MPJLk+1ec;IZka>CDrVRS|Vz2 z`I1(AcsfH8pbEj!%6()U4jk2FVW_RD0E%MsX-_)50@PSOmUL-oOhg^*gCrpsn1X^I z(XRGRlys^;e_y_?+fi3*)<~>e_bXNkdZ!h%h9w-3oMlLWjL-6hS4%UUN1W-eFX@#KP~Ys1x#l{-VCX*6CBi0EV154OoFwig0QE(AgAhiICQm7n zC@7mhlsMrLqZ3c^lg&H)x1FLIk`Iu|JIoq_cyCW^H5#>S5tg^d6U}#$<@px7xM)U5 z{mC?h`6j>G!(b z-T^ESOwW)?dBw{p931Zr+eRx`Z^TBsOpL`|ZIs{6-U`Bbd64TdC z@7q!OQ+wvJN2vW`5W=)}wz+S&r1=j5XZ9%=l2!~{(b-NWe+j8cWJ^L({BajF<`}*A z&iE2dB(eeKuY4G9eTM|H9@@ujyi|Z%>r~(@TwI{n;7phh060Kz&iT)6#REQA4VCXR zUI$KQ5J++aq?UznP!^VnKR^2CWqEw}4~mtRNhcW%60~>>G22xY6&3S-HTw~+@EAPz z3!}IBuDz)qsW7XUa*LUoG~4k0%`89b8$VaVr>oVYOP?pVncGoruZ-%e1?$q*nFVV? zKwB3Qk-sysJ?f|K2po3)mh%8TAE=}W^dtV;g6Oeu98|X6H+v72Z5;RWCpifO<*6Sp zMEpArF!f;YYDn|}kV6C4yzhv~8R)mF&t#w{N_%bt3LUU5MFS+wf;8OH-ucK+Hf9*D zkdvLVldaNvNb9T{Z^e#Y?_&@M4Y=nF0qPI+iTE}?olD6l-RM7+5*(|S{B&PnEGVGp zPNRSH6yT5}&Als)ZFrJ)dI*2}^K4>n#YU%a)GC|=dI(3;fa4fLQ#Y#gWrUbZ#QL+qu8@foQtpJj<8`b|4{{-u!n|F}st!{(&_tG+OiL$|vLFf`R3#HZR+uDD zmiCSh{wap4U`ijnd6g<06q=pfKqIc5Y*VGOP!^M#Ek|*}C8cyuk!6(cEC)cj%JEGZ z(9lzRo7qx)++X7#azTbRlvQ+b4R;i3Ui#q9vxYZANQ^DaH1kHXqM_SJWd=38A<=o; zlsQq9kExxdpU4mH|NrBO0txzw=gLpeY2j&w)-$@=ePel5yacS&csUplRsH0PU>YR^ zfo&4Cmhq;{JPsc*`R+&S>)(cspU}~G`ZdJZu&p18 z#BWc708$&l=22xNH)!PwNcMCt#5n6Rx6z#@P|)OEl4MDOdgQ?VJ+d#u7njF}hs#ro zeT%E*fNw{4YF3p3wt2UGMgMt#iU>fs{l|v%_pA+(;ta{HuR>gBTfES9u72s^dYRHT_`i&0ibDpvtS=ZPy(aBR=QF; zJ5cJmSyfUz18ByJJH)LcOrCs8!tHLnx`t@w(S2pvX)WysiCgN1NWGUx;5PBYSHr|tal8_Q)jt7Gu! zG{2o8q3O_7JYDZ0F7-(Z1Y)DNb-rk{ZFWLb312VY<^f>X-tFhVnVvQP=o6AtO~G9Z z$c+d1TvpHyWfxYfA!6ry@U=tqSRiuEz5{Jq5^qS z_aiCq7aaJi9l7uDW7)lZ0v&RTr75maY(eFtYRB)3ycLFvQkFn($f(?6YaZ1y(@l=v zs%mYhuyO;K4rk)?sF|CV?xp5ytUd+5Av8HSJ$zrkxt}Mbb*$N1SM=3UU1=q`huglr zr_>uuT0PiU`H=hvgll1gIGdf8XYzZ)`kOeOtt977%5fn33Ruo~*Eyf^ZYQHygS8`b z1;l<@I7>;w)^OxlQn*a5Ip-%C(dqPV^<>_WOglY*l|H~*($c|BNa(QW0^Cd7F3lJE z?aZ`^nHv$@z1|!@^|H%E7-?+|zkuV$nF38PlsxG4%@*3?9&FQZ`%WUgLP9yK$b>K0}d{xfHIYU#J>9Dr2O&!xou?08s;z{|c z(V1lfP;D<)AYA^DX#fC#UUw1DN?xpXF3FopctjQ2y0)gucDXt5%z%Wl>3g z^^^fER!udoOvVmT%Uu(SJSa~FB*Ty)%Wpc)Rd>;axAA$2W3lx zetE)t32$(_D-aHv5EF%k!CSJw!GT!h8@T`u0EIw4a{iE%{IEG(av<3KoqKuU8|)NH z#GljGhHjRXQ&Go31}%XqyTnoxL})qbDr!et8s(Ydy@**2HF;X znQsb%=fs#)D>@u8G{Br1oVnx0*P3#zGa`^RDmn$V^>cvBjLvQ_lwu3jg z1E{NabJ*=$qYEOeL&u;$DR|d<9nsVKO+;oaBAaO@tP1L#m|Nx9RY&wix+hA4myU9u%r$h3%btVvSgxQ+d3bl#VSK z2nXG_U{^Dqne!RL3~s*JWs9(b5qI}C2i$Dw?(@!>bjn zYMiX;pWD+9rQ7S2t0Q%#CzJOaA`;TyUCP+CW5ND3KY~4~^y!M7J61Qr z^z!5JX}rhim0!^_4wI4j#Li^K;2xiQr~B^4*y#*J%;Q6H9GxNW%@Z0+!&>Myo}sjUBhuBOgq`V73=zhxU@o9F2I+kTlxu~gj;;aT zTjGd1>5dhXqbeoP4wVds2lM%}r7yK=Mw3~UaX0L(b!sJ}Y!X7sW)x@HwMi)9Y350L z{4*{Y9^WXkjgcN9D6Jx|OA-yrKCna~Q39 zwmu^6n{o3%`|<5G21&_v2YuevZdx(ttqx8_2z&rGU(Ek0y82 zrJIhHkLiU5DI+4b_Zj)`cmWyA))(gu9@Q%xp{>zI+Xy(7T40pQ#3OB4-$(i#8(O6N zzskG*c$KN^VG)S}Nx4S4E3KRLqg%*Hj-IqJOcJkVCKN2@v0JQEAjGaz4WB{_CvH=6 zDkm*J964BLeE?V?sBui~!pGgmcA6_nDFr85I*e>z*Ont;FT|sC84JixxO&hG+Q{@< z_G1pqV)syrQ=$%QGiO_|=DX$=XsZWm9|;V-|D;lPYG&i}huSATerf-Nwz{_0&FN z#xk$sTIWsg=6P8FkB2g28#*TtJl_2^Q~d36(KAf=Jen90}Qa*p(%v>)#lO}XX?H< zER?FQugoBwuseGZl~FB2&LqB>F-6!XTf|o{$lIiQVserIu-NEOhnM)TF>N8S`E-~G z=@vFtB{MKR!T*$p7-7fKux|+S^`7IEjZFUWw4=p5(ObFUA2HpCf=OtyfPQ{*zyxdN z^Xhw}&72V5fqXe>I7^65@?FXkjfWBWT@ph#elUH`4-ZrFRMYy-G;kWei*{9+(vV8k zqFQvxXsw(aKp`Cx?y{O^op-Ui`0)*KNr9wBNR721n3&NwEfX>=cN8t{2rd-%Wz3A7 z1r%d^)9e(k>gPRs zNDen6jfJ6V-+a#!Zo?{bE)(ol_{>IQy04pjA8;Dl0bkY|*!$}#CqD3OWAsut7xPi; z_dD1e@6W{77Tc?K)?{9>M%LEg4S5R$*?zRVp>;evbyVNjL+`rSitWa79kei^G)5V^ zVA>lWpv7eHb=xJ1jOLP8h%JX4LsrDe#+7~d4q5+acRJXr+KOQHo`dmVfim3gQqLX? zM@dF&6#x>h_$vf`bqDa%oB1?!d;O=!JKVFa#q$}9?bWd|T7u=0X%`%!?I_I91!=Vo z@axh|E|?1Z7^_qDlHnok;Mc!~P>qS^Ec`PQMHduSJv|pXl~;9JK5UXzhNFhxdr5N? zSDqBxVg`IA6H+m%*}2VM=LYPw);%Exrp&Sbas_NsW&%{V=(Q{IY02eX;9<9pzKUwf zHVl;&FL-6TM%K9XTrlEqM!8z5#eL1g52J6fETwKqh$4VwY-MucJvVl#AJ(R&rM>cI zGqOy~zB@zS@tB90a&6TMVxcQsdHCQq$_|T+8@;!ZD^M?EDF$D`SdGsX;Jen4FdnR> zJO!u`DerD#Ol!9kY5qo(gg%E(vCk>jbeYorl(#V#8ChyItK0agw8HW*N|goK=c9Sx zWomzuRLy`HK058sAzEV1yOs07Qx=N&?qMG<%R&>Ci7E5c+rfM2ckj5HtnAtMI@RCi zN*kkxH#8ZRZ8pdqTWBMJP_Euaq8bK2g4zMLoU0|G3nAx};t}2?Omro+<+ z+gp7;+`s*rqF&CyuG{L#3WguuNpy*wKVhEh-k;rrle;7B?Gff0 z{ct^B&dY#=mXO!V8EeErD@py-+^`+2w`v*UY)|tiMfV2%$U~I2Dbs?2AC|$03jU1d zfE=H#HnJyy-u!4tO$waqQG!SqT737bDX0fupWT6XI7Uq6JXM}g665`D09NsuGjPdD z*xNfF=%Yi(6j8z1vwXn@7<7%arKAxX9~V_MtB3L#WTj zGh%)ETHpbVCCI&-OfEAQxPYPgbDd*jNDPs#*U9i&aDvsEOc0sobI82q0a|;9BSCwx z30Lpijt;0QCYhbTt-Pnp@w;Az9Fc>U#bVRMW?^&ho}gJ{ZD!Hx8%vqK$eJP*$q;|c z88@>h_OYZi^I^`9UpW?=AURX;Bpyf=?Sh*SR)W74Pk}+KJ`?rq@&df4DmbyVcMovL zPh<0i1~k*Lb-3)Ma3J3CqdFmpGUfB)D71IDc9@^v2us1D zYs#hc-9-#=0C;x)p}Yi7R-;3#TO zSegorYVKN6(Y#twf-<;JyA`0}3!mUk(LR^Y=Btn7^N_uTkQJjiWn2;+29qj1AHijO zQ+8Ba$8yNguU=R6Y_RX=zEfY;IB*Q6X74V3^oG%F={Jih?zm^H2))L*5mI z9}^HyvPL7M4`YQ4ZgH3l+r337KZ+~n^BtT$%a`Gf%X_b8^8sg3`>>y`TG&dqFnR?B z8Js7nLG-%)l5{)K!fZ(a^e7d!cuGk$wdcJo1xMj3Wn{ezd9t&k*71%6#TIw>}cHX_peG1D%jO1p(VQok{LxgjSSp zvyUbbXU$HEAL=J^X#wjCGdZ|*7$@l{$V{UR>o>$6shDz6gMk`#|vR?qqxqFYMv&)TNUVC9=@7lDOD9%18N@sHIe$0ITrngL?~PH%?vccw>`Sh_R7 zE4BCGeg7X%Hv!AfP$59?KxAbF;bK9zW7t^!2bUPm1?{Xn8+Y_j-V;y1SjF*EE~VBz z8q-JSlmyy%Xn{`iTSPb~oyjo_M<_m1D0fsmy`VG{`6n`Xkva}b!*|>@1F{skNlCF> zxk(hJ@hnc09F`)ilt~n}EW>b*>33~y;UAqQPtNX+TAvPEj{t{PKEz>2gQ9mx;mP+a zYJ}fI^~I>{-?SWrx~k1nAb9bMLO~j|+C7*Ug=W70@Rqmk zMF!EK@e8X0c=5+veS*8s;obepo=i*;u?1*Y6-a9mg)S6fE6|8x$e&&*7?_s7VS$8H z2s^yTU0;DChWtehyXAHWto``zqXH4Jfk6LzOPL6Fr1=j3)|L^Zd|3b2At+>H%@5m= z;tvhb4XY^|LIyqJuRM1B01zd-R_Q?5S2Yj`Oi;SNGK2)&Ff%qD=zpnaw!dm++Ym?Evv898#Vm+Jh8uc?sNAzzScsQdZntnSA0 zvf~o@lugk-fZDv<-J5dEja7j1$e4GDtG(_dht>4__|9c~(S617dLo&IQGr$z;uo7U zI4?6N%(yYrZg84`dgP!YeUS)34U9Ku5J|^?kHsq!0*U7Fl^(ItY_q8OPdKmg!NC== z#NJav0tIoQht~u3R}W9d%b#c=BI31RwL--wz{>c-0O=A5<42WP>TBWGZ)*VE?O8VC zo`tQ`$h*+HuV+^RF58{?b>+OWE~XY6>N0!@7Vgdya-pr>j=0rA&3b0}Xnznp4j3of z$2dgR!|)}G5v0W|MUxAa57xuhT1&&UDVHNC!ZLI#M_d-;k5vjBitSXX{(Y$oBN)qtJKq1(yFv;MQU8 zM*o46`BO?v=LGUsg;XWo4jF@eXH|yZCXvG^%iHf?xB|1aKq8i^yt6P)jI&9^&vhmN|@t^nyAp$t$ zfGfYGg4q^d!`pd+mOPT|PQ;Xm>gb;Zy~*>@IN5%06Di=`KkjzUrLm0XNs>Y6GO^U2 zc36&k`}!8#6m&}HqVQ^Sl*o+5#(M=~UP=OVKEk4Zngola<-vw_o5l0BW+WWf3R32OK-;$#)5nRScx%06{bAaoWud_C-~i z-d<$(xtjs}>9|yeiVANLu^!3q$r>#@Xd%ue&aApUYEvqEbM6vDp)RZ_NkuYw2#qZO z_)0;)($UNhmO*Bru!s#^L z=j8|w3$L^X2u^4aF+`=pu0?9dZ7dZ4OvAucPPMQVwW_p`X|`>*vOa3pPQGn1e{W~R*u+ikDf;JVoPx#LX^j8{a757JGVFee0Fi7e zZwGODwQbtA-kCc|>1MT;^6g%FkazLPj;Cwa8*AnMDhFfpMXfepw$0Pv-MFj3AY&NAE&e-327% z95C6VlHQ|E)g5Qu7|1&;^w!vT0Xl89VB2*rBz?@f-ea0X@w549TH&9P;urds=THc* z20q3O_7GB5C*!d(_#bwu&ue+33*dyd_L>He>mUzci09~j-S6VREI(moJy2+yekAM$ zg9gMVctZY)(uies^qVJ&55=wyrqXpFeY^uZ+FmJ0X5@r*>dDsGO#|P$1-QWIHdCBg zun`zNm{pWO(}8YgxD2FQRR(hszl~OgMrP%Hl#6^)%&uF_ofQoy1&X9xyssvw!uEEZ znlblM4auatnx1$QX}0ZbYEEt{s>1EA`fd<>)TAX6%bk#;A9NLmFjU8z#b=Bsy2S8t@MaL*n!@EtT(4XdWgoc!N7zkj4?R^+V)D=6_6;-B^ zADhvQSAVi99HPj5^tbz1P>#5LaZ$tvoR5;D4SDVAH z-jh}ztO^~uXUb4vcvqi&6r_5sw6Ar~#&j0m%gwVG#)#>1nK;KiUW~r4D*u2woy$Yt zyIH#lC-kkf#VvHXt+w8+c)8L=PM>Iekq|}-B0VM5)9#?7S~(>HHzV02P^S2t@T2X}RKDaw+-LwU)klk#xQPE291Wxp!=F)NFIFh;McM#v>%d_ zxr12>SPKl~?U^wKX}i)t5!aT`OW2)Z(Kr{iB!8sj2iw;2&__iDjKUjG``MiE4Yxt= z(AIrG62fCpl@l1$jSy)FppQ`G3l$)#Re{z}8PkN~U2l$((+GNc-LONPbD)=9rDLstNK4U(YO}BFqO-0bL-yNN;$Xq=YHRi*Zp>{#8^1&#Bh`OZ(`?RS zOui%7nn>8*{Z3>Od^s#QXaR&nlo5HF<7ckkU?LN;pgd@9VhT{}tJw=2poF3WCi zaU>F~=csiylLWN6WSW<49$zZy2NEkFD{rg^G1fK34So3_`NrFDi=1!3Bf&LRam_SC zzeQteN^v5!K(Qgj3U_P!gomK8nfmL1tTlR`y1Uha286@Afmdn2I^*NqmgIssKk>uW z*S^K1{7NtNaGbBog_;-dU=4Vs{P`QlUH9dk1YQ=2p_u{TPE@908TS&rU1iY7%0*o= zy-+E^ioo{=ZUKDW2yA<5dS|Wm40XYbE#3kX0t#|q{Abf?9hHJ>6e*!4%PI}R@PHfZ z)U+I*^xJqUmoxnhcoyx=h4+`d2#~EgZ}uru-5js{Q=*7t-Bf!_d_jQeB<~z%!rO0~ zp*R?2GTmhns3fa2QUmmGbXL4;E{V_V+X<=9}i5lE1l(|%mLXU&_ z)`Src4S`Jq>C?{GYOzHtH;F!1YO`lS2_Q60TWZGI{oHE%motWjszTyI^DNfIo^3r= zjn0m=TzQ!CHf2carV5W-VX@l$>13&)L>2`(Su;35-?Vt>mqF_qv?Muk8E>p<6y2TX zZ;#LtDO#NH6#(HO&zZA%WuNkxH%eJetF4|s8B@y>!kc2WLwBhAno9?|+#LPBgMCp5 zRQET-b{DpKwT^?^i&aIIgR2A)HT4n;1ePgKmlP6s)v7&^I$YMPrdtI0AwtGrFIf{+L(}? zEDr;3EyWID$!oj4Ui-vHTYT|Jo73U@P)PR%p!>MPY@7v6dk}oPM5F4qN(_h$gYq>l zy@0SWotnzVVfUb@B{c+nb0nWK=8)6G%}hFbM@b^%C;TW+FEQpL<#_Ym-rAmY{K8B* zt1~+X&t}BJLX;`Xdt_S1ike@%7qq*@`@~bZWC_zHO4U`Fig|ThLl2))bu#Fbi`CIF z0W>NUUZz~)y!i{Etqr&pp5l=8tYPSE z4RBwUa$Fj_rHNu8NkP?eFud7Dej@dVev3{S8m7>$fpv6LUA}9x`$mFpKc*YCyNNHBRVFfJb+u|>15;+JvMD_O^qN6w|l_g|7+{&qpGU1 zc!vj456BM)1<_u9rxEwwbMBYv=px0`5?VQ>vS>p5pvKUYj4-`}PRz2>Q6J8A$d)=v z$ii}1Ko86$QAg80plOYhP4-x;CFQav$LUFs!|d~b_uf6b%Rk)BIcNXQ-uvvmA8__A z_^Pe@zT}oc8cP?$uU0v6EYSa4fQcwPF z@57S2>Db3#eDUq^2mg8B)xWk@?5?>`({S%Ao4%~iK9-re^6R;Oi`|s&>uyQ<^sS2b z&qvpc3Ea){x70ndWn}Wl7qg}`jeKD9h6kTiCXSy`RlMfu)ys}{6kL0^>GC!!+t>a1 zm-$PN4*5sUpSxBb+Wx_G_FTibjE9pSX;l`V&MaPWqVcq!O-euC`cmDif4Y*JP~M%{ zI6H6QxYLzme0jAO&#Of%Ph7~KbZ^e^i~8D@l&xjMQ}fB1)?0x+dkeZYjr_VZ>3rt9 zU1q{_&+pk6mlIR!-51yXo4;gqHQ&DYhZjGyHfsmd3nyM0l=4#2wgV}LUXIV*_Kd$a zC(c*^%}=O{Rs>{_i`#*+xD~s!ohMx6rlY`L>jE_b>6674F~u`m9`q_@8>bxn}3fmv|ubSe!T2?*!QtuP7#s4{b=FG&V zuh#$j*6d+p<8NMBHDYV^xZZR2`qar~JZ$SHW`0yR~Pu{zwL)n(mo zizBIaNfa3!1ut>&gxPP$kb8ny>=+l>q|%= z&yvKxA|sIqj1YpM_K7>mShy|?Ff2WIhgpEZrNp~aPn+h>_;u!@x$|a0ySDzS3-g}H zS(H5=-utWFELgZ;-uyZ6E~=np?eZ0F$s-$*TM9iMO;xGtS>frY**gZ4>6Q#lF@r-q zMFT&8W^jOvKVh0K^Ku~qP33h81R9i0K{S(sOq}BknFjd|j$~p`X3rTyCRqrQp+lcf zaS6jjkW7h}197r4WnRKXpizb(nJO+Hf{gq5T9PD7a3~x^PSZ3@Gmv6r3HqXnb7h&q(cn*Lb279$MeE6oDi#{3YNA$U zS?9HXgar+5(@q-v;uDQipk1ptjzTxrewsC4iZWxo3X*d{rXpLAnPv=34$n1^Daz~@ zB%?xo4<`>xl2xcw;v@nMs_-D1%B!9@0jfF%tr{vGXJYYduw@VEAD*zDG{r=dHHHqA ztf|n6R-CI-Ofz((cU=nGk=5@BK*bsozfK2^Nf@Bcczp>cXk88IGo%t-XUH&h1Azvo zB=I6P&IJvCgJ@JnhGZ}VT9H&<3Cgja0u`Px&E&pxsdJ!$EnQJeiL_{YhM$>_8wa3aNxLuXDVs#Re+5{9B0$aEA94t|iY6}B-&qy5APnhrz} zpl^@D8<5RKW*IG#n4ZJRlrK0POQq)HE<^6FSWbjF}`MpUNOO zI7|X|#NbOjm<+-p9%tcr$RvZ8PvK7pHItyfxJZLwDrz6j9VURpTN+BqJra&uq5j7lV1V#amjK)F2B+{sa zaw7(A7O8|%3mtI=0FkIE#4p4Iy2B%yiPwYpj~GK3?o(5Q|AO0Y&^2Dr9YiI>7=i-= z$PDCQ88fv=QS+5yIp@jY@@J4KpaoTi!VQC>O-LoGj$$cO4U|zZ4fu$g(_|Ip$qXco zb__QGk$q??3JV|@l)^$)v|7^)SyaDfNJwZJcyX@P@eU@2 hiR?}@A>FVGN0GEBL$b?9kx6dI^xWge&(6+r{~zz^nO6V+ diff --git a/retropikzel/pffi.sld b/retropikzel/pffi.sld index 229e9b9..200c0c0 100644 --- a/retropikzel/pffi.sld +++ b/retropikzel/pffi.sld @@ -1,14 +1,15 @@ (define-library - (retropikzel pffi) + (retropikzel pffi) ; (foreign r7rs)? (foreign c)? (cond-expand (chibi - (import (scheme base) + (import (except (scheme base) bytevector-copy!) (scheme write) (scheme char) (scheme file) (scheme process-context) (chibi ast) - (chibi)) + (chibi) + (r6rs bytevectors)) (include-shared "pffi/chibi-pffi")) (chicken (import (scheme base) @@ -21,7 +22,8 @@ (chicken locative) (chicken syntax) (chicken memory) - (chicken random))) + (chicken random) + (r6rs bytevectors))) (cyclone (import (scheme base) (scheme write) @@ -29,14 +31,16 @@ (scheme file) (scheme process-context) (cyclone foreign) - (scheme cyclone primitives))) + (scheme cyclone primitives) + (r6rs bytevectors))) (gambit (import (scheme base) (scheme write) (scheme char) (scheme file) (scheme process-context) - (only (gambit) c-declare c-lambda c-define define-macro))) + (only (gambit) c-declare c-lambda c-define define-macro) + (r6rs bytevectors))) (gauche (import (scheme base) (scheme write) @@ -44,29 +48,32 @@ (scheme file) (scheme process-context) (gauche base) - (retropikzel pffi gauche))) + (retropikzel pffi gauche) + (r6rs bytevectors))) (gerbil (import (scheme base) (scheme write) (scheme char) (scheme file) - (scheme process-context))) + (scheme process-context) + (r6rs bytevectors))) (guile (import (scheme base) (scheme write) (scheme char) (scheme file) (scheme process-context) - (rnrs bytevectors) (system foreign) (system foreign-library) - (only (guile) include-from-path))) + (only (guile) include-from-path) + (rnrs bytevectors))) (kawa - (import (scheme base) + (import (except (scheme base) bytevector-copy bytevector-copy!) (scheme write) (scheme char) (scheme file) - (scheme process-context))) + (scheme process-context) + (r6rs bytevectors))) (larceny (import (scheme base) (scheme write) @@ -77,14 +84,16 @@ (primitives std-ffi) (primitives foreign-procedure) (primitives foreign-file) - (primitives foreign-stdlib))) + (primitives foreign-stdlib) + (r6rs bytevectors))) (mosh - (import (scheme base) + (import (except (scheme base) bytevector-copy!) (scheme write) (scheme char) (scheme file) (scheme process-context) - (mosh ffi))) + (mosh ffi) + (r6rs bytevectors))) (racket (import (scheme base) (scheme write) @@ -95,37 +104,87 @@ (ffi winapi) (compatibility mlist) (ffi unsafe) - (ffi vector))) + (ffi vector) + (except (r6rs bytevectors) bytevector-copy!))) (sagittarius (import (scheme base) (scheme write) (scheme char) (scheme file) (scheme process-context) - (sagittarius ffi) - (sagittarius))) + (except (sagittarius ffi) c-free c-malloc) + (sagittarius) + (r6rs bytevectors))) (skint (import (scheme base) (scheme write) (scheme char) (scheme file) - (scheme process-context))) + (scheme process-context) + (r6rs bytevectors))) (stklos (import (scheme base) (scheme write) (scheme char) (scheme file) (scheme process-context) - (stklos)) + (only (stklos) + make-external-function + allocate-bytes + free-bytes + cpointer? + cpointer-null? + cpointer-data + cpointer-data-set! + pointer-set-c-int8_t! + pointer-ref-c-int8_t + pointer-set-c-uint8_t! + pointer-ref-c-uint8_t + pointer-set-c-int16_t! + pointer-ref-c-int16_t + pointer-set-c-uint16_t! + pointer-ref-c-uint16_t + pointer-set-c-int32_t! + pointer-ref-c-int32_t + pointer-set-c-uint32_t! + pointer-ref-c-uint32_t + pointer-set-c-int64_t! + pointer-ref-c-int64_t + pointer-set-c-uint64_t! + pointer-ref-c-uint64_t + pointer-set-c-char! + pointer-ref-c-char + pointer-set-c-short! + pointer-ref-c-short + pointer-set-c-unsigned-short! + pointer-ref-c-unsigned-short + pointer-set-c-int! + pointer-ref-c-int + pointer-set-c-unsigned-int! + pointer-ref-c-unsigned-int + pointer-set-c-long! + pointer-ref-c-long + pointer-set-c-unsigned-long! + pointer-ref-c-unsigned-long + pointer-set-c-float! + pointer-ref-c-float + pointer-set-c-double! + pointer-ref-c-double + pointer-set-c-pointer! + pointer-ref-c-pointer + void?) + (r6rs bytevectors)) (export make-external-function calculate-struct-size-and-offsets - struct-make)) + struct-make + pffi:string-split)) (tr7 (import (scheme base) (scheme write) (scheme char) (scheme file) - (scheme process-context))) + (scheme process-context) + (r6rs bytevectors))) (ypsilon (import (scheme base) (scheme write) @@ -134,42 +193,67 @@ (scheme process-context) (ypsilon c-ffi) (ypsilon c-types) - (only (core) define-macro syntax-case)))) - (export pffi-init - pffi-size-of - pffi-type? - pffi-align-of - pffi-define-library - pffi-pointer-null - pffi-pointer-null? - pffi-pointer-allocate - pffi-pointer-address - pffi-pointer? - pffi-pointer-free - pffi-pointer-set! - pffi-pointer-get - pffi-string->pointer - pffi-pointer->string - pffi-define-struct - pffi-struct-pointer - pffi-struct-offset-get - pffi-struct-get - pffi-struct-set! - pffi-array-allocate - pffi-array-pointer - pffi-array? - pffi-pointer->array - pffi-array-get - pffi-array-set! - pffi-list->array - pffi-array->list - pffi-define-function - pffi-define-callback) + (only (core) define-macro syntax-case) + (except (rnrs bytevectors) + bytevector-copy! + bytevector-copy + string->utf8 + utf8->string)))) + (export ;; Primitives + c-size-of + define-c-library + define-c-procedure + ;pffi-define-callback; define-c-callback (?) + c-bytevector? + pffi-pointer-set!;c-bytevector-u8-set! and so on + pffi-pointer-get;c-bytevector-u8-ref and so on + + ;; c-bytevector + make-c-bytevector + c-bytevector ;; TODO Documentation, Testing + make-c-null + c-null? + c-free + c-bytevector-string-length ;; TODO Documentation, Testing + bytevector->c-bytevector + c-bytevector->bytevector + call-with-address-of-c-bytevector ;; Todo Documentation + string->c-bytevector + c-bytevector->string + + ;c-bytevector-u8-ref ;; TODO Documentation, Testing + + ;; c-struct + pffi-define-struct;define-c-struct + pffi-struct-pointer;c-struct-bytevector + pffi-struct-offset-get;c-struct-offset + pffi-struct-set!;c-struct-set! + pffi-struct-get;c-struct-get + + ;; c-array + ;define-c-array (?) + pffi-array-allocate;make-c-array + pffi-array-pointer;c-array-pointer + pffi-array?;c-array? + pffi-pointer->array;c-bytevector->array + pffi-array-get;c-array-get + pffi-array-set!;c-array-set! + pffi-list->array;list->c-array + pffi-array->list;c-array->list + + ;; c-variable + ;define-c-variable (?) + ) (cond-expand (chibi (include "pffi/chibi.scm")) - (chicken-5 (include "pffi/chicken.scm")) + (chicken-5 (export foreign-declare + foreign-safe-lambda + void) + (include "pffi/chicken.scm")) (chicken-6 (include-relative "pffi/chicken.scm")) - (cyclone (include "pffi/cyclone.scm")) + (cyclone (export calculate-struct-size-and-offsets + struct-make) + (include "pffi/cyclone.scm")) (gambit (include "pffi/gambit.scm")) (gauche (include "pffi/gauche.scm")) (gerbil (include "pffi/gerbil.scm")) @@ -182,14 +266,14 @@ (skint (include "pffi/skint.scm")) (stklos (include "pffi/stklos.scm")) (tr7 (include "pffi/tr7.scm")) - (ypsilon (include "pffi/ypsilon.scm"))) - ;(include "pffi/shared/union.scm") + (ypsilon (export c-function) + (include "pffi/ypsilon.scm"))) (cond-expand (chicken-6 (include-relative "pffi/shared/main.scm") - (include-relative "pffi/shared/pointer.scm") - (include-relative "pffi/shared/array.scm") - (include-relative "pffi/shared/struct.scm")) + (include-relative "pffi/shared/pointer.scm") + (include-relative "pffi/shared/array.scm") + (include-relative "pffi/shared/struct.scm")) (else (include "pffi/shared/main.scm") + (include "pffi/shared/struct.scm") (include "pffi/shared/pointer.scm") - (include "pffi/shared/array.scm") - (include "pffi/shared/struct.scm")))) + (include "pffi/shared/array.scm")))) diff --git a/retropikzel/pffi/chibi-src/pffi.stub b/retropikzel/pffi/chibi-src/pffi.stub index 7354e47..e46001a 100644 --- a/retropikzel/pffi/chibi-src/pffi.stub +++ b/retropikzel/pffi/chibi-src/pffi.stub @@ -4,7 +4,7 @@ (c-system-include "dlfcn.h") (c-system-include "ffi.h") -;; pffi-size-of +;; c-size-of (c-declare " int size_of_int8_t() { return sizeof(int8_t); } int size_of_uint8_t() { return sizeof(uint8_t); } @@ -47,7 +47,7 @@ (define-c int (size-of-double size_of_double) ()) (define-c int (size-of-pointer size_of_pointer) ()) -;; pffi-shape-object-load +;; pffi-shared-object-load (define-c-const int (RTLD-NOW "RTLD_NOW")) (define-c (maybe-null pointer void*) dlopen (string int)) (define-c (maybe-null pointer void*) dlerror ()) @@ -70,10 +70,10 @@ }") (define-c sexp (pointer? is_pointer) (sexp)) -(c-declare "intptr_t pointer_address(struct sexp_struct* pointer) { - return (intptr_t)&sexp_cpointer_value(pointer); +(c-declare "void* pointer_address(struct sexp_struct* pointer) { + return (void*)&sexp_cpointer_value(pointer); }") -(define-c uint32_t (pointer-address pointer_address) (sexp)) +(define-c (maybe-null pointer void*) (pointer-address pointer_address) (sexp)) (c-declare "void pointer_free(void* pointer) { free(pointer); }") (define-c void (pointer-free pointer_free) ((maybe-null pointer void*))) @@ -99,8 +99,8 @@ (c-declare "void pointer_set_c_uint64_t(void* pointer, int offset, uint64_t value) { *(uint64_t*)((char*)pointer + offset) = value; }") (define-c void (pointer-set-c-uint64_t! pointer_set_c_uint64_t) ((pointer void*) int uint64_t)) -(c-declare "void pointer_set_c_char(void* pointer, int offset, char value) { *((char*)pointer + offset) = value; }") -(define-c void (pointer-set-c-char! pointer_set_c_char) ((pointer void*) int char)) +(c-declare "void pointer_set_c_char(void* pointer, int offset, int8_t value) { *((char*)pointer + offset) = value; }") +(define-c void (pointer-set-c-char! pointer_set_c_char) ((pointer void*) int int8_t)) (c-declare "void pointer_set_c_unsigned_char(void* pointer, int offset, unsigned char value) { *(unsigned char*)((char*)pointer + offset) = value; }") (define-c void (pointer-set-c-unsigned-char! pointer_set_c_unsigned_char) ((pointer void*) int unsigned-char)) @@ -149,8 +149,8 @@ (c-declare "uint64_t pointer_ref_c_uint64_t(void* pointer, int offset) { return *(uint64_t*)((char*)pointer + offset); }") (define-c uint64_t (pointer-ref-c-uint64_t pointer_ref_c_uint64_t) ((pointer void*) int)) -(c-declare "char pointer_ref_c_char(void* pointer, int offset) { return *(char*)((char*)pointer + offset); }") -(define-c char (pointer-ref-c-char pointer_ref_c_char) ((pointer void*) int)) +(c-declare "int8_t pointer_ref_c_char(void* pointer, int offset) { return *(char*)((char*)pointer + offset); }") +(define-c int8_t (pointer-ref-c-char pointer_ref_c_char) ((pointer void*) int)) (c-declare "unsigned char pointer_ref_c_unsigned_char(void* pointer, int offset) { return *(unsigned char*)((char*)pointer + offset); }") (define-c unsigned-char (pointer-ref-c-unsigned-char pointer_ref_c_unsigned_char) ((pointer void*) int)) @@ -178,15 +178,7 @@ (c-declare "void* pointer_ref_c_pointer(void* pointer, int offset) { char* p = (char*)pointer + offset; return *(char**)p; }") (define-c (maybe-null pointer void*) (pointer-ref-c-pointer pointer_ref_c_pointer) ((pointer void*) int)) -;; pffi-string->pointer -;(c-declare "void* string_to_pointer(char* string) { return (void*)string; }") -;(define-c (maybe-null pointer void*) (string-to-pointer string_to_pointer) (string)) - -;; pffi-pointer->string -;(c-declare "char* pointer_to_string(void* pointer) { return (char*)pointer; }") -;(define-c string (pointer-to-string pointer_to_string) ((maybe-null pointer void*))) - -;; pffi-define-function +;; define-c-procedure (c-declare "ffi_cif cif;") (define-c (pointer void*) dlsym ((maybe-null pointer void*) string)) diff --git a/retropikzel/pffi/chibi.scm b/retropikzel/pffi/chibi.scm index c914484..2915a5c 100644 --- a/retropikzel/pffi/chibi.scm +++ b/retropikzel/pffi/chibi.scm @@ -29,32 +29,22 @@ (lambda (path options) (let ((shared-object (dlopen path RTLD-NOW)) (maybe-error (dlerror))) - (when (not (pffi-pointer-null? maybe-error)) - (error (pffi-pointer->string maybe-error))) + #;(when (not (pffi-pointer-null? maybe-error)) + (error (c-bytevector->string maybe-error))) shared-object))) -(define pffi-pointer-null - (lambda () - (pointer-null))) - -(define pffi-pointer-null? - (lambda (pointer) - (not pointer))) ; #f is null on Chibi - -(define pffi-pointer? +(define c-bytevector? (lambda (object) (or (equal? object #f) ; False can be null pointer (pointer? object)))) -(define pffi-pointer-allocate - (lambda (size) - (pointer-allocate size))) +(define make-c-bytevector + (lambda (k . byte) + (if (null? byte) + (pointer-allocate k) + (bytevector->c-bytevector (make-bytevector k byte))))) -(define pffi-pointer-address - (lambda (pointer) - (pointer-address pointer))) - -(define pffi-pointer-free +(define c-free (lambda (pointer) (pointer-free pointer))) @@ -68,7 +58,7 @@ ((equal? type 'uint32) (pointer-set-c-uint32_t! pointer offset value)) ((equal? type 'int64) (pointer-set-c-int64_t! pointer offset value)) ((equal? type 'uint64) (pointer-set-c-uint64_t! pointer offset value)) - ((equal? type 'char) (pointer-set-c-char! pointer offset value)) + ((equal? type 'char) (pointer-set-c-char! pointer offset (char->integer value))) ((equal? type 'short) (pointer-set-c-short! pointer offset value)) ((equal? type 'unsigned-short) (pointer-set-c-unsigned-short! pointer offset value)) ((equal? type 'int) (pointer-set-c-int! pointer offset value)) @@ -90,7 +80,7 @@ ((equal? type 'uint32) (pointer-ref-c-uint32_t pointer offset)) ((equal? type 'int64) (pointer-ref-c-int64_t pointer offset)) ((equal? type 'uint64) (pointer-ref-c-uint64_t pointer offset)) - ((equal? type 'char) (pointer-ref-c-char pointer offset)) + ((equal? type 'char) (integer->char (pointer-ref-c-char pointer offset))) ((equal? type 'short) (pointer-ref-c-short pointer offset)) ((equal? type 'unsigned-short) (pointer-ref-c-unsigned-short pointer offset)) ((equal? type 'int) (pointer-ref-c-int pointer offset)) @@ -102,14 +92,6 @@ ((equal? type 'void) (pointer-ref-c-pointer pointer offset)) ((equal? type 'pointer) (pointer-ref-c-pointer pointer offset))))) -#;(define pffi-string->pointer - (lambda (string-content) - (string-to-pointer string-content))) - -#;(define pffi-pointer->string - (lambda (pointer) - (pointer-to-string pointer))) - (define pffi-type->native-type (lambda (type) (cond ((equal? type 'int8) 'int8_t) @@ -136,7 +118,7 @@ ((equal? type 'callback) '(maybe-null void*)) (else (error "pffi-type->native-type -- No such pffi type" type))))) -;; pffi-define-function +;; define-c-procedure (define pffi-type->libffi-type (lambda (type) @@ -166,7 +148,7 @@ (define argument->pointer (lambda (value type) (cond ((procedure? value) (scheme-procedure-to-pointer value)) - (else (let ((pointer (pffi-pointer-allocate (size-of-type type)))) + (else (let ((pointer (make-c-bytevector (size-of-type type)))) (pffi-pointer-set! pointer type 0 value) pointer))))) @@ -175,10 +157,10 @@ (dlerror) ;; Clean all previous errors (let ((c-function (dlsym shared-object c-name)) (maybe-dlerror (dlerror))) - (when (not (pffi-pointer-null? maybe-dlerror)) - (error (pffi-pointer->string maybe-dlerror))) + #;(when (not (pffi-pointer-null? maybe-dlerror)) + (error (c-bytevector->string maybe-dlerror))) (lambda arguments - (let ((return-value (pffi-pointer-allocate + (let ((return-value (make-c-bytevector (if (equal? return-type 'void) 0 (size-of-type return-type))))) @@ -193,7 +175,7 @@ (cond ((not (equal? return-type 'void)) (pffi-pointer-get return-value return-type 0)))))))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (define scheme-name diff --git a/retropikzel/pffi/chicken.scm b/retropikzel/pffi/chicken.scm index 370180e..af795b2 100644 --- a/retropikzel/pffi/chicken.scm +++ b/retropikzel/pffi/chicken.scm @@ -25,11 +25,11 @@ ((equal? type 'struct) 'c-pointer) (else (error "pffi-type->native-type -- No such pffi type" type)))) ) -(define pffi-pointer? +(define c-bytevector? (lambda (object) (pointer? object))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (er-macro-transformer (lambda (expr rename compare) (let* ((pffi-type->native-type ; Chicken has this procedure in three places @@ -136,18 +136,17 @@ ((equal? type 'string) (foreign-value "sizeof(void*)" int)) ((equal? type 'callback) (foreign-value "sizeof(void*)" int))))) -#;(define pffi-pointer-allocate - (lambda (size) - (allocate size))) - -(define pffi-pointer-address - (lambda (pointer) - (pointer->address pointer))) - -(define pffi-pointer-null +(define make-c-null (lambda () (address->pointer 0))) +(define-syntax define-c-library + (syntax-rules () + ((_ scheme-name headers object-name options) + (begin + (define scheme-name #t) + (pffi-shared-object-load headers))))) + (define-syntax pffi-shared-object-load (er-macro-transformer (lambda (expr rename compare) @@ -158,13 +157,7 @@ `(foreign-declare ,(string-append "#include <" header ">"))) headers)))))) -#;(define pffi-pointer-free - (lambda (pointer) - (if (not (pointer? pointer)) - (error "pffi-pointer-free -- Argument is not pointer" pointer)) - (free pointer))) - -(define pffi-pointer-null? +(define c-null? (lambda (pointer) (if (and (not (pointer? pointer)) pointer) @@ -215,8 +208,3 @@ ((equal? type 'float) (pointer-f32-ref (pointer+ pointer offset))) ((equal? type 'double) (pointer-f64-ref (pointer+ pointer offset))) ((equal? type 'pointer) (address->pointer (pointer-u64-ref (pointer+ pointer offset))))))) - -(define pffi-struct-dereference - (lambda (struct) - (pffi-pointer-address (pffi-struct-pointer struct)))) - diff --git a/retropikzel/pffi/cyclone.scm b/retropikzel/pffi/cyclone.scm index 6948847..05d00b8 100644 --- a/retropikzel/pffi/cyclone.scm +++ b/retropikzel/pffi/cyclone.scm @@ -23,23 +23,23 @@ ((equal? type 'struct) 'c-pointer) (else (error "pffi-type->native-type -- No such pffi type" type))))) -(define pffi-pointer? +(define c-bytevector? (lambda (object) (opaque? object))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (er-macro-transformer (lambda (expr rename compare) (let* ((pffi-type->native-type (lambda (type) - (cond ((equal? type 'int8) 'byte) - ((equal? type 'uint8) 'unsigned-byte) - ((equal? type 'int16) 'int16_t) - ((equal? type 'uint16) 'uint16_t) - ((equal? type 'int32) 'int32) - ((equal? type 'uint32) 'unsigned-int32) - ((equal? type 'int64) 'integer-64) - ((equal? type 'uint64) 'unsigned-integer64) + (cond ((equal? type 'int8) 'int) + ((equal? type 'uint8) 'int) + ((equal? type 'int16) 'int) + ((equal? type 'uint16) 'int) + ((equal? type 'int32) 'int) + ((equal? type 'uint32) 'int) + ((equal? type 'int64) 'int) + ((equal? type 'uint64) 'int) ((equal? type 'char) 'char) ((equal? type 'unsigned-char) 'unsigned-char) ((equal? type 'short) 'short) @@ -50,22 +50,21 @@ ((equal? type 'unsigned-long) 'unsigned-long) ((equal? type 'float) 'float) ((equal? type 'double) 'double) - ((equal? type 'pointer) 'c-pointer) - ((equal? type 'void) 'void) - ((equal? type 'struct) 'c-pointer) + ((equal? type 'pointer) 'opaque) + ((equal? type 'void) 'c-void) (else (error "pffi-type->native-type -- No such pffi type" type))))) - (scheme-name (car (cdr expr))) + (scheme-name (cadr expr)) (c-name (symbol->string (car (cdr (car (cdr (cdr (cdr expr)))))))) (return-type (pffi-type->native-type (car (cdr (car (cdr (cdr (cdr (cdr expr))))))))) (argument-types - (let ((types (cdr (car (cdr (cdr (cdr (cdr (cdr expr))))))))) + (let ((types (cadr (car (cdr (cdr (cdr (cdr (cdr expr))))))))) (if (null? types) '() - (map pffi-type->native-type (map car (map cdr types))))))) + (map pffi-type->native-type types))))) (if (null? argument-types) `(c-define ,scheme-name ,return-type ,c-name) `(c-define ,scheme-name - ,return-type ,c-name ,@ argument-types)))))) + ,return-type ,c-name ,@argument-types)))))) (define pffi-define-callback (lambda (scheme-name return-type argument-types procedure) @@ -93,38 +92,31 @@ ((equal? type 'double) (c-value "sizeof(double)" int)) ((equal? type 'pointer) (c-value "sizeof(void*)" int))))) -#;(define-c pffi-pointer-allocate - "(void *data, int argc, closure _, object k, object size)" - "make_c_opaque(opq, malloc(obj_obj2int(size))); +(define-c pffi-pointer-address + "(void *data, int argc, closure _, object k, object pointer)" + "make_c_opaque(opq, &(void*)opaque_ptr(pointer)); return_closcall1(data, k, &opq);") (define pffi-pointer-null (lambda () (make-opaque))) -#;(define-c pffi-string->pointer - "(void *data, int argc, closure _, object k, object s)" - "make_c_opaque(opq, string_str(s)); - return_closcall1(data, k, &opq);") - -#;(define-c pffi-pointer->string - "(void *data, int argc, closure _, object k, object p)" - "make_string(s, opaque_ptr(p)); - return_closcall1(data, k, &s);") +(define-syntax define-c-library + (syntax-rules () + ((_ scheme-name headers object-name options) + (begin + (define scheme-name #t) + (pffi-shared-object-load headers))))) (define-syntax pffi-shared-object-load (er-macro-transformer (lambda (expr rename compare) - `(begin - ,@ (map - (lambda (header) - `(include-c-header ,(string-append "<" header ">"))) - (cdr (car (cdr expr)))))))) - -#;(define-c pffi-pointer-free - "(void *data, int argc, closure _, object k, object pointer)" - "free(opaque_ptr(pointer)); - return_closcall1(data, k, make_boolean(boolean_t));") + (let* ((headers (cadr (cadr expr))) + (includes (map + (lambda (header) + `(include-c-header ,(string-append "<" header ">"))) + headers))) + `(,@includes))))) (define pffi-pointer-null? (lambda (pointer) diff --git a/retropikzel/pffi/gambit.scm b/retropikzel/pffi/gambit.scm index b7aef6c..3c2d145 100644 --- a/retropikzel/pffi/gambit.scm +++ b/retropikzel/pffi/gambit.scm @@ -1,11 +1,6 @@ (c-declare "#include ") (c-declare "#include ") -(define-macro - (pffi-init) - `(begin (c-define-type pointer (pointer void)) - (c-define-type callback (pointer void)))) - (define size-of-int8_t (c-lambda () int "___return(sizeof(int8_t));")) (define size-of-uint8_t (c-lambda () int "___return(sizeof(uint8_t));")) (define size-of-int16_t (c-lambda () int "___return(sizeof(int16_t));")) @@ -52,16 +47,18 @@ (else (error "Can not get size of unknown type" type))))) (define-macro - (pffi-define-library name headers object-name . options) - `(begin (define ,name #t) - (c-declare ,(apply string-append - (map - (lambda (header) - (string-append "#include <" header ">" (string #\newline))) - (cdr headers)))))) + (define-c-library name headers object-name . options) + (begin + (let ((c-code (apply string-append + (map + (lambda (header) + (string-append "#include <" header ">" (string #\newline))) + (car (cdr headers)))))) + `(begin (define ,name #t) (c-declare ,c-code))))) + (define pointer? (c-lambda ((pointer void)) bool "___return(1);")) -(define pffi-pointer? +(define c-bytevector? (lambda (object) (call-with-current-continuation (lambda (k) @@ -69,20 +66,6 @@ (lambda (x) #f) (lambda () (pointer? object))))))) -(define pffi-pointer-null (c-lambda () (pointer void) "void* p = NULL; ___return(p);")) - -(define pointer-null? (c-lambda ((pointer void)) bool "if(___arg1 == NULL) { ___return(1); } else { ___return(0); }")) -(define pffi-pointer-null? - (lambda (pointer) - (and (pffi-pointer? pointer) - (pointer-null? pointer)))) - -;(define pffi-pointer-allocate (c-lambda (int) (pointer void) "void* p = malloc(___arg1); ___return(p);")) - -(define pffi-pointer-address (c-lambda ((pointer void)) ptrdiff_t "void* p = ___arg1; ___return((intptr_t)&p);")) - -;(define pffi-pointer-free (c-lambda ((pointer void)) void "free(___arg1);")) - (define pointer-set-c-int8_t! (c-lambda ((pointer void) int int8) void "*(int8_t*)((char*)___arg1 + ___arg2) = ___arg3;")) (define pointer-set-c-uint8_t! (c-lambda ((pointer void) int unsigned-int8) void "*(uint8_t*)((char*)___arg1 + ___arg2) = ___arg3;")) (define pointer-set-c-int16_t! (c-lambda ((pointer void) int int16) void "*(int16_t*)((char*)___arg1 + ___arg2) = ___arg3;")) @@ -167,31 +150,57 @@ ((equal? type 'pointer) (pointer-ref-c-pointer pointer offset))))) (define-macro - (pffi-define-function scheme-name shared-object c-name return-type argument-types) - (letrec* ((native-argument-types - (if (equal? '(list) argument-types) - (list) - (let ((types (map cdr (cdr argument-types)))) - (if (null? types) types (map car types))))) - (native-return-type (car (cdr return-type))) - (c-arguments (lambda (index argument-count result) - (if (> index argument-count) - result - (c-arguments (+ index 1) - argument-count - (string-append result - "___arg" - (number->string index) - (if (< index argument-count) - ", " - "")))))) - (c-code (string-append - (if (equal? 'void (cadr return-type)) "" "___return(") - (symbol->string (cadr c-name)) - "(" (c-arguments 1 (- (length argument-types) 1) "") ")" - (if (equal? 'void (cadr return-type)) "" ")") - ";"))) - `(define ,scheme-name - (c-lambda ,native-argument-types - ,native-return-type - ,c-code)))) + (define-c-procedure scheme-name shared-object c-name return-type argument-types) + (begin + (letrec* ((pffi-type->native-type + (lambda (type) + (cond ((equal? type 'int8) 'byte) + ((equal? type 'uint8) 'unsigned-int8) + ((equal? type 'int16) 'int16_t) + ((equal? type 'uint16) 'uint16_t) + ((equal? type 'int32) 'int32) + ((equal? type 'uint32) 'unsigned-int32) + ((equal? type 'int64) 'int64) + ((equal? type 'uint64) 'unsigned-int64) + ((equal? type 'char) 'char) + ((equal? type 'unsigned-char) 'unsigned-char) + ((equal? type 'short) 'short) + ((equal? type 'unsigned-short) 'unsigned-short) + ((equal? type 'int) 'int) + ((equal? type 'unsigned-int) 'unsigned-int) + ((equal? type 'long) 'long) + ((equal? type 'unsigned-long) 'unsigned-long) + ((equal? type 'float) 'float) + ((equal? type 'double) 'double) + ((equal? type 'pointer) '(pointer void)) + ((equal? type 'void) 'void) + ((equal? type 'callback) 'c-pointer) + ((equal? type 'struct) 'c-pointer) + (else (error "pffi-type->native-type -- No such pffi type" type))))) + (native-argument-types + (if (equal? '(list) argument-types) + (list) + (let ((types (map pffi-type->native-type (cadr argument-types)))) + (if (null? types) types types)))) + (native-return-type (pffi-type->native-type (cadr return-type))) + (argument-count (length native-argument-types)) + (c-arguments (lambda (index result) + (if (>= index argument-count) + result + (c-arguments (+ index 1) + (string-append result + "___arg" + (number->string (+ index 1)) + (if (<= index (- argument-count 2)) + ", " + "")))))) + (c-code (string-append + (if (equal? 'void (cadr return-type)) "" "___return(") + (symbol->string (cadr c-name)) + "(" (c-arguments 0 "") ")" + (if (equal? 'void (cadr return-type)) "" ")") + ";"))) + `(define ,scheme-name + (c-lambda ,native-argument-types + ,native-return-type + ,c-code))))) diff --git a/retropikzel/pffi/gauche-src/gauchelib.scm b/retropikzel/pffi/gauche-src/gauchelib.scm index 403864f..d801f43 100644 --- a/retropikzel/pffi/gauche-src/gauchelib.scm +++ b/retropikzel/pffi/gauche-src/gauchelib.scm @@ -71,8 +71,6 @@ (define-cproc pointer-get-double (pointer offset::) pointer_get_double) (define-cproc pointer-get-pointer (pointer offset::) pointer_get_pointer) - (define-cproc string->pointer (string-content) string_to_pointer) - (define-cproc pointer->string (pointer) pointer_to_string) (define-cproc dlerror () pffi_dlerror) (define-cproc dlsym (shared-object c-name) pffi_dlsym) (define-cproc internal-ffi-call (nargs rtype atypes fn rvalue avalues) internal_ffi_call) diff --git a/retropikzel/pffi/gauche.scm b/retropikzel/pffi/gauche.scm index 3102bbd..ec70147 100644 --- a/retropikzel/pffi/gauche.scm +++ b/retropikzel/pffi/gauche.scm @@ -1,17 +1,15 @@ (define-module retropikzel.pffi.gauche (export size-of-type pffi-shared-object-load - pffi-pointer-null - pffi-pointer-null? - pffi-pointer-allocate + ;pffi-pointer-null + ;pffi-pointer-null? + make-c-bytevector pffi-pointer-address - pffi-pointer? - pffi-pointer-free + c-bytevector? + c-free pffi-pointer-set! pffi-pointer-get - pffi-string->pointer - pffi-pointer->string - pffi-define-function)) + define-c-procedure)) (select-module retropikzel.pffi.gauche) (dynamic-load "retropikzel/pffi/gauche-pffi") @@ -45,27 +43,15 @@ (lambda (path options) (shared-object-load path))) -(define pffi-pointer-null - (lambda () - (pointer-null))) - -(define pffi-pointer-null? - (lambda (pointer) - (pointer-null? pointer))) - -(define pffi-pointer-allocate +(define make-c-bytevector (lambda (size) (pointer-allocate size))) -(define pffi-pointer-address - (lambda (object) - (pointer-address object))) - -(define pffi-pointer? +(define c-bytevector? (lambda (pointer) (pointer? pointer))) -(define pffi-pointer-free +(define c-free (lambda (pointer) (pointer-free pointer))) @@ -141,7 +127,7 @@ (define argument->pointer (lambda (value type) (cond ((procedure? value) (scheme-procedure-to-pointer value)) - (else (let ((pointer (pffi-pointer-allocate (size-of-type type)))) + (else (let ((pointer (make-c-bytevector (size-of-type type)))) (pffi-pointer-set! pointer type 0 value) pointer))))) @@ -150,10 +136,10 @@ (dlerror) ;; Clean all previous errors (let ((c-function (dlsym shared-object c-name)) (maybe-dlerror (dlerror))) - (when (not (pffi-pointer-null? maybe-dlerror)) - (error (pffi-pointer->string maybe-dlerror))) + #;(when (not (pffi-pointer-null? maybe-dlerror)) + (error (c-bytevector->string maybe-dlerror))) (lambda arguments - (let ((return-value (pffi-pointer-allocate + (let ((return-value (make-c-bytevector (if (equal? return-type 'void) 0 (size-of-type return-type))))) @@ -168,7 +154,7 @@ (cond ((not (equal? return-type 'void)) (pffi-pointer-get return-value return-type 0)))))))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (define scheme-name diff --git a/retropikzel/pffi/gerbil.scm b/retropikzel/pffi/gerbil.scm index cd726ad..a780a83 100644 --- a/retropikzel/pffi/gerbil.scm +++ b/retropikzel/pffi/gerbil.scm @@ -2,11 +2,11 @@ (lambda (type) (error "Not defined"))) -(define pffi-pointer? +(define c-bytevector? (lambda (object) (error "Not defined"))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (error "Not defined")))) @@ -15,34 +15,10 @@ (lambda (type) (error "Not defined"))) -(define pffi-pointer-allocate - (lambda (size) - (error "Not defined"))) - -(define pffi-pointer-null - (lambda () - (error "Not defined"))) - -#;(define pffi-string->pointer - (lambda (string-content) - (error "Not defined"))) - -#;(define pffi-pointer->string - (lambda (pointer) - pointer)) - (define pffi-shared-object-load (lambda (header path) (error "Not defined"))) -(define pffi-pointer-free - (lambda (pointer) - (error "Not defined"))) - -(define pffi-pointer-null? - (lambda (pointer) - (error "Not defined"))) - (define pffi-pointer-set! (lambda (pointer type offset value) (let ((p pointer)) @@ -51,7 +27,3 @@ (define pffi-pointer-get (lambda (pointer type offset) (error "Not defined"))) - -(define pffi-pointer-deref - (lambda (pointer) - (error "Not defined"))) diff --git a/retropikzel/pffi/guile.scm b/retropikzel/pffi/guile.scm index d776977..01d2d21 100644 --- a/retropikzel/pffi/guile.scm +++ b/retropikzel/pffi/guile.scm @@ -25,11 +25,11 @@ ((equal? type 'struct) '*) (else #f)))) -(define pffi-pointer? +(define c-bytevector? (lambda (object) (pointer? object))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (define scheme-name @@ -53,39 +53,10 @@ (native-type (sizeof native-type)) (else #f))))) -#;(define pffi-pointer-allocate - (lambda (size) - (bytevector->pointer (make-bytevector size 0)))) - -(define pffi-pointer-address - (lambda (pointer) - (pointer-address pointer))) - -(define pffi-pointer-null - (lambda () - (make-pointer 0))) - -#;(define pffi-string->pointer - (lambda (string-content) - (string->pointer string-content))) - -#;(define pffi-pointer->string - (lambda (pointer) - (pointer->string pointer))) - (define pffi-shared-object-load (lambda (path options) (load-foreign-library path))) -#;(define pffi-pointer-free - (lambda (pointer) - #t)) - -(define pffi-pointer-null? - (lambda (pointer) - (and (pffi-pointer? pointer) - (null-pointer? pointer)))) - (define pffi-pointer-set! (lambda (pointer type offset value) (let ((p (pointer->bytevector pointer (+ offset 100)))) @@ -106,8 +77,7 @@ ((equal? type 'unsigned-long) (bytevector-u64-set! p offset value (native-endianness))) ((equal? type 'float) (bytevector-ieee-single-set! p offset value (native-endianness))) ((equal? type 'double) (bytevector-ieee-double-set! p offset value (native-endianness))) - ((equal? type 'pointer) (bytevector-sint-set! p offset (pointer-address value) (native-endianness) (size-of-type type))) - ((equal? type 'string) (bytevector-sint-set! p offset (pointer-address (pffi-string->pointer value)) (native-endianness) (size-of-type type))))))) + ((equal? type 'pointer) (bytevector-sint-set! p offset (pointer-address value) (native-endianness) (size-of-type type))))))) (define pffi-pointer-get (lambda (pointer type offset) @@ -129,9 +99,4 @@ ((equal? type 'unsigned-long) (bytevector-u64-ref p offset (native-endianness))) ((equal? type 'float) (bytevector-ieee-single-ref p offset (native-endianness))) ((equal? type 'double) (bytevector-ieee-double-ref p offset (native-endianness))) - ((equal? type 'pointer) (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type)))) - ((equal? type 'string) (pffi-pointer->string (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type))))))))) - -#;(define pffi-struct-dereference - (lambda (struct) - (dereference-pointer (pffi-struct-pointer struct)))) + ((equal? type 'pointer) (make-pointer (bytevector-sint-ref p offset (native-endianness) (size-of-type type)))))))) diff --git a/retropikzel/pffi/kawa.scm b/retropikzel/pffi/kawa.scm index 0ce506b..e9e91c9 100644 --- a/retropikzel/pffi/kawa.scm +++ b/retropikzel/pffi/kawa.scm @@ -54,14 +54,14 @@ ((equal? type 'struct) (invoke (static-field java.lang.foreign.ValueLayout 'ADDRESS) 'withByteAlignment 8)) (else #f)))) -(define pffi-pointer? +(define c-bytevector? (lambda (object) (string=? (invoke (invoke object 'getClass) 'getName) "jdk.internal.foreign.NativeMemorySegmentImpl"))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () - ((pffi-define-function scheme-name shared-object c-name return-type argument-types) + ((_ scheme-name shared-object c-name return-type argument-types) (define scheme-name (lambda vals (invoke (invoke (cdr (assoc 'linker shared-object)) @@ -131,28 +131,10 @@ (invoke native-type 'byteAlignment) #f)))) -#;(define pffi-pointer-allocate - (lambda (size) - (invoke (invoke arena 'allocate size 1) 'reinterpret size))) - -(define pffi-pointer-address - (lambda (pointer) - (invoke pointer 'address))) - -(define pffi-pointer-null +(define make-c-null (lambda () (static-field java.lang.foreign.MemorySegment 'NULL))) -#;(define pffi-string->pointer - (lambda (string-content) - (let ((size (+ (invoke string-content 'length) 1))) - (invoke (invoke arena 'allocateFrom (invoke string-content 'toString)) - 'reinterpret size)))) - -#;(define pffi-pointer->string - (lambda (pointer) - (invoke (invoke pointer 'reinterpret (static-field java.lang.Integer 'MAX_VALUE)) 'getString 0))) - (define pffi-shared-object-load (lambda (path options) (let* ((library-file (make java.io.File path)) @@ -169,11 +151,7 @@ (list (cons 'linker linker) (cons 'lookup lookup))))) -#;(define pffi-pointer-free - (lambda (pointer) - #t)) - -(define pffi-pointer-null? +(define c-null? (lambda (pointer) (invoke pointer 'equals (pffi-pointer-null)))) diff --git a/retropikzel/pffi/larceny.scm b/retropikzel/pffi/larceny.scm index 8f92241..656c792 100644 --- a/retropikzel/pffi/larceny.scm +++ b/retropikzel/pffi/larceny.scm @@ -1,6 +1,4 @@ (require 'std-ffi) -;(require "Standard/foreign-stdlib") -;(require "Lib/Common/system-interface") ;; FIXME (define size-of-type @@ -28,49 +26,12 @@ ((eq? type 'callback) 4) (else (error "Can not get size of unknown type" type))))) -(define c-malloc (foreign-procedure "malloc" '(int) 'void*)) -;(define c-malloc (stdlib/malloc rtd-void*)) -#;(define pffi-pointer-allocate - (lambda (size) - (c-malloc size))) - -#;(define c-free (foreign-procedure "free" '(void*) 'int)) -;(define c-malloc (stdlib/malloc rtd-void*)) -#;(define pffi-pointer-free - (lambda (pointer) - (c-free pointer))) - -(define pffi-pointer-null (lambda () 0)) - -(define pffi-pointer-null? - (lambda (object) - (and (number? object) - (= object 0)))) - -(define pffi-pointer? +(define c-bytevector? (lambda (object) ;(void*? object) (number? object) )) -(define pffi-pointer-address - (lambda (pointer) - ;(void*->address pointer) - pointer - )) - -(define pffi-pointer->string - (lambda (pointer) - ;(char*->string pointer) - pointer - )) - -(define pffi-string->pointer - (lambda (string-content) - ;(string->char* string-content) - string-content - )) - (define pffi-shared-object-load (lambda (headers path . options) (foreign-file path))) @@ -122,7 +83,7 @@ ((equal? type 'void) (%peek-pointer (+ pointer offset))) ((equal? type 'pointer) (%peek-pointer (+ pointer offset)))))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (define scheme-name diff --git a/retropikzel/pffi/mosh.scm b/retropikzel/pffi/mosh.scm index 5a15eca..3395f22 100644 --- a/retropikzel/pffi/mosh.scm +++ b/retropikzel/pffi/mosh.scm @@ -25,33 +25,13 @@ (else #f)))) (define pffi-shared-object-load - (lambda (path . options) + (lambda (path options) (open-shared-library path))) -(define pffi-pointer-null - (lambda () - pointer-null)) - -(define pffi-pointer-null? - (lambda (pointer) - (pointer-null? pointer))) - -#;(define pffi-pointer-allocate - (lambda (size) - (malloc size))) - -(define pffi-pointer-address - (lambda (pointer) - (pointer->integer pointer))) - -(define pffi-pointer? +(define c-bytevector? (lambda (object) (pointer? object))) -#;(define pffi-pointer-free - (lambda (pointer) - (free pointer))) - (define pffi-pointer-set! (lambda (pointer type offset value) (cond ((equal? type 'int8) (pointer-set-c-int8! pointer offset value)) @@ -96,22 +76,6 @@ ((equal? type 'void) (pointer-ref-c-pointer pointer offset)) ((equal? type 'pointer) (pointer-ref-c-pointer pointer offset))))) -#;(define pffi-string->pointer - (lambda (string-content) - (let ((pointer (pffi-pointer-allocate (+ (string-length string-content) 1))) - (index 0)) - (string-for-each - (lambda (c) - (pffi-pointer-set! pointer 'char (* index (size-of-type 'char)) c) - (set! index (+ index 1))) - string-content) - (pffi-pointer-set! pointer 'char (* index (size-of-type 'char)) #\null) - pointer))) - -#;(define pffi-pointer->string - (lambda (pointer) - (pointer->string pointer))) - (define pffi-type->native-type (lambda (type) (cond ((equal? type 'int8) 'int8_t) @@ -139,7 +103,7 @@ ((equal? type 'struct) 'void*) (else (error "pffi-type->native-type -- No such pffi type" type))))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (define scheme-name @@ -155,7 +119,3 @@ (make-c-callback (pffi-type->native-type return-type) (map pffi-type->native-type argument-types) procedure))))) - -#;(define pffi-struct-dereference - (lambda (struct) - (pffi-struct-pointer struct))) diff --git a/retropikzel/pffi/racket.scm b/retropikzel/pffi/racket.scm index e890647..3cfb1f2 100644 --- a/retropikzel/pffi/racket.scm +++ b/retropikzel/pffi/racket.scm @@ -21,15 +21,14 @@ ((equal? type 'pointer) _pointer) ((equal? type 'void) _void) ((equal? type 'callback) _pointer) - ((equal? type 'string) _pointer) ((equal? type 'struct) _pointer) (else #f)))) -(define pffi-pointer? +(define c-bytevector? (lambda (object) (cpointer? object))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (define scheme-name @@ -53,31 +52,6 @@ (ctype-sizeof native-type) #f)))) -#;(define pffi-pointer-allocate - (lambda (size) - (malloc 'raw size))) - -(define pffi-pointer-address - (lambda (pointer) - pointer)) - -(define pffi-pointer-null - (lambda () - #f )) ; #f is the null pointer on racket - -#;(define pffi-string->pointer - (lambda (string-content) - (let* ((size (string-length string-content)) - (pointer (pffi-pointer-allocate (+ size 1)))) - (memmove pointer (cast (string-append string-content "") _string _pointer) (+ size 1)) - pointer))) - -#;(define pffi-pointer->string - (lambda (pointer) - (when (pffi-pointer-null? pointer) - (error "Can not make string from null pointer" pointer)) - (string-copy (cast pointer _pointer _string)))) - (define pffi-shared-object-load (lambda (path options) (if (and (not (null? options)) @@ -87,14 +61,6 @@ (list #f)))) (ffi-lib path)))) -#;(define pffi-pointer-free - (lambda (pointer) - (free pointer))) - -(define pffi-pointer-null? - (lambda (pointer) - (not pointer))) ; #f is the null pointer on racket - (define pffi-pointer-set! (lambda (pointer type offset value) (ptr-set! pointer @@ -114,7 +80,3 @@ (if (equal? type 'char) (integer->char r) r)))) - -#;(define pffi-struct-dereference - (lambda (struct) - (pffi-struct-pointer struct))) diff --git a/retropikzel/pffi/sagittarius.scm b/retropikzel/pffi/sagittarius.scm index 98df939..f2aab32 100644 --- a/retropikzel/pffi/sagittarius.scm +++ b/retropikzel/pffi/sagittarius.scm @@ -1,3 +1,33 @@ +(define size-of-type + (lambda (type) + (cond ((eq? type 'int8) size-of-int8_t) + ((eq? type 'uint8) size-of-uint8_t) + ((eq? type 'int16) size-of-int16_t) + ((eq? type 'uint16) size-of-uint16_t) + ((eq? type 'int32) size-of-int32_t) + ((eq? type 'uint32) size-of-uint32_t) + ((eq? type 'int64) size-of-int64_t) + ((eq? type 'uint64) size-of-uint64_t) + ((eq? type 'char) size-of-char) + ((eq? type 'unsigned-char) size-of-char) + ((eq? type 'short) size-of-short) + ((eq? type 'unsigned-short) size-of-unsigned-short) + ((eq? type 'int) size-of-int) + ((eq? type 'unsigned-int) size-of-unsigned-int) + ((eq? type 'long) size-of-long) + ((eq? type 'unsigned-long) size-of-unsigned-long) + ((eq? type 'float) size-of-float) + ((eq? type 'double) size-of-double) + ((eq? type 'pointer) size-of-void*) + ((eq? type 'void) 0) + ((eq? type 'string) size-of-void*) + ((eq? type 'callback) size-of-void*) + (else #f)))) + +(define pffi-shared-object-load + (lambda (path options) + (open-shared-library path))) + (define pffi-type->native-type (lambda (type) (cond ((equal? type 'int8) 'int8_t) @@ -25,11 +55,7 @@ ((and (pair? type) (equal? 'struct (car type))) 'void*) (else #f)))) -(define pffi-pointer? - (lambda (object) - (pointer? object))) - -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (define scheme-name @@ -46,72 +72,9 @@ (map pffi-type->native-type argument-types) procedure))))) -(define size-of-type - (lambda (type) - (cond ((eq? type 'int8) size-of-int8_t) - ((eq? type 'uint8) size-of-uint8_t) - ((eq? type 'int16) size-of-int16_t) - ((eq? type 'uint16) size-of-uint16_t) - ((eq? type 'int32) size-of-int32_t) - ((eq? type 'uint32) size-of-uint32_t) - ((eq? type 'int64) size-of-int64_t) - ((eq? type 'uint64) size-of-uint64_t) - ((eq? type 'char) size-of-char) - ((eq? type 'unsigned-char) size-of-char) - ((eq? type 'short) size-of-short) - ((eq? type 'unsigned-short) size-of-unsigned-short) - ((eq? type 'int) size-of-int) - ((eq? type 'unsigned-int) size-of-unsigned-int) - ((eq? type 'long) size-of-long) - ((eq? type 'unsigned-long) size-of-unsigned-long) - ((eq? type 'float) size-of-float) - ((eq? type 'double) size-of-double) - ((eq? type 'pointer) size-of-void*) - ((eq? type 'void) 0) - ((eq? type 'string) size-of-void*) - ((eq? type 'callback) size-of-void*) - (else #f)))) - -#;(define pffi-pointer-allocate - (lambda (size) - (c-malloc size))) - -(define pffi-pointer-address - (lambda (pointer) - (address pointer))) - -(define pffi-pointer-null - (lambda () - (empty-pointer))) - -#;(define (string->c-string s) - (let* ((bv (string->utf8 s)) - (p (allocate-pointer (+ (bytevector-length bv) 1)))) - (do ((i 0 (+ i 1))) - ((= i (bytevector-length bv)) p) - (pointer-set-c-uint8! p i (bytevector-u8-ref bv i))) - p)) - -#;(define pffi-string->pointer - (lambda (string-content) - (string->c-string string-content))) - -#;(define pffi-pointer->string - (lambda (pointer) - (pointer->string pointer))) - -(define pffi-shared-object-load - (lambda (path options) - (open-shared-library path))) - -#;(define pffi-pointer-free - (lambda (pointer) - (when (pointer? pointer) - (c-free pointer)))) - -(define pffi-pointer-null? - (lambda (pointer) - (null-pointer? pointer))) +(define c-bytevector? + (lambda (object) + (pointer? object))) (define pffi-pointer-set! (lambda (pointer type offset value) @@ -156,3 +119,4 @@ ((equal? type 'double) (pointer-ref-c-double pointer offset)) ((equal? type 'void) (pointer-ref-c-pointer pointer offset)) ((equal? type 'pointer) (pointer-ref-c-pointer pointer offset))))) + diff --git a/retropikzel/pffi/shared/array.scm b/retropikzel/pffi/shared/array.scm index ed347d4..9d4bd7e 100644 --- a/retropikzel/pffi/shared/array.scm +++ b/retropikzel/pffi/shared/array.scm @@ -8,8 +8,8 @@ (define pffi-list->array (lambda (type list-arg) (let* ((array-size (length list-arg)) - (type-size (pffi-size-of type)) - (array (pffi-pointer-allocate (* type-size array-size))) + (type-size (c-size-of type)) + (array (make-c-bytevector (* type-size array-size))) (offset 0)) (for-each (lambda (item) @@ -25,7 +25,7 @@ (define pffi-array->list (lambda (array) (letrec* ((type (pffi-array-type array)) - (type-size (pffi-size-of type)) + (type-size (c-size-of type)) (max-offset (* type-size (pffi-array-size array))) (array-pointer (pffi-array-pointer array)) (looper (lambda (offset result) @@ -40,19 +40,19 @@ (define pffi-array-allocate (lambda (type size) - (array-make type size (pffi-pointer-allocate-calloc size (pffi-size-of type))))) + (array-make type size (pffi-pointer-allocate-calloc size (c-size-of type))))) (define pffi-array-get (lambda (array index) (let ((type (pffi-array-type array))) (pffi-pointer-get (pffi-array-pointer array) type - (* (pffi-size-of type) index))))) + (* (c-size-of type) index))))) (define pffi-array-set! (lambda (array index value) (let ((type (pffi-array-type array))) (pffi-pointer-set! (pffi-array-pointer array) type - (* (pffi-size-of type) index) + (* (c-size-of type) index) value)))) diff --git a/retropikzel/pffi/shared/main.scm b/retropikzel/pffi/shared/main.scm index 986ce39..fe8425d 100644 --- a/retropikzel/pffi/shared/main.scm +++ b/retropikzel/pffi/shared/main.scm @@ -1,4 +1,4 @@ -(cond-expand +#;(cond-expand (mosh (define pffi-init (lambda () #t))) (chicken (define-syntax pffi-init @@ -8,7 +8,7 @@ (chicken memory)) #t)))) (gambit #t) - (ypsilon + #;(ypsilon (define-syntax pffi-init (syntax-rules () ((_) @@ -22,37 +22,12 @@ #f #t))) -(define pffi-size-of +(define c-size-of (lambda (object) (cond ((pffi-struct? object) (pffi-struct-size object)) ((pffi-type? object) (size-of-type object)) (else (error "Not pffi-struct, pffi-enum of pffi-type" object))))) -(define pffi-string->pointer - (lambda (str) - (letrec* ((str-length (string-length str)) - (pointer (pffi-pointer-allocate (+ str-length 1))) - (looper (lambda (index) - (when (< index str-length) - (pffi-pointer-set! pointer - 'char - index - (string-ref str index)) - (looper (+ index 1)))))) - (looper 0) - (pffi-pointer-set! pointer 'char str-length #\null) - pointer))) - -(define pffi-pointer->string - (lambda (pointer) - (letrec* ((looper (lambda (index str) - (let ((c (pffi-pointer-get pointer 'char index))) - (if (char=? c #\null) - str - (looper (+ index 1) (cons c str))))))) - (list->string (reverse (looper 0 (list))))))) - - (define pffi-types '(int8 uint8 @@ -75,7 +50,7 @@ pointer void)) -(define string-split +(define pffi:string-split (lambda (str mark) (let* ((str-l (string->list str)) (res (list)) @@ -93,16 +68,11 @@ res))) (cond-expand - (gambit #t) - ((or chicken cyclone) - (define-syntax pffi-define-library - (syntax-rules () - ((_ scheme-name headers object-name options) - (begin - (define scheme-name #t) - (pffi-shared-object-load headers)))))) + (gambit #t) ; Defined in pffi/gambit.scm + (chicken #t) ; Defined in pffi/chicken.scm + (cyclone #t) ; Defined in pffi/cyclone.scm (else - (define-syntax pffi-define-library + (define-syntax define-c-library (syntax-rules () ((_ scheme-name headers object-name options) (define scheme-name @@ -125,7 +95,7 @@ (windows (append (if (get-environment-variable "PFFI_LOAD_PATH") - (string-split (get-environment-variable "PFFI_LOAD_PATH") #\;) + (pffi:string-split (get-environment-variable "PFFI_LOAD_PATH") #\;) (list)) (if (get-environment-variable "SYSTEM") (list (get-environment-variable "SYSTEM")) @@ -144,7 +114,7 @@ (list)) (list ".") (if (get-environment-variable "PATH") - (string-split (get-environment-variable "PATH") #\;) + (pffi:string-split (get-environment-variable "PATH") #\;) (list)) (if (get-environment-variable "PWD") (list (get-environment-variable "PWD")) @@ -152,7 +122,7 @@ (else (append (if (get-environment-variable "PFFI_LOAD_PATH") - (string-split (get-environment-variable "PFFI_LOAD_PATH") #\:) + (pffi:string-split (get-environment-variable "PFFI_LOAD_PATH") #\:) (list)) ; Guix (list (if (get-environment-variable "GUIX_ENVIRONMENT") @@ -161,7 +131,7 @@ "/run/current-system/profile/lib") ; Debian (if (get-environment-variable "LD_LIBRARY_PATH") - (string-split (get-environment-variable "LD_LIBRARY_PATH") #\:) + (pffi:string-split (get-environment-variable "LD_LIBRARY_PATH") #\:) (list)) (list ;;; x86-64 diff --git a/retropikzel/pffi/shared/pointer.scm b/retropikzel/pffi/shared/pointer.scm index 186f4b2..7b12f0e 100644 --- a/retropikzel/pffi/shared/pointer.scm +++ b/retropikzel/pffi/shared/pointer.scm @@ -1,75 +1,105 @@ (cond-expand - (windows (pffi-define-library pffi-libc-stdlib - '("stdlib.h") - "ucrtbase" - '((additional-versions ("0" "6"))))) - (else (pffi-define-library pffi-libc-stdlib - '("stdlib.h") - "c" - '((additional-versions ("0" "6")))))) + (windows (define-c-library libc + '("stdlib.h" "string.h") + "ucrtbase" + '((additional-versions ("0" "6"))))) + (else (define-c-library libc + '("stdlib.h" "string.h") + "c" + '((additional-versions ("0" "6")))))) -(cond-expand - (windows (pffi-define-library pffi-libc-stdio - '("stdio.h") - "ucrtbase" - '((additional-versions ("0" "6"))))) - (else (pffi-define-library pffi-libc-stdio - '("stdio") - "c" - '((additional-versions ("0" "6")))))) -;(pffi-define-function c-snprintf pffi-libc-stdio 'snprintf 'int '(pointer int pointer pointer)) -;(pffi-define-function c-strtol pffi-libc-stdio 'strtol 'uint64 '(pointer pointer int)) +(define-c-procedure c-strlen libc 'strlen 'int '(pointer)) +(define-c-procedure pffi-pointer-allocate-calloc libc 'calloc 'pointer '(int int)) +(define-c-procedure c-memset-address->pointer libc 'memset 'pointer '(uint64 uint8 int)) +(define-c-procedure c-memset-pointer->address libc 'memset 'uint64 '(pointer uint8 int)) +(define-c-procedure c-printf libc 'printf 'int '(pointer pointer)) +(define-c-procedure c-malloc libc 'malloc 'pointer '(int)) +(define-c-procedure c-strlen libc 'strlen 'int '(pointer)) (cond-expand (chibi #t) ; FIXME - (else (pffi-define-function pffi-pointer-allocate pffi-libc-stdlib 'malloc 'pointer '(int)))) + (else (define make-c-bytevector + (lambda (k . byte) + (if (null? byte) + (c-malloc k) + (bytevector->c-bytevector (make-bytevector k (car byte)))))))) -(pffi-define-function pffi-pointer-allocate-calloc pffi-libc-stdlib 'calloc 'pointer '(int int)) +(define c-bytevector + (lambda bytes + (bytevector->c-bytevector (apply bytevector bytes)))) (cond-expand (chibi #t) ; FIXME - (else (pffi-define-function pffi-pointer-free pffi-libc-stdlib 'free 'void '(pointer)))) + (else (define-c-procedure c-free libc 'free 'void '(pointer)))) -#;(define pffi-pointer-null - (lambda () - (let ((pointer (pffi-pointer-allocate (pffi-size-of 'pointer)))) - (pffi-pointer-set! pointer 'int 0 0) +(define bytevector->c-bytevector + (lambda (bytes) + (letrec* ((bytes-length (bytevector-length bytes)) + (pointer (make-c-bytevector bytes-length)) + (looper (lambda (index) + (when (< index bytes-length) + (pffi-pointer-set! pointer + 'uint8 + index + (bytevector-u8-ref bytes index)) + (looper (+ index 1)))))) + (looper 0) pointer))) -#;(define pffi-pointer-null? - (lambda (pointer) - (let ((address - (let ((str (pffi-pointer-allocate 512))) - (c-snprintf str 512 (pffi-string->pointer "%p") pointer) - (display "Scheme: p1 address: ") - (write (pffi-pointer->string str)) - (newline) - (display "Scheme: p1 address int: ") - (write (c-strtol str (pffi-pointer-null) 16)) - (newline) - (c-strtol str (pffi-pointer-null) 16)))) - (= address 0)))) +(define c-bytevector->bytevector + (lambda (pointer size) + (letrec* ((bytes (make-bytevector size)) + (looper (lambda (index) + (let ((byte (pffi-pointer-get pointer 'uint8 index))) + (if (= index size) + bytes + (begin + (bytevector-u8-set! bytes index byte) + (looper (+ index 1)))))))) + (looper 0)))) -#;(define pffi-pointer-address +(define c-bytevector-string-length + (lambda (bytevector) + (c-strlen bytevector))) + +(define c-bytevector->string (lambda (pointer) - (let* ((address-number - (let ((str (pffi-pointer-allocate 512))) - (c-snprintf str 512 (pffi-string->pointer "%p") pointer) - (display "Scheme: p1 address: ") - (write (pffi-pointer->string str)) - (newline) - (display "Scheme: p1 address int: ") - (write (c-strtol str (pffi-pointer-null) 16)) - (newline) - (c-strtol str (pffi-pointer-null) 16))) - (address (pffi-pointer-allocate (pffi-size-of 'uint64)))) - (display "Scheme: p2 address: ") - (write address) - (newline) - ;address-number - (pffi-pointer-set! address 'uint64 0 address-number) - ;address-number - ;(pffi-pointer-get address 'pointer 0) - address - ) - )) + (when (not (c-bytevector? pointer)) + (error "c-bytevector->string argument not c-bytevector" pointer)) + (let ((size (c-strlen pointer))) + (utf8->string (c-bytevector->bytevector pointer size))))) + +(define string->c-bytevector + (lambda (text) + (when (not (string? text)) + (error "string->bytevector argument not string" text)) + (bytevector->c-bytevector (string->utf8 (string-append text (string #\null)))))) + +(cond-expand + (kawa #t) ; FIXME + (chicken #t) ; FIXME + (else (define make-c-null + (lambda () + (cond-expand (stklos (let ((pointer (make-c-bytevector 1))) + (free-bytes pointer) + pointer)) + (else (c-memset-address->pointer 0 0 0))))))) + +(cond-expand + (kawa #t) ; FIXME + (chicken #t) ; FIXME + (else (define c-null? + (lambda (pointer) + (if (c-bytevector? pointer) + (= (c-memset-pointer->address pointer 0 0) 0) + #f))))) + +(define-syntax call-with-address-of-c-bytevector + (syntax-rules () + ((_ input-pointer thunk) + (let ((address-pointer (make-c-bytevector (c-size-of 'pointer)))) + (pffi-pointer-set! address-pointer 'pointer 0 input-pointer) + (apply thunk (list address-pointer)) + (set! input-pointer (pffi-pointer-get address-pointer 'pointer 0)) + (c-free address-pointer))))) + diff --git a/retropikzel/pffi/shared/struct.scm b/retropikzel/pffi/shared/struct.scm index 66c3786..926b9ee 100644 --- a/retropikzel/pffi/shared/struct.scm +++ b/retropikzel/pffi/shared/struct.scm @@ -15,33 +15,13 @@ (size (cdr (assoc 'size size-and-offsets))) (offsets (cdr (assoc 'offsets size-and-offsets))) (pointer (if (and (not (null? arguments)) - (pffi-pointer? (car arguments))) + (c-bytevector? (car arguments))) (car arguments) - (pffi-pointer-allocate size))) + (make-c-bytevector size))) (c-type-string (if (string? c-type) c-type (symbol->string c-type)))) (struct-make c-type-string size pointer offsets))))))) -#;(define pffi-struct-dereference - (lambda (struct) - (let ((pointer (pffi-pointer-allocate (pffi-struct-size struct))) - (offset 0)) - (for-each - (lambda (struct-member) - (let* ((member-type (cadr struct-member)) - (member-name (car struct-member)) - (member-size (pffi-size-of member-type))) - (pffi-pointer-set! pointer - member-type - offset - (pffi-struct-get struct member-name)) - (set! offset (+ offset member-size)))) - (pffi-struct-members struct)) - ;(pffi-pointer-get (pffi-struct-pointer struct) 'pointer 0) - ;(pffi-pointer-get pointer 'pointer 0) - pointer - ))) - -(define pffi-align-of +(define c-align-of (lambda (type) (cond-expand ;(guile (alignof (pffi-type->native-type type))) @@ -60,7 +40,7 @@ (offsets (map (lambda (member) (let* ((name (cdr member)) (type (car member)) - (type-alignment (pffi-align-of type))) + (type-alignment (c-align-of type))) (when (> (size-of-type type) largest-member-size) (set! largest-member-size (size-of-type type))) (if (or (= size 0) @@ -97,7 +77,7 @@ (let* ((size-and-offsets (calculate-struct-size-and-offsets members)) (size (cdr (assoc 'size size-and-offsets))) (offsets (cdr (assoc 'offsets size-and-offsets))) - (pointer (if (null? pointer) (pffi-pointer-allocate size) (car pointer))) + (pointer (if (null? pointer) (make-c-bytevector size) (car pointer))) (c-type (if (string? c-type) c-type (symbol->string c-type)))) (struct-make c-type size pointer offsets)))) diff --git a/retropikzel/pffi/shared/union.scm b/retropikzel/pffi/shared/union.scm deleted file mode 100644 index 93527f3..0000000 --- a/retropikzel/pffi/shared/union.scm +++ /dev/null @@ -1,8 +0,0 @@ - -(define-record-type - (union-make c-type size pointer members) - pffi-union? - (c-type pffi-union-c-type) - (size pffi-union-size) - (pointer pffi-union-pointer) - (members pffi-union-members)) diff --git a/retropikzel/pffi/stklos.scm b/retropikzel/pffi/stklos.scm index 89ffe90..e9babd6 100644 --- a/retropikzel/pffi/stklos.scm +++ b/retropikzel/pffi/stklos.scm @@ -1,13 +1,13 @@ (define pffi-type->native-type (lambda (type) - (cond ((equal? type 'int8) :int) - ((equal? type 'uint8) :uint) - ((equal? type 'int16) :int) - ((equal? type 'uint16) :uint) + (cond ((equal? type 'int8) :char) + ((equal? type 'uint8) :char) + ((equal? type 'int16) :short) + ((equal? type 'uint16) :ushort) ((equal? type 'int32) :int) ((equal? type 'uint32) :uint) - ((equal? type 'int64) :int) - ((equal? type 'uint64) :uint) + ((equal? type 'int64) :long) + ((equal? type 'uint64) :ulong) ((equal? type 'char) :char) ((equal? type 'unsigned-char) :uchar) ((equal? type 'short) :short) @@ -19,21 +19,15 @@ ((equal? type 'float) :float) ((equal? type 'double) :double) ((equal? type 'pointer) :pointer) - ((equal? type 'string) :string) ((equal? type 'void) :void) ((equal? type 'struct) :void) (else (error "pffi-type->native-type -- No such pffi type" type))))) -(define pffi-pointer? +(define c-bytevector? (lambda (object) - (display "HERE: ") - (write object) - (newline) - (write (cpointer? object)) - (newline) (cpointer? object))) -(define-syntax pffi-define-function +(define-syntax define-c-procedure (syntax-rules () ((_ scheme-name shared-object c-name return-type argument-types) (begin @@ -76,53 +70,25 @@ ; FIXME (define size-of-type (lambda (type) - (cond - ((equal? type 'int8) 1) - ((equal? type 'uint8) 1) - ((equal? type 'int16) 2) - ((equal? type 'uint16) 2) - ((equal? type 'int32) 4) - ((equal? type 'uint32) 4) - ((equal? type 'int64) 8) - ((equal? type 'uint64) 8) - ((equal? type 'char) 1) - ((equal? type 'unsigned-char) 1) - ((equal? type 'short) 2) - ((equal? type 'unsigned-short) 2) - ((equal? type 'int) 4) - ((equal? type 'unsigned-int) 4) - ((equal? type 'long) 8) - ((equal? type 'unsigned-long) 8) - ((equal? type 'float) 4) - ((equal? type 'double) 8) - ((equal? type 'pointer) 8) - - ))) - -#;(define pffi-pointer-allocate - (lambda (size) - (allocate-bytes size))) - -;; FIXME -(define pffi-pointer-address - (lambda (pointer) - 0)) - -;; FIXME -(define pffi-pointer-null - (lambda () - (let ((p (allocate-bytes 0))) - (free-bytes p) - p))) - -#;(define pffi-pointer-free - (lambda (pointer) - (free-bytes pointer))) - -(define pffi-pointer-null? - (lambda (pointer) - (and (cpointer? pointer) - (cpointer-null? pointer)))) + (cond ((equal? type 'int8) 1) + ((equal? type 'uint8) 1) + ((equal? type 'int16) 2) + ((equal? type 'uint16) 2) + ((equal? type 'int32) 4) + ((equal? type 'uint32) 4) + ((equal? type 'int64) 8) + ((equal? type 'uint64) 8) + ((equal? type 'char) 1) + ((equal? type 'unsigned-char) 1) + ((equal? type 'short) 2) + ((equal? type 'unsigned-short) 2) + ((equal? type 'int) 4) + ((equal? type 'unsigned-int) 4) + ((equal? type 'long) 8) + ((equal? type 'unsigned-long) 8) + ((equal? type 'float) 4) + ((equal? type 'double) 8) + ((equal? type 'pointer) 8)))) (define pffi-pointer-set! (lambda (pointer type offset value) diff --git a/retropikzel/pffi/ypsilon.scm b/retropikzel/pffi/ypsilon.scm index 5dd9386..f59d640 100644 --- a/retropikzel/pffi/ypsilon.scm +++ b/retropikzel/pffi/ypsilon.scm @@ -25,52 +25,13 @@ ((eq? type 'void) 0) (else #f)))) -;(define c-malloc (c-function void* malloc (size_t))) -;(define c-free (c-function int free (void*))) - -#;(define pffi-pointer-allocate - (lambda (size) - (c-malloc size))) - -(define pffi-pointer-address - (lambda (pointer) - pointer)) - -(define pffi-pointer? +(define c-bytevector? (lambda (object) (number? object))) -#;(define pffi-pointer-free - (lambda (pointer) - (c-free pointer))) - -(define pffi-pointer-null - (lambda () - 0)) - -(define pffi-pointer-null? - (lambda (pointer) - (and (pffi-pointer? pointer) - (= (pffi-pointer-address pointer) 0)))) - -#;(define pffi-pointer->string - (lambda (pointer) - (c-string-ref pointer))) - -;(define c-memset(c-function int memset (void* int int))) -;(define c-snprintf (c-function int snprintf (void* size_t void*) (long double))) -#;(define pffi-string->pointer - (lambda (string-content) - (let* ((c-string (make-c-string string-content)) - (c-string-length (bytevector-length c-string)) - (pointer (c-malloc c-string-length))) - (c-memset pointer 0 c-string-length) - (c-snprintf pointer c-string-length (make-c-string "%s") c-string) - pointer))) - (define pffi-pointer-set! (lambda (pointer type offset value) - (let ((bv (make-bytevector-mapping (+ pointer offset) (pffi-size-of type)))) + (let ((bv (make-bytevector-mapping (+ pointer offset) (c-size-of type)))) (cond ((equal? type 'int8) (bytevector-c-int8-set! bv 0 value)) ((equal? type 'uint8) (bytevector-c-int8-set! bv 0 value)) ((equal? type 'int16) (bytevector-c-int16-set! bv 0 value)) @@ -93,7 +54,7 @@ (define pffi-pointer-get (lambda (pointer type offset) - (let ((bv (make-bytevector-mapping (+ pointer offset) (pffi-size-of type)))) + (let ((bv (make-bytevector-mapping (+ pointer offset) (c-size-of type)))) (cond ((equal? type 'int8) (bytevector-c-int8-ref bv 0)) ((equal? type 'uint8) (bytevector-c-uint8-ref bv 0)) ((equal? type 'int16) (bytevector-c-int16-ref bv 0)) @@ -115,44 +76,96 @@ ((equal? type 'pointer) (bytevector-c-void*-ref bv 0)))))) (define pffi-shared-object-load - (lambda (headers path options) + (lambda (path options) (load-shared-object path))) -(define-macro (pffi-type->native-type type) - `(cond ((equal? ,type int8) int8_t) - ((equal? ,type uint8) uint8_t) - ((equal? ,type int16) int16_t) - ((equal? ,type uint16) uint16_t) - ((equal? ,type int32) int32_t) - ((equal? ,type uint32) uint32_t) - ((equal? ,type int64) int64_t) - ((equal? ,type uint64) uint64_t) - ((equal? ,type char) char) - ((equal? ,type unsigned-char) char) - ((equal? ,type short) short) - ((equal? ,type unsigned-short) unsigned-short) - ((equal? ,type int) int) - ((equal? ,type unsigned-int) unsigned-int) - ((equal? ,type long) long) - ((equal? ,type unsigned-long) unsigned-long) - ((equal? ,type float) float) - ((equal? ,type double) double) - ((equal? ,type pointer) void*) - ((equal? ,type string) void*) - ((equal? ,type void) void) - ((equal? ,type callback) void*) - (else (error "pffi-type->native-type -- No such pffi type" ,type)))) +#;(define-macro + (pffi-type->native-type type) + `(cond ((equal? ,type 'int8) 'int8_t) + ((equal? ,type 'uint8) 'uint8_t) + ;((equal? ,type 'int16) 'int16_t) + ;((equal? ,type 'uint16) 'uint16_t) + ;((equal? ,type 'int32) 'int32_t) + ;((equal? ,type 'uint32) 'uint32_t) + ;((equal? ,type 'int64) 'int64_t) + ;((equal? ,type 'uint64) 'uint64_t) + ;((equal? ,type 'char) 'char) + ;((equal? ,type 'unsigned-char) 'char) + ;((equal? ,type 'short) 'short) + ;((equal? ,type 'unsigned-short) 'unsigned-short) + ((equal? ,type 'int) 'int) + ;((equal? ,type 'unsigned-int) 'unsigned-int) + ;((equal? ,type 'long) 'long) + ;((equal? ,type 'unsigned-long) 'unsigned-long) + ;((equal? ,type 'float) 'float) + ;((equal? ,type 'double) 'double) + ((equal? ,type 'pointer) 'void*) + ;((equal? ,type 'string) 'void*) + ((equal? ,type 'void) 'void) + ;((equal? ,type 'callback) 'void*) + (else (error "pffi-type->native-type -- No such pffi type" ,type)))) (define-macro - (pffi-define-function scheme-name shared-object c-name return-type argument-types) - `(define ,scheme-name - (c-function ,(pffi-type->native-type return-type) - ,(cadr c-name) - ,(map pffi-type->native-type (cdr argument-types))))) + (define-c-procedure scheme-name shared-object c-name return-type argument-types) + (begin + (let ((pffi-type->native-type + (lambda (type) + (cond ((equal? type 'int8) 'int8_t) + ((equal? type 'uint8) 'uint8_t) + ((equal? type 'int16) 'int16_t) + ((equal? type 'uint16) 'uint16_t) + ((equal? type 'int32) 'int32_t) + ((equal? type 'uint32) 'uint32_t) + ((equal? type 'int64) 'int64_t) + ((equal? type 'uint64) 'uint64_t) + ((equal? type 'char) 'char) + ((equal? type 'unsigned-char) 'char) + ((equal? type 'short) 'short) + ((equal? type 'unsigned-short) 'unsigned-short) + ((equal? type 'int) 'int) + ((equal? type 'unsigned-int) 'unsigned-int) + ((equal? type 'long) 'long) + ((equal? type 'unsigned-long) 'unsigned-long) + ((equal? type 'float) 'float) + ((equal? type 'double) 'double) + ((equal? type 'pointer) 'void*) + ((equal? type 'string) 'void*) + ((equal? type 'void) 'void) + ((equal? type 'callback) 'void*) + (else (error "pffi-type->native-type -- No such pffi type" type)))))) + `(define ,scheme-name + (c-function ,(pffi-type->native-type (cadr return-type)) + ,(cadr c-name) + ,(map pffi-type->native-type (cadr argument-types))))))) (define-macro (pffi-define-callback scheme-name return-type argument-types procedure) + (let ((pffi-type->native-type + (lambda (type) + (cond ((equal? type 'int8) 'int8_t) + ((equal? type 'uint8) 'uint8_t) + ((equal? type 'int16) 'int16_t) + ((equal? type 'uint16) 'uint16_t) + ((equal? type 'int32) 'int32_t) + ((equal? type 'uint32) 'uint32_t) + ((equal? type 'int64) 'int64_t) + ((equal? type 'uint64) 'uint64_t) + ((equal? type 'char) 'char) + ((equal? type 'unsigned-char) 'char) + ((equal? type 'short) 'short) + ((equal? type 'unsigned-short) 'unsigned-short) + ((equal? type 'int) 'int) + ((equal? type 'unsigned-int) 'unsigned-int) + ((equal? type 'long) 'long) + ((equal? type 'unsigned-long) 'unsigned-long) + ((equal? type 'float) 'float) + ((equal? type 'double) 'double) + ((equal? type 'pointer) 'void*) + ((equal? type 'string) 'void*) + ((equal? type 'void) 'void) + ((equal? type 'callback) 'void*) + (else (error "pffi-type->native-type -- No such pffi type" type)))))) `(define ,scheme-name (c-callback ,(pffi-type->native-type return-type) ,(map pffi-type->native-type (cdr argument-types)) - ,procedure))) + ,procedure)))) diff --git a/tests/compliance.scm b/tests/compliance.scm index f4ad12d..6604552 100755 --- a/tests/compliance.scm +++ b/tests/compliance.scm @@ -72,343 +72,343 @@ ;; pffi-init -(print-header 'pffi-init) +;(print-header 'pffi-init) -(pffi-init) +;(pffi-init) ;; pffi-type? -(print-header 'pffi-type?) +;(print-header 'pffi-type?) -(debug (pffi-type? 'int8)) -(assert equal? (pffi-type? 'int8) #t) -(debug (pffi-type? 'uint8)) -(assert equal? (pffi-type? 'uint8) #t) -(debug (pffi-type? 'int16)) -(assert equal? (pffi-type? 'int16) #t) -(debug (pffi-type? 'uint16)) -(assert equal? (pffi-type? 'uint16) #t) -(debug (pffi-type? 'int32)) -(assert equal? (pffi-type? 'int32) #t) -(debug (pffi-type? 'uint32)) -(assert equal? (pffi-type? 'uint32) #t) -(debug (pffi-type? 'int64)) -(assert equal? (pffi-type? 'int64) #t) -(debug (pffi-type? 'uint64)) -(assert equal? (pffi-type? 'uint64) #t) -(debug (pffi-type? 'char)) -(assert equal? (pffi-type? 'char) #t) -(debug (pffi-type? 'unsigned-char)) -(assert equal? (pffi-type? 'unsigned-char) #t) -(debug (pffi-type? 'short)) -(assert equal? (pffi-type? 'short) #t) -(debug (pffi-type? 'unsigned-short)) -(assert equal? (pffi-type? 'unsigned-short) #t) -(debug (pffi-type? 'int)) -(assert equal? (pffi-type? 'int) #t) -(debug (pffi-type? 'unsigned-int)) -(assert equal? (pffi-type? 'unsigned-int) #t) -(debug (pffi-type? 'long)) -(assert equal? (pffi-type? 'long) #t) -(debug (pffi-type? 'unsigned-long)) -(assert equal? (pffi-type? 'unsigned-long) #t) -(debug (pffi-type? 'float)) -(assert equal? (pffi-type? 'float) #t) -(debug (pffi-type? 'double)) -(assert equal? (pffi-type? 'double) #t) -(debug (pffi-type? 'pointer)) -(assert equal? (pffi-type? 'pointer) #t) -(debug (pffi-type? 'void)) -(assert equal? (pffi-type? 'void) #t) -(debug (pffi-type? 'callback)) -(assert equal? (pffi-type? 'callback) #t) +;(debug (pffi-type? 'int8)) +;(assert equal? (pffi-type? 'int8) #t) +;(debug (pffi-type? 'uint8)) +;(assert equal? (pffi-type? 'uint8) #t) +;(debug (pffi-type? 'int16)) +;(assert equal? (pffi-type? 'int16) #t) +;(debug (pffi-type? 'uint16)) +;(assert equal? (pffi-type? 'uint16) #t) +;(debug (pffi-type? 'int32)) +;(assert equal? (pffi-type? 'int32) #t) +;(debug (pffi-type? 'uint32)) +;(assert equal? (pffi-type? 'uint32) #t) +;(debug (pffi-type? 'int64)) +;(assert equal? (pffi-type? 'int64) #t) +;(debug (pffi-type? 'uint64)) +;(assert equal? (pffi-type? 'uint64) #t) +;(debug (pffi-type? 'char)) +;(assert equal? (pffi-type? 'char) #t) +;(debug (pffi-type? 'unsigned-char)) +;(assert equal? (pffi-type? 'unsigned-char) #t) +;(debug (pffi-type? 'short)) +;(assert equal? (pffi-type? 'short) #t) +;(debug (pffi-type? 'unsigned-short)) +;(assert equal? (pffi-type? 'unsigned-short) #t) +;(debug (pffi-type? 'int)) +;(assert equal? (pffi-type? 'int) #t) +;(debug (pffi-type? 'unsigned-int)) +;(assert equal? (pffi-type? 'unsigned-int) #t) +;(debug (pffi-type? 'long)) +;(assert equal? (pffi-type? 'long) #t) +;(debug (pffi-type? 'unsigned-long)) +;(assert equal? (pffi-type? 'unsigned-long) #t) +;(debug (pffi-type? 'float)) +;(assert equal? (pffi-type? 'float) #t) +;(debug (pffi-type? 'double)) +;(assert equal? (pffi-type? 'double) #t) +;(debug (pffi-type? 'pointer)) +;(assert equal? (pffi-type? 'pointer) #t) +;(debug (pffi-type? 'void)) +;(assert equal? (pffi-type? 'void) #t) +;(debug (pffi-type? 'callback)) +;(assert equal? (pffi-type? 'callback) #t) -;; pffi-size-of +;; c-size-of -(print-header 'pffi-size-of) +(print-header 'c-size-of) -(define size-int8 (pffi-size-of 'int8)) +(define size-int8 (c-size-of 'int8)) (debug size-int8) (assert equal? (number? size-int8) #t) (assert = size-int8 1) -(define size-uint8 (pffi-size-of 'uint8)) +(define size-uint8 (c-size-of 'uint8)) (debug size-uint8) (assert equal? (number? size-uint8) #t) (assert = size-uint8 1) -(assert equal? (number? (pffi-size-of 'uint8)) #t) -(define size-int16 (pffi-size-of 'int16)) +(assert equal? (number? (c-size-of 'uint8)) #t) +(define size-int16 (c-size-of 'int16)) (debug size-int16) (assert equal? (number? size-int16) #t) (assert = size-int16 2) -(assert equal? (number? (pffi-size-of 'int16)) #t) -(define size-uint16 (pffi-size-of 'uint16)) +(assert equal? (number? (c-size-of 'int16)) #t) +(define size-uint16 (c-size-of 'uint16)) (debug size-uint16) (assert equal? (number? size-uint16) #t) (assert = size-uint16 2) -(assert equal? (number? (pffi-size-of 'uint16)) #t) -(define size-int32 (pffi-size-of 'int32)) +(assert equal? (number? (c-size-of 'uint16)) #t) +(define size-int32 (c-size-of 'int32)) (debug size-int32) (assert equal? (number? size-int32) #t) (assert = size-int32 4) -(assert equal? (number? (pffi-size-of 'int32)) #t) -(define size-uint32 (pffi-size-of 'uint32)) +(assert equal? (number? (c-size-of 'int32)) #t) +(define size-uint32 (c-size-of 'uint32)) (debug size-uint32) (assert equal? (number? size-uint32) #t) (assert = size-uint32 4) -(assert equal? (number? (pffi-size-of 'uint32)) #t) -(define size-int64 (pffi-size-of 'int64)) +(assert equal? (number? (c-size-of 'uint32)) #t) +(define size-int64 (c-size-of 'int64)) (debug size-int64) (assert equal? (number? size-int64) #t) (assert = size-int64 8) -(assert equal? (number? (pffi-size-of 'int64)) #t) -(define size-uint64 (pffi-size-of 'uint64)) +(assert equal? (number? (c-size-of 'int64)) #t) +(define size-uint64 (c-size-of 'uint64)) (debug size-uint64) (assert equal? (number? size-uint64) #t) (assert = size-uint64 8) -(assert equal? (number? (pffi-size-of 'uint64)) #t) -(define size-char (pffi-size-of 'char)) +(assert equal? (number? (c-size-of 'uint64)) #t) +(define size-char (c-size-of 'char)) (debug size-char) (assert equal? (number? size-char) #t) (assert = size-char 1) -(assert equal? (number? (pffi-size-of 'char)) #t) -(define size-unsigned-char (pffi-size-of 'unsigned-char)) +(assert equal? (number? (c-size-of 'char)) #t) +(define size-unsigned-char (c-size-of 'unsigned-char)) (debug size-unsigned-char) (assert equal? (number? size-unsigned-char) #t) (assert = size-unsigned-char 1) -(assert equal? (number? (pffi-size-of 'unsigned-char)) #t) -(define size-short (pffi-size-of 'short)) +(assert equal? (number? (c-size-of 'unsigned-char)) #t) +(define size-short (c-size-of 'short)) (debug size-short) (assert equal? (number? size-short) #t) (assert = size-short 2) -(assert equal? (number? (pffi-size-of 'short)) #t) -(define size-unsigned-short (pffi-size-of 'unsigned-short)) +(assert equal? (number? (c-size-of 'short)) #t) +(define size-unsigned-short (c-size-of 'unsigned-short)) (debug size-unsigned-short) (assert equal? (number? size-unsigned-short) #t) (assert = size-unsigned-short 2) -(assert equal? (number? (pffi-size-of 'unsigned-short)) #t) -(define size-int (pffi-size-of 'int)) +(assert equal? (number? (c-size-of 'unsigned-short)) #t) +(define size-int (c-size-of 'int)) (debug size-int) (assert equal? (number? size-int) #t) (assert = size-int 4) -(assert equal? (number? (pffi-size-of 'int)) #t) -(define size-unsigned-int (pffi-size-of 'unsigned-int)) +(assert equal? (number? (c-size-of 'int)) #t) +(define size-unsigned-int (c-size-of 'unsigned-int)) (debug size-unsigned-int) (assert equal? (number? size-unsigned-int) #t) (assert = size-unsigned-int 4) (cond-expand (i386 - (assert equal? (number? (pffi-size-of 'long)) #t) - (define size-long (pffi-size-of 'long)) + (assert equal? (number? (c-size-of 'long)) #t) + (define size-long (c-size-of 'long)) (debug size-long) (assert equal? (number? size-long) #t) (assert = size-long 4)) (else - (assert equal? (number? (pffi-size-of 'long)) #t) - (define size-long (pffi-size-of 'long)) + (assert equal? (number? (c-size-of 'long)) #t) + (define size-long (c-size-of 'long)) (debug size-long) (assert equal? (number? size-long) #t) (assert = size-long 8))) (cond-expand (i386 - (assert equal? (number? (pffi-size-of 'unsigned-long)) #t) - (define size-unsigned-long (pffi-size-of 'unsigned-long)) + (assert equal? (number? (c-size-of 'unsigned-long)) #t) + (define size-unsigned-long (c-size-of 'unsigned-long)) (debug size-unsigned-long) (assert equal? (number? size-unsigned-long) #t) (assert = size-unsigned-long 4)) (else - (assert equal? (number? (pffi-size-of 'long)) #t) - (define size-unsigned-long (pffi-size-of 'unsigned-long)) + (assert equal? (number? (c-size-of 'long)) #t) + (define size-unsigned-long (c-size-of 'unsigned-long)) (debug size-unsigned-long) (assert equal? (number? size-unsigned-long) #t) (assert = size-unsigned-long 8))) -(assert equal? (number? (pffi-size-of 'float)) #t) -(define size-float (pffi-size-of 'float)) +(assert equal? (number? (c-size-of 'float)) #t) +(define size-float (c-size-of 'float)) (debug size-float) (assert equal? (number? size-float) #t) (assert = size-float 4) -(assert equal? (number? (pffi-size-of 'double)) #t) -(define size-double (pffi-size-of 'double)) +(assert equal? (number? (c-size-of 'double)) #t) +(define size-double (c-size-of 'double)) (debug size-double) (assert equal? (number? size-double) #t) (assert = size-double 8) (cond-expand (i386 - (define size-pointer (pffi-size-of 'pointer)) + (define size-pointer (c-size-of 'pointer)) (debug size-pointer) (assert equal? (number? size-pointer) #t) (assert = size-pointer 4)) (else - (define size-pointer (pffi-size-of 'pointer)) + (define size-pointer (c-size-of 'pointer)) (debug size-pointer) (assert equal? (number? size-pointer) #t) (assert = size-pointer 8))) -;; pffi-align-of +;; c-align-of +; +;(print-header 'c-align-of) +; +;(define align-int8 (c-align-of 'int8)) +;(debug align-int8) +;(assert equal? (number? align-int8) #t) +;(assert = align-int8 1) +; +;(define align-uint8 (c-align-of 'uint8)) +;(debug align-uint8) +;(assert equal? (number? align-uint8) #t) +;(assert = align-uint8 1) +; +;(assert equal? (number? (c-align-of 'uint8)) #t) +;(define align-int16 (c-align-of 'int16)) +;(debug align-int16) +;(assert equal? (number? align-int16) #t) +;(assert = align-int16 2) +; +;(assert equal? (number? (c-align-of 'int16)) #t) +;(define align-uint16 (c-align-of 'uint16)) +;(debug align-uint16) +;(assert equal? (number? align-uint16) #t) +;(assert = align-uint16 2) +; +;(assert equal? (number? (c-align-of 'uint16)) #t) +;(define align-int32 (c-align-of 'int32)) +;(debug align-int32) +;(assert equal? (number? align-int32) #t) +;(assert = align-int32 4) +; +;(assert equal? (number? (c-align-of 'int32)) #t) +;(define align-uint32 (c-align-of 'uint32)) +;(debug align-uint32) +;(assert equal? (number? align-uint32) #t) +;(assert = align-uint32 4) +; +;(assert equal? (number? (c-align-of 'uint32)) #t) +;(define align-int64 (c-align-of 'int64)) +;(debug align-int64) +;(assert equal? (number? align-int64) #t) +;(assert = align-int64 8) +; +;(assert equal? (number? (c-align-of 'int64)) #t) +;(define align-uint64 (c-align-of 'uint64)) +;(debug align-uint64) +;(assert equal? (number? align-uint64) #t) +;(assert = align-uint64 8) +; +;(assert equal? (number? (c-align-of 'uint64)) #t) +;(define align-char (c-align-of 'char)) +;(debug align-char) +;(assert equal? (number? align-char) #t) +;(assert = align-char 1) +; +;(assert equal? (number? (c-align-of 'char)) #t) +;(define align-unsigned-char (c-align-of 'unsigned-char)) +;(debug align-unsigned-char) +;(assert equal? (number? align-unsigned-char) #t) +;(assert = align-unsigned-char 1) +; +;(assert equal? (number? (c-align-of 'unsigned-char)) #t) +;(define align-short (c-align-of 'short)) +;(debug align-short) +;(assert equal? (number? align-short) #t) +;(assert = align-short 2) +; +;(assert equal? (number? (c-align-of 'short)) #t) +;(define align-unsigned-short (c-align-of 'unsigned-short)) +;(debug align-unsigned-short) +;(assert equal? (number? align-unsigned-short) #t) +;(assert = align-unsigned-short 2) +; +;(assert equal? (number? (c-align-of 'unsigned-short)) #t) +;(define align-int (c-align-of 'int)) +;(debug align-int) +;(assert equal? (number? align-int) #t) +;(assert = align-int 4) +; +;(assert equal? (number? (c-align-of 'int)) #t) +;(define align-unsigned-int (c-align-of 'unsigned-int)) +;(debug align-unsigned-int) +;(assert equal? (number? align-unsigned-int) #t) +;(assert = align-unsigned-int 4) +; +;(cond-expand +; (i386 +; (assert equal? (number? (c-align-of 'long)) #t) +; (define align-long (c-align-of 'long)) +; (debug align-long) +; (assert equal? (number? align-long) #t) +; (assert = align-long 4)) +; (else +; (assert equal? (number? (c-align-of 'long)) #t) +; (define align-long (c-align-of 'long)) +; (debug align-long) +; (assert equal? (number? align-long) #t) +; (assert = align-long 8))) +; +;(cond-expand +; (i386 +; (assert equal? (number? (c-align-of 'unsigned-long)) #t) +; (define align-unsigned-long (c-align-of 'unsigned-long)) +; (debug align-unsigned-long) +; (assert equal? (number? align-unsigned-long) #t) +; (assert = align-unsigned-long 4)) +; (else +; (assert equal? (number? (c-align-of 'long)) #t) +; (define align-unsigned-long (c-align-of 'unsigned-long)) +; (debug align-unsigned-long) +; (assert equal? (number? align-unsigned-long) #t) +; (assert = align-unsigned-long 8))) +; +;(assert equal? (number? (c-align-of 'float)) #t) +;(define align-float (c-align-of 'float)) +;(debug align-float) +;(assert equal? (number? align-float) #t) +;(assert = align-float 4) +; +;(assert equal? (number? (c-align-of 'double)) #t) +;(define align-double (c-align-of 'double)) +;(debug align-double) +;(assert equal? (number? align-double) #t) +;(assert = align-double 8) +; +;(cond-expand +; (i386 +; (define align-pointer (c-align-of 'pointer)) +; (debug align-pointer) +; (assert equal? (number? align-pointer) #t) +; (assert = align-pointer 4)) +; (else +; (define align-pointer (c-align-of 'pointer)) +; (debug align-pointer) +; (assert equal? (number? align-pointer) #t) +; (assert = align-pointer 8))) -(print-header 'pffi-align-of) - -(define align-int8 (pffi-align-of 'int8)) -(debug align-int8) -(assert equal? (number? align-int8) #t) -(assert = align-int8 1) - -(define align-uint8 (pffi-align-of 'uint8)) -(debug align-uint8) -(assert equal? (number? align-uint8) #t) -(assert = align-uint8 1) - -(assert equal? (number? (pffi-align-of 'uint8)) #t) -(define align-int16 (pffi-align-of 'int16)) -(debug align-int16) -(assert equal? (number? align-int16) #t) -(assert = align-int16 2) - -(assert equal? (number? (pffi-align-of 'int16)) #t) -(define align-uint16 (pffi-align-of 'uint16)) -(debug align-uint16) -(assert equal? (number? align-uint16) #t) -(assert = align-uint16 2) - -(assert equal? (number? (pffi-align-of 'uint16)) #t) -(define align-int32 (pffi-align-of 'int32)) -(debug align-int32) -(assert equal? (number? align-int32) #t) -(assert = align-int32 4) - -(assert equal? (number? (pffi-align-of 'int32)) #t) -(define align-uint32 (pffi-align-of 'uint32)) -(debug align-uint32) -(assert equal? (number? align-uint32) #t) -(assert = align-uint32 4) - -(assert equal? (number? (pffi-align-of 'uint32)) #t) -(define align-int64 (pffi-align-of 'int64)) -(debug align-int64) -(assert equal? (number? align-int64) #t) -(assert = align-int64 8) - -(assert equal? (number? (pffi-align-of 'int64)) #t) -(define align-uint64 (pffi-align-of 'uint64)) -(debug align-uint64) -(assert equal? (number? align-uint64) #t) -(assert = align-uint64 8) - -(assert equal? (number? (pffi-align-of 'uint64)) #t) -(define align-char (pffi-align-of 'char)) -(debug align-char) -(assert equal? (number? align-char) #t) -(assert = align-char 1) - -(assert equal? (number? (pffi-align-of 'char)) #t) -(define align-unsigned-char (pffi-align-of 'unsigned-char)) -(debug align-unsigned-char) -(assert equal? (number? align-unsigned-char) #t) -(assert = align-unsigned-char 1) - -(assert equal? (number? (pffi-align-of 'unsigned-char)) #t) -(define align-short (pffi-align-of 'short)) -(debug align-short) -(assert equal? (number? align-short) #t) -(assert = align-short 2) - -(assert equal? (number? (pffi-align-of 'short)) #t) -(define align-unsigned-short (pffi-align-of 'unsigned-short)) -(debug align-unsigned-short) -(assert equal? (number? align-unsigned-short) #t) -(assert = align-unsigned-short 2) - -(assert equal? (number? (pffi-align-of 'unsigned-short)) #t) -(define align-int (pffi-align-of 'int)) -(debug align-int) -(assert equal? (number? align-int) #t) -(assert = align-int 4) - -(assert equal? (number? (pffi-align-of 'int)) #t) -(define align-unsigned-int (pffi-align-of 'unsigned-int)) -(debug align-unsigned-int) -(assert equal? (number? align-unsigned-int) #t) -(assert = align-unsigned-int 4) - -(cond-expand - (i386 - (assert equal? (number? (pffi-align-of 'long)) #t) - (define align-long (pffi-align-of 'long)) - (debug align-long) - (assert equal? (number? align-long) #t) - (assert = align-long 4)) - (else - (assert equal? (number? (pffi-align-of 'long)) #t) - (define align-long (pffi-align-of 'long)) - (debug align-long) - (assert equal? (number? align-long) #t) - (assert = align-long 8))) - -(cond-expand - (i386 - (assert equal? (number? (pffi-align-of 'unsigned-long)) #t) - (define align-unsigned-long (pffi-align-of 'unsigned-long)) - (debug align-unsigned-long) - (assert equal? (number? align-unsigned-long) #t) - (assert = align-unsigned-long 4)) - (else - (assert equal? (number? (pffi-align-of 'long)) #t) - (define align-unsigned-long (pffi-align-of 'unsigned-long)) - (debug align-unsigned-long) - (assert equal? (number? align-unsigned-long) #t) - (assert = align-unsigned-long 8))) - -(assert equal? (number? (pffi-align-of 'float)) #t) -(define align-float (pffi-align-of 'float)) -(debug align-float) -(assert equal? (number? align-float) #t) -(assert = align-float 4) - -(assert equal? (number? (pffi-align-of 'double)) #t) -(define align-double (pffi-align-of 'double)) -(debug align-double) -(assert equal? (number? align-double) #t) -(assert = align-double 8) - -(cond-expand - (i386 - (define align-pointer (pffi-align-of 'pointer)) - (debug align-pointer) - (assert equal? (number? align-pointer) #t) - (assert = align-pointer 4)) - (else - (define align-pointer (pffi-align-of 'pointer)) - (debug align-pointer) - (assert equal? (number? align-pointer) #t) - (assert = align-pointer 8))) - -;; pffi-define-library +;; define-c-library (print-header 'pffi-define-library) (cond-expand - (windows (pffi-define-library libc-stdlib + (windows (define-c-library libc-stdlib '("stdlib.h") "ucrtbase" '((additional-versions ("0" "6"))))) - (else (pffi-define-library libc-stdlib + (else (define-c-library libc-stdlib '("stdlib.h") "c" '((additional-versions ("0" "6")))))) @@ -416,108 +416,146 @@ (debug libc-stdlib) (cond-expand - (windows (pffi-define-library libc-stdio + (windows (define-c-library libc-stdio '("stdio.h") "ucrtbase" '((additional-versions ("0" "6"))))) - (else (pffi-define-library libc-stdio + (else (define-c-library libc-stdio '("stdio.h") "c" '((additional-versions ("0" "6")))))) (debug libc-stdio) -(pffi-define-library c-testlib +(define-c-library c-testlib '("libtest.h") "test" '((additional-paths ("." "./tests")))) (debug c-testlib) -;; pffi-pointer-null +;; define-c-procedure -(print-header 'pffi-pointer-null) +(print-header 'define-c-procedure) -(define null-pointer (pffi-pointer-null)) +(define-c-procedure c-abs libc-stdlib 'abs 'int '(int)) +(debug c-abs) +(define absoluted (c-abs -2)) +(debug absoluted) +(assert = absoluted 2) + +(define-c-procedure c-puts libc-stdlib 'puts 'int '(pointer)) +(debug c-puts) +(define chars-written (c-puts (string->c-bytevector "puts: Hello from testing, I am C function puts"))) +(debug chars-written) +(assert = chars-written 47) + +(define-c-procedure c-atoi libc-stdlib 'atoi 'int '(pointer)) +(assert = (c-atoi (string->c-bytevector "100")) 100) + +(define-c-procedure c-fopen libc-stdio 'fopen 'pointer '(pointer pointer)) +(define output-file (c-fopen (string->c-bytevector "testfile.test") + (string->c-bytevector "w"))) +(debug output-file) +(define-c-procedure c-fprintf libc-stdio 'fprintf 'int '(pointer pointer)) +(define characters-written + (c-fprintf output-file (string->c-bytevector "Hello world"))) +(debug characters-written) +(assert equal? (= characters-written 11) #t) +(define-c-procedure c-fclose libc-stdio 'fclose 'int '(pointer)) +(define closed-status (c-fclose output-file)) +(debug closed-status) +(assert equal? (= closed-status 0) #t) +(assert equal? (file-exists? "testfile.test") #t) +(assert equal? (string=? (with-input-from-file "testfile.test" + (lambda () (read-line))) + "Hello world") #t) + +(define-c-procedure c-takes-no-args c-testlib 'takes_no_args 'void '()) +(debug c-takes-no-args) +(c-takes-no-args) + +(define-c-procedure c-takes-no-args-returns-int c-testlib 'takes_no_args_returns_int 'int '()) +(debug c-takes-no-args) +(define takes-no-args-returns-int-result (c-takes-no-args-returns-int)) +(assert equal? (= takes-no-args-returns-int-result 0) #t) + +;; c-bytevector? + +(print-header 'c-bytevector?) + +(define is-pointer (make-c-bytevector 100)) +(debug is-pointer) +(assert equal? (c-bytevector? is-pointer) #t) +;(assert equal? (c-bytevector? 100) #f) +(assert equal? (c-bytevector? 'bar) #f) + +;; make-c-null + +(print-header 'make-c-null) + +(define null-pointer (make-c-null)) (debug null-pointer) -(assert equal? (pffi-pointer-null? null-pointer) #t) +(assert equal? (c-null? null-pointer) #t) -;; pffi-pointer-null? +;; c-null? -(print-header 'pffi-pointer-null?) +(print-header 'c-null?) -(define is-null-pointer (pffi-pointer-null)) +(define is-null-pointer (make-c-null)) (debug is-null-pointer) -(assert equal? (pffi-pointer-null? is-null-pointer) #t) -(assert equal? (pffi-pointer-null? 100) #f) -(assert equal? (pffi-pointer-null? 'bar) #f) +(assert equal? (c-null? is-null-pointer) #t) +(assert equal? (c-null? 100) #f) +(assert equal? (c-null? 'bar) #f) -;; pffi-pointer-allocate +;;make-c-bytevector -(print-header 'pffi-pointer-allocate) +(print-header 'make-c-bytevector ) -(define test-pointer (pffi-pointer-allocate 100)) +(define test-pointer (make-c-bytevector 100)) (debug test-pointer) -(assert equal? (pffi-pointer? test-pointer) #t) -;(assert equal? (pffi-pointer? 0) #f) -;(assert equal? (pffi-pointer? #t) #f) -;(assert equal? (pffi-pointer? "Hello world") #f) -(assert equal? (pffi-pointer-null? test-pointer) #f) +(assert equal? (c-bytevector? test-pointer) #t) +;(assert equal? (c-bytevector? 0) #f) +;(assert equal? (c-bytevector? #t) #f) +;(assert equal? (c-bytevector? "Hello world") #f) +(assert equal? (c-null? test-pointer) #f) -;; pffi-pointer-address +;; call-with-address-of-c-bytevector -(print-header 'pffi-pointer-allocate) -(pffi-define-function test-passing-pointer-address +(print-header 'call-with-address-of-c-bytevector) + +(define-c-procedure test-passing-pointer-address c-testlib 'test_passing_pointer_address 'int '(pointer pointer)) -(pffi-define-function pa c-testlib 'pa 'pointer '(pointer)) -(pffi-define-function printa c-testlib 'printa 'void '(pointer)) -(define test-pointer1 (pffi-pointer-allocate 100)) -(debug test-pointer1) -(debug (pffi-pointer? test-pointer1)) -(assert equal? (pffi-pointer? test-pointer1) #t) -(debug (pffi-pointer-address test-pointer1)) - -(define input-pointer (pffi-pointer-allocate (pffi-size-of 'int))) +(define input-pointer (make-c-bytevector (c-size-of 'int))) (pffi-pointer-set! input-pointer 'int 0 100) -(define input-pointer-address (pffi-pointer-address input-pointer)) -(debug input-pointer-address) -(test-passing-pointer-address input-pointer input-pointer-address) -(debug input-pointer) -(debug input-pointer-address) (debug (pffi-pointer-get input-pointer 'int 0)) -;(assert equal? (pffi-pointer? input-pointer-address) #t) -;(assert equal? (= (pffi-pointer-get input-pointer 'int 0) 42) #t) -;(assert equal? (> (pffi-pointer-address test-pointer1) 0) #t) +(call-with-address-of-c-bytevector + input-pointer + (lambda (address) + (test-passing-pointer-address input-pointer address))) +(debug input-pointer) +(debug (pffi-pointer-get input-pointer 'int 0)) +(assert equal? (= (pffi-pointer-get input-pointer 'int 0) 42) #t) -;; pffi-pointer? +;; c-free -(print-header 'pffi-pointer?) +(print-header 'c-free) -(define is-pointer (pffi-pointer-allocate 100)) -(debug is-pointer) -(assert equal? (pffi-pointer? is-pointer) #t) -;(assert equal? (pffi-pointer? 100) #f) -(assert equal? (pffi-pointer? 'bar) #f) - -;; pffi-pointer-free - -(print-header 'pffi-pointer-free) - -(define pointer-to-be-freed (pffi-pointer-allocate 100)) +(define pointer-to-be-freed (make-c-bytevector 100)) (debug pointer-to-be-freed) -(pffi-pointer-free pointer-to-be-freed) +(c-free pointer-to-be-freed) (debug pointer-to-be-freed) ;; pffi-pointer-set! and pffi-pointer-get 1/2 (print-header "pffi-pointer-set! and pffi-pointer-get 1/2") -(define set-pointer (pffi-pointer-allocate 256)) +(define set-pointer (make-c-bytevector 256)) (define offset 64) (define value 1) (debug set-pointer) @@ -573,32 +611,32 @@ (pffi-define-struct test-struct1 'teststruct1 '((int . r) (int . g) (int . b))) (define struct1 (test-struct1)) (debug struct1) -(debug (pffi-size-of struct1)) -(assert = (pffi-size-of struct1) 12) +(debug (c-size-of struct1)) +(assert = (c-size-of struct1) 12) (pffi-define-struct test-struct2 'test2 '((int8 . r) (int8 . g) (int . b))) (define struct2 (test-struct2)) (debug struct2) -(debug (pffi-size-of struct2)) -(assert = (pffi-size-of struct2) 8) +(debug (c-size-of struct2)) +(assert = (c-size-of struct2) 8) (pffi-define-struct test-struct3 'test3 '((int8 . r) (int8 . g) (int . b))) (define struct3 (test-struct3)) (debug struct3) -(debug (pffi-size-of struct3)) -(assert = (pffi-size-of struct3) 8) +(debug (c-size-of struct3)) +(assert = (c-size-of struct3) 8) (pffi-define-struct test-struct4 'test4 '((int8 . r) (pointer . a) (int8 . g) (int . b))) (define struct4 (test-struct4)) (debug struct4) -(debug (pffi-size-of struct4)) -(assert = (pffi-size-of struct4) 24) +(debug (c-size-of struct4)) +(assert = (c-size-of struct4) 24) (pffi-define-struct test-struct5 'test5 '((int8 . r) (char . b) (pointer . a) (int8 . g) (int . b))) (define struct5 (test-struct5)) (debug struct5) -(debug (pffi-size-of struct5)) -(assert = (pffi-size-of struct5) 24) +(debug (c-size-of struct5)) +(assert = (c-size-of struct5) 24) (pffi-define-struct test-struct6 'test6 '((int8 . a) (char . b) @@ -616,18 +654,33 @@ (float . n))) (define struct6 (test-struct6)) (debug struct6) -(debug (pffi-size-of struct6)) -(assert = (pffi-size-of struct6) 96) +(debug (c-size-of struct6)) +(assert = (c-size-of struct6) 96) -;; pffi-string->pointer +;; bytevector->c-bytevector c-bytevector->bytevector -(print-header 'pffi-string->pointer) +(print-header "bytevector->c-bytevector c-bytevector->bytevector") -(define string-pointer (pffi-string->pointer "Hello world")) +(define bt1 (bytevector 1 2 3 4 5 6 7 8)) +(debug bt1) +(define btp1 (bytevector->c-bytevector bt1)) +(debug btp1) +(assert equal? (c-bytevector? btp1) #t) +(define bt2 (c-bytevector->bytevector btp1 (bytevector-length bt1))) +(debug bt2) +(assert equal? (bytevector? bt2) #t) +(debug (list bt1 bt2)) +(assert equal? bt1 bt2) + +;; string->c-bytevector + +(print-header 'string->c-bytevector) + +(define string-pointer (string->c-bytevector "Hello world")) (debug string-pointer) -(debug (pffi-pointer->string string-pointer)) -(assert equal? (pffi-pointer? string-pointer) #t) -(assert equal? (pffi-pointer-null? string-pointer) #f) +(debug (c-bytevector->string string-pointer)) +(assert equal? (c-bytevector? string-pointer) #t) +(assert equal? (c-null? string-pointer) #f) (debug (pffi-pointer-get string-pointer 'char 0)) (assert char=? (pffi-pointer-get string-pointer 'char 0) #\H) (debug (pffi-pointer-get string-pointer 'char 1)) @@ -641,28 +694,28 @@ (debug (pffi-pointer-get string-pointer 'char 10)) (assert char=? (pffi-pointer-get string-pointer 'char 10) #\d) -;; pffi-pointer->string +;; c-bytevector->string -(print-header 'pffi-pointer->string) +(print-header 'c-bytevector->string) -(define pointer-string (pffi-pointer->string string-pointer)) +(define pointer-string (c-bytevector->string string-pointer)) (debug pointer-string) (assert equal? (string? pointer-string) #t) (assert string=? pointer-string "Hello world") -(assert string=? (pffi-pointer->string (pffi-string->pointer "https://scheme.org")) "https://scheme.org") +(assert string=? (c-bytevector->string (string->c-bytevector "https://scheme.org")) "https://scheme.org") (define test-url-string "https://scheme.org") (debug test-url-string) -(define test-url (pffi-string->pointer test-url-string)) +(define test-url (string->c-bytevector test-url-string)) (debug test-url) -(debug (pffi-pointer->string test-url)) -(assert equal? (string=? (pffi-pointer->string test-url) test-url-string) #t) +(debug (c-bytevector->string test-url)) +(assert equal? (string=? (c-bytevector->string test-url) test-url-string) #t) ;; pffi-pointer-get (print-header "pffi-pointer-get") (define hello-string "hello") -(define hello-string-pointer (pffi-string->pointer hello-string)) +(define hello-string-pointer (string->c-bytevector hello-string)) (debug (pffi-pointer-get hello-string-pointer 'char 0)) (assert char=? (pffi-pointer-get hello-string-pointer 'char 0) #\h) @@ -675,81 +728,36 @@ (print-header "pffi-pointer-set! and pffi-pointer-get 2/2") -(define pointer-to-be-set (pffi-string->pointer "FOOBAR")) +(define pointer-to-be-set (string->c-bytevector "FOOBAR")) (debug pointer-to-be-set) -(debug (pffi-pointer->string pointer-to-be-set)) +(debug (c-bytevector->string pointer-to-be-set)) (pffi-pointer-set! set-pointer 'pointer offset pointer-to-be-set) (debug (pffi-pointer-get set-pointer 'pointer offset)) (assert equal? - (pffi-pointer? (pffi-pointer-get set-pointer 'pointer offset)) + (c-bytevector? (pffi-pointer-get set-pointer 'pointer offset)) #t) -(debug (pffi-pointer->string (pffi-pointer-get set-pointer 'pointer offset))) +(debug (c-bytevector->string (pffi-pointer-get set-pointer 'pointer offset))) (assert equal? - (string? (pffi-pointer->string (pffi-pointer-get set-pointer 'pointer offset))) + (string? (c-bytevector->string (pffi-pointer-get set-pointer 'pointer offset))) #t) -(debug (pffi-pointer->string (pffi-pointer-get set-pointer 'pointer offset))) +(debug (c-bytevector->string (pffi-pointer-get set-pointer 'pointer offset))) (assert equal? - (string=? (pffi-pointer->string (pffi-pointer-get set-pointer 'pointer offset)) "FOOBAR") + (string=? (c-bytevector->string (pffi-pointer-get set-pointer 'pointer offset)) "FOOBAR") #t) (define string-to-be-set "FOOBAR") (debug string-to-be-set) -(pffi-pointer-set! set-pointer 'pointer offset (pffi-string->pointer string-to-be-set)) -(assert string=? (pffi-pointer->string (pffi-pointer-get set-pointer 'pointer offset)) "FOOBAR") +(pffi-pointer-set! set-pointer 'pointer offset (string->c-bytevector string-to-be-set)) +(assert string=? (c-bytevector->string (pffi-pointer-get set-pointer 'pointer offset)) "FOOBAR") -;; pffi-define - -(print-header 'pffi-define) - -(pffi-define-function c-abs libc-stdlib 'abs 'int '(int)) -(debug c-abs) -(define absoluted (c-abs -2)) -(debug absoluted) -(assert = absoluted 2) - -(pffi-define-function c-puts libc-stdlib 'puts 'int '(pointer)) -(debug c-puts) -(define chars-written (c-puts (pffi-string->pointer "puts: Hello from testing, I am C function puts"))) -(debug chars-written) -(assert = chars-written 47) - -(pffi-define-function c-atoi libc-stdlib 'atoi 'int '(pointer)) -(assert = (c-atoi (pffi-string->pointer "100")) 100) - -(pffi-define-function c-fopen libc-stdio 'fopen 'pointer '(pointer pointer)) -(define output-file (c-fopen (pffi-string->pointer "testfile.test") - (pffi-string->pointer "w"))) -(debug output-file) -(pffi-define-function c-fprintf libc-stdio 'fprintf 'int '(pointer pointer)) -(define characters-written - (c-fprintf output-file (pffi-string->pointer "Hello world"))) -(debug characters-written) -(assert equal? (= characters-written 11) #t) -(pffi-define-function c-fclose libc-stdio 'fclose 'int '(pointer)) -(define closed-status (c-fclose output-file)) -(debug closed-status) -(assert equal? (= closed-status 0) #t) -(assert equal? (file-exists? "testfile.test") #t) -(assert equal? (string=? (with-input-from-file "testfile.test" - (lambda () (read-line))) - "Hello world") #t) - -(pffi-define-function c-takes-no-args c-testlib 'takes_no_args 'void '()) -(debug c-takes-no-args) -(c-takes-no-args) - -(pffi-define-function c-takes-no-args-returns-int c-testlib 'takes_no_args_returns_int 'int '()) -(debug c-takes-no-args) -(define takes-no-args-returns-int-result (c-takes-no-args-returns-int)) -(assert equal? (= takes-no-args-returns-int-result 0) #t) ;; pffi-struct-get (print-header 'pffi-struct-get) -(pffi-define-function c-init-struct c-testlib 'init_struct 'pointer '(pointer)) -(pffi-define-function c-check-offset c-testlib 'check_offset 'void '(int int)) +(define-c-procedure c-init-struct c-testlib 'init_struct 'pointer '(pointer)) +(define-c-procedure c-check-offset c-testlib 'check_offset 'void '(int int)) (pffi-define-struct struct-test-get1 'test_get1 '((int8 . a) (char . b) @@ -793,18 +801,18 @@ (debug (pffi-struct-get struct-test 'd)) (assert char=? (pffi-struct-get struct-test 'd) #\d) (debug (pffi-struct-get struct-test 'e)) -(debug (pffi-pointer-null? (pffi-struct-get struct-test 'e))) -(assert equal? (pffi-pointer-null? (pffi-struct-get struct-test 'e)) #t) +(debug (c-null? (pffi-struct-get struct-test 'e))) +(assert equal? (c-null? (pffi-struct-get struct-test 'e)) #t) (debug (pffi-struct-get struct-test 'f)) (assert = (pffi-struct-get struct-test 'f) 6.0) (debug (pffi-struct-get struct-test 'g)) -(debug (pffi-pointer->string (pffi-struct-get struct-test 'g))) -(assert equal? (string=? (pffi-pointer->string (pffi-struct-get struct-test 'g)) "FOOBAR") #t) +(debug (c-bytevector->string (pffi-struct-get struct-test 'g))) +(assert equal? (string=? (c-bytevector->string (pffi-struct-get struct-test 'g)) "FOOBAR") #t) (debug (pffi-struct-get struct-test 'h)) (assert = (pffi-struct-get struct-test 'h) 8) (debug (pffi-struct-get struct-test 'i)) -(debug (pffi-pointer-null? (pffi-struct-get struct-test 'i))) -(assert equal? (pffi-pointer-null? (pffi-struct-get struct-test 'i)) #t) +(debug (c-null? (pffi-struct-get struct-test 'i))) +(assert equal? (c-null? (pffi-struct-get struct-test 'i)) #t) (debug (pffi-struct-get struct-test 'j)) (assert = (pffi-struct-get struct-test 'j) 10) (debug (pffi-struct-get struct-test 'k)) @@ -820,7 +828,7 @@ (print-header "pffi-struct-set! 1") -(pffi-define-function c-test-check c-testlib 'test_check 'int '(pointer)) +(define-c-procedure c-test-check c-testlib 'test_check 'int '(pointer)) (pffi-define-struct struct-test-set1 'test_set1 '((int8 . a) (char . b) @@ -841,11 +849,11 @@ (pffi-struct-set! struct-test1 'b #\b) (pffi-struct-set! struct-test1 'c 3.0) (pffi-struct-set! struct-test1 'd #\d) -(pffi-struct-set! struct-test1 'e (pffi-pointer-null)) +(pffi-struct-set! struct-test1 'e (make-c-null)) (pffi-struct-set! struct-test1 'f 6.0) -(pffi-struct-set! struct-test1 'g (pffi-string->pointer "foo")) +(pffi-struct-set! struct-test1 'g (string->c-bytevector "foo")) (pffi-struct-set! struct-test1 'h 8) -(pffi-struct-set! struct-test1 'i (pffi-pointer-null)) +(pffi-struct-set! struct-test1 'i (make-c-null)) (pffi-struct-set! struct-test1 'j 10) (pffi-struct-set! struct-test1 'k 11) (pffi-struct-set! struct-test1 'l 12) @@ -857,7 +865,7 @@ ;(print-header "pffi-struct constructor with pointer") -;(pffi-define-function c-test-new c-testlib 'test_new 'pointer '()) +;(define-c-procedure c-test-new c-testlib 'test_new 'pointer '()) ;(define struct-test2-pointer (c-test-new)) #;(define struct-test2 (pffi-struct-make 'test '((int8 . a) @@ -888,17 +896,17 @@ ;(debug (pffi-struct-get struct-test2 'd)) ;(assert char=? (pffi-struct-get struct-test2 'd) #\d) ;(debug (pffi-struct-get struct-test2 'e)) -;(debug (pffi-pointer-null? (pffi-struct-get struct-test2 'e))) -;(assert equal? (pffi-pointer-null? (pffi-struct-get struct-test2 'e)) #t) +;(debug (c-null? (pffi-struct-get struct-test2 'e))) +;(assert equal? (c-null? (pffi-struct-get struct-test2 'e)) #t) ;(debug (pffi-struct-get struct-test2 'f)) ;(assert = (pffi-struct-get struct-test2 'f) 6.0) -;(debug (pffi-pointer->string (pffi-struct-get struct-test2 'g))) -;(assert equal? (string=? (pffi-pointer->string (pffi-struct-get struct-test2 'g)) "FOOBAR") #t) +;(debug (c-bytevector->string (pffi-struct-get struct-test2 'g))) +;(assert equal? (string=? (c-bytevector->string (pffi-struct-get struct-test2 'g)) "FOOBAR") #t) ;(debug (pffi-struct-get struct-test2 'h)) ;(assert = (pffi-struct-get struct-test2 'h) 8) ;(debug (pffi-struct-get struct-test2 'i)) -;(debug (pffi-pointer-null? (pffi-struct-get struct-test2 'i))) -;(assert (lambda (p t) (pffi-pointer-null? p)) (pffi-struct-get struct-test2 'i) #t) +;(debug (c-null? (pffi-struct-get struct-test2 'i))) +;(assert (lambda (p t) (c-null? p)) (pffi-struct-get struct-test2 'i) #t) ;(debug (pffi-struct-get struct-test2 'j)) ;(assert = (pffi-struct-get struct-test2 'j) 10) ;(debug (pffi-struct-get struct-test2 'k)) @@ -919,10 +927,10 @@ (debug (pffi-list->array 'int test-list1)) (assert equal? (pffi-array->list (pffi-list->array 'int test-list1)) test-list1) -(define test-array1 (pffi-pointer-allocate (* (pffi-size-of 'int) 3))) -(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 0) 4) -(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 1) 5) -(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 2) 6) +(define test-array1 (make-c-bytevector (* (c-size-of 'int) 3))) +(pffi-pointer-set! test-array1 'int (* (c-size-of 'int) 0) 4) +(pffi-pointer-set! test-array1 'int (* (c-size-of 'int) 1) 5) +(pffi-pointer-set! test-array1 'int (* (c-size-of 'int) 2) 6) (debug test-array1) (debug (pffi-array->list (pffi-pointer->array test-array1 'int 3))) (define check-list1 (list 4 5 6)) @@ -941,7 +949,7 @@ ;; pffi-struct-dereference 1 ;(print-header "pffi-struct-dereference 1") -;(pffi-define-function c-color-check-by-value c-testlib 'color_check_by_value 'int '((struct . color))) +;(define-c-procedure c-color-check-by-value c-testlib 'color_check_by_value 'int '((struct . color))) #;(pffi-define-struct make-struct-color 'color '((int8 . r) (int8 . g) (int8 . b) @@ -957,7 +965,7 @@ ;(print-header "pffi-struct-dereference 2") -;(pffi-define-function c-test-check-by-value c-testlib 'test_check_by_value 'int '((struct . test))) +;(define-c-procedure c-test-check-by-value c-testlib 'test_check_by_value 'int '((struct . test))) #;(pffi-define-struct make-struct-test-dereference2 'test '((int8 . a) @@ -979,11 +987,11 @@ ;(debug (pffi-struct-set! struct-test3 'b #\b)) ;(debug (pffi-struct-set! struct-test3 'c 3.0)) ;(debug (pffi-struct-set! struct-test3 'd #\d)) -;(debug (pffi-struct-set! struct-test3 'e (pffi-pointer-null))) +;(debug (pffi-struct-set! struct-test3 'e (make-c-null))) ;(debug (pffi-struct-set! struct-test3 'f 6.0)) -;(debug (pffi-struct-set! struct-test3 'g (pffi-string->pointer "foo"))) +;(debug (pffi-struct-set! struct-test3 'g (string->c-bytevector "foo"))) ;(debug (pffi-struct-set! struct-test3 'h 8)) -;(debug (pffi-struct-set! struct-test3 'i (pffi-pointer-null))) +;(debug (pffi-struct-set! struct-test3 'i (make-c-null))) ;(debug (pffi-struct-set! struct-test3 'j 10)) ;(debug (pffi-struct-set! struct-test3 'k 11)) ;(debug (pffi-struct-set! struct-test3 'l 12)) @@ -1009,12 +1017,12 @@ ;(print-header 'pffi-define-callback) -;(define array (pffi-pointer-allocate (* (pffi-size-of 'int) 3))) -;(pffi-pointer-set! array 'int (* (pffi-size-of 'int) 0) 3) -;(pffi-pointer-set! array 'int (* (pffi-size-of 'int) 1) 2) -;(pffi-pointer-set! array 'int (* (pffi-size-of 'int) 2) 1) +;(define array (make-c-bytevector (* (c-size-of 'int) 3))) +;(pffi-pointer-set! array 'int (* (c-size-of 'int) 0) 3) +;(pffi-pointer-set! array 'int (* (c-size-of 'int) 1) 2) +;(pffi-pointer-set! array 'int (* (c-size-of 'int) 2) 1) -;(pffi-define-function qsort libc-stdlib 'qsort 'void '(pointer int int callback)) +;(define-c-procedure qsort libc-stdlib 'qsort 'void '(pointer int int callback)) #;(pffi-define-callback compare 'int @@ -1028,17 +1036,17 @@ ;(write compare) ;(newline) -#;(define unsorted (list (pffi-pointer-get array 'int (* (pffi-size-of 'int) 0)) - (pffi-pointer-get array 'int (* (pffi-size-of 'int) 1)) - (pffi-pointer-get array 'int (* (pffi-size-of 'int) 2)))) +#;(define unsorted (list (pffi-pointer-get array 'int (* (c-size-of 'int) 0)) + (pffi-pointer-get array 'int (* (c-size-of 'int) 1)) + (pffi-pointer-get array 'int (* (c-size-of 'int) 2)))) ;(debug unsorted) ;(assert equal? unsorted (list 3 2 1)) -;(qsort array 3 (pffi-size-of 'int) compare) +;(qsort array 3 (c-size-of 'int) compare) -#;(define sorted (list (pffi-pointer-get array 'int (* (pffi-size-of 'int) 0)) - (pffi-pointer-get array 'int (* (pffi-size-of 'int) 1)) - (pffi-pointer-get array 'int (* (pffi-size-of 'int) 2)))) +#;(define sorted (list (pffi-pointer-get array 'int (* (c-size-of 'int) 0)) + (pffi-pointer-get array 'int (* (c-size-of 'int) 1)) + (pffi-pointer-get array 'int (* (c-size-of 'int) 2)))) ;(debug sorted) ;(assert equal? sorted (list 1 2 3))