-(defvar *values-type-okay* nil)
-
-(def-alien-type-class (fun :include mem-block)
- (result-type (required-argument) :type alien-type)
- (arg-types (required-argument) :type list)
- (stub nil :type (or null function)))
-
-(def-alien-type-translator function (result-type &rest arg-types
- &environment env)
- (make-alien-fun-type
- :result-type (let ((*values-type-okay* t))
- (parse-alien-type result-type env))
- :arg-types (mapcar (lambda (arg-type) (parse-alien-type arg-type env))
- arg-types)))
-
-(def-alien-type-method (fun :unparse) (type)
- `(function ,(%unparse-alien-type (alien-fun-type-result-type type))
- ,@(mapcar #'%unparse-alien-type
- (alien-fun-type-arg-types type))))
-
-(def-alien-type-method (fun :type=) (type1 type2)
+;;; Calling-convention spec, typically one of predefined keywords.
+;;; Add or remove as needed for target platform. It makes sense to
+;;; support :cdecl everywhere.
+;;;
+;;; Null convention is supposed to be platform-specific most-universal
+;;; callout convention. For x86, SBCL calls foreign functions in a way
+;;; allowing them to be either stdcall or cdecl; null convention is
+;;; appropriate here, as it is for specifying callbacks that could be
+;;; accepted by foreign code both in cdecl and stdcall form.
+(def!type calling-convention () `(or null (member :stdcall :cdecl)))
+
+;;; Convention could be a values type class, stored at result-type.
+;;; However, it seems appropriate only for epilogue-related
+;;; conventions, those not influencing incoming arg passing.
+;;;
+;;; As of x86's :stdcall and :cdecl, supported by now, both are
+;;; epilogue-related, but future extensions (like :fastcall and
+;;; miscellaneous non-x86 stuff) might affect incoming argument
+;;; translation as well.
+
+(define-alien-type-class (fun :include mem-block)
+ (result-type (missing-arg) :type alien-type)
+ (arg-types (missing-arg) :type list)
+ (stub nil :type (or null function))
+ (convention nil :type calling-convention))
+
+;;; KLUDGE: non-intrusive, backward-compatible way to allow calling
+;;; convention specification for function types is unobvious.
+;;;
+;;; By now, `RESULT-TYPE' is allowed, but not required, to be a list
+;;; starting with a convention keyword; its second item is a real
+;;; result-type in this case. If convention is ever to become a part
+;;; of result-type, such a syntax can be retained.
+
+(define-alien-type-translator function (result-type &rest arg-types
+ &environment env)
+ (multiple-value-bind (bare-result-type calling-convention)
+ (typecase result-type
+ ((cons calling-convention *)
+ (values (second result-type) (first result-type)))
+ (t result-type))
+ (make-alien-fun-type
+ :convention calling-convention
+ :result-type (let ((*values-type-okay* t))
+ (parse-alien-type bare-result-type env))
+ :arg-types (mapcar (lambda (arg-type) (parse-alien-type arg-type env))
+ arg-types))))
+
+(define-alien-type-method (fun :unparse) (type)
+ `(function ,(let ((result-type
+ (%unparse-alien-type (alien-fun-type-result-type type)))
+ (convention (alien-fun-type-convention type)))
+ (if convention (list convention result-type)
+ result-type))
+ ,@(mapcar #'%unparse-alien-type
+ (alien-fun-type-arg-types type))))
+
+(define-alien-type-method (fun :type=) (type1 type2)