Changeset 11590
- Timestamp:
- Jan 6, 2009, 6:00:06 PM (12 years ago)
- Location:
- trunk/source
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/compiler/X86/X8632/x8632-backend.lisp
r11552 r11590 285 285 (pushnew *x8632-backend* *known-backends* :key #'backend-name) 286 286 287 ;;; FFI stuff. Most operating systems use the same vanilla i386 ABI. 288 ;;; Darwin uses a variant that returns small (<= 64 bit) structures in 289 ;;; registers. (There are some other Darwin exceptions too, but they 290 ;;; don't concern us here). 287 ;;; FFI stuff. The vanilla i386 ABI always returns structures as a 288 ;;; hidden first argument. Some systems (Darwin, FreeBSD) use a 289 ;;; variant that returns small (<= 64 bit) structures in registers. 291 290 292 291 ;;; A returned structure is passed as a hidden first argument. … … 320 319 (argforms result-form)) 321 320 (progn 322 ;; for Darwin323 321 (ecase (foreign-type-bits result-type) 324 322 (8 (setq result-type-spec :unsigned-byte … … 443 441 (unless (eq return-type *void-foreign-type*) 444 442 (if (typep return-type 'foreign-record-type) 445 ;; On non-Darwin systems, the result type would have been mapped 446 ;; to :VOID. On Darwin, small (<= 64 bits) structs are returned 447 ;; by value. 443 ;; If the struct result is returned via a hidden argument, the 444 ;; return type would have been mapped to :VOID. On some 445 ;; systems, small (<= 64 bits) structs are returned by value, 446 ;; which we arrange to retrieve here. 448 447 (ecase (ensure-foreign-type-bits return-type) 449 448 (8 `(setf (%get-unsigned-byte ,stack-ptr -8) -
trunk/source/level-1/l1-callbacks.lisp
r11186 r11590 23 23 24 24 ;;; (defcallback ...) expands into a call to this function. 25 (defun define-callback-function (lisp-function &optional doc-string (without-interrupts t) (info 0)&aux name trampoline)25 (defun define-callback-function (lisp-function &optional doc-string (without-interrupts t) info &aux name trampoline) 26 26 (unless (functionp lisp-function) 27 27 (setq lisp-function (require-type lisp-function 'function))) … … 58 58 (unless (%svref %pascal-functions% i) 59 59 (return i))))) 60 (setq trampoline (make-callback-trampoline index (or info 0)))60 (setq trampoline (make-callback-trampoline index info)) 61 61 (setf (%svref %pascal-functions% index) 62 62 (%cons-pfe trampoline info lisp-function name without-interrupts))))) -
trunk/source/level-1/x86-callback-support.lisp
r11228 r11590 19 19 20 20 #+x8664-target 21 (defun make-callback-trampoline (index &optional discard-stack-bytes)22 (declare (ignore discard-stack-bytes))21 (defun make-callback-trampoline (index &optional info) 22 (declare (ignore info)) 23 23 (let* ((p (%allocate-callback-pointer 16)) 24 24 (addr #.(subprim-name->offset '.SPcallback))) … … 40 40 41 41 #+x8632-target 42 (defun make-callback-trampoline (index &optional (discard-stack-bytes 0))42 (defun make-callback-trampoline (index &optional info) 43 43 (let* ((p (%allocate-callback-pointer 12)) 44 44 (addr #.(subprim-name->offset '.SPcallback))) 45 ;; If the optional info parameter is supplied, it will contain 46 ;; some stuff in bits 23 through 31. 47 ;; 48 ;; If bit 23 is set, that indicates that the caller will pass a 49 ;; "hidden" argument which is a pointer to appropriate storage for 50 ;; holding a returned structure. .SPcallback will have to discard 51 ;; this extra argument upon return. 52 ;; 53 ;; The high 8 bits denote the number of words that .SPcallback 54 ;; will have to discard upon return (used for _stdcall on 55 ;; Windows). Bit 23 won't be set in this case: we will have 56 ;; already added in the extra word to discard if that's necessary. 57 ;; 58 ;; These bits are be packed into the value that .SPcallback 59 ;; receives in %eax. Bits 0 through 22 are the callback index. 60 (if info 61 (setf (ldb (byte 23 0) info) index) 62 (setq info index)) 45 63 (setf (%get-unsigned-byte p 0) #xb8 ; movl $n,%eax 46 (%get-unsigned-byte p 1) (ldb (byte 8 0) in dex)47 (%get-unsigned-byte p 2) (ldb (byte 8 8) in dex)48 (%get-unsigned-byte p 3) (ldb (byte 8 16) in dex)49 (%get-unsigned-byte p 4) (ldb (byte 8 0) (ash (or discard-stack-bytes 0) (- x8632::word-shift)))64 (%get-unsigned-byte p 1) (ldb (byte 8 0) info) 65 (%get-unsigned-byte p 2) (ldb (byte 8 8) info) 66 (%get-unsigned-byte p 3) (ldb (byte 8 16) info) 67 (%get-unsigned-byte p 4) (ldb (byte 8 24) info) 50 68 (%get-unsigned-byte p 5) #xff ; jmp * 51 69 (%get-unsigned-byte p 6) #x24 -
trunk/source/lib/macros.lisp
r11373 r11590 2541 2541 (result-type-spec :void) 2542 2542 (args args) 2543 (discard-stack-args nil) 2543 (discard-stack-args nil) ;only meaningful on win32 2544 (discard-hidden-arg nil) ;only meaningful on x8632 2545 (info nil) 2544 2546 (woi nil) 2545 2547 (need-struct-arg) … … 2551 2553 (rtype (ignore-errors (parse-foreign-type spec)))) 2552 2554 (setq need-struct-arg (typep rtype 'foreign-record-type)) 2555 (when need-struct-arg 2556 (setq discard-hidden-arg 2557 (funcall (ftd-ff-call-struct-return-by-implicit-arg-function 2558 *target-ftd*) rtype))) 2553 2559 (if rtype 2554 2560 (setq result-type-spec spec args (butlast args)))) … … 2571 2577 (funcall (ftd-callback-bindings-function *target-ftd*) 2572 2578 stack-ptr fp-args-ptr (arg-names) (arg-specs) result-type-spec struct-return-arg-name) 2573 (unless num-arg-bytes (setq num-arg-bytes 0)) 2579 ;; x8632 hair 2580 (when discard-hidden-arg 2581 (if discard-stack-args 2582 ;; We already have to discard some number of args, so just 2583 ;; discard the extra hidden arg while we're at it. 2584 (incf num-arg-bytes 4) 2585 ;; Otherwise, indicate that we'll need to discard the 2586 ;; hidden arg. 2587 (setq info (ash 1 23)))) 2588 (when discard-stack-args 2589 (setq info 0) 2590 ;; put number of words to discard in high-order byte 2591 (setf (ldb (byte 8 24) info) 2592 (ash num-arg-bytes (- target::word-shift)))) 2574 2593 (multiple-value-bind (body decls doc) (parse-body body env t) 2575 2594 `(progn … … 2599 2618 ,doc 2600 2619 ,woi 2601 , (if discard-stack-args num-arg-bytes 0))))))))2620 ,info))))))) 2602 2621 2603 2622 -
trunk/source/lisp-kernel/x86-spentry32.s
r11449 r11590 4252 4252 /* arg word 0 at 8(%ebp), word 1 at 12(%ebp), etc. */ 4253 4253 4254 /* %eax is passed to us via the callback trampoline. 4255 bits 0-22: callback index 4256 bit 23: flag, set if we need to discard hidden arg on return 4257 (ignored when upper 8 bits are non-zero) 4258 bits 24-31: arg words to discard on return (_stdcall for win32) */ 4259 4254 4260 /* Reserve some space for results, relative to the 4255 4261 current %ebp. We may need quite a bit of it. */ 4256 __(subl $2 4,%esp)4262 __(subl $20,%esp) 4257 4263 __(movl $0,-16(%ebp)) /* No FP result */ 4264 __(btl $23,%eax) /* set CF if we need to discard hidden arg */ 4265 __(pushfl) /* and save for later */ 4258 4266 __(movl %eax,%ecx) /* extract args-discard count */ 4259 4267 __(shrl $24,%ecx) 4260 __(andl $0x00 ffffff,%eax)4268 __(andl $0x007fffff,%eax) /* callback index */ 4261 4269 __(movl %ecx,-12(%ebp)) 4262 4270 /* If the C stack is 16-byte aligned by convention, … … 4328 4336 __(movl -8(%ebp),%eax) 4329 4337 __(movl -4(%ebp),%edx) 4330 __(leave)4331 4338 __ifdef([WIN_32]) 4332 4339 __(testl %ecx,%ecx) 4333 4340 __(jne local_label(winapi_return)) 4334 __(repret) 4335 __else 4336 __(ret) 4337 __endif 4341 __endif 4342 __(popfl) /* flags from bt way back when */ 4343 __(jc local_label(discard_first_arg)) 4344 __(leave) 4345 __(ret) 4338 4346 1: __(jne 2f) 4339 4347 /* single float return in x87 */ 4340 4348 __(flds -8(%ebp)) 4341 __(leave)4342 4349 __ifdef([WIN_32]) 4343 4350 __(testl %ecx,%ecx) 4344 4351 __(jne local_label(winapi_return)) 4345 __(repret)4346 __else4347 __(ret)4348 4352 __endif 4353 __(leave) 4354 __(ret) 4349 4355 2: /* double-float return in x87 */ 4350 4356 __(fldl -8(%ebp)) 4351 __(leave)4352 4357 __ifdef([WIN_32]) 4353 4358 __(testl %ecx,%ecx) 4354 4359 __(jne local_label(winapi_return)) 4355 __(repret)4356 __else4357 __(ret)4358 4360 __endif 4361 __(leave) 4362 __(ret) 4359 4363 __ifdef([WIN_32]) 4360 local_label(winapi_return): 4364 local_label(winapi_return): 4365 __(leave) 4361 4366 /* %ecx is non-zero and contains count of arg words to pop */ 4362 4367 __(popl -4(%esp,%ecx,4)) … … 4364 4369 __(ret) 4365 4370 __endif 4371 local_label(discard_first_arg): 4372 __(leave) 4373 __(ret $4) 4366 4374 _endsubp(callback) 4367 4375
Note: See TracChangeset
for help on using the changeset viewer.