Merge pull request #1655 from clasp-developers/intrinsic-fallback

Add intrinsic fallbacks

Author: Bike

src/lisp/kernel/cleavir/landing-pad.lisp

@@ -156,10 +156,8 @@
         (when cleanup-p (llvm-sys:set-cleanup lpad t))
         (cmp:irc-store exception-structure *exn.slot*)
         (cmp:irc-store exception-selector *ehselector.slot*)
-        (let* ((typeid (%intrinsic-call
-                        #+(or llvm15 llvm16 llvm17)"llvm.eh.typeid.for"
-                        #-(or llvm15 llvm16 llvm17)"llvm.eh.typeid.for.p0"
-                        (list (cmp:irc-exception-typeid* 'cmp:typeid-core-unwind))))
+        (let* ((typeid (%intrinsic-call cmp:+intrinsic/llvm.eh.typeid.for.p0+
+                                        (list (cmp:irc-exception-typeid* 'cmp:typeid-core-unwind))))
                (matches-type (cmp:irc-icmp-eq exception-selector typeid)))
           ;; If the exception is Clasp's Unwind exception, we handle it.
           ;; Otherwise we go to the cleanup, or perhaps directly to the resume.
@@ -289,10 +287,8 @@
           (bb (cmp:irc-basic-block-create "escape-m-v-prog1")))
       (cmp:irc-begin-block bb)
       ;; Lose the saved values alloca.
-      (%intrinsic-call
-       #+(or llvm15 llvm16 llvm17)"llvm.stackrestore"
-       #-(or llvm15 llvm16 llvm17)"llvm.stackrestore.p0"
-       (list stackpos))
+      (%intrinsic-call cmp:+intrinsic/llvm.stackrestore.p0+
+                       (list stackpos))
       ;; Continue
       (cmp:irc-br
        (maybe-entry-processor (cleavir-bir:parent instruction) tags))
@@ -305,10 +301,8 @@
           (let ((bb (cmp:irc-basic-block-create "escape-m-v-prog1")))
             (cmp:irc-begin-block bb)
             ;; Lose the saved values alloca.
-            (%intrinsic-call
-             #+(or llvm15 llvm16 llvm17)"llvm.stackrestore"
-             #-(or llvm15 llvm16 llvm17)"llvm.stackrestore.p0"
-             (list stackpos))
+            (%intrinsic-call cmp:+intrinsic/llvm.stackrestore.p0+
+                             (list stackpos))
             ;; Continue
             (cmp:irc-br
              (maybe-entry-processor (cleavir-bir:parent inst) tags))

src/lisp/kernel/cleavir/translate.lisp

@@ -210,10 +210,8 @@
          (nvals (cmp:irc-tmv-nret tmv))
          (primary (cmp:irc-tmv-primary tmv))
          ;; NOTE: Must be done BEFORE the alloca*fea.
-         (save (%intrinsic-call
-                #+(or llvm15 llvm16 llvm17)"llvm.stacksave"
-                #-(or llvm15 llvm16 llvm17)"llvm.stacksave.p0"
-                nil))
+         (save (%intrinsic-call cmp:+intrinsic/llvm.stacksave.p0+
+                                nil))
          (mv-temp (cmp:alloca-temp-values nvals))
          (label (datum-name-as-string outp))
          (s2 (cmp::irc-make-vaslist nvals mv-temp label)))
@@ -235,18 +233,14 @@
       (%intrinsic-call "cc_set_dynenv_stack" (list old-de-stack)))))
 (defmethod undo-dynenv ((dynenv bir:values-save) tmv)
   (declare (ignore tmv))
-  (%intrinsic-call
-   #+(or llvm15 llvm16 llvm17)"llvm.stackrestore"
-   #-(or llvm15 llvm16 llvm17)"llvm.stackrestore.p0"
-   (list (dynenv-storage dynenv))))
+  (%intrinsic-call cmp:+intrinsic/llvm.stackrestore.p0+
+                   (list (dynenv-storage dynenv))))
 (defmethod undo-dynenv ((dynenv bir:values-collect) tmv)
   (declare (ignore tmv))
   (let ((storage (dynenv-storage dynenv)))
     (when storage
-      (%intrinsic-call
-       #+(or llvm15 llvm16 llvm17)"llvm.stackrestore"
-       #-(or llvm15 llvm16 llvm17)"llvm.stackrestore.p0"
-       (list storage)))))
+      (%intrinsic-call cmp:+intrinsic/llvm.stackrestore.p0+
+                       (list storage)))))
 
 (defun translate-local-unwind (jump tmv)
   (loop with target = (bir:dynamic-environment
@@ -1528,10 +1522,8 @@
                  for n = size then (cmp:irc-add n size "sum-nret")
                  collect n))
          (n-total-values (first (last partial-sums)))
-         (stacksave (%intrinsic-call
-                     #+(or llvm15 llvm16 llvm17)"llvm.stacksave"
-                     #-(or llvm15 llvm16 llvm17)"llvm.stacksave.p0"
-                     nil "values-collect"))
+         (stacksave (%intrinsic-call cmp:+intrinsic/llvm.stacksave.p0+
+                                     nil "values-collect"))
          (tv-size
            ;; In order to store the primary value unconditionally below, we
            ;; need to allocate one extra word. This is important for the
@@ -1622,10 +1614,8 @@
                      in)
                     ((eq irt :multiple-values)
                      (let* ((nret (cmp:irc-tmv-nret in))
-                            (save (%intrinsic-call
-                                   #+(or llvm15 llvm16 llvm17)"llvm.stacksave"
-                                   #-(or llvm15 llvm16 llvm17)"llvm.stacksave.p0"
-                                   nil))
+                            (save (%intrinsic-call cmp:+intrinsic/llvm.stacksave.p0+
+                                                   nil))
                             (values (cmp:alloca-temp-values nret)))
                        (setf (dynenv-storage inst) save)
                        (%intrinsic-call "cc_save_values"

src/lisp/kernel/cmp/cmpexports.lisp

@@ -7,6 +7,10 @@
             codegen-startup-shutdown
             jit-startup-shutdown-function-names
             irc-simple-function-create
+            find-intrinsic-name
+            +intrinsic/llvm.eh.typeid.for.p0+
+            +intrinsic/llvm.stacksave.p0+
+            +intrinsic/llvm.stackrestore.p0+
             *primitives*
             primitive-argument-types
             primitive-varargs

src/lisp/kernel/cmp/cmpintrinsics.lisp

@@ -1242,3 +1242,16 @@ is dumped to a file before the block and after the block."
         (format t "~a Function ~a~%" num-instructions func)))
     (format t "~a total~%" total)))
 
+(defun find-intrinsic-name (&rest names)
+  (dolist (name names (error "Unable to find a valid intrinsic from ~s" names))
+    (unless (zerop (llvm-sys:lookup-intrinsic-id name))
+      (return name))))
+
+(defvar +intrinsic/llvm.eh.typeid.for.p0+
+  (find-intrinsic-name "llvm.eh.typeid.for.p0" "llvm.eh.typeid.for"))
+
+(defvar +intrinsic/llvm.stacksave.p0+
+  (find-intrinsic-name "llvm.stacksave.p0" "llvm.stacksave"))
+
+(defvar +intrinsic/llvm.stackrestore.p0+
+  (find-intrinsic-name "llvm.stackrestore.p0" "llvm.stackrestore"))

src/lisp/kernel/cmp/primitives.lisp

@@ -124,9 +124,7 @@
          (primitive         "__gxx_personality_v0" :i32 nil :varargs t)
          (primitive         "__cxa_begin_catch" :i8* (list :i8*) )
          (primitive-unwinds "__cxa_end_catch" :void nil)
-         (primitive #+(or llvm15 llvm16 llvm17)"llvm.eh.typeid.for"
-          #-(or llvm15 llvm16 llvm17)"llvm.eh.typeid.for.p0"
-          :i32 (list :i8*))
+         (primitive         +intrinsic/llvm.eh.typeid.for.p0+ :i32 (list :i8*))
          (primitive-unwinds "cc_overflowed_signed_bignum" :t* (list :i64))
          (primitive         "llvm.sadd.with.overflow.i32" :{i32.i1} (list :i32 :i32))
          (primitive         "llvm.sadd.with.overflow.i64" :{i64.i1} (list :i64 :i64))
@@ -190,14 +188,8 @@
          (primitive         "llvm.lifetime.start" :void (list :i64 :i8*))
          (primitive         "llvm.lifetime.end" :void (list :i64 :i8*))
 
-         (primitive
-          #+(or llvm15 llvm16 llvm17)"llvm.stacksave"
-          #-(or llvm15 llvm16 llvm17)"llvm.stacksave.p0"
-          :i8* nil)
-         (primitive
-          #+(or llvm15 llvm16 llvm17)"llvm.stackrestore"
-          #-(or llvm15 llvm16 llvm17)"llvm.stackrestore.p0"
-          :void (list :i8*))
+         (primitive         +intrinsic/llvm.stacksave.p0+ :i8* nil)
+         (primitive         +intrinsic/llvm.stackrestore.p0+ :void (list :i8*))
 
          (primitive         "llvm.memcpy.p0.p0.i64" :void (list :i8* :i8* :i64 :i1))
          (primitive         "llvm.memmove.p0.p0.i64" :void (list :i8* :i8* :i64 :i1))

src/llvmo/llvmoExpose.cc

@@ -748,6 +748,9 @@ CL_EXTERN_DEFMETHOD(Triple_O, &llvm::Triple::getEnvironmentName);
 CL_LISPIFY_NAME(getOSAndEnvironmentName);
 CL_EXTERN_DEFMETHOD(Triple_O, &llvm::Triple::getOSAndEnvironmentName);
 
+CL_PKG_NAME(LlvmoPkg, "lookup-intrinsic-id");
+CL_EXTERN_DEFUN((llvm::Intrinsic::ID(*)(llvm::StringRef Name))&llvm::Function::lookupIntrinsicID);
+
 SYMBOL_EXPORT_SC_(LlvmoPkg, ArchType);
 SYMBOL_EXPORT_SC_(LlvmoPkg, ArchType_UnknownArch);
 SYMBOL_EXPORT_SC_(LlvmoPkg, ArchType_arm);

src/llvmo/runtimeJit.cc

@@ -224,16 +224,21 @@ class ClaspAllocator : public JITLinkMemoryManager {
         llvm::orc::ExecutorAddr ea((uintptr_t)execMemory);
         OnFinalized(llvm::jitlink::InProcessMemoryManager::FinalizedAlloc(ea));
       }
+
       virtual void abandon(OnAbandonedFunction OnAbandoned) {
-        printf("%s:%d:%s I have no idea what to do here - calling OnAbandoned and continuing\n", __FILE__, __LINE__, __FUNCTION__);
-        if (getenv("CLASP_TRAP_ONABANDONED")!=NULL) {
-          printf("!\n!\n!\n!\n         You set CLASP_TRAP_ONABANDONED - sleeping for 9999 seconds - connect using debugger to pid %d\n!\n!\n!\n!\n", getpid());
-          sleep(9999);
+        size_t PageSize = getpagesize();
+        for (auto& KV : BL.segments()) {
+          auto& Seg = KV.second;
+          sys::MemoryBlock MB(Seg.WorkingMem, alignTo(Seg.ContentSize + Seg.ZeroFillSize, PageSize));
+          auto code = sys::Memory::releaseMappedMemory(MB);
+          if (code) {
+            OnAbandoned(std::move(llvm::errorCodeToError(code)));
+            return;
+          }
         }
-        printf("!\n!\n!\n!\n         If you want to trap here set CLASP_TRAP_ONABANDONED - restarting for now\n!\n!\n!\n!\n");
-        exit(1);
-        //OnAbandoned(std::move(llvm::Error::success()));
+        OnAbandoned(std::move(llvm::Error::success()));
       }
+
     private:
       Error applyProtections() {
         JITMemoryReadExecute(BL);
@@ -960,7 +965,8 @@ void ClaspReturnObjectBuffer(std::unique_ptr<llvm::MemoryBuffer> buffer) {
 
   ObjectFile_sp code = lookupObjectFile(buffer->getBufferIdentifier().str());
   code->_MemoryBuffer = std::move(buffer);
-//  printf("%s:%d:%s loadedObjectFile %p  _MemoryBuffer = %p\n", __FILE__, __LINE__, __FUNCTION__, (void*)&*code, (void*)code->_MemoryBuffer.get() );
+  //  printf("%s:%d:%s loadedObjectFile %p  _MemoryBuffer = %p\n", __FILE__, __LINE__, __FUNCTION__, (void*)&*code,
+  //  (void*)code->_MemoryBuffer.get() );
   auto objf = code->getObjectFile();
   llvm::object::ObjectFile& of = *objf->get();
 #if defined(_TARGET_OS_LINUX)