cs: repair ctype alignment

Currently, this repair matters only for PPC32 Mac OS, which is the
only place where alignment of some primitive atomic type is not the
same as its size.

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))))))
 

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})}

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])))])
 

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])

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))

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)])