Merge pull request #1507 from clasp-developers/hybrid-kernel

Hybrid kernel

RELEASE_NOTES.md

@@ -4,6 +4,8 @@
 * New module named "gray-streams" which makes it possible to
   initialize the Gray stream protocol without calls to internal
   functions.
+* New build mode `:bytecode-faso` which builds the kernel as native
+  code (FASO) while the bytecode compiler is active.
 
 # Version 2.4.0 (LLVM15-17) 2023-10-01
 

src/core/corePackage.cc

@@ -1131,16 +1131,16 @@ void CoreExposer_O::define_essential_globals(LispPtr lisp) {
   List_sp hooks = nil<T_O>();
   hooks = Cons_O::create(Cons_O::create(SimpleBaseString_O::make("lfasl"), _sym_loadSource), hooks); // List of load commands
 #if CLASP_BUILD_MODE == 6
+  hooks = Cons_O::create(Cons_O::create(clasp_make_fixnum(FASL_MAGIC_NUMBER), _sym_load_bytecode), hooks);
   // This not ideal, but ANSI tests uses FASL as a generic pathname type so dispatching in LOAD via
   // *LOAD-HOOKS* will end up sending a FASO with an extension of FASL to the FASL loader. We
   // could sniff the magic number before we dispatch on pathname type, but this is inefficient since
   // it results in two file opens. If we had only one FASL format this wouldn't be an issue.
   hooks = Cons_O::create(Cons_O::create(SimpleBaseString_O::make("fasl"), _sym_load_bytecode), hooks);
 #endif
-  hooks = Cons_O::create(Cons_O::create(clasp_make_fixnum(FASL_MAGIC_NUMBER), _sym_load_bytecode), hooks);
+  hooks = Cons_O::create(Cons_O::create(clasp_make_fixnum(FASO_MAGIC_NUMBER), _sym_load_faso), hooks);
   hooks = Cons_O::create(Cons_O::create(SimpleBaseString_O::make("faso"), _sym_load_faso), hooks);
   hooks = Cons_O::create(Cons_O::create(SimpleBaseString_O::make("fasp"), _sym_load_faso), hooks);
-  hooks = Cons_O::create(Cons_O::create(clasp_make_fixnum(FASO_MAGIC_NUMBER), _sym_load_faso), hooks);
   hooks = Cons_O::create(Cons_O::create(SimpleBaseString_O::make("fasoll"), _sym_load_fasoll), hooks);
   hooks = Cons_O::create(Cons_O::create(SimpleBaseString_O::make("faspll"), _sym_load_fasoll), hooks);
   hooks = Cons_O::create(Cons_O::create(SimpleBaseString_O::make("fasobc"), _sym_load_fasobc), hooks);

src/core/load.cc

@@ -178,29 +178,41 @@ CL_DEFUN T_sp core__load_no_package_set(T_sp lsource, T_sp verbose, T_sp print,
       filename = nil<T_O>();
     } else {
       function = nil<T_O>();
-      if (hooks.consp()) {
-        function = oCdr(gc::As<Cons_sp>(hooks)->assoc(pathname->_Type, nil<T_O>(), cl::_sym_equalp, nil<T_O>()));
-        if (function.nilp()) {
-          T_sp stream = cl__open(pathname, kw::_sym_input, ext::_sym_byte8, nil<T_O>(), false, nil<T_O>(), false, external_format,
-                                 nil<T_O>());
-          uint8_t bytes[4];
-          clasp_read_byte8(stream, bytes, 4);
-          cl__close(stream);
-          T_sp magic = clasp_make_fixnum(((uint32_t)bytes[0] << 24) | ((uint32_t)bytes[1] << 16) | ((uint32_t)bytes[2] << 8) |
-                                         ((uint32_t)bytes[3] << 0));
-          function = oCdr(gc::As<Cons_sp>(hooks)->assoc(magic, nil<T_O>(), cl::_sym_equalp, nil<T_O>()));
+      T_sp magic = nil<T_O>();
+      for (T_sp _hooks = hooks; _hooks.notnilp(); _hooks = oCdr(_hooks)) {
+        T_sp key = oCaar(_hooks);
+        if (gc::IsA<String_sp>(key)) {
+          if (cl__equalp(key, pathname->_Type)) {
+            function = oCdar(_hooks);
+            break;
+          }
+        } else {
+          if (magic.nilp()) {
+            T_sp stream = cl__open(pathname, kw::_sym_input, ext::_sym_byte8, nil<T_O>(), false, nil<T_O>(), false, external_format,
+                                   nil<T_O>());
+            uint8_t bytes[4];
+            magic = clasp_make_fixnum((clasp_read_byte8(stream, bytes, 4) == 4)
+                                          ? (((uint32_t)bytes[0] << 24) | ((uint32_t)bytes[1] << 16) | ((uint32_t)bytes[2] << 8) |
+                                             ((uint32_t)bytes[3] << 0))
+                                          : 0);
+            cl__close(stream);
+          }
+          if (cl__equalp(key, magic)) {
+            function = oCdar(_hooks);
+            break;
+          }
         }
       }
     }
   } else {
-    for (; hooks.notnilp(); hooks = oCdr(hooks)) {
-      if (gc::IsA<String_sp>(oCaar(hooks))) {
+    for (T_sp _hooks = hooks; _hooks.notnilp(); _hooks = oCdr(_hooks)) {
+      if (gc::IsA<String_sp>(oCaar(_hooks))) {
         /* Otherwise try with known extensions until a matching
                      file is found */
         T_sp kind;
         filename = pathname;
-        pathname->_Type = oCaar(hooks);
-        function = oCdar(hooks);
+        pathname->_Type = oCaar(_hooks);
+        function = oCdar(_hooks);
         kind = core__file_kind(pathname, true);
         if (kind == kw::_sym_file || kind == kw::_sym_special)
           break;

src/koga/config-header.lisp

@@ -22,8 +22,14 @@
                  "CLASP_CONFIG_H" t
                  "CST" (cst configuration)
                  "USE_PARALLEL_BUILD" (parallel-build configuration)
-                 "CLASP_BUILD_MODE" (position (build-mode configuration)
-                                              '(:fasl :object :bitcode :faso :fasoll :fasobc :bytecode))
+                 "CLASP_BUILD_MODE" (case (build-mode configuration)
+                                      (:fasl 0)
+                                      (:object 1)
+                                      (:bitcode 2)
+                                      (:faso 3)
+                                      (:fasoll 4)
+                                      (:fasobc 5)
+                                      ((:bytecode :bytecode-faso) 6))
                  "USE_COMPILE_FILE_PARALLEL" (if (compile-file-parallel configuration) 1 0)
                  "FORCE_STARTUP_EXTERNAL_LINKAGE" (if (force-startup-external-linkage configuration) 1 0)
                  "USE_PRECISE_GC" *variant-precise*

src/koga/configure.lisp

@@ -119,7 +119,7 @@
   ((build-mode :accessor build-mode ; TODO Add logic for :bitcode, :object and :fasl
                :initarg :build-mode
                :initform :faso
-               :type (member :faso :bitcode :bytecode :object :fasoll :fasobc :fasl)
+               :type (member :faso :bitcode :bytecode :bytecode-faso :object :fasoll :fasobc :fasl)
                :documentation "Define how clasp is built.
 - :bitcode compiles to bitcode and thinLTO is used to link everything.
   This gives the fastest product but linking takes a long time.
@@ -791,7 +791,7 @@ then they will overide the current variant's corresponding property."
 (defun file-faso-extension (configuration)
   "Return the file extension based on the build mode."
   (case (build-mode configuration)
-    (:bytecode "fasl")
+    ((:bytecode :bytecode-faso) "fasl")
     (:faso "faso")
     (:fasobc "fasobc")
     (:fasoll "fasoll")
@@ -800,7 +800,7 @@ then they will overide the current variant's corresponding property."
 (defun module-fasl-extension (configuration)
   "Return the module extension, i.e. faso -> fasp, etc."
   (case (build-mode configuration)
-    (:bytecode "fasl")
+    ((:bytecode :bytecode-faso) "fasl")
     (:faso "fasp")
     (:fasobc "faspbc")
     (:fasoll "faspll")
@@ -809,7 +809,7 @@ then they will overide the current variant's corresponding property."
 (defun image-fasl-extension (configuration)
   "Return the extension for the clasp image."
   (case (build-mode configuration)
-    (:bytecode "fasl")
+    ((:bytecode :bytecode-faso) "fasl")
     (:fasl "lfasl")
     (:faso "fasp")
     (:fasobc "faspbc")

src/koga/ninja.lisp

@@ -624,7 +624,7 @@
                                                                        :variant-lib)))
                                        sources))
     (ninja:write-build output-stream (case (build-mode configuration)
-                                       ((:bytecode :faso :fasoll :fasobc) :link-fasl)
+                                       ((:bytecode :bytecode-faso :faso :fasoll :fasobc) :link-fasl)
                                        (otherwise "link-fasl-abc"))
                        :variant-ldflags *variant-ldflags*
                        :variant-ldlibs *variant-ldlibs*
@@ -752,7 +752,7 @@
                                                                           :variant-lib)))
                                           eclasp-sources))
       (ninja:write-build output-stream (case (build-mode configuration)
-                                         ((:bytecode :faso :fasoll :fasobc) :link-fasl)
+                                         ((:bytecode :bytecode-faso :faso :fasoll :fasobc) :link-fasl)
                                          (otherwise "link-fasl-abc"))
                          :variant-ldflags *variant-ldflags*
                          :variant-ldlibs *variant-ldlibs*

src/koga/scripts.lisp

@@ -77,7 +77,7 @@
               :output-type ~s)"
           (case (build-mode configuration)
             (:bytecode :bytecode)
-            (:faso :fasp)
+            ((:faso :bytecode-faso) :fasp)
             (:fasoll :faspll)
             (:fasobc :faspbc)
             (otherwise :fasl))))
@@ -104,23 +104,31 @@
 (core:quit)" (jobs configuration) (reproducible-build configuration)))
 
 (defmethod print-prologue (configuration (name (eql :compile-clasp)) output-stream)
-  (format output-stream "(load #P\"sys:src;lisp;kernel;clasp-builder.lisp\")
+  (format output-stream "(setq core:*clasp-build-mode* ~s)
+(load #P\"sys:src;lisp;kernel;clasp-builder.lisp\")
 (setq core::*number-of-jobs* ~a)
 (core:load-and-compile-clasp :reproducible ~s :system-sort ~s
                              :name (elt core:*command-line-arguments* 0)
                              :position (parse-integer (elt core:*command-line-arguments* 1))
                              :system (core:command-line-paths 2))
 (core:quit)"
+          (if (eq (build-mode configuration) :bytecode-faso)
+              :faso
+              (build-mode configuration))
           (jobs configuration) (reproducible-build configuration)
           (and (> (jobs configuration) 1) (parallel-build configuration))))
 
 (defmethod print-prologue (configuration (name (eql :link-fasl)) output-stream)
-  (write-string "(setq *features* (cons :aclasp *features*))
+  (format output-stream "(setq *features* (cons :aclasp *features*)
+      core:*clasp-build-mode* ~s)
 (load #P\"sys:src;lisp;kernel;clasp-builder.lisp\")
 (load #P\"sys:src;lisp;kernel;cmp;jit-setup.lisp\")
 (core:link-fasl :output-file (pathname (elt core:*command-line-arguments* 0))
                 :system (core:command-line-paths 1))
-(core:quit)" output-stream))
+(core:quit)"
+          (if (eq (build-mode configuration) :bytecode-faso)
+              :faso
+              (build-mode configuration))))
 
 (defmethod print-prologue (configuration (name (eql :analyze-generate)) output-stream)
   (declare (ignore configuration))

src/lisp/kernel/init.lisp

@@ -610,7 +610,8 @@ Gives a global declaration.  See DECLARE for possible DECL-SPECs."
          "ll")
         ((eq type :object)
          "o")
-        ((eq type :bytecode)
+        ((or (eq type :bytecode)
+             (member :bytecode *features*))
          "fasl")
         ((eq type :fasp)
          "fasp")