mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Remove mentions of LRA and return-pc-widetag
This commit is contained in:
Stas Boukarev
parent
414be3b346
commit
ba8060eeb0
|
|
@ -951,9 +951,7 @@ between the ~A definition and the ~A definition"
|
|||
;;; hierarchy). See NAMED :COMPLEX-SUBTYPEP-ARG2
|
||||
(declaim (type cons **non-instance-classoid-types**))
|
||||
(defglobal **non-instance-classoid-types**
|
||||
'(symbol system-area-pointer weak-pointer code-component
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc) lra
|
||||
fdefn random-class))
|
||||
'(symbol system-area-pointer weak-pointer code-component fdefn random-class))
|
||||
|
||||
(defun classoid-non-instance-p (classoid)
|
||||
(declare (type classoid classoid))
|
||||
|
|
@ -1053,11 +1051,6 @@ between the ~A definition and the ~A definition"
|
|||
(code-component :codes (,sb-vm:code-header-widetag)
|
||||
:predicate code-component-p
|
||||
:prototype-form (fun-code-header #'identity))
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc)
|
||||
(lra :codes (,sb-vm:return-pc-widetag)
|
||||
:predicate lra-p
|
||||
;; Make the PROTOTYPE slot unbound.
|
||||
:prototype-form sb-pcl:+slot-unbound+)
|
||||
(fdefn :codes (,sb-vm:fdefn-widetag)
|
||||
:predicate fdefn-p
|
||||
:prototype-form (find-or-create-fdefn '(setf car)))
|
||||
|
|
|
|||
|
|
@ -151,7 +151,7 @@
|
|||
;; probably not a function. What about FMT-CONTROL instances?
|
||||
(values nil t)))
|
||||
((system-area-pointer stream fdefn weak-pointer file-stream
|
||||
code-component lra pathname logical-pathname)
|
||||
code-component pathname logical-pathname)
|
||||
(values nil t)))
|
||||
(cond ((eq name 'pathname)
|
||||
(values (pathnamep obj) t))
|
||||
|
|
|
|||
|
|
@ -530,8 +530,6 @@
|
|||
;; All backends have an additional slot to hold the cookie.
|
||||
(+ code-constants-offset 3))
|
||||
(defconstant real-lra-slot code-constants-offset)
|
||||
#-(or x86 x86-64 arm64 riscv loongarch64)
|
||||
(defconstant known-return-p-slot (+ code-constants-offset 1))
|
||||
(defconstant cookie-slot (+ code-constants-offset 2))
|
||||
|
||||
(declaim (inline control-stack-pointer-valid-p))
|
||||
|
|
@ -645,7 +643,7 @@
|
|||
(word (int-sap pc)))))))
|
||||
(unless (= base-ptr 0) (%make-lisp-obj (logior base-ptr other-pointer-lowtag))))))
|
||||
|
||||
#+(or arm arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
#-(or x86 x86-64)
|
||||
(defun compute-lra-data-from-pc (pc)
|
||||
(declare (type integer pc))
|
||||
(let* ((pc-sap (int-sap (ash pc n-fixnum-tag-bits)))
|
||||
|
|
@ -889,66 +887,9 @@
|
|||
;;; The current frame contains the pointer to the temporally previous
|
||||
;;; frame we want, and the current frame contains the pc at which we
|
||||
;;; will continue executing upon returning to that previous frame.
|
||||
;;;
|
||||
;;; Note: Sometimes LRA is actually a fixnum. This happens when lisp
|
||||
;;; calls into C. In this case, the code object is stored on the stack
|
||||
;;; after the LRA, and the LRA is the word offset.
|
||||
#-(or arm x86 x86-64 arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
(defun compute-calling-frame (caller lra up-frame &optional savedp)
|
||||
(declare (type system-area-pointer caller)
|
||||
(ignore savedp))
|
||||
(/noshow0 "entering COMPUTE-CALLING-FRAME")
|
||||
(when (control-stack-pointer-valid-p caller)
|
||||
(/noshow0 "in WHEN")
|
||||
(multiple-value-bind (code pc-offset escaped)
|
||||
(if lra
|
||||
(multiple-value-bind (word-offset code)
|
||||
(if (fixnump lra)
|
||||
(let ((fp (frame-pointer up-frame)))
|
||||
(values lra
|
||||
(let ((code (stack-ref fp (1+ lra-save-offset))))
|
||||
code
|
||||
#+ppc64
|
||||
(%make-lisp-obj (logior (ash code n-fixnum-tag-bits)
|
||||
other-pointer-lowtag)))))
|
||||
(values (get-header-data lra)
|
||||
(lra-code-header lra)))
|
||||
(if code
|
||||
(values code
|
||||
(* (1+ (- word-offset (code-header-words code)))
|
||||
n-word-bytes)
|
||||
nil)
|
||||
(values :foreign-function
|
||||
0
|
||||
nil)))
|
||||
(find-escaped-frame caller))
|
||||
(if (and (code-component-p code)
|
||||
(eq (%code-debug-info code) :bpt-lra))
|
||||
(let ((real-lra (code-header-ref code real-lra-slot)))
|
||||
(compute-calling-frame caller real-lra up-frame))
|
||||
(let ((d-fun (case code
|
||||
(:undefined-function
|
||||
(make-bogus-debug-fun
|
||||
"undefined function"))
|
||||
(:foreign-function
|
||||
(make-bogus-debug-fun
|
||||
(foreign-function-backtrace-name
|
||||
(int-sap (get-lisp-obj-address lra)))))
|
||||
((nil)
|
||||
(make-bogus-debug-fun
|
||||
"bogus stack frame"))
|
||||
(t
|
||||
(debug-fun-from-pc code pc-offset)))))
|
||||
(/noshow0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
|
||||
(make-compiled-frame caller up-frame d-fun
|
||||
(code-location-from-pc d-fun pc-offset
|
||||
escaped)
|
||||
(if up-frame (1+ (frame-number up-frame)) 0)
|
||||
escaped))))))
|
||||
|
||||
#+(or x86 x86-64 arm arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
(defun compute-calling-frame (caller ra up-frame &optional savedp)
|
||||
(declare (type system-area-pointer caller #-(or ppc ppc64 arm arm64 sparc riscv loongarch64) ra))
|
||||
(declare (type system-area-pointer caller #+c-stack-is-control-stack ra))
|
||||
(when (control-stack-pointer-valid-p caller)
|
||||
;; First check for an escaped frame.
|
||||
(multiple-value-bind (code pc-offset escaped off-stack assembly-routine-p)
|
||||
|
|
@ -973,8 +914,8 @@
|
|||
"undefined function"))
|
||||
(:foreign-function
|
||||
(make-bogus-debug-fun
|
||||
(foreign-function-backtrace-name #-(or arm64 sparc arm riscv loongarch64 ppc64 ppc) ra
|
||||
#+(or arm64 sparc arm riscv loongarch64 ppc64 ppc) (int-sap (get-lisp-obj-address ra)))))
|
||||
(foreign-function-backtrace-name #+c-stack-is-control-stack ra
|
||||
#-c-stack-is-control-stack (int-sap (get-lisp-obj-address ra)))))
|
||||
((nil)
|
||||
(make-bogus-debug-fun
|
||||
"bogus stack frame"))
|
||||
|
|
@ -1124,7 +1065,6 @@
|
|||
(code (code-object-from-context context))
|
||||
assembly-routine-p)
|
||||
(/noshow0 "got CODE")
|
||||
#+(or arm arm64 sparc loongarch64 ppc64 ppc)
|
||||
(when (eq code sb-fasl:*assembler-routines*)
|
||||
(unless (memq (assembly-routine-name-from-pc code (code-pc-offset pc code))
|
||||
'(sb-vm::undefined-tramp sb-vm::undefined-alien-tramp
|
||||
|
|
@ -1170,14 +1110,7 @@
|
|||
(setf pc-offset 0))))
|
||||
(/noshow0 "returning from FIND-ESCAPED-FRAME")
|
||||
(return
|
||||
(cond #-(or riscv arm arm64 sparc loongarch64 ppc64 ppc)
|
||||
((eq (%code-debug-info code) :bpt-lra)
|
||||
(let ((real-lra (code-header-ref code real-lra-slot)))
|
||||
(values (lra-code-header real-lra)
|
||||
(get-header-data real-lra)
|
||||
nil nil nil)))
|
||||
(t
|
||||
(values code pc-offset context nil assembly-routine-p))))))))
|
||||
(values code pc-offset context nil assembly-routine-p))))))
|
||||
|
||||
#-(or x86 x86-64)
|
||||
(defun find-pc-from-assembly-fun (code scp)
|
||||
|
|
@ -1195,72 +1128,9 @@ register."
|
|||
;;; Find the code object corresponding to the object represented by
|
||||
;;; bits and return it. We assume bogus functions correspond to the
|
||||
;;; undefined-function.
|
||||
#+(or riscv arm arm64 sparc ppc ppc64 x86 x86-64 loongarch64)
|
||||
(defun code-object-from-context (context)
|
||||
(declare (type (sb-alien:alien (* os-context-t)) context))
|
||||
(code-header-from-pc (context-pc context)))
|
||||
|
||||
#-(or riscv arm arm64 sparc ppc ppc64 x86 x86-64 loongarch64)
|
||||
(defun code-object-from-context (context)
|
||||
(declare (type (sb-alien:alien (* os-context-t)) context))
|
||||
;; The GC constraint on the program counter on precisely-scavenged
|
||||
;; backends is that it partakes of the interior-pointer nature.
|
||||
;; Which means that it may be within the scope of an object other
|
||||
;; than that pointed to by reg_CODE / $CODE. This is necessarily
|
||||
;; the case during function call and return: whichever the outbound
|
||||
;; function is has reg_CODE set up for itself, and the inbound
|
||||
;; function cannot have reg_CODE set up until after the program
|
||||
;; counter is within its body, otherwise a badly timed signal can
|
||||
;; mess things up entirely. In practical terms, this means that we
|
||||
;; need to do the same sort of pairing of interior pointers that the
|
||||
;; GC does these days (see scavenge_interrupt_context() in
|
||||
;; gc-common.c for details), but limiting to "things that can be
|
||||
;; code objects". -- AB, 2018-Jan-11
|
||||
;;
|
||||
;; Oh, and as of this writing, AFAIK, the only precisely-scavenged
|
||||
;; backends that are actually interrupt-safe around function calls
|
||||
;; are PPC, ARM64, and probably ARM. PPC and ARM64 because they
|
||||
;; have thread support, and GC load testing on PPC is how this
|
||||
;; constraint was found in the first place. Probably ARM because I
|
||||
;; wrote the bulk of the ARM backend well after I fixed function
|
||||
;; calling on PPC and rewrote scavenge_interrupt_context() so that
|
||||
;; things behaved reliably. -- AB, 2018-Jan-11
|
||||
(flet ((normalize-candidate (object)
|
||||
;; Unlike with the prior implementation, we cannot presume
|
||||
;; that a FUNCTION is amenable to FUN-CODE-HEADER (it might
|
||||
;; be a closure, and that is unlikely to be at all useful).
|
||||
;; Fortunately, WIDETAG-OF comes up with sane values for
|
||||
;; all object types, and we can pick off the SIMPLE-FUN
|
||||
;; case easily enough.
|
||||
(let ((widetag (widetag-of object)))
|
||||
(cond ((= widetag code-header-widetag)
|
||||
object)
|
||||
((= widetag return-pc-widetag)
|
||||
(lra-code-header object))
|
||||
((= widetag simple-fun-widetag)
|
||||
(or (fun-code-header object)
|
||||
:undefined-function))
|
||||
(t
|
||||
nil)))))
|
||||
(dolist (boxed-reg-offset sb-vm::boxed-regs
|
||||
;; If we can't actually pair the PC then we presume that
|
||||
;; we're in an assembly-routine and that reg_CODE is, in
|
||||
;; fact, the right thing to use... And that it will do
|
||||
;; no harm to return it here anyway even if it isn't.
|
||||
(normalize-candidate
|
||||
#+ppc64
|
||||
(let ((code (context-register context sb-vm::code-offset)))
|
||||
(%make-lisp-obj (if (logtest lowtag-mask code)
|
||||
code
|
||||
(logior code other-pointer-lowtag))))
|
||||
#-ppc64
|
||||
(boxed-context-register context sb-vm::code-offset)))
|
||||
(let ((candidate
|
||||
(normalize-candidate
|
||||
(boxed-context-register context boxed-reg-offset))))
|
||||
(when (and (not (symbolp candidate)) ;; NIL or :UNDEFINED-FUNCTION
|
||||
(nth-value 1 (context-code-pc-offset context candidate)))
|
||||
(return candidate))))))
|
||||
|
||||
;;;; frame utilities
|
||||
|
||||
|
|
@ -1356,22 +1226,11 @@ register."
|
|||
(fp (frame-pointer frame)))
|
||||
(labels ((catch-ref (slot)
|
||||
(sap-ref-lispobj catch (* slot n-word-bytes)))
|
||||
#-(or x86 x86-64 arm arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
(catch-entry-offset ()
|
||||
(let* ((lra (catch-ref catch-block-entry-pc-slot))
|
||||
(component (catch-ref catch-block-code-slot))
|
||||
#+ppc64
|
||||
(component (%make-lisp-obj (logior (ash component n-fixnum-tag-bits)
|
||||
other-pointer-lowtag))))
|
||||
(* (- (1+ (get-header-data lra))
|
||||
(code-header-words component))
|
||||
n-word-bytes)))
|
||||
#+(or x86 x86-64 arm arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
(catch-entry-offset ()
|
||||
(let* ((ra (sap-ref-sap
|
||||
catch (* catch-block-entry-pc-slot
|
||||
n-word-bytes)))
|
||||
(component #+(or riscv loongarch64 ppc64 ppc arm sparc)
|
||||
(component #-(or x86 x86-64 arm64)
|
||||
(catch-ref catch-block-code-slot)
|
||||
#+(or x86 x86-64 arm64)
|
||||
(code-header-from-pc ra))
|
||||
|
|
@ -3893,8 +3752,7 @@ register."
|
|||
;;; state of the program, not merely a return PC location.
|
||||
;;; (I tried changing this to DEFUN-CACHED, which failed a regression test)
|
||||
(defun make-bpt-lra (real-lra &optional known-return-p)
|
||||
(declare (type #-(or x86 x86-64 arm arm64 sparc riscv loongarch64 ppc64 ppc) lra
|
||||
#+(or arm arm64 sparc riscv loongarch64 ppc64 ppc) fixnum
|
||||
(declare (type #-(or x86 x86-64) fixnum
|
||||
#+(or x86 x86-64) system-area-pointer real-lra))
|
||||
(let* ((src-start
|
||||
;; Just trap when using the known return values convention,
|
||||
|
|
@ -3932,11 +3790,6 @@ register."
|
|||
(with-pinned-objects (code-object)
|
||||
(let ((dst-start
|
||||
(sap+ (code-instructions code-object) start-offset)))
|
||||
#-(or x86 x86-64 arm arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
(progn
|
||||
(setf (code-header-ref code-object real-lra-slot) real-lra)
|
||||
(setf (code-header-ref code-object known-return-p-slot) known-return-p))
|
||||
#+(or x86 x86-64 arm arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
(multiple-value-bind (offset code)
|
||||
(compute-lra-data-from-pc real-lra)
|
||||
(setf (code-header-ref code-object real-lra-slot) code)
|
||||
|
|
@ -3950,22 +3803,9 @@ register."
|
|||
;; CODE-OBJECT is implicitly pinned after leaving
|
||||
;; WITH-PINNED-OBJECTS (and would be pinned even if the W-P-O
|
||||
;; were deleted), so it's OK to return a SAP into CODE-OBJECT.
|
||||
#+(or x86 x86-64 arm arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
(let ((dst-start #+(or x86 x86-64) dst-start
|
||||
#+(or arm arm64 sparc riscv loongarch64 ppc64 ppc) (%make-lisp-obj (sap-int dst-start))))
|
||||
(values dst-start code-object trap-offset))
|
||||
#-(or x86 x86-64 arm arm64 sparc riscv loongarch64 ppc64 ppc)
|
||||
(let* ((lra-header (sap+ dst-start (* -1 n-word-bytes)))
|
||||
;; Compute the LRA->code backpointer in words
|
||||
(delta (ash (sap- lra-header
|
||||
(int-sap (logandc2 (get-lisp-obj-address code-object)
|
||||
lowtag-mask)))
|
||||
(- word-shift))))
|
||||
(setf (sap-ref-word lra-header 0)
|
||||
(logior (ash delta n-widetag-bits) return-pc-widetag))
|
||||
(values (%make-lisp-obj (logior (sap-int lra-header) other-pointer-lowtag))
|
||||
code-object
|
||||
trap-offset))))))
|
||||
#-(or x86 x86-64) (%make-lisp-obj (sap-int dst-start))))
|
||||
(values dst-start code-object trap-offset))))))
|
||||
|
||||
;;;; miscellaneous
|
||||
|
||||
|
|
|
|||
|
|
@ -71,7 +71,6 @@ and submit it as a patch."
|
|||
(cond ((not (sb-vm:is-lisp-pointer (get-lisp-obj-address object))) 0)
|
||||
((eq object nil) (ash sb-vm::sizeof-nil-in-words sb-vm:word-shift))
|
||||
((simple-fun-p object) (code-object-size (fun-code-header object)))
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc) ((lra-p object) 1)
|
||||
(t
|
||||
(with-alien ((sizer (function unsigned unsigned) :extern "primitive_object_size"))
|
||||
(with-pinned-objects (object)
|
||||
|
|
|
|||
|
|
@ -124,7 +124,6 @@
|
|||
;;; things have to happen:
|
||||
;;; * funcallable-instances must become directly callable objects
|
||||
;;; * simple-fun-self, closure-fun, fin-fun must be raw addresses
|
||||
;;; * LRAs should be removed
|
||||
;;; For now, I'm using a hand-assembled simple-fun as simplifying wrapper
|
||||
;;; since executable funinstances are not supported.
|
||||
#+64-bit
|
||||
|
|
|
|||
|
|
@ -108,7 +108,6 @@
|
|||
(def-type-predicate-wrapper integerp)
|
||||
(def-type-predicate-wrapper listp)
|
||||
(def-type-predicate-wrapper long-float-p)
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc) (def-type-predicate-wrapper lra-p)
|
||||
(def-type-predicate-wrapper null)
|
||||
(def-type-predicate-wrapper numberp)
|
||||
(sb-c::when-vop-existsp (:translate pointerp)
|
||||
|
|
|
|||
|
|
@ -1969,11 +1969,6 @@ variable: an unreadable object representing the error is printed instead.")
|
|||
(format stream " {~X..~X}"
|
||||
a (+ (logandc2 a sb-vm:lowtag-mask) (code-object-size component))))))
|
||||
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc)
|
||||
(defmethod print-object ((lra lra) stream)
|
||||
(print-unreadable-object (lra stream :identity t)
|
||||
(write-string "return PC object" stream)))
|
||||
|
||||
(defmethod print-object ((fdefn fdefn) stream)
|
||||
(print-unreadable-object (fdefn stream :type t)
|
||||
;; As fdefn names are particularly relevant to those hacking on the compiler
|
||||
|
|
|
|||
|
|
@ -166,7 +166,6 @@
|
|||
(def symbol-package-id)
|
||||
(def symbol-hash)
|
||||
(def symbol-%info) ; primitive reader always needs a stub
|
||||
#-(or x86 x86-64 arm64 riscv loongarch64 ppc64 ppc) (def lra-code-header)
|
||||
(def %make-lisp-obj)
|
||||
#+x86-64
|
||||
(def single-float-copysign (float float2))
|
||||
|
|
|
|||
|
|
@ -1831,7 +1831,6 @@ is a good idea, but see SB-SYS re. blurring of boundaries.")
|
|||
"COMPLEX-VECTOR"
|
||||
"LIST-TO-VECTOR" "LIST-TO-WEAK-VECTOR" "VECTOR-TO-LIST"
|
||||
"LOGICAL-HOST" "LOGICAL-HOST-DESIGNATOR"
|
||||
"LRA" "LRA-CODE-HEADER" "LRA-P"
|
||||
"MAKE-ALIEN-TYPE-TYPE"
|
||||
"MAKE-ARRAY-HEADER" "MAKE-ARRAY-TYPE" "MAKE-CONS-TYPE"
|
||||
"%MAKE-DOUBLE-FLOAT"
|
||||
|
|
@ -3068,7 +3067,6 @@ structure representations")
|
|||
"RATIO-DENOMINATOR-SLOT" "RATIO-NUMERATOR-SLOT"
|
||||
"RATIO-SIZE" "RATIO-WIDETAG"
|
||||
"*READ-ONLY-SPACE-FREE-POINTER*"
|
||||
"RETURN-PC-WIDETAG"
|
||||
"RETURN-PC-RETURN-POINT-OFFSET" "RETURN-PC-SAVE-OFFSET"
|
||||
"SAETP-CTYPE" "SAETP-INITIAL-ELEMENT-DEFAULT"
|
||||
"SAETP-N-BITS" "SAETP-TYPECODE" "SAETP-PRIMITIVE-TYPE-NAME"
|
||||
|
|
|
|||
|
|
@ -64,10 +64,6 @@
|
|||
(inst sub :ne code thing temp)
|
||||
(inst mov :eq code null-tn)))
|
||||
|
||||
(define-vop (code-from-lra code-from-mumble)
|
||||
(:translate sb-di::lra-code-header)
|
||||
(:variant other-pointer-lowtag))
|
||||
|
||||
(define-vop (code-from-fun code-from-mumble)
|
||||
(:translate sb-di::fun-code-header)
|
||||
(:variant fun-pointer-lowtag))
|
||||
|
|
|
|||
|
|
@ -349,8 +349,7 @@
|
|||
(assemble-sections
|
||||
asmstream
|
||||
(ir2-component-entries ir2-component)
|
||||
(make-segment nil;; (default-segment-run-scheduler)
|
||||
skew))
|
||||
(make-segment (default-segment-run-scheduler) skew))
|
||||
|
||||
(values segment text-length fun-table
|
||||
(asmstream-elsewhere-label asmstream) fixup-notes
|
||||
|
|
|
|||
|
|
@ -209,8 +209,7 @@
|
|||
simple-fun-widetag ; 3A 41
|
||||
closure-widetag ; 3E 45
|
||||
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc ppc64) return-pc-widetag ; 42 49
|
||||
#+(or x86 x86-64 arm arm64 riscv loongarch64 ppc ppc64) lra-widetag-notused
|
||||
unused10-widetag ; 42 49
|
||||
|
||||
value-cell-widetag ; 46 4D
|
||||
character-widetag ; 4A 51
|
||||
|
|
@ -306,7 +305,6 @@
|
|||
(simple-fun-widetag "simplefun")
|
||||
(closure-widetag "closure")
|
||||
(code-header-widetag "codeblob")
|
||||
(return-pc-widetag "LRA")
|
||||
(value-cell-widetag "value-cell")
|
||||
(character-widetag "char")
|
||||
(sap-widetag "sap")
|
||||
|
|
|
|||
|
|
@ -3246,11 +3246,7 @@ Legal values for OFFSET are -4, -8, -12, ..."
|
|||
(destructuring-bind (name priority value suffix) const
|
||||
(unless (= prev-priority priority)
|
||||
(when (= prev-priority 1)
|
||||
(format t "#ifdef RETURN_PC_WIDETAG
|
||||
#define embedded_obj_p(tag) (tag==RETURN_PC_WIDETAG || tag==SIMPLE_FUN_WIDETAG)
|
||||
#else
|
||||
#define embedded_obj_p(tag) (tag==SIMPLE_FUN_WIDETAG)
|
||||
#endif~%"))
|
||||
(format t "#define embedded_obj_p(tag) (tag==SIMPLE_FUN_WIDETAG)~%"))
|
||||
(terpri)
|
||||
(setf prev-priority priority))
|
||||
(when (minusp value)
|
||||
|
|
|
|||
|
|
@ -60,9 +60,6 @@
|
|||
(closure ,(or #+(or arm64 ppc64 x86 x86-64) "closure" "short_boxed") "lose" "short_boxed")
|
||||
;; Like closure, but these can also have a layout pointer in the high header bytes.
|
||||
(funcallable-instance "funinstance" "lose" "short_boxed")
|
||||
;; These have a scav and trans function, but no size function.
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc)
|
||||
(return-pc "return_pc_header" "return_pc_header" "lose")
|
||||
|
||||
(value-cell "boxed")
|
||||
(symbol "symbol")
|
||||
|
|
|
|||
|
|
@ -113,9 +113,6 @@
|
|||
|
||||
(define-type-vop code-component-p (code-header-widetag))
|
||||
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc)
|
||||
(define-type-vop lra-p (return-pc-widetag))
|
||||
|
||||
(define-type-vop fdefn-p (fdefn-widetag))
|
||||
|
||||
(define-type-vop array-header-p
|
||||
|
|
|
|||
|
|
@ -519,7 +519,6 @@
|
|||
;; it takes a word index, not a byte displacement from the SAP.
|
||||
(defknown stack-ref (system-area-pointer index) t (flushable))
|
||||
(defknown %set-stack-ref (system-area-pointer index t) (values) ())
|
||||
(defknown lra-code-header (t) t (movable flushable))
|
||||
;; FUN-CODE-HEADER returns NIL for assembly routines that have a simple-fun header
|
||||
;; with 0 as the data value. We should probably ensure that assembly routines
|
||||
;; referenced by tagged pointers have correct code backpointers.
|
||||
|
|
|
|||
|
|
@ -118,7 +118,6 @@
|
|||
(define-type-predicate simd-pack-256-p simd-pack-256)
|
||||
(define-type-predicate weak-pointer-p weak-pointer)
|
||||
(define-type-predicate code-component-p code-component)
|
||||
#-(or x86 x86-64 arm64 ppc64 ppc) (define-type-predicate lra-p lra)
|
||||
(define-type-predicate fdefn-p fdefn)
|
||||
;;; Unlike the un-%'ed versions, these are true type predicates,
|
||||
;;; accepting any type object.
|
||||
|
|
|
|||
|
|
@ -76,10 +76,6 @@
|
|||
(inst b done)
|
||||
(inst move code null-tn)))))
|
||||
|
||||
(define-vop (code-from-lra code-from-mumble)
|
||||
(:translate sb-di::lra-code-header)
|
||||
(:variant other-pointer-lowtag))
|
||||
|
||||
(define-vop (code-from-fun code-from-mumble)
|
||||
(:translate sb-di::fun-code-header)
|
||||
(:variant fun-pointer-lowtag))
|
||||
|
|
|
|||
|
|
@ -71,10 +71,6 @@
|
|||
(move code null-tn)
|
||||
(inst b done)))))
|
||||
|
||||
(define-vop (code-from-lra code-from-mumble)
|
||||
(:translate sb-di::lra-code-header)
|
||||
(:variant other-pointer-lowtag))
|
||||
|
||||
(define-vop (code-from-fun code-from-mumble)
|
||||
(:translate sb-di::fun-code-header)
|
||||
(:variant fun-pointer-lowtag))
|
||||
|
|
|
|||
|
|
@ -75,10 +75,6 @@
|
|||
(move code null-tn)
|
||||
(inst b done)))))
|
||||
|
||||
(define-vop (code-from-lra code-from-mumble)
|
||||
(:translate sb-di::lra-code-header)
|
||||
(:variant other-pointer-lowtag))
|
||||
|
||||
(define-vop (code-from-fun code-from-mumble)
|
||||
(:translate sb-di::fun-code-header)
|
||||
(:variant fun-pointer-lowtag))
|
||||
|
|
|
|||
|
|
@ -71,10 +71,6 @@
|
|||
(inst b done)
|
||||
(move code null-tn)))))
|
||||
|
||||
(define-vop (code-from-lra code-from-mumble)
|
||||
(:translate lra-code-header)
|
||||
(:variant other-pointer-lowtag))
|
||||
|
||||
(define-vop (code-from-function code-from-mumble)
|
||||
(:translate fun-code-header)
|
||||
(:variant fun-pointer-lowtag))
|
||||
|
|
|
|||
|
|
@ -1650,12 +1650,6 @@ Otherwise, use the Sparc register names")
|
|||
(:emitter
|
||||
(emit-header-data segment simple-fun-widetag)))
|
||||
|
||||
(define-instruction lra-header-word (segment)
|
||||
:pinned
|
||||
(:delay 0)
|
||||
(:emitter
|
||||
(emit-header-data segment return-pc-widetag)))
|
||||
|
||||
|
||||
;;;; Instructions for converting between code objects, functions, and lras.
|
||||
|
||||
|
|
|
|||
|
|
@ -151,8 +151,7 @@
|
|||
|
||||
|
||||
(define-vop (nlx-entry)
|
||||
(:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops
|
||||
; would be inserted before the LRA.
|
||||
(:args (sp)
|
||||
(start)
|
||||
(count))
|
||||
(:results (values :more t))
|
||||
|
|
|
|||
|
|
@ -278,7 +278,7 @@
|
|||
;;; <padding to dual-word boundary>
|
||||
;;; start of instructions
|
||||
;;; ...
|
||||
;;; fun-headers and lra's buried in here randomly
|
||||
;;; fun-headers buried in here randomly
|
||||
;;; ...
|
||||
;;; <padding to dual-word boundary>
|
||||
;;;
|
||||
|
|
@ -290,8 +290,6 @@
|
|||
;;; type
|
||||
;;; info
|
||||
;;;
|
||||
;;; LRA layout (dual word aligned):
|
||||
;;; header-word
|
||||
|
||||
(declaim (inline words-to-bytes))
|
||||
|
||||
|
|
@ -355,28 +353,6 @@
|
|||
(type alignment size))
|
||||
(zerop (logand (1- size) address)))
|
||||
|
||||
#-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc)
|
||||
(progn
|
||||
(defconstant lra-size (words-to-bytes 1))
|
||||
(defun lra-hook (chunk stream dstate)
|
||||
(declare (type dchunk chunk)
|
||||
(ignore chunk)
|
||||
(type (or null stream) stream)
|
||||
(type disassem-state dstate))
|
||||
(when (and (aligned-p (dstate-cur-addr dstate)
|
||||
(* 2 sb-vm:n-word-bytes))
|
||||
;; Check type.
|
||||
(= (sap-ref-8 (dstate-segment-sap dstate)
|
||||
(if (eq (dstate-byte-order dstate)
|
||||
:little-endian)
|
||||
(dstate-cur-offs dstate)
|
||||
(+ (dstate-cur-offs dstate)
|
||||
(1- lra-size))))
|
||||
sb-vm:return-pc-widetag))
|
||||
(when stream
|
||||
(note "possible LRA header" dstate)))
|
||||
nil))
|
||||
|
||||
;;; Print the fun-header (entry-point) pseudo-instruction at the
|
||||
;;; current location in DSTATE to STREAM and skip 2 words.
|
||||
(defun fun-header-hook (fun-index stream dstate)
|
||||
|
|
@ -1380,8 +1356,7 @@
|
|||
(write-string ", " stream))
|
||||
(format stream "#X~2,'0x" (sap-ref-8 sap (+ offs start-offs))))))
|
||||
|
||||
(defvar *default-dstate-hooks*
|
||||
(list* #-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc) #'lra-hook nil))
|
||||
(defvar *default-dstate-hooks* nil)
|
||||
|
||||
;;; Make a disassembler-state object.
|
||||
(defun make-dstate (&optional (fun-hooks *default-dstate-hooks*))
|
||||
|
|
|
|||
|
|
@ -407,9 +407,6 @@ code_pointer(lispobj object)
|
|||
switch (widetag_of(headerp)) {
|
||||
case CODE_HEADER_WIDETAG:
|
||||
break;
|
||||
#ifdef RETURN_PC_WIDETAG
|
||||
case RETURN_PC_WIDETAG:
|
||||
#endif
|
||||
case SIMPLE_FUN_WIDETAG:
|
||||
len = (HeaderValue(*headerp) & FUN_HEADER_NWORDS_MASK);
|
||||
if (len == 0)
|
||||
|
|
|
|||
|
|
@ -101,19 +101,9 @@ static inline sword_t dword_index(uword_t ptr, uword_t base) {
|
|||
|
||||
/* The "canonical" pointer to an object is usually just the object itself.
|
||||
* This is true even for SIMPLE-FUN- we don't need to regard only the code base
|
||||
* as canonical. The exception is that LRAs can't be marked because they can't
|
||||
* be discovered and marked when marking their containing code */
|
||||
* as canonical. */
|
||||
static inline lispobj canonical_ptr(lispobj pointer)
|
||||
{
|
||||
#ifdef RETURN_PC_WIDETAG
|
||||
/* NO_TLS_VALUE is all 1s, and so it might look like it has OTHER_POINTER_LOWTAG
|
||||
* depending on the architecture (the word size, etc), but there is no memory
|
||||
* at 0xff...ff so definitely don't call widetag_of - that won't fly! */
|
||||
if (lowtag_of(pointer)==OTHER_POINTER_LOWTAG
|
||||
&& pointer != NO_TLS_VALUE_MARKER
|
||||
&& widetag_of(native_pointer(pointer)) == RETURN_PC_WIDETAG)
|
||||
return fun_code_tagged(native_pointer(pointer));
|
||||
#endif
|
||||
return pointer;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -485,28 +485,6 @@ static sword_t size_code_blob(lispobj *where)
|
|||
return code_total_nwords((struct code*)where);
|
||||
}
|
||||
|
||||
#ifdef RETURN_PC_WIDETAG
|
||||
static sword_t
|
||||
scav_return_pc_header(lispobj *where, lispobj object)
|
||||
{
|
||||
lose("attempted to scavenge a return PC header where=%p object=%"OBJ_FMTX,
|
||||
where, object);
|
||||
return 0; /* bogus return value to satisfy static type checking */
|
||||
}
|
||||
|
||||
static lispobj
|
||||
trans_return_pc_header(lispobj object)
|
||||
{
|
||||
struct simple_fun *return_pc = (struct simple_fun *) native_pointer(object);
|
||||
uword_t offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
|
||||
|
||||
/* Transport the whole code object */
|
||||
struct code *code = trans_code((struct code *) ((uword_t) return_pc - offset));
|
||||
|
||||
return make_lispobj((char*)code + offset, OTHER_POINTER_LOWTAG);
|
||||
}
|
||||
#endif /* RETURN_PC_WIDETAG */
|
||||
|
||||
#if FUN_SELF_FIXNUM_TAGGED
|
||||
/* Closures hold a pointer to the raw simple-fun entry address instead of the
|
||||
* tagged object so that a native call instruction can be used more easily */
|
||||
|
|
@ -2145,20 +2123,6 @@ properly_tagged_p_internal(lispobj pointer, lispobj *start_addr)
|
|||
(struct simple_fun*)potential_fun) >= 0)
|
||||
return 1;
|
||||
}
|
||||
#ifdef RETURN_PC_WIDETAG
|
||||
/* LRA objects are similar to simple-funs in that they are
|
||||
* embedded objects. We can't actually do as precise a test
|
||||
* as for simple-funs, since we don't know where the LRAs are.
|
||||
* Nonetheless, the check of header validity should produce
|
||||
* very few false positives */
|
||||
if (lowtag_of(pointer) == OTHER_POINTER_LOWTAG) {
|
||||
lispobj *potential_lra = native_pointer(pointer);
|
||||
if ((widetag_of(potential_lra) == RETURN_PC_WIDETAG) &&
|
||||
((potential_lra - HeaderValue(potential_lra[0])) == start_addr)) {
|
||||
return 1; /* It's as good as we can verify. */
|
||||
}
|
||||
}
|
||||
#endif
|
||||
}
|
||||
return 0; // no good
|
||||
}
|
||||
|
|
|
|||
|
|
@ -312,9 +312,6 @@ lispobj copy_potential_large_object(lispobj object, sword_t nwords,
|
|||
#define page_single_obj_p(page) ((page_table[page].type & SINGLE_OBJECT_FLAG)!=0)
|
||||
|
||||
extern unsigned char* gc_page_pins;
|
||||
#ifdef RETURN_PC_WIDETAG
|
||||
#include "code.h" // for fun_code_header
|
||||
#endif
|
||||
static inline bool pinned_p(lispobj obj, page_index_t page)
|
||||
{
|
||||
extern struct hopscotch_table pinned_objects;
|
||||
|
|
@ -324,18 +321,6 @@ static inline bool pinned_p(lispobj obj, page_index_t page)
|
|||
// already have had its generation changed to newspace.
|
||||
if (page_single_obj_p(page)) return 0;
|
||||
|
||||
#ifdef RETURN_PC_WIDETAG
|
||||
// Yet another complication from the despised LRA objects- with the
|
||||
// refinement of 8 pin bits per page, we either must set all possible bits
|
||||
// for a simple-fun, or map LRAs to the code base address.
|
||||
if (widetag_of(native_pointer(obj)) == RETURN_PC_WIDETAG) {
|
||||
// The hash-table stores tagged pointers.
|
||||
obj = make_lispobj(fun_code_header((struct simple_fun*)native_pointer(obj)),
|
||||
OTHER_POINTER_LOWTAG);
|
||||
page = find_page_index((void*)obj);
|
||||
}
|
||||
#endif
|
||||
|
||||
unsigned char pins = gc_page_pins[page];
|
||||
if (!pins) return 0;
|
||||
unsigned addr_lowpart = obj & (GENCGC_PAGE_BYTES-1);
|
||||
|
|
|
|||
|
|
@ -2106,9 +2106,6 @@ static void pin_exact_root(lispobj obj)
|
|||
lispobj *object_start = native_pointer(obj);
|
||||
switch (widetag_of(object_start)) {
|
||||
case SIMPLE_FUN_WIDETAG:
|
||||
#ifdef RETURN_PC_WIDETAG
|
||||
case RETURN_PC_WIDETAG:
|
||||
#endif
|
||||
obj = make_lispobj(fun_code_header((struct simple_fun*)object_start),
|
||||
OTHER_POINTER_LOWTAG);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@
|
|||
#define reg_CNAME REG(20) /* Current function name */
|
||||
#define reg_LEXENV REG(21) /* And why burn a register for this ? */
|
||||
#define reg_OCFP REG(22) /* The caller's reg_CFP */
|
||||
#define reg_LRA REG(23) /* Tagged lisp return address */
|
||||
#define reg_LRA REG(23) /* Lisp return address */
|
||||
#define reg_A0 REG(24) /* First function arg/return value */
|
||||
#define reg_A1 REG(25) /* Second. */
|
||||
#define reg_A2 REG(26) /* */
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@
|
|||
#define reg_NFP REG(20) /* Lisp may save around FF-call */
|
||||
#define reg_LEXENV REG(21) /* And why burn a register for this ? */
|
||||
#define reg_OCFP REG(22) /* The caller's reg_CFP */
|
||||
#define reg_LRA REG(23) /* Tagged lisp return address */
|
||||
#define reg_LRA REG(23) /* lisp return address */
|
||||
#define reg_A0 REG(24) /* First function arg/return value */
|
||||
#define reg_A1 REG(25) /* Second. */
|
||||
#define reg_A2 REG(26) /* */
|
||||
|
|
|
|||
|
|
@ -674,12 +674,6 @@ static void print_fun_or_otherptr(lispobj obj, iochannel_t io)
|
|||
break;
|
||||
}
|
||||
|
||||
#ifdef RETURN_PC_WIDETAG
|
||||
case RETURN_PC_WIDETAG:
|
||||
print_obj("code: ", obj - (count * N_WORD_BYTES), io);
|
||||
break;
|
||||
#endif
|
||||
|
||||
case CLOSURE_WIDETAG:
|
||||
print_slots(closure_slots, count, ptr, io);
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -435,9 +435,6 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
|
|||
case CODE_HEADER_WIDETAG:
|
||||
return ptrans_code(thing);
|
||||
|
||||
case RETURN_PC_WIDETAG:
|
||||
return ptrans_returnpc(thing, header);
|
||||
|
||||
case FDEFN_WIDETAG:
|
||||
return ptrans_fdefn(thing, header);
|
||||
|
||||
|
|
@ -546,7 +543,6 @@ pscav(lispobj *addr, long nwords, boolean constant)
|
|||
break;
|
||||
|
||||
case SIMPLE_FUN_WIDETAG:
|
||||
case RETURN_PC_WIDETAG:
|
||||
/* We should never hit any of these, 'cause they occur
|
||||
* buried in the middle of code objects. */
|
||||
gc_abort();
|
||||
|
|
|
|||
|
|
@ -64,15 +64,10 @@
|
|||
(let ((obj (sb-vm::reconstitute-object (%make-lisp-obj baseptr))))
|
||||
(when (code-component-p obj)
|
||||
(cond
|
||||
#+(or c-stack-is-control-stack arm64 riscv loongarch64)
|
||||
((= (logand word sb-vm:lowtag-mask) sb-vm:fun-pointer-lowtag)
|
||||
(dotimes (i (code-n-entries obj))
|
||||
(when (= (get-lisp-obj-address (%code-entry-point obj i)) word)
|
||||
(return (setq obj (%code-entry-point obj i))))))
|
||||
#-(or c-stack-is-control-stack arm64 riscv loongarch64) ; i.e. does this backend have LRAs
|
||||
((= (logand (sb-sys:sap-ref-word (int-sap (logandc2 word sb-vm:lowtag-mask)) 0)
|
||||
sb-vm:widetag-mask) sb-vm:return-pc-widetag)
|
||||
(setq obj (%make-lisp-obj word)))))
|
||||
(return (setq obj (%code-entry-point obj i))))))))
|
||||
;; interior pointers to objects that contain instructions are OK,
|
||||
;; otherwise only correctly tagged pointers.
|
||||
(when (or (typep obj '(or fdefn code-component funcallable-instance))
|
||||
|
|
|
|||
Loading…
Reference in a new issue