Merge branch 'jpellegrini-parameter-peephole'

doc/refman/idiosync.adoc

@@ -1,6 +1,6 @@
 //  SPDX-License-Identifier: GFDL-1.3-or-later
 //
-//  Copyright © 2000-2023 Erick Gallesio <eg@stklos.net>
+//  Copyright © 2000-2024 Erick Gallesio <eg@stklos.net>
 //
 //           Author: Erick Gallesio [eg@unice.fr]
 //    Creation date:  3-Feb-2022 11:16 (eg)
@@ -187,3 +187,4 @@ Compiling files from Scheme programs can be done with the
 {{insertdoc 'compiler:keep-formals}}
 {{insertdoc 'compiler:keep-source}}
 {{insertdoc 'compiler:unroll-iterations}}
+{{insertdoc 'compiler:peephole-optimizer}}

doc/stklos.1.in

@@ -76,7 +76,7 @@ directory is also used to store the packages installed with the
 .IP "-q, --no-init-file"
 quiet: do not load the user init file.
 .IP "-Q, --no-startup-message"
-quiet: do not show the startup message. 
+quiet: do not show the startup message.
 .IP "-i, --interactive"
 be interactive, even if the command finds it is not the case. This
 option is generally useful when used inside emacs since it permits to
@@ -120,7 +120,7 @@ this option:
 .IP "" 10
 - \fIline-info\fR insert line numbers in the generated file. Setting this flag
 is equivalent to the \fI-l\fR option. This flag uses the parameter
-\fIcompiler:gen-line-number\fR. 
+\fIcompiler:gen-line-number\fR.
 .IP "" 10
 - \fIshow-instructions\fR can be used to insert the textual instructions
 into compiled files. This flag uses the parameter
@@ -145,8 +145,12 @@ in produced code. This flag uses the parameter
 - \fIunroll-iterations\fR can be used to set the number of iterations to be unrolled
 in loops. This flag uses the parameter \fIcompiler:unroll-iterations\fR and its
 default value is 4.
-
-
+.IP "" 10
+- \fIpeephole-optimizer\fR can be used to activate or deactivate the peephole
+optimizer during compilation. The peephole optimizer is used to change a
+succession of instructions by another set of instructions that has better
+performance. This flag uses the parameter \fIcompiler:peehole-optimizer\fR.
+By default, the peephole optimizer is activated.
 .IP "-v, --version"
 print program version and exit.
 .IP "-V"

lib/assembler.stk

@@ -308,7 +308,7 @@
 (define (assemble code)
   (let ((pc    0)
         (labs '())
-        (code  (peephole code)))
+        (code  (if (compiler:peephole-optimizer) (peephole code) code)))
     ;;
     ;; Pass 1
     ;;
@@ -473,7 +473,8 @@ doc>
   (let ((code (%procedure-code proc)))
     (if code
         (disassemble-code code port)
-        (error 'disassemble "cannot disassemble ~S (not a closure with bytecode)" proc))))
+        (error 'disassemble "cannot disassemble ~S (not a closure with bytecode)"
+               proc))))
 
 #|
 <doc EXT disassemble-expr

lib/compflags.stk

@@ -39,7 +39,8 @@
         compiler:keep-formals
         compiler:keep-source
         compiler:inline-common-functions
-        compiler:unroll-iterations)
+        compiler:unroll-iterations
+        compiler:peephole-optimizer)
 
 #|
 <doc EXT compiler:time-display
@@ -65,19 +66,20 @@ doc>
  * (compiler:show-assembly-code)
  * (compiler:show-assembly-code bool)
  *
- * This parameter controls if the object files produced by the {{stklos}} compiler
- * code must embed a readable version of the code. The code is placed at the beginning
- * of the produced file. This parameter defaults to `#f`.
+ * This parameter controls if the object files produced by the {{stklos}}
+ * compiler code must embed a readable version of the code. The code is placed
+ * at the beginning of the produced file. This parameter defaults to `#f`.
 doc>
 <doc EXT compiler:inline-common-functions
  * (compiler:inline-common-functions)
  * (compiler:inline-common-functions bool)
  *
- * This parameter controls if the compiler must try to inline the most common Scheme
- * primitives (simple arithmetic, main list or vector functions, ...). Code produced
- * when this parameter is set is more efficient. Note that the compiler can sometimes be
- * misleaded if those functions are redefined, hence the existence of this parameter.
- * |compiler:inline-common-functions| is set by default to `#t`.
+ * This parameter controls if the compiler must try to inline the most common
+ * Scheme primitives (simple arithmetic, main list or vector functions, ...).
+ * Code produced  when this parameter is set is more efficient. Note that the
+ * compiler can sometimes be misleaded if those functions are redefined, hence
+ * the existence of this parameter. |compiler:inline-common-functions| is set
+ * by default to `#t`.
  * @lisp
  * > (compiler:inline-common-functions #t)
  * > (disassemble-expr '(begin (car '(1 2 3)) (+ a 1)) #t)
@@ -167,6 +169,40 @@ doc>
  * loops. Currently, only |repeat| loops are unrolled. The argument
  * |n| must be a positive integer.
 doc>
+<doc EXT compiler:peephole-optimizer
+ * (compiler:peephole-optimizer)
+ * (compiler:peephole-optimizer bool)
+ *
+ * This parameter determines if the peephole optimizer is used when compiling.
+ * The default value for this parameter is `#t`. The next example illustrates
+ * how it works.
+ *
+ * @lisp
+ * (compiler:peephole-optimizer #f)
+ * (disassemble-expr '(+ a #f) #t)
+ * @end lisp
+ * will print
+ * @lisp
+ * 000:  GLOBAL-REF           0
+ * 002:  PUSH
+ * 003:  IM-FALSE
+ * 004:  IN-ADD2
+ * 005:
+ * @end lisp
+ * Now, if we change the parameter,
+ * @lisp
+ * (compiler:peephole-optimizer #t)
+ * (disassemble-expr '(+ a #f) #t)
+ * then the result is
+ * @lisp
+ * 000:  GLOBAL-REF-PUSH      0
+ * 002:  IM-FALSE
+ * 003:  IN-ADD2
+ * 004:
+ * @end lisp
+ * See that the `GLOBAL-REF` and `PUSH` were turned by the peephole optimizer
+ * into `GLOBAL-REF-PUSH`.
+doc>
 |#
 (define-parameter compiler:time-display                   #t)
 (define-parameter compiler:gen-line-number                #f)
@@ -175,38 +211,32 @@ doc>
 (define-parameter compiler:show-assembly-code             #f)
 (define-parameter compiler:keep-formals                   #f)
 (define-parameter compiler:keep-source                    #f)
+(define-parameter compiler:peephole-optimizer              #t)
 (define-parameter compiler:unroll-iterations 4
   (lambda (v)
     (unless (and (fixnum? v) (positive? v))
       (error 'compiler:unroll-iterations
              "must be a positive fixnum. It was ~s" v))
     v))
 
-;;.///(define compiler:inline-common-functions
-;;.///  (let* ((inlined *inline-symbols*)
-;;.///         (res     (make-parameter #t
-;;.///                                  (lambda (v)
-;;.///                                    (set! *inline-symbols* (if v inlined '()))
-;;.///                                    (not (null? *inline-symbols*))))))
-;;.///    (%set-parameter-name! res 'compiler:inline-common-functions)
-;;.///    res))
-
 (define compiler:inline-common-functions
   (let* ((inlined-math-commutative *inline-math-commutative*)
          (inlined-math-general     *inline-math-general*)
          (inlined-math             *inline-math*)
          (inlined-general          *inline-general*)
-         (res (make-parameter #t
-                              (lambda (v)
-                                (set! *inline-math-commutative* (if v inlined-math-commutative '()))
-                                (set! *inline-math-general*     (if v inlined-math-general     '()))
-                                (set! *inline-math*             (if v inlined-math             '()))
-                                (set! *inline-general*          (if v inlined-general          '()))
-                                (set! *inline-table*            (append *inline-math*
-                                                                        *inline-general*))
-                                (not (null? *inline-table*))))))
-   (%set-parameter-name! res 'compiler:inline-common-functions)
-   res))
+         (res     (make-parameter
+                   #t
+                   (lambda (v)
+                     (set! *inline-math-commutative* (if v inlined-math-commutative '()))
+                     (set! *inline-math-general*     (if v inlined-math-general     '()))
+                     (set! *inline-math*             (if v inlined-math             '()))
+                     (set! *inline-general*          (if v inlined-general          '()))
+                     (set! *inline-table*            (append *inline-math*
+                                                             *inline-general*))
+                     (not (null? *inline-table*))))))
+    (%set-parameter-name! res 'compiler:inline-common-functions)
+    res))
+
 
 ;; ----------------------------------------------------------------------
 ;;      %compiler-set-flags ...
@@ -230,6 +260,7 @@ doc>
                           ((keep-source)       (compiler:keep-source val))
                           ((inline-usuals)     (compiler:inline-common-functions val))
                           ((show-instructions) (compiler:show-assembly-code val))
+                          ((peephole-optimizer)(compiler:peephole-optimizer val))
                           (else (error "bad boolean flag ~s" flag))))
                       ;; valued flag
                       (let* ((lst  (string-split flag "=")))
@@ -240,7 +271,8 @@ doc>
                                 ((unroll-iterations)
                                  (if v
                                      (compiler:unroll-iterations v)
-                                     (error "bad value for unroll-iteration ~s" (cadr lst))))
+                                     (error "bad value for unroll-iteration ~s"
+                                            (cadr lst))))
                                 (else
                                  (error "bad flag name ~s" f))))
                             (error "bad valued flag ~s" flag))))))