- (and (alien-integer-type-p type)
- (> (sb!alien::alien-integer-type-bits type) 32)))
- arg-types)
- (and (alien-integer-type-p result-type)
- (> (sb!alien::alien-integer-type-bits result-type) 32)))
- (collect ((new-args) (lambda-vars) (new-arg-types))
- (dolist (type arg-types)
- (let ((arg (gensym)))
- (lambda-vars arg)
- (cond ((and (alien-integer-type-p type)
- (> (sb!alien::alien-integer-type-bits type) 32))
- ;; 64-bit long long types are stored in
- ;; consecutive locations, endian word order,
- ;; aligned to 8 bytes.
- (if (oddp (length (new-args)))
- (new-args nil))
- #!-little-endian
- (progn (new-args `(ash ,arg -32))
- (new-args `(logand ,arg #xffffffff))
- (if (oddp (length (new-arg-types)))
- (new-arg-types (parse-alien-type '(unsigned 32) env)))
- (if (alien-integer-type-signed type)
- (new-arg-types (parse-alien-type '(signed 32) env))
- (new-arg-types (parse-alien-type '(unsigned 32) env)))
- (new-arg-types (parse-alien-type '(unsigned 32) env)))
- #!+little-endian
- (progn (new-args `(logand ,arg #xffffffff))
- (new-args `(ash ,arg -32))
- (if (oddp (length (new-arg-types)))
- (new-arg-types (parse-alien-type '(unsigned 32) env)))
- (new-arg-types (parse-alien-type '(unsigned 32) env))
- (if (alien-integer-type-signed type)
- (new-arg-types (parse-alien-type '(signed 32) env))
- (new-arg-types (parse-alien-type '(unsigned 32) env)))))
- (t
- (new-args arg)
- (new-arg-types type)))))
- (cond ((and (alien-integer-type-p result-type)
- (> (sb!alien::alien-integer-type-bits result-type) 32))
- (let ((new-result-type
- (let ((sb!alien::*values-type-okay* t))
- (parse-alien-type
- (if (alien-integer-type-signed result-type)
- #!-little-endian
- '(values (signed 32) (unsigned 32))
- #!+little-endian
- '(values (unsigned 32) (signed 32))
- '(values (unsigned 32) (unsigned 32)))
- env))))
- `(lambda (function type ,@(lambda-vars))
- (declare (ignore type))
- (multiple-value-bind
- #!-little-endian
- (high low)
- #!+little-endian
- (low high)
- (%alien-funcall function
- ',(make-alien-fun-type
- :arg-types (new-arg-types)
- :result-type new-result-type)
- ,@(new-args))
- (logior low (ash high 32))))))
- (t
- `(lambda (function type ,@(lambda-vars))
- (declare (ignore type))
- (%alien-funcall function
- ',(make-alien-fun-type
- :arg-types (new-arg-types)
- :result-type result-type)
- ,@(new-args))))))
- (sb!c::give-up-ir1-transform))))
+ (and (alien-integer-type-p type)
+ (> (sb!alien::alien-integer-type-bits type) 32)))
+ arg-types)
+ (and (alien-integer-type-p result-type)
+ (> (sb!alien::alien-integer-type-bits result-type) 32)))
+ (collect ((new-args) (lambda-vars) (new-arg-types))
+ (dolist (type arg-types)
+ (let ((arg (gensym)))
+ (lambda-vars arg)
+ (cond ((and (alien-integer-type-p type)
+ (> (sb!alien::alien-integer-type-bits type) 32))
+ ;; 64-bit long long types are stored in
+ ;; consecutive locations, endian word order,
+ ;; aligned to 8 bytes.
+ (if (oddp (length (new-args)))
+ (new-args nil))
+ #!-little-endian
+ (progn (new-args `(ash ,arg -32))
+ (new-args `(logand ,arg #xffffffff))
+ (if (oddp (length (new-arg-types)))
+ (new-arg-types (parse-alien-type '(unsigned 32) env)))
+ (if (alien-integer-type-signed type)
+ (new-arg-types (parse-alien-type '(signed 32) env))
+ (new-arg-types (parse-alien-type '(unsigned 32) env)))
+ (new-arg-types (parse-alien-type '(unsigned 32) env)))
+ #!+little-endian
+ (progn (new-args `(logand ,arg #xffffffff))
+ (new-args `(ash ,arg -32))
+ (if (oddp (length (new-arg-types)))
+ (new-arg-types (parse-alien-type '(unsigned 32) env)))
+ (new-arg-types (parse-alien-type '(unsigned 32) env))
+ (if (alien-integer-type-signed type)
+ (new-arg-types (parse-alien-type '(signed 32) env))
+ (new-arg-types (parse-alien-type '(unsigned 32) env)))))
+ (t
+ (new-args arg)
+ (new-arg-types type)))))
+ (cond ((and (alien-integer-type-p result-type)
+ (> (sb!alien::alien-integer-type-bits result-type) 32))
+ (let ((new-result-type
+ (let ((sb!alien::*values-type-okay* t))
+ (parse-alien-type
+ (if (alien-integer-type-signed result-type)
+ #!-little-endian
+ '(values (signed 32) (unsigned 32))
+ #!+little-endian
+ '(values (unsigned 32) (signed 32))
+ '(values (unsigned 32) (unsigned 32)))
+ env))))
+ `(lambda (function type ,@(lambda-vars))
+ (declare (ignore type))
+ (multiple-value-bind
+ #!-little-endian
+ (high low)
+ #!+little-endian
+ (low high)
+ (%alien-funcall function
+ ',(make-alien-fun-type
+ :arg-types (new-arg-types)
+ :result-type new-result-type)
+ ,@(new-args))
+ (logior low (ash high 32))))))
+ (t
+ `(lambda (function type ,@(lambda-vars))
+ (declare (ignore type))
+ (%alien-funcall function
+ ',(make-alien-fun-type
+ :arg-types (new-arg-types)
+ :result-type result-type)
+ ,@(new-args))))))
+ (sb!c::give-up-ir1-transform))))