diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl index 89af119141..4250f72063 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/foreign/types.scrbl @@ -1399,7 +1399,7 @@ is to throw an exception. @examples[#:eval ffi-eval (code:comment "example from snappy-c.h") - (define _snappy_status + (define @#,racketidfont{_snappy_status} (_enum '(ok = 0 invalid_input buffer_too_small))) @@ -1409,14 +1409,21 @@ is to throw an exception. ctype?]{ Similar to @racket[_enum], but the resulting mapping translates a list -of symbols to a number and back, using @racket[bitwise-ior]. A single -symbol is equivalent to a list containing just the symbol. The -default @racket[basetype] is @racket[_uint], since high bits are often -used for flags. +of symbols to a number and back, using @racket[bitwise-ior] on the +values of individual symbols, where A single symbol is equivalent to a +list containing just the symbol. + +When a symbol does not have a given value (via @racket['=] after the +symbol in @racket[symbols]), its value is the next power of 2 greater +than the previous symbol's assignment (or @racket[1] for the first +symbol). + +The default @racket[basetype] is @racket[_uint], since high bits are +often used for flags. @examples[#:eval ffi-eval (code:comment "example from curl.h") - (define _curl_global_flag + (define @#,racketidfont{_curl_global_flag} (_bitmask `(CURL_GLOBAL_SSL = 1 CURL_GLOBAL_WIN32 = 2 CURL_GLOBAL_ALL = 3 @@ -1424,7 +1431,7 @@ used for flags. CURL_GLOBAL_DEFAULT = 3 CURL_GLOBAL_ACK_EINTR = 4))) (code:comment "example from XOrg") - (define _Modifiers + (define @#,racketidfont{_Modifiers} (_bitmask '(ShiftMask = #b0000000000001 LockMask = #b0000000000010 ControlMask = #b0000000000100 diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl index 7f85b9ad94..bb925aeabf 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/foreign-test.rktl @@ -130,6 +130,21 @@ (test 21 ctype-sizeof (_array _byte 3 7)) +;; Test enum and bitmask +(define ([t (_enum '(a b c = 4 d))] + [s (_bitmask '(a b c = 14 d))]) + (define (check t v n) + (test n (cast v t _int))) + (check t 'a 0) + (check t 'b 1) + (check t 'c 4) + (check t 'd 5) + (check t 'a 1) + (check t 'b 2) + (check t 'c 14) + (check t 'd 16) + (check t '(a b) 3)) + (define-cstruct _ic7i ([i1 _int] [c7 _c7_list] [i2 _int])) diff --git a/racket/collects/ffi/unsafe.rkt b/racket/collects/ffi/unsafe.rkt index 2e731066c6..9f90126829 100644 --- a/racket/collects/ffi/unsafe.rkt +++ b/racket/collects/ffi/unsafe.rkt @@ -828,23 +828,25 @@ ;; the above with '= -- but the numbers have to be specified in some way. The ;; generated type will convert a list of these symbols into the logical-or of ;; their values and back. -(define (_bitmask name orig-symbols->integers . base?) +(define (_bitmask name orig-s->i . base?) (define basetype (if (pair? base?) (car base?) _uint)) (define s->c (if name (string->symbol (format "bitmask:~a->int" name)) 'bitmask->int)) (define symbols->integers - (let loop ([s->i orig-symbols->integers]) + (let loop ([s->i orig-s->i] [last 0]) (cond [(null? s->i) null] [(and (pair? (cdr s->i)) (eq? '= (cadr s->i)) (pair? (cddr s->i))) (cons (list (car s->i) (caddr s->i)) - (loop (cdddr s->i)))] + (loop (cdddr s->i) (integer-length (caddr s->i))))] [(and (pair? (car s->i)) (pair? (cdar s->i)) (null? (cddar s->i)) (symbol? (caar s->i)) (integer? (cadar s->i))) - (cons (car s->i) (loop (cdr s->i)))] + (cons (car s->i) (loop (cdr s->i) (integer-length (cadar s->i))))] + [(symbol? (car s->i)) + (cons (list (car s->i) (arithmetic-shift 1 last)) (loop (cdr s->i) (add1 last)))] [else - (error '_bitmask "bad spec in ~e" orig-symbols->integers)]))) + (error '_bitmask "bad spec in ~e" orig-s->i)]))) (make-ctype basetype (lambda (symbols) (if (null? symbols) ; probably common