From 5e3a23886a13a130c837c83cb4ccd5135f1d12d6 Mon Sep 17 00:00:00 2001 From: Leif Andersen Date: Fri, 22 Sep 2017 23:15:28 -0400 Subject: [PATCH] Make compute-offsets public. (#1814) Make compute-offsets public. --- pkgs/base/info.rkt | 2 +- .../scribblings/foreign/types.scrbl | 27 +++++++++++++++++++ .../tests/racket/cstruct.rktl | 10 +++++++ racket/collects/ffi/unsafe.rkt | 12 ++++++--- racket/src/racket/src/schvers.h | 4 +-- 5 files changed, 48 insertions(+), 7 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 7638c96c94..7ef8766652 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "6.10.1.1") +(define version "6.10.1.2") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-doc/scribblings/foreign/types.scrbl index 34f975354e..4ed4fdbb73 100644 --- a/pkgs/racket-doc/scribblings/foreign/types.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/types.scrbl @@ -1402,6 +1402,33 @@ expects arguments for both the super fields and the new ones: #:changed "6.1.1.8" @elem{Added @racket[#:offset] for fields.} #:changed "6.3.0.13" @elem{Added @racket[#:define-unsafe].}]} +@defproc[(compute-offsets [types (listof ctype?)] + [alignment (or/c #f 1 2 4 8 16) #f] + [declare (listof (or/c #f exact-integer?)) '()]) + (listof exact-integer?)]{ + + Given a list of types in a C struct type, return the offset + of those types. + + The @racket[types] list describes a C struct type and is + identical to the list in @racket[make-cstruct-type]. + + The C struct's alignment is set with @racket[alignment] + The behavior is identical to @racket[make-cstruct-type]. + + Explicit positions can be set with @racket[declare]. If + provided, it is a list with the same length as as + @racket[types]. At each index, if a number is provided, that + type is at that offset. Otherwise, the type is + @racket[alignment] bytes after the offset. + + @examples[#:eval ffi-eval + (compute-offsets (list _int _bool _short)) + (compute-offsets (list _int _bool _short) 1) + (compute-offsets (list _int _int _int) #f (list #f 5 #f))] + + @history[#:added "6.10.1.2"]} + @; ------------------------------------------------------------ @section{C Array Types} diff --git a/pkgs/racket-test-core/tests/racket/cstruct.rktl b/pkgs/racket-test-core/tests/racket/cstruct.rktl index 3a4821c920..2d2c5c7e59 100644 --- a/pkgs/racket-test-core/tests/racket/cstruct.rktl +++ b/pkgs/racket-test-core/tests/racket/cstruct.rktl @@ -155,6 +155,16 @@ (test #f equal? b (cast b _B-pointer _B-pointer))) ; cast forces new wrapper +;; ---------------------------------------- +;; Check to ensure offsets are computed correctly + +(let () + (test '(0 4 8) compute-offsets (list _int _bool _string)) + (test '(0 4 5 8) compute-offsets (list _int _byte _byte _int)) + (test '(0 4 5 6) compute-offsets (list _int _byte _byte _int) 1) + (test '(5 4 3 2) compute-offsets (list _int _byte _byte _int) #f (list 5 4 3 2)) + (test '(0 5 6 8) compute-offsets (list _int _byte _byte _int) #f (list #f 5 #f #f))) + ;; ---------------------------------------- (report-errs) diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index da34218faa..c7c8248438 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -1410,10 +1410,14 @@ ;; ---------------------------------------------------------------------------- ;; Struct wrappers -(define (compute-offsets types alignment declared) - (let ([alignment (if (memq alignment '(#f 1 2 4 8 16)) - alignment - #f)]) +(define* (compute-offsets types [alignment #f] [declared '()]) + (unless (and (list? types) (map ctype? types)) + (raise-argument-error 'compute-offsets "(listof ctype?)" types)) + (unless (memq alignment '(#f 1 2 4 8 16)) + (raise-argument-error 'compute-offsets "(or/c #f 1 2 4 8 16)" alignment)) + (unless (and (list? declared) (map (λ (v) (or (not v) (exact-integer? v))) declared)) + (raise-argument-error 'compute-offsets "(listof (or/c exact-integer? #f))" declared)) + (let ([declared (append declared (build-list (- (length types) (length declared)) (λ (n) #f)))]) (let loop ([ts types] [ds declared] [cur 0] [r '()]) (if (null? ts) (reverse r) diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 69e590a67f..c54edf54ae 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.10.1.1" +#define MZSCHEME_VERSION "6.10.1.2" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 10 #define MZSCHEME_VERSION_Z 1 -#define MZSCHEME_VERSION_W 1 +#define MZSCHEME_VERSION_W 2 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)