diff --git a/racket/collects/net/osx-ssl.rkt b/racket/collects/net/osx-ssl.rkt index 2909c24364..6a5029a7cf 100644 --- a/racket/collects/net/osx-ssl.rkt +++ b/racket/collects/net/osx-ssl.rkt @@ -18,6 +18,7 @@ (define (osx-old-openssl?) (and (eq? 'macosx (system-type)) + (not (eq? 'ppc (system-type 'arch))) ; Mac OS 10.5 is too old for this to work? (or (not ssl-available?) (not (memq 'tls12 (supported-client-protocols)))))) diff --git a/racket/src/ChezScheme/csug/foreign.stex b/racket/src/ChezScheme/csug/foreign.stex index 3e99d48615..73714991cc 100644 --- a/racket/src/ChezScheme/csug/foreign.stex +++ b/racket/src/ChezScheme/csug/foreign.stex @@ -1295,7 +1295,7 @@ the C stack is reset to its original value. The procedures described in this section directly create and manipulate foreign data, i.e., data that resides outside of the Scheme heap. -With the exception of \scheme{foreign-alloc} and \scheme{foreign-sizeof}, +With the exception of \scheme{foreign-alloc}, \scheme{foreign-sizeof}, and \scheme{foreign-alignof}, these procedures are inherently unsafe in the sense that they do not (and cannot) check the validity of the addresses they are passed. Improper use of these procedures can result in invalid memory references, @@ -1474,6 +1474,17 @@ For multiple-byte values, the native endianness of the machine is assumed. of \scheme{foreign-ref} above. +%---------------------------------------------------------------------------- +\entryheader +\formdef{foreign-alignof}{\categoryprocedure}{(foreign-alignof \var{type})} +\returns the alignment in bytes of \var{type} +\listlibraries +\endentryheader + +\var{type} must be one of the symbols listed in the description +of \scheme{foreign-ref} above. + + %---------------------------------------------------------------------------- \entryheader\label{defn:define-ftype} \formdef{define-ftype}{\categorysyntax}{(define-ftype \var{ftype-name} \var{ftype})} diff --git a/racket/src/ChezScheme/s/cp0.ss b/racket/src/ChezScheme/s/cp0.ss index 3ec7595e5d..8016d20240 100644 --- a/racket/src/ChezScheme/s/cp0.ss +++ b/racket/src/ChezScheme/s/cp0.ss @@ -2333,7 +2333,7 @@ (residualize-seq '() (list c) ctxt) `(quote ,(and (memv dc (if-feature windows '(#\\ #\/) '(#\/))) #t)))]) - (define-inline 2 foreign-sizeof + (define-inline 2 (foreign-sizeof foreign-alignof) [(x) (and (okay-to-handle?) (let ([xval (value-visit-operand! x)]) (nanopass-case (Lsrc Expr) (result-exp xval) @@ -2344,7 +2344,13 @@ [(_ type bytes pred) (begin (residualize-seq '() (list x) ctxt) - `(quote ,bytes))])) + `(quote ,(cond + [(eq? prim-name 'foreign-alignof) + (case 'type + [(double-float single-float) (gcd (constant max-float-alignment) bytes)] + [(integer-64 unsigned-64) (gcd (constant max-integer-alignment) bytes)] + [else bytes])] + [else bytes])))])) (record-datatype cases (filter-foreign-type d) size #f))] [else #f])))]) diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss index 0578e432c0..2c65a56cbf 100644 --- a/racket/src/ChezScheme/s/primdata.ss +++ b/racket/src/ChezScheme/s/primdata.ss @@ -1350,6 +1350,7 @@ (foreign-address-name [sig [(uptr/iptr) -> (maybe-string)]] [flags discard]) (foreign-callable-entry-point [sig [(code) -> (uint)]] [flags discard]) (foreign-callable-code-object [sig [(sint) -> (code)]] [flags discard]) + (foreign-alignof [sig [(sub-symbol) -> (fixnum)]] [flags pure true cp02]) (foreign-alloc [sig [(pfixnum) -> (uint)]] [flags discard true]) (foreign-free [sig [(sub-uint) -> (void)]] [flags true]) (foreign-ref [sig [(sub-symbol uptr/iptr uptr/iptr) -> (ptr)]] [flags]) diff --git a/racket/src/ChezScheme/s/record.ss b/racket/src/ChezScheme/s/record.ss index 71537ece10..482ba4c11a 100644 --- a/racket/src/ChezScheme/s/record.ss +++ b/racket/src/ChezScheme/s/record.ss @@ -509,6 +509,21 @@ (record-datatype cases (filter-foreign-type ty) size ($oops who "invalid foreign type specifier ~s" ty)))) + (set-who! foreign-alignof + (lambda (ty) + (define-syntax size + (syntax-rules () + [(_ type bytes pred) + ;; rely on cp0 expansion: + (case 'type + [(double-float) (foreign-alignof 'double)] + [(single-float) (foreign-alignof 'float)] + [(integer-64) (foreign-alignof 'integer-64)] + [(unsigned-64) (foreign-alignof 'unsigned-64)] + [else bytes])])) + (record-datatype cases (filter-foreign-type ty) size + ($oops who "invalid foreign type specifier ~s" ty)))) + (set-who! #(csv7: record-type-descriptor) (lambda (r) (unless (record? r) ($oops who "~s is not a record" r)) diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss index a5a11a78b4..3adadbea1f 100644 --- a/racket/src/cs/rumble/foreign.ss +++ b/racket/src/cs/rumble/foreign.ss @@ -726,7 +726,17 @@ [(compound-ctype? c) (compound-ctype-alignment c)] [else - (ctype-sizeof c)])) + (case (ctype-host-rep c) + [(boolean int) (foreign-alignof 'int)] + [(double) (foreign-alignof 'double)] + [(float) (foreign-alignof 'float)] + [(integer-8 unsigned-8) (foreign-alignof 'integer-8)] + [(integer-16 unsigned-16) (foreign-alignof 'integer-16)] + [(integer-32 unsigned-32) (foreign-alignof 'integer-32)] + [(integer-64 unsigned-64) (foreign-alignof 'integer-64)] + [else + ;; Everything else is pointer-sized: + (foreign-alignof 'void*)])])) (define/who (cpointer-gcable? p) (let ([p (unwrap-cpointer who p)])