Remove mentions of LRA and return-pc-widetag

src/code/class.lisp

@@ -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
+  '(symbol system-area-pointer weak-pointer code-component fdefn random-class))
-    #-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc) lra
-    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)))

src/code/cross-type.lisp

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

src/code/debug-int.lisp

@@ -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
+                       (foreign-function-backtrace-name #+c-stack-is-control-stack ra
-                                                        #+(or arm64 sparc arm riscv loongarch64 ppc64 ppc) (int-sap (get-lisp-obj-address 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)
+          (values code pc-offset context nil assembly-routine-p))))))
-                ((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))))))))
 
 #-(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
+  (declare (type #-(or x86 x86-64) fixnum
-                 #+(or arm arm64 sparc riscv loongarch64 ppc64 ppc) 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))))
+                         #-(or x86 x86-64) (%make-lisp-obj (sap-int dst-start))))
-          (values dst-start code-object trap-offset))
+          (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))))))
 
 ;;;; miscellaneous
 

src/code/gc.lisp

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

src/code/ppc-vm.lisp

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

src/code/pred.lisp

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

src/code/print.lisp

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

src/code/stubs.lisp

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

src/cold/exports.lisp

@@ -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"

src/compiler/arm/debug.lisp

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

src/compiler/codegen.lisp

@@ -349,8 +349,7 @@
           (assemble-sections
            asmstream
            (ir2-component-entries ir2-component)
-           (make-segment nil;; (default-segment-run-scheduler)
+           (make-segment (default-segment-run-scheduler) skew))
-                         skew))
 
         (values segment text-length fun-table
                 (asmstream-elsewhere-label asmstream) fixup-notes

src/compiler/generic/early-objdef.lisp

@@ -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
+  unused10-widetag                                ;  42   49
-  #+(or x86 x86-64 arm arm64 riscv loongarch64 ppc ppc64) lra-widetag-notused
 
   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")

src/compiler/generic/genesis.lisp

@@ -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
+  (format t "#define embedded_obj_p(tag) (tag==SIMPLE_FUN_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~%"))
             (terpri)
             (setf prev-priority priority))
           (when (minusp value)

src/compiler/generic/late-objdef.lisp

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

src/compiler/generic/type-vops.lisp

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

src/compiler/generic/vm-fndb.lisp

@@ -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.

src/compiler/generic/vm-typetran.lisp

@@ -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.

src/compiler/mips/debug.lisp

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

src/compiler/ppc/debug.lisp

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

src/compiler/ppc64/debug.lisp

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

src/compiler/sparc/debug.lisp

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

src/compiler/sparc/insts.lisp

@@ -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.
 

src/compiler/sparc/nlx.lisp

@@ -151,8 +151,7 @@
 
 
 (define-vop (nlx-entry)
-  (:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops
+  (:args (sp)
-              ; would be inserted before the LRA.
          (start)
          (count))
   (:results (values :more t))

src/compiler/target-disassem.lisp

@@ -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*
+(defvar *default-dstate-hooks* nil)
-  (list* #-(or x86 x86-64 arm arm64 riscv loongarch64 ppc64 ppc) #'lra-hook nil))
 
 ;;; Make a disassembler-state object.
 (defun make-dstate (&optional (fun-hooks *default-dstate-hooks*))

src/runtime/backtrace.c

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

src/runtime/fullcgc.c

@@ -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
+ * as canonical. */
- * be discovered and marked when marking their containing code */
 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;
 }
 

src/runtime/gc-common.c

@@ -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
 }

src/runtime/gencgc-impl.h

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

src/runtime/gencgc.c

@@ -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);
     }

src/runtime/ppc-lispregs.h

@@ -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)   /*  */

src/runtime/ppc64-lispregs.h

@@ -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)   /*  */

src/runtime/print.c

@@ -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;

src/runtime/purify.c

@@ -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();

tests/make-thread.pure.lisp

@@ -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))))))
+                               (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)))))
                        ;; interior pointers to objects that contain instructions are OK,
                        ;; otherwise only correctly tagged pointers.
                        (when (or (typep obj '(or fdefn code-component funcallable-instance))