;; The start of the actual code.
;; Save the return-pc.
- (popw ebp-tn (- (1+ return-pc-save-offset)))
+ (popw ebp-tn (frame-word-offset return-pc-save-offset))
;; If copy-more-arg follows it will allocate the correct stack
;; size. The stack is not allocated first here as this may expose
(inst cmp ecx-tn (fixnumize i))
(inst jmp :be default-lab)
- (loadw edx-tn ebx-tn (- (1+ i)))
+ (loadw edx-tn ebx-tn (frame-word-offset i))
(inst mov tn edx-tn)))
(emit-label defaulting-done)
(emit-label no-stack-args)
(inst lea edi-tn
(make-ea :dword :base ebp-tn
- :disp (* (- (1+ register-arg-count)) n-word-bytes)))
+ :disp (frame-byte-offset register-arg-count)))
;; Load EAX with NIL so we can quickly store it, and set up
;; stuff for the loop.
(inst mov eax-tn nil-value)
(inst std)
(inst mov ecx-tn (- nvals register-arg-count))
- ;; solaris requires DF being zero.
- #!+sunos (inst cld)
;; Jump into the default loop.
(inst jmp default-stack-vals)
;; and then default the remaining stack arguments.
(emit-label regs-defaulted)
;; Save EDI.
- (storew edi-tn ebx-tn (- (1+ 1)))
+ (storew edi-tn ebx-tn (frame-word-offset 1))
;; Compute the number of stack arguments, and if it's zero or
;; less, don't copy any stack arguments.
(inst sub ecx-tn (fixnumize register-arg-count))
;; Compute a pointer to where the stack args go.
(inst lea edi-tn
(make-ea :dword :base ebp-tn
- :disp (* (- (1+ register-arg-count)) n-word-bytes)))
+ :disp (frame-byte-offset register-arg-count)))
;; Save ESI, and compute a pointer to where the args come from.
- (storew esi-tn ebx-tn (- (1+ 2)))
+ (storew esi-tn ebx-tn (frame-word-offset 2))
(inst lea esi-tn
(make-ea :dword :base ebx-tn
- :disp (* (- (1+ register-arg-count)) n-word-bytes)))
+ :disp (frame-byte-offset register-arg-count)))
;; Do the copy.
(inst shr ecx-tn word-shift) ; make word count
(inst std)
(inst rep)
(inst movs :dword)
- ;; solaris requires DF being zero.
- #!+sunos (inst cld)
;; Restore ESI.
- (loadw esi-tn ebx-tn (- (1+ 2)))
+ (loadw esi-tn ebx-tn (frame-word-offset 2))
;; Now we have to default the remaining args. Find out how many.
(inst sub eax-tn (fixnumize (- nvals register-arg-count)))
(inst neg eax-tn)
(emit-label default-stack-vals)
(inst rep)
(inst stos eax-tn)
- ;; solaris requires DF being zero.
- #!+sunos (inst cld)
;; Restore EDI, and reset the stack.
(emit-label restore-edi)
- (loadw edi-tn ebx-tn (- (1+ 1)))
- (inst mov esp-tn ebx-tn))))
+ (loadw edi-tn ebx-tn (frame-word-offset 1))
+ (inst mov esp-tn ebx-tn)
+ (inst cld))))
(values))
\f
;;;; unknown values receiving
#+nil (format t "*call-local: ret-tn on stack; offset=~S~%"
(tn-offset ret-tn))
(storew (make-fixup nil :code-object return)
- ebp-tn (- (1+ (tn-offset ret-tn)))))
+ ebp-tn (frame-word-offset (tn-offset ret-tn))))
((sap-reg)
(inst lea ret-tn (make-fixup nil :code-object return)))))
(tn-offset ret-tn))
;; Stack
(storew (make-fixup nil :code-object return)
- ebp-tn (- (1+ (tn-offset ret-tn)))))
+ ebp-tn (frame-word-offset (tn-offset ret-tn))))
((sap-reg)
;; Register
(inst lea ret-tn (make-fixup nil :code-object return)))))
(tn-offset ret-tn))
;; Stack
(storew (make-fixup nil :code-object return)
- ebp-tn (- (1+ (tn-offset ret-tn)))))
+ ebp-tn (frame-word-offset (tn-offset ret-tn))))
((sap-reg)
;; Register
(inst lea ret-tn (make-fixup nil :code-object return)))))
(cond ((zerop (tn-offset old-fp))
;; Zot all of the stack except for the old-fp.
(inst lea esp-tn (make-ea :dword :base ebp-tn
- :disp (- (* (1+ ocfp-save-offset)
- n-word-bytes))))
+ :disp (frame-byte-offset ocfp-save-offset)))
;; Restore the old fp from its save location on the stack,
;; and zot the stack.
(inst pop ebp-tn))
;; Zot all of the stack except for the old-fp and return-pc.
(inst lea esp-tn
(make-ea :dword :base ebp-tn
- :disp (- (* (1+ (tn-offset return-pc)) n-word-bytes))))
+ :disp (frame-byte-offset (tn-offset return-pc))))
;; Restore the old fp. old-fp may be either on the stack in its
;; save location or in a register, in either case this restores it.
(move ebp-tn old-fp)
(move old-fp-tmp old-fp)
(storew old-fp-tmp
ebp-tn
- (- (1+ ocfp-save-offset)))))
+ (frame-word-offset ocfp-save-offset))))
((any-reg descriptor-reg)
(format t "** tail-call old-fp in reg not S0~%")
(storew old-fp
ebp-tn
- (- (1+ ocfp-save-offset)))))
+ (frame-word-offset ocfp-save-offset))))
;; For tail call, we have to push the
;; return-pc so that it looks like we CALLed
'(inst sub esp-tn (fixnumize 3)))
;; Save the fp
- (storew ebp-tn new-fp (- (1+ ocfp-save-offset)))
+ (storew ebp-tn new-fp (frame-word-offset ocfp-save-offset))
(move ebp-tn new-fp) ; NB - now on new stack frame.
)))
(note-this-location vop :call-site)
(inst ,(if (eq return :tail) 'jmp 'call)
- (make-ea :dword :base eax
- :disp ,(if named
- '(- (* fdefn-raw-addr-slot
- n-word-bytes)
- other-pointer-lowtag)
- '(- (* closure-fun-slot n-word-bytes)
- fun-pointer-lowtag))))
+ ,(if named
+ '(make-ea-for-object-slot eax fdefn-raw-addr-slot
+ other-pointer-lowtag)
+ '(make-ea-for-object-slot eax closure-fun-slot
+ fun-pointer-lowtag)))
,@(ecase return
(:fixed
'((default-unknown-values vop values nvals)))
;; Drop the stack above it and pop it off.
(cond ((zerop (tn-offset old-fp))
(inst lea esp-tn (make-ea :dword :base ebp-tn
- :disp (- (* (1+ ocfp-save-offset)
- n-word-bytes))))
+ :disp (frame-byte-offset ocfp-save-offset)))
(inst pop ebp-tn))
(t
;; Should this ever happen, we do the same as above, but
;; into a temp reg while we fix the stack.
;; Drop stack above return-pc
(inst lea esp-tn (make-ea :dword :base ebp-tn
- :disp (- (* (1+ (tn-offset return-pc))
- n-word-bytes))))
+ :disp (frame-byte-offset (tn-offset return-pc))))
;; Set single-value return flag
(inst clc)
;; Restore the old frame pointer
(inst ret))
(t
(inst jmp (make-ea :dword :base ebx
- :disp (- (* (1+ (tn-offset return-pc))
- n-word-bytes))))))
+ :disp (frame-byte-offset (tn-offset return-pc))))))
(trace-table-entry trace-table-normal)))
;; Check to see whether there are no args, and just return NIL if so.
(inst mov result nil-value)
(inst jecxz done)
- (inst lea dst (make-ea :dword :index ecx :scale 2))
+ (inst lea dst (make-ea :dword :base ecx :index ecx))
(maybe-pseudo-atomic stack-allocate-p
(allocation dst dst node stack-allocate-p)
(inst lea dst (make-ea :byte :base dst :disp list-pointer-lowtag))
(inst sub ecx 1)
(inst jmp :nz loop)
;; NIL out the last cons.
- (storew nil-value dst 1 list-pointer-lowtag))
- (emit-label done)
- ;; solaris requires DF being zero.
- #!+sunos (inst cld))))
+ (storew nil-value dst 1 list-pointer-lowtag)
+ (inst cld))
+ (emit-label done))))
;;; Return the location and size of the &MORE arg glob created by
;;; COPY-MORE-ARG. SUPPLIED is the total number of arguments supplied
(:save-p :compute-only)
(:generator 3
(let ((err-lab
- (generate-error-code vop invalid-arg-count-error nargs)))
+ (generate-error-code vop 'invalid-arg-count-error nargs)))
(if (zerop count)
(inst test nargs nargs) ; smaller instruction
(inst cmp nargs (fixnumize count)))
(:vop-var vop)
(:save-p :compute-only)
(:generator 1000
- (error-call vop ,error ,@args)))))
+ (error-call vop ',error ,@args)))))
(def arg-count-error invalid-arg-count-error
sb!c::%arg-count-error nargs)
(def type-check-error object-not-type-error sb!c::%type-check-error
:disp (* thread-stepping-slot n-word-bytes))
nil-value))
#!-sb-thread
- (inst cmp (make-ea :dword
- :disp (+ nil-value (static-symbol-offset
- 'sb!impl::*stepping*)
- (* symbol-value-slot n-word-bytes)
- (- other-pointer-lowtag)))
+ (inst cmp (make-ea-for-symbol-value sb!impl::*stepping*)
nil-value))
(define-vop (step-instrument-before-vop)
projects / sbcl.git / blobdiff