From 9b6b6d32eed729c39d7a18c5498c6d85b9481ba6 Mon Sep 17 00:00:00 2001
From: dyb <dyb@scheme.com>
Date: Sun, 29 Oct 2017 17:48:43 -0400
Subject: [PATCH] attempt to stabilize timing tests let-values source-caching
 test and ephemeron gc test while resensitizing the former   8.ms, 4.ms
 various formatting and comment corrections   workarea,   s/Mf-base,
 bytevector.ss, cpnanopass.ss, date.ss,   5_6.ms, examples.ms

original commit: 19e2505fc6477fce2d1d0e61187bd504b58ea994
---
 LOG              |   7 ++
 mats/4.ms        |  46 +++++++-----
 mats/5_6.ms      |   2 +-
 mats/8.ms        |  20 +++--
 mats/examples.ms |   1 -
 s/Mf-base        |   4 +-
 s/bytevector.ss  |  46 ++++++------
 s/cpnanopass.ss  | 186 +++++++++++++++++++++++------------------------
 s/date.ss        |  10 +--
 workarea         |   7 +-
 10 files changed, 172 insertions(+), 157 deletions(-)

diff --git a/LOG b/LOG
index 0641fc5f9a..1a470c5233 100644
--- a/LOG
+++ b/LOG
@@ -720,3 +720,10 @@
     8.ms
 - updated allx, bullyx patches
     patch*
+- attempt to stabilize timing tests let-values source-caching
+  test and ephemeron gc test while resensitizing the former
+    8.ms, 4.ms
+- various formatting and comment corrections
+    workarea,
+    s/Mf-base, bytevector.ss, cpnanopass.ss, date.ss,
+    5_6.ms, examples.ms
diff --git a/mats/4.ms b/mats/4.ms
index 3d2990385c..2f1a5cdb33 100644
--- a/mats/4.ms
+++ b/mats/4.ms
@@ -3496,7 +3496,7 @@
    ;; ----------------------------------------
    ;; Stress test to check that the GC doesn't suffer from quadratic
    ;; behavior
-   (begin
+   (let ()
      (define (wrapper v) (list 1 2 3 4 5 v))
      
      ;; Create a chain of ephemerons where we have all
@@ -3532,21 +3532,24 @@
        ;; off the end of the discover-ephemerons-one-at-a-time
        ;; chain, which is the most complex case for avoiding
        ;; quadratic GC times
-       (define-values (key es) (mk n (gensym) '()))
-       (define-values (root holds) (mk* n key es))
-
-       (define start (current-time))
-       (collect (collect-maximum-generation))
-       (let ([delta (time-difference (current-time) start)])
-         ;; Sanity check on ephemerons
-         (for-each (lambda (e)
-                     (when (eq? #!bwp (ephemeron-key e))
-                       (error 'check "oops")))
-                   es)
-         ;; Keep `root` and `holds` live:
-         (keep-alive (cons root holds))
-         ;; Return duration:
-         delta))
+       (parameterize ([collect-request-handler void] [collect-maximum-generation (max (collect-maximum-generation) 2)])
+         (collect 2)
+         (let*-values ([(key es) (mk n (gensym) '())]
+                       [(root holds) (mk* n key es)])
+           (let ([start (current-time)])
+             (collect 0 1)
+             (collect 1 2)
+             (collect 2 2)
+             (let ([delta (time-difference (current-time) start)])
+               ;; Sanity check on ephemerons
+               (for-each (lambda (e)
+                           (when (eq? #!bwp (ephemeron-key e))
+                             (error 'check "oops")))
+                         es)
+               ;; Keep `root` and `holds` live:
+               (keep-alive (cons root holds))
+               ;; Return duration:
+               delta)))))
 
      (define N 10000)
 
@@ -3558,11 +3561,14 @@
        (define dummy2 (set! dummy #f))
        (define t2 (measure-time N keep-alive))
        (define (duration->inexact t) (+ (* (time-second t) 1e9)
-                                        (time-nanosecond t)))
+                                        (inexact (time-nanosecond t))))
        (set! dummy #f)
-       (or (< (/ (duration->inexact t1) (duration->inexact t2)) 20)
-           (and (positive? tries)
-                (loop (sub1 tries))))))
+       (let ([t1 (duration->inexact t1)] [t2 (duration->inexact t2)])
+         (or (< (/ t1 t2) 20)
+           (begin
+             (printf "t1 = ~s, t2 = ~s, t1/t2 = ~s\n" t1 t2 (/ t1 t2))
+             (and (positive? tries)
+               (loop (sub1 tries))))))))
 
    ;; ----------------------------------------
    ;; Check interaction of mutation and generations
diff --git a/mats/5_6.ms b/mats/5_6.ms
index b613b04c2d..86fc47e01b 100644
--- a/mats/5_6.ms
+++ b/mats/5_6.ms
@@ -1,4 +1,4 @@
-;;; 5-5.ms
+;;; 5_6.ms
 ;;; Copyright 1984-2017 Cisco Systems, Inc.
 ;;; 
 ;;; Licensed under the Apache License, Version 2.0 (the "License");
diff --git a/mats/8.ms b/mats/8.ms
index d7d9b97914..20efa5c3d8 100644
--- a/mats/8.ms
+++ b/mats/8.ms
@@ -11093,18 +11093,22 @@
        (lambda ()
          (pretty-print (make-expr n)))
        'truncate)
-     (let ([start (current-time)])
-       (load "testfile.ss" expand)
-       (let ([delta (time-difference (current-time) start)])
-         (+ (time-second delta)
-            (* 1e-9 (time-nanosecond delta))))))
+     (collect)
+     (parameterize ([collect-request-handler void])
+       (let ([start (current-time)])
+         (load "testfile.ss" expand)
+         (let ([delta (time-difference (current-time) start)])
+           (+ (* #e1e9 (time-second delta))
+              (time-nanosecond delta))))))
 
    (let loop ([tries 3])
      (when (zero? tries)
        (error 'source-cache-test "loading lots of `let-values` forms seems to take too long"))
-     (or (> (* 30 (time-expr 100))
-            (time-expr 1000))
-         (loop (sub1 tries)))))
+     (let ([t1000 (time-expr 1000)] [t10000 (time-expr 10000)])
+       (or (> (* 20 t1000) t10000)
+         (begin
+           (printf "t1000 = ~s, t10000 = ~s, t10000 / t1000 = ~s\n" t1000 t10000 (inexact (/ t10000 t1000)))
+           (loop (sub1 tries)))))))
 
   (begin
     (define sfd-to-cache
diff --git a/mats/examples.ms b/mats/examples.ms
index c13b6d3bb2..7235e4bf7e 100644
--- a/mats/examples.ms
+++ b/mats/examples.ms
@@ -1,4 +1,3 @@
-;; examples .ms
 ;;; examples.ms
 ;;; Copyright 1984-2017 Cisco Systems, Inc.
 ;;; 
diff --git a/s/Mf-base b/s/Mf-base
index f7ef72f042..ba99af842c 100644
--- a/s/Mf-base
+++ b/s/Mf-base
@@ -61,7 +61,7 @@ pdhtml = f
 # gac determines whether cost-center allocation counts are generated: f for false, t for true
 gac = f
 
-# gac determines whether cost-center instruction counts are generated: f for false, t for true
+# gic determines whether cost-center instruction counts are generated: f for false, t for true
 gic = f
 
 # pps determines whether pass timings are printed
@@ -151,7 +151,7 @@ allsrc =\
 # doit uses a different Scheme process to compile each target
 doit: ${PetiteBoot} ${SchemeBoot} ${Cheader} ${Cequates}
 
-# doit uses a single Scheme process to compile all targets.  this is typically
+# all uses a single Scheme process to compile all targets.  this is typically
 # faster when most of the targets need to be recompiled.
 all: bootall ${Cheader} ${Cequates}
 
diff --git a/s/bytevector.ss b/s/bytevector.ss
index c45c46e013..24b6bf388c 100644
--- a/s/bytevector.ss
+++ b/s/bytevector.ss
@@ -1,13 +1,13 @@
 "bytevector.ss"
 ;;; bytevector.ss
 ;;; Copyright 1984-2017 Cisco Systems, Inc.
-;;; 
+;;;
 ;;; Licensed under the Apache License, Version 2.0 (the "License");
 ;;; you may not use this file except in compliance with the License.
 ;;; You may obtain a copy of the License at
-;;; 
+;;;
 ;;; http://www.apache.org/licenses/LICENSE-2.0
-;;; 
+;;;
 ;;; Unless required by applicable law or agreed to in writing, software
 ;;; distributed under the License is distributed on an "AS IS" BASIS,
 ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
@@ -320,7 +320,7 @@
                                (little-ref v i))]
                         [else #`(little-ref v i)])]
                    [else (unrecognized-endianness who eness)])))])))
- 
+
     (define $bytevector-s16-ref (bytevector-*-ref s 16))
     (define $bytevector-u16-ref (bytevector-*-ref u 16))
     (define $bytevector-s24-ref (bytevector-*-ref s 24))
@@ -769,7 +769,7 @@
           ($oops who "index ~s + count ~s is beyond the end of ~s" i2 k v2))
        ; whew!
         (#3%bytevector-copy! v1 i1 v2 i2 k))))
-  
+
   (set-who! bytevector->immutable-bytevector
     (lambda (v)
       (cond
@@ -829,11 +829,11 @@
     (lambda (v i eness)
       ($bytevector-u24-ref v i eness who)))
 
-  (set-who! bytevector-s32-ref 
+  (set-who! bytevector-s32-ref
     (lambda (v i eness)
       ($bytevector-s32-ref v i eness who)))
 
-  (set-who! bytevector-u32-ref 
+  (set-who! bytevector-u32-ref
     (lambda (v i eness)
       ($bytevector-u32-ref v i eness who)))
 
@@ -861,67 +861,67 @@
     (lambda (v i eness)
       ($bytevector-u56-ref v i eness who)))
 
-  (set-who! bytevector-s64-ref 
+  (set-who! bytevector-s64-ref
     (lambda (v i eness)
       ($bytevector-s64-ref v i eness who)))
 
-  (set-who! bytevector-u64-ref 
+  (set-who! bytevector-u64-ref
     (lambda (v i eness)
       ($bytevector-u64-ref v i eness who)))
 
-  (set-who! bytevector-s16-set! 
+  (set-who! bytevector-s16-set!
     (lambda (v i k eness)
       ($bytevector-s16-set! v i k eness who)))
 
-  (set-who! bytevector-u16-set! 
+  (set-who! bytevector-u16-set!
     (lambda (v i k eness)
       ($bytevector-u16-set! v i k eness who)))
 
-  (set-who! bytevector-s24-set! 
+  (set-who! bytevector-s24-set!
     (lambda (v i k eness)
       ($bytevector-s24-set! v i k eness who)))
 
-  (set-who! bytevector-u24-set! 
+  (set-who! bytevector-u24-set!
     (lambda (v i k eness)
       ($bytevector-u24-set! v i k eness who)))
 
-  (set-who! bytevector-s32-set! 
+  (set-who! bytevector-s32-set!
     (lambda (v i k eness)
       ($bytevector-s32-set! v i k eness who)))
 
-  (set-who! bytevector-u32-set! 
+  (set-who! bytevector-u32-set!
     (lambda (v i k eness)
       ($bytevector-u32-set! v i k eness who)))
 
-  (set-who! bytevector-s40-set! 
+  (set-who! bytevector-s40-set!
     (lambda (v i k eness)
       ($bytevector-s40-set! v i k eness who)))
 
-  (set-who! bytevector-u40-set! 
+  (set-who! bytevector-u40-set!
     (lambda (v i k eness)
       ($bytevector-u40-set! v i k eness who)))
 
-  (set-who! bytevector-s48-set! 
+  (set-who! bytevector-s48-set!
     (lambda (v i k eness)
       ($bytevector-s48-set! v i k eness who)))
 
-  (set-who! bytevector-u48-set! 
+  (set-who! bytevector-u48-set!
     (lambda (v i k eness)
       ($bytevector-u48-set! v i k eness who)))
 
-  (set-who! bytevector-s56-set! 
+  (set-who! bytevector-s56-set!
     (lambda (v i k eness)
       ($bytevector-s56-set! v i k eness who)))
 
-  (set-who! bytevector-u56-set! 
+  (set-who! bytevector-u56-set!
     (lambda (v i k eness)
       ($bytevector-u56-set! v i k eness who)))
 
-  (set-who! bytevector-s64-set! 
+  (set-who! bytevector-s64-set!
     (lambda (v i k eness)
       ($bytevector-s64-set! v i k eness who)))
 
-  (set-who! bytevector-u64-set! 
+  (set-who! bytevector-u64-set!
     (lambda (v i k eness)
       ($bytevector-u64-set! v i k eness who)))
 
diff --git a/s/cpnanopass.ss b/s/cpnanopass.ss
index 8d50bb2944..8287a0b002 100644
--- a/s/cpnanopass.ss
+++ b/s/cpnanopass.ss
@@ -1,13 +1,13 @@
 "cpnanopass.ss"
 ;;; cpnanopass.ss
 ;;; Copyright 1984-2017 Cisco Systems, Inc.
-;;; 
+;;;
 ;;; Licensed under the Apache License, Version 2.0 (the "License");
 ;;; you may not use this file except in compliance with the License.
 ;;; You may obtain a copy of the License at
-;;; 
+;;;
 ;;; http://www.apache.org/licenses/LICENSE-2.0
-;;; 
+;;;
 ;;; Unless required by applicable law or agreed to in writing, software
 ;;; distributed under the License is distributed on an "AS IS" BASIS,
 ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
@@ -824,7 +824,7 @@
     (define-record-type info-kill*-live* (nongenerative)
       (parent info-kill*)
       (fields live*)
-      (protocol 
+      (protocol
         (lambda (new)
           (case-lambda
             [(kill* live*)
@@ -838,7 +838,7 @@
       (fields libspec save-ra?)
       (protocol
         (lambda (new)
-          (case-lambda 
+          (case-lambda
             [(kill* libspec save-ra? live*)
              ((new kill* live*) libspec save-ra?)]
             [(kill* libspec save-ra?)
@@ -914,7 +914,7 @@
       (export dorest-intrinsic-max)
       (define (list-xtail ls n)
         (if (or (null? ls) (fx= n 0))
-            ls 
+            ls
             (list-xtail (cdr ls) (fx1- n))))
       (define dorest-intrinsics
         (let ()
@@ -1190,7 +1190,7 @@
             ; can't use a guard, since body isn't bound in guard.
             (if (eq? body x1)
                 (build-seq* profile1*
-                  (build-seq* profile2* 
+                  (build-seq* profile2*
                     `(letrec ([,x1 ,le*]) (call ,info1 ,x1 ,e* ...))))
                 `(call ,info1 ,(build-seq* profile1* (Expr e)) ,e* ...))]
            [else
@@ -1933,9 +1933,9 @@
             (define add-raw-counters
               (lambda (free** e)
                 (if (track-dynamic-closure-counts)
-                    (let f ([x** free**] [alloc 0] [raw 0]) 
+                    (let f ([x** free**] [alloc 0] [raw 0])
                       (if (null? x**)
-                          (add-counter '#{raw-create-count bhowt6w0coxl0s2y-2} (length free**) 
+                          (add-counter '#{raw-create-count bhowt6w0coxl0s2y-2} (length free**)
                             (add-counter '#{raw-alloc-count bhowt6w0coxl0s2y-3} alloc
                               (add-counter '#{raw-ref-count bhowt6w0coxl0s2y-1} raw e)))
                           (let ([x* (car x**)])
@@ -1998,7 +1998,7 @@
                                      (+ (static-closure-info-wk-borrowed-count ci) 1))]
                                  [(closure)
                                    (static-closure-info-nwk-closure-count-set! ci
-                                     (+ (static-closure-info-nwk-closure-count ci) 1)) 
+                                     (+ (static-closure-info-nwk-closure-count ci) 1))
                                    (static-closure-info-nwk-closure-free-var-count-set! ci
                                      (+ (static-closure-info-nwk-closure-free-var-count ci)
                                         (length (closure-free* c))))]
@@ -2112,7 +2112,7 @@
                          `(let ([,(closure-name c) ,(%primcall #f #f cons ,(map build-free-ref (closure-free* c)) ...)])
                             ,body)]
                         [(vector)
-                         `(let ([,(closure-name c) ,(%primcall #f #f vector ,(map build-free-ref (closure-free* c)) ...)]) 
+                         `(let ([,(closure-name c) ,(%primcall #f #f vector ,(map build-free-ref (closure-free* c)) ...)])
                             ,body)]
                         [else
                           (safe-assert (eq? (closure-type c) 'closure))
@@ -2156,7 +2156,7 @@
                      (with-frob-location (cadr free*) (add-ref-counter (%mref ,mcp ,(constant pair-cdr-disp)))
                        (Expr body index bank)))]
                   [else
-                    (safe-assert (memq type '(vector closure))) 
+                    (safe-assert (memq type '(vector closure)))
                     (let f ([free* free*] [i (if (eq? type 'vector) (constant vector-data-disp) (constant closure-data-disp))])
                       (if (null? free*)
                           (Expr body index bank)
@@ -2244,7 +2244,7 @@
                ; find closures w/free variables (non-constant closures) and propagate
                (when (ormap (lambda (c) (not (null? (closure-free* c)))) c*)
                  (for-each
-                   (lambda (c) 
+                   (lambda (c)
                      (closure-free*-set! c (append (closure-sibling* c) (closure-free* c))))
                    c*))
 
@@ -2416,7 +2416,7 @@
                              (let-values ([(out ...) (proc (car ls1) (car ls2) ...)]
                                           [(out* ...) (f (cdr ls1) (cdr ls2) ...)])
                                (values (cons out out*) ...))))))))])))
-      (define-who loop-unroll-limit 
+      (define-who loop-unroll-limit
         ($make-thread-parameter
           0 ; NB: disabling loop unrolling for now
           (lambda (x)
@@ -2428,14 +2428,14 @@
       ;; Code growth computation is a little restrictive since it's measured
       ;; per loop... but maybe since new-size is weighted when profiling is
       ;; enabled it's fine.
-      #;(define CODE-GROWTH-FACTOR (fx1+ (loop-unroll-limit))) 
+      #;(define CODE-GROWTH-FACTOR (fx1+ (loop-unroll-limit)))
       (define-syntax delay
         (syntax-rules ()
           [(_ x) (lambda () x)]))
       (define (force x) (if (procedure? x) (x) x))
       (define-who analyze-loops ;; -> (lambda () body) size new-weighted-size
         (lambda (body path-size unroll-count)
-          (with-output-language (L7 Expr) 
+          (with-output-language (L7 Expr)
             ;; Not really a loop, just didn't want to pass around path-size and unroll-count when unnecessary
             (let loop ([body body])
               (if (not body)
@@ -2449,7 +2449,7 @@
                      (values (delay `(mref ,(force e1-promise) ,(force e2-promise) ,imm))
                        (fx+ e1-size e2-size 1)
                        (fx+ e1-new-size e2-new-size 1))]
-                    [,lvalue (values body 1 1)] 
+                    [,lvalue (values body 1 1)]
                     [(profile ,src) (values body 0 0)]
                     [(pariah) (values body 0 0)]
                     [(label-ref ,l ,offset) (values body 0 0)]
@@ -2471,23 +2471,23 @@
                             [query-count (if (or (not query-count) (< query-count .1)) 0 (exact (truncate (* query-count 1000))))]
                             ;; allow path-size to increase up to 300
                             [adjusted-path-size-limit (fx+ PATH-SIZE-LIMIT (fx/ (or query-count 0) 5))]
-                            ;; allow unroll limit to increase up to 4 
+                            ;; allow unroll limit to increase up to 4
                             [adjusted-unroll-limit (fx+ (loop-unroll-limit) (fx/ (or query-count 0) 300))])
                        (if (or (fxzero? query-count)
                                (fxzero? (fx+ unroll-count adjusted-unroll-limit))
                                (fx> path-size adjusted-path-size-limit))
-                           (begin 
+                           (begin
                              (values (delay `(call ,info ,mdcl ,x ,(map force e*-promise) ...))
                                (fx1+ (apply fx+ size*))
-                               (fx1+ (apply fx+ new-size*)))) 
+                               (fx1+ (apply fx+ new-size*))))
                            (let*-values ([(var*) (car (uvar-location x))]
                                          [(loop-body-promise body-size new-size) (analyze-loops (cdr (uvar-location x)) (fx1+ path-size) (fx1- unroll-count))]
                                          [(new-size) ((lambda (x) (if query-count (fx/ x query-count) x)) (fx+ (length e*-promise) new-size))]
                                          [(acceptable-new-size) (fx* (fx1+ adjusted-unroll-limit) body-size)])
                              ;; NB: trying code growth computation here, where it could be per call site.
-                             (values 
+                             (values
                                (if (<= new-size acceptable-new-size)
-                                   (delay (fold-left 
+                                   (delay (fold-left
                                             (lambda (body var e-promise)
                                               `(seq (set! ,var ,(force e-promise)) ,body))
                                             (rename-loop-body (force loop-body-promise))
@@ -2511,7 +2511,7 @@
                      (values (delay `(foreign-call ,info ,(force e-promise) ,(map force e*-promise) ...))
                        (fx+ 5 e-size (apply fx+ size*))
                        (fx+ 5 e-new-size (apply fx+ new-size*)))]
-                    [(label ,l ,[loop : body -> e size new-size]) 
+                    [(label ,l ,[loop : body -> e size new-size])
                      (values (delay `(label ,l ,(force e))) size new-size)]
                     [(mvlet ,[loop : e -> e-promise e-size e-new-size] ((,x** ...) ,interface* ,body*) ...)
                      (let-values ([(body*-promise body*-size body*-new-size) (mvmap 3 (lambda (e) (analyze-loops e (fx+ e-size path-size) unroll-count)) body*)])
@@ -2529,7 +2529,7 @@
                        (values (delay `(let ([,x* ,(map force e*-promise)] ...) ,(force body-promise)))
                          (fx+ 1 body-size (apply fx+ size*))
                          (fx+ 1 body-new-size (apply fx+ new-size*))))]
-                    [(if ,[loop : e0 -> e0-promise e0-size e0-new-size] ,e1 ,e2) 
+                    [(if ,[loop : e0 -> e0-promise e0-size e0-new-size] ,e1 ,e2)
                      (let-values ([(e1-promise e1-size e1-new-size) (analyze-loops e1 (fx+ path-size e0-size) unroll-count)]
                                   [(e2-promise e2-size e2-new-size) (analyze-loops e2 (fx+ path-size e0-size) unroll-count)])
                        (values (delay `(if ,(force e0-promise) ,(force e1-promise) ,(force e2-promise)))
@@ -2556,7 +2556,7 @@
                     [else ($oops who "forgot a case: ~a" body)]))))))
 
       (define-pass rename-loop-body : (L7 Expr) (ir) -> (L7 Expr) ()
-        (definitions 
+        (definitions
           (define-syntax with-fresh
             (syntax-rules ()
               [(_ rename-ht x* body)
@@ -2570,15 +2570,15 @@
           [,x (eq-hashtable-ref rename-ht x x)]
           [(mref ,[e1] ,[e2] ,imm) `(mref ,e1 ,e2 ,imm)])
         (Expr : Expr (ir rename-ht) -> Expr ()
-          [(loop ,x (,[Lvalue : x* rename-ht -> x*] ...) ,body) 
-           ;; NB: with-fresh is so well designed that it can't handle this case 
+          [(loop ,x (,[Lvalue : x* rename-ht -> x*] ...) ,body)
+           ;; NB: with-fresh is so well designed that it can't handle this case
            (let*-values ([(x) (list x)]
                          [(x body) (with-fresh rename-ht x (values (car x) (Expr body rename-ht)))])
              `(loop ,x (,x* ...) ,body))]
-          [(let ([,x* ,[e*]] ...) ,body) 
-           (with-fresh rename-ht x* 
+          [(let ([,x* ,[e*]] ...) ,body)
+           (with-fresh rename-ht x*
              `(let ([,x* ,e*] ...) ,(Expr body rename-ht)))]
-          [(mvlet ,[e] ((,x** ...) ,interface* ,body*) ...) 
+          [(mvlet ,[e] ((,x** ...) ,interface* ,body*) ...)
            (let* ([x**/body* (map (lambda (x* body)
                                     (with-fresh rename-ht x* (cons x* (Expr body rename-ht))))
                                x** body*)]
@@ -2600,7 +2600,7 @@
                    (begin
                      #;(printf "Opt: ~a\n" x)
                      `(loop ,x (,x* ...) ,(force e-promise)))
-                   (begin 
+                   (begin
                      #;(printf "New size: ~a, old size: ~a\n" new-size size)
                      ir)))]))
       (set! $loop-unroll-limit loop-unroll-limit))
@@ -3194,7 +3194,7 @@
                          (goto ,Lbig)
                          ,(build-fix lo))
                      (label ,Lbig
-                       ,(%seq 
+                       ,(%seq
                           (set! ,%ac0 ,lo)
                           (set! ,(ref-reg %ac1) ,hi)
                           (set! ,%ac0 (inline ,(intrinsic-info-asmlib dofretuns64 #f) ,%asmlibcall))
@@ -3926,7 +3926,7 @@
                    [() `(immediate ,(fix base))]
                    [e* (and (fx<= (length e*) (fx- inline-args-limit 1))
                             (list-bind #t (e*)
-                              ;; NB: using inline-op here because it works when target's 
+                              ;; NB: using inline-op here because it works when target's
                               ;; NB: fixnum range is larger than the host's fixnum range
                               ;; NB: during cross compile
                               (let-values ([(e e* nc*) (log-partition inline-op base e*)])
@@ -5128,7 +5128,7 @@
               `(seq
                  ,(build-dirty-store e-sym (constant symbol-value-disp) e-value)
                  (set! ,(%mref ,e-sym ,(constant symbol-pvalue-disp))
-                   (literal 
+                   (literal
                      ,(make-info-literal #f 'library
                         (lookup-libspec nonprocedure-code)
                         (constant code-data-disp)))))))
@@ -5460,7 +5460,7 @@
                  (define (go3 e1 e2 e3)
                    (bind #t (e2)
                      (bind #f (e3)
-                       (build-and 
+                       (build-and
                          (go2 e1 e2)
                          (go2 e2 e3)))))
                  (define-inline 3 op
@@ -7892,42 +7892,42 @@
           (let ()
             (define build-bytevector-ref-check
               (lambda (e-bits e-bv e-i check-mutable?)
-               (nanopass-case (L7 Expr) e-bits
-                 [(quote ,d)
-                  (guard (and (fixnum? d) (fx> d 0) (fx= (* (fxquotient d 8) 8) d)))
-                  (let ([bits d] [bytes (fxquotient d 8)])
-                    (bind #t (e-bv e-i)
-                      (build-and
-                        (%type-check mask-typed-object type-typed-object ,e-bv)
-                        (bind #t ([t (%mref ,e-bv ,(constant bytevector-type-disp))])
-                          (build-and
-                            (if check-mutable?
-                                (%type-check mask-mutable-bytevector type-mutable-bytevector ,t)
-                                (%type-check mask-bytevector type-bytevector ,t))
-                            (cond
-                              [(expr->index e-i bytes (constant maximum-bytevector-length)) =>
-                               (lambda (index)
-                                 (%inline u<
-                                   (immediate ,(logor (ash (+ index (fx- bytes 1)) (constant bytevector-length-offset))
-                                                 (constant type-bytevector)))
-                                   ,t))]  
-                              [else
-                                (build-and
-                                  ($type-check (fxlogor (fix (fx- bytes 1)) (constant mask-fixnum)) (constant type-fixnum) e-i)
+                (nanopass-case (L7 Expr) e-bits
+                  [(quote ,d)
+                   (guard (and (fixnum? d) (fx> d 0) (fx= (* (fxquotient d 8) 8) d)))
+                   (let ([bits d] [bytes (fxquotient d 8)])
+                     (bind #t (e-bv e-i)
+                       (build-and
+                         (%type-check mask-typed-object type-typed-object ,e-bv)
+                         (bind #t ([t (%mref ,e-bv ,(constant bytevector-type-disp))])
+                           (build-and
+                             (if check-mutable?
+                                 (%type-check mask-mutable-bytevector type-mutable-bytevector ,t)
+                                 (%type-check mask-bytevector type-bytevector ,t))
+                             (cond
+                               [(expr->index e-i bytes (constant maximum-bytevector-length)) =>
+                                (lambda (index)
                                   (%inline u<
-                                    ; NB. add cannot overflow or change negative to positive when
-                                    ; low-order (log2 bytes) bits of fixnum value are zero, as
-                                    ; guaranteed by type-check above
-                                    ,(if (fx= bytes 1)
-                                         e-i
-                                         (%inline + ,e-i (immediate ,(fix (fx- bytes 1)))))
-                                    ,(%inline logand
-                                       ,(translate t
-                                          (constant bytevector-length-offset)
-                                          (constant fixnum-offset))
-                                       (immediate ,(- (constant fixnum-factor))))))]))))))]
-                 [(seq (profile ,src) ,[e]) (and e `(seq (profile ,src) ,e))]
-                 [else #f])))
+                                    (immediate ,(logor (ash (+ index (fx- bytes 1)) (constant bytevector-length-offset))
+                                                  (constant type-bytevector)))
+                                    ,t))]
+                               [else
+                                 (build-and
+                                   ($type-check (fxlogor (fix (fx- bytes 1)) (constant mask-fixnum)) (constant type-fixnum) e-i)
+                                   (%inline u<
+                                     ; NB. add cannot overflow or change negative to positive when
+                                     ; low-order (log2 bytes) bits of fixnum value are zero, as
+                                     ; guaranteed by type-check above
+                                     ,(if (fx= bytes 1)
+                                          e-i
+                                          (%inline + ,e-i (immediate ,(fix (fx- bytes 1)))))
+                                     ,(%inline logand
+                                        ,(translate t
+                                           (constant bytevector-length-offset)
+                                           (constant fixnum-offset))
+                                        (immediate ,(- (constant fixnum-factor))))))]))))))]
+                  [(seq (profile ,src) ,[e]) (and e `(seq (profile ,src) ,e))]
+                  [else #f])))
             (define-inline 2 $bytevector-ref-check?
               [(e-bits e-bv e-i) (build-bytevector-ref-check e-bits e-bv e-i #f)])
             (define-inline 2 $bytevector-set!-check?
@@ -9065,7 +9065,7 @@
                    ,(u32xu32->ptr t-hi %real-zero)))])])
 
         (define-inline 3 $read-performance-monitoring-counter
-          [(e) 
+          [(e)
            (constant-case architecture
              [(x86)
               (%seq
@@ -9275,7 +9275,7 @@
               (unless (uvar-in-prefix? x)
                 (uvar-in-prefix! x #t)
                 (set! prefix* (cons x prefix*))))))
-        (define add-prefix*! (lambda (x*) (for-each add-prefix! x*))) 
+        (define add-prefix*! (lambda (x*) (for-each add-prefix! x*)))
         (define reset-prefix*!
           (lambda (orig-prefix*)
             (let loop ([ls prefix*] [diff* '()])
@@ -9440,7 +9440,7 @@
         (define build-seq* (lambda (x* y) (fold-right build-seq y x*)))
         (with-output-language (L10 Expr)
           (define build-seq (lambda (x y) `(seq ,x ,y)))
-          (define Rhs 
+          (define Rhs
             (lambda (ir lvalue)
               (Expr ir
                 (lambda (e)
@@ -9714,7 +9714,7 @@
                              ,(Pvalues #f (list tmp))))]
                       [else ; set! & mvset
                         `(seq ,e ,(Pvalues #f (list (%constant svoid))))])])
-             (let-values ([(label* body*) 
+             (let-values ([(label* body*)
                            (let loop ([label* label*] [body* body*] [rlabel* '()] [rbody* '()])
                              (if (null? label*)
                                  (values rlabel* rbody*)
@@ -9909,7 +9909,7 @@
                    (pariah)
                    (mvcall ,(make-info-call #f #f #f #t #f) #f
                      (literal ,(make-info-literal #f 'library
-                                 (if ioc 
+                                 (if ioc
                                      (lookup-does-not-expect-headroom-libspec event)
                                      (lookup-libspec event))
                                  0))
@@ -12090,7 +12090,7 @@
             `(lambda ,(make-info "$install-library-entry" '(2)) 0 ()
                ,(%seq
                   ,(with-saved-ret-reg
-                     (%seq 
+                     (%seq
                        ,(save-scheme-state
                           (in scheme-args)
                           (out %ac0 %ac1 %cp %xp %yp %ts %td extra-regs))
@@ -12429,7 +12429,7 @@
         (define add-instr!
           (lambda (block ir)
             (block-effect*-set! block (cons ir (block-effect* block)))))
-  
+
         (define add-label-link!
           (lambda (from l setter)
             (let ([x (local-label-block l)])
@@ -12443,7 +12443,7 @@
               (safe-assert (not (block? x)))
               (when x (for-each (lambda (add-link!) (add-link! to)) x))
               (local-label-block-set! l to))))
-  
+
         (define-pass build-graph : (L14 Tail) (ir) -> * (block block*)
           (definitions
             (define add-goto-block
@@ -12653,7 +12653,7 @@
              (include "types.ss")
              (let ([n (fx- ($block-counter) 1)])
                ($block-counter n)
-               (block-pseudo-src-set! block 
+               (block-pseudo-src-set! block
                  (make-source ($sfd) n (block-checksum block)))))
            block*)
          ir]))
@@ -12736,7 +12736,7 @@
         [(lambda ,info ,max-fv (,local* ...) (,entry-block* ...) (,block* ...))
          (safe-assert (not (ormap block-seen? block*)))
          ; optimistically assume all blocks are pariahs, then un-pariah anything reachable from
-         ; the entry block without going through a known pariah block 
+         ; the entry block without going through a known pariah block
          (for-each (lambda (b) (if (block-pariah? b) (block-seen! b #t) (block-pariah! b #t))) block*)
          (for-each propagate! entry-block*)
          (for-each (lambda (b) (block-seen! b #f)) block*)
@@ -12863,7 +12863,7 @@
                              [else (sorry! who "unrecognized block ~s" block)])])
                 (safe-assert (not (null? links)))
                 ; AWK: we are missing the notion of those instructions that usually
-                ; succeed (dooverflow, dooverflood, call-error, fx+? and fx-? in 
+                ; succeed (dooverflow, dooverflood, call-error, fx+? and fx-? in
                 ; the original blocks.ss code)
                 (let-values ([(pariah* non-pariah*)
                               (partition (lambda (link) (block-pariah? (link-to link))) links)])
@@ -13010,7 +13010,7 @@
                           (cons* (car effect*) ir (cdr effect*))
                           (cons ir effect*))))))
               (with-output-language (L15a Effect)
-                (add-instr! block 
+                (add-instr! block
                   `(inline ,(make-live-info) ,null-info ,%inc-profile-counter
                      (literal ,(make-info-literal #t 'object counter (constant record-data-disp)))
                      (immediate 1))))))
@@ -13068,8 +13068,8 @@
           ; op -> counter | (plus-counter* . minus-counter*)
           ; plus-counter* -> (op ...)
           ; minus-counter* -> (op ...)
-          (define make-op 
-            (lambda (plus minus) 
+          (define make-op
+            (lambda (plus minus)
               ; optimize ((op) . ()) => op
               (if (and (null? minus) (fx= (length plus) 1))
                   (car plus)
@@ -13109,7 +13109,7 @@
                        (link-op-set! l counter)
                        counter))])))
           (define (filter-src* block)
-            (cond 
+            (cond
               [(eq? ($compile-profile) 'source) (block-src* block)]
               [(block-pseudo-src block) => list]
               [else '()]))
@@ -13327,7 +13327,7 @@
                   [(newframe-block? block) (fprintf p "   ~s\n" `(goto ,(block->pretty-name (newframe-block-next block))))]
                   [else (sorry! who "unrecognized block ~s" block)]))
               block*)))))
-  
+
     (define-pass np-add-in-links! : L15a (ir) -> L15a ()
       (CaseLambdaExpr : CaseLambdaExpr (ir) -> CaseLambdaExpr ()
         [(lambda ,info ,max-fv (,local* ...) (,entry-block* ...) (,block* ...))
@@ -13360,7 +13360,7 @@
                (lambda (b)
                  (unless (block-finished? b)
                    (if (block-seen? b)
-                       (begin 
+                       (begin
                          (block-loop-header! b #t)
                          (set! lh* (cons b lh*)))
                        (begin
@@ -14127,7 +14127,7 @@
                          (let ([out (if (info-kill*? info) (fold-left remove-var out (info-kill*-kill* info)) out)])
                            (live-info-live-set! live-info out)
                            (let ([out (fold-left Triv out t*)])
-                             (if (info-kill*-live*? info) 
+                             (if (info-kill*-live*? info)
                                  (fold-left add-var out (info-kill*-live*-live* info))
                                  out)))]
                         [(remove-frame ,live-info ,info) (live-info-live-set! live-info out) out]
@@ -14225,7 +14225,7 @@
                                        (let ([call (add-var
                                                      (fold-left
                                                        (lambda (live* x*) (fold-left remove-var live* x*))
-                                                       rp 
+                                                       rp
                                                        (cons*
                                                          ; could base set of registers to kill on expected return values
                                                          (reg-cons* %ret %ac0 arg-registers)
@@ -14293,7 +14293,7 @@
                           (uvar-spilled! x #t)
                           (unless (block-pariah? block)
                             (uvar-save-weight-set! x
-                              (fixnum 
+                              (fixnum
                                 (+ (uvar-save-weight x)
                                    (* (info-newframe-weight newframe-info) 2)))))))
                       call-live*)
@@ -14771,7 +14771,7 @@
                     (let ([effect* (block-effect* block)])
                       (block-fp-offset-set! block cur-off)
                       (cond
-                        [(goto-block? block) 
+                        [(goto-block? block)
                          (record-fp-offsets! (goto-block-next block) (fold-left Effect cur-off effect*))]
                         [(joto-block? block)
                          (record-fp-offsets! (joto-block-next block) 0)]
@@ -14932,7 +14932,7 @@
         (define-pass literal@->literal : (L15c Triv) (ir) -> (L15d Triv) ()
           (Triv : Triv (ir) -> Triv ()
             [(literal ,info)
-             `(literal 
+             `(literal
                 ,(make-info-literal #f (info-literal-type info)
                    (info-literal-addr info) (info-literal-offset info)))]
             [else (sorry! who "unexpected literal ~s" ir)]))
@@ -15001,7 +15001,7 @@
                 (if force-overflow?
                     (fxmax
                       (fx- (fx* max-fs@call (constant ptr-bytes)) 0)
-                      (fx- (fx* (fx+ max-fv 1) (constant ptr-bytes)) (fx- (constant stack-slop) (fx* (constant stack-frame-limit) 2)))) 
+                      (fx- (fx* (fx+ max-fv 1) (constant ptr-bytes)) (fx- (constant stack-slop) (fx* (constant stack-frame-limit) 2))))
                     (fxmax
                       (fx- (fx* max-fs@call (constant ptr-bytes)) (constant stack-frame-limit))
                       (fx- (fx* (fx+ max-fv 1) (constant ptr-bytes)) (fx- (constant stack-slop) (constant stack-frame-limit)))))))
diff --git a/s/date.ss b/s/date.ss
index 0b714ee439..4bb7d61bfd 100644
--- a/s/date.ss
+++ b/s/date.ss
@@ -96,7 +96,7 @@
       (scheme-object)
       scheme-object))
 
-  (define $mktime ; dtvec -> tspair        (returns #f on error)
+  (define $mktime ; dtvec -> tspair                (returns #f on error)
     (foreign-procedure "(cs)mktime"
       (scheme-object)
       scheme-object))
@@ -389,10 +389,10 @@
                  ($oops 'make-date "invalid day ~s for month ~s and year ~s" day mon year))
                (make-dt dtvec)))])
       (case-lambda
-       [(nsec sec min hour day mon year tz)
-        (do-make-date nsec sec min hour day mon year tz #t)]
-       [(nsec sec min hour day mon year)
-        (do-make-date nsec sec min hour day mon year #f #f)])))
+        [(nsec sec min hour day mon year tz)
+         (do-make-date nsec sec min hour day mon year tz #t)]
+        [(nsec sec min hour day mon year)
+         (do-make-date nsec sec min hour day mon year #f #f)])))
 
   (set! date? (lambda (x) (dt? x)))
 
diff --git a/workarea b/workarea
index 2a9db42910..736ef4c6f1 100755
--- a/workarea
+++ b/workarea
@@ -33,10 +33,10 @@ fi
 case "$M" in
   a6fb) ;;
   a6le) ;;
-  a6ob) ;;
-  a6osx) ;;
   a6nb) ;;
   a6nt) ;;
+  a6ob) ;;
+  a6osx) ;;
   a6s2) ;;
   arm32le) ;;
   i3fb) ;;
@@ -50,10 +50,10 @@ case "$M" in
   ppc32le) ;;
   ta6fb) ;;
   ta6le) ;;
+  ta6nb) ;;
   ta6nt) ;;
   ta6ob) ;;
   ta6osx) ;;
-  ta6nb) ;;
   ta6s2) ;;
   tarm32le) ;;
   ti3fb) ;;
@@ -139,7 +139,6 @@ case $M in
     ;;
 esac
 
-
 workdir $W/s
 (cd $W/s; workln ../../s/Mf-$M Mf-$M)
 (cd $W/s; forceworkln Mf-$M Makefile)