DONE
;; We are done. Do the jump.
- (progn
- (loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
- (lisp-jump temp lip)))
+ (loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
+ (lisp-jump temp lip))
\f
;;;; Non-local exit noise.
(define-assembly-routine
(unwind
+ (:return-style :none)
(:translate %continue-unwind)
(:policy :fast-safe))
((:arg block (any-reg descriptor-reg) a0-offset)
(move cur-uwp block)
- do-exit
+ DO-EXIT
(loadw cfp-tn cur-uwp unwind-block-current-cont-slot)
(loadw code-tn cur-uwp unwind-block-current-code-slot)
- (progn
- (loadw lra cur-uwp unwind-block-entry-pc-slot)
- (lisp-return lra lip :frob-code nil))
+ (loadw lra cur-uwp unwind-block-entry-pc-slot)
+ (lisp-return lra lip :frob-code nil)
- do-uwp
+ DO-UWP
(loadw next-uwp cur-uwp unwind-block-current-uwp-slot)
(inst b do-exit)
(store-symbol-value next-uwp *current-unwind-protect-block*))
(define-assembly-routine
- throw
+ (throw
+ (:return-style :none))
((:arg target descriptor-reg a0-offset)
(:arg start any-reg ocfp-offset)
(:arg count any-reg nargs-offset)
(:temp catch any-reg a1-offset)
(:temp tag descriptor-reg a2-offset))
- (progn start count) ; We just need them in the registers.
+ (declare (ignore start count)) ; We only need them in the registers.
(load-symbol-value catch *current-catch-block*)
-
- loop
+
+ LOOP
(let ((error (generate-error-code nil unseen-throw-tag-error target)))
(inst beq catch zero-tn error)
;; Don't bother doing anything.
))
-;;; Get the lexical environment from it's passing location.
+;;; Get the lexical environment from its passing location.
;;;
(define-vop (setup-closure-environment)
(:temporary (:sc descriptor-reg :offset lexenv-offset :target closure
(def-mem-op storew sw word-shift nil)
(defmacro load-symbol (reg symbol)
- `(inst addu ,reg null-tn (static-symbol-offset ,symbol)))
+ (once-only ((reg reg) (symbol symbol))
+ `(inst addu ,reg null-tn (static-symbol-offset ,symbol))))
(defmacro load-symbol-value (reg symbol)
`(progn
(n-offset offset))
(ecase *backend-byte-order*
(:little-endian
- `(inst lbu ,n-target ,n-source ,n-offset ))
+ `(inst lbu ,n-target ,n-source ,n-offset))
(:big-endian
`(inst lbu ,n-target ,n-source (+ ,n-offset 3))))))
\f
;;;; Error Code
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
(defun emit-error-break (vop kind code values)
(let ((vector (gensym)))
`((let ((vop ,vop))
,@forms
(without-scheduling ()
(let ((label (gen-label)))
- (inst nop)
- (inst nop)
- (inst nop)
(inst bgez ,flag-tn label)
(inst addu alloc-tn (1- ,extra))
(inst break 16)
(inst sll y x 2)
(pseudo-atomic
- (pa-flag :extra (pad-data-block (+ bignum-digits-offset 2)))
+ (pa-flag :extra (pad-data-block (+ bignum-digits-offset 2)))
(inst or y alloc-tn other-pointer-lowtag)
(inst slt temp x zero-tn)
(inst sll temp n-widetag-bits)
(sap-reg) (descriptor-reg))
\f
;;;; SAP-INT and INT-SAP
+
+;;; The function SAP-INT is used to generate an integer corresponding
+;;; to the system area pointer, suitable for passing to the kernel
+;;; interfaces (which want all addresses specified as integers). The
+;;; function INT-SAP is used to do the opposite conversion. The
+;;; integer representation of a SAP is the byte offset of the SAP from
+;;; the start of the address space.
(define-vop (sap-int)
(:args (sap :scs (sap-reg) :target int))
(:arg-types system-area-pointer)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter ,name
(list ,@(mapcar #'(lambda (name) (symbolicate name "-OFFSET")) regs))))))
- (defreg zero 0)
- (defreg nl3 1)
- (defreg cfunc 2)
- (defreg nl4 3)
- (defreg nl0 4) ; First C argument reg.
- (defreg nl1 5)
- (defreg nl2 6)
- (defreg nargs 7)
- (defreg a0 8)
- (defreg a1 9)
- (defreg a2 10)
- (defreg a3 11)
- (defreg a4 12)
- (defreg a5 13)
- (defreg fdefn 14)
- (defreg lexenv 15)
- ;; First saved reg
- (defreg nfp 16)
- (defreg ocfp 17)
- (defreg lra 18)
- (defreg l0 19)
- (defreg null 20)
- (defreg bsp 21)
- (defreg cfp 22)
- (defreg csp 23)
- (defreg l1 24)
- (defreg alloc 25)
- (defreg nsp 29)
- (defreg code 30)
- (defreg lip 31)
+ ;; Wired zero register.
+ (defreg zero 0) ; NULL
+ ;; Reserved for assembler use.
+ (defreg nl3 1) ; untagged temporary 3
+ ;; C return registers.
+ (defreg cfunc 2) ; FF function address, wastes a register
+ (defreg nl4 3) ; PA flag
+ ;; C argument registers.
+ (defreg nl0 4) ; untagged temporary 0
+ (defreg nl1 5) ; untagged temporary 1
+ (defreg nl2 6) ; untagged temporary 2
+ (defreg nargs 7) ; number of function arguments
+ ;; C unsaved temporaries.
+ (defreg a0 8) ; function arg 0
+ (defreg a1 9) ; function arg 1
+ (defreg a2 10) ; function arg 2
+ (defreg a3 11) ; function arg 3
+ (defreg a4 12) ; function arg 4
+ (defreg a5 13) ; function arg 5
+ (defreg fdefn 14) ; ?
+ (defreg lexenv 15) ; wastes a register
+ ;; C saved registers.
+ (defreg nfp 16) ; non-lisp frame pointer
+ (defreg ocfp 17) ; caller's control frame pointer
+ (defreg lra 18) ; tagged Lisp return address
+ (defreg l0 19) ; tagged temporary 0
+ (defreg null 20) ; NIL
+ (defreg bsp 21) ; binding stack pointer
+ (defreg cfp 22) ; control frame pointer
+ (defreg csp 23) ; control stack pointer
+ ;; More C unsaved temporaries.
+ (defreg l1 24) ; tagged temporary 1
+ (defreg alloc 25) ; ALLOC pointer
+ ;; 26 and 27 are used by the system kernel.
+ ;; 28 is the global pointer of our C runtime.
+ (defreg nsp 29) ; number (native) stack pointer
+ ;; C frame pointer, or additional saved register.
+ (defreg code 30) ; current function object
+ ;; Return link register.
+ (defreg lip 31) ; Lisp interior pointer
(defregset non-descriptor-regs
nl0 nl1 nl2 nl3 nl4 cfunc nargs)
:sc (sc-or-lose ',sc)
:offset ,offset-sym)))))
(defregtn zero any-reg)
- (defregtn lip interior-reg)
- (defregtn code descriptor-reg)
- (defregtn alloc any-reg)
- (defregtn null descriptor-reg)
-
(defregtn nargs any-reg)
+
(defregtn fdefn descriptor-reg)
(defregtn lexenv descriptor-reg)
+ (defregtn nfp any-reg)
+ (defregtn ocfp any-reg)
+
+ (defregtn null descriptor-reg)
+
(defregtn bsp any-reg)
- (defregtn csp any-reg)
(defregtn cfp any-reg)
- (defregtn ocfp any-reg)
+ (defregtn csp any-reg)
+ (defregtn alloc any-reg)
(defregtn nsp any-reg)
- (defregtn nfp any-reg))
+
+ (defregtn code descriptor-reg)
+ (defregtn lip interior-reg))
\f
;;; If VALUE can be represented as an immediate constant, then return the
;;; appropriate SC number, otherwise return NIL.
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.2.21"
+"0.9.2.22"
projects / sbcl.git / commitdiff