7985f7c4debb8c36bb299b35602b654cd52b375e
[sbcl.git] / src / assembly / x86 / support.lisp
1 ;;;; This software is part of the SBCL system. See the README file for
2 ;;;; more information.
3 ;;;;
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
9
10 (in-package "SB!VM")
11
12 ;;; The :full-call assembly-routines must use the same full-call
13 ;;; unknown-values return convention as a normal call, as some
14 ;;; of the routines will tail-chain to a static-function. The
15 ;;; routines themselves, however, take all of their arguments
16 ;;; in registers (this will typically be one or two arguments,
17 ;;; and is one of the lower bounds on the number of argument-
18 ;;; passing registers), and thus don't need a call frame, which
19 ;;; simplifies things for the normal call/return case. When it
20 ;;; is neccessary for one of the assembly-functions to call a
21 ;;; static-function it will construct the required call frame.
22 ;;; Also, none of the assembly-routines return other than one
23 ;;; value, which again simplifies the return path.
24 ;;;    -- AB, 2006/Feb/05.
25
26 (defun generate-call-sequence (name style vop)
27   (ecase style
28     ((:raw :none)
29      (values
30       `((inst call (make-fixup ',name :assembly-routine)))
31       nil))
32     (:full-call
33      (values
34       `((note-this-location ,vop :call-site)
35         (inst call (make-fixup ',name :assembly-routine))
36         (note-this-location ,vop :single-value-return)
37         (cond
38           ((member :cmov *backend-subfeatures*)
39            (inst cmov :c esp-tn ebx-tn))
40           (t
41            (let ((single-value (gen-label)))
42              (inst jmp :nc single-value)
43              (move esp-tn ebx-tn)
44              (emit-label single-value)))))
45       '((:save-p :compute-only))))))
46
47 (defun generate-return-sequence (style)
48   (ecase style
49     (:raw
50      `(inst ret))
51     (:full-call
52      `((inst clc)
53        (inst ret)))
54     (:none)))