Add --x86-64-v2 and similar to configure

BUILDING

@@ -435,6 +435,13 @@ after <machine type>:
    Specifies that "scheme.exe" (and its DLL, if any) should statically
    link to the multi-threaded C runtime.
 
+ * `/x86-64-v<level>` with <level> as 1, 2, 3, or 4
+
+   Configures x64 output to for instructions that can be used
+   directly, instead of dynamically substituting them when available
+   or using other fallbacks. The <level> corresponds to the level
+   in the x86-64 psABI.
+
  * `/keepvs`
 
    Specifies that command-line tools like "cl.exe" are available and

build.bat

@@ -10,6 +10,7 @@ set MAKETARGET=all-dlls
 set SKIPVS=no
 set SKIPSUBMODULE=no
 set USEPB=yes
+set XLEVEL=1
 
 if "%WORKAREA%"=="" goto needargument
 
@@ -21,6 +22,10 @@ if defined ARG (
   if "%ARG%"=="/exe" set LINKAS=exe && goto argloop
   if "%ARG%"=="/MD" set RUNTIMEAS=dll && goto argloop
   if "%ARG%"=="/MT" set RUNTIMEAS=static && goto argloop
+  if "%ARG%"=="/x86-64-v1" set XLEVEL=1 && goto argloop
+  if "%ARG%"=="/x86-64-v2" set XLEVEL=2 && goto argloop
+  if "%ARG%"=="/x86-64-v3" set XLEVEL=3 && goto argloop
+  if "%ARG%"=="/x86-64-v4" set XLEVEL=4 && goto argloop
   if "%ARG%"=="/only" set MAKETARGET=build && goto argloop
   if "%ARG%"=="/kernel" set MAKETARGET=kernel && goto argloop
   if "%ARG%"=="/none" set MAKETARGET=none && goto argloop
@@ -63,6 +68,7 @@ echo m=%M% >> %WORKAREA%\Mf-config
 echo linkAs=%LINKAS% >> %WORKAREA%\Mf-config
 echo runtimeAs=%RUNTIMEAS% >> %WORKAREA%\Mf-config
 echo enableFrompb=%USEPB% >> %WORKAREA%\Mf-config
+echo x86_64_level=%XLEVEL% >> %WORKAREA%\Mf-config
 
 echo workarea=%WORKAREA% > Makefile
 echo !include %WORKAREA%\Mf-config >> Makefile

build.zuo

@@ -85,6 +85,15 @@
            (map (lambda (file) (build-path pb-dir file))
                 boot:boot-file-names))))
 
+  (define x86-64-level
+    (hash-ref config 'x86_64_level "1"))
+
+  (define (add-x86-64-level-target xm targets)
+    (if (equal? (m->arch xm) "a6")
+        (cons (input-data-target 'x86-64-level x86-64-level)
+              targets)
+        targets))
+
   (define all-src-files
     (map (lambda (n) (at-source "s" n))
          all-src-names))
@@ -176,7 +185,8 @@
                            (hash)))
        (reboot m xm scheme (hash 'shell-options options
                                  'out-dir (at-dir "..")
-                                 'work-dir (at-dir "..")))
+                                 'work-dir (at-dir "..")
+                                 'x86-64-level x86-64-level))
        (record-build-success token xm m host-scheme host-workarea))))
 
   (define (record-build-success token xm m host-scheme host-workarea)
@@ -197,13 +207,15 @@
         [else boot-files]))
     (build (target (at-boot (car boot-file-names))
                    (lambda (path token)
-                     (rule (if record-from-pb?
-                               ;; declare dependency on pb instead of host,
-                               ;; so we don't rebuild via pb:
-                               via-pb-files
-                               ;; otherwise, bootquick again if host changes:
-                               (append (host-boot-files)
-                                       all-src-files))
+                     (rule (add-x86-64-level-target
+                            xm
+                            (if record-from-pb?
+                                ;; declare dependency on pb instead of host,
+                                ;; so we don't rebuild via pb:
+                                via-pb-files
+                                ;; otherwise, bootquick again if host changes:
+                                (append (host-boot-files)
+                                        all-src-files)))
                            thunk))
                    (hash 'co-outputs (map at-boot (cdr boot-file-names))
                          'precious? #t
@@ -507,7 +519,7 @@
               boot-files)
 
        ,@(if boot-from-pb?
-             `([:target (,@boot-src-files) (,@via-pb-files)
+             `([:target (,@boot-src-files) (,@(add-x86-64-level-target m via-pb-files))
                         ,(lambda (first-path token)
                            (check-machine-type m)
                            (alert (~a "checking boot files for " m " against pb"))
@@ -521,6 +533,7 @@
                                        (list* (build-raw-path (at-source ".") "configure")
                                               "--nomakefile"
                                               "--pb"
+                                              (~a "--x86-64-v" x86-64-level)
                                               (string->shell
                                                (~a  "--sessionkey="
                                                     (hash-ref config 'sessionKey "")))

c/build.zuo

@@ -80,11 +80,11 @@
   ;; sources for "kernel.o":
   (define kernel-src-files
     (add-windows
-     (list "statics.c" "segment.c" "alloc.c" "symbol.c" "intern.c"
+     (list "statics.c" "segment.c" "alloc.c" "symbol.c" "intern.c" "expeditor.c"
            "gcwrapper.c" "gc-011.c" "gc-par.c" "gc-ocd.c" "gc-oce.c"
            "number.c" "schsig.c" "io.c" "new-io.c" "print.c" "fasl.c" "vfasl.c"
            "stats.c" "foreign.c" "prim.c" "prim5.c" "flushcache.c"
-           "schlib.c" "thread.c" "expeditor.c" "scheme.c" "compress-io.c"
+           "schlib.c" "thread.c" "scheme.c" "compress-io.c"
            "random.c" "ffi.c" "self-exe.c"
            arch.c)))
   (define kernel-srcs

configure

@@ -114,6 +114,7 @@ buildKernelOnly=no
 enableFrompb=yes
 pbendian=l
 emscripten=no
+x86_64_level=1
 empetite=no
 android=no
 crossCompile=no
@@ -333,6 +334,17 @@ while [ $# != 0 ] ; do
       AR="emar"
       RANLIB="emranlib"
       ;;
+    --x86-64-v*)
+      x86_64_level=`echo $1 | sed -e 's/^--x86-64-v//'`
+      case "$x86_64_level" in
+          1|2|3|4)
+              ;;
+          *)
+              echo "unrecoginzed x86-64 level: $x86_64_level"
+              exit 1
+              ;;
+      esac
+      ;;
     --force)
       forceworkarea=yes
       enableFrompb=no
@@ -708,6 +720,7 @@ if [ "$help" = "yes" ]; then
   echo "  --pb                              specify pb (portable bytecode) version"
   echo "  --pbarch                          specify pb with inferred word and endianness"
   echo "  --emscripten                      build via emscripten (\"em\" tool prefix)"
+  echo "  --x86-64-v<level>                 configure a6 code generation; see below"
   echo "  --cross                           build host to bootstrap target"
   echo "  --disable-x11                     disable X11 support"
   echo "  --disable-curses                  disable [n]curses support"
@@ -768,6 +781,13 @@ if [ "$help" = "yes" ]; then
   echo "  STEXLIB=<stex>                    build docs with <stex> instead of own stex"
   echo "  ZUO=<zuo>                         build with <zuo> instead of own Zuo"
   echo ""
+  echo "For --x86-64-v<level>, the <level> can be 1, 2, or 4 corresponding to a level"
+  echo "in the x86-64 psABI:"
+  echo "  1 is the baseline supported by all x86_64 processors"
+  echo "  2 includes POPCOUNT and SSE4.1 instructions"
+  echo "  3 includes FMA and AVX instructions"
+  echo "  4 includes AVX512 instructions"
+  echo ""
   echo "Available machine types: $machs"
   echo ""
   echo "Examples:"
@@ -1222,6 +1242,7 @@ mboot=$mboot
 crossCompile=$crossCompile
 buildKernelOnly=$buildKernelOnly
 enableFrompb=$enableFrompb
+x86_64_level=$x86_64_level
 mdinclude=$mdinclude
 mdcppflags=$mdcppflags
 mdcflags=$mdcflags

makefiles/boot.zuo

@@ -34,6 +34,7 @@
                        (if (or host-scheme host-workarea)
                            "cross=t\n"
                            "")
+                       (~a "x86_64_level=" (hash-ref config 'x86_64_level "1") "\n")
                        (~a "sessionKey=" (hash-ref config 'sessionKey "") "\n")
                        "\n")
                    (build-path dir "Mf-config")

release_notes/release_notes.stex

@@ -165,6 +165,15 @@ The armv7le and tarmv7le machine types correspond to a 32-bit ARM
 compilation target using the armel ABI, which is consistent with (old)
 Android devices.
 
+\subsection{Support for additional x86-64 instructions (10.5.0)}
+
+Supplying \scheme{--x86-64-v\var{level}} to \scheme{configure} enables
+use of instructions at \var{level} as specified by the x86-64 psABI.
+In particular, \var{level} as \scheme{2} enables direct use of
+POPCOUNT and SSE4.1 instructions in code that is generated for x86\_64
+targets, instead of substituting those instructions (with a small
+overhead) dynamically when they are available at run time.
+
 \subsection{Exact zeros and \scheme{lcm} (10.5.0)}
 
 Supplying an exact \scheme{0} to \scheme{lcm} produces exact

s/a6-options.def

@@ -0,0 +1 @@
+(define-constant x86-64-level $(level))

s/a6.def

@@ -12,3 +12,5 @@
 (define-constant integer-divide-instruction #t)
 (define-constant popcount-instruction #t)
 (define-constant fpround-instruction #t)
+
+(include "a6-options.def")

s/build.zuo

@@ -134,14 +134,19 @@
   '("../unicode/unicode-char-cases.ss"
     "../unicode/unicode-charinfo.ss"))
 
+(define def-src-names
+  (sort (filter (glob->matcher "*.def") (ls (at-source ".")))
+        string<?))
+
 ;; used externally as dependencies
 (define all-src-names
   (append base-src-names
           macro-src-names
           other-src-names
           type-src-names
           cpnanopass-src-names
-          unicode-src-names))
+          unicode-src-names
+          def-src-names))
 
 ;; The `compiler-compiler-options` argument overrides certain `var` and config-file
 ;; options for building preamble files, which is useful for compiling a cross-compiler
@@ -168,7 +173,11 @@
   (define host-scheme (lookup 'hostscheme))
   (define arch (m->arch m))
 
-  (define mach-src+dep+more-srcs (get-machine-files m arch))
+  (define x86-64-level (if (string=? arch "a6")
+                           (or (lookup 'x86_64_level) "1")
+                           0))
+
+  (define mach-src+dep+more-srcs (get-machine-files m arch x86-64-level))
   (define machine-def-inputs (map at-source (cons (caar mach-src+dep+more-srcs)
                                                   (cdr mach-src+dep+more-srcs))))
 
@@ -221,7 +230,8 @@
                  other-src-names)))
 
   (define all-srcs
-    (append base-srcs
+    (append (map at-source def-src-names)
+            base-srcs
             compiler-srcs
             included-srcs
             other-srcs))
@@ -345,9 +355,9 @@
                              loads))])
 
   ;; Create a `:depend` line for a file that `include`s other files
-  (define (include-dep name src-names)
+  (define (include-dep name src-names [more-deps '()])
     `[:depend (,(at-dir (~a name "." m)) ,(at-dir (~a name ".so")) ,(at-dir (~a name ".patch")))
-              ,(map at-source src-names)])
+              ,(append more-deps (map at-source src-names))])
 
   (define (run-scheme-header-script dest make-script mk.so*)
     (define tmp (~a dest ".next"))
@@ -532,7 +542,8 @@
 
        ;; Internal targets ----------------------------------------
 
-       [:target ,machine.def (,(input-data-target 'machine m) ,@machine-def-inputs)
+       [:target ,machine.def (,(input-data-target 'machine (list m x86-64-level))
+                              ,@machine-def-inputs)
                 ,(lambda (dest token)
                    ((cdar mach-src+dep+more-srcs) dest token))]
 
@@ -593,8 +604,8 @@
        ,(include-dep "strip" (list "strip-types.ss"))
        ,(include-dep "vfasl" (list "strip-types.ss"))
        ,(include-dep "pbchunk" (list "strip-types.ss"))
-       ,(include-dep "cpnanopass" cpnanopass-src-names)
-       ,(include-dep "cpprim" cpnanopass-src-names)
+       ,(include-dep "cpnanopass" cpnanopass-src-names (list machine.def))
+       ,(include-dep "cpprim" cpnanopass-src-names (list machine.def))
 
        [:target ,petite.boot ,(add-patchfile base-objs)
                 ,(lambda (petite.boot token)

s/cpprim.ss

@@ -5055,7 +5055,7 @@
           [(e)
            (constant-case fpround-instruction
              [(#t) (build-fp-op-1 %fpround e)]
-             [else (build-fl-call (lookup-c-entry flround) e)])]) ; fpround-instruction: SSE4.1 roundsd on x86_64, frint* on arm64
+             [else (build-fl-call (lookup-c-entry flround) e)])])
         (define-inline 3 flfloor
           [(e)
            (constant-case fpround-instruction

s/machine.zuo

@@ -16,7 +16,8 @@
 ;; Get or synthesize a "machine.def" file and supporting files,
 ;; returns
 ;;    (list (cons dep-name build) dep-input-name ...)
-(define (get-machine-files m arch)
+;; The `x86-64-level` argument is relevant only for the "a6" architecture
+(define (get-machine-files m arch [x86-64-level 0])
   (define threaded? (= (char "t") (string-ref m 0)))
   (define uni (if threaded? (substring m 1) m))
   (cond
@@ -50,22 +51,44 @@
      (define arch.def (~a arch ".def"))
      (define os.def (~a os ".def"))
      (define src (at-source m.def))
-     (cons (if (file-exists? src)
-               (cons m.def
-                     (lambda (dest token)
-                       (cp/ln src dest)))
-               (let ([src (if threaded? "tunix.def" "unix.def")])
-                 (cons src
-                       (lambda (dest token)
-                         (fill-template (at-source src) dest
-                                        (hash 'M m 'March arch))))))
+     (define dep
+       (if (file-exists? src)
+           (cons m.def
+                 (lambda (dest token)
+                   (cp/ln src dest)))
+           (let ([src (if threaded? "tunix.def" "unix.def")])
+             (cons src
+                   (lambda (dest token)
+                     (fill-template (at-source src) dest
+                                    (hash 'M m 'March arch)))))))
+     (define a6? (string=? arch "a6"))
+     (cons (if a6?
+               (add-a6-options dep x86-64-level)
+               dep)
            (append
             (list "default.def"
                   arch.def)
+            (if a6?
+                (list "a6-options.def")
+                '())
             (if (file-exists? (at-source os.def))
                 (list os.def)
                 '())))]))
 
+;; "a6.def" includes "a6-options.def"
+(define (add-a6-options dep x86-64-level)
+  (cons (car dep)
+        (lambda (dest token)
+          ((cdr dep) dest token)
+          (define options.def (build-path (path-only dest) "a6-options.def"))
+          (rm* options.def)
+          (fill-template (at-source "a6-options.def") options.def
+                         (hash 'level x86-64-level))
+          ;; record level in `dest` so the file changes f the configuration changes
+          (define o (fd-open-output dest :append))
+          (fd-write o (~a "\n;; level = " x86-64-level "\n"))
+          (fd-close o))))
+
 (define (fill-template src dest vars)
   (define s (file->string src))
   (define new-s (let loop ([i 0] [start 0])

s/reboot.zuo

@@ -13,6 +13,8 @@
           (hash-set flags 'target machine)]
    [flags ("--dest") dest "Write boot files to <dest>/boot/<target>"
           (hash-set flags 'dest dest)]
+   [flags ("--x86-64-v") level "Enable x86-64 instructions for <level>>"
+          (hash-set flags 'x86-64-level level)]
    :args
    ()
    (lambda (flags)
@@ -21,7 +23,8 @@
      (define target (hash-ref flags 'target host))
      (define dest (hash-ref flags 'dest "."))
 
-     (reboot 'infer target command (hash 'out-dir dest)))))
+     (reboot 'infer target command (hash 'out-dir dest
+                                          'x86-64-level (hash-ref flags 'x86-64-level "1"))))))
 
 (define (reboot given-host target command [options (hash)])
   (define host (if (eq? given-host 'infer)
@@ -41,7 +44,8 @@
   (mkdir-p host-dir)
 
   (define host-config (get-machine-files host (m->arch host)))
-  (define target-config (get-machine-files target (m->arch target)))
+  (define target-config (get-machine-files target (m->arch target)
+                                           (hash-ref options 'x86-64-level "1")))
 
   ((cdar host-config) (build-path host-dir "machine.def") #f)
   ((cdar target-config) (build-path s-dir "machine.def") #f)