assem-rtns.lisp 8.91 KB
Newer Older
ram's avatar
ram committed
1
2
3
4
5
6
7
8
9
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
10
 "$Header: src/assembly/x86/assem-rtns.lisp $")
ram's avatar
ram committed
11
12
13
14
15
16
17
18
19
;;;
;;; **********************************************************************
;;; 
;;; This file contains the machine specific support routines needed by
;;; the file assembler.
;;;
;;; Written by William Lott
;;;
;;; Debugged by Paul F. Werkowski -- Spring/Summer 1995.
20
;;; Enhancements/debugging by Douglas T. Crosher 1997.
ram's avatar
ram committed
21
22
23
24
25
26
27
28
29
30
31
32
33
34
;;;
(in-package :x86)


;;;; Return-multiple

;;; For return-multiple, we have to move the results from the end of the
;;; frame for the function that is returning to the end of the frame for
;;; the function being returned to.

#+assembler ;; we don't want a vop for this one.
(define-assembly-routine
    (return-multiple (:return-style :none))
    (;; These four are really arguments.
35
36
37
38
     (:temp eax unsigned-reg eax-offset)
     (:temp ebx unsigned-reg ebx-offset)
     (:temp ecx unsigned-reg ecx-offset)
     (:temp esi unsigned-reg esi-offset)
ram's avatar
ram committed
39
40

     ;; These we need as temporaries.
41
42
     (:temp edx unsigned-reg edx-offset)
     (:temp edi unsigned-reg edi-offset))
ram's avatar
ram committed
43
44
45
     
  ;; Pick off the cases where everything fits in register args.
  (inst jecxz zero-values)
46
  (inst cmp ecx (fixnumize 1))
ram's avatar
ram committed
47
  (inst jmp :e one-value)
48
  (inst cmp ecx (fixnumize 2))
ram's avatar
ram committed
49
  (inst jmp :e two-values)
50
  (inst cmp ecx (fixnumize 3))
ram's avatar
ram committed
51
52
53
54
55
56
57
  (inst jmp :e three-values)

  ;; Save the count, because the loop is going to destroy it.
  (inst mov edx ecx)

  ;; Blit the values down the stack.  Note: there might be overlap, so we have
  ;; to be careful not to clobber values before we've read them.  Because the
rtoy's avatar
rtoy committed
58
  ;; stack builds down, we are copying to a larger address.  Therefore, we need
ram's avatar
ram committed
59
60
61
62
63
  ;; to iterate from larger addresses to smaller addresses.
  ;; pfw-this says copy ecx words from esi to edi counting down.
  (inst shr ecx 2)			; fixnum to raw word count
  (inst sub esi 4)			; ?
  (inst lea edi (make-ea :dword :base ebx :disp (- word-bytes)))
64
  (inst std)				; count down
ram's avatar
ram committed
65
66
  (inst rep)
  (inst movs :dword)
67
  (inst cld)
ram's avatar
ram committed
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

  ;; Restore the count.
  (inst mov ecx edx)

  ;; Set the stack top to the last result.
  (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))

  ;; Load the register args.
  (loadw edx ebx -1)
  (loadw edi ebx -2)
  (loadw esi ebx -3)

  ;; And back we go.
  (inst jmp eax)

  ;; Handle the register arg cases.
  ZERO-VALUES
  (move esp-tn ebx)
  (inst mov edx nil-value)
  (inst mov edi edx)
  (inst mov esi edx)
  (inst jmp eax)

  ONE-VALUE ; Note: we can get this, because the return-multiple vop
	    ; doesn't check for this case when size > speed.
  (loadw edx esi -1)
  (inst mov esp-tn ebx)
  (inst add eax 2)
  (inst jmp eax)

  TWO-VALUES
  (loadw edx esi -1)
  (loadw edi esi -2)
  (inst mov esi nil-value)
  (inst lea esp-tn (make-ea :dword :base ebx :disp (* -2 word-bytes)))
  (inst jmp eax)

  THREE-VALUES
  (loadw edx esi -1)
  (loadw edi esi -2)
  (loadw esi esi -3)
  (inst lea esp-tn (make-ea :dword :base ebx :disp (* -3 word-bytes)))
  (inst jmp eax))



;;;; tail-call-variable.

;;; For tail-call-variable, we have to copy the arguments from the end of our
rtoy's avatar
rtoy committed
117
118
;;; stack frame (where args are produced) to the start of our stack frame
;;; (where args are expected).
ram's avatar
ram committed
119
120
;;;
;;; We take the function to call in EAX and a pointer to the arguments in
rtoy's avatar
rtoy committed
121
;;; ESI.  EBP stays the same over the jump, and the old frame pointer is
ram's avatar
ram committed
122
123
124
125
126
127
128
129
130
131
;;; still saved in the first stack slot.  The return-pc is saved in
;;; the second stack slot, so we have to push it to make it look like
;;; we actually called.  We also have to compute ECX from the difference
;;; between ESI and the stack top.
;;; 
#+assembler ;; no vop for this one either.
(define-assembly-routine
    (tail-call-variable
     (:return-style :none))

132
133
134
135
136
137
    ((:temp eax unsigned-reg eax-offset)
     (:temp ebx unsigned-reg ebx-offset)
     (:temp ecx unsigned-reg ecx-offset)
     (:temp edx unsigned-reg edx-offset)
     (:temp edi unsigned-reg edi-offset)
     (:temp esi unsigned-reg esi-offset))
ram's avatar
ram committed
138
139
140
141
142

  ;; Calculate NARGS (as a fixnum)
  (move ecx esi)
  (inst sub ecx esp-tn)

rtoy's avatar
rtoy committed
143
  ;; Check for all the args fitting in the registers.
144
  (inst cmp ecx (fixnumize 3))
ram's avatar
ram committed
145
146
  (inst jmp :le REGISTER-ARGS)

rtoy's avatar
rtoy committed
147
  ;; Save the OLD-FP and RETURN-PC because the blit is going to trash
ram's avatar
ram committed
148
149
150
151
152
153
  ;; those stack locations.  Save the ECX, because the loop is going
  ;; to trash it.
  (pushw ebp-tn -1)
  (loadw ebx ebp-tn -2)
  (inst push ecx)

rtoy's avatar
rtoy committed
154
  ;; Do the blit.  Because we are copying from smaller addresses to larger
ram's avatar
ram committed
155
156
157
  ;; addresses, we have to start at the largest pair and work our way down.
  (inst shr ecx 2)			; fixnum to raw words
  (inst lea edi (make-ea :dword :base ebp-tn :disp (- word-bytes)))
158
  (inst sub esi (fixnumize 1))
159
  (inst std)				; count down
ram's avatar
ram committed
160
161
  (inst rep)
  (inst movs :dword)
162
  (inst cld)
ram's avatar
ram committed
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

  ;; Load the register arguments carefully.
  (loadw edx ebp-tn -1)

  ;; Restore OLD-FP and ECX.
  (inst pop ecx)
  (popw ebp-tn -1)			; overwrites a0

  ;; Blow off the stack above the arguments.
  (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes))

  ;; remaining register args
  (loadw edi ebp-tn -2)
  (loadw esi ebp-tn -3)

  ;; Push the (saved) return-pc so it looks like we just called.
  (inst push ebx)

  ;; And jump into the function.
rtoy's avatar
rtoy committed
182
183
184
185
  (inst jmp 
	(make-ea :byte :base eax
		 :disp (- (* closure-function-slot word-bytes)
			  function-pointer-type)))
ram's avatar
ram committed
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200

  ;; All the arguments fit in registers, so load them.
  REGISTER-ARGS
  (loadw edx esi -1)
  (loadw edi esi -2)
  (loadw esi esi -3)

  ;; Clear most of the stack.
  (inst lea esp-tn
	(make-ea :dword :base ebp-tn :disp (* -3 word-bytes)))

  ;; Push the return-pc so it looks like we just called.
  (pushw ebp-tn -2)

  ;; And away we go.
201
202
203
  (inst jmp (make-ea :byte :base eax
		     :disp (- (* closure-function-slot word-bytes)
			      function-pointer-type))))
ram's avatar
ram committed
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231



(define-assembly-routine (throw
			  (:return-style :none))
			 ((:arg target (descriptor-reg any-reg) edx-offset)
			  (:arg start any-reg ebx-offset)
			  (:arg count any-reg ecx-offset)
			  (:temp catch any-reg eax-offset))
  
  (declare (ignore start count))

  (load-symbol-value catch lisp::*current-catch-block*)
  
  LOOP
  
  (let ((error (generate-error-code nil unseen-throw-tag-error target)))
    (inst or catch catch)		; check for NULL pointer
    (inst jmp :z error))
  
  (inst cmp target (make-ea-for-object-slot catch catch-block-tag-slot 0))
  (inst jmp :e exit)
  
  (loadw catch catch catch-block-previous-catch-slot)
  (inst jmp loop)
  
  EXIT
  
rtoy's avatar
rtoy committed
232
  ;; Here EAX points to catch block containing symbol pointed to by EDX.
233
  (inst jmp (make-fixup 'unwind :assembly-routine)))
ram's avatar
ram committed
234
235
236
237
238
239
240
241
242
243

;;;; Non-local exit noise.

(define-assembly-routine (unwind
			  (:return-style :none)
			  (:translate %continue-unwind)
			  (:policy :fast-safe))
			 ((:arg block (any-reg descriptor-reg) eax-offset)
			  (:arg start (any-reg descriptor-reg) ebx-offset)
			  (:arg count (any-reg descriptor-reg) ecx-offset)
244
			  (:temp uwp unsigned-reg esi-offset))
245
  (declare (ignore start count))
ram's avatar
ram committed
246
247
248
249
250
251
252

  (let ((error (generate-error-code nil invalid-unwind-error)))
    (inst or block block)		; check for NULL pointer
    (inst jmp :z error))
  
  (load-symbol-value uwp lisp::*current-unwind-protect-block*)

253
254
255
  ;; Does *cuwpb* match value stored in argument cuwp slot?
  (inst cmp uwp
	(make-ea-for-object-slot block unwind-block-current-uwp-slot 0))
ram's avatar
ram committed
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
  ;; If a match, return to context in arg block.
  (inst jmp :e do-exit)

  ;; Not a match - return to *current-unwind-protect-block* context.
  ;; Important! Must save (and return) the arg 'block' for later use!!
  (move edx-tn block)
  (move block uwp)
  ;; Set next unwind protect context.
  (loadw uwp uwp unwind-block-current-uwp-slot)
  (store-symbol-value uwp lisp::*current-unwind-protect-block*)
  
  DO-EXIT
  
  (loadw ebp-tn block unwind-block-current-cont-slot)
  
271
272
273
  ;; Uwp-entry expects some things in known locations so that they can
  ;; be saved on the stack: the block in edx-tn; start in ebx-tn; and
  ;; count in ecx-tn
ram's avatar
ram committed
274
275
276

  (inst jmp (make-ea :byte :base block
		     :disp (* unwind-block-entry-pc-slot word-bytes))))
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296

#+assembler
(define-assembly-routine (closure-tramp
			  (:return-style :none))
                         ()
  (loadw eax-tn eax-tn fdefn-function-slot other-pointer-type)
  (inst jmp (make-ea :dword :base eax-tn
		     :disp (- (* closure-function-slot word-bytes)
			      function-pointer-type))))

#+assembler
(define-assembly-routine (undefined-tramp
			  (:return-style :none))
                         ()
  (let ((error (generate-error-code nil undefined-symbol-error
				    (make-random-tn :kind :normal
						    :sc (sc-or-lose 'descriptor-reg c::*backend*)
						    :offset 0))))
    (inst jmp error)
    (inst ret)))