Merge pull request #1435 from clasp-developers/bytecode-feature

Bytecode feature

Author: Bike

src/lisp/kernel/cmp/cmpltv.lisp

@@ -99,8 +99,7 @@
    (%value :initarg :value :reader setf-aref-value :type creator)))
 
 (defclass hash-table-creator (vcreator)
-  (;; used in disltv
-   (%test :initarg :test :reader hash-table-creator-test :type symbol)
+  ((%test :initarg :test :reader hash-table-creator-test :type symbol)
    (%count :initarg :count :reader hash-table-creator-count
            :type (integer 0))))
 
@@ -570,7 +569,7 @@
     (make-array 74 sind rank . dims)
     (setf-row-major-aref 75 arrayind rmindex valueind)
     (make-hash-table 76 sind test count)
-    ((setf gethash) 77 htind keyind valueind)
+    (setf-gethash 77 htind keyind valueind)
     (make-sb64 78 sind sb64)
     (find-package 79 sind nameind)
     (make-bignum 80 sind size . words) ; size is signed
@@ -827,11 +826,10 @@
   (%uaet-info (array-element-type array)))
 
 (defmethod encode ((inst hash-table-creator) stream)
-  (let* ((ht (prototype inst))
-         ;; TODO: Custom hash-table tests.
+  (let* (;; TODO: Custom hash-table tests.
          ;; NOTE that for non-custom hash table tests, the standard
          ;; guarantees that hash-table-test returns a symbol.
-         (testcode (ecase (hash-table-test ht)
+         (testcode (ecase (hash-table-creator-test inst)
                      ((eq) #b00)
                      ((eql) #b01)
                      ((equal) #b10)
@@ -845,14 +843,14 @@
          ;; up, it might be rehashed and resized during initialization as it
          ;; reaches the rehash threshold. I am not sure how to deal with this
          ;; in a portable fashion. (we could just invert a provided rehash-size?)
-         (count (max (hash-table-count ht) #xffff)))
+         (count (min (hash-table-creator-count inst) #xffff)))
     (write-mnemonic 'make-hash-table stream)
     (write-index inst stream)
     (write-byte testcode stream)
     (write-b16 count stream)))
 
 (defmethod encode ((inst setf-gethash) stream)
-  (write-mnemonic '(setf gethash) stream)
+  (write-mnemonic 'setf-gethash stream)
   (write-index (setf-gethash-hash-table inst) stream)
   (write-index (setf-gethash-key inst) stream)
   (write-index (setf-gethash-value inst) stream))

src/lisp/kernel/cmp/compile-file.lisp

@@ -301,24 +301,25 @@ Compile a Lisp source stream and return a corresponding LLVM module."
                    image-startup-position optimize optimize-level))
   "See CLHS compile-file."
   (with-compilation-unit ()
-    (let ((output-path (apply #'compile-file-pathname input-file args))
-          (*compilation-module-index* 0) ; FIXME: necessary?
-          (*readtable* *readtable*) (*package* *package*)
-          (*optimize* *optimize*) (*policy* *policy*)
-          (*compile-file-pathname*
-            (pathname (merge-pathnames input-file)))
-          (*compile-file-truename*
-            (translate-logical-pathname *compile-file-pathname*))
-          (*compile-file-source-debug-pathname*
-            (if cfsdpp source-debug-pathname *compile-file-truename*))
-          (*compile-file-file-scope*
-            (core:file-scope *compile-file-source-debug-pathname*))
-          ;; bytecode compilation can't be done in parallel at the moment.
-          ;; we could possibly warn about it if execution was specified,
-          ;; but practically speaking it would mostly be noise.
-          (execution (if (member output-type '(:bytecode :bytecodel))
-                         :serial
-                         execution)))
+    (let* ((output-type (fixup-output-type output-type))
+           (output-path (apply #'compile-file-pathname input-file args))
+           (*compilation-module-index* 0) ; FIXME: necessary?
+           (*readtable* *readtable*) (*package* *package*)
+           (*optimize* *optimize*) (*policy* *policy*)
+           (*compile-file-pathname*
+             (pathname (merge-pathnames input-file)))
+           (*compile-file-truename*
+             (translate-logical-pathname *compile-file-pathname*))
+           (*compile-file-source-debug-pathname*
+             (if cfsdpp source-debug-pathname *compile-file-truename*))
+           (*compile-file-file-scope*
+             (core:file-scope *compile-file-source-debug-pathname*))
+           ;; bytecode compilation can't be done in parallel at the moment.
+           ;; we could possibly warn about it if execution was specified,
+           ;; but practically speaking it would mostly be noise.
+           (execution (if (member output-type '(:bytecode :bytecodel))
+                          :serial
+                          execution)))
       (with-open-file (source-sin input-file
                                   :external-format external-format)
         (with-compilation-results ()

src/lisp/kernel/cmp/disltv.lisp

@@ -546,7 +546,7 @@
 ;;; Write a FASL object out to a stream/file.
 
 (defun write-fasl (fasl stream)
-  (write-bytecode (instructions fasl) (attributes fasl) stream))
+  (write-bytecode (instructions fasl) stream))
 
 (defun save-fasl (fasl output-path)
   (with-open-file (output output-path

src/lisp/kernel/init.lisp

@@ -109,9 +109,12 @@
 
 (if (member :generate-faso *features*)
     (setq core:*clasp-build-mode* :faso))
-                                  
 
-(setq cmp:*default-object-type* core:*clasp-build-mode*)
+
+(setq cmp:*default-object-type*
+      (if (member :generate-bytecode *features*)
+          :bytecode
+          core:*clasp-build-mode*))
 
 ;;; ------------------------------------------------------------
 ;;;