LoongArch64 Support (#754)

maoif · web-flow · commit 0654a2d8fee3 · 2023-11-18T16:37:26.000-07:00
* Fix riscv64 asm-indirect-jump.

* Add loongarch64 support.

* Fix the `cas` primitive in riscv and loongarch backend to allow for offset value bigger than 12 bits.
diff --git a/.gitignore b/.gitignore
@@ -15,6 +15,10 @@
 /ti3*/
 /arm*/
 /tarm*/
+/rv64*/
+/trv64*/
+/la64*/
+/tla64*/
 /ppc*/
 /tppc*/
 /xc-*/
diff --git a/README.md b/README.md
@@ -10,7 +10,7 @@ Supported platforms (bytecode interpreter may work for others):
 
  * Windows: x86, x86_64, AArch64
  * Mac OS: x86, x86_64, AArch64, PowerPC32
- * Linux: x86, x86_64, ARMv6, AArch64, RV64G, PowerPC32
+ * Linux: x86, x86_64, ARMv6, AArch64, RV64G, LoongArch64, PowerPC32
  * FreeBSD: x86, x86_64, ARMv6, AArch64, PowerPC32
  * OpenBSD: x86, x86_64, ARMv6, AArch64, PowerPC32
  * NetBSD: x86, x86_64, ARMv6, AArch64, PowerPC32
diff --git a/c/atomic.h b/c/atomic.h
@@ -30,6 +30,10 @@
 # define STORE_FENCE() __asm__ __volatile__ ("fence w,rw" : : : "memory")
 # define ACQUIRE_FENCE() __asm__ __volatile__ ("fence r,rw" : : : "memory")
 # define RELEASE_FENCE() __asm__ __volatile__ ("fence rw,r" : : : "memory")
+#elif defined(__loongarch64)
+# define STORE_FENCE() __asm__ __volatile__ ("dbar 0" : : : "memory")
+# define ACQUIRE_FENCE() __asm__ __volatile__ ("dbar 0" : : : "memory")
+# define RELEASE_FENCE() __asm__ __volatile__ ("dbar 0" : : : "memory")
 #else
 # define STORE_FENCE() do { } while (0)
 #endif
@@ -147,6 +151,8 @@ FORCEINLINE int S_cas_any_fence(volatile void *addr, void *old_val, void *new_va
 # define CAS_ANY_FENCE(a, old, new) S_cas_any_fence(a, old, new)
 #elif defined(__riscv)
 # error expected a compiler with a CS intrinsic for RISC-V
+#elif defined(__loongarch64)
+# error TODO
 #else
 # define CAS_ANY_FENCE(a, old, new) ((*(ptr *)(a) == TO_PTR(old)) ? (*(ptr *)(a) = TO_PTR(new), 1) : 0)
 #endif
diff --git a/c/build.zuo b/c/build.zuo
@@ -59,6 +59,9 @@
       [(string=? arch "rv64")
        (cons "RISCV64"
              "clearcache.c")]
+      [(string=? arch "la64")
+       (cons "LOONGARCH64"
+             "clearcache.c")]
       [(glob-match? "pb*" arch)
        (cons "PORTABLE_BYTECODE"
              "pb.c")]
diff --git a/c/fasl.c b/c/fasl.c
@@ -282,6 +282,12 @@ static uptr riscv64_get_abs(void *address);
 static void riscv64_set_jump(void *address, uptr item);
 static uptr riscv64_get_jump(void *address);
 #endif /* RISCV64 */
+#ifdef LOONGARCH64
+static void loongarch64_set_abs(void *address, uptr item);
+static uptr loongarch64_get_abs(void *address);
+static void loongarch64_set_jump(void *address, uptr item);
+static uptr loongarch64_get_jump(void *address);
+#endif /* LOONGARCH64 */
 #ifdef PORTABLE_BYTECODE_SWAPENDIAN
 static void swap_code_endian(octet *code, uptr len);
 #endif
@@ -1486,6 +1492,17 @@ void S_set_code_obj(char *who, IFASLCODE typ, ptr p, iptr n, ptr x, iptr o) {
           riscv64_set_jump(address, item);
           break;
 #endif /* RISCV64 */
+#ifdef LOONGARCH64
+    case reloc_loongarch64_abs:
+            loongarch64_set_abs(address, item);
+            break;
+    case reloc_loongarch64_jump:
+            loongarch64_set_jump(address, item);
+            break;
+    case reloc_loongarch64_call:
+            loongarch64_set_jump(address, item);
+            break;
+#endif /* LOONGARCH64 */
         default:
             S_error1(who, "invalid relocation type ~s", FIX(typ));
     }
@@ -1575,6 +1592,15 @@ ptr S_get_code_obj(IFASLCODE typ, ptr p, iptr n, iptr o) {
           item = riscv64_get_jump(address);
           break;
 #endif /* RISCV64 */
+#ifdef LOONGARCH64
+    case reloc_loongarch64_abs:
+            item = loongarch64_get_abs(address);
+            break;
+    case reloc_loongarch64_jump:
+    case reloc_loongarch64_call:
+            item = loongarch64_get_jump(address);
+            break;
+#endif /* LOONGARCH64 */
         default:
             S_error1("", "invalid relocation type ~s", FIX(typ));
             return (ptr)0 /* not reached */;
@@ -2042,6 +2068,52 @@ static void riscv64_set_jump(void* address, uptr item)
 }
 #endif /* RISCV64 */
 
+#ifdef LOONGARCH64
+#define PCADDI_INSTR(dest, offset)   ((0b1100 << 25) | ((offset) << 5) | (dest))
+#define EXTRACT_LD_INSTR_DEST(instr) (instr & 0b11111)
+#define JUMP_REG 12
+
+static uptr loongarch64_get_abs(void* address)
+{
+  return *((I64 *)((I32 *)address + 3));
+}
+
+static uptr loongarch64_get_jump(void* address)
+{
+  return *((I64 *)((I32 *)address + 3));
+}
+
+static void loongarch64_set_abs(void* address, uptr item)
+{
+  /*
+    [0] pcaddi dest 0
+    [1] ld.d dest dest 12
+    [2] b 12
+    [3-4] 8-bytes of addr
+  */
+
+  // same as riscv64
+  int dest = EXTRACT_LD_INSTR_DEST(((I32 *)address)[1]);
+  ((I32 *)address)[0] = PCADDI_INSTR(dest, 0);
+  (*((I64 *)((I32 *)address + 3))) = item;
+}
+
+static void loongarch64_set_jump(void* address, uptr item)
+{
+  /*
+    [0] pcaddi dest 0
+    [1] ld.d dest dest 12
+    [2] b 12
+    [3-4] 8-bytes of addr
+    [5] jirl %real-zero dest 0
+  */
+
+  int dest = EXTRACT_LD_INSTR_DEST(((I32 *)address)[1]);
+  ((I32 *)address)[0] = PCADDI_INSTR(dest, 0);
+  (*((I64 *)((I32 *)address + 3))) = item;
+}
+#endif /* LOONGARCH64 */
+
 #ifdef PORTABLE_BYTECODE_SWAPENDIAN
 typedef struct {
   octet *code;
diff --git a/c/version.h b/c/version.h
@@ -44,7 +44,7 @@
 # define FLUSHCACHE
 #endif
 
-#if defined(__arm__) || defined(__arm64__) || defined(__aarch64__) || defined(_M_ARM64) || defined(__riscv)
+#if defined(__arm__) || defined(__arm64__) || defined(__aarch64__) || defined(_M_ARM64) || defined(__riscv) || defined(__loongarch64)
 # define FLUSHCACHE
 #endif
 
diff --git a/configure b/configure
@@ -209,6 +209,11 @@ if [ "$unixsuffix" != "" ] ; then
         m64=rv64${unixsuffix}
         tm32=""
         tm64=trv64${unixsuffix}
+    elif uname -m | grep 'loongarch64' > /dev/null 2>&1 ; then
+        m32=""
+        m64=la64${unixsuffix}
+        tm32=""
+        tm64=tla64${unixsuffix}
     else
         # using "unknown" helps at least select OS-based flags
         m32=unknown32${unixsuffix}
@@ -443,7 +448,7 @@ esac
 
 if [ "$bits" = "" ] ; then
   # infer default bits; this will be irrelevant if a machine is specified
-  if uname -m | egrep 'amd64|x86_64|aarch64|arm64|ppc64|powerpc64|riscv64' > /dev/null 2>&1 ; then
+  if uname -m | egrep 'amd64|x86_64|aarch64|arm64|ppc64|powerpc64|riscv64|loongarch64' > /dev/null 2>&1 ; then
     bits=64
   # NetBSD `uname -m` produces "evbarm" for AArch64
   elif uname -p | egrep 'aarch64' > /dev/null 2>&1 ; then
diff --git a/makefiles/lib.zuo b/makefiles/lib.zuo
@@ -45,7 +45,7 @@
                  (and (>= (string-length uni) (string-length arch))
                       (string=? (substring uni 0 (string-length arch)) arch)
                       arch))
-               '("a6" "i3" "arm64" "arm32" "ppc32" "rv64" "pb"))
+               '("a6" "i3" "arm64" "arm32" "ppc32" "rv64" "la64" "pb"))
         (error "could not extract architecture from machine name" m))))
 
 (define (hash-set* ht . keys+vals)
diff --git a/mats/bytevector.ms b/mats/bytevector.ms
@@ -35,7 +35,8 @@
          [(i3le ti3le i3nt ti3nt a6nt ta6nt arm64nt tarm64nt i3ob ti3ob i3fb ti3fb i3nb ti3nb
                 i3osx ti3osx a6le ta6le a6nb ta6nb
                 a6osx ta6osx a6fb ta6fb a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx
-                arm32le tarm32le arm64le tarm64le arm64osx tarm64osx rv64le trv64le)
+                arm32le tarm32le arm64le tarm64le arm64osx tarm64osx rv64le trv64le
+                la64le tla64le)
           'little]
          [(ppc32le tppc32le ppc32osx tppc32osx) 'big]
          [(pb tpb) (native-endianness)]
diff --git a/mats/foreign.ms b/mats/foreign.ms
@@ -199,7 +199,7 @@
       (error? (load-shared-object 3))
     )
    ]
-  [(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le rv64le trv64le)
+  [(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le rv64le trv64le la64le tla64le)
    (mat load-shared-object
       (file-exists? foreign1.so)
       (begin (load-shared-object foreign1.so) #t)
@@ -3085,7 +3085,7 @@
       (machine-case
         [(i3ob ti3ob a6ob ta6ob a6s2 ta6s2 i3s2 ti3s2 i3qnx ti3qnx i3nb ti3nb a6nb ta6nb)
          '(load-shared-object "libc.so")]
-        [(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le rv64le trv64le)
+        [(i3le ti3le a6le ta6le arm32le tarm32le arm64le tarm64le ppc32le tppc32le rv64le trv64le la64le tla64le)
          '(load-shared-object "libc.so.6")]
         [(i3fb ti3fb a6fb ta6fb)
          '(load-shared-object "libc.so.7")]
diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex
@@ -39,6 +39,7 @@ procedure) is given in parentheses.
      \item AArch64 including Android, nonthreaded (arm64le) and threaded (tarm64le)
      \item ARMv6 (32-bit) including Android, nonthreaded (arm32le) and threaded (tarm32le)
      \item RV64G (64-bit RISC-V), nonthreaded (rv64le) and threaded (trv64le)
+     \item LoongArch64 (64-bit LoongArch), nonthreaded (la64le) and threaded (tla64le)
      \item PowerPC (32-bit), nonthreaded (ppc32le) and threaded (tppc32le)
      \end{itemizeC}
 \item Mac OS
@@ -114,7 +115,7 @@ Online versions of both books can be found at
 
 \subsection{New supported platforms and portable bytecode (9.9.9)}
 
-AArch64 (64-bit Arm) and RV64G (64-bit RISC-V) architectures are
+AArch64 (64-bit Arm), RV64G (64-bit RISC-V), and LoongArch64 architectures are
 supported. Threads are supported on architectures with weak memory
 models while preserving the safety guarantee described in the
 documentation for variables and primitive datatypes.
diff --git a/s/build.zuo b/s/build.zuo
@@ -125,7 +125,7 @@
 
 (define cpnanopass-src-names
   ;; files that are `include`d by "cpnanopass.ss" and "cpprim.ss"
-  (list "x86.ss" "x86_64.ss" "arm32.ss" "arm64.ss" "ppc32.ss" "riscv64.ss" "pb.ss"
+  (list "x86.ss" "x86_64.ss" "arm32.ss" "arm64.ss" "ppc32.ss" "riscv64.ss" "loongarch64.ss" "pb.ss"
         "np-languages.ss" "fxmap.ss" "cptypes-lattice.ss"
         "np-register.ss" "np-info.ss" "np-help.ss"
         "ffi-help.ss"))
diff --git a/s/cmacros.ss b/s/cmacros.ss
@@ -415,6 +415,7 @@
   rv64fb    trv64fb
   rv64ob    trv64ob
   rv64nb    trv64nb
+  la64le    tla64le
 )
 
 (include "machine.def")
@@ -597,6 +598,7 @@
   (arm64 reloc-arm64-abs reloc-arm64-call reloc-arm64-jump)
   (ppc32 reloc-ppc32-abs reloc-ppc32-call reloc-ppc32-jump)
   (riscv64 reloc-riscv64-abs reloc-riscv64-call reloc-riscv64-jump)
+  (loongarch64 reloc-loongarch64-abs reloc-loongarch64-call reloc-loongarch64-jump)
   (pb reloc-pb-abs reloc-pb-proc))
 
 (constant-case ptr-bits
diff --git a/s/compile.ss b/s/compile.ss
@@ -234,6 +234,24 @@
                                   (let ([r ($reloc (constant reloc-riscv64-call) n (fx- a1 ra))])
                                     (mkc0 (cdr c*) a (cons r r*) a1 x*))))]
                              [else (c-assembler-output-error c)])]
+                          [(loongarch64)
+                           (record-case c
+                             [(loongarch64-abs) (n x)
+                              (let ([a1 (fx- a 20)])
+                                (let ([x* (cons (mkcode x) x*)])
+                                  (let ([r ($reloc (constant reloc-loongarch64-abs) n (fx- a1 ra))])
+                                    (mkc0 (cdr c*) a (cons r r*) a1 x*))))]
+                             [(loongarch64-jump) (n x)
+                              (let ([a1 (fx- a 24)])
+                                (let ([x* (cons (mkcode x) x*)])
+                                  (let ([r ($reloc (constant reloc-loongarch64-jump) n (fx- a1 ra))])
+                                    (mkc0 (cdr c*) a (cons r r*) a1 x*))))]
+                             [(loongarch64-call) (n x)
+                              (let ([a1 (fx- a 24)])
+                                (let ([x* (cons (mkcode x) x*)])
+                                  (let ([r ($reloc (constant reloc-loongarch64-call) n (fx- a1 ra))])
+                                    (mkc0 (cdr c*) a (cons r r*) a1 x*))))]
+                             [else (c-assembler-output-error c)])]
                           [(pb)
                            (record-case c
                              [(pb-abs) (n x)
@@ -318,6 +336,10 @@
                           (record-case x
                             [(riscv64-abs riscv64-call riscv64-jump) (n x) (build x d)]
                            [else (void)])]
+                         [(loongarch64)
+                          (record-case x
+                            [(loongarch64-abs loongarch64-call loongarch64-jump) (n x) (build x d)]
+                            [else (void)])]
                          [(pb)
                           (record-case x
                             [(pb-abs pb-proc) (n x) (build x d)]
@@ -502,6 +524,21 @@
                                (let ([r ($reloc (constant reloc-riscv64-call) n (fx- a1 ra))])
                                  (prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
                             [else (c-assembler-output-error c)])]
+                         [(loongarch64)
+                          (record-case c
+                            [(loongarch64-abs) (n x)
+                             (let ([a1 (fx- a 20)])
+                               (let ([r ($reloc (constant reloc-loongarch64-abs) n (fx- a1 ra))])
+                                 (prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
+                            [(loongarch64-jump) (n x)
+                             (let ([a1 (fx- a 24)])
+                               (let ([r ($reloc (constant reloc-loongarch64-jump) n (fx- a1 ra))])
+                                 (prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
+                            [(loongarch64-call) (n x)
+                             (let ([a1 (fx- a 24)])
+                               (let ([r ($reloc (constant reloc-loongarch64-call) n (fx- a1 ra))])
+                                 (prf0 (cdr c*) a (cons r r*) a1 (cons x x*))))]
+                            [else (c-assembler-output-error c)])]
                          [(pb)
                           (record-case c
                             [(pb-abs) (n x)
diff --git a/s/cpprim.ss b/s/cpprim.ss
@@ -630,10 +630,10 @@
           ,(%constant type-char))))
     (define need-store-fence?
       (if-feature pthreads
-	(constant-case architecture
-          [(arm32 arm64 riscv64 pb) #t]
-          [else #f])
-        #f))
+	              (constant-case architecture
+                                 [(arm32 arm64 riscv64 loongarch64 pb) #t]
+                                 [else #f])
+                  #f))
     (define add-store-fence
       ;; A store--store fence should be good enough for safety on a platform that
       ;; orders load dependencies (which is anything except Alpha)
@@ -3166,13 +3166,13 @@
     (define-inline 2 memory-order-acquire
       [() (if-feature pthreads
             (constant-case architecture
-	          [(arm32 arm64 riscv64 pb) (%seq ,(%inline acquire-fence) (quote ,(void)))]
+	          [(arm32 arm64 riscv64 loongarch64 pb) (%seq ,(%inline acquire-fence) (quote ,(void)))]
               [else `(quote ,(void))])
             `(quote ,(void)))])
     (define-inline 2 memory-order-release
       [() (if-feature pthreads
             (constant-case architecture
-	          [(arm32 arm64 riscv64 pb) (%seq ,(%inline release-fence) (quote ,(void)))]
+	          [(arm32 arm64 riscv64 loongarch64 pb) (%seq ,(%inline release-fence) (quote ,(void)))]
               [else `(quote ,(void))])
             `(quote ,(void)))])
     (let ()
@@ -4771,7 +4771,7 @@
       (define-inline 3 flsqrt
         [(e)
          (constant-case architecture
-           [(x86 x86_64 arm32 arm64 riscv64 pb) (build-fp-op-1 %fpsqrt e)]
+           [(x86 x86_64 arm32 arm64 riscv64 loongarch64 pb) (build-fp-op-1 %fpsqrt e)]
            [(ppc32) (build-fl-call (lookup-c-entry flsqrt) e)])])
 
       (define-inline 3 flsingle
@@ -5136,7 +5136,7 @@
          (build-checked-fp-op e
            (lambda (e)
              (constant-case architecture
-               [(x86 x86_64 arm32 arm64 riscv64 pb) (build-fp-op-1 %fpsqrt e)]
+               [(x86 x86_64 arm32 arm64 riscv64 loongarch64 pb) (build-fp-op-1 %fpsqrt e)]
                [(ppc32) (build-fl-call (lookup-c-entry flsqrt) e)]))
            (lambda (e)
              (build-libcall #t src sexpr flsqrt e)))])
@@ -8087,7 +8087,7 @@
                (%inline logor ,(%inline sll ,%rdx (immediate 32)) ,%rax)
                64))]
          [(arm32 pb) (unsigned->ptr (%inline read-time-stamp-counter) 32)]
-         [(arm64 riscv64) (unsigned->ptr (%inline read-time-stamp-counter) 64)]
+         [(arm64 riscv64 loongarch64) (unsigned->ptr (%inline read-time-stamp-counter) 64)]
          [(ppc32)
           (let ([t-hi (make-tmp 't-hi)])
             `(let ([,t-hi (inline ,(make-info-kill* (reg-list %real-zero))
@@ -8108,7 +8108,7 @@
                (%inline logor ,(%inline sll ,%rdx (immediate 32)) ,%rax)
                64))]
          [(arm32 ppc32 pb) (unsigned->ptr (%inline read-performance-monitoring-counter ,(build-unfix e)) 32)]
-         [(arm64 riscv64) (unsigned->ptr (%inline read-performance-monitoring-counter ,(build-unfix e)) 64)])])
+         [(arm64 riscv64 loongarch64) (unsigned->ptr (%inline read-performance-monitoring-counter ,(build-unfix e)) 64)])])
 
     (define-inline 3 assert-unreachable
       [() (%constant svoid)])
diff --git a/s/la64.def b/s/la64.def
@@ -0,0 +1,11 @@
+(define-constant architecture 'loongarch64)
+(define-constant ptr-bits 64)
+
+(define-constant asm-arg-reg-max 15)
+(define-constant asm-arg-reg-cnt 3)
+(define-constant asm-fpreg-max 6)
+
+(define-constant native-endianness 'little)
+(define-constant unaligned-floats #t)
+(define-constant unaligned-integers #t)
+(define-constant integer-divide-instruction #t)
diff --git a/s/loongarch64.ss b/s/loongarch64.ss
diff --git a/s/machine.zuo b/s/machine.zuo
diff --git a/s/mkheader.ss b/s/mkheader.ss
diff --git a/s/riscv64.ss b/s/riscv64.ss
