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)))