Changeset 15596

Timestamp:

11/26/22 08:35:27 (10 months ago)

Author:

Mark Evenson

Message:

• Fixes the issue with the compile & loading of Fricas0 system (Github
  • Now the file compiler will always try to compile the form and it will only fallback to the interpreted form when the bytecode error is actually raised

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• autoloads-gen.lisp (modified) (1 diff)
• compile-file.lisp (modified) (2 diffs)
• compiler-error.lisp (modified) (3 diffs)
• jvm-class-file.lisp (modified) (4 diffs)

trunk/abcl/src/org/armedbear/lisp/autoloads-gen.lisp

@@ -146 +146 @@
 ;; EXPORTS
 (IN-PACKAGE :SYSTEM)
-(EXPORT (QUOTE (CONCATENATE-FASLS AVER *COMPILER-DIAGNOSTIC* COMPILE-FILE-IF-NEEDED GROVEL-JAVA-DEFINITIONS-IN-FILE COMPILER-UNSUPPORTED INTERNAL-COMPILER-ERROR COMPILER-ERROR COMPILER-WARN COMPILER-STYLE-WARN *COMPILER-ERROR-CONTEXT* COMPILER-MACROEXPAND DEFKNOWN FUNCTION-RESULT-TYPE COMPILER-SUBTYPEP MAKE-COMPILER-TYPE JAVA-LONG-TYPE-P INTEGER-CONSTANT-VALUE FIXNUM-CONSTANT-VALUE FIXNUM-TYPE-P +INTEGER-TYPE+ +FIXNUM-TYPE+ MAKE-INTEGER-TYPE %MAKE-INTEGER-TYPE INTEGER-TYPE-P INTEGER-TYPE-HIGH INTEGER-TYPE-LOW +FALSE-TYPE+ +TRUE-TYPE+ COMPILER-DEFSTRUCT DESCRIBE-COMPILER-POLICY PARSE-BODY DUMP-UNINTERNED-SYMBOL-INDEX DUMP-FORM LOOKUP-KNOWN-SYMBOL STANDARD-INSTANCE-ACCESS SLOT-DEFINITION FORWARD-REFERENCED-CLASS LOGICAL-HOST-P *INLINE-DECLARATIONS* FTYPE-RESULT-TYPE PROCLAIMED-FTYPE PROCLAIMED-TYPE CHECK-DECLARATION-TYPE PROCESS-KILL PROCESS-EXIT-CODE PROCESS-WAIT PROCESS-ALIVE-P PROCESS-ERROR PROCESS-OUTPUT PROCESS-INPUT PROCESS-P PROCESS RUN-PROGRAM SIMPLE-SEARCH EXPAND-SOURCE-TRANSFORM DEFINE-SOURCE-TRANSFORM SOURCE-TRANSFORM UNTRACED-FUNCTION)))
+(EXPORT (QUOTE (CONCATENATE-FASLS AVER *COMPILER-DIAGNOSTIC* COMPILE-FILE-IF-NEEDED GROVEL-JAVA-DEFINITIONS-IN-FILE COMPILER-UNSUPPORTED INTERNAL-COMPILER-ERROR COMPILER-ERROR COMPILER-BYTECODE-LENGTH-ERROR COMPILER-WARN COMPILER-STYLE-WARN *COMPILER-ERROR-CONTEXT* COMPILER-MACROEXPAND DEFKNOWN FUNCTION-RESULT-TYPE COMPILER-SUBTYPEP MAKE-COMPILER-TYPE JAVA-LONG-TYPE-P INTEGER-CONSTANT-VALUE FIXNUM-CONSTANT-VALUE FIXNUM-TYPE-P +INTEGER-TYPE+ +FIXNUM-TYPE+ MAKE-INTEGER-TYPE %MAKE-INTEGER-TYPE INTEGER-TYPE-P INTEGER-TYPE-HIGH INTEGER-TYPE-LOW +FALSE-TYPE+ +TRUE-TYPE+ COMPILER-DEFSTRUCT DESCRIBE-COMPILER-POLICY PARSE-BODY DUMP-UNINTERNED-SYMBOL-INDEX DUMP-FORM LOOKUP-KNOWN-SYMBOL STANDARD-INSTANCE-ACCESS SLOT-DEFINITION FORWARD-REFERENCED-CLASS LOGICAL-HOST-P *INLINE-DECLARATIONS* FTYPE-RESULT-TYPE PROCLAIMED-FTYPE PROCLAIMED-TYPE CHECK-DECLARATION-TYPE PROCESS-KILL PROCESS-EXIT-CODE PROCESS-WAIT PROCESS-ALIVE-P PROCESS-ERROR PROCESS-OUTPUT PROCESS-INPUT PROCESS-P PROCESS RUN-PROGRAM SIMPLE-SEARCH EXPAND-SOURCE-TRANSFORM DEFINE-SOURCE-TRANSFORM SOURCE-TRANSFORM UNTRACED-FUNCTION)))
 
 ;; FUNCTIONS

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -102 +102 @@
          (when args
            args)))
-          
+
 
 (declaim (ftype (function (t) t) verify-load))
@@ -881 +881 @@
                     (when (eq form in)
                       (return))
-                    (cond 
-                      ((>= (length (format nil "~a" form)) 65536)
-                       ;; Following the solution propose here:
-                       ;; see https://github.com/armedbear/abcl/issues/246#issuecomment-698854437
-                       ;; just include the offending interpreted form in the loader
-                       ;; using it instead of the compiled representation
-                       (diag "Falling back to interpreted version of top-level form longer ~
+
+                    (handler-case (process-toplevel-form form out nil)
+                      (compiler-bytecode-length-error ()
+                        ;; Following the solution propose here:
+                        ;; see https://github.com/armedbear/abcl/issues/246#issuecomment-698854437
+                        ;; just include the offending interpreted form in the loader
+                        ;; using it instead of the compiled representation
+                        (diag "Falling back to interpreted version of top-level form longer ~
                               than 65535 bytes")
-                       (write (ext:macroexpand-all form *compile-file-environment*)
-                              :stream out))
-                      (t 
-                       (process-toplevel-form form out nil))))))
+                        (write (ext:macroexpand-all form *compile-file-environment*)
+                                 :stream out)))
+                    )))
               (finalize-fasl-output)
               (dolist (name *fbound-names*)

trunk/abcl/src/org/armedbear/lisp/compiler-error.lisp

@@ -36 +36 @@
           compiler-warn
           compiler-error
+          compiler-bytecode-length-error
           internal-compiler-error
           compiler-unsupported))
@@ -42 +43 @@
 
 (define-condition compiler-error (error) ())
+(define-condition compiler-bytecode-length-error (error) ())
 (define-condition internal-compiler-error (compiler-error) ())
 (define-condition compiler-unsupported-feature-error (compiler-error) ())
@@ -61 +63 @@
 
 (defun internal-compiler-error (format-control &rest format-arguments)
-  (cerror "Eventually use interpreted form instead" 
+  (cerror "Eventually use interpreted form instead"
           'internal-compiler-error
           :format-control format-control

trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

@@ -268 +268 @@
       (princ ret-string s))
     str)
-;;  (format nil "(~{~A~})~A" 
+;;  (format nil "(~{~A~})~A"
 ;;          (internal-field-ref return-type))
   )
@@ -804 +804 @@
   (let ((interface-refs nil))
     (dolist (interface (class-file-interfaces class))
-      (push 
+      (push
        (pool-add-class (class-file-constants class)
                        interface)
@@ -1276 +1276 @@
           (c labels)
         (code-bytes c)
-      (assert (< 0 (length c) 65536))
+      (unless (< 0 (length c) 65536)
+        (signal 'sys:compiler-bytecode-length-error))
       (setf (code-code code) c
             (code-labels code) labels)))
@@ -1735 +1736 @@
 - add code to the code attribute
 - finalize the code attribute contents (blocking it for further addition)
-- 
+-