[PATCH 11/13] Recognize loongarch64 path in src/code

From 09bacd01fbaf0c74068ea1d7ca6f556460cdb213 Mon Sep 17 00:00:00 2001
From: ZiLong Wang <[email protected]>
Date: Sat, 17 Jan 2026 10:31:01 +0800
Subject: [PATCH 11/13] recognize loongarch path in src/code

---
 src/code/cas.lisp             |  4 +--
 src/code/class.lisp           |  4 +--
 src/code/debug-int.lisp       | 56 ++++++++++++++++++-----------------
 src/code/early-raw-slots.lisp |  2 +-
 src/code/gc.lisp              |  2 +-
 src/code/interr.lisp          |  4 +--
 src/code/irrat.lisp           |  4 +--
 src/code/macros.lisp          |  6 ++--
 src/code/pred.lisp            |  2 +-
 src/code/print.lisp           |  2 +-
 src/code/share-vm.lisp        |  4 +--
 src/code/stubs.lisp           |  2 +-
 12 files changed, 47 insertions(+), 45 deletions(-)

diff --git a/src/code/cas.lisp b/src/code/cas.lisp
index ea6e0e6ea..7947adba8 100644
--- a/src/code/cas.lisp
+++ b/src/code/cas.lisp
@@ -31,11 +31,11 @@
   ;; because it is used for effect. And if compare-and-swap vops exist,
   ;; then the setter isn't used at all.
   (def %instance-cas (instance index) %instance-ref %instance-set)
-  #+(or x86-64 x86 riscv)
+  #+(or x86-64 x86 riscv loongarch64)
   (def %raw-instance-cas/word (instance index)
        %raw-instance-ref/word
        %raw-instance-set/word)
-  #+(or arm64 riscv x86 x86-64)
+  #+(or arm64 riscv x86 x86-64 loongarch64)
   (def %raw-instance-cas/signed-word (instance index)
        %raw-instance-ref/signed-word
        %raw-instance-set/signed-word)
diff --git a/src/code/class.lisp b/src/code/class.lisp
index e8cdf5624..b5275f57b 100644
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -951,7 +951,7 @@ between the ~A definition and the ~A definition"
 (declaim (type cons **non-instance-classoid-types**))
 (defglobal **non-instance-classoid-types**
   '(symbol system-area-pointer weak-pointer code-component
-    #-(or x86 x86-64 arm64 riscv) lra
+    #-(or x86 x86-64 arm64 riscv loongarch64) lra
     fdefn random-class))
 
 (defun classoid-non-instance-p (classoid)
@@ -1052,7 +1052,7 @@ 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 arm64 riscv)
+     #-(or x86 x86-64 arm64 riscv loongarch64)
      (lra :codes (,sb-vm:return-pc-widetag)
           :predicate lra-p
           ;; Make the PROTOTYPE slot unbound.
diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 4dd0ebb10..ee8328ce4 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -530,7 +530,7 @@
   ;; 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)
+#-(or x86 x86-64 arm64 riscv loongarch64)
 (defconstant known-return-p-slot (+ code-constants-offset 1))
 (defconstant cookie-slot (+ code-constants-offset 2))
 
@@ -645,7 +645,7 @@
                  (word (int-sap pc)))))))
       (unless (= base-ptr 0) (%make-lisp-obj (logior base-ptr other-pointer-lowtag))))))
 
-#+(or arm64 riscv)
+#+(or arm64 riscv loongarch64)
 (defun compute-lra-data-from-pc (pc)
   (declare (type integer pc))
   (let* ((pc-sap (int-sap (ash pc n-fixnum-tag-bits)))
@@ -796,7 +796,9 @@
     (bogus-debug-fun
      ;; No handy backend (or compiler) defined constant for this one,
      ;; so construct it here and now.
-     (sb-c:make-sc+offset control-stack-sc-number #-riscv lra-save-offset #+riscv sb-vm::ra-save-offset))))
+     (sb-c:make-sc+offset control-stack-sc-number 
+		     #-(or riscv loongarch64) lra-save-offset
+                     #+(or riscv loongarch64) sb-vm::ra-save-offset))))
 
 (defun old-fp-offset-for-location (debug-fun location)
   (declare (ignorable debug-fun location))
@@ -883,7 +885,7 @@
 ;;; 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 x86 x86-64 arm64 riscv)
+#-(or x86 x86-64 arm64 riscv loongarch64)
 (defun compute-calling-frame (caller lra up-frame &optional savedp)
   (declare (type system-area-pointer caller)
            (ignore savedp))
@@ -936,9 +938,9 @@
                                  (if up-frame (1+ (frame-number up-frame)) 0)
                                  escaped))))))
 
-#+(or x86 x86-64 arm64 riscv)
+#+(or x86 x86-64 arm64 riscv loongarch64)
 (defun compute-calling-frame (caller ra up-frame &optional savedp)
-  (declare (type system-area-pointer caller #-(or arm64 riscv) ra))
+  (declare (type system-area-pointer caller #-(or arm64 riscv loongarch64) 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)
@@ -963,8 +965,8 @@
                        "undefined function"))
                      (:foreign-function
                       (make-bogus-debug-fun
-                       (foreign-function-backtrace-name #-(or arm64 riscv) ra
-                                                        #+(or arm64 riscv) (int-sap (get-lisp-obj-address ra)))))
+                       (foreign-function-backtrace-name #-(or arm64 riscv loongarch64) ra
+                                                        #+(or arm64 riscv loongarch64) (int-sap (get-lisp-obj-address ra)))))
                      ((nil)
                       (make-bogus-debug-fun
                        "bogus stack frame"))
@@ -1001,13 +1003,13 @@
 ;;; The special var and descriptor-sap costs a few more instructions, which isn't a big deal
 ;;; because nothing that uses these is performance-critical. However, x86-64 wants these
 ;;; pointers accessed via the thread structure for +/- sb-thread to simplify the vops.
-#+(or x86-64 (and (or riscv arm64) sb-thread))
+#+(or x86-64 (and (or riscv arm64 loongarch64) sb-thread))
 (progn
   (defmacro current-uwp-block-sap ()
     '(sb-vm::current-thread-offset-sap sb-vm::thread-current-unwind-protect-block-slot))
   (defmacro current-catch-block-sap ()
     '(sb-vm::current-thread-offset-sap sb-vm::thread-current-catch-block-slot)))
-#-(or x86-64 (and (or riscv arm64) sb-thread))
+#-(or x86-64 (and (or riscv arm64 loongarch64) sb-thread))
 (progn
   (declaim (special sb-vm::*current-unwind-protect-block* *current-catch-block*))
   (defmacro current-uwp-block-sap () '(descriptor-sap sb-vm::*current-unwind-protect-block*))
@@ -1114,7 +1116,7 @@
           (code (code-object-from-context context))
           assembly-routine-p)
       (/noshow0 "got CODE")
-      #+arm64
+      #+(or arm64 loongarch64)
       (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
@@ -1145,9 +1147,9 @@
                      (sap-int (context-pc context))
                      code
                      (%code-entry-point code 0)
-                     #-(or riscv arm arm64)
+                     #-(or riscv arm arm64 loongarch64)
                      (context-register context sb-vm::lra-offset)
-                     #+riscv
+                     #+(or riscv loongarch64)
                      (context-register context sb-vm::ra-offset)
                      #+(or arm arm64)
                      (stack-ref (int-sap (context-register context
@@ -1160,7 +1162,7 @@
               (setf pc-offset 0))))
         (/noshow0 "returning from FIND-ESCAPED-FRAME")
         (return
-          (cond #-(or riscv arm64)
+          (cond #-(or riscv arm64 loongarch64)
                 ((eq (%code-debug-info code) :bpt-lra)
                  (let ((real-lra (code-header-ref code real-lra-slot)))
                    (values (lra-code-header real-lra)
@@ -1185,12 +1187,12 @@ 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 arm64 ppc64 x86 x86-64)
+#+(or riscv arm64 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 arm64 ppc64 x86 x86-64)
+#-(or riscv arm64 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
@@ -1346,7 +1348,7 @@ register."
         (fp (frame-pointer frame)))
     (labels ((catch-ref (slot)
                (sap-ref-lispobj catch (* slot n-word-bytes)))
-             #-(or x86 x86-64 arm64 riscv)
+             #-(or x86 x86-64 arm64 riscv loongarch64)
              (catch-entry-offset ()
                (let* ((lra (catch-ref catch-block-entry-pc-slot))
                       (component (catch-ref catch-block-code-slot))
@@ -1356,12 +1358,12 @@ register."
                  (* (- (1+ (get-header-data lra))
                        (code-header-words component))
                     n-word-bytes)))
-             #+(or x86 x86-64 arm64 riscv)
+             #+(or x86 x86-64 arm64 riscv loongarch64)
              (catch-entry-offset ()
                (let* ((ra (sap-ref-sap
                            catch (* catch-block-entry-pc-slot
                                     n-word-bytes)))
-                      (component #+riscv
+                      (component #+(or riscv loongarch64)
                                  (catch-ref catch-block-code-slot)
                                  #+(or x86 x86-64 arm64)
                                  (code-header-from-pc ra)))
@@ -3880,8 +3882,8 @@ 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 arm64 riscv) lra
-                 #+(or arm64 riscv) fixnum
+  (declare (type #-(or x86 x86-64 arm64 riscv loongarch64) lra
+                 #+(or arm64 riscv loongarch64) fixnum
                  #+(or x86 x86-64) system-area-pointer real-lra))
   (let* ((src-start
            ;; Just trap when using the known return values convention,
@@ -3894,7 +3896,7 @@ register."
          (start-offset
            (+ n-word-bytes ; Jump Table prefix word
               ;; Alignment padding, LRA header.
-              #-(or x86 x86-64 arm64 riscv)
+              #-(or x86 x86-64 arm64 riscv loongarch64)
               (* 2 n-word-bytes)))
          ;; TRAP-OFFSET is the distance from CODE-INSTRUCTIONS to the
          ;; actual magic fun_end breakpoint trap.
@@ -3919,11 +3921,11 @@ register."
     (with-pinned-objects (code-object)
       (let ((dst-start
               (sap+ (code-instructions code-object) start-offset)))
-        #-(or x86 x86-64 arm64 riscv)
+        #-(or x86 x86-64 arm64 riscv loongarch64)
         (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 arm64 riscv)
+        #+(or x86 x86-64 arm64 riscv loongarch64)
         (multiple-value-bind (offset code)
             (compute-lra-data-from-pc real-lra)
           (setf (code-header-ref code-object real-lra-slot) code)
@@ -3937,11 +3939,11 @@ 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 arm64 riscv)
+        #+(or x86 x86-64 arm64 riscv loongarch64)
         (let ((dst-start #+(or x86 x86-64) dst-start
-                         #+(or arm64 riscv) (%make-lisp-obj (sap-int dst-start))))
+                         #+(or arm64 riscv loongarch64) (%make-lisp-obj (sap-int dst-start))))
           (values dst-start code-object trap-offset))
-        #-(or x86 x86-64 arm64 riscv)
+        #-(or x86 x86-64 arm64 riscv loongarch64)
         (let* ((lra-header (sap+ dst-start (* -1 n-word-bytes)))
                ;; Compute the LRA->code backpointer in words
                (delta (ash (sap- lra-header
diff --git a/src/code/early-raw-slots.lisp b/src/code/early-raw-slots.lisp
index 27a9af04b..1faf2bb34 100644
--- a/src/code/early-raw-slots.lisp
+++ b/src/code/early-raw-slots.lisp
@@ -111,7 +111,7 @@
            ;; For 8 byte words, this should be 1 since double-floats are 8 bytes.
            ;; It can be 1 if the word size is 4 bytes and the machine permits
            ;; double-floats to be unnaturally aligned (x86 and ppc).
-           (or #+(or x86 x86-64 ppc ppc64 arm64 riscv) 1
+           (or #+(or x86 x86-64 ppc ppc64 arm64 riscv loongarch64) 1
                ;; other architectures align double-floats to twice the
                ;; machine word size
                2)))
diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index a5aa0f070..4c226465c 100644
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -71,7 +71,7 @@ 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 arm64 riscv) ((lra-p object) 1)
+        #-(or x86 x86-64 arm64 riscv loongarch64) ((lra-p object) 1)
         (t
          (with-alien ((sizer (function unsigned unsigned) :extern "primitive_object_size"))
            (with-pinned-objects (object)
diff --git a/src/code/interr.lisp b/src/code/interr.lisp
index 509b4c7d8..5b2681f14 100644
--- a/src/code/interr.lisp
+++ b/src/code/interr.lisp
@@ -201,14 +201,14 @@
                        max)
                  (sb-vm::incf-context-pc *current-internal-error-context*
                                          restart)))
-             #+(or x86-64 arm64)
+             #+(or x86-64 arm64 loongarch64)
              (replace-function (value)
                :report (lambda (stream)
                          (format stream "Call a different function with the same arguments"))
                :interactive read-evaluated-form
                (sb-vm::context-call-function *current-internal-error-context*
                                              (fdefinition value)))
-             #+(or x86-64 arm64)
+             #+(or x86-64 arm64 loongarch64)
              (call-form (form)
                :report (lambda (stream)
                          (format stream "Call a different form"))
diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index fa4f7d808..6c9438a80 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -74,7 +74,7 @@
        ,(make-fun name)
        ,(make-fun name t))))
 
-#+(or x86 x86-64 arm-vfp arm64 riscv) ;; for constant folding
+#+(or x86 x86-64 arm-vfp arm64 riscv loongarch64) ;; for constant folding
 (macrolet ((def (name ll)
              `(defun ,name ,ll (,name ,@ll))))
   (def %sqrt (x))
@@ -105,7 +105,7 @@
 (def-math-rtn "log" 1)
 (def-math-rtn "log10" 1)
 (def-math-rtn "pow" 2)
-#-(or x86 x86-64 arm-vfp arm64 riscv)
+#-(or x86 x86-64 arm-vfp arm64 riscv loongarch64)
 (def-math-rtn "sqrt" 1 nil #+ppc64 t)
 (def-math-rtn "log1p" 1)
 (def-math-rtn "log2" 1)
diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 4b1dfee02..e13b61539 100644
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -612,7 +612,7 @@ evaluated as a PROGN."
   ;; optional dispatch mechanism for the M-V-B gets increasingly
   ;; hairy.
   (let ((val (and (constantp n env) (constant-form-value n env))))
-    (if (and (integerp val) (<= 0 val (or #+(or x86-64 arm64 riscv) ;; better DEFAULT-UNKNOWN-VALUES
+    (if (and (integerp val) (<= 0 val (or #+(or x86-64 arm64 riscv loongarch64) ;; better DEFAULT-UNKNOWN-VALUES
                                           1000
                                           10))) ; Arbitrary limit.
         (let ((dummy-list (make-gensym-list val))
@@ -1765,9 +1765,9 @@ invoked. In that case it will store into PLACE and start over."
          (casser
            (case (dsd-raw-type slotd)
              ((t) '%instance-cas)
-             #+(or arm64 ppc ppc64 riscv x86 x86-64)
+             #+(or arm64 loongarch64 ppc ppc64 riscv x86 x86-64)
              ((word) '%raw-instance-cas/word)
-             #+(or arm64 riscv x86 x86-64)
+             #+(or arm64 loongarch64 riscv x86 x86-64)
              ((sb-vm:signed-word) '%raw-instance-cas/signed-word))))
     (unless casser
       (error "Cannot use COMPARE-AND-SWAP with structure accessor ~
diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index fc4ac7749..4613aa88a 100644
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -108,7 +108,7 @@
   (def-type-predicate-wrapper integerp)
   (def-type-predicate-wrapper listp)
   (def-type-predicate-wrapper long-float-p)
-  #-(or x86 x86-64 arm64 riscv) (def-type-predicate-wrapper lra-p)
+  #-(or x86 x86-64 arm64 riscv loongarch64) (def-type-predicate-wrapper lra-p)
   (def-type-predicate-wrapper null)
   (def-type-predicate-wrapper numberp)
   (sb-c::when-vop-existsp (:translate pointerp)
diff --git a/src/code/print.lisp b/src/code/print.lisp
index 4f1f20208..9ccd2a250 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -1992,7 +1992,7 @@ 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 arm64 riscv)
+#-(or x86 x86-64 arm64 riscv loongarch64)
 (defmethod print-object ((lra lra) stream)
   (print-unreadable-object (lra stream :identity t)
     (write-string "return PC object" stream)))
diff --git a/src/code/share-vm.lisp b/src/code/share-vm.lisp
index 8a2aa1494..26e628b36 100644
--- a/src/code/share-vm.lisp
+++ b/src/code/share-vm.lisp
@@ -18,9 +18,9 @@
     ((&optional (context '*current-internal-error-context*))
      &body body)
   (declare (ignorable context))
-  #+(or x86 x86-64 arm64 riscv)
+  #+(or x86 x86-64 arm64 riscv loongarch64)
   `(progn ,@body)
-  #-(or x86 x86-64 arm64 riscv)
+  #-(or x86 x86-64 arm64 riscv loongarch64)
   `(with-pinned-objects ((with-code-pages-pinned (:dynamic)
                            (sb-di::code-object-from-context ,context)))
      ,@body))
diff --git a/src/code/stubs.lisp b/src/code/stubs.lisp
index 12bc63cc7..0a4988602 100644
--- a/src/code/stubs.lisp
+++ b/src/code/stubs.lisp
@@ -166,7 +166,7 @@
   (def symbol-package-id)
   (def symbol-hash)
   (def symbol-%info) ; primitive reader always needs a stub
-  #-(or x86 x86-64 arm64 riscv) (def lra-code-header)
+  #-(or x86 x86-64 arm64 riscv loongarch64) (def lra-code-header)
   (def %make-lisp-obj)
   #+x86-64
   (def single-float-copysign (float float2))
-- 
2.20.1